summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
authorAkira Kakuto <kakuto@fuk.kindai.ac.jp>2018-02-14 07:58:50 +0000
committerAkira Kakuto <kakuto@fuk.kindai.ac.jp>2018-02-14 07:58:50 +0000
commit885daa2d99a9bbccdf44a29e243a784c5165641a (patch)
tree573c340dd20ec8a181e324563000f25bc83a214f /Build
parentcbcd7f9542aac9c18e28e1100d6898478f459ae6 (diff)
pmx 2.8.4
git-svn-id: svn://tug.org/texlive/trunk@46632 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-Changes3
-rwxr-xr-xBuild/source/utils/pmx/configure20
-rw-r--r--Build/source/utils/pmx/pmx-src/ChangeLog915
-rw-r--r--Build/source/utils/pmx/pmx-src/Makefile.am4
-rw-r--r--Build/source/utils/pmx/pmx-src/Makefile.f2c4
-rw-r--r--Build/source/utils/pmx/pmx-src/PATCH-pmx284.for (renamed from Build/source/utils/pmx/pmx-src/PATCH-pmx276.for)61
-rw-r--r--Build/source/utils/pmx/pmx-src/README2
-rw-r--r--Build/source/utils/pmx/pmx-src/configure.ac2
-rwxr-xr-xBuild/source/utils/pmx/pmx-src/pmx.test6
-rw-r--r--Build/source/utils/pmx/pmx-src/pmx284.for (renamed from Build/source/utils/pmx/pmx-src/pmx276.for)1784
-rw-r--r--Build/source/utils/pmx/pmx-src/pmx284.for.orig (renamed from Build/source/utils/pmx/pmx-src/pmx276.for.orig)1780
-rw-r--r--Build/source/utils/pmx/pmx-src/pmxab.c28592
-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.pml2
-rw-r--r--Build/source/utils/pmx/pmx-src/version.ac2
-rw-r--r--Build/source/utils/pmx/pmxab.12
-rw-r--r--Build/source/utils/pmx/version.ac2
20 files changed, 29918 insertions, 3273 deletions
diff --git a/Build/source/utils/README b/Build/source/utils/README
index bc07ecb5473..3686f95fbd8 100644
--- a/Build/source/utils/README
+++ b/Build/source/utils/README
@@ -20,7 +20,7 @@ lacheck - maintained here, by us
m-tx 0.63 - checked 09jan18
http://ctan.org/pkg/m-tx/
-pmx 2.7.6 - checked 09dec16
+pmx 2.8.4 - checked 14feb18
http://ctan.org/pkg/pmx/
ps2eps 1.68 - checked 10may12
diff --git a/Build/source/utils/pmx/ChangeLog b/Build/source/utils/pmx/ChangeLog
index d42497d2b50..07fa8ff330c 100644
--- a/Build/source/utils/pmx/ChangeLog
+++ b/Build/source/utils/pmx/ChangeLog
@@ -1,3 +1,7 @@
+2018-02-14 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * Import pmx 2.8.4.
+
2017-03-27 Karl Berry <karl@freefriends.org>
* Makefile.am (AM_TESTS_ENVIRONMENT): use instead of TESTS_ENVIRONMENT.
diff --git a/Build/source/utils/pmx/TLpatches/ChangeLog b/Build/source/utils/pmx/TLpatches/ChangeLog
index c6f4cfebb39..8e52ce8d895 100644
--- a/Build/source/utils/pmx/TLpatches/ChangeLog
+++ b/Build/source/utils/pmx/TLpatches/ChangeLog
@@ -1,3 +1,7 @@
+2018-02-14 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * import pmx-2.8.4.
+
2016-12-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
* import pmx-2.7.6.
diff --git a/Build/source/utils/pmx/TLpatches/TL-Changes b/Build/source/utils/pmx/TLpatches/TL-Changes
index 16641f4a0a5..c1728a1b9e2 100644
--- a/Build/source/utils/pmx/TLpatches/TL-Changes
+++ b/Build/source/utils/pmx/TLpatches/TL-Changes
@@ -1,4 +1,4 @@
-Changes applied to the pmx-2.7.6 tree as obtained from:
+Changes applied to the pmx-2.8.4 tree as obtained from:
http://www.ctan.org/tex-archive/support/pmx/
Remove:
@@ -9,3 +9,4 @@ Remove:
depcomp
install-sh
missing
+ test-driver
diff --git a/Build/source/utils/pmx/configure b/Build/source/utils/pmx/configure
index f81c63197a1..d3f548e4435 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.69 for pmx (TeX Live) 2.7.6.
+# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.8.4.
#
# Report bugs to <tex-k@tug.org>.
#
@@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='pmx (TeX Live)'
PACKAGE_TARNAME='pmx--tex-live-'
-PACKAGE_VERSION='2.7.6'
-PACKAGE_STRING='pmx (TeX Live) 2.7.6'
+PACKAGE_VERSION='2.8.4'
+PACKAGE_STRING='pmx (TeX Live) 2.8.4'
PACKAGE_BUGREPORT='tex-k@tug.org'
PACKAGE_URL=''
@@ -1278,7 +1278,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.7.6 to adapt to many kinds of systems.
+\`configure' configures pmx (TeX Live) 2.8.4 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1344,7 +1344,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.6:";;
+ short | recursive ) echo "Configuration of pmx (TeX Live) 2.8.4:";;
esac
cat <<\_ACEOF
@@ -1441,7 +1441,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-pmx (TeX Live) configure 2.7.6
+pmx (TeX Live) configure 2.8.4
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1835,7 +1835,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.7.6, which was
+It was created by pmx (TeX Live) $as_me 2.8.4, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -3758,7 +3758,7 @@ fi
# Define the identity of the package.
PACKAGE='pmx--tex-live-'
- VERSION='2.7.6'
+ VERSION='2.8.4'
cat >>confdefs.h <<_ACEOF
@@ -5963,7 +5963,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.7.6, which was
+This file was extended by pmx (TeX Live) $as_me 2.8.4, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6020,7 +6020,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-pmx (TeX Live) config.status 2.7.6
+pmx (TeX Live) config.status 2.8.4
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/Build/source/utils/pmx/pmx-src/ChangeLog b/Build/source/utils/pmx/pmx-src/ChangeLog
index 86223087368..54297fae190 100644
--- a/Build/source/utils/pmx/pmx-src/ChangeLog
+++ b/Build/source/utils/pmx/pmx-src/ChangeLog
@@ -1,231 +1,686 @@
-Changes from PMX 2.5 to 2.621, 28 January 2013
-
-2.501 (Note: new scor2prt)
-
-Bugfix: initialize index in PMX subroutine putorn to eliminate subscript
-error detected in some compilers Bugfix in scor2prt: Ignore special
-treatment of special symbols if they appear between double quotes.
-Tweak: move end of first part of line­break ties slightly to the right.
-
-2.502 (Note: new pmx.tex)
-
-The height of a figured bass vertical stack can now be adjusted upward by
-an integral number of \internote by appending "+" and the number. Recall
-that it can already be moved downward 4\internote by prepending "_"
-(underscore). The two options can be combined to provide full control
-over the vertical position. Ties can now be represented with braces
-"{" before a note and "}" after. Both are equivalent to "t" after the
-note. (Thanks to Dirk Laurie). In pmx.tex all the commands of the form
-\font\...=\fontid sy1000 have been changed to \font\...=cmsy10 (Thanks
-to Olivier Vogel).
-
-2.503
-
-Enable arpeggio left shift with ?­[x] Allow musicsize of 24 and 29.
-Bugfix: Fix bug introduced in 2.415 which caused error in printing
-replacement number in xtup.
-
-2.504
-
-Gap between normal grace and main note: X[x] as option to the G command,
-where x is the gap size in notehead widths. Bugfix: og (segno) now
-works OK when nv .ne. noinst.
-
-2.505
-
-A new global option AK activates special rules for vertical positioning of
-rests in two­voice staves. By way of background, without the new option,
-rests in two­voice staves have default positions based on a simple rule
-that is not context­sensitive: those in the lower voice (the one before
-"//") are 4\internote below their single­voice default positions,
-and those in the upper line are 2\internote above the single­voice
-default. The new option invokes a set of context­sensitive rules to
-set the default position. The baseline rule is to align the rest in
-a horizontal line with the next following note in the same bar. If
-there is no following note in the bar, then it is aligned with the next
-prior note. If there are simulataneous rests in both voices, the old
-rule is applied. When the AK option is in force, it only affects places
-where there are two voices in a staff. It may be toggled on and off at
-the beginning of any input block, using just AK. When the option is in
-effect, any user­defined tweaks on the height of a rest will supersede
-the option for that particular rest, i.e., the tweak will be applied
-relative to the single­voice default position.
-
-2.506
-
-Fixes a bug in AK. Simultaneous, equal­duration rests will be positioned
-according to the default rules.
-
-2.507
-
-Enhancement to global option AK for vertical positioning of rests in
-two­voice staves (see version 2.505): The option L ("look left") in a rest
-will cause the vertical position of that rest to be based on the preceding
-note, rather than the following one as is the default when AK has been
-issued Partial bugfix: In unbeamed xtuplets, the length of the bracket
-and position of the number are now adjusted to account for any inserted
-hardspaces. Bugfix: unbeamed xtups with two flags are now allowed.
-
-2.508
-
-Allow grace notes in xtuplets.
-
-2.509
-
-Correct small bug in arpeggio left­shifting (it got confused when there
-was more than one voice on a staff).
-
-2.510
-
-Bugfix: Correct omission of character variable declarations in new
-subroutine getgrace introduced in 2.508.
-
-2.511 (Note: new scor2prt named s2p2511.exe)
-
-Bugfix: Correct error in horizontal spacing introduced in 2.507.
-Experiment: Remove prohibition against tempo changes in MIDI macros.
-Bugfix in scor2prt: Make it work right when "R" command occurs at end
-of input block and "/" is on next line (as produced by M­Tx).
-
-2.512
-
-Enable multiplicity down­up "][" within xtuplet
-
-2.513
-
-Bugfix: If there is more than one rest at start of a beamed xtuplet marked
-as a forced beam, beam height and slope tweaks are now properly handled.
-Bugfix: If an xtuplet with multiplicity 2 or 3 starts with a rest, the
-rest is now printed correctly. Bugfix: Unbeamed xtuplets (with option
-'a' on first note) with multiplicity 2 or 3 are now printed correctly.
-
-2.514
-
-Bugfix: Correct horizontal spacing when after­grace is immediately
-followed by normal grace. Bugfix: Correct transpose register when it
-has been changed in a single after­grace.
-
-2.515
-
-Bugfix: Correct error in automatic forced beams. Before the fix, if the
-beam did not start an integral number of beam durations from the start
-of the bar, incorrect results would occur. Bugfix: Properly center
-fermata over centered whole­bar rest.
-
-2.516 (Note: new pmx.tex)
-
-Allow figures in voice #2.
-
-2.517
-
-Allow figures in two voices, voice 1 and any other one.
-
-2.518
-
-Bug fixes in 2­voice figures.
-
-2.519
-
-Fix bug that prevented \sk from being output, misaligning some voices.
-
-2.520
-
-New feature: special characters 2+, 4+, 5+, 6+, 9+ for figured bass. In
-the PMX string for any figure, follow the number by 's'. This uses the
-font cmrj from the new package figbas. You must install this font in
-your TeX setup for this to work.
-
-2.521
-
-Bugfix: Font definition syntax corrected so no extra space is introduced.
-
-2.602 (Note: new pmx.tex; requires eTeX)
-
-Allow 24 voices, beams, slurs. Require etex. Include comment about
-doubling size of internal buffer to 131072, requiring gfortran for
-Windows to compile. Correct slur indexing in linebreakslurs. Account for
-comment lines in line count for error messages
-
-2.603 (Note: new scor2prt)
-
-In getpmxmod.for, decrease nline by 2 to fix locating errors following
-reading in an include file. Add some error messages in g1etset.for
-setup data
-
-2.610
-
-Instrument-wise transposition: Ki[instrument #][+/-][trans
-amt.][+/-][new key]. For more than one instrument, may immediately
-repeat everything after "K". Must either be at start of score (right
-after setup), or if later, must be preceded by normal (full score) key
-change command K+0[+/-][new key]. Must be used with relative accidentals
-("Ar"). Part(s) to be transposed must be entered in concert key, and
-will appear transposed in the score. MIDI behavior not yet tested.
-Has not yet been integrated into scor2prt, so for now if you want to
-make parts, only use Ki... as score-only (on line after "%%") and/or
-instrument only (on same line after %[Instrument #]).
-
-2.613
-
-Set error trap if "D" is entered before any notes.
-
-Enhance "AS" to allow spacing adjustments tailored for either smallsize
-or tinysize. As before, "AS" must be followed by nv characters, but now
-they may be "0" for normal, "-" or "s" for small, or "t" for tiny. Still
-must set sizes of instruments with inline TeX.
-
-Bugfix: Fixed broken "K-..." in 2.610.
-
-2.614
-
-Bugfix: revise raised dotted rests by separately raising rest and dot.
-
-2.615 *(Note: new scor2prt)*
-
-Command "AS", described above under 2.163, now also causes staff sizes
-to change (in score only, not parts), so inline TeX is no longer needed
-to change sizes of selected staves.
-
-Scor2prt transfers partwise transposition commands Ki... (see 2.610
-above) into parts.
-
-2.616
-
-"Feature" added: Hairpin dynamics now may span input blocks.
-
-2.617
-
-Repaired several obscure bugs related to platform and compiler
-dependencies; see pmxab.f for details.
-
-2.618
-
-For letter and a4 paper respectively, commands "Acl" and "Ac4" set
-horizontal and vertical sizes and offsets that center the page with no
-further adjustments required in dvips.
-
-2.619
-
-Several changes at movement breaks to improve compatibility with M-Tx
-and musixlyr.
-
-2.621
-
-Bugfix: Made keyboard rest positioning ("AK" command) work properly
-when there are rests are within xtuplets. Also fine-tune default
-positioning of number and bracket in unbeamed xtuplets containing
-rests. Position of both can still be overridden with options on
-first note command for xtuplet.
-
+2.84
+ Bug fix: dots in chordal seconds
+ Bug fix: Initialize ihornb for non-beamed, down xtup
+ Bug fix: When using "AT" with 2-note x3c rD.
+2.83
+ Fix problems when changing to or from octave treble clef.
+ Fix beaming (or not) and number location for xtups with
+ multiple rests. Still some problems with number height but
+ can be band-aided with number height tweak option.
+ Tweak error messages for options on "R" command.
+ Allow forced beam height and slope tweaks with 2-note tremolos
+ Allow chordal note with 2-note tremolos, adding dots as needed.
+ Fix call to ncmid in beamstrt when setting start height for beam of
+ 2-note trem, by changing arg from ivx to iv
+2.82
+ bugfix: beams with rests, not confused with xtups.
+ x option after slur index to allow slurs to go from one voice to another.
+ x option also for ties
+2.81
+ Allow string of rests to end xtup
+ in chordal half-note 2-note tremolo, make chord notes open.
+2.80
+ Add 2-note tremolos
+2.78
+ Expand bufq to 131072 bytes
+ Expand maxblks tp 9600
+ Allow up to 75 pages
+ Index postscript hairpins from 1 up instead of by voice #.
+ Add option 'o' to forced beam for open notehead (\hb); set ipl(3)
+ Add option T[n], n=1,2,3 for single stem tremolo
+2.77
+ Enable AV+/-x+/-y to add vskip bigh before or after \eject
+2.76
+2.75
+ Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and
+ 2 or 3 flags on shortened note.
+2.74
+ Bugfix: allow "0" as argument of @ command on lyrics string.
+ Check for and allow "\ in centered page headings with P command.
+ Check for and allow "\ in text dynamics with D command.
+ For lyrics string starting in xtuplet, insert check for inputting musixlyr.
+ For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam
+ starts with a blank rest, put '\sk' into the TeX.
+ To enable high-to-both beamed etup staff-crossing chord, for blank
+ rest at start of forced beam, shift \sk's from before to after \ib..;
+ so \ib is at start and note in upper voice has a beam to connect to.
+ Expand range of vertical xtup number shift, now stored in mult(16-22)
+ Check for and allow \" within lyrics strings, for umlauts.
+2.73 (160121)
+ Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as
+ inline TeX. Replace all '~' inside "..." and not preceded with '\', by
+ '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\
+ Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ",
+ add (as type 2 string) '\\input musixlyr \'
+ After inputting pathname, change any '\' to '/', for Linux compatibility.
+2.72 (160110)
+ Really finalize \mbrest...go back to 3 args to deal with clef changes.
+ Fine tune centered whole bar rests to deal with clef changes
+ Fix bug in wsclef when >1 staff per instrument, since \setclef
+ needs to know instrument and specify clefs on all staves for that
+ instrument. Ones that were not changed by user will not be printed,
+ and will be kept the same as before.
+ Fix bug with arpegii from one voice to another in same staff.
+2.71 (151226)
+ Finalize mbrest mods
+2.705
+ Fix error message
+2.704 (140614)
+ Octave treble clef
+ Make horizontal ornament shift (ornhshft) floating
+2.703 (140323)
+ Option v[-]n at end of any figure will alter figdrop for rest of system
+2.702
+ Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v"
+2.701
+ oC = coda (\code{10})
+ Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote)
+ oG = new seqno
+ To do: fix grace note spacing problem (partially done)
2.622
-
-New option in "K" command: "Kn..." inserts \ignorenats before signature
-change, supressing naturals in new signature.
-
-Many small fixes in transposition and key changes with "K", "Ki",
-and "IT" to make MIDI come out OK. Basic function of "K" and
-"Ki" unchanged. "IT[+/- n1][+/- n2]..." now transposes MIDI by
-\internotes, not half steps as before. E.g. to transpose MIDI of
-2nd instrument out of 3 up by one octave, use "IT+0+7+0". May also
-use to untranspose a transposing instrument that has been entered
-transposed, to make MIDI come out right.
+ Redefine midtc(..) and miditran(..); clean up all transpositions/key changes
+ Kn[+/-...] \ignorenats at signature changes
+ Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs
+ before checking and setting pitch levels levson() and levsoff()
+ Define midisig separately from isig. Put in common commidisig.
+ Use for explicit midi signature and for accid corrections to midi piches
+ in addmidi.
+2.621
+ Make keyboard rest option work in xtuplets. Created subroutine
+ chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd.
+2.620
+ Allow user-defined rest height tweaks at start of beam.
+2.619
+ At movement break, change \nbinstruments in \newmovement macro; add
+ 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for
+ to remove call to newnoi and change call to \newmovement
+2.618
+ Add option Ac[l,4] to set vert and horiz size and offsets to properly
+ center page for letter or a4 paper.
+2.617
+ In g1etnote, change if-check for note to use index(...) instead
+ of ichar(charq) since it was messing up gfortran optimizer
+ After pmxa, search for and remove penultimate line <blank><blank>/
+ because it was screwing up linux-compiled versions
+ Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...)
+2.616 (111110)
+ Allow hairpins to span multiple notes groups (gulps).
+2.615+ (110810)
+ Fix midi when some instruments are transposed, by subtracting
+ iTransAmt(instno(iv)) from pitch values sent to via addmidi in
+ make2bar.for (for main notes) and docrd (for chord notes)
+2.615 (110725)
+ Fig bug with size-setting (in topfile) when instrument has >1 staves
+2.615 (110724)
+ Make AS[0|-|s|t]... really set sizes
+2.614
+ Mod notex.for to fix Terry's bug with raised dotted rests (caused
+ by double-hboxing).
+2.613
+ Bugfix: In pmxa, change "do while" limit to keep from overwriting instno.
+2.612
+ Enhance AS to allow s or t for smallsize or tinysize
+2.611
+ Error trap for "D" before any notes in a block.
+2.610
+ Instrument-wise key changes and transposition (incomplete)
+2.603
+ 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors
+ following reading in an include file.
+ 101121 Added some error messages in g1etset.for setup data
+2.602
+ Correct slur indexing in linebreakslurs.
+ Account for comment lines in line count for error messages
+2.601
+ Bug fix: allow 24 slurs with graces
+2.60 Changes made make it really big
+ increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o
+ major reprogramming, and 16 may also be a problem (icmm)
+ nm=24 (voices) done
+ 24 slurs done
+ 24 simultaneous beams (Replace index 24 by 0, so get 0-23)
+ bufq*131072 (gfortran only)
+ getarg syntax (gfortran only)
+2.523+
+ Fix voice numbering for normal dynamics and text dynamics
+2.523
+ Version of bigpmx first posted to Hiroaki's web site.
+2.522
+ 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it.
+ With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices.
+ 5/13/10 Fix log2 function
+ 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length.
+2.521+
+ 091025 Enable dotting 2nd part of linebreak slur or tie.
+ To adjust barno height due to linebreak slur, use \bnrs instead of
+ explicitly redefining \raisebarno (pmxb)
+2.521
+ Bugfix
+2.520
+ 090519 Enable ligfonts (special figured bass characters)
+2.519
+ Fix another bug which kept \sk from being output so misaligned some notes.
+2.518
+ Fix bugs: referencing fig data, char declaration for member of
+ common/comfig/
+2.517
+ Allow figures in voice 1 + any one other.
+2.516
+ Allow figures in voice #2
+2.515+ to do: Change manual and activate rule against clef change in voice #2.
+2.515
+ 071222 Changes in getnote to allow auto forced beams to start anywhere.
+ 071206 In make2bar, shift fermataup7 to left over centered pause.
+ 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line
+ staff (it was screwing up vertical justification).
+ n34 for tweaks to midi durations of quarter note septuplets.
+ To do: In ref250.tex, the tables where 's,t,)' is explained, the line
+ [+,- i] ... Vertical adjustment of the start of second segment
+ should it be replaced by
+ [s +,- i] ... Vertical adjustment of the start of second segment
+2.514
+ Changes in make2bar to get horizontal spacing right when normal grace
+ follows after grace
+ Changes in dograce to get octaves right for any material entered inside
+ \gaft, which shields transpose register changes from the outside world.
+2.513
+ In make1bar, near end, for forced beams starting with a rest, copy hgt and
+ slope tweaks to ALL notes after first, not just the second one, so if
+ there's more than one rest at start the tweaks are still observed.
+ In beamid and beamend, add stand-alone triply-flagged notes for xtups.
+2.512
+ Near end of pmxb, fix error trap to allow redundant 'RD'
+ Enable multiplicity down-up '][' within xtup.
+2.511
+ Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by
+ adjusteskz as in bar 7 of barsant.
+2.510a
+ Test: remove restriction on tempo changes in MIDI macros
+ Send to CM for beta testing.
+2.509+
+ To do: Correct manual on AS. "-" is for smaller staves.
+2.510
+ Forgot to declare litq, voltxtq as character in subroutine getgrace
+2.509
+ Corrected small bug in arpeggio shifting (ivx <= iv in call putarp)
+2.508
+ Allow graces in xtups. New subroutine getgrace.
+2.507
+ To do: Raise/lower figures.
+ To do: Add 24, 29 to list of musicsizes in manual
+ New sub adjusteskz to account for ask's when computing lengths of
+ brackets for unbeamed xtups, slopes and horizontal posn's of number
+ Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags
+ Add look-left option for keyboard rests, "L" in rest command, set iornq(30)
+2.506
+ Fix bug with AK, when simultaneous rests have same duration, use defaults.
+2.505
+ Keyboard rests AK
+2.504
+ Space after normal grace: option X[n]
+ Fixed og when nv .ne. noinst, by using sepsymq instead of '&'
+ (To do) length of xtup bracket when there is added non-collision space.
+ Trap musicsize if .ne. 16,20,24,29.
+2.503
+ Enable arpeggio left shift with ?-x
+ To do: In manual, arpeggio over 2 staves.
+ Allow musicsize of 24 and 29. Had to define meter font size explicitly,
+ also change font size for text dynamics, but not much else so far.
+ Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn
+ was called, causing error in printing replacement number.
+2.502
+ Incorporate Dirk Laurie's patch to use { , } , for ties.
+ Figure height adjustment: append +[n]
+ Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?)
+2.501
+ Readjust horizontal offset back to .8 in LineBreakTies
+ Fix zero-subscript (iudorn) in putorn
+2.50
+ Increase number of text-dynamics (dimension of txtdynq) per block
+ from 12 to 41.
+ Slur option n to override altered default curvature.
+ Allow default ps slur curvature tweaks with Ap+/-c
+2.416
+ Increase length of textdynq from 24 to 128
+ (Todo) Add comment in manual about blank lines at end.
+ Configuration file: Define subroutine getpmxmod, check path in environment
+ variable pmxmoddir, check existence, read lines into bufq after setup.
+ Increase dimension on idynn in dodyn from 4 to 10 for max number
+ of marks in a bar
+ Increase allowable # of lines from 2000 to 4000.
+ (To do) Replace definition of \liftpausc per Olivier.
+ (To do) Fix extraneous error message if RD is placed at very end.
+2.415
+ Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt
+ instead of redefining \xnum. Change font used to \smallfont (as for
+ normal xtups,
+ Allow slur to start on rest.
+2.414
+ Correct bug in crdacc when adding accidental to boundary causes number of
+ segments to decrease
+ Special rule for 3-accidental chords: If no 2nds, place them in order
+ top, bottom, middle.
+2.413
+ Correct bugs in chordal accidentals, related to left-shifted noteheads
+ (a) Special problems with downstem when main note needs shifting
+ (b) Assign 0 rank to boundary segs due to left-shifted noteheads
+2.412
+ Change default horiz shift of start of seg 2 of linebreak slurs:
+ -.7 for slurs, -1.2 for ties,
+ Use height of start of seg 1 slur itself for end of 1 and start of 2.
+2.411
+ "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2.
+ "s" option in start of slur/tie as precursor to vert/horiz tweaks for end
+ of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2.
+ With "Apl", curvature adjustments on starting slur command apply to seg 1,
+ those on ending command to seg 2.
+2.410
+ "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine
+ \xnum, \unbkt, \ovbkt.
+ "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is
+ flag, mult(5-9) is tweak value+16
+2.409
+ Bugfix in docrd for MIDI: Use original pitch in case main/chord were
+ switched due to 2nds.
+ Remove "o" from error message for "A" command.
+ New syntax: optional instrument number separator ":" in movement
+ break command to precede a 2-digit instrument.
+ Conditional output formats for \setname at movement break to allow
+ instrument numbers >9.
+ Bugfix in coding to raise barno due to slur over line break (pmxb)
+ Move date/version data statement in pmxab to a better place.
+2.408
+ Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar).
+ Bug fix in \liftPAusep in notex.for and in pmx.tex
+ Character variables for version and date
+ For up-stem single graces slurred to down-stem, shift slur start left by
+ 0.8 so slur doesn't get too short.
+ Initialize and slide mult, same as other full-program variables in /all/.
+2.407
+ Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n,
+2.406
+ Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing
+ equalization).
+ Put dimensions of double sharps and flats in crdacc (for chords).
+ Bugfix: Use sepsymq in LineBreakTies(..) instead of '&'
+ Use only first 4 bits of mult for multiplicity+8, so rest can be used
+ for other stuff.
+ Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict.
+2.405: Not published but saved for safety.
+ Option Aph to write \special{header=psslurs.pro} top of each page, so
+ dviselec will work OK.
+2.404
+ Allow slur to end on rest, but not start on a rest. Efaults height
+ of ending is default height of start (before any automatic or user-
+ defined djustments). User may adjust height as normal from default.
+2.403
+ Bugfix: turn off repeated beaming patterns.at end of non-last voice.
+2.402
+ Automatic repeated forced beams. Start with "[:" End with next explicit
+ forced beam or end of input block.
+ Increase # of forced beams per line of music per input block from 20 to 40
+2.401
+ Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies.
+ Makes 1st part normal shape, and starts 2nd part a little further left.
+ Enable arpeggios in xtuplets. Had to make time itar(narp) a real.
+2.40
+ Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap.
+ Fix non-ps-slur input to \midslur (third signed integer). Do not reverse
+ sign for down-slurs.
+2.359
+ Add error exit subroutine stop1 to make exit status g77-compatible..
+ Absolute octave on xtup chord note was 2 octave too high, fixed in getnote
+ Fermata on vertically shifted rest: special trap in putorn() to set height.
+ Correct multiple grace note spacing for small staves (in dograce,
+ define wheadpt1 depending on staff size)
+2.358
+ Allow curvature corrections at start of postscript slur, in dopsslur()
+ Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust
+ Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h]
+ Make t[ID] act like s[ID]t, most mods in spsslur().
+ Add spsslur() to read in data for ps slurs, call from getnote.
+ In beamstrt, save args for SetupB in common comipb to save them for
+ 2nd call when xtup starts with rest
+ Add spacing for ornament ")" as if it were accidental, in make2bar().
+ Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur()
+ Horiz. shift start of ps grace slur, 2 places in dograce().
+ Horiz shift end of grace slur in endslur()
+ Make st slurs into postscript ties. Separate subroutine dopsslur(),
+ Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.)
+ Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn.
+2.357a
+ Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote
+2.357
+ Increase dimension for # of lit TeX strings from 52 to 83.
+ Allow blank rest in middle of xtuplet. Only mods in g*etnote().
+2.356
+ Increased some dimensions from 30 to 40 to allow up to 40 pages.
+ In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt().
+ Fix parsing of "f,h,H,HH" in sslur.
+ Fix bug with cdot, note-level for slur termination (in getnote)
+2.355
+ Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)],
+ n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues
+ Make midi recognize ps ties in doslur.
+ Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote
+ to get octave right.
+2.354
+ With postscript slurs, make t-slurs real ties by inserting replacement
+ macros \tieforisu, etc, defined in pmx.tex
+ Check for open cresc or decresc at end of input block, using list[de]cresc
+ Hairpin syntax conditional on postscript slurs. Backup to fill in start
+ level, using new backfill(...). Separate height tweaks for
+ start and finish.
+2.353
+ K-0+n to transpose by half step (rather than just change key)
+ Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of
+ \mbrest's
+ Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end
+ of input block before movement break, and at start of block after
+ movement break, using \newmovement rather than \setzalaligne, since
+ former already redefines \stoppiece. In second case, set rptfg2='z'.
+ Make clefq(nm) common between pmxb and getnote; change references in
+ getnote at 'M' to array elements, setting all new clefs as you go.
+2.352
+ Remove \parskip redefinition from pmx.tex; write it into TeX file when
+ "Ae" is invoked.
+ Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine
+ \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH',
+ translate them thru mapping to (1,4,5,6) as \midslur params, then let
+ \psforts translate them back to ps slur macors.
+2.351
+ Number slurs from 0 up instead of 11 down, anticipating postscript slurs.
+ Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size.
+ Increase length of basenameq to 44 characters everywhere.
+ Increase dimension of mcpitch (midi-chord-pitch) to 20.
+ Set default systems per page to 1 if nv>7
+ In pmxb, move place where isystpg is reset to 0, so that \eject gets
+ written when there is just one system per page.
+2.35
+ Cautionary accidentals with 'c' anywhere in note symbol.
+ NEW pmx.tex with \resetsize to set size to normal or small depending on
+ current \internote. Used with new coding in dograce() to get right
+ new size in case user has \setsize'ed some lines to \smallvalue. For
+ \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font.
+ Affects pmx.tex.
+ Continuation figure with fractional length. May now mix with other figures.
+ If another figure follow Cont-fig, separate with colon.
+2.342
+ Bugfix in getnote to recognize relative octave shift in grace at start of
+ input block.
+ In make2bar, initialize islhgt=0 earlier than before (possible solution
+ to Suse g77 compile problem that I could not reproduce)..
+ Bugfix in beamstrt & beamn1 for r2x6 c4D d d d
+2.341
+ Syntax check: Forced page break page number must be > than previous.
+ Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb.
+2.34
+ New pmx.tex with redefined liftpausc
+ Bug fix with dotted, non-beamed xtups.
+2.332
+ Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads.
+ Allow arbitrary pos. input to W in g1etnote and getnote.
+2.331
+ Bug-fix in dodyn(..): typo on length of arg of txtdyn
+2.33
+ Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata()
+2.321
+ Rescale accidental shifts. Still use 7 bits but now map (0,127)
+ onto (-1.,5.35)
+ Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups
+2.32 (Noticed after posting)
+ Prohibit "/" as figure.
+2.32 (Posted)
+ Tidied up accidentals in chords, do spacing.
+ Still to do:
+ check for "(" on chord notes in spacing algo
+ small accids
+ double accids
+ autoshift slurs
+2.310
+ Extra call to precrd ahead of spacing chk, and single-note crd/acc
+ shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time.
+2.309
+ Alternate algo for accid shifts in chords.
+2.308
+ Auto horiz. notehead shifting added to precrd.
+2.307
+ Auto shifting of multiple accidentals in chords.
+ "Ao" in main chord note to keep accidentals in order. Set nacc(28).
+ If there are any manual main or chord note shifts, then
+ If any manual shift is preceded by "A" then
+ 1. Auto-shifting proceeds
+ 2. "A"-shifts add to autoshifts
+ 3. non-"A" shifts are ignored!
+ Else (>0 man shifts, none has "A")
+ No auto-ordering, No autoshifts,
+ End if
+ End if
+2.306
+ Initialize legacy note level to middle C in case user forgets to set
+ octave.
+ Shift xtup note?
+ Shift in elemskips rather than noteheads?
+2.305
+ Stop pmxb from multiple endvolta's at start of new page.
+2.304
+ "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on
+ for multiple notes in the voice, "S:" last shortened note.
+2.303
+ vshrink stuff all OK? Description is in pmxb.
+2.302
+ Toggle vshrink with "Av". vshrink normally kicks in when \interstaff
+ hits 20. This still needs work.
+ Add " /" to last line if last char is not % or /.
+2.301
+ Check in beamn1 for single note before multiplicity down-up.
+ allow '.PMX' as well as '.pmx'
+2.299
+ Correct typo in pmxb involving PMXbarnotrue.
+ Replacement printed number for xtup: Unsigned integer after 'n' after 'x'
+ Minor upgrade parsing xtuplet options 'x...'
+ Correct dimension of nxtinbm in make2bar.
+2.298
+ Account for doubled xtup notes in subroutine getx (user-defined spaces),
+ by adding ndoub as an argument..
+2.297
+ Created and solved compiler problem. Put drawbm(NM) in its own common.
+ Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar
+ when \centerbar is used.
+ Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX
+ use right 2nd and 3rd args for \mbrest when key, meter, or clef changes.
+2.296
+ Correct printed numbers for forced beams with multiple xtups. For each beam
+ make list in setupb by voice of eloff (h-offset) and mtupv (printed #)
+ Increase lengths of jobname and infileq by 20 characters
+ Enable whole notes and breves as 1st or last note of xtup in beamn1 and
+ beamend, and wholes in beamid.
+2.295
+ Midi balance Ib[n1]:[n2]:...[nn]
+ Single-slope beam groups [...]-[...]
+ Trap "i" unless after accidental (main notes, xtups, chord notes)
+2.294
+ Unequal xtups with "D" to double a note in an xtup.
+ As above, "F" will (a) increase multiplicity by 1 for marked note and next
+ one and (b) add a dot to the first one.
+ Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on
+ when "." is encountered, then correcting beam start time.(end of getnote)
+ MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]...
+2.293
+ Check for single notes spanning bar lines.
+ Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup
+ must be set in make2bar since beamstrt is not called, fixing problem with
+ dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix
+ problem when >2 staves.
+ Add nodur to args of dodyn, so can check if stemless and avoid height tweak
+ Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak
+2.292a
+ Undo syntax check for Type 2 or 3 TeX string starting in column 1.
+ Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?!
+2.292
+ Allow comments in xtuplets
+ Enable multiple octave jumps in grace notes.
+ Allow dynamics in xtuplets.
+ Fix bug in getdyn searching for end of text string (correct length of lineq
+ to 128)
+ Fix bug in dodyn, must ignore horiz. interaction tweak for
+ user-text (idno = 0)
+ Syntax check for Type 2 or 3 TeX string starting in column 1
+ (NOTE: later undone!)
+ Syntax check for page number > npages at forced line break.
+2.291
+ Fix error in AS command (accid spacing for small systems), making only
+ one spec per staff, nv total.
+ Stop using MIDI channel 10
+2.29
+ Fix error in console output format for # of bytes used in MIDI file.
+ Fix bug in dograce so no space is added between grace and main note when
+ there is a MIDI-only accidental.
+ Fix bug so oes?+4 works. It was too ugly to explain.
+ ...Different ways of storing accidental specs on input and output.
+ No longer zap \writezbarno in special situations.
+ Fix bug in dyntxt level on rest
+ Line spacing equalization. Add macros \starteq, \endeq, \spread, etc.
+ Activate with Ae. (Maybe later could input alternate values for
+ \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1
+ in the page, and \endeq on 1st note of next-to-last line in page.
+2.28
+ Flip direction of forced beam "[f..."
+ Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30)
+ Fix bug in sliding ip's for txtdyn's
+ In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99)
+2.27
+ Comment out lines in dodyn checking number of dynamic marks found. Voice
+ order may not be monotonic if two lines on a staff.
+ Literal dynamic: D"[text]"
+2.26
+ Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn,
+ increasing dimension of idynn to 4 to allow 4 symbols on same note.
+ Increase voltxtq length from 10 to 20.
+ AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough
+ accounting for ast's is done by defining effective headwidth
+ whead1 in makebar2 to be 0.8*whead.
+2.25
+ Fix logic bug with sepsym's when # of instruments changes.
+ Slight increases in default offsets for hairpin starts after "p"
+2.24
+ Hairpins D< or D> as toggle.
+ Many automatic position tweaks for letter-group dynamics and hairpins.
+2.23
+ Continued rhythmic shortcuts: space followed by "." or ","
+2.22
+ In call to doslur, change tno(...) to tnote(...). This was only
+ used when checking to slurs per stem directions, and should have been
+ the note duration all along.
+ MIDI-only accidental, bit 17 in nacc, or 27 in icrdat.
+ Use "i" anywhere in note symbol.
+2.21
+ Increase from 20 to 30 dimensions for movement breaks and midi sections.
+ Fix out-of-order declarations per mutex comments
+ Add "Bad error" and "Kluging" messages to log file.
+2.197
+ add /comips/ to save tie-check midi variables
+ For spacing of clef changes at start of input block, changed integer time
+ lastnodur to prevtn, so it works with xtups. Possible incompatibility!
+2.196
+ Fix Ickbug with time check in ncmid()
+ Interchange \fermataup7 and \pausec to get proper alignment
+ Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX.
+ Add defn's of \hsp, \hspp to pmx.tex
+ Fix pre-slurs on xtup chord notes.
+ Fixed raised PAuse, define \liftPAuse
+ Replace \zbreve\sk with \breve.
+ Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what
+ about "o" and 1 as shorthand for 16???? Search for "Kluge"
+ Added "vo" (voice) as MIDI instrument 55
+ Allow 3-digit page numbers (search for "toppageno")
+ Fix bug caused by prior fix (cancelling accid after bar line was ignored).
+ Fix double accids in chords
+2.194
+ Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if
+ block.
+ Add meter to MIDI file with every pause
+ Purify FORTRAN?
+2.193
+ Increased # of in-line TeX strings from 36 to 52.
+ Fix entry of # of bytes in header of tempo/meter/key track to allow >255.
+2.191
+ Event track: Tempos, meters, keys all together. Data in comevent
+2.15
+ Pretty good midi capability. Still no attention to slurs on chord notes.
+2.11
+ 11 Dec 99 c rm1
+ 11 Dec 99 "oes?", "oe?"
+ 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes
+ 11 Dec 99 Error message for shifted, repeated ornaments.
+2.10 (Version 2.1)
+ Fix bug with lowdot and xtuplets
+2.09
+ Fix bug with multiple ornament heights over beams, when one is . or _
+ Error message from pmxa if rest on last note of xtup.
+ Enable 12 slurs.
+ Reinstate multiple rests at start of xtup.
+2.07
+ Combine consecutive type-1 TeX strings.
+ \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's.
+ Fixed breve chord notes in docrd
+ Check irest(28) as well as vxtup when setting nodur for chord notes, since
+ vxtup isn't set until 1st *main* note in xtup
+ Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing.
+2.06+
+ Make deterministic the beam slope calculation when there are an even # of
+ slopes in list and middle two are equal magnitude but opposite sign.
+ pmxa Trap for "o:" before 1st note in block
+ Partial bug fix for 64th notes in xtuplets.
+ Make ixrest a vector, since with new time scheme may not finish xtup in
+ same notes block.
+ Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb)
+2.06
+ Account for changes in nv when computing \interstaff. Add a counter
+ nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever
+ setting isysflb(iflb). Note nv can only change at a forced line break.
+ Note also, iflb starts at 0!
+2.05
+ Automatic start of new notes group with part 2 of staff-jump beam
+ In make1bar, set irest bit 29 of lowest-voice note at same time,
+ use as flag when making notes groups.
+ For now, remove dummy blank line at end...it zaps terminal repeats.
+2.02
+ Fixed slur-counting bug for multiple, slurred, aftergraces.
+2.01
+ Increase to ask(1400)
+ Increase max forced page breaks to 18
+ Define pausc for centered pause
+2.0a
+ Insert dummy blank line at very end to handle input files w/o terminal CR-LF
+pmx03r
+ Option m[n] in S symbol to change musicsize (for parts)
+ Double dotted rests now work.
+ Write file name to log file
+ Check existence of input file
+ Allow 24-char jobname, may end with ".pmx"
+ Comment out time stuff
+ Replace 3-argument getarg with 2-argument + iargc
+ Fix bug with negative noinst due to nint<=int replacement
+ move lovation of iv in isdat1 to allow iv>7.
+ Set nm=12
+pmx03q
+ replace int(x+.001) with nint(x)
+ Write TeX file name to screen and to pml.
+ Replace char(...) with chax(...) to sovle msdev bug.
+ Bug fix: macro terminations when M is on a line by itself.
+ Bug fix: don't accumulate space for XS in pmxa.
+ Streamline Macros: use pointers to bufq instead of scratch files
+pmx03p
+ Store input file in single character array bufq.
+ lbuf(i)*2 is length of line i
+ ipbuf is position just before next line to be read.
+pmx03
+ Optimize read/writes
+pmx02
+ Fix line count (for errors) when there are saved macros
+pmx01
+ In optimize mode, open/close macros (Watch out for residual zz files!)
+ Command line input
+ Option Ao to optimize, otherwise normal processing
+c
diff --git a/Build/source/utils/pmx/pmx-src/Makefile.am b/Build/source/utils/pmx/pmx-src/Makefile.am
index 0d86435f73d..a1c900ef64e 100644
--- a/Build/source/utils/pmx/pmx-src/Makefile.am
+++ b/Build/source/utils/pmx/pmx-src/Makefile.am
@@ -233,11 +233,11 @@ PATCHES = libf2c/patch-01-binary libf2c/patch-03-DOS-line-endings \
libf2c/patch-07-MuslLibc \
libf2c/patch-08-WIN64 \
libf2c/patch-09-tmpfile \
- PATCH-pmx276.for
+ PATCH-pmx284.for
## 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 pmx276.for.orig pmx276.for
+EXTRA_DIST += scor2prt.for pmx284.for.orig pmx284.for
EXTRA_DIST += $(PATCHES)
EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c
DISTCLEANFILES = barsant* pmxaerr.dat
diff --git a/Build/source/utils/pmx/pmx-src/Makefile.f2c b/Build/source/utils/pmx/pmx-src/Makefile.f2c
index ae58b8792fe..d1e75570c99 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: pmx274.for
- f2c -g -\!bs < pmx274.for > pmxab.c
+pmxab.c: pmx284.for
+ f2c -g -\!bs < pmx284.for > pmxab.c
scor2prt.c: scor2prt.for
f2c -g -\!bs < scor2prt.for > scor2prt.c
diff --git a/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for b/Build/source/utils/pmx/pmx-src/PATCH-pmx284.for
index 89750d303f9..c1262cfa78a 100644
--- a/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for
+++ b/Build/source/utils/pmx/pmx-src/PATCH-pmx284.for
@@ -1,7 +1,7 @@
-*** pmx276.for.orig 2016-12-07 08:56:24.231733002 -0500
---- pmx276.for 2016-12-07 14:55:34.769485275 -0500
+*** pmx284.for.orig 2018-02-12 13:36:14.825209815 -0500
+--- pmx284.for 2018-02-12 13:36:14.848209816 -0500
***************
-*** 11104,11110 ****
+*** 11875,11881 ****
end if
go to 1
end
@@ -9,7 +9,7 @@
* lenbar,
c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
* mtrdenl,first)
---- 11104,11110 ----
+--- 11875,11881 ----
end if
go to 1
end
@@ -18,7 +18,7 @@
c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
* mtrdenl,first)
***************
-*** 11210,11216 ****
+*** 11981,11987 ****
c Instrument numbers or letters. Expect noinst of them.
c
c do 2 ivx = 1 , nv
@@ -26,7 +26,7 @@
call getchar(lineq,iccount,durq)
if (ichar(durq) .gt. 96) then
c
---- 11210,11216 ----
+--- 11981,11987 ----
c Instrument numbers or letters. Expect noinst of them.
c
c do 2 ivx = 1 , nv
@@ -35,7 +35,7 @@
if (ichar(durq) .gt. 96) then
c
***************
-*** 11255,11261 ****
+*** 12026,12032 ****
c Follow same pattern as for insttrument numbers above.
c
c do 7 ivx = 1 , nv
@@ -43,7 +43,7 @@
call getchar(lineq,iccount,durq)
if (index('123456789',durq) .eq. 0) then
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
---- 11255,11261 ----
+--- 12026,12032 ----
c Follow same pattern as for insttrument numbers above.
c
c do 7 ivx = 1 , nv
@@ -52,7 +52,7 @@
if (index('123456789',durq) .eq. 0) then
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
***************
-*** 11278,11284 ****
+*** 12049,12055 ****
c Follow same pattern as for instrument numbers above.
c
c do 8 ivx = 1 , nv
@@ -60,7 +60,7 @@
call getchar(lineq,iccount,durq)
if (index('123456789',durq) .eq. 0) then
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
---- 11278,11284 ----
+--- 12049,12055 ----
c Follow same pattern as for instrument numbers above.
c
c do 8 ivx = 1 , nv
@@ -69,7 +69,7 @@
if (index('123456789',durq) .eq. 0) then
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
***************
-*** 11301,11307 ****
+*** 12072,12078 ****
c Follow similar pattern as above, but separator is +|-.
c
c do 9 ivx = 1 , nv
@@ -77,7 +77,7 @@
call getchar(lineq,iccount,durq)
ipm = index('-+',durq)
if (ipm .eq. 0) then
---- 11301,11307 ----
+--- 12072,12078 ----
c Follow similar pattern as above, but separator is +|-.
c
c do 9 ivx = 1 , nv
@@ -86,34 +86,37 @@
ipm = index('-+',durq)
if (ipm .eq. 0) then
***************
-*** 11634,11639 ****
---- 11634,11640 ----
- common /commidisig/ midisig
- common /comlyr/ inputmlyr
- logical inputmlyr
-+ data inputmlyr /.false./
- cdot = .false.
- 1 call getchar(lineq,iccount,charq)
- if (lastchar) return
-***************
-*** 19899,19905 ****
+*** 20724,20736 ****
common /comclefrests/ centrests
logical newclef, centrests
common /comlyr/ inputmlyr
! logical inputmlyr /.false./
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comhair/ idhairuse,idhair(nm)
+ bottopgap = .false.
+ idhairuse = 0
if (.not.optimize) then
print*
- print*,'Starting second PMX pass'
---- 19900,19906 ----
+--- 20724,20737 ----
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)
+ bottopgap = .false.
++ inputmlyr = .false.
+ idhairuse = 0
if (.not.optimize) then
print*
- print*,'Starting second PMX pass'
***************
-*** 24541,24547 ****
+*** 25399,25405 ****
c (unless preceded with '\'), check length
c
character*128 lineq,lineqt
@@ -121,12 +124,12 @@
iend = lenstr(lineq,128)
c
c i2nd = iccount+index(lineq(iccount+1:128),'"')
---- 24542,24549 ----
+--- 25400,25407 ----
c (unless preceded with '\'), check length
c
character*128 lineq,lineqt
! character*1 sq
-! data sq /'\'/
+! sq = '\'
iend = lenstr(lineq,128)
c
c i2nd = iccount+index(lineq(iccount+1:128),'"')
diff --git a/Build/source/utils/pmx/pmx-src/README b/Build/source/utils/pmx/pmx-src/README
index c5725475eaf..492559b1b0d 100644
--- a/Build/source/utils/pmx/pmx-src/README
+++ b/Build/source/utils/pmx/pmx-src/README
@@ -1,4 +1,4 @@
-This is PMX, version 2.7.4 (2016-02-20). PMX provides a preprocessor for MusiXTeX.
+This is PMX, version 2.8.4 (2018-02-12). PMX provides a preprocessor for MusiXTeX.
pmxab builds a TeX input file based on a .pmx input file in a much
simpler language, making most of the layout decisions by itself. It has
diff --git a/Build/source/utils/pmx/pmx-src/configure.ac b/Build/source/utils/pmx/pmx-src/configure.ac
index d56db2ca306..07ab7e522a6 100644
--- a/Build/source/utils/pmx/pmx-src/configure.ac
+++ b/Build/source/utils/pmx/pmx-src/configure.ac
@@ -11,7 +11,7 @@ AC_INIT([pmx], pmx_version, [rdt@cs.queensu.ca])
AC_PREREQ([2.63])
AC_CONFIG_SRCDIR([pmxab.c])
-AM_INIT_AUTOMAKE(pmx, pmx_version)
+AM_INIT_AUTOMAKE
dnl Check compiler and flags
AC_PROG_CC
diff --git a/Build/source/utils/pmx/pmx-src/pmx.test b/Build/source/utils/pmx/pmx-src/pmx.test
index 9979082d335..4055a6e47ed 100755
--- a/Build/source/utils/pmx/pmx-src/pmx.test
+++ b/Build/source/utils/pmx/pmx-src/pmx.test
@@ -1,6 +1,6 @@
-#! /bin/sh -vx
-# Copyright 2017 Karl Berry <tex-live@tug.org>
-# Copyright 2012 Peter Breitenlohner <tex-live@tug.org>
+#! /bin/sh
+
+# Copyright (C) 2012 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
rm -f barsant* pmxaerr.dat
diff --git a/Build/source/utils/pmx/pmx-src/pmx276.for b/Build/source/utils/pmx/pmx-src/pmx284.for
index d863df79a01..172f3da759b 100644
--- a/Build/source/utils/pmx/pmx-src/pmx276.for
+++ b/Build/source/utils/pmx/pmx-src/pmx284.for
@@ -63,6 +63,39 @@ 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.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.
@@ -717,9 +750,9 @@ c Command line input
c Option Ao to optimize, otherwise normal processing
c
ccccccc
- parameter (nks=125,nm=24,mv=24576,maxblks=4000)
+ parameter (nks=125,nm=24,mv=24576,maxblks=9600)
character*128 lnholdq
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /comevent/ miditime,lasttime
logical slmon,dbltie
@@ -769,8 +802,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording).
c
ccccccccccccccccccccccccc
c
- data date /'24 Nov 16'/
- data version /'2.76'/
+ data date /'10 Feb 18'/
+ data version /'2.84'/
c
ccccccccccccccccccccccccc
data maxit,ncalls /200,0/
@@ -908,7 +941,7 @@ c
else
linewcom(1) = 1+ncomments
end if
- if (ipbuf+lbuf(ilbuf).gt.65536) then
+ if (ipbuf+lbuf(ilbuf).gt.131072) then
print*,'Too many characters in file, stopping'
call stop1()
end if
@@ -1006,11 +1039,6 @@ c
c Check to see if (1) last line is "<blank><blank>/" and (2) next to last
c line is "/"
c
-c print*,'iplast:',iplast
-c print*,'Last line:'
-c print*,bufq(iplast+1-lbuf(nlbuf):iplast)
-c print*,'Last char of next to last line:'
-c print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf))
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>/"'
@@ -1109,9 +1137,6 @@ c
write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
call pmxb(.true.,poe0,ncalls,optimize)
-c itend = mytime()
-c print*,'Elapsed time in ms:',itend-itstart
-c write(15,*)'Elapsed time in ms:',itend-itstart
close(15)
end
subroutine accsym(nacc,acsymq,lacc)
@@ -1573,9 +1598,6 @@ c
if (endrest) then
return
end if
-c
-c print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time
-c
8 continue
naccbl(icm) = nusebl
if (nusebl .gt. 0) then
@@ -1883,6 +1905,7 @@ c
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.
@@ -1901,10 +1924,79 @@ c
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
@@ -1918,29 +2010,180 @@ c
else
call notefq(noteq,lnoten,nole,ncmid(iv,ip))
if (lnoten .eq. 1) call addblank(noteq,lnoten)
- lnote = lnoten+3
+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
+c write(11,'(a)')notexq(1:lnote)
+ end if
if (multip .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
+c if (btest(irest(ivx,ip-1),2)) 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
+ notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten)
+ 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
+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
+ 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
+ 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
+ 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
+ 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
- lnote = lnote+1
+ 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
- lnote = lnote+2
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+5
else if (multip .eq. -2) then
- notexq = sq//'wh'//noteq
+ notexq = sq//'wh'//noteq(1:lnoten)
+ lnote = lnoten+3
else if (multip .eq. -3) then
- notexq = sq//'breve'//noteq
- lnote = lnote+3
+ notexq = sq//'breve'//noteq(1:lnoten)
+ lnote = lnoten+6
else
print*
print*,'(Error in beamend, send source to Dr. Don)'
@@ -1957,17 +2200,27 @@ c
else if (multip .eq. -2) then
notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
end if
+ lnote = lnoten+3
end if
end if
- return
+ return
end if
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- lnote = 0
+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))
- * ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
+ 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
@@ -2012,14 +2265,67 @@ c
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)
+ call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
+ end if
else
c
c Terminate a sequence of jump-beam segments.
@@ -2038,12 +2344,50 @@ c if (isbjmp.and.ivx.eq.ivbj2
return
end if
c
-c And now the note
+c And now the note, checking for open-head beamed tremolo
c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
+ 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 (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)) ! Octave changes?
+ end if
+ 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
+ else
+c
+c No tremolo
+c
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
end if
lnote = lnote+3
isdotm = .false.
@@ -2063,10 +2407,8 @@ 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
-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
if (isbjmp .and. ivx.eq.ivbj2
@@ -2263,7 +2605,6 @@ c
call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
* nolev1(ivx),islope(ivx),slfac,
* xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
-c * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.)
* eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
* mult(ivx,ip),.false.)
end if
@@ -2287,10 +2628,43 @@ c
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
- if(.not.btest(irest(ivx,ip-1),24)
+ 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
@@ -2432,11 +2806,10 @@ c call istring(mod(ivbj1,12),tempq,len)
* nssb(nm),issb(nm),lev1ssb(nm,20)
common /comdraw/ drawbm(nm)
common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*8 noteq
+ character*8 noteq,tempq
character*79 notexq
ip1 = ipo(jn)
multip = iand(15,mult(ivx,ip1))-8
-c if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then
if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
lnote = 0
c
@@ -2471,8 +2844,93 @@ c
call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
if (lnoten .eq. 1) call addblank(noteq,lnoten)
lnote = 3
- if (multip .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ if (multip .le. 0) then
+c if (btest(irest(ivx,ip1),2) .and.
+c * nodur(ivx,ip1+1).ge.32) 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.
+c * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
+ * 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)
+ else
+ notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote)
+ end if
+ lnote = lnote+3+lnoten
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes?
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ 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))
+ 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
@@ -2527,12 +2985,46 @@ c
end if
end if
c
-c Put in the note
+c Check for beamed, dotted 2-note tremolo
c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
+ 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))
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ 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
+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
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'hb'
+ else
+ notexq = sq//'hb'
+ end if
else
- notexq = sq//'qb'
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
end if
lnote = lnote+3
c
@@ -2651,12 +3143,86 @@ c
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.
+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
+c numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4
+ 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
@@ -2665,7 +3231,9 @@ c
issb(ivx) = issb(ivx)+1
nolev1(ivx) = lev1ssb(ivx,issb(ivx))
end if
- lnote = 0
+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.
@@ -2715,8 +3283,13 @@ c
if (iud*iup .lt. 0) iflop = iup
end if
c
-c Determine if a beam is to be drawn
+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.
@@ -2730,15 +3303,29 @@ 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)),
-c * iup,irest(ivx,ipb1),usexnumt)
* iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
end if
if (.not.drawbm(ivx)) then
@@ -2829,25 +3416,11 @@ c beamstrt and beamn1 some non-spacing chars. are inserted.
c
c 130126 Deal with vertical shifts of rest starting xtuplet
c
-c if (multb .eq. 0) then
-c notexq = notexq(1:lnote)//sq//'qp'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.1) then
-c notexq = notexq(1:lnote)//sq//'ds'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.2) then
-c notexq = notexq(1:lnote)//sq//'qs'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.3) then
-c notexq = notexq(1:lnote)//sq//'hs'
-c lnote = lnote+3
-c else
-c notexq = notexq(1:lnote)//sq//'hpause'
-c lnote = lnote+7
-c end if
-
lrest = 3
- if (multb .eq. 0) then
+ 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'
@@ -2859,10 +3432,20 @@ c end if
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
- if (nole .eq. 0) then
+c if (nole .eq. 0) then
+ if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then
c
-c Rest is not raised
+c Rest blank or is not raised
c
notexq = notexq(1:lnote)//restq
lnote = lnote+lrest
@@ -3016,14 +3599,23 @@ c
flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
end if
end if
- call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote)
+ 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)
- call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1))
+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
@@ -3258,7 +3850,7 @@ 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,
data iTransAmt /nm*0/
end
subroutine catspace(space,squez,nnsk)
- parameter (nkb=3999,maxblks=4000)
+ 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)
@@ -4391,8 +4983,9 @@ c
end
subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
* islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
- * dotxtup,nacc)
+ * 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),
@@ -4427,10 +5020,10 @@ c
* 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)
-c
+ 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.
@@ -4453,10 +5046,86 @@ c
c
c Check for special situations with 2nds (see precrd).
c
- if (btest(nacc,30)) then
- if (nolev .eq. nolevm-1) nolev = nolevm
- else if (btest(nacc,31)) then
- if (nolev .eq. nolevm+1) nolev = nolevm
+ 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:
@@ -4467,43 +5136,38 @@ 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
+ 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,
+ 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
+ call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
end if
- end if
- if (btest(icrdat(icrd),26)) then
+ end if
+ end if
+ if (btest(icrdat(icrd),26)) then
c
-c Move the dot.
+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)
+ 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.)
-c
-c subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
-c * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt,
-c * notcrd,beamon,iscrd)
-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
@@ -4603,15 +5267,8 @@ c
c
c Use original saved pitch level, unaltered by 2nds logic.
c
-c 130316
-c call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)),
call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
-c * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.)
-c 130316
-c * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1.,
* igetbits(icrdat(icrd),3,20),midisig,1.,
-
-
* .false.,.false.)
end if
5 continue
@@ -4643,6 +5300,7 @@ c
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
@@ -4650,7 +5308,6 @@ 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
-c ivxtent = iand(idyndat(idyn),15)
ivxtent = iand(idyndat(idyn),15)
* +16*igetbits(idynda2(idyn),1,10)
if (ivxtent .eq. ivx) then
@@ -4664,8 +5321,6 @@ c I don't think there are any more possible for this ivx,ip, so exit loop
c
go to 2
end if
-c else if (ivxtent .gt. ivx) then
-c go to 2
end if
1 continue
2 continue
@@ -4709,7 +5364,14 @@ c
end if
else
hoffsd = -.5
- lbot = ihornb(ivx,nornb(ivx))+1
+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.
@@ -4761,7 +5423,7 @@ c
lnote = 7
if (idno .eq. 13) then
c
-c Start a hairpin
+c Start a font-based hairpin
c
notexq = chax(92)//'hpstrt'
else if (idno .eq. 14) then
@@ -4775,6 +5437,19 @@ 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
@@ -4788,19 +5463,37 @@ c
else
notexq = chax(92)//'Tcresc'
end if
- end if
- if (idno .ge. 13) then
+ 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 Put in voice number
+c Unrecord ID no for end of ps hairpin
+c
+ call setbits(ihairuse,1,idhair(ivx),0)
+ end if
c
- if (ivx .le. 9) then
- notexq = notexq(1:lnote)//char(48+ivx)
+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 (ivx .le. 19) then
- notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
+ 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+ivx)//'}'
+ notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}'
lnote = lnote+4
end if
end if
@@ -5095,14 +5788,14 @@ c
c
c Construct string to search backwards for placeholder
c
- if (ivx .le. 9) then
- tempq = 'cresc'//char(48+ivx)//'{ }'
+ if (idh .le. 9) then
+ tempq = 'cresc'//char(48+idh)//'{ }'
ltemp = 11
- else if (ivx .le. 19) then
- tempq = 'cresc'//'{1'//char(38+ivx)//'}{ }'
+ else if (idh .le. 19) then
+ tempq = 'cresc'//'{1'//char(38+idh)//'}{ }'
ltemp = 14
else
- tempq = 'cresc'//'{2'//char(28+ivx)//'}{ }'
+ tempq = 'cresc'//'{2'//char(28+idh)//'}{ }'
ltemp = 14
end if
write(11,'(a)')soutq(1:lsout)//'%'
@@ -5269,13 +5962,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
lnote = 4
end if
-c if (11-ndxslur .lt. 10) then
-c call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten,
-c * soutq,lsout)
-c else
-c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-c * 4+lnoten,soutq,lsout)
-c end if
call addstr(notexq(1:lnote)//noteq(1:lnoten),
* lnote+lnoten,soutq,lsout)
if (.not.fontslur) then
@@ -5363,12 +6049,10 @@ c
c
c Terminate slur on single after-grace
c
-c ndxslur = igetbits(ipl,4,23)
ndxslur = igetbits(ipl,5,23)
call notefq(noteq,lnoten,nolevg(ngs),ncm)
call addstr(sq//'tslur',6,soutq,lsout)
c
-cc Print 11-ndxslur
c Print 24-ndxslur
c
c if (11-ndxslur .lt. 10) then
@@ -5391,8 +6075,6 @@ c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
c
c+++ Try to fix loss of octave with single gaft
c
-c if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}',
-c * 13+lnoten,soutq,lsout)
if (isgaft) then
itrans = 0
do 1 i = 1 , lnotenGA
@@ -5505,7 +6187,7 @@ c
end if
end if
c
-c Print 11-ndxslur
+c Print 23-ndxslur
c
if (23-ndxslur .lt. 10) then
call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
@@ -5689,11 +6371,13 @@ 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.
@@ -5756,7 +6440,9 @@ c
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 * 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
@@ -5869,13 +6555,10 @@ c
c Get index of next slur not in use, starting from 12 down
c
ndxslur = log2(16777215-listslur)
-c write(*,'()')
-c write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur
c
c Record slur index
c
listslur = ibset(listslur,ndxslur)
-c write(*,'(10x,B24)')listslur
c
c Save for use on termination
c
@@ -5892,7 +6575,7 @@ c
else
ihoff = ihoff+2
end if
- end if
+ end if
if (iscrd) then
c
c Additional horiz shifts for h-shifted noteheads?
@@ -5963,19 +6646,15 @@ c notexq = chax(92)//'dotted'//noteq
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
@@ -5985,7 +6664,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
c
c Add note name to string
c
-c call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
islhgt = nolevs+iupdn+ivoff
call notefq(noteq,lnoten,islhgt,ncm)
notexq = notexq(1:lnote)//noteq(1:lnoten)
@@ -6045,7 +6723,9 @@ 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
+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
@@ -6063,7 +6743,6 @@ c
c
c Bugfix 070901 for slur ending on rest in 2-voice staff
c
-c if (nolevs.eq.0 .or. nolevs.gt.60) then
if (nolevs.le.2 .or. nolevs.gt.60) then
c
c Ending is on a rest, reset nolevs to default starting height
@@ -7432,7 +8111,7 @@ c
return
end
subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
- parameter (nkb=3999,maxblks=4000)
+ 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.
@@ -7531,7 +8210,7 @@ c fnote = nodur(ivx,iip)/float(iip-ip1m1)
print*,' '
call printl
* ('Probable misplaced barline or incorrect meter, stopping')
-c call printl('Program error in fnote, send source to Dr. Don')
+ print*,'ivx,ip:',ivx,ip
call stop1()
end
subroutine g1etchar(lineq,iccount,charq)
@@ -7567,7 +8246,7 @@ c
return
end
subroutine g1etnote(loop,ifig,optimize,fulltrans)
- parameter (nm=24,nkb=3999,mv=24576,maxblks=4000)
+ parameter (nm=24,nkb=3999,mv=24576,maxblks=9600)
character*1 chax
common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
* nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
@@ -7604,7 +8283,7 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
* restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
* debugmidi
logical debugmidi
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
logical novshrinktop,upslur,fontslur,ztrans,
@@ -7621,6 +8300,8 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
logical fulltrans
common /comsize/ isize(nm)
common /commidisig/ midisig
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
data literq
* /'Literal TeX string cannot start with 4 backslashes!',
* 'TeX string must have <129 char, end with backslash!',
@@ -7850,13 +8531,13 @@ 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
-c else if (durq .eq. 'S') then
else if (index('LS',durq) .gt. 0) then
c
c Stemlength change
@@ -7933,20 +8614,51 @@ c
c Will set all durations to 0 except last one.
c
call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
+ 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"!')
+ * 'First char after "x" in xtuplet must be "1"-"9" or "T"!')
call stop1()
end if
- call readnum(lineq,iccount,durq,fnum)
- if (fnum .gt. 99) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ if (durq .eq. 'T') then
+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()
+ 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.
@@ -8262,6 +8974,8 @@ c
* '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,
@@ -8486,18 +9200,10 @@ c
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
* 'In xtup, this character is not allowed!')
call stop1()
-c else if (durq.eq.'r' .and. itup.eq.ntup) then
-c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'Sorry, PMX cannot end an xtuplet with a rest!')
-c call stop1()
- else if (durq.eq.'r' .and. itup.eq.ntup .and.
- * index(lineq(iccount+1:iccount+2),'b').eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Sorry, PMX cannot end an xtuplet with a non-blank rest!')
- call stop1()
end if
7 call g1etchar(lineq,iccount,durq)
- if (index('2345678ulcb',durq) .gt. 0) then
+c if (index('2345678ulcb',durq) .gt. 0) then
+ if (index('12345678ulcb',durq) .gt. 0) then
go to 7
else if (index('sfn',durq) .gt. 0) then
c
@@ -8640,7 +9346,14 @@ c
iccount = iccount-1
end if
go to 2
- else if (durq .ne. ' ') then
+ 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)
@@ -9079,6 +9792,8 @@ c
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
@@ -9536,13 +10251,28 @@ c gotclef = .true.
* 'Repeats can only go in voice 1!')
call stop1()
end if
-10 call g1etchar(lineq,iccount,durq)
- if (index('lrdDbz',durq) .gt. 0) go to 10
- if (durq .ne. ' ') then
+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)!')
+ * '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
@@ -9640,7 +10370,16 @@ c
iccount = 128
else if (charq .eq. 'A') then
27 call g1etchar(lineq,iccount,durq)
- if (index('rbsdeK',durq) .gt. 0) then
+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.
@@ -9656,6 +10395,8 @@ c
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,
@@ -9669,6 +10410,8 @@ c
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
@@ -9771,10 +10514,38 @@ c
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 the letters abcdeiILNprRsST!')
+ * '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.'
@@ -9936,7 +10707,7 @@ 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 is ',lenbar
+ print*,'lenbar, timesofar are ',lenbar,itsofar(ivx)
call stop1()
else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
print*
@@ -10326,8 +11097,8 @@ c
end
subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
* xmtrnum0,newkey,npages,nsyst,musize,bottreb)
- parameter(nm=24,maxblks=4000)
- character*65536 bufq
+ parameter(nm=24,maxblks=9600)
+ character*131072 bufq
character*1 chax
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
@@ -10564,9 +11335,9 @@ c mytime = 1000*(ts+60*(im+60*ih))
c return
c end
subroutine getbuf(lineq)
- parameter (maxblks=4000)
+ parameter (maxblks=9600)
character*(*) lineq
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
@@ -11552,7 +12323,7 @@ c
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(40),ipage,
+ * 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,
@@ -11574,7 +12345,7 @@ c
* kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
common /combc/ bcspec
common /comas3/ ask(2500),iask,topmods
c
@@ -11634,8 +12405,11 @@ c
common /commidisig/ midisig
common /comlyr/ inputmlyr
logical inputmlyr
- data inputmlyr /.false./
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ logical inxtup
cdot = .false.
+ inxtup = .false.
1 call getchar(lineq,iccount,charq)
if (lastchar) return
if (charq .eq. ' ') go to 1
@@ -11825,11 +12599,15 @@ c
c
c Accidental
c
- if (nacc(ivx,nnl(ivx)) .eq. 0) then
+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
- nacc(ivx,nnl(ivx)) = index('fsn',durq)
+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
@@ -11878,8 +12656,8 @@ 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-2
- go to 2
+ iccount = iccount-1
+c go to 2
end if
nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
c
@@ -11898,17 +12676,86 @@ c
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
+c Next input will be digit unless its a "T"
c
iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- ntup = nint(fnum)
+ 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
@@ -12292,12 +13139,8 @@ c
c 140218 Need to get time differently inside xtup, since itsofar doesn't get
c updated until after xtup is done
c
-c tcc(iv,ncc(iv)) = itsofar(iv)
nodurt = ifnodur(nnodur,dotq)
tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1))
-c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:'
-c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv))
-c isl = ibset(islur(iv,nnl(iv)+1),11)
isl = ibset(islur(iv,nnl(iv)),11)
call getchar(lineq,iccount,durq)
c
@@ -12307,7 +13150,7 @@ c
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)) = 7+iTransAmt(instno(iv))
end if
c
c Set marker on note with lowest voice # starting at same time.
@@ -12379,6 +13222,12 @@ c
else
nolev(ivx,nnl(ivx)) = 2
end if
+c end if
+ else
+c
+c Counter for non-rests
+c
+ nnb = nnb+1
end if
notcrd = .true.
8 call getchar(lineq,iccount,durq)
@@ -12396,11 +13245,16 @@ c
end if
end if
else if (index('fsn',durq) .gt. 0) then
- if (nacc(ivx,nnl(ivx)) .eq. 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
- nacc(ivx,nnl(ivx)) = index('fsn',durq)
+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
@@ -12541,7 +13395,6 @@ c
ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
go to 2
-c else if (durq .eq. 'S') then
else if (index('LS',durq) .gt. 0) then
c
c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5
@@ -12629,6 +13482,16 @@ c
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)
@@ -12652,6 +13515,17 @@ 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
+c ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19)
+ islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18)
end if
if (idotform .gt. 0) then
if (idotform .eq. 1) then
@@ -13441,9 +14315,18 @@ c
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)) = 7+iTransAmt(instno(iv))
+ lastlev = lastlev+7
else
- if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0
+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
+ print*,'Reset itransamt to ',iTransAmt(instno(iv))
+ end if
end if
c
c Set marker on note with lowest voice # starting at same time.
@@ -13826,6 +14709,20 @@ 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
@@ -14308,14 +15205,14 @@ 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=4000,nm=24)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
logical fexist,global
@@ -15280,12 +16177,10 @@ c
c
c Forced multiplicity
c
-c mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22)
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
-c mult(ivx,iip) = 4-log2(nodur(ivx,iip))
call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8)
else
c
@@ -15305,7 +16200,6 @@ c
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
-c mult(ivx,iiip) = multx
call setbits(mult(ivx,iiip),4,0,multx+8)
c
c Note the following still works after making mult only the 1st 4 bits.
@@ -15367,13 +16261,13 @@ 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=4000)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
lbuf(1) = lbuf(1)
@@ -15443,7 +16337,7 @@ c
logical upg,slurg,slashg,autofbon
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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)
@@ -15843,21 +16737,6 @@ c
end if
30 continue
c
-c Debug writes
-c
-c print*
-c write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot)
-c print*,'PMXB has now got blocks'
-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 write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
-cc write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048,
-c * in=1,ntot)
-c write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot)
-c
-c
c Analyze for beams.
c
do 20 iv = 1 , nv
@@ -16004,10 +16883,10 @@ c
logical upg,slurg,slashg,issig,rpndot,autofbon
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
+ character*1 ulfbq,udqq,clefq(nm),slurudq,udq
character*8 noteq
character*79 cwrq(nm),notexq,inameq
character*20 voltxtq
@@ -16157,10 +17036,10 @@ c
c if (clefq(ivxo(in)) .eq. '8') then
if (btest(ipl(ivxo(in),ipo(in)),2)) then
if (iv .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
end if
end if
@@ -16545,8 +17424,12 @@ c
if (isaccs .or. iscacc) then
ptsneed = ptsneed+taccfac*wheadpt1
end if
- if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed,
+c if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed,
+c * esk,fixednew,scaldold,0.,.false.)
+ if (poenom*esk .lt. ptsneed) then
+ call addask(to(in),ptsneed,
* esk,fixednew,scaldold,0.,.false.)
+ end if
99 continue
if (btest(iornq(ivx,ip),26)) then
c
@@ -16758,7 +17641,6 @@ c
c Check for new clef here.
c
if (isclef .and. btest(islur(ivx,ip),11)) then
-c print*,'At clef insertion, ptclef:',ptclef(iv)
if (ptclef(iv) .gt. 0.) then
notexq = sq//'off{-'
if (ptclef(iv) .lt. 9.95) then
@@ -16771,7 +17653,6 @@ c print*,'At clef insertion, ptclef:',ptclef(iv)
notexq = notexq(1:lnote)//'pt}'
lnote = lnote+3
call addstr(notexq,lnote,soutq,lsout)
-c print*,'Just added: ',notexq(1:lnote)
end if
call clefsym(islur(iv,ip),notexq,lnote,nclef)
c
@@ -17050,7 +17931,28 @@ 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)
-c else if (mult(ivx,ip) .lt. 0) then
+cc else if (iand(mult(ivx,ip),15)-8 .lt. 0) then
+c else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or.
+c * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or.
+c * (ip.gt.1.and.btest(irest(ivx,ip-1),2)
+c * .and.nodur(ivx,ip).eq.32)) then
+c nodu = 32
+c else
+c nodu = 16
+c end if
+ 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
@@ -17059,7 +17961,8 @@ c else if (mult(ivx,ip) .lt. 0) then
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))
+ * btest(nacc(ivx,ip),27),nacc(ivx,ip),
+ * irest)
end if
c
c Now that chords are done, add stuff to midi file
@@ -17179,7 +18082,9 @@ c
end if
end if
c
-c Check for dotted notes with moved dots
+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
@@ -17290,106 +18195,58 @@ 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)
-cc 4. Not last note in bar
-cc 5. Followed by note (add better test later)
c
if (kbdrests .and. btest(irest(ivx,ip),0) .and.
* .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
-c * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx)
-c * .and. .not.(btest(irest(ivx,ip+1),0))) then
* 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 130127 Replaced following code with a subroutine
+c Deal with single stem tremolo
+c Get up-downness, borrowed from notex
c
-cc Get reference level: next following note if no intervening blank rests,
-cc otherwise next prior note.
-cc
-cc levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line
-c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
-cc
-cc Not the last note and not "look-left" for level
-cc
-c do 8 kkp = ip+1 , nn(ivx)
-c if (btest(islur(ivx,kkp),29)) go to 4
-c if (.not.btest(irest(ivx,kkp),0)) then
-c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c go to 9
-c end if
-c8 continue
-c end if
-c4 continue
-cc
-cc If here, there were no following notes or came to a blank rest, or
-cc "look-left" option set. So look before
-cc
-c if (ip .eq. 1) go to 2 ! Get out if this is the first note.
-c do 3 kkp = ip-1, 1, -1
-c if (.not.btest(irest(ivx,kkp),0)) then
-c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c go to 9
-c end if
-c3 continue
-c go to 2 ! Pretty odd, should never be here, but get out if so.
-c9 continue
-cc
-cc Find note in other voice at same time
-cc
-c iupdown = sign(1,ivx-nv-1)
-c ivother = ivmx(iv,(3-iupdown)/2)
-c tother = 0.
-c do 5 kkp = 1 , nib(ivother,ibar)
-c if (abs(tother-tnow) .lt. tol) go to 6
-c tother = tother+nodur(ivother,kkp)
-c5 continue
-cc
-cc If here, then no note starts in other voice at same time, so set default
-cc
-c levother = -iupdown*50
-c go to 7
-c6 continue
-cc
-cc If here, have just identified a simultaneous note or rest in other voice
-cc
-c if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
-c levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
-c else
-c if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-cc
-cc Rest in other voice has same duration, get out (so defualt spacing is used)
-cc
-c go to 2
-c end if
-c levother = -iupdown*50
-c end if
-c7 continue
-c indxr = log2(nodur(ivx,ip))+1
-c if (iupdown .lt. 0) then
-c levtop = levtopr(indxr)
-c iraise1 = levother-levtop-3 ! Based on other note
-c iraise2 = levnext-levtop ! Based on following note
-c if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
-c iraise = min(iraise1,iraise2)
-c if (mod(iraise+50,2).eq.1 .and.
-c * iraise+levtop.gt.-1) iraise = iraise-1
-c else
-c levbot = levbotr(indxr)
-c iraise1 = levother-levbot+3
-c iraise2 = levnext-levbot
-c if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
-c iraise = max(iraise1,iraise2)
-c if (mod(iraise+50,2).eq.1 .and.
-c * iraise+levbot.le.9) iraise = iraise-1
-c end if
-c nolev(ivx,ip) = 100+iraise
+ 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 The new subroutine call, to replace above code
+c Get a numerical pitch argument
c
- call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr,
- * mult,ipl)
+ 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 Write a separate note or rest
+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
@@ -17401,8 +18258,9 @@ c
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)
- * call addstr(notexq,lnote,soutq,lsout)
+ 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
@@ -17815,7 +18673,7 @@ 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=4000)
+ 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),
@@ -18117,13 +18975,13 @@ 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=4000)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
if (.not.mrecord) then
@@ -18165,7 +19023,7 @@ c
character*1 ulq,sepsymq,sq
logical beamon,firstgulp,figbass,figchk,isfig
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
@@ -18187,23 +19045,6 @@ c
c Return middle line of a clef
c
character*1 clefq
-c if (clefq.eq.'t' .or. clefq.eq.'0') then
-c ncmidf = 35
-c else if (clefq.eq.'s' .or. clefq.eq.'1') then
-c ncmidf = 33
-c else if (clefq.eq.'m' .or. clefq.eq.'2') then
-c ncmidf = 31
-c else if (clefq.eq.'a' .or. clefq.eq.'3') then
-c ncmidf = 29
-c else if (clefq.eq.'n' .or. clefq.eq.'4') then
-c ncmidf = 27
-c else if (clefq.eq.'r' .or. clefq.eq.'5') then
-c ncmidf = 25
-c else if (clefq.eq.'f' .or. clefq.eq.'7') then
-c ncmidf = 37
-c else
-c ncmidf = 23
-c end if
if (clefq .eq. '8') then
c
c treblelowoct; will treat as treble for this purpose
@@ -18232,7 +19073,7 @@ c
* tautofb,autofbon,t1autofb
character*1 ulfbq,clefq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
@@ -18480,20 +19321,14 @@ c
restq =sq//'qqs'
lrest = 4
end if
-c if (2**log2(nodu) .ne. nodu) then
-cc
-cc One or two dots on rest
-cc
-c restq = restq(1:3)//'p'
-c lrest = 4
-c if (2*nodu .gt. 3*2**log2(nodu)) then
-cc
-cc Double dotted rest
-cc
-c restq = restq(1:4)//'p'
-c lrest = 5
-c end if
-c 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
@@ -18513,19 +19348,8 @@ c
notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
end if
lnote = 16+lnoten
-c if (2**log2(nodu) .ne. nodu) then
-cc
-cc Have dot in raised rest. must put in hbox!
-cc
-c notexq = notexq(1:lnote)//sq//'hbox{'
-c lnote = lnote+6
-c end if
notexq = notexq(1:lnote)//restq(1:lrest)
lnote = lnote+lrest
-c if (2**log2(nodu) .ne. nodu) then
-c notexq = notexq(1:lnote)//'}'
-c lnote = lnote+1
-c end if
end if
if (2**log2(nodu) .ne. nodu) then
c
@@ -18561,9 +19385,6 @@ c * (nole.lt.0.or.nole.gt.8)) then
* sq//'hbox{'//restq(1:lrest)//'}'
lrest = lrest+23
end if
-
-
-
notexq = restq(1:lrest)//notexq(1:lnote)
lnote = lnote+lrest
end if
@@ -18803,9 +19624,9 @@ 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=4000)
+ parameter (nm=24,nkb=3999,nks=125,maxblks=9600)
logical loop,usefig,isfirst,optimize
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
integer nn(nm),nodur(nm,200),ivxo(600),ipo(600),
@@ -18854,8 +19675,12 @@ c logical mrecord,mplay,endmac,gotclef,cstuplet
* instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
logical EarlyTransOn,LaterInstTrans
logical fulltrans
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
data wtimesig,wclef,wkeysig
* / 0.72 , 0.8 , 0.28 /
+ is4bignv = .false.
+ AIset = .false.
whead20 = 0.3
if (.not.optimize) then
print*
@@ -19399,7 +20224,6 @@ c * 'In system #',isyst,' cannot meet min. space rqmt'
c
c Find eonk by Newton method
c
-c eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0))
call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1,
* wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax,
* (wminpt-elmin0)/(elmin1-elmin0))
@@ -19556,7 +20380,7 @@ 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=4000)
+ parameter (nm=24,nks=125,mv=24576,maxblks=9600)
c
c FYI /all/ differs in appearance in function ncmid
c
@@ -19604,20 +20428,19 @@ c 31 If on, suppress printing number with xtuplet starting here
ccccccccccccc
cc ipl cc
ccccccccccccc
-cc 0-7 Location in list [0,200]
-cc 0-7 Unused
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
-cc 2-7 Unused
-c 3-7 unused
+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.
-cc 27 Unused?
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)
@@ -19655,8 +20478,9 @@ 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 Moved hgt shft to mult 16-22, so could span -64,64.
-cc 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n'
+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
@@ -19782,7 +20606,7 @@ c
c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
c
cccccccccccccccccccccccccccccccc
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
character*10 figq
@@ -19794,7 +20618,7 @@ cccccccccccccccccccccccccccccccc
logical loop,lastchar,slint,svolta,evolta,onvolt,
* cwrest(nm),islast,inlast,optimize
integer istop(80),numbms(nm),istart(80)
- real*4 xnsttop(40),xintstaff(40),hesk(23),hpts(23),poevec(nks),
+ 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
@@ -19821,7 +20645,7 @@ cccccccccccccccccccccccccccccccc
* rptprev,equalize,rptfq1,rptfq2
common /combeam/ ibmtyp
common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
- * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage,
+ * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
* OptLineBreakTies,HeaderSpecial
common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
* isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
@@ -19851,7 +20675,7 @@ cccccccccccccccccccccccccccccccc
* ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb,
* btest,sluron,setis,nobar1
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
common /compoi/ ispoi
common /combc/ bcspec
common /comeon/ eonk,ewmxk
@@ -19901,6 +20725,14 @@ cccccccccccccccccccccccccccccccc
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)
+ bottopgap = .false.
+ inputmlyr = .false.
+ idhairuse = 0
if (.not.optimize) then
print*
print*,'Starting second PMX pass'
@@ -20191,6 +21023,7 @@ c
nvolt = 0
do 28 iv = 1 , nm
nudoff(iv) = 0
+ maxdotmv(iv) = ndotmv(iv)
ndotmv(iv) = 0
28 continue
c
@@ -20387,10 +21220,10 @@ c
c if (clefq(iv) .eq. '8') then
if (btest(ipl(iv,ioff+1),2)) then
if (iv .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
end if
else
@@ -20843,6 +21676,21 @@ c second pass, vshrink at top of page one is dealt with in topfile, which is ca
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)'
@@ -20851,6 +21699,22 @@ c
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) write(11,'(a)') sq//'vfill'//sq//'eject%'
end if
@@ -20878,6 +21742,7 @@ c
c
c Vertical spacing parameters, then restart
c
+ if (is4bignv) xinsnow = .95*xinsnow
if (islast) write(11,fmtq)sq//'interstaff{',xinsnow,
* '}'//sq//'contpiece'
c
@@ -21162,8 +22027,6 @@ c
ipl(ivx,ip) = ipl(ivx,ip+ioff)
iornq(ivx,ip) = iornq(ivx,ip+ioff)
mult(ivx,ip) = mult(ivx,ip+ioff)
-c if (ivx.le.2 .and. figbass)
-c * isfig(ivx,ip) = isfig(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)
@@ -21204,7 +22067,6 @@ c
* iptrill(it)+nib(ivtrill(it),ibar-2)
22 continue
do 27 icrd = 1 , ncrd
-c ivx = iand(15,ishft(icrdat(icrd),-8))
ivx = iand(15,ishft(icrdat(icrd),-8))
* +16*igetbits(icrdat(icrd),1,28)
ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1)
@@ -21213,7 +22075,6 @@ c ivx = iand(15,ishft(icrdat(icrd),-8))
icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd))
27 continue
do 29 iudorn = 1 , nudorn
-c ivx = iand(15,ishft(kudorn(iudorn),-8))
ivx = ivxudorn(iudorn)
ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1)
if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
@@ -21222,7 +22083,6 @@ c ivx = iand(15,ishft(kudorn(iudorn),-8))
29 continue
do 42 idyn = 1 , ndyn
idynd = idyndat(idyn)
-c ivx = iand(15,idynd)
ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10)
ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
c
@@ -21237,9 +22097,7 @@ c
42 continue
do 43 itxtdyn = 1 , ntxtdyn
idynd = ivxiptxt(itxtdyn)
-c ivx = iand(15,idynd)
ivx = iand(31,idynd)
-c ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1)
if (ibar .gt. 2) then
ipnew = ipnew+nib(ivx,ibar-2)
@@ -21261,7 +22119,6 @@ c call setbits(idynd,8,4,ipnew)
isdat1(isdat) = isdata
41 continue
do 44 ibc = 1 , nbc
-c ivx = iand(15,ibcdata(ibc))
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
@@ -21397,7 +22254,6 @@ c
else if (rptfq2 .eq. 'z') then
if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece'
else
-c else if (rptfq2 .ne. 'D') then
print*
print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
@@ -21407,6 +22263,21 @@ c else if (rptfq2 .ne. 'D') then
if (islast) write(11,'(a)')sq//'Endpiece'
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)'
@@ -21763,9 +22634,6 @@ c
c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp)
levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp)
invert = -levbot+4+nolev-ncm
-c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:'
-c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp),
-c *levbot,nolev,ncm
end if
c
c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote
@@ -22631,11 +23499,10 @@ c
c
c Only print number when wanted. First check vert, horiz offset
c
-c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16
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
+ if (.not.usexnumt) then
notexq = chax(92)//'xnum{'
lnote = 10
istrtn = 7
@@ -22668,8 +23535,8 @@ c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16
return
end
subroutine read10(string,lastchar)
- parameter (maxblks=4000)
- character*65536 bufq
+ parameter (maxblks=9600)
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
character*(*) string
@@ -22869,11 +23736,6 @@ c
c Sets iwidbits of isdata, shifted by ishift, to ivalue
c
ibase = 2**iwidbit-1
- if (ivalue.gt.ibase) then
- print*
- print*,'WARNING in setbits: ivalue > ibase'
- write(15,'(/,a)')'WARNING in setbits: ivalue > ibase'
- end if
isdata = iand(not(ishft(ibase,ishift)),isdata)
isdata = ior(isdata,ishft(ivalue,ishift))
return
@@ -22976,9 +23838,6 @@ c
call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
* 'Macro number not in range 1-20!')
call stop1()
-c else if (btest(macuse,macnum)) then
-c print*
-c print*,'WARNING: Redefining macro # ',macnum
end if
macuse = ibset(macuse,macnum)
if (charq .eq. 'R') then
@@ -23038,6 +23897,12 @@ c
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
@@ -23168,11 +24033,12 @@ c Reset nxtinbm for use as counter as #'s are posted by putxtn(..)
c
nxtinbm(ivx) = 0
smed = 0.
- if (.not.btest(islur(ivx,ipb(1)),2)) then
+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
- if (nnb .eq. 1) go to 6
+c if (nnb .eq. 1) go to 6
nsc = 0
do 5 inb = 1 , nnb-1
do 5 jnb = inb+1 , nnb
@@ -23245,12 +24111,10 @@ c
if (ulq(ivx,ibc) .eq. 'u') iul = 1
ssq = 0.
syb = 0.
-c yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1))
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
-c * -iul*bmhgt*(mult(ivx,ipb(inb))-1)
* -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1)
syb = syb+ybeam
ynote = nolev(ivx,ipb(inb))
@@ -23275,7 +24139,9 @@ c * -iul*bmhgt*(mult(ivx,ipb(inb))-1)
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)
- * .and. .not.btest(islur(ivx,ipb(1)),2)) then
+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.
@@ -23286,7 +24152,6 @@ c
c
c Check if beam starts or ends too high or low.
c
-c xboff = bmhgt*(mult(ivx,ipb(1))-1)
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)
@@ -23304,7 +24169,8 @@ c
c
c Since one or the other end has changed, need to change slope
c
- if (.not.btest(islur(ivx,ipb(1)),2))
+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
@@ -23407,6 +24273,13 @@ 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
@@ -23415,7 +24288,9 @@ 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 * 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
@@ -23829,6 +24704,8 @@ c
* instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
logical EarlyTransOn,LaterInstTrans
common /comsize/ isize(nm)
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
sq = chax(92)
vshrink = xinstf1.gt.20. .and. .not.novshrinktop
if (vshrink) then
@@ -23948,7 +24825,7 @@ c
clefqiv = clefq(iv)
if (clefqiv.eq.'8') then
clefqiv='t'
- iTransAmt(instno(iv)) = 7
+ iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
end if
if (nstaves .eq. 1) then
fmtq = chax(48+numclef(clefq(iv)))
@@ -24011,8 +24888,10 @@ c
else
fmtq = '(a,f4.1,a)'
end if
+ facis = 1.
+ if (is4bignv) facis = .95
write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt'
- * //sq//'interstaff{',xinstf1,'}'//sq//'relax'
+ * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax'
else
write(11,'(a)')sq//'stafftopmarg0pt'//
* sq//'staffbotmarg5'//sq//'Interligne'//sq//
@@ -24104,7 +24983,7 @@ c
upcaseq = chq
print*,'Warning, upcaseq was called with improper argument: '
* //chq
- stop
+ stop
end if
return
end
@@ -24266,25 +25145,6 @@ c
kv = 1
end if
c
-c Moved to pmxab to allow midivel, bal, tran as functions of instrument
-c rather than staff (iv)
-cc
-cc Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv)
-cc
-c nstaves = 0
-c ivt = 0
-c do 12 iinst = 1 , nm
-c nstaves = nstaves+nsperi(iinst)
-c do 13 ivtt = 1 , nsperi(iinst)
-c ivt = ivt+1
-c iinsiv(ivt) = iinst
-c13 continue
-c if (nstaves .eq. nv) go to 14
-c12 continue
-c print*,'Screwup!'
-c call stop1()
-c14 continue
-c
do 5 icm = 0 , numchan-1
c
c Get the number of bytes in the data stream
@@ -24294,10 +25154,8 @@ c
ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec)
11 continue
c
-cc Add 3 (for instrum) plus 4 (for closing) to byte count,
c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count,
c
-c ndata = ndata+7
ndata = ndata+11
c
c Add 4+lnam(iinsiv(iv)) if lnam>0 ,
@@ -24543,7 +25401,7 @@ c (unless preceded with '\'), check length
c
character*128 lineq,lineqt
character*1 sq
- data sq /'\'/
+ sq = '\'
iend = lenstr(lineq,128)
c
c i2nd = iccount+index(lineq(iccount+1:128),'"')
diff --git a/Build/source/utils/pmx/pmx-src/pmx276.for.orig b/Build/source/utils/pmx/pmx-src/pmx284.for.orig
index 0ef9353f24d..2e331296c98 100644
--- a/Build/source/utils/pmx/pmx-src/pmx276.for.orig
+++ b/Build/source/utils/pmx/pmx-src/pmx284.for.orig
@@ -63,6 +63,39 @@ 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.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.
@@ -717,9 +750,9 @@ c Command line input
c Option Ao to optimize, otherwise normal processing
c
ccccccc
- parameter (nks=125,nm=24,mv=24576,maxblks=4000)
+ parameter (nks=125,nm=24,mv=24576,maxblks=9600)
character*128 lnholdq
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /comevent/ miditime,lasttime
logical slmon,dbltie
@@ -769,8 +802,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording).
c
ccccccccccccccccccccccccc
c
- data date /'24 Nov 16'/
- data version /'2.76'/
+ data date /'10 Feb 18'/
+ data version /'2.84'/
c
ccccccccccccccccccccccccc
data maxit,ncalls /200,0/
@@ -908,7 +941,7 @@ c
else
linewcom(1) = 1+ncomments
end if
- if (ipbuf+lbuf(ilbuf).gt.65536) then
+ if (ipbuf+lbuf(ilbuf).gt.131072) then
print*,'Too many characters in file, stopping'
call stop1()
end if
@@ -1006,11 +1039,6 @@ c
c Check to see if (1) last line is "<blank><blank>/" and (2) next to last
c line is "/"
c
-c print*,'iplast:',iplast
-c print*,'Last line:'
-c print*,bufq(iplast+1-lbuf(nlbuf):iplast)
-c print*,'Last char of next to last line:'
-c print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf))
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>/"'
@@ -1109,9 +1137,6 @@ c
write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
call pmxb(.true.,poe0,ncalls,optimize)
-c itend = mytime()
-c print*,'Elapsed time in ms:',itend-itstart
-c write(15,*)'Elapsed time in ms:',itend-itstart
close(15)
end
subroutine accsym(nacc,acsymq,lacc)
@@ -1573,9 +1598,6 @@ c
if (endrest) then
return
end if
-c
-c print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time
-c
8 continue
naccbl(icm) = nusebl
if (nusebl .gt. 0) then
@@ -1883,6 +1905,7 @@ c
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.
@@ -1901,10 +1924,79 @@ c
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
@@ -1918,29 +2010,180 @@ c
else
call notefq(noteq,lnoten,nole,ncmid(iv,ip))
if (lnoten .eq. 1) call addblank(noteq,lnoten)
- lnote = lnoten+3
+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
+c write(11,'(a)')notexq(1:lnote)
+ end if
if (multip .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
+c if (btest(irest(ivx,ip-1),2)) 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
+ notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten)
+ 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
+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
+ 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
+ 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
+ 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
+ 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
- lnote = lnote+1
+ 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
- lnote = lnote+2
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+5
else if (multip .eq. -2) then
- notexq = sq//'wh'//noteq
+ notexq = sq//'wh'//noteq(1:lnoten)
+ lnote = lnoten+3
else if (multip .eq. -3) then
- notexq = sq//'breve'//noteq
- lnote = lnote+3
+ notexq = sq//'breve'//noteq(1:lnoten)
+ lnote = lnoten+6
else
print*
print*,'(Error in beamend, send source to Dr. Don)'
@@ -1957,17 +2200,27 @@ c
else if (multip .eq. -2) then
notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
end if
+ lnote = lnoten+3
end if
end if
- return
+ return
end if
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- lnote = 0
+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))
- * ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
+ 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
@@ -2012,14 +2265,67 @@ c
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)
+ call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
+ end if
else
c
c Terminate a sequence of jump-beam segments.
@@ -2038,12 +2344,50 @@ c if (isbjmp.and.ivx.eq.ivbj2
return
end if
c
-c And now the note
+c And now the note, checking for open-head beamed tremolo
c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
+ 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 (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)) ! Octave changes?
+ end if
+ 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
+ else
+c
+c No tremolo
+c
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
end if
lnote = lnote+3
isdotm = .false.
@@ -2063,10 +2407,8 @@ 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
-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
if (isbjmp .and. ivx.eq.ivbj2
@@ -2263,7 +2605,6 @@ c
call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
* nolev1(ivx),islope(ivx),slfac,
* xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
-c * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.)
* eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
* mult(ivx,ip),.false.)
end if
@@ -2287,10 +2628,43 @@ c
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
- if(.not.btest(irest(ivx,ip-1),24)
+ 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
@@ -2432,11 +2806,10 @@ c call istring(mod(ivbj1,12),tempq,len)
* nssb(nm),issb(nm),lev1ssb(nm,20)
common /comdraw/ drawbm(nm)
common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*8 noteq
+ character*8 noteq,tempq
character*79 notexq
ip1 = ipo(jn)
multip = iand(15,mult(ivx,ip1))-8
-c if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then
if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
lnote = 0
c
@@ -2471,8 +2844,93 @@ c
call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
if (lnoten .eq. 1) call addblank(noteq,lnoten)
lnote = 3
- if (multip .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ if (multip .le. 0) then
+c if (btest(irest(ivx,ip1),2) .and.
+c * nodur(ivx,ip1+1).ge.32) 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.
+c * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
+ * 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)
+ else
+ notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote)
+ end if
+ lnote = lnote+3+lnoten
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes?
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ 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))
+ 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
@@ -2527,12 +2985,46 @@ c
end if
end if
c
-c Put in the note
+c Check for beamed, dotted 2-note tremolo
c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
+ 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))
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ 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
+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
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'hb'
+ else
+ notexq = sq//'hb'
+ end if
else
- notexq = sq//'qb'
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
end if
lnote = lnote+3
c
@@ -2651,12 +3143,86 @@ c
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.
+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
+c numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4
+ 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
@@ -2665,7 +3231,9 @@ c
issb(ivx) = issb(ivx)+1
nolev1(ivx) = lev1ssb(ivx,issb(ivx))
end if
- lnote = 0
+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.
@@ -2715,8 +3283,13 @@ c
if (iud*iup .lt. 0) iflop = iup
end if
c
-c Determine if a beam is to be drawn
+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.
@@ -2730,15 +3303,29 @@ 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)),
-c * iup,irest(ivx,ipb1),usexnumt)
* iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
end if
if (.not.drawbm(ivx)) then
@@ -2829,25 +3416,11 @@ c beamstrt and beamn1 some non-spacing chars. are inserted.
c
c 130126 Deal with vertical shifts of rest starting xtuplet
c
-c if (multb .eq. 0) then
-c notexq = notexq(1:lnote)//sq//'qp'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.1) then
-c notexq = notexq(1:lnote)//sq//'ds'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.2) then
-c notexq = notexq(1:lnote)//sq//'qs'
-c lnote = lnote+3
-c else if (.not.drawbm(ivx).and.multb.eq.3) then
-c notexq = notexq(1:lnote)//sq//'hs'
-c lnote = lnote+3
-c else
-c notexq = notexq(1:lnote)//sq//'hpause'
-c lnote = lnote+7
-c end if
-
lrest = 3
- if (multb .eq. 0) then
+ 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'
@@ -2859,10 +3432,20 @@ c end if
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
- if (nole .eq. 0) then
+c if (nole .eq. 0) then
+ if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then
c
-c Rest is not raised
+c Rest blank or is not raised
c
notexq = notexq(1:lnote)//restq
lnote = lnote+lrest
@@ -3016,14 +3599,23 @@ c
flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
end if
end if
- call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote)
+ 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)
- call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1))
+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
@@ -3258,7 +3850,7 @@ 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,
data iTransAmt /nm*0/
end
subroutine catspace(space,squez,nnsk)
- parameter (nkb=3999,maxblks=4000)
+ 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)
@@ -4391,8 +4983,9 @@ c
end
subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
* islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
- * dotxtup,nacc)
+ * 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),
@@ -4427,10 +5020,10 @@ c
* 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)
-c
+ 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.
@@ -4453,10 +5046,86 @@ c
c
c Check for special situations with 2nds (see precrd).
c
- if (btest(nacc,30)) then
- if (nolev .eq. nolevm-1) nolev = nolevm
- else if (btest(nacc,31)) then
- if (nolev .eq. nolevm+1) nolev = nolevm
+ 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:
@@ -4467,43 +5136,38 @@ 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
+ 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,
+ 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
+ call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
end if
- end if
- if (btest(icrdat(icrd),26)) then
+ end if
+ end if
+ if (btest(icrdat(icrd),26)) then
c
-c Move the dot.
+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)
+ 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.)
-c
-c subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
-c * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt,
-c * notcrd,beamon,iscrd)
-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
@@ -4603,15 +5267,8 @@ c
c
c Use original saved pitch level, unaltered by 2nds logic.
c
-c 130316
-c call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)),
call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
-c * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.)
-c 130316
-c * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1.,
* igetbits(icrdat(icrd),3,20),midisig,1.,
-
-
* .false.,.false.)
end if
5 continue
@@ -4643,6 +5300,7 @@ c
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
@@ -4650,7 +5308,6 @@ 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
-c ivxtent = iand(idyndat(idyn),15)
ivxtent = iand(idyndat(idyn),15)
* +16*igetbits(idynda2(idyn),1,10)
if (ivxtent .eq. ivx) then
@@ -4664,8 +5321,6 @@ c I don't think there are any more possible for this ivx,ip, so exit loop
c
go to 2
end if
-c else if (ivxtent .gt. ivx) then
-c go to 2
end if
1 continue
2 continue
@@ -4709,7 +5364,14 @@ c
end if
else
hoffsd = -.5
- lbot = ihornb(ivx,nornb(ivx))+1
+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.
@@ -4761,7 +5423,7 @@ c
lnote = 7
if (idno .eq. 13) then
c
-c Start a hairpin
+c Start a font-based hairpin
c
notexq = chax(92)//'hpstrt'
else if (idno .eq. 14) then
@@ -4775,6 +5437,19 @@ 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
@@ -4788,19 +5463,37 @@ c
else
notexq = chax(92)//'Tcresc'
end if
- end if
- if (idno .ge. 13) then
+ 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 Put in voice number
+c Unrecord ID no for end of ps hairpin
+c
+ call setbits(ihairuse,1,idhair(ivx),0)
+ end if
c
- if (ivx .le. 9) then
- notexq = notexq(1:lnote)//char(48+ivx)
+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 (ivx .le. 19) then
- notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
+ 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+ivx)//'}'
+ notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}'
lnote = lnote+4
end if
end if
@@ -5095,14 +5788,14 @@ c
c
c Construct string to search backwards for placeholder
c
- if (ivx .le. 9) then
- tempq = 'cresc'//char(48+ivx)//'{ }'
+ if (idh .le. 9) then
+ tempq = 'cresc'//char(48+idh)//'{ }'
ltemp = 11
- else if (ivx .le. 19) then
- tempq = 'cresc'//'{1'//char(38+ivx)//'}{ }'
+ else if (idh .le. 19) then
+ tempq = 'cresc'//'{1'//char(38+idh)//'}{ }'
ltemp = 14
else
- tempq = 'cresc'//'{2'//char(28+ivx)//'}{ }'
+ tempq = 'cresc'//'{2'//char(28+idh)//'}{ }'
ltemp = 14
end if
write(11,'(a)')soutq(1:lsout)//'%'
@@ -5269,13 +5962,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
lnote = 4
end if
-c if (11-ndxslur .lt. 10) then
-c call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten,
-c * soutq,lsout)
-c else
-c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
-c * 4+lnoten,soutq,lsout)
-c end if
call addstr(notexq(1:lnote)//noteq(1:lnoten),
* lnote+lnoten,soutq,lsout)
if (.not.fontslur) then
@@ -5363,12 +6049,10 @@ c
c
c Terminate slur on single after-grace
c
-c ndxslur = igetbits(ipl,4,23)
ndxslur = igetbits(ipl,5,23)
call notefq(noteq,lnoten,nolevg(ngs),ncm)
call addstr(sq//'tslur',6,soutq,lsout)
c
-cc Print 11-ndxslur
c Print 24-ndxslur
c
c if (11-ndxslur .lt. 10) then
@@ -5391,8 +6075,6 @@ c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
c
c+++ Try to fix loss of octave with single gaft
c
-c if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}',
-c * 13+lnoten,soutq,lsout)
if (isgaft) then
itrans = 0
do 1 i = 1 , lnotenGA
@@ -5505,7 +6187,7 @@ c
end if
end if
c
-c Print 11-ndxslur
+c Print 23-ndxslur
c
if (23-ndxslur .lt. 10) then
call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
@@ -5689,11 +6371,13 @@ 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.
@@ -5756,7 +6440,9 @@ c
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 * 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
@@ -5869,13 +6555,10 @@ c
c Get index of next slur not in use, starting from 12 down
c
ndxslur = log2(16777215-listslur)
-c write(*,'()')
-c write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur
c
c Record slur index
c
listslur = ibset(listslur,ndxslur)
-c write(*,'(10x,B24)')listslur
c
c Save for use on termination
c
@@ -5892,7 +6575,7 @@ c
else
ihoff = ihoff+2
end if
- end if
+ end if
if (iscrd) then
c
c Additional horiz shifts for h-shifted noteheads?
@@ -5963,19 +6646,15 @@ c notexq = chax(92)//'dotted'//noteq
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
@@ -5985,7 +6664,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
c
c Add note name to string
c
-c call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
islhgt = nolevs+iupdn+ivoff
call notefq(noteq,lnoten,islhgt,ncm)
notexq = notexq(1:lnote)//noteq(1:lnoten)
@@ -6045,7 +6723,9 @@ 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
+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
@@ -6063,7 +6743,6 @@ c
c
c Bugfix 070901 for slur ending on rest in 2-voice staff
c
-c if (nolevs.eq.0 .or. nolevs.gt.60) then
if (nolevs.le.2 .or. nolevs.gt.60) then
c
c Ending is on a rest, reset nolevs to default starting height
@@ -7432,7 +8111,7 @@ c
return
end
subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
- parameter (nkb=3999,maxblks=4000)
+ 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.
@@ -7531,7 +8210,7 @@ c fnote = nodur(ivx,iip)/float(iip-ip1m1)
print*,' '
call printl
* ('Probable misplaced barline or incorrect meter, stopping')
-c call printl('Program error in fnote, send source to Dr. Don')
+ print*,'ivx,ip:',ivx,ip
call stop1()
end
subroutine g1etchar(lineq,iccount,charq)
@@ -7567,7 +8246,7 @@ c
return
end
subroutine g1etnote(loop,ifig,optimize,fulltrans)
- parameter (nm=24,nkb=3999,mv=24576,maxblks=4000)
+ parameter (nm=24,nkb=3999,mv=24576,maxblks=9600)
character*1 chax
common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
* nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
@@ -7604,7 +8283,7 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
* restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
* debugmidi
logical debugmidi
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
logical novshrinktop,upslur,fontslur,ztrans,
@@ -7621,6 +8300,8 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
logical fulltrans
common /comsize/ isize(nm)
common /commidisig/ midisig
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
data literq
* /'Literal TeX string cannot start with 4 backslashes!',
* 'TeX string must have <129 char, end with backslash!',
@@ -7850,13 +8531,13 @@ 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
-c else if (durq .eq. 'S') then
else if (index('LS',durq) .gt. 0) then
c
c Stemlength change
@@ -7933,20 +8614,51 @@ c
c Will set all durations to 0 except last one.
c
call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
+ 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"!')
+ * 'First char after "x" in xtuplet must be "1"-"9" or "T"!')
call stop1()
end if
- call readnum(lineq,iccount,durq,fnum)
- if (fnum .gt. 99) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ if (durq .eq. 'T') then
+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()
+ 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.
@@ -8262,6 +8974,8 @@ c
* '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,
@@ -8486,18 +9200,10 @@ c
call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
* 'In xtup, this character is not allowed!')
call stop1()
-c else if (durq.eq.'r' .and. itup.eq.ntup) then
-c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'Sorry, PMX cannot end an xtuplet with a rest!')
-c call stop1()
- else if (durq.eq.'r' .and. itup.eq.ntup .and.
- * index(lineq(iccount+1:iccount+2),'b').eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Sorry, PMX cannot end an xtuplet with a non-blank rest!')
- call stop1()
end if
7 call g1etchar(lineq,iccount,durq)
- if (index('2345678ulcb',durq) .gt. 0) then
+c if (index('2345678ulcb',durq) .gt. 0) then
+ if (index('12345678ulcb',durq) .gt. 0) then
go to 7
else if (index('sfn',durq) .gt. 0) then
c
@@ -8640,7 +9346,14 @@ c
iccount = iccount-1
end if
go to 2
- else if (durq .ne. ' ') then
+ 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)
@@ -9079,6 +9792,8 @@ c
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
@@ -9536,13 +10251,28 @@ c gotclef = .true.
* 'Repeats can only go in voice 1!')
call stop1()
end if
-10 call g1etchar(lineq,iccount,durq)
- if (index('lrdDbz',durq) .gt. 0) go to 10
- if (durq .ne. ' ') then
+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)!')
+ * '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
@@ -9640,7 +10370,16 @@ c
iccount = 128
else if (charq .eq. 'A') then
27 call g1etchar(lineq,iccount,durq)
- if (index('rbsdeK',durq) .gt. 0) then
+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.
@@ -9656,6 +10395,8 @@ c
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,
@@ -9669,6 +10410,8 @@ c
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
@@ -9771,10 +10514,38 @@ c
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 the letters abcdeiILNprRsST!')
+ * '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.'
@@ -9936,7 +10707,7 @@ 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 is ',lenbar
+ print*,'lenbar, timesofar are ',lenbar,itsofar(ivx)
call stop1()
else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
print*
@@ -10326,8 +11097,8 @@ c
end
subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
* xmtrnum0,newkey,npages,nsyst,musize,bottreb)
- parameter(nm=24,maxblks=4000)
- character*65536 bufq
+ parameter(nm=24,maxblks=9600)
+ character*131072 bufq
character*1 chax
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
@@ -10564,9 +11335,9 @@ c mytime = 1000*(ts+60*(im+60*ih))
c return
c end
subroutine getbuf(lineq)
- parameter (maxblks=4000)
+ parameter (maxblks=9600)
character*(*) lineq
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
@@ -11552,7 +12323,7 @@ c
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(40),ipage,
+ * 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,
@@ -11574,7 +12345,7 @@ c
* kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
common /combc/ bcspec
common /comas3/ ask(2500),iask,topmods
c
@@ -11634,7 +12405,11 @@ c
common /commidisig/ midisig
common /comlyr/ inputmlyr
logical inputmlyr
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ logical inxtup
cdot = .false.
+ inxtup = .false.
1 call getchar(lineq,iccount,charq)
if (lastchar) return
if (charq .eq. ' ') go to 1
@@ -11824,11 +12599,15 @@ c
c
c Accidental
c
- if (nacc(ivx,nnl(ivx)) .eq. 0) then
+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
- nacc(ivx,nnl(ivx)) = index('fsn',durq)
+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
@@ -11877,8 +12656,8 @@ 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-2
- go to 2
+ iccount = iccount-1
+c go to 2
end if
nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
c
@@ -11897,17 +12676,86 @@ c
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
+c Next input will be digit unless its a "T"
c
iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- ntup = nint(fnum)
+ 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
@@ -12291,12 +13139,8 @@ c
c 140218 Need to get time differently inside xtup, since itsofar doesn't get
c updated until after xtup is done
c
-c tcc(iv,ncc(iv)) = itsofar(iv)
nodurt = ifnodur(nnodur,dotq)
tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1))
-c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:'
-c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv))
-c isl = ibset(islur(iv,nnl(iv)+1),11)
isl = ibset(islur(iv,nnl(iv)),11)
call getchar(lineq,iccount,durq)
c
@@ -12306,7 +13150,7 @@ c
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)) = 7+iTransAmt(instno(iv))
end if
c
c Set marker on note with lowest voice # starting at same time.
@@ -12378,6 +13222,12 @@ c
else
nolev(ivx,nnl(ivx)) = 2
end if
+c end if
+ else
+c
+c Counter for non-rests
+c
+ nnb = nnb+1
end if
notcrd = .true.
8 call getchar(lineq,iccount,durq)
@@ -12395,11 +13245,16 @@ c
end if
end if
else if (index('fsn',durq) .gt. 0) then
- if (nacc(ivx,nnl(ivx)) .eq. 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
- nacc(ivx,nnl(ivx)) = index('fsn',durq)
+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
@@ -12540,7 +13395,6 @@ c
ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
go to 2
-c else if (durq .eq. 'S') then
else if (index('LS',durq) .gt. 0) then
c
c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5
@@ -12628,6 +13482,16 @@ c
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)
@@ -12651,6 +13515,17 @@ 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
+c ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19)
+ islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18)
end if
if (idotform .gt. 0) then
if (idotform .eq. 1) then
@@ -13440,9 +14315,18 @@ c
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)) = 7+iTransAmt(instno(iv))
+ lastlev = lastlev+7
else
- if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0
+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
+ print*,'Reset itransamt to ',iTransAmt(instno(iv))
+ end if
end if
c
c Set marker on note with lowest voice # starting at same time.
@@ -13825,6 +14709,20 @@ 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
@@ -14307,14 +15205,14 @@ 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=4000,nm=24)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
logical fexist,global
@@ -15279,12 +16177,10 @@ c
c
c Forced multiplicity
c
-c mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22)
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
-c mult(ivx,iip) = 4-log2(nodur(ivx,iip))
call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8)
else
c
@@ -15304,7 +16200,6 @@ c
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
-c mult(ivx,iiip) = multx
call setbits(mult(ivx,iiip),4,0,multx+8)
c
c Note the following still works after making mult only the 1st 4 bits.
@@ -15366,13 +16261,13 @@ 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=4000)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
lbuf(1) = lbuf(1)
@@ -15442,7 +16337,7 @@ c
logical upg,slurg,slashg,autofbon
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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)
@@ -15842,21 +16737,6 @@ c
end if
30 continue
c
-c Debug writes
-c
-c print*
-c write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot)
-c print*,'PMXB has now got blocks'
-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 write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
-cc write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048,
-c * in=1,ntot)
-c write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot)
-c
-c
c Analyze for beams.
c
do 20 iv = 1 , nv
@@ -16003,10 +16883,10 @@ c
logical upg,slurg,slashg,issig,rpndot,autofbon
character*128 litq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
+ character*1 ulfbq,udqq,clefq(nm),slurudq,udq
character*8 noteq
character*79 cwrq(nm),notexq,inameq
character*20 voltxtq
@@ -16156,10 +17036,10 @@ c
c if (clefq(ivxo(in)) .eq. '8') then
if (btest(ipl(ivxo(in),ipo(in)),2)) then
if (iv .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
end if
end if
@@ -16544,8 +17424,12 @@ c
if (isaccs .or. iscacc) then
ptsneed = ptsneed+taccfac*wheadpt1
end if
- if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed,
+c if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed,
+c * esk,fixednew,scaldold,0.,.false.)
+ if (poenom*esk .lt. ptsneed) then
+ call addask(to(in),ptsneed,
* esk,fixednew,scaldold,0.,.false.)
+ end if
99 continue
if (btest(iornq(ivx,ip),26)) then
c
@@ -16757,7 +17641,6 @@ c
c Check for new clef here.
c
if (isclef .and. btest(islur(ivx,ip),11)) then
-c print*,'At clef insertion, ptclef:',ptclef(iv)
if (ptclef(iv) .gt. 0.) then
notexq = sq//'off{-'
if (ptclef(iv) .lt. 9.95) then
@@ -16770,7 +17653,6 @@ c print*,'At clef insertion, ptclef:',ptclef(iv)
notexq = notexq(1:lnote)//'pt}'
lnote = lnote+3
call addstr(notexq,lnote,soutq,lsout)
-c print*,'Just added: ',notexq(1:lnote)
end if
call clefsym(islur(iv,ip),notexq,lnote,nclef)
c
@@ -17049,7 +17931,28 @@ 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)
-c else if (mult(ivx,ip) .lt. 0) then
+cc else if (iand(mult(ivx,ip),15)-8 .lt. 0) then
+c else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or.
+c * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or.
+c * (ip.gt.1.and.btest(irest(ivx,ip-1),2)
+c * .and.nodur(ivx,ip).eq.32)) then
+c nodu = 32
+c else
+c nodu = 16
+c end if
+ 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
@@ -17058,7 +17961,8 @@ c else if (mult(ivx,ip) .lt. 0) then
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))
+ * btest(nacc(ivx,ip),27),nacc(ivx,ip),
+ * irest)
end if
c
c Now that chords are done, add stuff to midi file
@@ -17178,7 +18082,9 @@ c
end if
end if
c
-c Check for dotted notes with moved dots
+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
@@ -17289,106 +18195,58 @@ 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)
-cc 4. Not last note in bar
-cc 5. Followed by note (add better test later)
c
if (kbdrests .and. btest(irest(ivx,ip),0) .and.
* .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
-c * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx)
-c * .and. .not.(btest(irest(ivx,ip+1),0))) then
* 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 130127 Replaced following code with a subroutine
+c Deal with single stem tremolo
+c Get up-downness, borrowed from notex
c
-cc Get reference level: next following note if no intervening blank rests,
-cc otherwise next prior note.
-cc
-cc levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line
-c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
-cc
-cc Not the last note and not "look-left" for level
-cc
-c do 8 kkp = ip+1 , nn(ivx)
-c if (btest(islur(ivx,kkp),29)) go to 4
-c if (.not.btest(irest(ivx,kkp),0)) then
-c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c go to 9
-c end if
-c8 continue
-c end if
-c4 continue
-cc
-cc If here, there were no following notes or came to a blank rest, or
-cc "look-left" option set. So look before
-cc
-c if (ip .eq. 1) go to 2 ! Get out if this is the first note.
-c do 3 kkp = ip-1, 1, -1
-c if (.not.btest(irest(ivx,kkp),0)) then
-c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
-c go to 9
-c end if
-c3 continue
-c go to 2 ! Pretty odd, should never be here, but get out if so.
-c9 continue
-cc
-cc Find note in other voice at same time
-cc
-c iupdown = sign(1,ivx-nv-1)
-c ivother = ivmx(iv,(3-iupdown)/2)
-c tother = 0.
-c do 5 kkp = 1 , nib(ivother,ibar)
-c if (abs(tother-tnow) .lt. tol) go to 6
-c tother = tother+nodur(ivother,kkp)
-c5 continue
-cc
-cc If here, then no note starts in other voice at same time, so set default
-cc
-c levother = -iupdown*50
-c go to 7
-c6 continue
-cc
-cc If here, have just identified a simultaneous note or rest in other voice
-cc
-c if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
-c levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
-c else
-c if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-cc
-cc Rest in other voice has same duration, get out (so defualt spacing is used)
-cc
-c go to 2
-c end if
-c levother = -iupdown*50
-c end if
-c7 continue
-c indxr = log2(nodur(ivx,ip))+1
-c if (iupdown .lt. 0) then
-c levtop = levtopr(indxr)
-c iraise1 = levother-levtop-3 ! Based on other note
-c iraise2 = levnext-levtop ! Based on following note
-c if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
-c iraise = min(iraise1,iraise2)
-c if (mod(iraise+50,2).eq.1 .and.
-c * iraise+levtop.gt.-1) iraise = iraise-1
-c else
-c levbot = levbotr(indxr)
-c iraise1 = levother-levbot+3
-c iraise2 = levnext-levbot
-c if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
-c iraise = max(iraise1,iraise2)
-c if (mod(iraise+50,2).eq.1 .and.
-c * iraise+levbot.le.9) iraise = iraise-1
-c end if
-c nolev(ivx,ip) = 100+iraise
+ 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 The new subroutine call, to replace above code
+c Get a numerical pitch argument
c
- call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr,
- * mult,ipl)
+ 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 Write a separate note or rest
+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
@@ -17400,8 +18258,9 @@ c
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)
- * call addstr(notexq,lnote,soutq,lsout)
+ 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
@@ -17814,7 +18673,7 @@ 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=4000)
+ 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),
@@ -18116,13 +18975,13 @@ 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=4000)
+ 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*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
if (.not.mrecord) then
@@ -18164,7 +19023,7 @@ c
character*1 ulq,sepsymq,sq
logical beamon,firstgulp,figbass,figchk,isfig
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
@@ -18186,23 +19045,6 @@ c
c Return middle line of a clef
c
character*1 clefq
-c if (clefq.eq.'t' .or. clefq.eq.'0') then
-c ncmidf = 35
-c else if (clefq.eq.'s' .or. clefq.eq.'1') then
-c ncmidf = 33
-c else if (clefq.eq.'m' .or. clefq.eq.'2') then
-c ncmidf = 31
-c else if (clefq.eq.'a' .or. clefq.eq.'3') then
-c ncmidf = 29
-c else if (clefq.eq.'n' .or. clefq.eq.'4') then
-c ncmidf = 27
-c else if (clefq.eq.'r' .or. clefq.eq.'5') then
-c ncmidf = 25
-c else if (clefq.eq.'f' .or. clefq.eq.'7') then
-c ncmidf = 37
-c else
-c ncmidf = 23
-c end if
if (clefq .eq. '8') then
c
c treblelowoct; will treat as treble for this purpose
@@ -18231,7 +19073,7 @@ c
* tautofb,autofbon,t1autofb
character*1 ulfbq,clefq
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * 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
@@ -18479,20 +19321,14 @@ c
restq =sq//'qqs'
lrest = 4
end if
-c if (2**log2(nodu) .ne. nodu) then
-cc
-cc One or two dots on rest
-cc
-c restq = restq(1:3)//'p'
-c lrest = 4
-c if (2*nodu .gt. 3*2**log2(nodu)) then
-cc
-cc Double dotted rest
-cc
-c restq = restq(1:4)//'p'
-c lrest = 5
-c end if
-c 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
@@ -18512,19 +19348,8 @@ c
notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
end if
lnote = 16+lnoten
-c if (2**log2(nodu) .ne. nodu) then
-cc
-cc Have dot in raised rest. must put in hbox!
-cc
-c notexq = notexq(1:lnote)//sq//'hbox{'
-c lnote = lnote+6
-c end if
notexq = notexq(1:lnote)//restq(1:lrest)
lnote = lnote+lrest
-c if (2**log2(nodu) .ne. nodu) then
-c notexq = notexq(1:lnote)//'}'
-c lnote = lnote+1
-c end if
end if
if (2**log2(nodu) .ne. nodu) then
c
@@ -18560,9 +19385,6 @@ c * (nole.lt.0.or.nole.gt.8)) then
* sq//'hbox{'//restq(1:lrest)//'}'
lrest = lrest+23
end if
-
-
-
notexq = restq(1:lrest)//notexq(1:lnote)
lnote = lnote+lrest
end if
@@ -18802,9 +19624,9 @@ 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=4000)
+ parameter (nm=24,nkb=3999,nks=125,maxblks=9600)
logical loop,usefig,isfirst,optimize
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
integer nn(nm),nodur(nm,200),ivxo(600),ipo(600),
@@ -18853,8 +19675,12 @@ c logical mrecord,mplay,endmac,gotclef,cstuplet
* instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
logical EarlyTransOn,LaterInstTrans
logical fulltrans
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
data wtimesig,wclef,wkeysig
* / 0.72 , 0.8 , 0.28 /
+ is4bignv = .false.
+ AIset = .false.
whead20 = 0.3
if (.not.optimize) then
print*
@@ -19398,7 +20224,6 @@ c * 'In system #',isyst,' cannot meet min. space rqmt'
c
c Find eonk by Newton method
c
-c eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0))
call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1,
* wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax,
* (wminpt-elmin0)/(elmin1-elmin0))
@@ -19555,7 +20380,7 @@ 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=4000)
+ parameter (nm=24,nks=125,mv=24576,maxblks=9600)
c
c FYI /all/ differs in appearance in function ncmid
c
@@ -19603,20 +20428,19 @@ c 31 If on, suppress printing number with xtuplet starting here
ccccccccccccc
cc ipl cc
ccccccccccccc
-cc 0-7 Location in list [0,200]
-cc 0-7 Unused
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
-cc 2-7 Unused
-c 3-7 unused
+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.
-cc 27 Unused?
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)
@@ -19654,8 +20478,9 @@ 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 Moved hgt shft to mult 16-22, so could span -64,64.
-cc 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n'
+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
@@ -19781,7 +20606,7 @@ c
c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
c
cccccccccccccccccccccccccccccccc
- character*65536 bufq
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
character*10 figq
@@ -19793,7 +20618,7 @@ cccccccccccccccccccccccccccccccc
logical loop,lastchar,slint,svolta,evolta,onvolt,
* cwrest(nm),islast,inlast,optimize
integer istop(80),numbms(nm),istart(80)
- real*4 xnsttop(40),xintstaff(40),hesk(23),hpts(23),poevec(nks),
+ 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
@@ -19820,7 +20645,7 @@ cccccccccccccccccccccccccccccccc
* rptprev,equalize,rptfq1,rptfq2
common /combeam/ ibmtyp
common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
- * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage,
+ * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
* OptLineBreakTies,HeaderSpecial
common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
* isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
@@ -19850,7 +20675,7 @@ cccccccccccccccccccccccccccccccc
* ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb,
* btest,sluron,setis,nobar1
common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
common /compoi/ ispoi
common /combc/ bcspec
common /comeon/ eonk,ewmxk
@@ -19900,6 +20725,13 @@ cccccccccccccccccccccccccccccccc
logical newclef, centrests
common /comlyr/ inputmlyr
logical inputmlyr /.false./
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comhair/ idhairuse,idhair(nm)
+ bottopgap = .false.
+ idhairuse = 0
if (.not.optimize) then
print*
print*,'Starting second PMX pass'
@@ -20190,6 +21022,7 @@ c
nvolt = 0
do 28 iv = 1 , nm
nudoff(iv) = 0
+ maxdotmv(iv) = ndotmv(iv)
ndotmv(iv) = 0
28 continue
c
@@ -20386,10 +21219,10 @@ c
c if (clefq(iv) .eq. '8') then
if (btest(ipl(iv,ioff+1),2)) then
if (iv .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv,
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv,
* sq//'treblelowoct%'
end if
else
@@ -20842,6 +21675,21 @@ c second pass, vshrink at top of page one is dealt with in topfile, which is ca
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)'
@@ -20850,6 +21698,22 @@ c
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) write(11,'(a)') sq//'vfill'//sq//'eject%'
end if
@@ -20877,6 +21741,7 @@ c
c
c Vertical spacing parameters, then restart
c
+ if (is4bignv) xinsnow = .95*xinsnow
if (islast) write(11,fmtq)sq//'interstaff{',xinsnow,
* '}'//sq//'contpiece'
c
@@ -21161,8 +22026,6 @@ c
ipl(ivx,ip) = ipl(ivx,ip+ioff)
iornq(ivx,ip) = iornq(ivx,ip+ioff)
mult(ivx,ip) = mult(ivx,ip+ioff)
-c if (ivx.le.2 .and. figbass)
-c * isfig(ivx,ip) = isfig(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)
@@ -21203,7 +22066,6 @@ c
* iptrill(it)+nib(ivtrill(it),ibar-2)
22 continue
do 27 icrd = 1 , ncrd
-c ivx = iand(15,ishft(icrdat(icrd),-8))
ivx = iand(15,ishft(icrdat(icrd),-8))
* +16*igetbits(icrdat(icrd),1,28)
ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1)
@@ -21212,7 +22074,6 @@ c ivx = iand(15,ishft(icrdat(icrd),-8))
icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd))
27 continue
do 29 iudorn = 1 , nudorn
-c ivx = iand(15,ishft(kudorn(iudorn),-8))
ivx = ivxudorn(iudorn)
ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1)
if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
@@ -21221,7 +22082,6 @@ c ivx = iand(15,ishft(kudorn(iudorn),-8))
29 continue
do 42 idyn = 1 , ndyn
idynd = idyndat(idyn)
-c ivx = iand(15,idynd)
ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10)
ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
c
@@ -21236,9 +22096,7 @@ c
42 continue
do 43 itxtdyn = 1 , ntxtdyn
idynd = ivxiptxt(itxtdyn)
-c ivx = iand(15,idynd)
ivx = iand(31,idynd)
-c ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1)
if (ibar .gt. 2) then
ipnew = ipnew+nib(ivx,ibar-2)
@@ -21260,7 +22118,6 @@ c call setbits(idynd,8,4,ipnew)
isdat1(isdat) = isdata
41 continue
do 44 ibc = 1 , nbc
-c ivx = iand(15,ibcdata(ibc))
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
@@ -21396,7 +22253,6 @@ c
else if (rptfq2 .eq. 'z') then
if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece'
else
-c else if (rptfq2 .ne. 'D') then
print*
print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
@@ -21406,6 +22262,21 @@ c else if (rptfq2 .ne. 'D') then
if (islast) write(11,'(a)')sq//'Endpiece'
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)'
@@ -21762,9 +22633,6 @@ c
c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp)
levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp)
invert = -levbot+4+nolev-ncm
-c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:'
-c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp),
-c *levbot,nolev,ncm
end if
c
c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote
@@ -22630,11 +23498,10 @@ c
c
c Only print number when wanted. First check vert, horiz offset
c
-c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16
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
+ if (.not.usexnumt) then
notexq = chax(92)//'xnum{'
lnote = 10
istrtn = 7
@@ -22667,8 +23534,8 @@ c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16
return
end
subroutine read10(string,lastchar)
- parameter (maxblks=4000)
- character*65536 bufq
+ parameter (maxblks=9600)
+ character*131072 bufq
integer*2 lbuf(maxblks)
common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
character*(*) string
@@ -22868,11 +23735,6 @@ c
c Sets iwidbits of isdata, shifted by ishift, to ivalue
c
ibase = 2**iwidbit-1
- if (ivalue.gt.ibase) then
- print*
- print*,'WARNING in setbits: ivalue > ibase'
- write(15,'(/,a)')'WARNING in setbits: ivalue > ibase'
- end if
isdata = iand(not(ishft(ibase,ishift)),isdata)
isdata = ior(isdata,ishft(ivalue,ishift))
return
@@ -22975,9 +23837,6 @@ c
call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
* 'Macro number not in range 1-20!')
call stop1()
-c else if (btest(macuse,macnum)) then
-c print*
-c print*,'WARNING: Redefining macro # ',macnum
end if
macuse = ibset(macuse,macnum)
if (charq .eq. 'R') then
@@ -23037,6 +23896,12 @@ c
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
@@ -23167,11 +24032,12 @@ c Reset nxtinbm for use as counter as #'s are posted by putxtn(..)
c
nxtinbm(ivx) = 0
smed = 0.
- if (.not.btest(islur(ivx,ipb(1)),2)) then
+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
- if (nnb .eq. 1) go to 6
+c if (nnb .eq. 1) go to 6
nsc = 0
do 5 inb = 1 , nnb-1
do 5 jnb = inb+1 , nnb
@@ -23244,12 +24110,10 @@ c
if (ulq(ivx,ibc) .eq. 'u') iul = 1
ssq = 0.
syb = 0.
-c yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1))
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
-c * -iul*bmhgt*(mult(ivx,ipb(inb))-1)
* -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1)
syb = syb+ybeam
ynote = nolev(ivx,ipb(inb))
@@ -23274,7 +24138,9 @@ c * -iul*bmhgt*(mult(ivx,ipb(inb))-1)
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)
- * .and. .not.btest(islur(ivx,ipb(1)),2)) then
+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.
@@ -23285,7 +24151,6 @@ c
c
c Check if beam starts or ends too high or low.
c
-c xboff = bmhgt*(mult(ivx,ipb(1))-1)
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)
@@ -23303,7 +24168,8 @@ c
c
c Since one or the other end has changed, need to change slope
c
- if (.not.btest(islur(ivx,ipb(1)),2))
+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
@@ -23406,6 +24272,13 @@ 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
@@ -23414,7 +24287,9 @@ 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 * 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
@@ -23828,6 +24703,8 @@ c
* instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
logical EarlyTransOn,LaterInstTrans
common /comsize/ isize(nm)
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
sq = chax(92)
vshrink = xinstf1.gt.20. .and. .not.novshrinktop
if (vshrink) then
@@ -23947,7 +24824,7 @@ c
clefqiv = clefq(iv)
if (clefqiv.eq.'8') then
clefqiv='t'
- iTransAmt(instno(iv)) = 7
+ iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
end if
if (nstaves .eq. 1) then
fmtq = chax(48+numclef(clefq(iv)))
@@ -24010,8 +24887,10 @@ c
else
fmtq = '(a,f4.1,a)'
end if
+ facis = 1.
+ if (is4bignv) facis = .95
write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt'
- * //sq//'interstaff{',xinstf1,'}'//sq//'relax'
+ * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax'
else
write(11,'(a)')sq//'stafftopmarg0pt'//
* sq//'staffbotmarg5'//sq//'Interligne'//sq//
@@ -24103,7 +24982,7 @@ c
upcaseq = chq
print*,'Warning, upcaseq was called with improper argument: '
* //chq
- stop
+ stop
end if
return
end
@@ -24265,25 +25144,6 @@ c
kv = 1
end if
c
-c Moved to pmxab to allow midivel, bal, tran as functions of instrument
-c rather than staff (iv)
-cc
-cc Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv)
-cc
-c nstaves = 0
-c ivt = 0
-c do 12 iinst = 1 , nm
-c nstaves = nstaves+nsperi(iinst)
-c do 13 ivtt = 1 , nsperi(iinst)
-c ivt = ivt+1
-c iinsiv(ivt) = iinst
-c13 continue
-c if (nstaves .eq. nv) go to 14
-c12 continue
-c print*,'Screwup!'
-c call stop1()
-c14 continue
-c
do 5 icm = 0 , numchan-1
c
c Get the number of bytes in the data stream
@@ -24293,10 +25153,8 @@ c
ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec)
11 continue
c
-cc Add 3 (for instrum) plus 4 (for closing) to byte count,
c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count,
c
-c ndata = ndata+7
ndata = ndata+11
c
c Add 4+lnam(iinsiv(iv)) if lnam>0 ,
diff --git a/Build/source/utils/pmx/pmx-src/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c
index d4776386d23..38aac5a1d0f 100644
--- a/Build/source/utils/pmx/pmx-src/pmxab.c
+++ b/Build/source/utils/pmx/pmx-src/pmxab.c
@@ -1,3 +1,4 @@
+#line 1 ""
/* -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
@@ -12,6 +13,7 @@
#include "f2c.h"
+#line 1 ""
/* Common Block Declarations */
struct {
@@ -66,8 +68,8 @@ union {
struct {
integer ipbuf, ilbuf, nlbuf;
- shortint lbuf[4000];
- char bufq[65536];
+ shortint lbuf[9600];
+ char bufq[131072];
} inbuff_;
#define inbuff_1 inbuff_
@@ -503,10 +505,10 @@ struct comsize_1_ {
struct {
integer nnodur;
real wminnh[3999];
- integer nnpd[4000];
- real durb[4000];
+ integer nnpd[9600];
+ real durb[9600];
integer iddot, nptr[3999], ibarcnt, mbrest, ibarmbr, ibaroff;
- real udsp[3999], wheadpt, sqzb[4000];
+ real udsp[3999], wheadpt, sqzb[9600];
} c1omnotes_;
#define c1omnotes_1 c1omnotes_
@@ -528,6 +530,15 @@ struct {
#define commidisig_1 commidisig_
struct {
+ integer ncc[24];
+ real tcc[240] /* was [24][10] */;
+ integer ncmidcc[240] /* was [24][10] */, maxdotmv[24], ndotmv[24];
+ real updot[480] /* was [24][20] */, rtdot[480] /* was [24][20] */;
+} comcc_;
+
+#define comcc_1 comcc_
+
+struct {
integer listslur;
logical upslur[48] /* was [24][2] */;
integer ndxslur;
@@ -537,6 +548,18 @@ struct {
#define comslur_1 comslur_
+union {
+ struct {
+ integer ihairuse, idhair[24];
+ } _1;
+ struct {
+ integer idhairuse, idhair[24];
+ } _2;
+} comhair_;
+
+#define comhair_1 (comhair_._1)
+#define comhair_2 (comhair_._2)
+
struct {
integer ivg[37], ipg[37], nolevg[74], itoff[148] /* was [2][74] */;
real aftshft;
@@ -623,6 +646,12 @@ struct {
#define comligfont_1 comligfont_
struct {
+ logical is4bignv, aiset;
+} comis4bignv_;
+
+#define comis4bignv_1 comis4bignv_
+
+struct {
logical lastchar, rptnd1, sluron[48] /* was [24][2] */, fbon,
ornrpt, stickys;
integer movbrk, movnmp, movdnp, movgap;
@@ -646,7 +675,7 @@ struct {
logical was2[24];
integer ninow;
logical nobar1;
- integer nsystp[40], ipage;
+ integer nsystp[75], ipage;
logical optlinebreakties, headerspecial;
} comnotes_;
@@ -674,15 +703,6 @@ struct {
#define comfb_1 comfb_
struct {
- integer ncc[24];
- real tcc[240] /* was [24][10] */;
- integer ncmidcc[240] /* was [24][10] */, ndotmv[24];
- real updot[480] /* was [24][20] */, rtdot[480] /* was [24][20] */;
-} comcc_;
-
-#define comcc_1 comcc_
-
-struct {
logical bcspec;
} combc_;
@@ -722,11 +742,18 @@ struct {
#define combibarcnt_1 combibarcnt_
-struct comlyr_1_ {
+struct {
logical inputmlyr;
-};
+} comlyr_;
+
+#define comlyr_1 comlyr_
-#define comlyr_1 (*(struct comlyr_1_ *) &comlyr_)
+struct {
+ real botamt, topamt;
+ logical bottopgap;
+} combottop_;
+
+#define combottop_1 combottop_
struct {
integer ivxudorn[63];
@@ -849,10 +876,6 @@ struct {
0, 0, 0, 0 };
struct {
- logical e_1;
- } comlyr_ = { FALSE_ };
-
-struct {
real e_1;
} comtol_ = { .001f };
@@ -875,16 +898,18 @@ static integer c__17 = 17;
static integer c__14 = 14;
static integer c__129 = 129;
static integer c__5 = 5;
+static integer c__13 = 13;
+static integer c__6 = 6;
+static integer c__7 = 7;
static integer c__22 = 22;
static integer c__0 = 0;
-static integer c__6 = 6;
static integer c__27 = 27;
-static integer c__7 = 7;
static integer c__10 = 10;
static integer c__20 = 20;
-static real c_b773 = -2.f;
-static real c_b774 = 0.f;
-static real c_b819 = 1.f;
+static integer c__26 = 26;
+static real c_b1008 = -2.f;
+static real c_b1009 = 0.f;
+static real c_b1054 = 1.f;
static integer c__8 = 8;
static integer c__16 = 16;
static integer c__23 = 23;
@@ -893,10 +918,9 @@ static integer c__96 = 96;
static integer c__21 = 21;
static integer c__19 = 19;
static integer c__24 = 24;
-static integer c__13 = 13;
static integer c__28 = 28;
static integer c__18 = 18;
-static real c_b1655 = 2.f;
+static real c_b1902 = 2.f;
static integer c__30 = 30;
static integer c__60 = 60;
static integer c__80 = 80;
@@ -911,8 +935,8 @@ static integer c__47 = 47;
{
/* Initialized data */
- static char date[9] = "24 Nov 16";
- static char version[5] = "2.76 ";
+ static char date[9] = "10 Feb 18";
+ static char version[5] = "2.84 ";
static integer maxit = 200;
static integer ncalls = 0;
static logical isfirst = TRUE_;
@@ -1064,6 +1088,39 @@ 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.84 */
+/* Bug fix: dots in chordal seconds */
+/* Bug fix: Initialize ihornb for non-beamed, down xtup */
+/* Bug fix: When using "AT" with 2-note x3c rD. */
+/* 2.83 */
+/* Fix problems when changing to or from octave treble clef. */
+/* Fix beaming (or not) and number location for xtups with */
+/* multiple rests. Still some problems with number height but */
+/* can be band-aided with number height tweak option. */
+/* Tweak error messages for options on "R" command. */
+/* Allow forced beam height and slope tweaks with 2-note tremolos */
+/* Allow chordal note with 2-note tremolos, adding dots as needed. */
+/* Fix call to ncmid in beamstrt when setting start height for beam of */
+/* 2-note trem, by changing arg from ivx to iv */
+/* 2.82 */
+/* bugfix: beams with rests, not confused with xtups. */
+/* x option after slur index to allow slurs to go from one voice to another. */
+/* x option also for ties */
+/* 2.81 */
+/* Allow string of rests to end xtup */
+/* in chordal half-note 2-note tremolo, make chord notes open. */
+/* 2.80 */
+/* Add 2-note tremolos */
+/* 2.78 */
+/* Expand bufq to 131072 bytes */
+/* Expand maxblks tp 9600 */
+/* Allow up to 75 pages */
+/* Index postscript hairpins from 1 up instead of by voice #. */
+/* Add option 'o' to forced beam for open notehead (\hb); set ipl(3) */
+/* Add option T[n], n=1,2,3 for single stem tremolo */
+/* 2.77 */
+/* Enable AV+/-x+/-y to add vskip bigh before or after \eject */
+/* 2.76 */
/* 2.75 */
/* Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and */
/* 2 or 3 flags on shortened note. */
@@ -1730,654 +1787,1149 @@ static integer c__47 = 47;
/* cccccccccccccccccccccccc */
/* itstart = mytime() */
+#line 812 ""
s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5);
/* Initialize midi parameters */
+#line 816 ""
commmac_1.gottempo = FALSE_;
+#line 817 ""
commidi_1.ismidi = FALSE_;
+#line 818 ""
commidi_1.debugmidi = FALSE_;
+#line 819 ""
commidi_1.relacc = FALSE_;
+#line 820 ""
commmac_1.mmacrec = FALSE_;
+#line 821 ""
commmac_1.nmidsec = 1;
+#line 822 ""
commidi_1.mgap = 10;
+#line 823 ""
comevent_1.miditime = 0;
+#line 824 ""
comevent_1.lasttime = 0;
+#line 825 ""
commidi_1.nmidcrd = 0;
+#line 826 ""
comslm_1.nusebl = 0;
+#line 827 ""
commidi_1.notmain = FALSE_;
+#line 828 ""
for (ivx = 1; ivx <= 24; ++ivx) {
+#line 829 ""
commidi_1.twoline[ivx - 1] = FALSE_;
+#line 830 ""
commidi_1.midinst[ivx - 1] = 6;
+#line 831 ""
commvel_1.midivel[ivx - 1] = 127;
+#line 832 ""
commvel_1.midibal[ivx - 1] = 64;
+#line 833 ""
commvel_1.miditran[ivx - 1] = 0;
+#line 834 ""
/* L3: */
+#line 834 ""
}
+#line 835 ""
for (icm = 0; icm <= 24; ++icm) {
+#line 836 ""
commidi_1.imidi[icm] = 0;
+#line 837 ""
commidi_1.restpend[icm] = FALSE_;
+#line 838 ""
commidi_1.trest[icm] = 0.f;
+#line 839 ""
comslm_1.levson[icm] = 0;
+#line 840 ""
comslm_1.levsoff[icm] = 0;
+#line 841 ""
comslm_1.slmon[icm] = FALSE_;
+#line 842 ""
comslm_1.naccbl[icm] = 0;
+#line 843 ""
comdiag_1.n69[icm] = 0;
+#line 844 ""
comdiag_1.n34[icm] = 0;
+#line 845 ""
commmac_1.msecstrt[icm] = 1;
+#line 846 ""
/* L12: */
+#line 846 ""
}
/* End of midi parameter initialization */
+#line 850 ""
commus_1.musize = 0;
+#line 851 ""
optimize = FALSE_;
+#line 852 ""
numargs = iargc_();
+#line 853 ""
if (numargs == 0) {
+#line 854 ""
s_wsle(&io___10);
- do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"
+#line 854 ""
+ do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
"d line,", (ftnlen)53);
+#line 854 ""
e_wsle();
+#line 855 ""
s_wsle(&io___11);
+#line 855 ""
do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32);
+#line 855 ""
e_wsle();
+#line 856 ""
s_rsfe(&io___12);
+#line 856 ""
do_fio(&c__1, jobname, (ftnlen)44);
+#line 856 ""
e_rsfe();
+#line 857 ""
numargs = 1;
+#line 858 ""
} else {
/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */
+#line 860 ""
getarg_(&c__1, jobname, (ftnlen)44);
+#line 861 ""
}
+#line 862 ""
L10:
+#line 862 ""
ljob = lenstr_(jobname, &c__44, (ftnlen)44);
+#line 863 ""
if (ljob > 44) {
+#line 864 ""
s_wsle(&io___15);
+#line 864 ""
do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31);
+#line 864 ""
e_wsle();
+#line 865 ""
stop1_();
+#line 866 ""
} else if (ljob == 0) {
+#line 867 ""
s_wsle(&io___16);
+#line 867 ""
do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34)
;
+#line 867 ""
e_wsle();
+#line 868 ""
stop1_();
+#line 869 ""
} else if (numargs == 2) {
+#line 870 ""
if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) {
+#line 871 ""
optimize = TRUE_;
/* call getarg(2,jobname,idum) ! May need to replace this w/ next line */
+#line 873 ""
getarg_(&c__2, jobname, (ftnlen)44);
+#line 874 ""
numargs = 1;
+#line 875 ""
goto L10;
+#line 876 ""
} else {
+#line 877 ""
s_wsle(&io___17);
+#line 877 ""
do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30)
;
+#line 877 ""
e_wsle();
+#line 878 ""
stop1_();
+#line 879 ""
}
+#line 880 ""
}
/* Strip ".pmx" if necessary */
/* Computing MAX */
+#line 884 ""
i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx(
jobname, ".PMX", (ftnlen)44, (ftnlen)4);
+#line 884 ""
ndxpmx = max(i__1,i__2);
+#line 885 ""
if (ndxpmx > 0) {
+#line 886 ""
s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1);
+#line 887 ""
ljob += -4;
+#line 888 ""
}
/* Check for existence of input file */
/* Writing concatenation */
+#line 892 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 892 ""
i__3[1] = 4, a__1[1] = ".pmx";
+#line 892 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
+#line 893 ""
ioin__1.inerr = 0;
+#line 893 ""
ioin__1.infilen = 47;
+#line 893 ""
ioin__1.infile = infileq;
+#line 893 ""
ioin__1.inex = &fexist;
+#line 893 ""
ioin__1.inopen = 0;
+#line 893 ""
ioin__1.innum = 0;
+#line 893 ""
ioin__1.innamed = 0;
+#line 893 ""
ioin__1.inname = 0;
+#line 893 ""
ioin__1.inacc = 0;
+#line 893 ""
ioin__1.inseq = 0;
+#line 893 ""
ioin__1.indir = 0;
+#line 893 ""
ioin__1.infmt = 0;
+#line 893 ""
ioin__1.inform = 0;
+#line 893 ""
ioin__1.inunf = 0;
+#line 893 ""
ioin__1.inrecl = 0;
+#line 893 ""
ioin__1.innrec = 0;
+#line 893 ""
ioin__1.inblank = 0;
+#line 893 ""
f_inqu(&ioin__1);
+#line 894 ""
if (! fexist) {
+#line 895 ""
ioin__1.inerr = 0;
+#line 895 ""
ioin__1.infilen = ljob + 4;
/* Writing concatenation */
+#line 895 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 895 ""
i__3[1] = 4, a__1[1] = ".PMX";
+#line 895 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
+#line 895 ""
ioin__1.infile = ch__1;
+#line 895 ""
ioin__1.inex = &fexist;
+#line 895 ""
ioin__1.inopen = 0;
+#line 895 ""
ioin__1.innum = 0;
+#line 895 ""
ioin__1.innamed = 0;
+#line 895 ""
ioin__1.inname = 0;
+#line 895 ""
ioin__1.inacc = 0;
+#line 895 ""
ioin__1.inseq = 0;
+#line 895 ""
ioin__1.indir = 0;
+#line 895 ""
ioin__1.infmt = 0;
+#line 895 ""
ioin__1.inform = 0;
+#line 895 ""
ioin__1.inunf = 0;
+#line 895 ""
ioin__1.inrecl = 0;
+#line 895 ""
ioin__1.innrec = 0;
+#line 895 ""
ioin__1.inblank = 0;
+#line 895 ""
f_inqu(&ioin__1);
+#line 896 ""
if (! fexist) {
+#line 897 ""
s_wsle(&io___21);
/* Writing concatenation */
+#line 897 ""
i__3[0] = 17, a__1[0] = "Cannot find file ";
+#line 897 ""
i__3[1] = 47, a__1[1] = infileq;
+#line 897 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64);
+#line 897 ""
do_lio(&c__9, &c__1, ch__2, (ftnlen)64);
+#line 897 ""
e_wsle();
+#line 898 ""
stop1_();
+#line 899 ""
} else {
/* Writing concatenation */
+#line 900 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 900 ""
i__3[1] = 4, a__1[1] = ".PMX";
+#line 900 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
+#line 901 ""
}
+#line 902 ""
}
/* Open a log file */
+#line 906 ""
o__1.oerr = 0;
+#line 906 ""
o__1.ounit = 15;
+#line 906 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
+#line 906 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 906 ""
i__3[1] = 4, a__1[1] = ".pml";
+#line 906 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
+#line 906 ""
o__1.ofnm = ch__1;
+#line 906 ""
o__1.orl = 0;
+#line 906 ""
o__1.osta = 0;
+#line 906 ""
o__1.oacc = 0;
+#line 906 ""
o__1.ofm = 0;
+#line 906 ""
o__1.oblnk = 0;
+#line 906 ""
f_open(&o__1);
/* Writing concatenation */
+#line 907 ""
i__4[0] = 21, a__2[0] = "This is PMX, Version ";
+#line 907 ""
i__4[1] = 5, a__2[1] = version;
+#line 907 ""
i__4[2] = 2, a__2[2] = ", ";
+#line 907 ""
i__4[3] = 9, a__2[3] = date;
+#line 907 ""
s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37);
+#line 907 ""
printl_(ch__3, (ftnlen)37);
+#line 908 ""
ljob4 = ljob;
/* Writing concatenation */
+#line 909 ""
i__3[0] = 8, a__1[0] = "Opening ";
+#line 909 ""
i__3[1] = 47, a__1[1] = infileq;
+#line 909 ""
s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55);
+#line 909 ""
printl_(ch__4, (ftnlen)55);
+#line 910 ""
o__1.oerr = 0;
+#line 910 ""
o__1.ounit = 18;
+#line 910 ""
o__1.ofnmlen = 47;
+#line 910 ""
o__1.ofnm = infileq;
+#line 910 ""
o__1.orl = 0;
+#line 910 ""
o__1.osta = 0;
+#line 910 ""
o__1.oacc = 0;
+#line 910 ""
o__1.ofm = 0;
+#line 910 ""
o__1.oblnk = 0;
+#line 910 ""
f_open(&o__1);
/* Copy input file into common buffer */
+#line 914 ""
inbuff_1.ipbuf = 0;
+#line 915 ""
truelinecount_1.linewcom[0] = 1;
- for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 4000; ++inbuff_1.ilbuf) {
+#line 916 ""
+ for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 9600; ++inbuff_1.ilbuf) {
+#line 917 ""
ncomments = 0;
+#line 918 ""
L14:
+#line 918 ""
i__1 = s_rsfe(&io___24);
+#line 918 ""
if (i__1 != 0) {
+#line 918 ""
goto L9;
+#line 918 ""
}
+#line 918 ""
i__1 = do_fio(&c__1, lnholdq, (ftnlen)128);
+#line 918 ""
if (i__1 != 0) {
+#line 918 ""
goto L9;
+#line 918 ""
}
+#line 918 ""
i__1 = e_rsfe();
+#line 918 ""
if (i__1 != 0) {
+#line 918 ""
goto L9;
+#line 918 ""
}
+#line 919 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, &
c__128, (ftnlen)128);
+#line 920 ""
if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) {
/* Blank line. Make it a single blank with length 1 */
+#line 924 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1;
+#line 925 ""
s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
+#line 926 ""
}
/* 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 932 ""
if (*(unsigned char *)lnholdq == '%') {
+#line 933 ""
++ncomments;
+#line 934 ""
goto L14;
+#line 935 ""
}
/* When here, have counted all preceding comments and have a real line */
+#line 939 ""
if (inbuff_1.ilbuf > 1) {
+#line 940 ""
truelinecount_1.linewcom[inbuff_1.ilbuf - 1] =
truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 +
ncomments;
+#line 941 ""
} else {
+#line 942 ""
truelinecount_1.linewcom[0] = ncomments + 1;
+#line 943 ""
}
- if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 65536) {
+#line 944 ""
+ if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 131072) {
+#line 945 ""
s_wsle(&io___26);
+#line 945 ""
do_lio(&c__9, &c__1, "Too many characters in file, stopping", (
ftnlen)37);
+#line 945 ""
e_wsle();
+#line 946 ""
stop1_();
+#line 947 ""
}
+#line 948 ""
i__1 = inbuff_1.ipbuf;
+#line 948 ""
s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[
inbuff_1.ilbuf - 1] - i__1, (ftnlen)128);
+#line 949 ""
inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
+#line 950 ""
/* L8: */
+#line 950 ""
}
+#line 951 ""
printl_("Too many lines in input file", (ftnlen)28);
+#line 952 ""
stop1_();
+#line 953 ""
L9:
/* Insert dummy line to handle input files w/o CR-LF at end. */
+#line 957 ""
inbuff_1.nlbuf = inbuff_1.ilbuf - 1;
/* nlbuf = ilbuf */
/* bufq(ipbuf+1:ipbuf+3) = ' / ' */
/* lbuf(nlbuf) = 3 */
+#line 961 ""
cl__1.cerr = 0;
+#line 961 ""
cl__1.cunit = 18;
+#line 961 ""
cl__1.csta = 0;
+#line 961 ""
f_clos(&cl__1);
+#line 962 ""
i__1 = maxit;
+#line 962 ""
for (numit = 1; numit <= i__1; ++numit) {
+#line 963 ""
if (optimize) {
+#line 963 ""
printl_("Starting an iteration", (ftnlen)21);
+#line 963 ""
}
/* 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 969 ""
pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen)
44);
+#line 970 ""
if (! optimize) {
+#line 971 ""
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 977 ""
nstaves = 0;
+#line 978 ""
ivt = 0;
+#line 979 ""
for (iinst = 1; iinst <= 24; ++iinst) {
+#line 980 ""
nstaves += c1omget_1.nsperi[iinst - 1];
+#line 981 ""
i__2 = c1omget_1.nsperi[iinst - 1];
+#line 981 ""
for (ivtt = 1; ivtt <= i__2; ++ivtt) {
+#line 982 ""
++ivt;
+#line 983 ""
commvel_1.iinsiv[ivt - 1] = (shortint) iinst;
+#line 984 ""
/* L17: */
+#line 984 ""
}
+#line 985 ""
if (nstaves == a1ll_1.nv) {
+#line 985 ""
goto L18;
+#line 985 ""
}
+#line 986 ""
/* L16: */
+#line 986 ""
}
+#line 987 ""
s_wsle(&io___34);
+#line 987 ""
do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8);
+#line 987 ""
e_wsle();
+#line 988 ""
stop1_();
+#line 989 ""
L18:
/* Set up channel numbers for midi. */
+#line 993 ""
commidi_1.numchan = 0;
+#line 994 ""
for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
+#line 995 ""
if (commidi_1.twoline[a1ll_1.iv - 1]) {
+#line 996 ""
commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan;
+#line 997 ""
++commidi_1.numchan;
+#line 998 ""
}
+#line 999 ""
commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan;
+#line 1000 ""
++commidi_1.numchan;
+#line 1001 ""
/* L11: */
+#line 1001 ""
}
/* numchan will now be the number of channels, but max channel # is numchan-1 */
/* Set up velocities, balances, and midi-transpositions */
+#line 1007 ""
for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
+#line 1008 ""
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 1013 ""
commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
+#line 1014 ""
commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
+#line 1015 ""
commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
+#line 1016 ""
}
/* midvelc(midchan(iv,1)) = midivel(iv) */
/* midbc(midchan(iv,1)) = midibal(iv) */
/* midtc(midchan(iv,1)) = miditran(iv) */
+#line 1020 ""
commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
+#line 1021 ""
commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
+#line 1022 ""
commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
+#line 1023 ""
/* L13: */
+#line 1023 ""
}
+#line 1024 ""
}
/* TEMPORARY!!! */
+#line 1028 ""
s_wsle(&io___35);
+#line 1028 ""
do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
+#line 1028 ""
do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(
integer));
+#line 1028 ""
e_wsle();
+#line 1029 ""
ip1 = 1;
+#line 1030 ""
i__2 = inbuff_1.nlbuf;
+#line 1030 ""
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 1035 ""
ip1 += inbuff_1.lbuf[ilb - 1];
+#line 1036 ""
/* L10000: */
+#line 1036 ""
}
+#line 1037 ""
iplast = ip1 - 1;
/* Check to see if (1) last line is "<blank><blank>/" and (2) next to last */
/* line is "/" */
-/* print*,'iplast:',iplast */
-/* print*,'Last line:' */
-/* print*,bufq(iplast+1-lbuf(nlbuf):iplast) */
-/* print*,'Last char of next to last line:' */
-/* print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)) */
+#line 1042 ""
i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
+#line 1042 ""
if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3)
== 0) {
+#line 1043 ""
i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
+#line 1043 ""
if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[
inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) {
+#line 1044 ""
s_wsle(&io___39);
- do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"
+#line 1044 ""
+ do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
"ank>/\"", (ftnlen)39);
+#line 1044 ""
e_wsle();
+#line 1045 ""
s_wsle(&io___40);
- do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"
+#line 1045 ""
+ do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
"ank>/\"", (ftnlen)39);
+#line 1045 ""
e_wsle();
+#line 1046 ""
--inbuff_1.nlbuf;
+#line 1047 ""
}
+#line 1048 ""
}
+#line 1050 ""
pmxb_(&c_true, poe0, &ncalls, &optimize);
+#line 1051 ""
if (commidi_1.ismidi) {
/* Write midi file */
+#line 1055 ""
o__1.oerr = 0;
+#line 1055 ""
o__1.ounit = 51;
+#line 1055 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
+#line 1055 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 1055 ""
i__3[1] = 4, a__1[1] = ".mid";
+#line 1055 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
+#line 1055 ""
o__1.ofnm = ch__1;
+#line 1055 ""
o__1.orl = 0;
+#line 1055 ""
o__1.osta = 0;
+#line 1055 ""
o__1.oacc = 0;
+#line 1055 ""
o__1.ofm = 0;
+#line 1055 ""
o__1.oblnk = 0;
+#line 1055 ""
f_open(&o__1);
+#line 1056 ""
if (commidi_1.debugmidi) {
+#line 1056 ""
o__1.oerr = 0;
+#line 1056 ""
o__1.ounit = 52;
+#line 1056 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
+#line 1056 ""
i__3[0] = ljob, a__1[0] = jobname;
+#line 1056 ""
i__3[1] = 4, a__1[1] = ".dbm";
+#line 1056 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
+#line 1056 ""
o__1.ofnm = ch__1;
+#line 1056 ""
o__1.orl = 0;
+#line 1056 ""
o__1.osta = 0;
+#line 1056 ""
o__1.oacc = 0;
+#line 1056 ""
o__1.ofm = 0;
+#line 1056 ""
o__1.oblnk = 0;
+#line 1056 ""
f_open(&o__1);
+#line 1056 ""
}
+#line 1057 ""
printl_(" ", (ftnlen)1);
/* Writing concatenation */
+#line 1058 ""
i__5[0] = 8, a__3[0] = "Writing ";
+#line 1058 ""
i__5[1] = ljob, a__3[1] = jobname;
+#line 1058 ""
i__5[2] = 4, a__3[2] = ".mid";
+#line 1058 ""
s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56);
+#line 1058 ""
printl_(ch__5, ljob + 12);
+#line 1059 ""
writemidi_(jobname, &ljob, (ftnlen)44);
+#line 1060 ""
}
+#line 1061 ""
cl__1.cerr = 0;
+#line 1061 ""
cl__1.cunit = 15;
+#line 1061 ""
cl__1.csta = 0;
+#line 1061 ""
f_clos(&cl__1);
+#line 1062 ""
s_stop("", (ftnlen)0);
+#line 1063 ""
}
+#line 1064 ""
s_wsle(&io___42);
+#line 1064 ""
do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
+#line 1064 ""
do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer))
;
+#line 1064 ""
e_wsle();
+#line 1065 ""
ip1 = 1;
+#line 1066 ""
pmxb_(&c_false, poe0, &ncalls, &optimize);
+#line 1067 ""
poestats_(&nsyst, poe0, &poebar0, &devnorm0);
/* Save initial deviation and line breaks for later comparison */
+#line 1071 ""
if (numit == 1) {
+#line 1072 ""
devpmx = devnorm0;
+#line 1073 ""
i__2 = nsyst;
+#line 1073 ""
for (isys = 1; isys <= i__2; ++isys) {
+#line 1074 ""
nbari[isys - 1] = nbars0[isys - 1];
+#line 1075 ""
/* L20: */
+#line 1075 ""
}
+#line 1076 ""
}
+#line 1077 ""
sortpoe_(&nsyst, poe0, ipoe);
+#line 1078 ""
for (iupord = nsyst; iupord >= 1; --iupord) {
+#line 1079 ""
isysu = ipoe[iupord - 1];
+#line 1080 ""
s_wsle(&io___51);
+#line 1080 ""
do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
+#line 1080 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
+#line 1080 ""
e_wsle();
+#line 1081 ""
s_wsle(&io___52);
+#line 1081 ""
do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
+#line 1081 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
+#line 1081 ""
e_wsle();
/* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */
+#line 1085 ""
if (poe0[isysu - 1] < poebar0) {
+#line 1085 ""
goto L1;
+#line 1085 ""
}
+#line 1086 ""
i__2 = nsyst;
+#line 1086 ""
for (idnord = 1; idnord <= i__2; ++idnord) {
+#line 1087 ""
isysd = ipoe[idnord - 1];
+#line 1088 ""
if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd -
1] > poebar0) {
+#line 1088 ""
goto L5;
+#line 1088 ""
}
+#line 1090 ""
i__6 = nsyst;
+#line 1090 ""
for (isyst = 1; isyst <= i__6; ++isyst) {
+#line 1091 ""
nbars[isyst - 1] = nbars0[isyst - 1];
+#line 1092 ""
if (isyst == isysu) {
+#line 1093 ""
++nbars[isyst - 1];
+#line 1094 ""
} else if (isyst == isysd) {
+#line 1095 ""
--nbars[isyst - 1];
+#line 1096 ""
}
+#line 1097 ""
/* L2: */
+#line 1097 ""
}
+#line 1098 ""
pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, (
ftnlen)44);
+#line 1099 ""
pmxb_(&c_false, poe, &ncalls, &optimize);
+#line 1100 ""
poestats_(&nsyst, poe, &poebar, &devnorm);
+#line 1101 ""
if (devnorm < devnorm0) {
+#line 1102 ""
devnorm0 = devnorm;
+#line 1103 ""
poebar0 = poebar;
+#line 1104 ""
i__6 = nsyst;
+#line 1104 ""
for (isys = 1; isys <= i__6; ++isys) {
+#line 1105 ""
nbars0[isys - 1] = nbars[isys - 1];
+#line 1106 ""
poe0[isys - 1] = poe[isys - 1];
+#line 1107 ""
/* L4: */
+#line 1107 ""
}
+#line 1108 ""
s_wsle(&io___60);
+#line 1108 ""
do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
ftnlen)32);
+#line 1108 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
integer));
+#line 1108 ""
do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
integer));
+#line 1108 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
real));
+#line 1108 ""
e_wsle();
+#line 1110 ""
s_wsle(&io___61);
+#line 1110 ""
do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
ftnlen)32);
+#line 1110 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
integer));
+#line 1110 ""
do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
integer));
+#line 1110 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
real));
+#line 1110 ""
e_wsle();
+#line 1112 ""
s_wsfe(&io___62);
+#line 1112 ""
i__6 = nsyst;
+#line 1112 ""
for (isys = 1; isys <= i__6; ++isys) {
+#line 1112 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
sizeof(integer));
+#line 1112 ""
}
+#line 1112 ""
e_wsfe();
+#line 1113 ""
s_wsfe(&io___63);
+#line 1113 ""
i__6 = nsyst;
+#line 1113 ""
for (isys = 1; isys <= i__6; ++isys) {
+#line 1113 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
sizeof(integer));
+#line 1113 ""
}
+#line 1113 ""
e_wsfe();
+#line 1114 ""
sortpoe_(&nsyst, poe0, ipoe);
+#line 1115 ""
goto L6;
+#line 1116 ""
}
+#line 1117 ""
L5:
+#line 1117 ""
;
+#line 1117 ""
}
+#line 1118 ""
L1:
+#line 1118 ""
;
+#line 1118 ""
}
/* If we get here, must have gone thru all switches and found nothing better, */
/* so done! */
+#line 1123 ""
goto L7;
+#line 1124 ""
L6:
+#line 1124 ""
;
+#line 1124 ""
}
+#line 1125 ""
L7:
+#line 1126 ""
s_wsle(&io___64);
+#line 1126 ""
do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
+#line 1126 ""
do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
+#line 1126 ""
do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
+#line 1126 ""
do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
+#line 1126 ""
e_wsle();
+#line 1127 ""
s_wsle(&io___65);
+#line 1127 ""
do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
+#line 1127 ""
do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
+#line 1127 ""
do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
+#line 1127 ""
do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
+#line 1127 ""
e_wsle();
+#line 1128 ""
s_wsle(&io___66);
+#line 1128 ""
do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
+#line 1128 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
+#line 1128 ""
do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
+#line 1128 ""
do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
+#line 1128 ""
e_wsle();
+#line 1129 ""
s_wsle(&io___67);
+#line 1129 ""
do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
+#line 1129 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
+#line 1129 ""
do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
+#line 1129 ""
do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
+#line 1129 ""
e_wsle();
+#line 1130 ""
s_wsle(&io___68);
+#line 1130 ""
do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
+#line 1130 ""
r__1 = (1 - devnorm0 / devpmx) * 100.f;
+#line 1130 ""
do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 1130 ""
e_wsle();
+#line 1131 ""
s_wsle(&io___69);
+#line 1131 ""
do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
+#line 1131 ""
r__1 = (1 - devnorm0 / devpmx) * 100.f;
+#line 1131 ""
do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 1131 ""
e_wsle();
+#line 1132 ""
printl_("Initial bars/system:", (ftnlen)20);
+#line 1133 ""
s_wsfe(&io___70);
+#line 1133 ""
i__1 = nsyst;
+#line 1133 ""
for (isys = 1; isys <= i__1; ++isys) {
+#line 1133 ""
do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
+#line 1133 ""
}
+#line 1133 ""
e_wsfe();
+#line 1134 ""
s_wsfe(&io___71);
+#line 1134 ""
i__1 = nsyst;
+#line 1134 ""
for (isys = 1; isys <= i__1; ++isys) {
+#line 1134 ""
do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
+#line 1134 ""
}
+#line 1134 ""
e_wsfe();
+#line 1135 ""
printl_("Final bars/system:", (ftnlen)18);
+#line 1136 ""
s_wsfe(&io___72);
+#line 1136 ""
i__1 = nsyst;
+#line 1136 ""
for (isys = 1; isys <= i__1; ++isys) {
+#line 1136 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
+#line 1136 ""
}
+#line 1136 ""
e_wsfe();
+#line 1137 ""
s_wsfe(&io___73);
+#line 1137 ""
i__1 = nsyst;
+#line 1137 ""
for (isys = 1; isys <= i__1; ++isys) {
+#line 1137 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
+#line 1137 ""
}
+#line 1137 ""
e_wsfe();
+#line 1138 ""
pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44);
+#line 1139 ""
pmxb_(&c_true, poe0, &ncalls, &optimize);
-/* itend = mytime() */
-/* print*,'Elapsed time in ms:',itend-itstart */
-/* write(15,*)'Elapsed time in ms:',itend-itstart */
+#line 1140 ""
cl__1.cerr = 0;
+#line 1140 ""
cl__1.cunit = 15;
+#line 1140 ""
cl__1.csta = 0;
+#line 1140 ""
f_clos(&cl__1);
+#line 1141 ""
return 0;
} /* MAIN__ */
@@ -2396,28 +2948,51 @@ L7:
static cilist io___75 = { 0, 6, 0, 0, 0 };
+#line 1144 ""
iacc = *nacc & 7;
+#line 1145 ""
if (iacc == 1) {
+#line 1146 ""
s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2);
+#line 1147 ""
*lacc = 2;
+#line 1148 ""
} else if (iacc == 2) {
+#line 1149 ""
s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2);
+#line 1150 ""
*lacc = 2;
+#line 1151 ""
} else if (iacc == 3) {
+#line 1152 ""
s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2);
+#line 1153 ""
*lacc = 2;
+#line 1154 ""
} else if (iacc == 5) {
+#line 1155 ""
s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3);
+#line 1156 ""
*lacc = 3;
+#line 1157 ""
} else if (iacc == 6) {
+#line 1158 ""
s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3);
+#line 1159 ""
*lacc = 3;
+#line 1160 ""
} else {
+#line 1161 ""
s_wsle(&io___75);
+#line 1161 ""
do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16);
+#line 1161 ""
do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer));
+#line 1161 ""
e_wsle();
+#line 1162 ""
}
+#line 1163 ""
return 0;
} /* accsym_ */
@@ -2442,82 +3017,123 @@ L7:
static cilist io___77 = { 0, 6, 0, 0, 0 };
+#line 1172 ""
if (*isudsp) {
/* Find which udsp we're dealing with */
+#line 1176 ""
i__1 = comudsp_1.nudsp;
+#line 1176 ""
for (iudsp = 1; iudsp <= i__1; ++iudsp) {
+#line 1177 ""
if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs(
r__1)) < comtol_1.tol) {
+#line 1177 ""
goto L2;
+#line 1177 ""
}
+#line 1178 ""
/* L1: */
+#line 1178 ""
}
+#line 1179 ""
s_wsle(&io___77);
+#line 1179 ""
do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen)
36);
+#line 1179 ""
e_wsle();
+#line 1180 ""
stop1_();
+#line 1181 ""
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 1186 ""
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 1190 ""
comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1];
+#line 1191 ""
} else {
/* This place has no other space. */
+#line 1195 ""
++comas1_1.naskb;
+#line 1196 ""
comas1_1.task[comas1_1.naskb - 1] = *taskn;
+#line 1197 ""
comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1];
+#line 1198 ""
comas1_1.elask[comas1_1.naskb - 1] = 0.f;
+#line 1199 ""
}
+#line 1200 ""
} else {
/* 130330 start */
+#line 1202 ""
oldwask = 0.f;
+#line 1203 ""
oldelask = 0.f;
/* 130330 end */
/* This is a normal space, no effect if smaller than existing space */
+#line 1208 ""
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 1213 ""
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 1219 ""
oldwask = comas1_1.wask[comas1_1.naskb - 1];
+#line 1220 ""
oldelask = comas1_1.elask[comas1_1.naskb - 1];
/* End of 130330 insertions */
+#line 1222 ""
--comas1_1.naskb;
+#line 1223 ""
} else {
+#line 1224 ""
return 0;
+#line 1225 ""
}
+#line 1226 ""
}
+#line 1227 ""
++comas1_1.naskb;
+#line 1228 ""
comas1_1.task[comas1_1.naskb - 1] = *taskn;
+#line 1229 ""
comas1_1.wask[comas1_1.naskb - 1] = *waskn;
+#line 1230 ""
comas1_1.elask[comas1_1.naskb - 1] = *elaskn;
/* 130330 start */
/* fixednew = fixednew+waskn */
/* scaldold = scaldold+elaskn */
+#line 1234 ""
*fixednew = *fixednew + *waskn - oldwask;
+#line 1235 ""
*scaldold = *scaldold + *elaskn - oldelask;
/* 130330 end */
+#line 1237 ""
}
+#line 1238 ""
return 0;
} /* addask_ */
@@ -2533,12 +3149,18 @@ L2:
/* Local variables */
static char tchar[1];
+#line 1243 ""
*(unsigned char *)tchar = *(unsigned char *)noteq;
/* Writing concatenation */
+#line 1244 ""
i__1[0] = 1, a__1[0] = " ";
+#line 1244 ""
i__1[1] = 1, a__1[1] = tchar;
+#line 1244 ""
s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8);
+#line 1245 ""
*lnoten = 2;
+#line 1246 ""
return 0;
} /* addblank_ */
@@ -2547,30 +3169,54 @@ L2:
{
static integer ifb;
+#line 1254 ""
/* Parameter adjustments */
+#line 1254 ""
ulfbq -= 25;
+#line 1254 ""
t2fb -= 25;
+#line 1254 ""
t1fb -= 25;
+#line 1254 ""
--nfb;
+#line 1254 ""
+#line 1254 ""
/* Function Body */
+#line 1254 ""
*ifbadd = 1;
+#line 1255 ""
++nfb[*iv];
+#line 1256 ""
for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) {
+#line 1257 ""
if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) {
+#line 1258 ""
t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24];
+#line 1259 ""
t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24];
+#line 1260 ""
*(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char *
)&ulfbq[*iv + ifb * 24];
+#line 1261 ""
} else {
+#line 1262 ""
*ifbadd = ifb + 1;
+#line 1263 ""
goto L2;
+#line 1264 ""
}
+#line 1265 ""
/* L1: */
+#line 1265 ""
}
+#line 1266 ""
L2:
+#line 1267 ""
t1fb[*iv + *ifbadd * 24] = *tnew;
+#line 1268 ""
*(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x';
+#line 1269 ""
return 0;
} /* addfb_ */
@@ -2627,117 +3273,179 @@ L2:
/* Cancel out barline accidentals if there's a rest. */
+#line 1309 ""
if (*rest) {
+#line 1309 ""
comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0;
+#line 1309 ""
}
/* Special path to insert dummy rest at end of a section */
+#line 1313 ""
if (*endrest) {
+#line 1313 ""
goto L20;
+#line 1313 ""
}
+#line 1315 ""
i__1 = commidi_1.nmidcrd;
+#line 1315 ""
for (ion = 0; ion <= i__1; ++ion) {
/* check if this is only to get pitch of a chord note */
+#line 1319 ""
if (commidi_1.notmain) {
+#line 1319 ""
goto L6;
+#line 1319 ""
}
/* check for rest */
+#line 1323 ""
if (*rest) {
/* Will not put in a note, but must update timing */
+#line 1327 ""
if (! commidi_1.restpend[*icm]) {
/* First rest in sequence, save the time */
+#line 1331 ""
commidi_1.restpend[*icm] = TRUE_;
+#line 1332 ""
commidi_1.trest[*icm] = *time;
+#line 1333 ""
} else {
+#line 1334 ""
commidi_1.trest[*icm] += *time;
+#line 1335 ""
}
/* 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 1341 ""
chkimidi_(icm);
+#line 1342 ""
return 0;
+#line 1343 ""
}
/* time tics */
+#line 1347 ""
if (commidi_1.imidi[*icm] > 0 && ion == 0) {
+#line 1348 ""
idur = commidi_1.mgap;
+#line 1349 ""
} else {
+#line 1350 ""
idur = 0;
+#line 1351 ""
}
+#line 1352 ""
if (commidi_1.restpend[*icm]) {
+#line 1353 ""
commidi_1.restpend[*icm] = FALSE_;
+#line 1354 ""
r__1 = commidi_1.trest[*icm] * 15;
+#line 1354 ""
idur += i_nint(&r__1);
+#line 1355 ""
}
/* time to start of note */
+#line 1359 ""
idurvar = isetvarlen_(&idur, &nby2on);
+#line 1360 ""
if (nby2on > 4) {
+#line 1361 ""
s_wsle(&io___87);
+#line 1361 ""
do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (
ftnlen)37);
+#line 1361 ""
e_wsle();
+#line 1362 ""
stop1_();
+#line 1363 ""
}
+#line 1364 ""
++commidi_1.imidi[*icm];
+#line 1365 ""
i__2 = nby2on;
+#line 1365 ""
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 1370 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) *
25 - 25] = (shortint) (idurvar % 256);
+#line 1371 ""
if (nby2on > 1) {
+#line 1371 ""
idurvar /= 256;
+#line 1371 ""
}
+#line 1372 ""
/* L2: */
+#line 1372 ""
}
+#line 1373 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1;
/* Note-on signal */
+#line 1377 ""
++commidi_1.imidi[*icm];
/* mmidi(icm,imidi(icm)) = 9*16+icm */
+#line 1379 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
icmm[*icm] + 144);
/* Entry point for chord note pitch determination */
+#line 1383 ""
L6:
/* Get midi pitch. On chord iteration, only do this first time (main note), */
/* since pitch was already computed for nonmain chord notes. */
+#line 1388 ""
if (ion == 0) {
+#line 1389 ""
ipsav = *nolev * 12.f / 7 + 11;
+#line 1390 ""
ipsav0 = ipsav;
+#line 1391 ""
if (*midisig != 0) {
/* Adjust for signature */
+#line 1395 ""
*(unsigned char *)notenumq = (char) (*nolev % 7 + 48);
+#line 1396 ""
if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, (
ftnlen)1)) {
+#line 1397 ""
++ipsav;
+#line 1398 ""
} else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen)
7, (ftnlen)1)) {
+#line 1399 ""
--ipsav;
+#line 1400 ""
}
+#line 1401 ""
}
/* Deal with accidentals. */
@@ -2746,276 +3454,442 @@ L6:
/* effect X fl sh na X dfl dsh X */
/* iashft X -1 1 0 X -2 2 X */
+#line 1409 ""
jacc = 0;
+#line 1410 ""
eximacc = FALSE_;
+#line 1411 ""
if (*iacc > 0) {
/* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */
+#line 1415 ""
jacc = iashft_(iacc);
+#line 1416 ""
eximacc = TRUE_;
+#line 1417 ""
if (! commidi_1.relacc) {
+#line 1417 ""
jacc = jacc + ipsav0 - ipsav;
+#line 1417 ""
}
/* (Above) Shift applies to diatonic pitch but will be added to adjusted one */
+#line 1421 ""
} 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 1426 ""
i__2 = commidi_1.naccim[*icm];
+#line 1426 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
+#line 1427 ""
if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
+#line 1428 ""
jacc = commidi_1.jaccim[*icm + kacc * 25 - 25];
+#line 1429 ""
eximacc = TRUE_;
+#line 1430 ""
if (! commidi_1.relacc) {
+#line 1430 ""
jacc = jacc + ipsav0 - ipsav;
+#line 1430 ""
}
+#line 1431 ""
goto L4;
+#line 1432 ""
}
+#line 1433 ""
/* L3: */
+#line 1433 ""
}
+#line 1434 ""
L4:
+#line 1435 ""
;
+#line 1435 ""
}
/* 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 1441 ""
if (comslm_1.naccbl[*icm] > 0 && ! eximacc) {
/* Possible carryover accid from prior bar (or prior same-pitch note). */
+#line 1445 ""
i__2 = comslm_1.naccbl[*icm];
+#line 1445 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
+#line 1446 ""
if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) {
+#line 1447 ""
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 1451 ""
++comslm_1.nusebl;
+#line 1452 ""
comips_1.jusebl[comslm_1.nusebl - 1] = (shortint)
jacc;
+#line 1453 ""
comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (*
nolev);
+#line 1454 ""
if (! commidi_1.relacc) {
+#line 1454 ""
jacc = jacc + ipsav0 - ipsav;
+#line 1454 ""
}
+#line 1455 ""
goto L22;
+#line 1456 ""
}
+#line 1457 ""
/* L21: */
+#line 1457 ""
}
+#line 1458 ""
L22:
+#line 1459 ""
;
+#line 1459 ""
}
+#line 1460 ""
ipsav += jacc;
+#line 1461 ""
}
+#line 1462 ""
if (commidi_1.notmain) {
+#line 1463 ""
commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav;
/* Save pitch for tie checks */
+#line 1467 ""
if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) {
+#line 1467 ""
comips_1.ipslon[*icm] = (shortint) ipsav;
+#line 1467 ""
}
+#line 1469 ""
} else {
+#line 1470 ""
++commidi_1.imidi[*icm];
+#line 1471 ""
if (ion == 0) {
+#line 1472 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) ipsav;
+#line 1473 ""
if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm])
{
+#line 1473 ""
comips_1.ipslon[*icm] = (shortint) ipsav;
+#line 1473 ""
}
+#line 1475 ""
} else {
+#line 1476 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) commidi_1.mcpitch[ion - 1];
+#line 1477 ""
}
+#line 1478 ""
}
+#line 1479 ""
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 1484 ""
if (*iacc > 0) {
/* Set marker for accidental for possible continuations later this bar */
/* but first check and clear earlier ones on same note. */
+#line 1489 ""
i__2 = commidi_1.naccim[*icm];
+#line 1489 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
+#line 1490 ""
if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
+#line 1491 ""
i__3 = commidi_1.naccim[*icm] - 1;
+#line 1491 ""
for (macc = kacc; macc <= i__3; ++macc) {
+#line 1492 ""
commidi_1.laccim[*icm + macc * 25 - 25] =
commidi_1.laccim[*icm + (macc + 1) * 25 -
25];
+#line 1493 ""
commidi_1.jaccim[*icm + macc * 25 - 25] =
commidi_1.jaccim[*icm + (macc + 1) * 25 -
25];
+#line 1494 ""
/* L24: */
+#line 1494 ""
}
+#line 1495 ""
goto L25;
+#line 1496 ""
}
+#line 1497 ""
/* L23: */
+#line 1497 ""
}
+#line 1498 ""
goto L26;
+#line 1499 ""
L25:
+#line 1500 ""
--commidi_1.naccim[*icm];
+#line 1501 ""
L26:
/* Flag new accidental */
+#line 1505 ""
++commidi_1.naccim[*icm];
+#line 1506 ""
commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = *
nolev;
+#line 1507 ""
commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] =
iashft_(iacc);
+#line 1508 ""
}
/* Bail if this is a chord note on the first call (from docrd) */
+#line 1512 ""
if (commidi_1.notmain) {
+#line 1513 ""
chkimidi_(icm);
+#line 1514 ""
return 0;
+#line 1515 ""
}
+#line 1516 ""
}
/* Vel */
+#line 1520 ""
++commidi_1.imidi[*icm];
/* mmidi(icm,imidi(icm)) = 127 */
+#line 1522 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint)
commvel_1.midvelc[*icm];
+#line 1523 ""
chkimidi_(icm);
+#line 1524 ""
/* L7: */
+#line 1524 ""
}
/* For tie checks */
+#line 1528 ""
if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) {
+#line 1528 ""
comslm_1.imidso[*icm] = commidi_1.imidi[*icm];
+#line 1528 ""
}
/* Entry point for special rests at section ends (endrest=T) */
+#line 1532 ""
L20:
/* Now insert all the ends */
+#line 1536 ""
i__1 = commidi_1.nmidcrd;
+#line 1536 ""
for (ioff = 0; ioff <= i__1; ++ioff) {
+#line 1537 ""
if (ioff == 0) {
/* time to end */
+#line 1541 ""
r__1 = *time * 15;
+#line 1541 ""
idur1 = i_nint(&r__1);
+#line 1542 ""
r__1 = commidi_1.trest[*icm] * 15;
+#line 1542 ""
if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) {
+#line 1543 ""
idur = idur1 - commidi_1.mgap;
+#line 1544 ""
} else {
+#line 1545 ""
idur = idur1;
+#line 1546 ""
}
/* Deal with roundoff problems with 7-tuplets on half or quarters */
+#line 1550 ""
if (idur1 == 69) {
+#line 1551 ""
++comdiag_1.n69[*icm];
/* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */
+#line 1553 ""
if ((comdiag_1.n69[*icm] + 6) % 7 > 3) {
+#line 1553 ""
idur = idur1 - commidi_1.mgap - 1;
+#line 1553 ""
}
+#line 1554 ""
} else if (idur1 == 34) {
+#line 1555 ""
++comdiag_1.n34[*icm];
+#line 1556 ""
if ((comdiag_1.n34[*icm] + 6) % 7 > 4) {
+#line 1556 ""
idur = idur1 - commidi_1.mgap + 1;
+#line 1556 ""
}
+#line 1557 ""
}
+#line 1558 ""
idurvar = isetvarlen_(&idur, &nby2off);
+#line 1559 ""
if (nby2off > 4) {
+#line 1560 ""
s_wsle(&io___99);
+#line 1560 ""
do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.",
(ftnlen)37);
+#line 1560 ""
e_wsle();
+#line 1561 ""
stop1_();
+#line 1562 ""
}
+#line 1563 ""
++commidi_1.imidi[*icm];
+#line 1564 ""
chkimidi_(icm);
+#line 1565 ""
i__2 = nby2off;
+#line 1565 ""
for (i__ = 1; i__ <= i__2; ++i__) {
+#line 1566 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__)
* 25 - 25] = (shortint) (idurvar % 256);
+#line 1567 ""
if (nby2off > 1) {
+#line 1567 ""
idurvar /= 256;
+#line 1567 ""
}
+#line 1568 ""
/* L1: */
+#line 1568 ""
}
+#line 1569 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1;
+#line 1570 ""
} else {
/* Inserting end of chord note, delta time is 0 */
+#line 1574 ""
++commidi_1.imidi[*icm];
+#line 1575 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
+#line 1576 ""
}
/* Note off */
+#line 1580 ""
++commidi_1.imidi[*icm];
/* mmidi(icm,imidi(icm)) = 8*16+icm */
+#line 1582 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
icmm[*icm] + 128);
/* Pitch */
+#line 1586 ""
++commidi_1.imidi[*icm];
+#line 1587 ""
if (ioff == 0) {
+#line 1588 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) ipsav;
+#line 1589 ""
} else {
+#line 1590 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) commidi_1.mcpitch[ioff - 1];
+#line 1591 ""
}
/* Vel */
+#line 1595 ""
++commidi_1.imidi[*icm];
+#line 1596 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
+#line 1597 ""
chkimidi_(icm);
+#line 1598 ""
if (*endrest) {
+#line 1599 ""
return 0;
+#line 1600 ""
}
-
-/* print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time */
-
+#line 1601 ""
/* L8: */
+#line 1601 ""
}
+#line 1602 ""
comslm_1.naccbl[*icm] = comslm_1.nusebl;
+#line 1603 ""
if (comslm_1.nusebl > 0) {
/* Fix tables of "bar-line" accids that are saved due to consecutive notes. */
+#line 1607 ""
i__1 = comslm_1.nusebl;
+#line 1607 ""
for (kacc = 1; kacc <= i__1; ++kacc) {
+#line 1608 ""
comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1]
;
+#line 1609 ""
comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1]
;
+#line 1610 ""
/* L30: */
+#line 1610 ""
}
+#line 1611 ""
comslm_1.nusebl = 0;
+#line 1612 ""
}
/* Begin tie checks */
+#line 1616 ""
if (comslm_1.slmon[*icm]) {
/* Prior note had a slur start */
+#line 1620 ""
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) */
@@ -3024,110 +3898,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 1628 ""
nsav4tie = 0;
+#line 1629 ""
imidt = comslm_1.imidso[*icm];
+#line 1630 ""
L10:
+#line 1630 ""
++nsav4tie;
+#line 1631 ""
itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, &
imidt, &nbytes);
+#line 1632 ""
imidt += nbytes;
+#line 1633 ""
for (j = 1; j <= 3; ++j) {
+#line 1634 ""
itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + (
imidt + j) * 25 - 25];
+#line 1635 ""
/* L11: */
+#line 1635 ""
}
+#line 1636 ""
imidt += 3;
+#line 1637 ""
if (nsav4tie == 1) {
+#line 1638 ""
itiesav[4] = itiesav[0];
+#line 1639 ""
} else {
+#line 1640 ""
itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] +
itiesav[(nsav4tie - 1) * 5 - 1];
+#line 1642 ""
}
+#line 1643 ""
if (imidt != commidi_1.imidi[*icm]) {
+#line 1643 ""
goto L10;
+#line 1643 ""
}
/* Find which two pitches agree with saved slur pitch. */
+#line 1647 ""
it1found = FALSE_;
+#line 1648 ""
i__1 = nsav4tie;
+#line 1648 ""
for (it2 = 1; it2 <= i__1; ++it2) {
+#line 1649 ""
if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) {
+#line 1650 ""
if (it1found) {
+#line 1650 ""
goto L13;
+#line 1650 ""
}
+#line 1651 ""
it1 = it2;
+#line 1652 ""
it1found = TRUE_;
+#line 1653 ""
}
+#line 1654 ""
/* L12: */
+#line 1654 ""
}
+#line 1655 ""
printl_("Program error, tied notes, send source to Dr. Don", (
ftnlen)49);
+#line 1657 ""
it1 = nsav4tie + 1;
+#line 1658 ""
it2 = nsav4tie + 1;
+#line 1659 ""
L13:
/* List the positions we want to keep */
+#line 1663 ""
jsav = 0;
+#line 1664 ""
i__1 = nsav4tie;
+#line 1664 ""
for (isav = 1; isav <= i__1; ++isav) {
+#line 1665 ""
if (isav == it1 || isav == it2) {
+#line 1665 ""
goto L14;
+#line 1665 ""
}
+#line 1666 ""
++jsav;
+#line 1667 ""
itk[jsav - 1] = (shortint) isav;
+#line 1668 ""
L14:
+#line 1668 ""
;
+#line 1668 ""
}
+#line 1669 ""
nsav4tie += -2;
/* Now dump events it1 & it2, recompute times, restack mmidi. */
+#line 1673 ""
commidi_1.imidi[*icm] = comslm_1.imidso[*icm];
+#line 1674 ""
i__1 = nsav4tie;
+#line 1674 ""
for (isav = 1; isav <= i__1; ++isav) {
+#line 1675 ""
if (isav == 1) {
+#line 1676 ""
idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], &
nbytes);
+#line 1677 ""
} else {
+#line 1678 ""
i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav
- 2] * 5 - 1];
+#line 1678 ""
idurvar = isetvarlen_(&i__2, &nbytes);
+#line 1680 ""
}
+#line 1681 ""
++commidi_1.imidi[*icm];
+#line 1682 ""
i__2 = nbytes;
+#line 1682 ""
for (i__ = 1; i__ <= i__2; ++i__) {
+#line 1683 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes -
i__) * 25 - 25] = (shortint) (idurvar % 256);
+#line 1684 ""
if (nbytes > 1) {
+#line 1684 ""
idurvar /= 256;
+#line 1684 ""
}
+#line 1685 ""
/* L16: */
+#line 1685 ""
}
+#line 1686 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1;
+#line 1687 ""
for (i__ = 2; i__ <= 4; ++i__) {
+#line 1688 ""
++commidi_1.imidi[*icm];
+#line 1689 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] =
(shortint) itiesav[i__ + itk[isav - 1] * 5 - 6];
+#line 1690 ""
/* L17: */
+#line 1690 ""
}
+#line 1691 ""
/* L15: */
+#line 1691 ""
}
+#line 1692 ""
}
+#line 1693 ""
comslm_1.slmon[*icm] = FALSE_;
+#line 1694 ""
comslm_1.levsoff[*icm] = 0;
+#line 1695 ""
if (! comslm_1.dbltie) {
+#line 1695 ""
comslm_1.levson[*icm] = 0;
+#line 1695 ""
}
+#line 1696 ""
}
+#line 1697 ""
if (comslm_1.levson[*icm] > 0) {
+#line 1697 ""
comslm_1.slmon[*icm] = TRUE_;
+#line 1697 ""
}
+#line 1698 ""
if (commidi_1.nmidcrd > 0) {
+#line 1698 ""
commidi_1.nmidcrd = 0;
+#line 1698 ""
}
+#line 1699 ""
chkimidi_(icm);
+#line 1700 ""
return 0;
} /* addmidi_ */
@@ -3149,27 +4111,47 @@ L14:
static cilist io___111 = { 0, 11, 0, "(a)", 0 };
+#line 1707 ""
if (*lsout + *lnote > 72) {
+#line 1708 ""
if (comlast_1.islast) {
+#line 1708 ""
s_wsfe(&io___111);
/* Writing concatenation */
+#line 1708 ""
i__1[0] = *lsout, a__1[0] = soutq;
+#line 1708 ""
i__1[1] = 1, a__1[1] = "%";
+#line 1708 ""
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81);
+#line 1708 ""
do_fio(&c__1, ch__1, *lsout + 1);
+#line 1708 ""
e_wsfe();
+#line 1708 ""
}
+#line 1709 ""
*lsout = 0;
+#line 1710 ""
}
+#line 1711 ""
if (*lsout > 0) {
/* Writing concatenation */
+#line 1712 ""
i__1[0] = *lsout, a__1[0] = soutq;
+#line 1712 ""
i__1[1] = *lnote, a__1[1] = notexq;
+#line 1712 ""
s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80);
+#line 1713 ""
} else {
+#line 1714 ""
s_copy(soutq, notexq, (ftnlen)80, (*lnote));
+#line 1715 ""
}
+#line 1716 ""
*lsout += *lnote;
+#line 1717 ""
return 0;
} /* addstr_ */
@@ -3187,36 +4169,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 1743 ""
/* Parameter adjustments */
+#line 1743 ""
--istart;
+#line 1743 ""
+#line 1743 ""
/* Function Body */
+#line 1743 ""
inmin = istart[*ib] + 1;
+#line 1744 ""
i__1 = comas1_1.naskb;
+#line 1744 ""
for (iaskb = 1; iaskb <= i__1; ++iaskb) {
+#line 1745 ""
if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] -
comtol_1.tol) {
+#line 1745 ""
goto L10;
+#line 1745 ""
}
+#line 1746 ""
eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb -
1];
+#line 1747 ""
i__2 = comntot_1.ntot;
+#line 1747 ""
for (in = inmin; in <= i__2; ++in) {
+#line 1748 ""
if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) {
+#line 1749 ""
comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24
- 25] += eskadd;
+#line 1750 ""
if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs(
r__1)) < comtol_1.tol) {
+#line 1750 ""
--inmin;
+#line 1750 ""
}
+#line 1751 ""
} else {
+#line 1752 ""
++inmin;
+#line 1753 ""
}
+#line 1754 ""
/* L11: */
+#line 1754 ""
}
+#line 1755 ""
L10:
+#line 1755 ""
;
+#line 1755 ""
}
+#line 1756 ""
return 0;
} /* adjusteskz_ */
@@ -3262,185 +4271,333 @@ L10:
static cilist io___129 = { 0, 12, 0, "(a)", 0 };
+#line 1768 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 1768 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 1769 ""
o__1.oerr = 0;
+#line 1769 ""
o__1.ounit = 12;
+#line 1769 ""
o__1.ofnmlen = *lpath + *lbase + 4;
/* Writing concatenation */
+#line 1769 ""
i__1[0] = *lpath, a__1[0] = pathnameq;
+#line 1769 ""
i__1[1] = *lbase, a__1[1] = basenameq;
+#line 1769 ""
i__1[2] = 4, a__1[2] = ".tex";
+#line 1769 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88);
+#line 1769 ""
o__1.ofnm = ch__2;
+#line 1769 ""
o__1.orl = 0;
+#line 1769 ""
o__1.osta = 0;
+#line 1769 ""
o__1.oacc = 0;
+#line 1769 ""
o__1.ofm = 0;
+#line 1769 ""
o__1.oblnk = 0;
+#line 1769 ""
f_open(&o__1);
/* Transfer first 5 lines of main internal TeX file */
+#line 1773 ""
for (il = 1; il <= 5; ++il) {
+#line 1774 ""
moveln_(&c__11, &c__12, &done);
+#line 1775 ""
/* L11: */
+#line 1775 ""
}
+#line 1776 ""
if (*istype0) {
/* Transfer literal TeX stuff from special scratch file */
+#line 1780 ""
al__1.aerr = 0;
+#line 1780 ""
al__1.aunit = 17;
+#line 1780 ""
f_rew(&al__1);
+#line 1781 ""
L10:
+#line 1781 ""
moveln_(&c__17, &c__12, &done);
+#line 1782 ""
if (! done) {
+#line 1782 ""
goto L10;
+#line 1782 ""
}
+#line 1783 ""
cl__1.cerr = 0;
+#line 1783 ""
cl__1.cunit = 17;
+#line 1783 ""
cl__1.csta = 0;
+#line 1783 ""
f_clos(&cl__1);
+#line 1784 ""
}
/* Transfer next 2 lines from main scratch file */
+#line 1788 ""
for (il = 1; il <= 2; ++il) {
+#line 1789 ""
moveln_(&c__11, &c__12, &done);
+#line 1790 ""
/* L3: */
+#line 1790 ""
}
+#line 1791 ""
if (compoi_1.ispoi) {
+#line 1791 ""
s_wsfe(&io___119);
/* Writing concatenation */
+#line 1791 ""
i__2[0] = 1, a__2[0] = sq;
+#line 1791 ""
i__2[1] = 14, a__2[1] = "input musixpoi";
+#line 1791 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
+#line 1791 ""
do_fio(&c__1, ch__3, (ftnlen)15);
+#line 1791 ""
e_wsfe();
+#line 1791 ""
}
+#line 1792 ""
if (combbm_1.isbbm) {
+#line 1792 ""
s_wsfe(&io___120);
/* Writing concatenation */
+#line 1792 ""
i__2[0] = 1, a__2[0] = sq;
+#line 1792 ""
i__2[1] = 14, a__2[1] = "input musixbbm";
+#line 1792 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
+#line 1792 ""
do_fio(&c__1, ch__3, (ftnlen)15);
+#line 1792 ""
e_wsfe();
+#line 1792 ""
}
+#line 1793 ""
if (*figbass) {
/* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */
+#line 1797 ""
L4:
+#line 1797 ""
moveln_(&c__14, &c__12, &done);
+#line 1798 ""
if (! done) {
+#line 1798 ""
goto L4;
+#line 1798 ""
}
+#line 1799 ""
cl__1.cerr = 0;
+#line 1799 ""
cl__1.cunit = 14;
+#line 1799 ""
cl__1.csta = 0;
+#line 1799 ""
f_clos(&cl__1);
+#line 1800 ""
}
+#line 1801 ""
comas3_1.iask = 0;
+#line 1802 ""
ihs = 0;
+#line 1803 ""
L1:
+#line 1803 ""
i__3 = s_rsfe(&io___122);
+#line 1803 ""
if (i__3 != 0) {
+#line 1803 ""
goto L999;
+#line 1803 ""
}
+#line 1803 ""
i__3 = do_fio(&c__1, outq, (ftnlen)129);
+#line 1803 ""
if (i__3 != 0) {
+#line 1803 ""
goto L999;
+#line 1803 ""
}
+#line 1803 ""
i__3 = e_rsfe();
+#line 1803 ""
if (i__3 != 0) {
+#line 1803 ""
goto L999;
+#line 1803 ""
}
/* Hardspaces. */
/* Writing concatenation */
+#line 1807 ""
i__2[0] = 1, a__2[0] = sq;
+#line 1807 ""
i__2[1] = 4, a__2[1] = "xard";
+#line 1807 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5);
+#line 1807 ""
if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) {
+#line 1808 ""
++ihs;
+#line 1809 ""
*(unsigned char *)&outq[1] = 'h';
+#line 1810 ""
s_wsfi(&io___124);
+#line 1810 ""
do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real))
;
+#line 1810 ""
e_wsfi();
+#line 1811 ""
lenout = 19;
+#line 1812 ""
goto L9;
+#line 1813 ""
}
/* This part hard-wires ask's into new .tex file as ast's */
+#line 1817 ""
L2:
/* Writing concatenation */
+#line 1817 ""
i__2[0] = 1, a__2[0] = sq;
+#line 1817 ""
i__2[1] = 3, a__2[1] = "ask";
+#line 1817 ""
s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4);
+#line 1817 ""
indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4);
+#line 1818 ""
if (indxask != 0) {
+#line 1819 ""
++comas3_1.iask;
+#line 1820 ""
putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129)
;
+#line 1821 ""
goto L2;
+#line 1822 ""
}
+#line 1823 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
+#line 1824 ""
L9:
+#line 1825 ""
s_wsfe(&io___127);
+#line 1825 ""
do_fio(&c__1, outq, lenout);
+#line 1825 ""
e_wsfe();
/* If this is the line with "readmod", check for topmods. */
+#line 1829 ""
if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7)
== 0) {
+#line 1830 ""
comas3_1.topmods = FALSE_;
+#line 1831 ""
al__1.aerr = 0;
+#line 1831 ""
al__1.aunit = 16;
+#line 1831 ""
f_rew(&al__1);
+#line 1832 ""
for (il = 1; il <= 1000; ++il) {
+#line 1833 ""
i__3 = s_rsfe(&io___128);
+#line 1833 ""
if (i__3 != 0) {
+#line 1833 ""
goto L8;
+#line 1833 ""
}
+#line 1833 ""
i__3 = do_fio(&c__1, outq, (ftnlen)129);
+#line 1833 ""
if (i__3 != 0) {
+#line 1833 ""
goto L8;
+#line 1833 ""
}
+#line 1833 ""
i__3 = e_rsfe();
+#line 1833 ""
if (i__3 != 0) {
+#line 1833 ""
goto L8;
+#line 1833 ""
}
+#line 1834 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
/* We inserted the '%' in subroutine littex, to guarantee including blank. */
+#line 1838 ""
s_wsfe(&io___129);
+#line 1838 ""
do_fio(&c__1, outq, lenout);
+#line 1838 ""
e_wsfe();
+#line 1839 ""
/* L7: */
+#line 1839 ""
}
+#line 1840 ""
L8:
+#line 1841 ""
cl__1.cerr = 0;
+#line 1841 ""
cl__1.cunit = 16;
+#line 1841 ""
cl__1.csta = 0;
+#line 1841 ""
f_clos(&cl__1);
+#line 1842 ""
}
+#line 1843 ""
goto L1;
+#line 1844 ""
L999:
+#line 1844 ""
cl__1.cerr = 0;
+#line 1844 ""
cl__1.cunit = 11;
+#line 1844 ""
cl__1.csta = 0;
+#line 1844 ""
f_clos(&cl__1);
+#line 1845 ""
cl__1.cerr = 0;
+#line 1845 ""
cl__1.cunit = 12;
+#line 1845 ""
cl__1.csta = 0;
+#line 1845 ""
f_clos(&cl__1);
+#line 1846 ""
return 0;
} /* askfig_ */
@@ -3472,285 +4629,1143 @@ L999:
/* In iunit, looks backward for oldq, overwrites newq */
/* Safest if both are same length! */
+#line 1855 ""
linesback = 0;
+#line 1856 ""
L1:
+#line 1857 ""
al__1.aerr = 0;
+#line 1857 ""
al__1.aunit = *iunit;
+#line 1857 ""
f_back(&al__1);
+#line 1858 ""
io___131.ciunit = *iunit;
+#line 1858 ""
s_rsfe(&io___131);
+#line 1858 ""
do_fio(&c__1, nowq, (ftnlen)128);
+#line 1858 ""
e_rsfe();
+#line 1859 ""
ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold));
/* Save the line just read */
+#line 1863 ""
++linesback;
+#line 1864 ""
s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128);
+#line 1865 ""
if (ndx == 0) {
+#line 1866 ""
al__1.aerr = 0;
+#line 1866 ""
al__1.aunit = *iunit;
+#line 1866 ""
f_back(&al__1);
+#line 1867 ""
goto L1;
+#line 1868 ""
}
/* If here, it's replacement time. */
+#line 1872 ""
i__1 = ndx + *lenold - 1;
/* Writing concatenation */
+#line 1872 ""
i__2[0] = ndx - 1, a__1[0] = nowq;
+#line 1872 ""
i__2[1] = *lennew, a__1[1] = newq;
+#line 1872 ""
i__2[2] = 128 - i__1, a__1[2] = nowq + i__1;
+#line 1872 ""
s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128);
+#line 1874 ""
al__1.aerr = 0;
+#line 1874 ""
al__1.aunit = *iunit;
+#line 1874 ""
f_back(&al__1);
+#line 1875 ""
for (line = linesback; line >= 1; --line) {
+#line 1876 ""
io___136.ciunit = *iunit;
+#line 1876 ""
s_wsfe(&io___136);
+#line 1876 ""
do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128);
+#line 1876 ""
e_wsfe();
+#line 1877 ""
/* L2: */
+#line 1877 ""
}
+#line 1878 ""
return 0;
} /* backfill_ */
/* Subroutine */ int beamend_(char *notexq, integer *lnote, ftnlen notexq_len)
{
/* System generated locals */
- address a__1[4], a__2[3], a__3[2];
- integer i__1, i__2[4], i__3[3], i__4[2];
+ address a__1[13], a__2[2], a__3[6], a__4[4], a__5[5], a__6[3], a__7[7];
+ integer i__1, i__2[13], i__3[2], i__4[6], i__5[4], i__6[5], i__7[3], i__8[
+ 7], i__9;
+ real r__1;
char ch__1[1];
/* Builtin functions */
- integer pow_ii(integer *, integer *);
- /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+ integer pow_ii(integer *, integer *), s_wsfi(icilist *), do_fio(integer *,
+ char *, ftnlen), e_wsfi(void);
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
+ s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
*, ftnlen);
/* Local variables */
extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
+ extern integer igetbits_(integer *, integer *, integer *);
static integer ip, mp, len, imp;
extern integer log2_(integer *);
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static integer nole;
+ static real slen;
static char ulqq[1];
extern /* Subroutine */ int stop1_(void);
extern integer ncmid_(integer *, integer *);
static integer ndsav;
static char tempq[4], noteq[8];
- extern /* Subroutine */ int notex_(char *, integer *, ftnlen), ntrbbb_(
- integer *, char *, char *, integer *, char *, integer *, ftnlen,
- ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *,
- ftnlen);
+ extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
+ static real addoff;
+ extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
+ char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *,
+ integer *, integer *, integer *, ftnlen);
static logical isdotm;
- static integer lnoten, multip;
+ static integer lnoten, multip, nindent;
extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
;
/* Fortran I/O blocks */
- static cilist io___143 = { 0, 6, 0, 0, 0 };
- static cilist io___144 = { 0, 6, 0, 0, 0 };
-
-
+ static icilist io___143 = { 0, tempq, 0, "(f4.1)", 4, 1 };
+ static icilist io___144 = { 0, tempq, 0, "(f4.2)", 4, 1 };
+ static icilist io___147 = { 0, noteq, 0, "(i2)", 2, 1 };
+ static icilist io___149 = { 0, tempq, 0, "(f4.1)", 4, 1 };
+ static icilist io___150 = { 0, tempq, 0, "(f4.2)", 4, 1 };
+ static icilist io___152 = { 0, tempq, 0, "(f4.1)", 4, 1 };
+ static icilist io___153 = { 0, tempq, 0, "(f4.1)", 4, 1 };
+ static cilist io___154 = { 0, 6, 0, 0, 0 };
+ static cilist io___155 = { 0, 6, 0, 0, 0 };
+ static icilist io___159 = { 0, noteq, 0, "(i2)", 2, 1 };
+
+
+#line 1906 ""
ip = all_1.ipo[all_1.jn - 1];
+#line 1907 ""
multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
+#line 1908 ""
+ *lnote = 0;
+#line 1909 ""
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 1913 ""
i__1 = 4 - multip;
+#line 1913 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
+#line 1914 ""
notex_(notexq, lnote, (ftnlen)79);
+#line 1915 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
+#line 1916 ""
return 0;
+#line 1917 ""
}
+#line 1918 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
+#line 1922 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
+#line 1923 ""
--nole;
+#line 1924 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
+#line 1925 ""
++nole;
+#line 1926 ""
}
+
+/* Terminate indented beams for 2-note tremolo if needed */
+
+#line 1930 ""
+ 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 1932 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &
+ c__2, &c__5);
+#line 1933 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
+ commvl_1.ivx - 1] * 24 - 25] == 'u') {
+#line 1934 ""
+ addoff = -1 - nindent * .5f;
+#line 1935 ""
+ } else {
+#line 1936 ""
+ addoff = nindent * .5f + 1;
+#line 1937 ""
+ }
+/* addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) */
+#line 1939 ""
+ addoff += comxtup_1.islope[commvl_1.ivx - 1] * .0822f;
+#line 1940 ""
+ if (addoff < -.05f) {
+#line 1941 ""
+ s_wsfi(&io___143);
+#line 1941 ""
+ do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
+#line 1941 ""
+ e_wsfi();
+#line 1942 ""
+ } else {
+#line 1943 ""
+ s_wsfi(&io___144);
+#line 1943 ""
+ do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
+#line 1943 ""
+ e_wsfi();
+#line 1944 ""
+ }
+/* Writing concatenation */
+#line 1945 ""
+ i__2[0] = 1, a__1[0] = all_1.sq;
+#line 1945 ""
+ i__2[1] = 5, a__1[1] = "raise";
+#line 1945 ""
+ i__2[2] = 4, a__1[2] = tempq;
+#line 1945 ""
+ i__2[3] = 1, a__1[3] = all_1.sq;
+#line 1945 ""
+ i__2[4] = 9, a__1[4] = "internote";
+#line 1945 ""
+ i__2[5] = 1, a__1[5] = all_1.sq;
+#line 1945 ""
+ i__2[6] = 5, a__1[6] = "hbox{";
+#line 1945 ""
+ i__2[7] = 1, a__1[7] = all_1.sq;
+#line 1945 ""
+ i__2[8] = 12, a__1[8] = "loffset{.7}{";
+#line 1945 ""
+ i__2[9] = 1, a__1[9] = all_1.sq;
+#line 1945 ""
+ i__2[10] = 2, a__1[10] = "tb";
+#line 1945 ""
+ i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
+ commvl_1.ivx - 1] * 24 - 25);
+#line 1945 ""
+ i__2[12] = 3, a__1[12] = "0}}";
+#line 1945 ""
+ s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
+#line 1948 ""
+ *lnote = 46;
+#line 1949 ""
+ }
+#line 1950 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam, just put in the right kind of note */
+#line 1954 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+
+/* Rest at end of unbeamed xtup */
+
+#line 1958 ""
+ *lnote = 3;
+#line 1959 ""
+ if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
+/* Writing concatenation */
+#line 1960 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1960 ""
+ i__3[1] = 2, a__2[1] = "sk";
+#line 1960 ""
+ 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 1965 ""
+ return 0;
+#line 1966 ""
+ } else if (multip == 0) {
+/* Writing concatenation */
+#line 1967 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1967 ""
+ i__3[1] = 2, a__2[1] = "qp";
+#line 1967 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 1968 ""
+ } else if (multip == -1) {
+/* Writing concatenation */
+#line 1969 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1969 ""
+ i__3[1] = 2, a__2[1] = "hp";
+#line 1969 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 1970 ""
+ } else if (multip == 1) {
+/* Writing concatenation */
+#line 1971 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1971 ""
+ i__3[1] = 2, a__2[1] = "ds";
+#line 1971 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 1972 ""
+ } else if (multip == 2) {
+/* Writing concatenation */
+#line 1973 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1973 ""
+ i__3[1] = 2, a__2[1] = "qs";
+#line 1973 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 1974 ""
+ } else {
+/* Writing concatenation */
+#line 1975 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 1975 ""
+ i__3[1] = 2, a__2[1] = "hs";
+#line 1975 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 1976 ""
+ }
+
+/* 180106 Deal with possible level tweak */
+
+#line 1980 ""
+ nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 50) % 100 - 50;
+#line 1981 ""
+ if (nole != 0) {
+#line 1982 ""
+ if (abs(nole) < 10) {
+#line 1983 ""
+ i__1 = abs(nole) + 48;
+#line 1983 ""
+ chax_(ch__1, (ftnlen)1, &i__1);
+#line 1983 ""
+ s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
+#line 1984 ""
+ lnoten = 1;
+#line 1985 ""
+ } else {
+#line 1986 ""
+ s_wsfi(&io___147);
+#line 1986 ""
+ i__1 = abs(nole);
+#line 1986 ""
+ do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 1986 ""
+ e_wsfi();
+#line 1987 ""
+ lnoten = 2;
+#line 1988 ""
+ }
+#line 1989 ""
+ if (nole > 0) {
+/* Writing concatenation */
+#line 1990 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 1990 ""
+ i__4[1] = 5, a__3[1] = "raise";
+#line 1990 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 1990 ""
+ i__4[3] = 1, a__3[3] = all_1.sq;
+#line 1990 ""
+ i__4[4] = 9, a__3[4] = "internote";
+#line 1990 ""
+ i__4[5] = *lnote, a__3[5] = notexq;
+#line 1990 ""
+ s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
+#line 1992 ""
+ } else {
+/* Writing concatenation */
+#line 1993 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 1993 ""
+ i__4[1] = 5, a__3[1] = "lower";
+#line 1993 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 1993 ""
+ i__4[3] = 1, a__3[3] = all_1.sq;
+#line 1993 ""
+ i__4[4] = 9, a__3[4] = "internote";
+#line 1993 ""
+ i__4[5] = *lnote, a__3[5] = notexq;
+#line 1993 ""
+ s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
+#line 1995 ""
+ }
+#line 1996 ""
+ *lnote = lnoten + 16 + *lnote;
+#line 1997 ""
+ }
+#line 1998 ""
+ return 0;
+#line 1999 ""
+ }
+#line 2000 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
/* Forced stem direction */
+#line 2004 ""
ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
+#line 2005 ""
i__1 = 4 - multip;
+#line 2005 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
+#line 2006 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
+#line 2006 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
+#line 2006 ""
}
+#line 2008 ""
notex_(notexq, lnote, (ftnlen)79);
+#line 2009 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
+#line 2010 ""
} else {
+#line 2011 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2011 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2012 ""
if (lnoten == 1) {
+#line 2012 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 2012 ""
}
- *lnote = lnoten + 3;
+
+/* To reduce confusion due to this early update of lnote, do it */
+/* below, separately in each case/ */
+/* lnote = lnoten+3 */
+#line 2017 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
{
/* Prior note is not regular-dotted */
- if (multip == 0) {
+#line 2021 ""
+ 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 2026 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
+ 24 - 25], &c__2, &c__5);
+#line 2027 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
+ {
+#line 2028 ""
+ addoff = -1 - nindent * .5f;
+#line 2029 ""
+ } else {
+#line 2030 ""
+ addoff = nindent * .5f + 1;
+#line 2031 ""
+ }
+
+/* Is there an islope here, for unbeamed? */
+
+#line 2035 ""
+ if (addoff < -.05f) {
+#line 2036 ""
+ s_wsfi(&io___149);
+#line 2036 ""
+ do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
+#line 2036 ""
+ e_wsfi();
+#line 2037 ""
+ } else {
+#line 2038 ""
+ s_wsfi(&io___150);
+#line 2038 ""
+ do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
+#line 2038 ""
+ e_wsfi();
+#line 2039 ""
+ }
/* Writing concatenation */
+#line 2040 ""
i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "q";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2040 ""
+ i__2[1] = 5, a__1[1] = "raise";
+#line 2040 ""
+ i__2[2] = 4, a__1[2] = tempq;
+#line 2040 ""
+ i__2[3] = 1, a__1[3] = all_1.sq;
+#line 2040 ""
+ i__2[4] = 9, a__1[4] = "internote";
+#line 2040 ""
+ i__2[5] = 1, a__1[5] = all_1.sq;
+#line 2040 ""
+ i__2[6] = 5, a__1[6] = "hbox{";
+#line 2040 ""
+ i__2[7] = 1, a__1[7] = all_1.sq;
+#line 2040 ""
+ i__2[8] = 12, a__1[8] = "loffset{.7}{";
+#line 2040 ""
+ i__2[9] = 1, a__1[9] = all_1.sq;
+#line 2040 ""
+ i__2[10] = 2, a__1[10] = "tb";
+#line 2040 ""
+ i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2040 ""
+ i__2[12] = 3, a__1[12] = "0}}";
+#line 2040 ""
+ s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
+#line 2044 ""
+ *lnote = 46;
+/* write(11,'(a)')notexq(1:lnote) */
+#line 2046 ""
+ }
+#line 2047 ""
+ if (multip == 0) {
+/* if (btest(irest(ivx,ip-1),2)) then */
+#line 2049 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 -
+ 25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25]
+ > 24) {
+
+/* 2nd note of unbeamed half-note trem; make open */
+/* But it's not clear if unbeamed half-note tremolo is Kosher, */
+/* so don't worry about stem lengths here now. */
+
+#line 2056 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 2057 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2057 ""
+ i__5[1] = 1, a__4[1] = "h";
+#line 2057 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx
+ + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
+ 25);
+#line 2057 ""
+ i__5[3] = 8, a__4[3] = noteq;
+#line 2057 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2058 ""
+ } else {
+/* Writing concatenation */
+#line 2059 ""
+ i__6[0] = 46, a__5[0] = notexq;
+#line 2059 ""
+ i__6[1] = 1, a__5[1] = all_1.sq;
+#line 2059 ""
+ i__6[2] = 1, a__5[2] = "h";
+#line 2059 ""
+ i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx
+ + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
+ 25);
+#line 2059 ""
+ i__6[4] = 8, a__5[4] = noteq;
+#line 2059 ""
+ s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
+#line 2061 ""
+ *lnote = 46;
+#line 2062 ""
+ }
+#line 2063 ""
+ } else {
+#line 2064 ""
+ 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) {
+
+/* Need a dot. */
+
+#line 2069 ""
+ *lnote = 46;
+#line 2070 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2071 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2071 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2071 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2072 ""
+ lnoten = 2;
+#line 2073 ""
+ }
+/* Writing concatenation */
+#line 2074 ""
+ i__5[0] = *lnote, a__4[0] = notexq;
+#line 2074 ""
+ i__5[1] = 1, a__4[1] = all_1.sq;
+#line 2074 ""
+ i__5[2] = 2, a__4[2] = "pt";
+#line 2074 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2074 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2075 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2076 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2076 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2077 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2078 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2078 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2078 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2079 ""
+ lnoten = 2;
+#line 2080 ""
+ }
+
+/* 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 2086 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + (
+ ip - 1) * 24 - 25], &c__2, &c__5);
+#line 2087 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]
+ == 'u') {
+#line 2088 ""
+ 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 2091 ""
+ } else {
+#line 2092 ""
+ 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 2095 ""
+ }
+#line 2096 ""
+ s_wsfi(&io___152);
+#line 2096 ""
+ do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real))
+ ;
+#line 2096 ""
+ e_wsfi();
+/* Writing concatenation */
+#line 2097 ""
+ i__6[0] = 1, a__5[0] = all_1.sq;
+#line 2097 ""
+ i__6[1] = 4, a__5[1] = "slx{";
+#line 2097 ""
+ i__6[2] = 4, a__5[2] = tempq;
+#line 2097 ""
+ i__6[3] = 1, a__5[3] = "}";
+#line 2097 ""
+ i__6[4] = *lnote, a__5[4] = notexq;
+#line 2097 ""
+ s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
+#line 2098 ""
+ *lnote += 10;
+#line 2099 ""
+ }
+#line 2100 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 2101 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2101 ""
+ i__5[1] = 1, a__4[1] = "q";
+#line 2101 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx
+ + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
+ 25);
+#line 2101 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2101 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2103 ""
+ } else {
+/* Writing concatenation */
+#line 2104 ""
+ i__6[0] = *lnote, a__5[0] = notexq;
+#line 2104 ""
+ i__6[1] = 1, a__5[1] = all_1.sq;
+#line 2104 ""
+ i__6[2] = 1, a__5[2] = "q";
+#line 2104 ""
+ i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx
+ + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
+ 25);
+#line 2104 ""
+ i__6[4] = lnoten, a__5[4] = noteq;
+#line 2104 ""
+ s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
+#line 2106 ""
+ }
+#line 2107 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2108 ""
+ 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 2110 ""
+ i__7[0] = *lnote, a__6[0] = notexq;
+#line 2110 ""
+ i__7[1] = 1, a__6[1] = all_1.sq;
+#line 2110 ""
+ i__7[2] = 3, a__6[2] = "slz";
+#line 2110 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2111 ""
+ *lnote += 4;
+#line 2112 ""
+ }
+#line 2113 ""
+ }
+#line 2114 ""
+ } 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 2119 ""
+ *lnote = 46;
+#line 2120 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
+ 24 - 25], &c__2, &c__5);
+#line 2121 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
+ {
+#line 2122 ""
+ 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 2125 ""
+ } else {
+#line 2126 ""
+ 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 2129 ""
+ }
+#line 2130 ""
+ s_wsfi(&io___153);
+#line 2130 ""
+ do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
+#line 2130 ""
+ e_wsfi();
+/* Writing concatenation */
+#line 2131 ""
+ i__6[0] = 46, a__5[0] = notexq;
+#line 2131 ""
+ i__6[1] = 1, a__5[1] = all_1.sq;
+#line 2131 ""
+ i__6[2] = 4, a__5[2] = "slx{";
+#line 2131 ""
+ i__6[3] = 4, a__5[3] = tempq;
+#line 2131 ""
+ i__6[4] = 1, a__5[4] = "}";
+#line 2131 ""
+ s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
+#line 2132 ""
+ *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 2143 ""
+ 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 2147 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2148 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2148 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2148 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2149 ""
+ lnoten = 2;
+#line 2150 ""
+ }
+#line 2151 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 2152 ""
+ i__7[0] = 1, a__6[0] = all_1.sq;
+#line 2152 ""
+ i__7[1] = 2, a__6[1] = "pt";
+#line 2152 ""
+ i__7[2] = lnoten, a__6[2] = noteq;
+#line 2152 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2153 ""
+ } else {
+/* Writing concatenation */
+#line 2154 ""
+ i__5[0] = *lnote, a__4[0] = notexq;
+#line 2154 ""
+ i__5[1] = 1, a__4[1] = all_1.sq;
+#line 2154 ""
+ i__5[2] = 2, a__4[2] = "pt";
+#line 2154 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2154 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2155 ""
+ }
+#line 2156 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2157 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2157 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2158 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2159 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2159 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2159 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2160 ""
+ lnoten = 2;
+#line 2161 ""
+ }
+#line 2162 ""
+ }
+/* Writing concatenation */
+#line 2163 ""
+ i__8[0] = *lnote, a__7[0] = notexq;
+#line 2163 ""
+ i__8[1] = 1, a__7[1] = all_1.sq;
+#line 2163 ""
+ i__8[2] = 1, a__7[2] = "q";
+#line 2163 ""
+ i__8[3] = 1, a__7[3] = all_1.ulq + (commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2163 ""
+ i__8[4] = lnoten, a__7[4] = noteq;
+#line 2163 ""
+ i__8[5] = 1, a__7[5] = all_1.sq;
+#line 2163 ""
+ i__8[6] = 3, a__7[6] = "slz";
+#line 2163 ""
+ s_cat(notexq, a__7, i__8, &c__7, (ftnlen)79);
+/* * //sq//'stemcut' */
+/* lnote=lnote+3+lnoten+8 */
+#line 2168 ""
+ *lnote = *lnote + 3 + lnoten + 4;
+#line 2169 ""
} else if (multip == -1) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "h";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2170 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2170 ""
+ i__5[1] = 1, a__4[1] = "h";
+#line 2170 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2170 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2170 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2171 ""
+ *lnote = lnoten + 3;
+#line 2172 ""
} else if (multip == 1) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "c";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2173 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2173 ""
+ i__5[1] = 1, a__4[1] = "c";
+#line 2173 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2173 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2173 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2174 ""
+ *lnote = lnoten + 3;
+#line 2175 ""
} else if (multip == 2) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 2, a__1[1] = "cc";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2176 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2176 ""
+ i__5[1] = 2, a__4[1] = "cc";
+#line 2176 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
- ++(*lnote);
+#line 2176 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2176 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2177 ""
+ *lnote = lnoten + 4;
+#line 2178 ""
} else if (multip == 3) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 3, a__1[1] = "ccc";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2179 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2179 ""
+ i__5[1] = 3, a__4[1] = "ccc";
+#line 2179 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
- *lnote += 2;
+#line 2179 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2179 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2180 ""
+ *lnote = lnoten + 5;
+#line 2181 ""
} else if (multip == -2) {
/* Writing concatenation */
- i__3[0] = 1, a__2[0] = all_1.sq;
- i__3[1] = 2, a__2[1] = "wh";
- i__3[2] = 8, a__2[2] = noteq;
- s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 2182 ""
+ i__7[0] = 1, a__6[0] = all_1.sq;
+#line 2182 ""
+ i__7[1] = 2, a__6[1] = "wh";
+#line 2182 ""
+ i__7[2] = lnoten, a__6[2] = noteq;
+#line 2182 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2183 ""
+ *lnote = lnoten + 3;
+#line 2184 ""
} else if (multip == -3) {
/* Writing concatenation */
- i__3[0] = 1, a__2[0] = all_1.sq;
- i__3[1] = 5, a__2[1] = "breve";
- i__3[2] = 8, a__2[2] = noteq;
- s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
- *lnote += 3;
+#line 2185 ""
+ i__7[0] = 1, a__6[0] = all_1.sq;
+#line 2185 ""
+ i__7[1] = 5, a__6[1] = "breve";
+#line 2185 ""
+ i__7[2] = lnoten, a__6[2] = noteq;
+#line 2185 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2186 ""
+ *lnote = lnoten + 6;
+#line 2187 ""
} else {
- s_wsle(&io___143);
+#line 2188 ""
+ s_wsle(&io___154);
+#line 2188 ""
e_wsle();
- s_wsle(&io___144);
- do_lio(&c__9, &c__1, "(Error in beamend, send source to "
+#line 2189 ""
+ s_wsle(&io___155);
+#line 2189 ""
+ do_lio(&c__9, &c__1, "(Error in beamend, send source to "\
"Dr. Don)", (ftnlen)42);
+#line 2189 ""
e_wsle();
+#line 2190 ""
stop1_();
+#line 2191 ""
}
+#line 2192 ""
} else {
/* Prior note is regular-dotted so this one is halved */
+#line 2196 ""
if (multip == 0) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "c";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2197 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2197 ""
+ i__5[1] = 1, a__4[1] = "c";
+#line 2197 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2197 ""
+ i__5[3] = 8, a__4[3] = noteq;
+#line 2197 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2198 ""
} else if (multip == -1) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "q";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2199 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2199 ""
+ i__5[1] = 1, a__4[1] = "q";
+#line 2199 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2199 ""
+ i__5[3] = 8, a__4[3] = noteq;
+#line 2199 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2200 ""
} else if (multip == -2) {
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "h";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2201 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2201 ""
+ i__5[1] = 1, a__4[1] = "h";
+#line 2201 ""
+ i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- i__2[3] = 8, a__1[3] = noteq;
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2201 ""
+ i__5[3] = 8, a__4[3] = noteq;
+#line 2201 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2202 ""
}
+#line 2203 ""
+ *lnote = lnoten + 3;
+#line 2204 ""
}
+#line 2205 ""
}
+#line 2206 ""
return 0;
+#line 2207 ""
}
- i__1 = ncmid_(&all_1.iv, &ip);
- notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
- *lnote = 0;
+
+/* End of block for unbeamed. Problem if beamed but ends w/ rest. Try just */
+/* skipping the call in that case. */
+
+#line 2212 ""
+ if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 2213 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2213 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2214 ""
+ }
+/* call notefq(noteq,lnoten,nole,ncmid(iv,ip)) */
+/* lnote = 0 */
/* New way, with flipend, which was computed in beamstrt. */
+#line 2220 ""
if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[
commvl_1.ivx + ip * 24 - 25],30)) {
+#line 2221 ""
i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25];
+#line 2221 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 2221 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx
- 1] * 24 - 25] = *(unsigned char *)&ch__1[0];
+#line 2222 ""
+ strtmid_1.flipend[commvl_1.ivx - 1] = FALSE_;
+#line 2223 ""
}
+#line 2224 ""
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 2228 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) {
/* Prior note is a rest, check one before that */
+#line 2232 ""
mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8;
+#line 2233 ""
} else {
+#line 2234 ""
mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8;
+#line 2235 ""
}
+#line 2236 ""
if (multip > mp) {
/* Assume 1-3, 2-3, or 1-2 */
+#line 2240 ""
i__1 = mp + 1;
+#line 2240 ""
for (imp = multip; imp >= i__1; --imp) {
+#line 2241 ""
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 2242 ""
/* L2: */
+#line 2242 ""
}
+#line 2243 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
{
/* 2nd member of dotted xtup */
+#line 2247 ""
i__1 = multip + 1;
+#line 2247 ""
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 2249 ""
}
+#line 2250 ""
}
/* Beam termination and direction analysis */
+#line 2254 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && !
combjmp_1.isbjmp) {
@@ -3759,130 +5774,477 @@ L1:
/* voice of the 2nd part of jumped beam. (May need special treatment for */
/* multi-segment jump-beams */
+#line 2261 ""
combjmp_1.isbjmp = TRUE_;
+#line 2262 ""
combjmp_1.ivbj1 = commvl_1.ivx;
+#line 2263 ""
combjmp_1.ivbj2 = 0;
+#line 2264 ""
}
+#line 2265 ""
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 2271 ""
*(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
+#line 2272 ""
if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) {
+#line 2273 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+
+/* Xtup ends with rest */
+
+#line 2277 ""
+ if (multip == 1) {
+/* Writing concatenation */
+#line 2278 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2278 ""
+ i__3[1] = 2, a__2[1] = "ds";
+#line 2278 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2279 ""
+ *lnote = 3;
+#line 2280 ""
+ } else if (multip == 2) {
+/* Writing concatenation */
+#line 2281 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2281 ""
+ i__3[1] = 2, a__2[1] = "qs";
+#line 2281 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2282 ""
+ *lnote = 3;
+#line 2283 ""
+ } else if (multip == 3) {
+/* Writing concatenation */
+#line 2284 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2284 ""
+ i__3[1] = 2, a__2[1] = "hs";
+#line 2284 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2285 ""
+ *lnote = 3;
+#line 2286 ""
+ }
+
+/* 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 2292 ""
+ if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
+
+/* Blank rest */
+
+/* Writing concatenation */
+#line 2296 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2296 ""
+ i__3[1] = 2, a__2[1] = "sk";
+#line 2296 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2297 ""
+ *lnote = 3;
+#line 2298 ""
+ } 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 2303 ""
+ if (abs(nole) < 30) {
+#line 2303 ""
+ nole += 100;
+#line 2303 ""
+ }
+
+#line 2305 ""
+ if ((i__1 = nole - 100, abs(i__1)) < 10) {
+#line 2306 ""
+ i__9 = (i__1 = nole - 100, abs(i__1)) + 48;
+#line 2306 ""
+ chax_(ch__1, (ftnlen)1, &i__9);
+#line 2306 ""
+ s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
+#line 2307 ""
+ lnoten = 1;
+#line 2308 ""
+ } else {
+#line 2309 ""
+ s_wsfi(&io___159);
+#line 2309 ""
+ i__9 = (i__1 = nole - 100, abs(i__1));
+#line 2309 ""
+ do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer));
+#line 2309 ""
+ e_wsfi();
+#line 2310 ""
+ lnoten = 2;
+#line 2311 ""
+ }
+/* ??? if (nole .gt. 0) then */
+#line 2313 ""
+ if (nole > 100) {
+/* Writing concatenation */
+#line 2314 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 2314 ""
+ i__4[1] = 5, a__3[1] = "raise";
+#line 2314 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 2314 ""
+ i__4[3] = 1, a__3[3] = all_1.sq;
+#line 2314 ""
+ i__4[4] = 9, a__3[4] = "internote";
+#line 2314 ""
+ i__4[5] = *lnote, a__3[5] = notexq;
+#line 2314 ""
+ s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
+#line 2316 ""
+ } else {
+/* Writing concatenation */
+#line 2317 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 2317 ""
+ i__4[1] = 5, a__3[1] = "lower";
+#line 2317 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 2317 ""
+ i__4[3] = 1, a__3[3] = all_1.sq;
+#line 2317 ""
+ i__4[4] = 9, a__3[4] = "internote";
+#line 2317 ""
+ i__4[5] = *lnote, a__3[5] = notexq;
+#line 2317 ""
+ s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
+#line 2319 ""
+ }
+#line 2320 ""
+ *lnote = lnoten + 16 + *lnote;
+#line 2321 ""
+ }
+#line 2322 ""
+ return 0;
+#line 2323 ""
+ } else {
/* Normal termination */
- i__1 = commvl_1.ivx % 24;
- ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
- ftnlen)1, (ftnlen)79);
+#line 2327 ""
+ i__1 = commvl_1.ivx % 24;
+#line 2327 ""
+ ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
+ ftnlen)1, (ftnlen)79);
+#line 2328 ""
+ }
+#line 2329 ""
} else {
/* Terminate a sequence of jump-beam segments. */
+#line 2333 ""
i__1 = 225 - *(unsigned char *)ulqq;
+#line 2333 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 2333 ""
*(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
+#line 2334 ""
i__1 = combjmp_1.ivbj1 % 24;
+#line 2334 ""
ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
+#line 2335 ""
}
+#line 2336 ""
}
/* Check for end of 2nd seg of staff-jump xtup chord blank rest */
/* if (isbjmp.and.ivx.eq.ivbj2 */
+#line 2341 ""
if (combjmp_1.isbjmp && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
29)) {
/* Writing concatenation */
- i__3[0] = *lnote, a__2[0] = notexq;
- i__3[1] = 1, a__2[1] = all_1.sq;
- i__3[2] = 2, a__2[2] = "sk";
- s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 2343 ""
+ i__7[0] = *lnote, a__6[0] = notexq;
+#line 2343 ""
+ i__7[1] = 1, a__6[1] = all_1.sq;
+#line 2343 ""
+ i__7[2] = 2, a__6[2] = "sk";
+#line 2343 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2344 ""
return 0;
+#line 2345 ""
}
-/* And now the note */
+/* And now the note, checking for open-head beamed tremolo */
- if (*lnote > 0) {
+#line 2349 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) {
+
+/* Check for dotted tremolo */
+
+#line 2353 ""
+ 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 2357 ""
+ if (lnoten == 1) {
/* Writing concatenation */
- i__3[0] = *lnote, a__2[0] = notexq;
- i__3[1] = 1, a__2[1] = all_1.sq;
- i__3[2] = 2, a__2[2] = "qb";
- s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 2358 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2358 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2358 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2359 ""
+ lnoten = 2;
+#line 2360 ""
+ }
+#line 2361 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 2362 ""
+ i__7[0] = 1, a__6[0] = all_1.sq;
+#line 2362 ""
+ i__7[1] = 2, a__6[1] = "pt";
+#line 2362 ""
+ i__7[2] = lnoten, a__6[2] = noteq;
+#line 2362 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2363 ""
+ } else {
+/* Writing concatenation */
+#line 2364 ""
+ i__5[0] = *lnote, a__4[0] = notexq;
+#line 2364 ""
+ i__5[1] = 1, a__4[1] = all_1.sq;
+#line 2364 ""
+ i__5[2] = 2, a__4[2] = "pt";
+#line 2364 ""
+ i__5[3] = lnoten, a__4[3] = noteq;
+#line 2364 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2365 ""
+ }
+#line 2366 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2367 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2367 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+/* Octave changes? */
+#line 2368 ""
+ }
+#line 2369 ""
+ if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 32 || all_1.nodur[
+ commvl_1.ivx + ip * 24 - 25] == 48) {
+#line 2370 ""
+ if (*lnote > 0) {
+/* Writing concatenation */
+#line 2371 ""
+ i__7[0] = *lnote, a__6[0] = notexq;
+#line 2371 ""
+ i__7[1] = 1, a__6[1] = all_1.sq;
+#line 2371 ""
+ i__7[2] = 2, a__6[2] = "hb";
+#line 2371 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2372 ""
+ } else {
+/* Writing concatenation */
+#line 2373 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2373 ""
+ i__3[1] = 2, a__2[1] = "hb";
+#line 2373 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2374 ""
+ }
+#line 2375 ""
+ } else {
+#line 2376 ""
+ if (*lnote > 0) {
+/* Writing concatenation */
+#line 2377 ""
+ i__7[0] = *lnote, a__6[0] = notexq;
+#line 2377 ""
+ i__7[1] = 1, a__6[1] = all_1.sq;
+#line 2377 ""
+ i__7[2] = 2, a__6[2] = "qb";
+#line 2377 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2378 ""
+ } else {
+/* Writing concatenation */
+#line 2379 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2379 ""
+ i__3[1] = 2, a__2[1] = "qb";
+#line 2379 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2380 ""
+ }
+#line 2381 ""
+ }
+#line 2382 ""
} else {
+
+/* No tremolo */
+
+#line 2386 ""
+ if (*lnote > 0) {
+/* Writing concatenation */
+#line 2387 ""
+ i__7[0] = *lnote, a__6[0] = notexq;
+#line 2387 ""
+ i__7[1] = 1, a__6[1] = all_1.sq;
+#line 2387 ""
+ i__7[2] = 2, a__6[2] = "qb";
+#line 2387 ""
+ s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
+#line 2388 ""
+ } else {
/* Writing concatenation */
- i__4[0] = 1, a__3[0] = all_1.sq;
- i__4[1] = 2, a__3[1] = "qb";
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2389 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2389 ""
+ i__3[1] = 2, a__2[1] = "qb";
+#line 2389 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2390 ""
+ }
+#line 2391 ""
}
+#line 2392 ""
*lnote += 3;
+#line 2393 ""
isdotm = FALSE_;
+#line 2394 ""
if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
+#line 2395 ""
i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]);
+#line 2395 ""
if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25])
{
+#line 2396 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
/* Writing concatenation */
- i__4[0] = *lnote, a__3[0] = notexq;
- i__4[1] = 1, a__3[1] = "p";
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2397 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2397 ""
+ i__3[1] = 1, a__2[1] = "p";
+#line 2397 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2398 ""
} else {
/* Writing concatenation */
- i__4[0] = *lnote, a__3[0] = notexq;
- i__4[1] = 1, a__3[1] = "m";
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2399 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2399 ""
+ i__3[1] = 1, a__2[1] = "m";
+#line 2399 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2400 ""
isdotm = TRUE_;
+#line 2401 ""
}
+#line 2402 ""
++(*lnote);
+#line 2403 ""
}
+#line 2404 ""
}
/* 5/25/08 Allow >12 */
/* 5/9/10 Up to 24; replace 24 with 0 */
+#line 2409 ""
if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
-/* call istring(mod(ivx,12),tempq,len) */
+#line 2410 ""
i__1 = commvl_1.ivx % 24;
+#line 2410 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
+#line 2411 ""
} else {
-/* call istring(mod(ivbj1,12),tempq,len) */
+#line 2412 ""
i__1 = combjmp_1.ivbj1 % 24;
+#line 2412 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
+#line 2413 ""
}
+#line 2414 ""
if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) {
+#line 2414 ""
combjmp_1.isbjmp = FALSE_;
+#line 2414 ""
}
/* Writing concatenation */
- i__4[0] = *lnote, a__3[0] = notexq;
- i__4[1] = len, a__3[1] = tempq;
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2416 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2416 ""
+ i__3[1] = len, a__2[1] = tempq;
+#line 2416 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2417 ""
*lnote += len;
/* Writing concatenation */
- i__4[0] = *lnote, a__3[0] = notexq;
- i__4[1] = lnoten, a__3[1] = noteq;
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2418 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2418 ""
+ i__3[1] = lnoten, a__2[1] = noteq;
+#line 2418 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2419 ""
*lnote += lnoten;
+#line 2420 ""
if (isdotm) {
+#line 2421 ""
if (lnoten == 1) {
/* Writing concatenation */
- i__2[0] = *lnote, a__1[0] = notexq;
- i__2[1] = 1, a__1[1] = "{";
- i__2[2] = 1, a__1[2] = noteq;
- i__2[3] = 1, a__1[3] = "}";
- s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79);
+#line 2422 ""
+ i__5[0] = *lnote, a__4[0] = notexq;
+#line 2422 ""
+ i__5[1] = 1, a__4[1] = "{";
+#line 2422 ""
+ i__5[2] = 1, a__4[2] = noteq;
+#line 2422 ""
+ i__5[3] = 1, a__4[3] = "}";
+#line 2422 ""
+ s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
+#line 2423 ""
*lnote += 3;
+#line 2424 ""
} else {
+#line 2425 ""
i__1 = lnoten - 2;
/* Writing concatenation */
- i__4[0] = *lnote, a__3[0] = notexq;
- i__4[1] = lnoten - 1 - i__1, a__3[1] = noteq + i__1;
- s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79);
+#line 2425 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2425 ""
+ i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
+#line 2425 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2426 ""
++(*lnote);
+#line 2427 ""
}
+#line 2428 ""
}
+#line 2429 ""
return 0;
} /* beamend_ */
@@ -3912,7 +6274,7 @@ L1:
extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
extern integer levrn_(integer *, integer *, integer *, integer *, integer
*);
- static integer nlnum, multl, multr;
+ static integer nlnum, ipnow, multl, multr;
extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
char *, integer *, ftnlen, ftnlen, ftnlen);
static integer ipleft;
@@ -3929,18 +6291,28 @@ L1:
extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
;
+#line 2459 ""
*lnote = 0;
+#line 2460 ""
ip = all_1.ipo[all_1.jn - 1];
+#line 2461 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
+#line 2465 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
+#line 2466 ""
--nole;
+#line 2467 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
+#line 2468 ""
++nole;
+#line 2469 ""
}
+#line 2470 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 2471 ""
multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
/* if (btest(islur(ivx,ip-1),3)) multip = multip+1 */
@@ -3950,229 +6322,371 @@ L1:
/* embedded xtup with number, due to ordering/octave feature. */
/* call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */
+#line 2480 ""
}
+#line 2481 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) {
+#line 2481 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
+#line 2481 ""
}
+#line 2482 ""
if (comxtup_1.vxtup[commvl_1.ivx - 1]) {
/* In an xtup */
+#line 2486 ""
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 2490 ""
i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8);
+#line 2490 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
+#line 2491 ""
notex_(notexq, lnote, (ftnlen)79);
/* Re-zero so next note does not get confused */
+#line 2495 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0;
+#line 2496 ""
return 0;
+#line 2497 ""
}
+#line 2498 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam, just put in the right kind of note */
+#line 2502 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
/* Forced stem direction */
+#line 2506 ""
ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
+#line 2507 ""
i__1 = 4 - multip;
+#line 2507 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &
i__1);
+#line 2508 ""
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 2510 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[
commvl_1.ivx + ip * 24 - 25] * 3 / 2;
+#line 2511 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 -
25],27)) {
+#line 2512 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
+#line 2513 ""
}
+#line 2514 ""
notex_(notexq, lnote, (ftnlen)79);
+#line 2515 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
+#line 2516 ""
} else {
/* Use ulq for stem direction */
+#line 2520 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2520 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2521 ""
if (lnoten == 1) {
+#line 2521 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 2521 ""
}
+#line 2522 ""
*lnote = 3;
+#line 2523 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],
27)) {
/* Prior note of xtup is not regular-dotted */
+#line 2527 ""
if (multip == 0) {
/* Writing concatenation */
+#line 2528 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2528 ""
i__2[1] = 1, a__1[1] = "q";
+#line 2528 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2528 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2529 ""
} else if (multip == -1) {
/* Writing concatenation */
+#line 2530 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2530 ""
i__2[1] = 1, a__1[1] = "h";
+#line 2530 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2530 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2531 ""
} else if (multip == 1) {
/* Writing concatenation */
+#line 2532 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2532 ""
i__2[1] = 1, a__1[1] = "c";
+#line 2532 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2532 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2533 ""
} else if (multip == 2) {
/* Writing concatenation */
+#line 2534 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2534 ""
i__2[1] = 2, a__1[1] = "cc";
+#line 2534 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2534 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2535 ""
*lnote = 4;
+#line 2536 ""
} else if (multip == 3) {
/* Writing concatenation */
+#line 2537 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2537 ""
i__2[1] = 3, a__1[1] = "ccc";
+#line 2537 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2537 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2538 ""
*lnote = 5;
+#line 2539 ""
} else if (multip == -2) {
/* Writing concatenation */
+#line 2540 ""
i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2540 ""
i__3[1] = 2, a__2[1] = "wh";
+#line 2540 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2541 ""
}
+#line 2542 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27))
{
/* This xtup note is regular dotted non-beamed xtup */
/* Writing concatenation */
+#line 2546 ""
i__3[0] = 3, a__2[0] = notexq;
+#line 2546 ""
i__3[1] = 1, a__2[1] = "p";
+#line 2546 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2547 ""
*lnote = 4;
+#line 2548 ""
}
+#line 2549 ""
} else {
/* Prior note of xtup is regular-dotted so this one is halved */
+#line 2553 ""
if (multip == 2) {
/* Writing concatenation */
+#line 2554 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2554 ""
i__2[1] = 3, a__1[1] = "ccc";
+#line 2554 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2554 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2555 ""
*lnote = 5;
+#line 2556 ""
} else if (multip == 1) {
/* Writing concatenation */
+#line 2557 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2557 ""
i__2[1] = 2, a__1[1] = "cc";
+#line 2557 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2557 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2558 ""
*lnote = 4;
+#line 2559 ""
} else if (multip == 0) {
/* Writing concatenation */
+#line 2560 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2560 ""
i__2[1] = 1, a__1[1] = "c";
+#line 2560 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2560 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2561 ""
} else if (multip == -1) {
/* Writing concatenation */
+#line 2562 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2562 ""
i__2[1] = 1, a__1[1] = "q";
+#line 2562 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2562 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2563 ""
} else if (multip == -2) {
/* Writing concatenation */
+#line 2564 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2564 ""
i__2[1] = 1, a__1[1] = "h";
+#line 2564 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2564 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2565 ""
}
+#line 2566 ""
}
/* Writing concatenation */
+#line 2567 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2567 ""
i__3[1] = 8, a__2[1] = noteq;
+#line 2567 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2568 ""
*lnote += lnoten;
+#line 2569 ""
}
+#line 2570 ""
return 0;
+#line 2571 ""
} else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
/* In the beamed xtup but not the last note */
+#line 2575 ""
if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) {
/* Embedded Xtup, mult>0, starts here. Put in number if needed */
+#line 2579 ""
++comxtup_1.nxtinbm[commvl_1.ivx - 1];
+#line 2580 ""
iud = 1;
+#line 2581 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
+#line 2581 ""
iud = -1;
+#line 2581 ""
}
/* Get ip#, notelevel of middle note (or gap) in xtup */
+#line 2585 ""
ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] / 2;
+#line 2586 ""
i__1 = ncmid_(&all_1.iv, &ipmid);
+#line 2586 ""
i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
+#line 2586 ""
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 2588 ""
if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] % 2 == 0) {
+#line 2588 ""
i__4 = ipmid - 1;
+#line 2588 ""
i__1 = ncmid_(&all_1.iv, &i__4);
+#line 2588 ""
i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 -
25]) - 8;
+#line 2588 ""
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 2588 ""
}
+#line 2591 ""
iflop = 0;
+#line 2592 ""
if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) <
3.f) {
+#line 2592 ""
iflop = -iud;
+#line 2592 ""
}
+#line 2593 ""
iup = iud + (iflop << 1);
+#line 2594 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) {
+#line 2595 ""
iup = -iup;
+#line 2596 ""
iflop = 0;
+#line 2597 ""
if (iud * iup < 0) {
+#line 2597 ""
iflop = iup;
+#line 2597 ""
}
+#line 2598 ""
}
/* Place number if needed */
+#line 2602 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) {
+#line 2603 ""
mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 -
25], &c__5, &c__22);
+#line 2604 ""
if (mprint == 0) {
+#line 2604 ""
mprint = comxtup_1.mtupv[commvl_1.ivx +
comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25]
;
+#line 2604 ""
}
+#line 2605 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2605 ""
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], &
@@ -4183,507 +6697,1273 @@ L1:
commvl_1.ivx + ip * 24 - 25], &all_1.mult[
commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen)
79);
-/* * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.) */
+#line 2610 ""
}
+#line 2611 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2611 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2612 ""
} else {
/* Intermediate note of xtup */
+#line 2616 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2616 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2617 ""
}
+#line 2618 ""
} else {
/* Last note of xtup (but not last note of beam!) */
+#line 2622 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2622 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2623 ""
}
+#line 2624 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 2625 ""
notex_(notexq, lnote, (ftnlen)79);
+#line 2626 ""
return 0;
+#line 2627 ""
} else {
+#line 2628 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 2628 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
- }
+#line 2629 ""
+ }
+
+/* Check for string of rests up to and including last note in xtup. */
+
+/* Replace next 2 lines to keep from doing this block */
+/* when in second part of staff-jumping chordal xtup. This fix could */
+/* 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 2638 ""
+ 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 &&
+ commvl_1.ivx == combjmp_1.ivbj2)) {
+
+/* This note is not a rest but next is a rest. Do rests continue to */
+/* end of xtup, where nodur>0 */
+
+#line 2645 ""
+ i__1 = ip + 24;
+#line 2645 ""
+ for (ipnow = ip + 1; ipnow <= i__1; ++ipnow) {
+#line 2646 ""
+ if (all_1.nodur[commvl_1.ivx + ipnow * 24 - 25] > 0) {
+#line 2646 ""
+ goto L4;
+#line 2646 ""
+ }
+/* This is last of xtup */
+#line 2647 ""
+ if (! bit_test(all_1.irest[commvl_1.ivx + (ipnow + 1) * 24 - 25],
+ 0)) {
+#line 2647 ""
+ goto L5;
+#line 2647 ""
+ }
+
+/* If I don't go to 5, know next note IS a rest! */
+
+/* Next is not */
+#line 2651 ""
+/* L3: */
+#line 2651 ""
+ }
+#line 2652 ""
+L4:
+#line 2653 ""
+ 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 2654 ""
+ i__2[0] = *lnote, a__1[0] = notexq;
+#line 2654 ""
+ i__2[1] = 1, a__1[1] = all_1.sq;
+#line 2654 ""
+ i__2[2] = 2, a__1[2] = "qb";
+#line 2654 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2655 ""
+ *lnote += 3;
+#line 2656 ""
+ istring_(&commvl_1.ivx, tempq, &len, (ftnlen)4);
+/* Writing concatenation */
+#line 2657 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2657 ""
+ i__3[1] = len, a__2[1] = tempq;
+#line 2657 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2658 ""
+ *lnote += len;
+/* Writing concatenation */
+#line 2659 ""
+ i__3[0] = *lnote, a__2[0] = notexq;
+#line 2659 ""
+ i__3[1] = lnoten, a__2[1] = noteq;
+#line 2659 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2660 ""
+ *lnote += lnoten;
+#line 2661 ""
+ return 0;
+#line 2662 ""
+L5:
/* Check if multiplicity changes in a way requiring action, */
/* unless (160211) it's blank rest on start of 2nd seg of joined beam */
- 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 2667 ""
+ ;
+#line 2667 ""
+ } 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 2669 ""
ipleft = ip - 1;
+#line 2670 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) {
+#line 2670 ""
--ipleft;
+#line 2670 ""
}
+#line 2671 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) {
+#line 2672 ""
multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8;
+#line 2673 ""
} else {
+#line 2674 ""
multl = 1;
+#line 2675 ""
}
+#line 2676 ""
mub = multip - multl;
+#line 2677 ""
ipright = ip + 1;
+#line 2678 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) {
+#line 2678 ""
++ipright;
+#line 2678 ""
}
+#line 2679 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) {
+#line 2680 ""
multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8;
+#line 2681 ""
} else {
+#line 2682 ""
multr = 1;
+#line 2683 ""
}
+#line 2684 ""
mua = multr - multip;
+#line 2685 ""
if (mub > 0 || mua < 0) {
/* Multiplicity has increased from left or will decrease to right. Need action. */
+#line 2689 ""
if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) {
+#line 2690 ""
ivb = combjmp_1.ivbj1;
+#line 2691 ""
i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
+#line 2691 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 2691 ""
*(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
+#line 2692 ""
} else {
+#line 2693 ""
ivb = commvl_1.ivx;
+#line 2694 ""
*(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[
commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25];
+#line 2695 ""
}
+#line 2696 ""
if (mua >= 0) {
+#line 2697 ""
ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
/* else if (multl .ge. multr) then */
/* Test for next note being blank rest, assuming staff-crossing */
/* xtup chord */
+#line 2702 ""
} else if (multl >= multr && ! bit_test(all_1.islur[commvl_1.ivx
+ (ip + 1) * 24 - 25],29)) {
+#line 2704 ""
i__1 = multr + 1;
+#line 2704 ""
for (im = multip; im >= i__1; --im) {
+#line 2705 ""
ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
+#line 2706 ""
/* L1: */
+#line 2706 ""
}
/* else */
/* Test for next note being blank rest, assuming staff-crossing */
/* xtup chord */
+#line 2711 ""
} else if (! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 -
25],29)) {
+#line 2712 ""
i__1 = multip;
+#line 2712 ""
for (im = multr + 1; im <= i__1; ++im) {
+#line 2713 ""
ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
+#line 2714 ""
/* L2: */
+#line 2714 ""
}
+#line 2715 ""
ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
+#line 2716 ""
}
+#line 2717 ""
} else if (ip > 1) {
/* Check for 2nd member of dotted xtup */
+#line 2721 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
+#line 2721 ""
i__1 = multip + 1;
+#line 2721 ""
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 2721 ""
}
+#line 2723 ""
}
+#line 2724 ""
}
/* Now put in the note */
+#line 2728 ""
if (*lnote > 0) {
/* Writing concatenation */
+#line 2729 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 2729 ""
i__2[1] = 1, a__1[1] = all_1.sq;
+#line 2729 ""
i__2[2] = 2, a__1[2] = "qb";
+#line 2729 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2730 ""
} else {
/* Writing concatenation */
+#line 2731 ""
i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2731 ""
i__3[1] = 2, a__2[1] = "qb";
+#line 2731 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2732 ""
}
+#line 2733 ""
*lnote += 3;
+#line 2734 ""
isdotm = FALSE_;
+#line 2735 ""
if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
/* rule out ')' */
+#line 2739 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
+#line 2740 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
/* Writing concatenation */
+#line 2741 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2741 ""
i__3[1] = 1, a__2[1] = "p";
+#line 2741 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2742 ""
} else {
/* Double dot */
/* Writing concatenation */
+#line 2746 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2746 ""
i__3[1] = 2, a__2[1] = "pp";
+#line 2746 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2747 ""
++(*lnote);
+#line 2748 ""
}
+#line 2749 ""
} else {
/* Writing concatenation */
+#line 2750 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2750 ""
i__3[1] = 1, a__2[1] = "m";
+#line 2750 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2751 ""
isdotm = TRUE_;
+#line 2752 ""
}
+#line 2753 ""
++(*lnote);
+#line 2754 ""
} 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 2759 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2759 ""
i__3[1] = 1, a__2[1] = "p";
+#line 2759 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2760 ""
++(*lnote);
+#line 2761 ""
}
/* 5/25/08 Allow >12 */
+#line 2765 ""
if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
/* call istring(mod(ivx,12),tempq,len) */
+#line 2767 ""
i__1 = commvl_1.ivx % 24;
+#line 2767 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
+#line 2768 ""
} else {
/* call istring(mod(ivbj1,12),tempq,len) */
+#line 2770 ""
i__1 = combjmp_1.ivbj1 % 24;
+#line 2770 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
+#line 2771 ""
}
/* Writing concatenation */
+#line 2772 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2772 ""
i__3[1] = len, a__2[1] = tempq;
+#line 2772 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2773 ""
*lnote += len;
/* Writing concatenation */
+#line 2774 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2774 ""
i__3[1] = lnoten, a__2[1] = noteq;
+#line 2774 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2775 ""
*lnote += lnoten;
+#line 2776 ""
if (isdotm) {
+#line 2777 ""
if (lnoten == 2) {
/* Writing concatenation */
+#line 2778 ""
i__6[0] = *lnote, a__3[0] = notexq;
+#line 2778 ""
i__6[1] = 1, a__3[1] = "{";
+#line 2778 ""
i__6[2] = 1, a__3[2] = noteq + 1;
+#line 2778 ""
i__6[3] = 1, a__3[3] = "}";
+#line 2778 ""
s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79);
+#line 2779 ""
*lnote += 3;
+#line 2780 ""
} else {
+#line 2781 ""
i__1 = lnoten - 2;
/* Writing concatenation */
+#line 2781 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2781 ""
i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
+#line 2781 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2782 ""
++(*lnote);
+#line 2783 ""
}
+#line 2784 ""
}
+#line 2785 ""
return 0;
} /* beamid_ */
/* Subroutine */ int beamn1_(char *notexq, integer *lnote, ftnlen notexq_len)
{
/* System generated locals */
- address a__1[3], a__2[2], a__3[4];
- integer i__1, i__2[3], i__3[2], i__4[4];
+ address a__1[3], a__2[2], a__3[4], a__4[5], a__5[7];
+ integer i__1, i__2[3], i__3[2], i__4[4], i__5[5], i__6[7];
+ real r__1;
/* Builtin functions */
integer pow_ii(integer *, integer *);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
- integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
- *, ftnlen);
+ integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
+ , s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *,
+ char *, ftnlen);
/* Local variables */
extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
- static integer nd, im, ip1, len;
+ extern integer igetbits_(integer *, integer *, integer *);
+ static integer nd, im, ip, ip1, len;
extern integer log2_(integer *);
static integer nole;
+ static real slen;
extern /* Subroutine */ int stop1_(void);
extern integer ncmid_(integer *, integer *);
static integer ndsav;
- static char noteq[8];
+ static char noteq[8], tempq[8];
extern /* Subroutine */ int notex_(char *, integer *, ftnlen);
static integer multr;
extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *,
integer *, integer *, integer *, ftnlen);
static logical isdotm;
- static integer lnoten, multip;
+ static integer lnoten, multip, nindent;
extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
;
/* Fortran I/O blocks */
- static cilist io___182 = { 0, 6, 0, 0, 0 };
- static cilist io___183 = { 0, 6, 0, 0, 0 };
+ static icilist io___198 = { 0, tempq, 0, "(f4.1)", 8, 1 };
+ static icilist io___199 = { 0, tempq, 0, "(f4.1)", 8, 1 };
+ static cilist io___200 = { 0, 6, 0, 0, 0 };
+ static cilist io___201 = { 0, 6, 0, 0, 0 };
+#line 2811 ""
ip1 = all_1.ipo[all_1.jn - 1];
+#line 2812 ""
multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8;
-/* if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then */
+#line 2813 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[
commvl_1.ivx + ip1 * 24 - 25],0)) {
+#line 2814 ""
*lnote = 0;
/* The rest was already written in beamstrt, so just get out of here */
+#line 2818 ""
return 0;
+#line 2819 ""
}
+#line 2820 ""
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 2824 ""
if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25],
30)) {
+#line 2825 ""
--nole;
+#line 2826 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] *
24 - 25],31)) {
+#line 2827 ""
++nole;
+#line 2828 ""
}
+#line 2829 ""
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 2833 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) {
/* Forced stem direction */
+#line 2837 ""
ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25];
+#line 2838 ""
i__1 = 4 - multip;
+#line 2838 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1);
+#line 2839 ""
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 2839 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[
commvl_1.ivx + ip1 * 24 - 25] * 3 / 2;
+#line 2839 ""
}
+#line 2841 ""
notex_(notexq, lnote, (ftnlen)79);
+#line 2842 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav;
+#line 2843 ""
} else {
+#line 2844 ""
i__1 = ncmid_(&all_1.iv, &ip1);
+#line 2844 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2845 ""
if (lnoten == 1) {
+#line 2845 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 2845 ""
}
+#line 2846 ""
*lnote = 3;
- if (multip == 0) {
+#line 2847 ""
+ if (multip <= 0) {
+/* if (btest(irest(ivx,ip1),2) .and. */
+/* * nodur(ivx,ip1+1).ge.32) then */
+#line 2850 ""
+ 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) {
+
+/* 1st note of unbeamed half-note trem; make open */
+
/* Writing concatenation */
- i__2[0] = 1, a__1[0] = all_1.sq;
- i__2[1] = 1, a__1[1] = "q";
- i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+#line 2856 ""
+ i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2856 ""
+ i__2[1] = 1, a__1[1] = "h";
+#line 2856 ""
+ i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2856 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2857 ""
+ } else if (multip == -2) {
+/* Writing concatenation */
+#line 2858 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2858 ""
+ i__3[1] = 2, a__2[1] = "wh";
+#line 2858 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2859 ""
+ } else {
+/* Writing concatenation */
+#line 2860 ""
+ i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2860 ""
+ i__2[1] = 1, a__1[1] = "q";
+#line 2860 ""
+ i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2860 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2861 ""
+ }
+
+/* Check for dot */
+
+#line 2865 ""
+ 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) {
+/* * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then */
+
+/* Need a dot. already called addblank for noteq */
+
+#line 2871 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 2872 ""
+ i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2872 ""
+ i__2[1] = 2, a__1[1] = "pt";
+#line 2872 ""
+ i__2[2] = lnoten, a__1[2] = noteq;
+#line 2872 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2873 ""
+ } else {
+/* Writing concatenation */
+#line 2874 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 2874 ""
+ i__4[1] = 2, a__3[1] = "pt";
+#line 2874 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 2874 ""
+ i__4[3] = *lnote, a__3[3] = notexq;
+#line 2874 ""
+ s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 2875 ""
+ }
+#line 2876 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2877 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2877 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+/* Octave chang */
+#line 2878 ""
+ if (lnoten == 1) {
+#line 2878 ""
+ addblank_(noteq, &lnoten, (ftnlen)8);
+#line 2878 ""
+ }
+#line 2879 ""
+ }
+
+/* Insert the stemlength calcs here for dotted, unbeamed. */
+/* Later may combine with below to avoid repeat. */
+
+#line 2884 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) {
+#line 2885 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24
+ - 25], &c__2, &c__5);
+#line 2886 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
+ {
+#line 2887 ""
+ 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 2889 ""
+ } else {
+#line 2890 ""
+ 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 2892 ""
+ }
+#line 2893 ""
+ s_wsfi(&io___198);
+#line 2893 ""
+ do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
+#line 2893 ""
+ e_wsfi();
+/* Writing concatenation */
+#line 2894 ""
+ i__5[0] = 1, a__4[0] = all_1.sq;
+#line 2894 ""
+ i__5[1] = 4, a__4[1] = "slx{";
+#line 2894 ""
+ i__5[2] = 4, a__4[2] = tempq;
+#line 2894 ""
+ i__5[3] = 1, a__4[3] = "}";
+#line 2894 ""
+ i__5[4] = *lnote, a__4[4] = notexq;
+#line 2894 ""
+ s_cat(notexq, a__4, i__5, &c__5, (ftnlen)79);
+#line 2896 ""
+ *lnote += 10;
+#line 2897 ""
+ }
+#line 2898 ""
+ } else if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2))
+ {
+
+/* 1st note of unbeamed quarter or 8th trem, make a quarter note */
+
+/* Stem length calcs here. The .2 factor is empirical, but */
+/* slfac accounts for musicsize. */
+
+#line 2905 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 - 25]
+ , &c__2, &c__5);
+#line 2906 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
+ commvl_1.ivx - 1] * 24 - 25] == 'u') {
+#line 2907 ""
+ 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 2909 ""
+ } else {
+#line 2910 ""
+ 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 2912 ""
+ }
+#line 2913 ""
+ s_wsfi(&io___199);
+#line 2913 ""
+ do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
+#line 2913 ""
+ e_wsfi();
+/* Writing concatenation */
+#line 2914 ""
+ i__6[0] = 1, a__5[0] = all_1.sq;
+#line 2914 ""
+ i__6[1] = 4, a__5[1] = "slx{";
+#line 2914 ""
+ i__6[2] = 4, a__5[2] = tempq;
+#line 2914 ""
+ i__6[3] = 1, a__5[3] = "}";
+#line 2914 ""
+ i__6[4] = 1, a__5[4] = all_1.sq;
+#line 2914 ""
+ i__6[5] = 1, a__5[5] = "q";
+#line 2914 ""
+ i__6[6] = 1, a__5[6] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
- s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2914 ""
+ s_cat(notexq, a__5, i__6, &c__7, (ftnlen)79);
+#line 2916 ""
+ *lnote = 13;
+
+/* Check for dotted 2-note trem; prepend dot to notexq if needed */
+
+#line 2920 ""
+ if (all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 ||
+ all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24)
+ {
+#line 2922 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2923 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2923 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2923 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2924 ""
+ lnoten = 2;
+#line 2925 ""
+ }
+/* Writing concatenation */
+#line 2926 ""
+ i__4[0] = 1, a__3[0] = all_1.sq;
+#line 2926 ""
+ i__4[1] = 2, a__3[1] = "pt";
+#line 2926 ""
+ i__4[2] = lnoten, a__3[2] = noteq;
+#line 2926 ""
+ i__4[3] = *lnote, a__3[3] = notexq;
+#line 2926 ""
+ s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 2927 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 2928 ""
+ i__1 = ncmid_(&all_1.iv, &ip1);
+#line 2928 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2929 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2930 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2930 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2930 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2931 ""
+ lnoten = 2;
+#line 2932 ""
+ }
+#line 2933 ""
+ }
+#line 2934 ""
} else if (multip == -1) {
/* Writing concatenation */
+#line 2935 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2935 ""
i__2[1] = 1, a__1[1] = "h";
+#line 2935 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2935 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2936 ""
} else if (multip == 1) {
/* Writing concatenation */
+#line 2937 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2937 ""
i__2[1] = 1, a__1[1] = "c";
+#line 2937 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2937 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2938 ""
} else if (multip == 2) {
/* Writing concatenation */
+#line 2939 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2939 ""
i__2[1] = 2, a__1[1] = "cc";
+#line 2939 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2939 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2940 ""
*lnote = 4;
+#line 2941 ""
} else if (multip == 3) {
/* Writing concatenation */
+#line 2942 ""
i__2[0] = 1, a__1[0] = all_1.sq;
+#line 2942 ""
i__2[1] = 3, a__1[1] = "ccc";
+#line 2942 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
+#line 2942 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2943 ""
*lnote = 5;
+#line 2944 ""
} else if (multip == -2) {
/* Writing concatenation */
+#line 2945 ""
i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2945 ""
i__3[1] = 2, a__2[1] = "wh";
+#line 2945 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2946 ""
} else if (multip == -3) {
/* Writing concatenation */
+#line 2947 ""
i__3[0] = 1, a__2[0] = all_1.sq;
+#line 2947 ""
i__3[1] = 5, a__2[1] = "breve";
+#line 2947 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2948 ""
*lnote = 6;
+#line 2949 ""
} else {
- s_wsle(&io___182);
+#line 2950 ""
+ s_wsle(&io___200);
+#line 2950 ""
e_wsle();
- s_wsle(&io___183);
- do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"
+#line 2951 ""
+ s_wsle(&io___201);
+#line 2951 ""
+ do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"\
"on)", (ftnlen)41);
+#line 2951 ""
e_wsle();
+#line 2952 ""
stop1_();
+#line 2953 ""
}
+#line 2954 ""
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 2957 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2957 ""
i__3[1] = 1, a__2[1] = "p";
+#line 2957 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2958 ""
++(*lnote);
+#line 2959 ""
}
/* Writing concatenation */
+#line 2960 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 2960 ""
i__3[1] = 8, a__2[1] = noteq;
+#line 2960 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 2961 ""
*lnote += lnoten;
+#line 2962 ""
}
+#line 2963 ""
return 0;
+#line 2964 ""
}
/* Check if mult. decreases from 1st note to 2nd */
+#line 2968 ""
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 2973 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) {
+#line 2974 ""
multr = 1;
+#line 2975 ""
} else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25],
0)) {
+#line 2976 ""
multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8;
+#line 2977 ""
} else {
+#line 2978 ""
multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8;
+#line 2979 ""
}
+#line 2980 ""
*lnote = 0;
+#line 2981 ""
if (multr < multip) {
+#line 2982 ""
i__1 = multr + 1;
+#line 2982 ""
for (im = multip; im >= i__1; --im) {
+#line 2983 ""
ntrbbb_(&im, "r", 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 2984 ""
/* L1: */
+#line 2984 ""
}
+#line 2985 ""
}
+#line 2986 ""
}
-/* Put in the note */
+/* Check for beamed, dotted 2-note tremolo */
- if (*lnote > 0) {
+#line 2990 ""
+ 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 2992 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 2992 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 2993 ""
+ if (lnoten == 1) {
/* Writing concatenation */
- i__2[0] = *lnote, a__1[0] = notexq;
- i__2[1] = 1, a__1[1] = all_1.sq;
- i__2[2] = 2, a__1[2] = "qb";
- s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 2994 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2994 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2994 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2995 ""
+ lnoten = 2;
+#line 2996 ""
+ }
+#line 2997 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 2998 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 2998 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 2998 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 2999 ""
+ lnoten = 2;
+#line 3000 ""
+ }
+#line 3001 ""
+ if (*lnote == 0) {
+/* Writing concatenation */
+#line 3002 ""
+ i__2[0] = 1, a__1[0] = all_1.sq;
+#line 3002 ""
+ i__2[1] = 2, a__1[1] = "pt";
+#line 3002 ""
+ i__2[2] = lnoten, a__1[2] = noteq;
+#line 3002 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 3003 ""
+ } else {
+/* Writing concatenation */
+#line 3004 ""
+ i__4[0] = *lnote, a__3[0] = notexq;
+#line 3004 ""
+ i__4[1] = 1, a__3[1] = all_1.sq;
+#line 3004 ""
+ i__4[2] = 2, a__3[2] = "pt";
+#line 3004 ""
+ i__4[3] = lnoten, a__3[3] = noteq;
+#line 3004 ""
+ s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 3005 ""
+ }
+#line 3006 ""
+ *lnote = *lnote + 3 + lnoten;
+#line 3007 ""
+ i__1 = ncmid_(&all_1.iv, &ip);
+#line 3007 ""
+ notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 3008 ""
+ if (lnoten == 1) {
+/* Writing concatenation */
+#line 3009 ""
+ i__3[0] = 1, a__2[0] = " ";
+#line 3009 ""
+ i__3[1] = 1, a__2[1] = noteq;
+#line 3009 ""
+ s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
+#line 3010 ""
+ lnoten = 2;
+#line 3011 ""
+ }
+#line 3012 ""
+ }
+
+/* Put in the note, but check first for open-head beamed tremolo. */
+
+#line 3016 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && all_1.nodur[
+ commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32) {
+#line 3017 ""
+ if (*lnote > 0) {
+/* Writing concatenation */
+#line 3018 ""
+ i__2[0] = *lnote, a__1[0] = notexq;
+#line 3018 ""
+ i__2[1] = 1, a__1[1] = all_1.sq;
+#line 3018 ""
+ i__2[2] = 2, a__1[2] = "hb";
+#line 3018 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 3019 ""
+ } else {
+/* Writing concatenation */
+#line 3020 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 3020 ""
+ i__3[1] = 2, a__2[1] = "hb";
+#line 3020 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3021 ""
+ }
+#line 3022 ""
} else {
+#line 3023 ""
+ if (*lnote > 0) {
/* Writing concatenation */
- i__3[0] = 1, a__2[0] = all_1.sq;
- i__3[1] = 2, a__2[1] = "qb";
- s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3024 ""
+ i__2[0] = *lnote, a__1[0] = notexq;
+#line 3024 ""
+ i__2[1] = 1, a__1[1] = all_1.sq;
+#line 3024 ""
+ i__2[2] = 2, a__1[2] = "qb";
+#line 3024 ""
+ s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
+#line 3025 ""
+ } else {
+/* Writing concatenation */
+#line 3026 ""
+ i__3[0] = 1, a__2[0] = all_1.sq;
+#line 3026 ""
+ i__3[1] = 2, a__2[1] = "qb";
+#line 3026 ""
+ s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3027 ""
+ }
+#line 3028 ""
}
+#line 3029 ""
*lnote += 3;
/* Check for dot */
+#line 3033 ""
isdotm = FALSE_;
+#line 3034 ""
if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
+#line 3035 ""
nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25];
+#line 3036 ""
if (nd != 0) {
+#line 3037 ""
i__1 = log2_(&nd);
+#line 3037 ""
if (pow_ii(&c__2, &i__1) != nd) {
+#line 3038 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) {
+#line 3039 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],
3)) {
/* Writing concatenation */
+#line 3040 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3040 ""
i__3[1] = 1, a__2[1] = "p";
+#line 3040 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3041 ""
} else {
/* Double dot */
/* Writing concatenation */
+#line 3045 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3045 ""
i__3[1] = 2, a__2[1] = "pp";
+#line 3045 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3046 ""
++(*lnote);
+#line 3047 ""
}
+#line 3048 ""
} else {
/* Writing concatenation */
+#line 3049 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3049 ""
i__3[1] = 1, a__2[1] = "m";
+#line 3049 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3050 ""
isdotm = TRUE_;
+#line 3051 ""
}
+#line 3052 ""
++(*lnote);
+#line 3053 ""
}
+#line 3054 ""
}
+#line 3055 ""
} 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 3060 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3060 ""
i__3[1] = 1, a__2[1] = "p";
+#line 3060 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3061 ""
++(*lnote);
+#line 3062 ""
}
/* Do the number; 0 if 12 */
/* 5/25/08 allow >12 */
+#line 3068 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) {
/* call istring(mod(ivx,12),noteq,len) */
+#line 3070 ""
i__1 = commvl_1.ivx % 24;
+#line 3070 ""
istring_(&i__1, noteq, &len, (ftnlen)8);
+#line 3071 ""
} else {
/* call istring(mod(ivbj1,12),noteq,len) */
+#line 3073 ""
i__1 = combjmp_1.ivbj1 % 24;
+#line 3073 ""
istring_(&i__1, noteq, &len, (ftnlen)8);
+#line 3074 ""
}
/* Writing concatenation */
+#line 3075 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3075 ""
i__3[1] = len, a__2[1] = noteq;
+#line 3075 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3076 ""
*lnote += len;
+#line 3077 ""
i__1 = ncmid_(&all_1.iv, &ip1);
+#line 3077 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
/* Writing concatenation */
+#line 3078 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3078 ""
i__3[1] = lnoten, a__2[1] = noteq;
+#line 3078 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3079 ""
*lnote += lnoten;
+#line 3080 ""
if (isdotm) {
+#line 3081 ""
if (lnoten == 1) {
/* Writing concatenation */
+#line 3082 ""
i__4[0] = *lnote, a__3[0] = notexq;
+#line 3082 ""
i__4[1] = 1, a__3[1] = "{";
+#line 3082 ""
i__4[2] = 1, a__3[2] = noteq;
+#line 3082 ""
i__4[3] = 1, a__3[3] = "}";
+#line 3082 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 3083 ""
*lnote += 3;
+#line 3084 ""
} else {
+#line 3085 ""
i__1 = lnoten - 2;
/* Writing concatenation */
+#line 3085 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 3085 ""
i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
+#line 3085 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
+#line 3086 ""
++(*lnote);
+#line 3087 ""
}
+#line 3088 ""
}
+#line 3089 ""
return 0;
} /* beamn1_ */
@@ -4692,19 +7972,19 @@ L1:
notexq_len)
{
/* System generated locals */
- address a__1[3], a__2[2], a__3[5];
- integer i__1, i__2, i__3, i__4[3], i__5[2], i__6[5];
+ address a__1[4], a__2[2], a__3[3], a__4[5];
+ integer i__1[4], i__2[2], i__3[3], i__4, i__5, i__6, i__7[5];
real r__1;
char ch__1[1];
icilist ici__1;
/* Builtin functions */
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
- integer i_nint(real *), s_wsfi(icilist *), do_fio(integer *, char *,
- ftnlen), e_wsfi(void);
+ integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
+ ;
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
- integer pow_ii(integer *, integer *), i_sign(integer *, integer *),
- lbit_shift(integer, integer);
+ integer i_nint(real *), pow_ii(integer *, integer *), i_sign(integer *,
+ integer *), lbit_shift(integer, integer);
/* Local variables */
static logical addbrack;
@@ -4738,64 +8018,290 @@ L1:
static real zmult;
extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *,
char *, integer *, ftnlen, ftnlen, ftnlen);
+ static integer multbb, lnoten;
static real xnlmid;
extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
- *, ftnlen);
- static integer lnoten;
- extern /* Subroutine */ int setupb_(real *, integer *, real *, real *,
- integer *, real *, integer *);
+ *, ftnlen), setupb_(real *, integer *, real *, real *, integer *,
+ real *, integer *);
static integer mprint;
static real xslope;
+ static integer nvtrem;
extern /* Subroutine */ int putxtn_(integer *, integer *, integer *,
integer *, real *, real *, integer *, integer *, real *, real *,
integer *, integer *, char *, integer *, integer *, real *,
integer *, integer *, integer *, logical *, ftnlen);
- static integer maxdrop;
+ static integer nindent, maxdrop, numinit;
/* Fortran I/O blocks */
- static icilist io___213 = { 0, tempq, 0, "(i2)", 2, 1 };
+ static icilist io___219 = { 0, noteq, 0, "(i1)", 8, 1 };
+ static icilist io___221 = { 0, noteq, 0, "(a1,i2,a1)", 8, 1 };
+ static icilist io___222 = { 0, noteq, 0, "(i1,a1)", 8, 1 };
+ static icilist io___223 = { 0, noteq, 0, "(a1,i2,a2)", 8, 1 };
+ static icilist io___239 = { 0, tempq, 0, "(i2)", 2, 1 };
/* 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 3141 ""
/* Parameter adjustments */
+#line 3141 ""
--squez;
+#line 3141 ""
--space;
+#line 3141 ""
ihornb -= 25;
+#line 3141 ""
--nornb;
+#line 3141 ""
+#line 3141 ""
/* Function Body */
+#line 3141 ""
writebrests = TRUE_;
+#line 3142 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
+#line 3143 ""
ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
+#line 3144 ""
multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8;
+#line 3145 ""
ip = all_1.ipo[all_1.jn - 1];
+#line 3146 ""
+ *lnote = 0;
+#line 3147 ""
+ nvtrem = 0;
/* Compute slopes and note offsets from start of beam. Inside SetupB, for each */
-/* xtup in the beam, set eloff,mtupv (in comxtup) for printed number. */
+/* xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also */
+/* gets islope(ivx), transferred in common. */
+/* Vertical adjustment beams for tremolo */
+#line 3153 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[
commvl_1.ivx + ip * 24 - 25],21)) {
+#line 3153 ""
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 3153 ""
+ }
+
+/* Will always come past here after entering beamstrt for 2-note tremolo, and */
+/* slope will have been computed, even for unbeamed. So start the indented */
+/* beams here. The indented tremolo bars will be added to the notexq output */
+/* string, under the tacet assumption that there is no horizontal shift */
+/* enacted by the action just before and after the call to beamstrt. */
+
+#line 3162 ""
+ 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 3164 ""
+ nindent = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &
+ c__2, &c__5);
+/* Writing concatenation */
+#line 3165 ""
+ i__1[0] = 1, a__1[0] = all_1.sq;
+#line 3165 ""
+ i__1[1] = 12, a__1[1] = "roffset{.7}{";
+#line 3165 ""
+ i__1[2] = 1, a__1[2] = all_1.sq;
+#line 3165 ""
+ i__1[3] = 2, a__1[3] = "ib";
+#line 3165 ""
+ s_cat(tempq, a__1, i__1, &c__4, (ftnlen)79);
+#line 3166 ""
+ ltemp = 16;
+#line 3167 ""
+ if (nindent == 2) {
+/* Writing concatenation */
+#line 3168 ""
+ i__2[0] = 16, a__2[0] = tempq;
+#line 3168 ""
+ i__2[1] = 1, a__2[1] = "b";
+#line 3168 ""
+ s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3169 ""
+ ltemp = 17;
+#line 3170 ""
+ } else if (nindent == 3) {
+/* Writing concatenation */
+#line 3171 ""
+ i__2[0] = 16, a__2[0] = tempq;
+#line 3171 ""
+ i__2[1] = 2, a__2[1] = "bb";
+#line 3171 ""
+ s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3172 ""
+ ltemp = 18;
+#line 3173 ""
+ }
+
+/* Use beam # 0 for indented beams */
+
+/* Writing concatenation */
+#line 3177 ""
+ i__3[0] = ltemp, a__3[0] = tempq;
+#line 3177 ""
+ i__3[1] = 1, a__3[1] = all_1.ulq + (commvl_1.ivx + ibc * 24 - 25);
+#line 3177 ""
+ i__3[2] = 1, a__3[2] = "0";
+#line 3177 ""
+ s_cat(tempq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3178 ""
+ ltemp += 2;
+
+/* Get adjustment to nolev1 for main beam based on nindent */
+
+#line 3182 ""
+ if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u')
+ {
+#line 3183 ""
+ nvtrem = nindent - 1;
+#line 3184 ""
+ } else {
+#line 3185 ""
+ nvtrem = 1 - nindent;
+#line 3186 ""
+ }
+
+/* Get numerical position of initiation for main beam. Will adjust height at */
+/* closing to account for nindent */
+
+/* numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4 */
+#line 3192 ""
+ 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 3196 ""
+ iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
+ c__11) - 30;
+#line 3197 ""
+ if (iadj != -30) {
+#line 3197 ""
+ numinit += iadj;
+#line 3197 ""
+ }
+#line 3198 ""
+ if (numinit >= 0 && numinit <= 9) {
+#line 3199 ""
+ s_wsfi(&io___219);
+#line 3199 ""
+ do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
+#line 3199 ""
+ e_wsfi();
+#line 3200 ""
+ lnoten = 1;
+#line 3201 ""
+ } else {
+#line 3202 ""
+ s_wsfi(&io___221);
+#line 3202 ""
+ do_fio(&c__1, "{", (ftnlen)1);
+#line 3202 ""
+ do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
+#line 3202 ""
+ do_fio(&c__1, "}", (ftnlen)1);
+#line 3202 ""
+ e_wsfi();
+#line 3203 ""
+ lnoten = 4;
+#line 3204 ""
+ }
+/* Writing concatenation */
+#line 3205 ""
+ i__2[0] = ltemp, a__2[0] = tempq;
+#line 3205 ""
+ i__2[1] = lnoten, a__2[1] = noteq;
+#line 3205 ""
+ s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3206 ""
+ ltemp += lnoten;
+
+/* Now do the slope. */
+/* 170408 Baseline is in islope(ivx). Apply slope tweak if present. */
+
+#line 3211 ""
+ numinit = comxtup_1.islope[commvl_1.ivx - 1];
+#line 3212 ""
+ iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
+ c__17) - 30;
+#line 3213 ""
+ if (iadj != -30) {
+#line 3213 ""
+ numinit += iadj;
+#line 3213 ""
+ }
+#line 3214 ""
+ if (numinit >= 0 && numinit <= 9) {
+#line 3215 ""
+ s_wsfi(&io___222);
+#line 3215 ""
+ do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
+#line 3215 ""
+ do_fio(&c__1, "}", (ftnlen)1);
+#line 3215 ""
+ e_wsfi();
+#line 3216 ""
+ lnoten = 2;
+#line 3217 ""
+ } else {
+#line 3218 ""
+ s_wsfi(&io___223);
+#line 3218 ""
+ do_fio(&c__1, "{", (ftnlen)1);
+#line 3218 ""
+ do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
+#line 3218 ""
+ do_fio(&c__1, "}}", (ftnlen)2);
+#line 3218 ""
+ e_wsfi();
+#line 3219 ""
+ lnoten = 5;
+#line 3220 ""
+ }
+/* Writing concatenation */
+#line 3221 ""
+ i__2[0] = ltemp, a__2[0] = tempq;
+#line 3221 ""
+ i__2[1] = lnoten, a__2[1] = noteq;
+#line 3221 ""
+ s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3222 ""
+ ltemp += lnoten;
+#line 3223 ""
+ s_copy(notexq, tempq, (ftnlen)79, (ftnlen)79);
+#line 3224 ""
+ *lnote = ltemp;
+#line 3225 ""
+ }
+#line 3226 ""
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 3231 ""
++comxtup_1.issb[commvl_1.ivx - 1];
+#line 3232 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx +
comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25];
+#line 3233 ""
}
- *lnote = 0;
+
+/* Move this up to before indented beams for tremolo */
+/* lnote = 0 */
+#line 3237 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
+#line 3238 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) &&
strtmid_1.ixrest[commvl_1.ivx - 1] != 2) {
+#line 3239 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
+#line 3240 ""
++comxtup_1.nxtinbm[commvl_1.ivx - 1];
/* irest(28)=>Xtup starts on this note. Set up for xtuplet. */
@@ -4810,275 +8316,500 @@ L1:
/* iflop 0 1 -1 0 ...direction of flop */
/* iup -1 1 -1 1 ...direction of number and bracket */
+#line 3254 ""
iud = 1;
+#line 3255 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u')
{
+#line 3255 ""
iud = -1;
+#line 3255 ""
}
/* Get ip#, note level of middle note (or gap) in xtup */
+#line 3259 ""
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 3264 ""
L14:
+#line 3265 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) {
+#line 3266 ""
++ipmid;
+#line 3267 ""
goto L14;
+#line 3268 ""
}
- i__1 = ncmid_(&all_1.iv, &ipmid);
- i__2 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
+#line 3269 ""
+ i__4 = ncmid_(&all_1.iv, &ipmid);
+#line 3269 ""
+ i__5 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
+#line 3269 ""
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__2);
+ all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__4, &
+ i__5);
+#line 3271 ""
if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1]
* 24 - 25] % 2 == 0) {
- i__2 = ipmid - 1;
- i__1 = ncmid_(&all_1.iv, &i__2);
- i__3 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) -
+#line 3271 ""
+ i__5 = ipmid - 1;
+#line 3271 ""
+ i__4 = ncmid_(&all_1.iv, &i__5);
+#line 3271 ""
+ i__6 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) -
8;
+#line 3271 ""
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__3)) / 2;
+ - 25], &iud, &i__4, &i__6)) / 2;
+#line 3271 ""
}
+#line 3274 ""
iflop = 0;
+#line 3275 ""
if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) {
+#line 3275 ""
iflop = -iud;
+#line 3275 ""
}
+#line 3276 ""
iup = iud + (iflop << 1);
+#line 3277 ""
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 3281 ""
iup = -iup;
+#line 3282 ""
iflop = 0;
+#line 3283 ""
if (iud * iup < 0) {
+#line 3283 ""
iflop = iup;
+#line 3283 ""
}
+#line 3284 ""
}
-/* Determine if a beam is to be drawn */
+/* Determine if a beam is to be drawn. */
+/* Had problem w/ half-note 2-note xtups always F, so add a test */
- i__1 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
- for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__1;
+#line 3289 ""
+ if (igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &
+ c__3) != 0) {
+#line 3290 ""
+ comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
+#line 3291 ""
+ goto L6;
+#line 3292 ""
+ }
+#line 3293 ""
+ i__4 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
+#line 3293 ""
+ for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__4;
++ipp) {
+#line 3294 ""
if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) {
+#line 3295 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_;
+#line 3296 ""
goto L6;
+#line 3297 ""
}
+#line 3298 ""
/* L5: */
+#line 3298 ""
}
+#line 3299 ""
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 3300 ""
L6:
/* Are we using tuplet.tex? */
+#line 3304 ""
usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1];
+/* Check for single note xtup 171217 */
+
+#line 3308 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) &&
+ comipb_1.nnb == 1) {
+#line 3309 ""
+ comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_;
+#line 3310 ""
+ }
+
/* Place xtup number if needed */
+#line 3314 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) ||
multb <= 0) {
+#line 3315 ""
mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
c__5, &c__22);
+#line 3316 ""
if (mprint == 0) {
+#line 3316 ""
mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25];
+#line 3316 ""
+ }
+/* Stab in the dark! Note: tried setting unbeam flag islur18 but no go. */
+#line 3318 ""
+ if (comipb_1.nnb == 1) {
+#line 3319 ""
+ xnlmid = (real) comxtup_1.nolev1[commvl_1.ivx - 1];
+#line 3320 ""
+ 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 3325 ""
}
- i__1 = ncmid_(&all_1.iv, &ipb1);
+#line 3326 ""
+ i__4 = ncmid_(&all_1.iv, &ipb1);
+#line 3326 ""
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,
&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], lnote,
- notexq, &i__1, &nlnum, &comxtup_1.eloff[commvl_1.ivx +
+ notexq, &i__4, &nlnum, &comxtup_1.eloff[commvl_1.ivx +
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);
-/* * iup,irest(ivx,ipb1),usexnumt) */
+#line 3330 ""
}
+#line 3331 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam */
+#line 3335 ""
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 3341 ""
r__1 = space[*ib] / squez[*ib];
+#line 3341 ""
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 3343 ""
if (iup == 1) {
+#line 3344 ""
if (*lnote > 0) {
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = 1, a__1[1] = all_1.sq;
- i__4[2] = 5, a__1[2] = "ovbkt";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3345 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3345 ""
+ i__3[1] = 1, a__3[1] = all_1.sq;
+#line 3345 ""
+ i__3[2] = 5, a__3[2] = "ovbkt";
+#line 3345 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3346 ""
} else {
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 5, a__2[1] = "ovbkt";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3347 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3347 ""
+ i__2[1] = 5, a__2[1] = "ovbkt";
+#line 3347 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3348 ""
}
+#line 3349 ""
} else {
+#line 3350 ""
if (*lnote > 0) {
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = 1, a__1[1] = all_1.sq;
- i__4[2] = 5, a__1[2] = "unbkt";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3351 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3351 ""
+ i__3[1] = 1, a__3[1] = all_1.sq;
+#line 3351 ""
+ i__3[2] = 5, a__3[2] = "unbkt";
+#line 3351 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3352 ""
} else {
/* Introduced 12/5/98, req'd due to possible presence of in-line TeX */
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 5, a__2[1] = "unbkt";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3356 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3356 ""
+ i__2[1] = 5, a__2[1] = "unbkt";
+#line 3356 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3357 ""
}
+#line 3358 ""
}
+#line 3359 ""
*lnote += 6;
+#line 3360 ""
if (all_1.iline == 1) {
+#line 3361 ""
comipb_1.smed /= 1.f - comtop_1.fracindent;
+#line 3362 ""
}
+#line 3363 ""
xslope = comipb_1.smed * 1.8f * all_1.slfac;
+#line 3364 ""
comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope);
+#line 3365 ""
r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1];
+#line 3365 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1);
+#line 3366 ""
if (comxtup_1.islope[commvl_1.ivx - 1] == 0) {
+#line 3366 ""
--comxtup_1.nolev1[commvl_1.ivx - 1];
+#line 3366 ""
}
+#line 3367 ""
if (iup == 1) {
+#line 3367 ""
comxtup_1.nolev1[commvl_1.ivx - 1] += 4;
+#line 3367 ""
}
+#line 3368 ""
levbracket = comxtup_1.nolev1[commvl_1.ivx - 1];
+#line 3369 ""
if (iup == 1 && comnvst_1.cstuplet) {
+#line 3369 ""
--levbracket;
+#line 3369 ""
}
- i__1 = ncmid_(&all_1.iv, &ipb1);
- notefq_(noteq, &lnoten, &levbracket, &i__1, (ftnlen)8);
+#line 3370 ""
+ i__4 = ncmid_(&all_1.iv, &ipb1);
+#line 3370 ""
+ notefq_(noteq, &lnoten, &levbracket, &i__4, (ftnlen)8);
+#line 3371 ""
if (lnoten == 1) {
+#line 3371 ""
addblank_(noteq, &lnoten, (ftnlen)8);
- }
-/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = lnoten, a__1[1] = noteq;
- i__4[2] = 1, a__1[2] = "{";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3371 ""
+ }
+/* Writing concatenation */
+#line 3372 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3372 ""
+ i__3[1] = lnoten, a__3[1] = noteq;
+#line 3372 ""
+ i__3[2] = 1, a__3[2] = "{";
+#line 3372 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3373 ""
*lnote = *lnote + lnoten + 1;
+#line 3374 ""
if (xnsk < .995f) {
- i__1 = *lnote;
+#line 3375 ""
+ i__4 = *lnote;
+#line 3375 ""
ici__1.icierr = 0;
+#line 3375 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 4 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3375 ""
+ ici__1.icirlen = *lnote + 4 - i__4;
+#line 3375 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3375 ""
ici__1.icifmt = "(i1,f3.2)";
+#line 3375 ""
s_wsfi(&ici__1);
+#line 3375 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 3375 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
+#line 3375 ""
e_wsfi();
+#line 3376 ""
*lnote += 4;
+#line 3377 ""
} else if (xnsk < 9.995f) {
- i__1 = *lnote;
+#line 3378 ""
+ i__4 = *lnote;
+#line 3378 ""
ici__1.icierr = 0;
+#line 3378 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 4 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3378 ""
+ ici__1.icirlen = *lnote + 4 - i__4;
+#line 3378 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3378 ""
ici__1.icifmt = "(f4.2)";
+#line 3378 ""
s_wsfi(&ici__1);
+#line 3378 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
+#line 3378 ""
e_wsfi();
+#line 3379 ""
*lnote += 4;
+#line 3380 ""
} else {
- i__1 = *lnote;
+#line 3381 ""
+ i__4 = *lnote;
+#line 3381 ""
ici__1.icierr = 0;
+#line 3381 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 5 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3381 ""
+ ici__1.icirlen = *lnote + 5 - i__4;
+#line 3381 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3381 ""
ici__1.icifmt = "(f5.2)";
+#line 3381 ""
s_wsfi(&ici__1);
+#line 3381 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
+#line 3381 ""
e_wsfi();
+#line 3382 ""
*lnote += 5;
+#line 3383 ""
}
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = 1, a__2[1] = "}";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3384 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3384 ""
+ i__2[1] = 1, a__2[1] = "}";
+#line 3384 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3385 ""
++(*lnote);
+#line 3386 ""
if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) {
/* Tweak slope of bracket */
+#line 3390 ""
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 3391 ""
}
+#line 3392 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < 0 ||
comxtup_1.islope[commvl_1.ivx - 1] >= 10) {
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = 1, a__2[1] = "{";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3393 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3393 ""
+ i__2[1] = 1, a__2[1] = "{";
+#line 3393 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3394 ""
++(*lnote);
+#line 3395 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < -9) {
- i__1 = *lnote;
+#line 3396 ""
+ i__4 = *lnote;
+#line 3396 ""
ici__1.icierr = 0;
+#line 3396 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 3 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3396 ""
+ ici__1.icirlen = *lnote + 3 - i__4;
+#line 3396 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3396 ""
ici__1.icifmt = "(i3)";
+#line 3396 ""
s_wsfi(&ici__1);
+#line 3396 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
- 1], (ftnlen)sizeof(integer));
+#line 3396 ""
e_wsfi();
+#line 3397 ""
*lnote += 3;
+#line 3398 ""
} else {
- i__1 = *lnote;
+#line 3399 ""
+ i__4 = *lnote;
+#line 3399 ""
ici__1.icierr = 0;
+#line 3399 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 2 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3399 ""
+ ici__1.icirlen = *lnote + 2 - i__4;
+#line 3399 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3399 ""
ici__1.icifmt = "(i2)";
+#line 3399 ""
s_wsfi(&ici__1);
+#line 3399 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
- 1], (ftnlen)sizeof(integer));
+#line 3399 ""
e_wsfi();
+#line 3400 ""
*lnote += 2;
+#line 3401 ""
}
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = 1, a__2[1] = "}";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3402 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3402 ""
+ i__2[1] = 1, a__2[1] = "}";
+#line 3402 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3403 ""
++(*lnote);
+#line 3404 ""
} else {
- i__1 = *lnote;
+#line 3405 ""
+ i__4 = *lnote;
+#line 3405 ""
ici__1.icierr = 0;
+#line 3405 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote + 1 - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3405 ""
+ ici__1.icirlen = *lnote + 1 - i__4;
+#line 3405 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3405 ""
ici__1.icifmt = "(i1)";
+#line 3405 ""
s_wsfi(&ici__1);
+#line 3405 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1],
(ftnlen)sizeof(integer));
+#line 3405 ""
e_wsfi();
+#line 3406 ""
++(*lnote);
+#line 3407 ""
}
/* Done with bracket */
+#line 3411 ""
}
+#line 3412 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) {
/* Put in the rest. Possible problem: Rest is a spacing char, but between */
@@ -5086,372 +8817,633 @@ L6:
/* 130126 Deal with vertical shifts of rest starting xtuplet */
-/* if (multb .eq. 0) then */
-/* notexq = notexq(1:lnote)//sq//'qp' */
-/* lnote = lnote+3 */
-/* else if (.not.drawbm(ivx).and.multb.eq.1) then */
-/* notexq = notexq(1:lnote)//sq//'ds' */
-/* lnote = lnote+3 */
-/* else if (.not.drawbm(ivx).and.multb.eq.2) then */
-/* notexq = notexq(1:lnote)//sq//'qs' */
-/* lnote = lnote+3 */
-/* else if (.not.drawbm(ivx).and.multb.eq.3) then */
-/* notexq = notexq(1:lnote)//sq//'hs' */
-/* lnote = lnote+3 */
-/* else */
-/* notexq = notexq(1:lnote)//sq//'hpause' */
-/* lnote = lnote+7 */
-/* end if */
+#line 3419 ""
lrest = 3;
- if (multb == 0) {
-/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 2, a__2[1] = "qp";
- s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
+#line 3420 ""
+ if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
+/* Writing concatenation */
+#line 3421 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3421 ""
+ i__2[1] = 2, a__2[1] = "sk";
+#line 3421 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+/* if (multb .eq. 0) then */
+#line 3423 ""
+ } else if (multb == 0) {
+/* Writing concatenation */
+#line 3424 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3424 ""
+ i__2[1] = 2, a__2[1] = "qp";
+#line 3424 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+#line 3425 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1)
{
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 2, a__2[1] = "ds";
- s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
+#line 3426 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3426 ""
+ i__2[1] = 2, a__2[1] = "ds";
+#line 3426 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+#line 3427 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2)
{
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 2, a__2[1] = "qs";
- s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
+#line 3428 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3428 ""
+ i__2[1] = 2, a__2[1] = "qs";
+#line 3428 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+#line 3429 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3)
{
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 2, a__2[1] = "hs";
- s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
+#line 3430 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3430 ""
+ i__2[1] = 2, a__2[1] = "hs";
+#line 3430 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+#line 3431 ""
} else {
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 6, a__2[1] = "hpause";
- s_cat(restq, a__2, i__5, &c__2, (ftnlen)40);
+#line 3432 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3432 ""
+ i__2[1] = 6, a__2[1] = "hpause";
+#line 3432 ""
+ s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
+#line 3433 ""
lrest = 7;
+#line 3434 ""
+ }
+#line 3435 ""
+ 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)
+ ) {
+
+/* VERY special case of rest at start of F-tuplet, needs dot */
+
+/* Writing concatenation */
+#line 3440 ""
+ i__3[0] = 1, a__3[0] = all_1.sq;
+#line 3440 ""
+ i__3[1] = 3, a__3[1] = "pt4";
+#line 3440 ""
+ i__3[2] = lrest, a__3[2] = restq;
+#line 3440 ""
+ s_cat(restq, a__3, i__3, &c__3, (ftnlen)40);
+#line 3441 ""
+ lrest += 4;
+#line 3442 ""
}
+#line 3444 ""
nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100
- 20;
- if (nole == 0) {
+/* if (nole .eq. 0) then */
+#line 3446 ""
+ if (nole == 0 || bit_test(all_1.islur[commvl_1.ivx + ip * 24
+ - 25],29)) {
-/* Rest is not raised */
+/* Rest blank or is not raised */
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = 40, a__2[1] = restq;
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3450 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3450 ""
+ i__2[1] = 40, a__2[1] = restq;
+#line 3450 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3451 ""
*lnote += lrest;
+#line 3452 ""
} else {
+#line 3453 ""
if (abs(nole) < 10) {
- i__1 = abs(nole) + 48;
- chax_(ch__1, (ftnlen)1, &i__1);
+#line 3454 ""
+ i__4 = abs(nole) + 48;
+#line 3454 ""
+ chax_(ch__1, (ftnlen)1, &i__4);
+#line 3454 ""
s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1);
+#line 3455 ""
ltemp = 1;
+#line 3456 ""
} else {
- s_wsfi(&io___213);
- i__1 = abs(nole);
- do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 3457 ""
+ s_wsfi(&io___239);
+#line 3457 ""
+ i__4 = abs(nole);
+#line 3457 ""
+ do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
+#line 3457 ""
e_wsfi();
+#line 3458 ""
ltemp = 2;
+#line 3459 ""
}
+#line 3460 ""
if (nole > 0) {
/* Writing concatenation */
- i__6[0] = 1, a__3[0] = all_1.sq;
- i__6[1] = 5, a__3[1] = "raise";
- i__6[2] = ltemp, a__3[2] = tempq;
- i__6[3] = 1, a__3[3] = all_1.sq;
- i__6[4] = 9, a__3[4] = "internote";
- s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79);
+#line 3461 ""
+ i__7[0] = 1, a__4[0] = all_1.sq;
+#line 3461 ""
+ i__7[1] = 5, a__4[1] = "raise";
+#line 3461 ""
+ i__7[2] = ltemp, a__4[2] = tempq;
+#line 3461 ""
+ i__7[3] = 1, a__4[3] = all_1.sq;
+#line 3461 ""
+ i__7[4] = 9, a__4[4] = "internote";
+#line 3461 ""
+ s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79);
+#line 3462 ""
} else {
/* Writing concatenation */
- i__6[0] = 1, a__3[0] = all_1.sq;
- i__6[1] = 5, a__3[1] = "lower";
- i__6[2] = ltemp, a__3[2] = tempq;
- i__6[3] = 1, a__3[3] = all_1.sq;
- i__6[4] = 9, a__3[4] = "internote";
- s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79);
- }
+#line 3463 ""
+ i__7[0] = 1, a__4[0] = all_1.sq;
+#line 3463 ""
+ i__7[1] = 5, a__4[1] = "lower";
+#line 3463 ""
+ i__7[2] = ltemp, a__4[2] = tempq;
+#line 3463 ""
+ i__7[3] = 1, a__4[3] = all_1.sq;
+#line 3463 ""
+ i__7[4] = 9, a__4[4] = "internote";
+#line 3463 ""
+ s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79);
+#line 3464 ""
+ }
+#line 3465 ""
ltemp += 16;
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = ltemp, a__1[1] = tempq;
- i__4[2] = lrest, a__1[2] = restq;
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3466 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3466 ""
+ i__3[1] = ltemp, a__3[1] = tempq;
+#line 3466 ""
+ i__3[2] = lrest, a__3[2] = restq;
+#line 3466 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3467 ""
*lnote = *lnote + ltemp + lrest;
+#line 3468 ""
}
/* 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 3473 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
+#line 3474 ""
}
+#line 3475 ""
return 0;
+#line 3476 ""
}
/* End if block for non-beamed xtup start...note we returned */
+#line 3480 ""
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 3486 ""
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 3487 ""
++xjbeambrests_1.nbrests;
+#line 3488 ""
writebrests = FALSE_;
+#line 3489 ""
} else {
- i__1 = 4 - multb;
+#line 3490 ""
+ i__4 = 4 - multb;
+#line 3490 ""
all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, &
- i__1);
+ i__4);
+#line 3491 ""
notex_(tempq, &ltemp, (ftnlen)79);
+#line 3492 ""
if (*lnote > 0) {
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = ltemp, a__2[1] = tempq;
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3493 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3493 ""
+ i__2[1] = ltemp, a__2[1] = tempq;
+#line 3493 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3494 ""
} else {
+#line 3495 ""
s_copy(notexq, tempq, (ftnlen)79, ltemp);
+#line 3496 ""
}
+#line 3497 ""
*lnote += ltemp;
+#line 3498 ""
}
/* Re-zero just in case! */
+#line 3502 ""
all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0;
+#line 3503 ""
++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
/* See if next note is a non-rest */
+#line 3507 ""
if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0)
) {
+#line 3508 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 2;
+#line 3509 ""
} else {
/* Suppress reprinting xtup number next time through beamstrt */
+#line 3513 ""
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 3517 ""
all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set(
all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28);
+#line 3518 ""
}
+#line 3519 ""
return 0;
+#line 3520 ""
}
+#line 3521 ""
}
/* Just ended if block for xtups */
+#line 3525 ""
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 3529 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 4;
+#line 3530 ""
return 0;
+#line 3531 ""
}
+#line 3532 ""
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 3536 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__11) - 30;
+#line 3537 ""
if (iadj != -30) {
+#line 3538 ""
comxtup_1.nolev1[commvl_1.ivx - 1] += iadj;
- i__1 = comxtup_1.nssb[commvl_1.ivx - 1];
- for (isssb = 1; isssb <= i__1; ++isssb) {
+#line 3539 ""
+ i__4 = comxtup_1.nssb[commvl_1.ivx - 1];
+#line 3539 ""
+ for (isssb = 1; isssb <= i__4; ++isssb) {
+#line 3540 ""
comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj;
+#line 3541 ""
/* L2: */
+#line 3541 ""
}
+#line 3542 ""
}
+#line 3543 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__17) - 30;
+#line 3544 ""
if (iadj != -30) {
+#line 3545 ""
comxtup_1.islope[commvl_1.ivx - 1] += iadj;
- if ((i__1 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__1)) > 9) {
+#line 3546 ""
+ if ((i__4 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__4)) > 9) {
+#line 3546 ""
comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
comxtup_1.islope[commvl_1.ivx - 1]);
+#line 3546 ""
}
+#line 3547 ""
if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) {
/* Cycle thru non-rest notes in SSBG, looking for bmstrts. */
+#line 3551 ""
isssb = 0;
- i__1 = comipb_1.nnb;
- for (inb = 2; inb <= i__1; ++inb) {
+#line 3552 ""
+ i__4 = comipb_1.nnb;
+#line 3552 ""
+ for (inb = 2; inb <= i__4; ++inb) {
+#line 3553 ""
if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb -
1] * 24 - 25],21)) {
/* Beam segment start. New start level */
+#line 3556 ""
++isssb;
+#line 3557 ""
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 3559 ""
}
+#line 3560 ""
/* L4: */
+#line 3560 ""
}
+#line 3561 ""
}
+#line 3562 ""
}
+#line 3563 ""
}
+#line 3564 ""
iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &
c__27);
+#line 3565 ""
addbrack = FALSE_;
+#line 3566 ""
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 3571 ""
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 3573 ""
if (*lnote == 0) {
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 5, a__2[1] = "loff{";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3574 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3574 ""
+ i__2[1] = 5, a__2[1] = "loff{";
+#line 3574 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3575 ""
} else {
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = 1, a__1[1] = all_1.sq;
- i__4[2] = 5, a__1[2] = "loff{";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
- }
+#line 3576 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3576 ""
+ i__3[1] = 1, a__3[1] = all_1.sq;
+#line 3576 ""
+ i__3[2] = 5, a__3[2] = "loff{";
+#line 3576 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3577 ""
+ }
+#line 3578 ""
*lnote += 6;
+#line 3579 ""
addbrack = TRUE_;
+#line 3580 ""
} 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 3582 ""
if (*lnote == 0) {
/* Writing concatenation */
- i__5[0] = 1, a__2[0] = all_1.sq;
- i__5[1] = 5, a__2[1] = "roff{";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3583 ""
+ i__2[0] = 1, a__2[0] = all_1.sq;
+#line 3583 ""
+ i__2[1] = 5, a__2[1] = "roff{";
+#line 3583 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3584 ""
} else {
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = 1, a__1[1] = all_1.sq;
- i__4[2] = 5, a__1[2] = "roff{";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
- }
+#line 3585 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3585 ""
+ i__3[1] = 1, a__3[1] = all_1.sq;
+#line 3585 ""
+ i__3[2] = 5, a__3[2] = "roff{";
+#line 3585 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3586 ""
+ }
+#line 3587 ""
*lnote += 6;
+#line 3588 ""
addbrack = TRUE_;
+#line 3589 ""
}
/* Check end level for possible flipping in forced beam. Have to do it */
/* here since with multiple voices, xelsk will not be preserved. */
+#line 3594 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
+#line 3595 ""
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 3596 ""
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 3597 ""
} else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'l') {
+#line 3598 ""
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 3599 ""
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 3600 ""
}
+#line 3601 ""
}
- i__1 = multb + iadj;
- ntrbbb_(&i__1, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
+#line 3602 ""
+ multbb = multb + iadj;
+
+/* Tremolo starting? */
+
+#line 3606 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2)) {
+#line 3606 ""
+ multbb = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2,
+ &c__3);
+#line 3606 ""
+ }
+#line 3608 ""
+ 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 3613 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
+#line 3613 ""
r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] *
comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac;
+#line 3613 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
+#line 3613 ""
}
- i__1 = ncmid_(&all_1.iv, &ipb1);
- notefq_(noteq, &lnoten, &comxtup_1.nolev1[commvl_1.ivx - 1], &i__1, (
- ftnlen)8);
+
+/* Add adjustment nvtrem to main beam to account for tremolo indented beams */
+
+#line 3618 ""
+ i__4 = comxtup_1.nolev1[commvl_1.ivx - 1] + nvtrem;
+#line 3618 ""
+ i__5 = ncmid_(&all_1.iv, &ipb1);
+#line 3618 ""
+ notefq_(noteq, &lnoten, &i__4, &i__5, (ftnlen)8);
+#line 3619 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < 0) {
/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
- i__4[1] = lnoten, a__1[1] = noteq;
- i__4[2] = 1, a__1[2] = "{";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3620 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3620 ""
+ i__3[1] = lnoten, a__3[1] = noteq;
+#line 3620 ""
+ i__3[2] = 1, a__3[2] = "{";
+#line 3620 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3621 ""
*lnote = *lnote + 4 + lnoten;
- i__1 = *lnote - 3;
+#line 3622 ""
+ i__4 = *lnote - 3;
+#line 3622 ""
ici__1.icierr = 0;
+#line 3622 ""
ici__1.icirnum = 1;
- ici__1.icirlen = *lnote - i__1;
- ici__1.iciunit = notexq + i__1;
+#line 3622 ""
+ ici__1.icirlen = *lnote - i__4;
+#line 3622 ""
+ ici__1.iciunit = notexq + i__4;
+#line 3622 ""
ici__1.icifmt = "(i2,a1)";
+#line 3622 ""
s_wsfi(&ici__1);
+#line 3622 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
sizeof(integer));
+#line 3622 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 3622 ""
e_wsfi();
+#line 3623 ""
} else {
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = lnoten, a__2[1] = noteq;
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3624 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3624 ""
+ i__2[1] = lnoten, a__2[1] = noteq;
+#line 3624 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3625 ""
*lnote = *lnote + 1 + lnoten;
+#line 3626 ""
ici__1.icierr = 0;
+#line 3626 ""
ici__1.icirnum = 1;
+#line 3626 ""
ici__1.icirlen = 1;
+#line 3626 ""
ici__1.iciunit = notexq + (*lnote - 1);
+#line 3626 ""
ici__1.icifmt = "(i1)";
+#line 3626 ""
s_wsfi(&ici__1);
+#line 3626 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
sizeof(integer));
+#line 3626 ""
e_wsfi();
+#line 3627 ""
}
/* Check for beam-thk fine-tuning */
+#line 3631 ""
if (iadj > 0) {
- i__1 = multb + 1;
- for (imp = multb + iadj; imp >= i__1; --imp) {
+#line 3632 ""
+ i__4 = multb + 1;
+#line 3632 ""
+ for (imp = multb + iadj; imp >= i__4; --imp) {
+#line 3633 ""
ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (
ftnlen)79);
+#line 3634 ""
/* L1: */
+#line 3634 ""
}
+#line 3635 ""
}
/* If we shifted, must close with right bracket */
+#line 3639 ""
if (addbrack) {
/* Writing concatenation */
- i__5[0] = *lnote, a__2[0] = notexq;
- i__5[1] = 1, a__2[1] = "}";
- s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79);
+#line 3640 ""
+ i__2[0] = *lnote, a__2[0] = notexq;
+#line 3640 ""
+ i__2[1] = 1, a__2[1] = "}";
+#line 3640 ""
+ s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 3641 ""
++(*lnote);
+#line 3642 ""
}
/* 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 3648 ""
if (xjbeambrests_1.nbrests > 0 && writebrests) {
- i__1 = xjbeambrests_1.nbrests;
- for (isk = 1; isk <= i__1; ++isk) {
-/* Writing concatenation */
- i__4[0] = *lnote, a__1[0] = notexq;
+#line 3649 ""
+ i__4 = xjbeambrests_1.nbrests;
+#line 3649 ""
+ for (isk = 1; isk <= i__4; ++isk) {
+/* Writing concatenation */
+#line 3650 ""
+ i__3[0] = *lnote, a__3[0] = notexq;
+#line 3650 ""
chax_(ch__1, (ftnlen)1, &c__92);
- i__4[1] = 1, a__1[1] = ch__1;
- i__4[2] = 2, a__1[2] = "sk";
- s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79);
+#line 3650 ""
+ i__3[1] = 1, a__3[1] = ch__1;
+#line 3650 ""
+ i__3[2] = 2, a__3[2] = "sk";
+#line 3650 ""
+ s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
+#line 3651 ""
*lnote += 3;
+#line 3652 ""
/* L7: */
+#line 3652 ""
}
+#line 3653 ""
xjbeambrests_1.nbrests = 0;
+#line 3654 ""
}
/* Get 'floor' zmin for figures */
@@ -5459,61 +9451,100 @@ L6:
/* won't be adjusted. If anyone ever needs that, need to duplicate this */
/* functionality up above, before exiting. */
+#line 3661 ""
if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2)) {
+#line 3662 ""
if (commvl_1.ivx == 1) {
+#line 3663 ""
ivf = 1;
+#line 3664 ""
} else {
+#line 3665 ""
ivf = comfig_1.ivxfig2;
+#line 3666 ""
}
+#line 3667 ""
zmult = (multb - 1) * 1.2f;
+#line 3668 ""
ymin = 100.f;
- i__1 = comipb_1.nnb;
- for (inb = 1; inb <= i__1; ++inb) {
+#line 3669 ""
+ i__4 = comipb_1.nnb;
+#line 3669 ""
+ for (inb = 1; inb <= i__4; ++inb) {
+#line 3670 ""
if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) {
+#line 3671 ""
if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] ==
'u') {
+#line 3672 ""
ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1]
* 24 - 25];
+#line 3673 ""
} else {
+#line 3674 ""
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 3676 ""
}
+#line 3677 ""
ymin = dmin(ymin,ybot);
+#line 3678 ""
}
+#line 3679 ""
/* L3: */
+#line 3679 ""
}
+#line 3680 ""
maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f;
/* Computing MAX */
- i__1 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3];
- all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__1,maxdrop);
+#line 3681 ""
+ i__4 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3];
+#line 3681 ""
+ all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__4,maxdrop);
+#line 3682 ""
}
/* Compute ornament levels if needed */
+#line 3686 ""
nomornlev = ncmid_(&all_1.iv, &ipb1) + 5;
+#line 3687 ""
iorn = 0;
- i__1 = comipb_1.nnb;
- for (inb = 1; inb <= i__1; ++inb) {
+#line 3688 ""
+ i__4 = comipb_1.nnb;
+#line 3688 ""
+ for (inb = 1; inb <= i__4; ++inb) {
+#line 3689 ""
ip = comipb_1.ipb[inb - 1];
+#line 3690 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) {
+#line 3690 ""
goto L8;
+#line 3690 ""
}
+#line 3691 ""
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 3695 ""
++iorn;
+#line 3696 ""
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 3698 ""
r__1 = ybeam - 3.f;
- i__2 = i_nint(&r__1), i__3 = nomornlev - 10;
- ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3);
+#line 3698 ""
+ i__5 = i_nint(&r__1), i__6 = nomornlev - 10;
+#line 3698 ""
+ ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6);
+#line 3699 ""
} else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */
@@ -5522,35 +9553,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 3707 ""
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 3709 ""
++iorn;
+#line 3710 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[
commvl_1.ivx + ip * 24 - 1],22);
+#line 3711 ""
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 3713 ""
r__1 = ybeam + 3.f;
- i__2 = i_nint(&r__1);
- ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev);
+#line 3713 ""
+ i__5 = i_nint(&r__1);
+#line 3713 ""
+ ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev);
+#line 3714 ""
}
+#line 3715 ""
} 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 */
- i__2 = comtrill_1.ncrd;
- for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__2;
+#line 3720 ""
+ i__5 = comtrill_1.ncrd;
+#line 3720 ""
+ for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__5;
++comtrill_1.icrd1) {
+#line 3721 ""
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 3721 ""
goto L11;
+#line 3721 ""
}
+#line 3723 ""
/* L10: */
+#line 3723 ""
}
+#line 3724 ""
L11:
/* Find outermost note, min or max depending on beam direction ulq. xto is true */
@@ -5558,79 +9606,126 @@ L11:
/* on extreme chord note in beam, will move. */
/* So ornaments are all except 0,4,13 (,g,) */
+#line 3731 ""
levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
+#line 3732 ""
xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1]
& 4186094) > 0;
+#line 3733 ""
icrdx = 0;
- i__2 = comtrill_1.ncrd;
- for (icrd = comtrill_1.icrd1; icrd <= i__2; ++icrd) {
+#line 3734 ""
+ i__5 = comtrill_1.ncrd;
+#line 3734 ""
+ for (icrd = comtrill_1.icrd1; icrd <= i__5; ++icrd) {
+#line 3735 ""
if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 &
lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8))
!= commvl_1.ivx) {
+#line 3735 ""
goto L13;
+#line 3735 ""
}
+#line 3737 ""
levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)
-12);
+#line 3738 ""
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 3740 ""
levx = levc;
+#line 3741 ""
icrdx = icrd;
+#line 3742 ""
xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0;
+#line 3743 ""
}
+#line 3744 ""
/* L12: */
+#line 3744 ""
}
+#line 3745 ""
L13:
/* If there's orn on extreme note, do stuff */
+#line 3749 ""
if (xto) {
+#line 3750 ""
++iorn;
+#line 3751 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
== 'u') {
+#line 3752 ""
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 3754 ""
r__1 = ybeam + 3.f;
- i__2 = i_nint(&r__1);
- ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev);
+#line 3754 ""
+ i__5 = i_nint(&r__1);
+#line 3754 ""
+ ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev);
+#line 3755 ""
} else {
+#line 3756 ""
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 3758 ""
r__1 = ybeam - 3.f;
- i__2 = i_nint(&r__1), i__3 = nomornlev - 10;
- ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3);
+#line 3758 ""
+ i__5 = i_nint(&r__1), i__6 = nomornlev - 10;
+#line 3758 ""
+ ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6);
+#line 3759 ""
}
+#line 3760 ""
if (icrdx == 0) {
/* Affected ornament is on main note */
+#line 3764 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
all_1.iornq[commvl_1.ivx + ip * 24 - 1],22);
+#line 3765 ""
} else {
+#line 3766 ""
comtrill_1.icrdorn[icrdx - 1] = bit_set(
comtrill_1.icrdorn[icrdx - 1],22);
+#line 3767 ""
}
+#line 3768 ""
}
+#line 3769 ""
}
+#line 3770 ""
L8:
+#line 3770 ""
;
+#line 3770 ""
}
/* Henceforth nornb will be a counter. */
+#line 3774 ""
if (iorn > 0) {
+#line 3774 ""
nornb[commvl_1.ivx] = 1;
+#line 3774 ""
}
+#line 3775 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
+#line 3775 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
+#line 3775 ""
}
+#line 3776 ""
return 0;
} /* beamstrt_ */
@@ -5654,30 +9749,45 @@ L8:
/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
/* logical gotclef */
+#line 3860 ""
i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1;
+#line 3860 ""
for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1;
++iptr) {
+#line 3861 ""
if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) <
comtol_1.tol) {
+#line 3862 ""
if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) <
comtol_1.tol) {
/* Increment pre-existing entry */
+#line 3866 ""
c1omnotes_1.nnpd[iptr - 1] += *nnsk;
+#line 3867 ""
return 0;
+#line 3868 ""
}
+#line 3869 ""
}
+#line 3870 ""
/* L16: */
+#line 3870 ""
}
/* Didn't find current duration & squez, so add a new entry. */
/* No particular reason to keep in order, so add at the end. */
+#line 3875 ""
c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk;
+#line 3876 ""
c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space;
+#line 3877 ""
c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez;
+#line 3878 ""
++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
+#line 3879 ""
return 0;
} /* catspace_ */
@@ -5687,7 +9797,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 3886 ""
*(unsigned char *)ret_val = (char) (*n);
+#line 3887 ""
return ;
} /* chax_ */
@@ -5722,141 +9834,238 @@ L8:
ftnlen, ftnlen);
static char dynsymq[4];
+#line 3894 ""
txtdyn = FALSE_;
/* On entry, iccount is on "D" */
+#line 3898 ""
i__1 = *iccount;
+#line 3898 ""
if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
/* Dynamic text */
+#line 3903 ""
istart = *iccount + 2;
/* 1 past 1st quote */
+#line 3904 ""
L3:
+#line 3905 ""
iend = i_indx(lineq + (istart - 1), "\"", 128 - (istart - 1), (ftnlen)
1);
+#line 3906 ""
i__1 = istart + iend - 3;
+#line 3906 ""
if (s_cmp(lineq + i__1, "\\", istart + iend - 2 - i__1, (ftnlen)1) ==
0) {
+#line 3907 ""
istart = *iccount + iend + 2;
+#line 3908 ""
goto L3;
+#line 3909 ""
}
+#line 3910 ""
if (iend == 0) {
+#line 3911 ""
i__1 = *iccount + 1;
- errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"
+#line 3911 ""
+ errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"\
"h double quote!", (ftnlen)128, (ftnlen)50);
+#line 3913 ""
stop1_();
+#line 3914 ""
}
/* Set iccount to character after 2nd ", and set ipm */
/* iccount = iccount+iend+2 */
+#line 3919 ""
*iccount = istart + iend;
+#line 3920 ""
ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1);
+#line 3921 ""
if (ipm == 0) {
- errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"
+#line 3922 ""
+ errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"\
"ere!", (ftnlen)128, (ftnlen)33);
+#line 3924 ""
stop1_();
+#line 3925 ""
}
+#line 3926 ""
} else {
/* Expect ordinary dynamic */
+#line 3930 ""
for (iend = *iccount + 2; iend <= 128; ++iend) {
+#line 3931 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
+#line 3932 ""
if (ipm > 0) {
+#line 3932 ""
goto L2;
+#line 3932 ""
}
+#line 3933 ""
/* L1: */
+#line 3933 ""
}
+#line 3934 ""
L2:
+#line 3935 ""
if (iend - *iccount > 5 || iend - *iccount < 2) {
+#line 3936 ""
i__1 = iend - 1;
+#line 3936 ""
errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", (
ftnlen)128, (ftnlen)30);
+#line 3938 ""
stop1_();
+#line 3939 ""
}
+#line 3940 ""
i__1 = *iccount;
+#line 3940 ""
ici__1.icierr = 0;
+#line 3940 ""
ici__1.iciend = 0;
+#line 3940 ""
ici__1.icirnum = 1;
+#line 3940 ""
ici__1.icirlen = iend - 1 - i__1;
+#line 3940 ""
ici__1.iciunit = lineq + i__1;
/* Writing concatenation */
+#line 3940 ""
i__2[0] = 2, a__1[0] = "(a";
+#line 3940 ""
i__3 = iend + 47 - *iccount;
+#line 3940 ""
chax_(ch__2, (ftnlen)1, &i__3);
+#line 3940 ""
i__2[1] = 1, a__1[1] = ch__2;
+#line 3940 ""
i__2[2] = 1, a__1[2] = ")";
+#line 3940 ""
ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
+#line 3940 ""
s_rsfi(&ici__1);
+#line 3940 ""
do_fio(&c__1, dynsymq, (ftnlen)4);
+#line 3940 ""
e_rsfi();
- idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "
+#line 3942 ""
+ idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "\
"> ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4;
+#line 3945 ""
if (idno == 0) {
+#line 3946 ""
i__1 = *iccount + 1;
+#line 3946 ""
errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128,
(ftnlen)21);
+#line 3947 ""
stop1_();
+#line 3948 ""
}
+#line 3949 ""
*iccount = iend;
+#line 3950 ""
}
+#line 3951 ""
if (ipm != 2) {
/* There is a vertical shift, have "+" or "-" */
+#line 3955 ""
++(*iccount);
+#line 3956 ""
if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen)
1) == 0) {
- errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"
+#line 3957 ""
+ errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"\
"l offset!", (ftnlen)128, (ftnlen)42);
+#line 3959 ""
stop1_();
+#line 3960 ""
}
+#line 3961 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 3962 ""
idno = i_nint(&fnum);
+#line 3963 ""
if (idno > 63) {
+#line 3964 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"
+#line 3964 ""
+ errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"\
"st be (-63,63)!", (ftnlen)128, (ftnlen)50);
+#line 3966 ""
stop1_();
+#line 3967 ""
}
+#line 3968 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
+#line 3969 ""
if (ipm == 0) {
- errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"
+#line 3970 ""
+ errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"\
"ere!", (ftnlen)128, (ftnlen)33);
+#line 3972 ""
stop1_();
+#line 3973 ""
}
+#line 3974 ""
if (ipm != 2) {
/* There is a horizontal shift */
+#line 3978 ""
++(*iccount);
+#line 3979 ""
if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, (
ftnlen)1) == 0) {
- errmsg_(lineq, iccount, ibar, "Expected number here for hori"
+#line 3980 ""
+ errmsg_(lineq, iccount, ibar, "Expected number here for hori"\
"zontal offset!", (ftnlen)128, (ftnlen)43);
+#line 3982 ""
stop1_();
+#line 3983 ""
}
+#line 3984 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 3985 ""
r__1 = fnum * 10;
+#line 3985 ""
idno = i_nint(&r__1);
+#line 3986 ""
if (idno > 255) {
+#line 3987 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"
+#line 3987 ""
+ errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"\
"ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56);
+#line 3989 ""
stop1_();
+#line 3990 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 3991 ""
errmsg_(lineq, iccount, ibar, "There should be a blank here!",
(ftnlen)128, (ftnlen)29);
+#line 3993 ""
stop1_();
+#line 3994 ""
}
+#line 3995 ""
}
/* iccount should be on the blank at the end of the entire symbol */
+#line 3999 ""
}
+#line 4000 ""
return 0;
} /* checkdyn_ */
@@ -5875,10 +10084,15 @@ L2:
/* subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */
/* * icashft) */
+#line 4007 ""
/* Parameter adjustments */
+#line 4007 ""
--icrdat;
+#line 4007 ""
+#line 4007 ""
/* Function Body */
+#line 4007 ""
found1 = FALSE_;
/* icashft will be max left shift of accid's in chord notes. */
@@ -5886,14 +10100,19 @@ L2:
/* Will include left shift of chord note itself. */
/* Rezero after use. */
+#line 4014 ""
i__1 = *ncrd;
+#line 4014 ""
for (icrd = 1; icrd <= i__1; ++icrd) {
/* This if block cycles thru all chord notes on ivx,ip; then returns. */
+#line 4018 ""
if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], (
ftnlen)-8)) == *ivx) {
+#line 4020 ""
found1 = TRUE_;
+#line 4021 ""
*iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test(
icrdat[icrd],27);
@@ -5917,12 +10136,19 @@ L2:
/* if (irshft .lt. 64) icashft = max(icashft,64-irshft) */
/* end if */
/* end if */
+#line 4044 ""
*isarp = *isarp || bit_test(icrdat[icrd],25);
+#line 4045 ""
} else if (found1) {
+#line 4046 ""
return 0;
+#line 4047 ""
}
+#line 4048 ""
/* L18: */
+#line 4048 ""
}
+#line 4049 ""
return 0;
} /* chkarp_ */
@@ -5934,26 +10160,41 @@ L2:
e_wsfe(void);
/* Fortran I/O blocks */
- static cilist io___245 = { 0, 6, 0, 0, 0 };
- static cilist io___246 = { 0, 6, 0, 0, 0 };
- static cilist io___247 = { 0, 6, 0, "(a6,2x,4i8)", 0 };
+ static cilist io___271 = { 0, 6, 0, 0, 0 };
+ static cilist io___272 = { 0, 6, 0, 0, 0 };
+ static cilist io___273 = { 0, 6, 0, "(a6,2x,4i8)", 0 };
+#line 4062 ""
if (commidi_1.imidi[*icm] >= 24576) {
- s_wsle(&io___245);
+#line 4063 ""
+ s_wsle(&io___271);
+#line 4063 ""
e_wsle();
- s_wsle(&io___246);
- do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"
+#line 4064 ""
+ s_wsle(&io___272);
+#line 4064 ""
+ do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"\
" worse", (ftnlen)52);
+#line 4064 ""
e_wsle();
- s_wsfe(&io___247);
+#line 4065 ""
+ s_wsfe(&io___273);
+#line 4065 ""
do_fio(&c__1, "imidi:", (ftnlen)6);
+#line 4065 ""
do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer));
+#line 4065 ""
do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer));
+#line 4065 ""
do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer));
+#line 4065 ""
do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer));
+#line 4065 ""
e_wsfe();
+#line 4067 ""
}
+#line 4068 ""
return 0;
} /* chkimidi_ */
@@ -5991,129 +10232,223 @@ L2:
/* otherwise next prior note. Relative to bottom line. */
/* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */
+#line 4090 ""
/* Parameter adjustments */
+#line 4090 ""
ipl -= 25;
+#line 4090 ""
mult -= 25;
+#line 4090 ""
--levbotr;
+#line 4090 ""
--levtopr;
+#line 4090 ""
nodur -= 25;
+#line 4090 ""
nib -= 25;
+#line 4090 ""
ivmx -= 25;
+#line 4090 ""
nolev -= 25;
+#line 4090 ""
irest -= 25;
+#line 4090 ""
islur -= 25;
+#line 4090 ""
--nn;
+#line 4090 ""
+#line 4090 ""
/* Function Body */
+#line 4090 ""
if (*ip != nn[*ivx] && ! bit_test(ipl[*ivx + *ip * 24],1)) {
/* Not the last note and not "look-left" for level */
+#line 4094 ""
i__1 = nn[*ivx];
+#line 4094 ""
for (kkp = *ip + 1; kkp <= i__1; ++kkp) {
+#line 4095 ""
if (bit_test(islur[*ivx + kkp * 24],29)) {
+#line 4095 ""
goto L4;
+#line 4095 ""
}
+#line 4096 ""
if (! bit_test(irest[*ivx + kkp * 24],0)) {
+#line 4097 ""
levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
/* Relative to botto */
+#line 4098 ""
goto L9;
+#line 4099 ""
}
+#line 4100 ""
/* L8: */
+#line 4100 ""
}
+#line 4101 ""
}
+#line 4102 ""
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 4108 ""
if (*ip == 1) {
+#line 4108 ""
return 0;
+#line 4108 ""
}
/* Get out if this is the first note. */
+#line 4109 ""
for (kkp = *ip - 1; kkp >= 1; --kkp) {
+#line 4110 ""
if (! bit_test(irest[*ivx + kkp * 24],0)) {
+#line 4111 ""
levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
/* Relative to bottom */
+#line 4112 ""
goto L9;
+#line 4113 ""
}
+#line 4114 ""
/* L3: */
+#line 4114 ""
}
/* go to 2 ! Pretty odd, should never be here, but get out if so. */
+#line 4116 ""
return 0;
/* Pretty odd, should never be here, but get out if so. */
+#line 4117 ""
L9:
/* Find note in other voice at same time */
+#line 4121 ""
i__1 = *ivx - *nv - 1;
+#line 4121 ""
iupdown = i_sign(&c__1, &i__1);
+#line 4122 ""
ivother = ivmx[*iv + (3 - iupdown) / 2 * 24];
+#line 4123 ""
tother = 0.f;
+#line 4124 ""
i__1 = nib[ivother + *ibar * 24];
+#line 4124 ""
for (kkp = 1; kkp <= i__1; ++kkp) {
+#line 4125 ""
if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) {
+#line 4125 ""
goto L6;
+#line 4125 ""
}
+#line 4126 ""
tother += nodur[ivother + kkp * 24];
+#line 4127 ""
/* L5: */
+#line 4127 ""
}
/* If here, then no note starts in other voice at same time, so set default */
+#line 4131 ""
levother = -iupdown * 50;
+#line 4132 ""
goto L7;
+#line 4133 ""
L6:
/* If here, have just identified a simultaneous note or rest in other voice */
+#line 4137 ""
if (! bit_test(irest[ivother + kkp * 24],0)) {
/* Not a rest, use it */
+#line 4138 ""
levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4;
+#line 4139 ""
} else {
+#line 4140 ""
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 4145 ""
return 0;
+#line 4146 ""
}
+#line 4147 ""
levother = -iupdown * 50;
+#line 4148 ""
}
+#line 4149 ""
L7:
+#line 4150 ""
if (*mode == 1) {
+#line 4151 ""
indxr = log2_(&nodur[*ivx + *ip * 24]) + 1;
+#line 4152 ""
} else {
/* nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */
+#line 4154 ""
indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1;
+#line 4155 ""
}
+#line 4156 ""
if (iupdown < 0) {
+#line 4157 ""
levtop = levtopr[indxr];
+#line 4158 ""
iraise1 = levother - levtop - 3;
/* Based on other note */
+#line 4159 ""
iraise2 = levnext - levtop;
/* Based on following note */
+#line 4160 ""
if (indxr == 5 && levnext < 1) {
+#line 4160 ""
iraise2 += 2;
+#line 4160 ""
}
+#line 4161 ""
iraise = min(iraise1,iraise2);
+#line 4162 ""
if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) {
+#line 4162 ""
--iraise;
+#line 4162 ""
}
+#line 4164 ""
} else {
+#line 4165 ""
levbot = levbotr[indxr];
+#line 4166 ""
iraise1 = levother - levbot + 3;
+#line 4167 ""
iraise2 = levnext - levbot;
+#line 4168 ""
if (indxr == 5 && levnext > 8) {
+#line 4168 ""
--iraise2;
+#line 4168 ""
}
+#line 4169 ""
iraise = max(iraise1,iraise2);
+#line 4170 ""
if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) {
+#line 4170 ""
--iraise;
+#line 4170 ""
}
+#line 4172 ""
}
+#line 4173 ""
nolev[*ivx + *ip * 24] = iraise + 100;
+#line 4174 ""
return 0;
} /* chkkbdrests_ */
@@ -6130,44 +10465,80 @@ L7:
extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
ftnlen);
+#line 4179 ""
*literr = 0;
+#line 4180 ""
itype = 1;
+#line 4181 ""
L17:
+#line 4181 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 4182 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 4182 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
+#line 4183 ""
++itype;
+#line 4184 ""
if (itype > 3) {
+#line 4185 ""
*literr = 1;
+#line 4186 ""
return 0;
+#line 4187 ""
}
+#line 4188 ""
goto L17;
+#line 4189 ""
}
+#line 4190 ""
lenlit = itype;
+#line 4191 ""
L18:
+#line 4191 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 4192 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 4192 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
+#line 4193 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 4194 ""
if (*(unsigned char *)charq != ' ') {
/* Starting a new tex command withing the string */
+#line 4198 ""
lenlit += 2;
+#line 4199 ""
if (lenlit > 128) {
+#line 4200 ""
*literr = 2;
+#line 4201 ""
return 0;
+#line 4202 ""
}
+#line 4203 ""
goto L18;
+#line 4204 ""
}
+#line 4205 ""
} else {
+#line 4206 ""
++lenlit;
+#line 4207 ""
if (lenlit > 128) {
+#line 4208 ""
*literr = 2;
+#line 4209 ""
return 0;
+#line 4210 ""
}
+#line 4211 ""
goto L18;
+#line 4212 ""
}
+#line 4213 ""
return 0;
} /* chklit_ */
@@ -6199,8 +10570,11 @@ L18:
/* numbers. If moved=.true., iccount on exit is on end of last number. */
/* If moved=.false., iccount still on +/- */
+#line 4226 ""
i__1 = *iccount - 2;
+#line 4226 ""
i__2 = *iccount;
+#line 4226 ""
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) {
@@ -6208,66 +10582,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 4232 ""
ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1)
- 2;
+#line 4233 ""
i__1 = *iccount + 1;
+#line 4233 ""
i__2 = *iccount;
+#line 4233 ""
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 4238 ""
*moved = FALSE_;
+#line 4239 ""
return 0;
+#line 4240 ""
}
+#line 4241 ""
ishorz = ipm > 1;
/* Save iccount in case it's not accid shift and we have to reset. */
+#line 4245 ""
icsav = *iccount;
+#line 4246 ""
++(*iccount);
+#line 4247 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 4248 ""
if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* This has to be accidental shift. Set vert. shift. */
+#line 4252 ""
if (! ishorz) {
/* +/- syntax, both shifts set, vertical first */
+#line 4256 ""
i__1 = (integer) (ipm * fnum + 32.5f);
+#line 4256 ""
setbits_(nacc, &c__6, &c__4, &i__1);
+#line 4257 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
+#line 4258 ""
++(*iccount);
+#line 4259 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 4260 ""
} else {
/* </> syntax, only horiz set */
+#line 4264 ""
ipm += -3;
+#line 4265 ""
}
/* Set horiz. shift */
+#line 4269 ""
r__1 = (ipm * fnum + 5.35f) * 20;
+#line 4269 ""
i__1 = i_nint(&r__1);
+#line 4269 ""
setbits_(nacc, &c__7, &c__10, &i__1);
+#line 4270 ""
--(*iccount);
+#line 4271 ""
*moved = TRUE_;
+#line 4272 ""
} else {
/* False alarm. Reset everything and flow onward */
+#line 4276 ""
*moved = FALSE_;
+#line 4277 ""
*iccount = icsav;
+#line 4278 ""
}
+#line 4279 ""
} else {
/* Either prior char was not 'sfn' or next was not digit, so take no action */
+#line 4283 ""
*moved = FALSE_;
+#line 4284 ""
}
+#line 4285 ""
return 0;
} /* chkpm4ac_ */
@@ -6290,40 +10698,62 @@ L18:
/* Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */
+#line 4293 ""
*nclef = lbit_shift(*isl, (ftnlen)-12) & 7;
+#line 4294 ""
if (*nclef == 0) {
/* treble */
+#line 4298 ""
nlev = 2;
+#line 4299 ""
} else if (*nclef > 6) {
/* French violin */
+#line 4303 ""
nlev = 0;
+#line 4304 ""
} else if (*nclef < 5) {
/* C-clef */
+#line 4308 ""
nlev = (*nclef << 1) - 2;
+#line 4309 ""
} else {
/* F-clef */
+#line 4313 ""
nlev = (*nclef << 1) - 6;
+#line 4314 ""
}
/* Writing concatenation */
+#line 4315 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 4315 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 4315 ""
i__1[1] = 7, a__1[1] = "pmxclef";
+#line 4315 ""
i__2 = min(*nclef,7) + 48;
+#line 4315 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 4315 ""
i__1[2] = 1, a__1[2] = ch__2;
+#line 4315 ""
i__3 = nlev + 48;
+#line 4315 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 4315 ""
i__1[3] = 1, a__1[3] = ch__3;
+#line 4315 ""
s_cat(notexq, a__1, i__1, &c__4, notexq_len);
+#line 4317 ""
*lnote = 10;
+#line 4318 ""
return 0;
} /* clefsym_ */
@@ -6378,8 +10808,8 @@ L18:
integer *);
/* Fortran I/O blocks */
- static cilist io___294 = { 0, 6, 0, 0, 0 };
- static cilist io___295 = { 0, 6, 0, 0, 0 };
+ static cilist io___320 = { 0, 6, 0, 0, 0 };
+ static cilist io___321 = { 0, 6, 0, 0, 0 };
@@ -6398,11 +10828,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 4345 ""
/* Parameter adjustments */
+#line 4345 ""
--ksegrb0;
+#line 4345 ""
segrb0 -= 3;
+#line 4345 ""
--micrd;
+#line 4345 ""
+#line 4345 ""
/* Function Body */
/* Fancy sharp boundary. fl,sh,na,dfl,dsh */
@@ -6419,97 +10855,152 @@ L18:
/* Set up barrier segrb(iseg,ipoint) to define coords of corner points */
/* on stem+notes */
+#line 4376 ""
i__1 = *nsegrb0;
+#line 4376 ""
for (iseg = 1; iseg <= i__1; ++iseg) {
+#line 4377 ""
segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1];
+#line 4378 ""
segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2];
+#line 4379 ""
ksegrb[iseg - 1] = ksegrb0[iseg];
+#line 4380 ""
/* L11: */
+#line 4380 ""
}
+#line 4381 ""
nsegrb = *nsegrb0;
+#line 4382 ""
*rmsshift = 0.f;
+#line 4383 ""
shiftmin = 1e3f;
+#line 4384 ""
i__1 = *naccid;
+#line 4384 ""
for (iwa = 1; iwa <= i__1; ++iwa) {
/* Initialize shift for this note */
+#line 4388 ""
shift = 0.f;
+#line 4389 ""
mainnote = micrd[iwa] == 0;
+#line 4390 ""
isetshft[iwa - 1] = -1;
/* Get note level and accidental type */
+#line 4394 ""
if (mainnote) {
+#line 4395 ""
nolev = *nolevm;
+#line 4396 ""
iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1];
+#line 4397 ""
} else {
+#line 4398 ""
nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, &
c__12);
+#line 4399 ""
iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &
c__3, &c__20) - 1];
+#line 4400 ""
}
/* Cycle thru segments on right edge of this accidental */
+#line 4404 ""
i__2 = nsegar[iacctype - 1] - 1;
+#line 4404 ""
for (isega = 1; isega <= i__2; ++isega) {
+#line 4405 ""
ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16];
+#line 4406 ""
ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 -
16];
/* Cycle thru segments of right-hand barrier */
+#line 4410 ""
i__3 = nsegrb - 1;
+#line 4410 ""
for (isegrb = 1; isegrb <= i__3; ++isegrb) {
/* Must find all barrier segments that start below ytopseg & end above ybotseg */
+#line 4414 ""
if (segrb[(isegrb << 1) - 1] < ytopaseg) {
/* Barrier seg starts below top of accid */
/* Check if barrier seg ends above bottom of accid */
+#line 4419 ""
if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) {
+#line 4420 ""
if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype
+ ((isega << 1) + 1) * 5 - 16]) {
+#line 4422 ""
shift = segrb[(isegrb << 1) - 2] - segar[iacctype
+ ((isega << 1) + 1) * 5 - 16];
/* Record the cause of the shift */
+#line 4426 ""
isetshft[iwa - 1] = ksegrb[isegrb - 1];
+#line 4427 ""
}
+#line 4428 ""
}
/* Does barrier segment end above top of accid seg? */
+#line 4432 ""
if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) {
+#line 4432 ""
goto L4;
+#line 4432 ""
}
+#line 4433 ""
}
+#line 4434 ""
/* L3: */
+#line 4434 ""
}
+#line 4435 ""
L4:
+#line 4436 ""
/* L2: */
+#line 4436 ""
;
+#line 4436 ""
}
+#line 4437 ""
if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) {
/* if (nolev .eq. levmaxacc) then */
+#line 4440 ""
if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) {
+#line 4441 ""
*rmsshift = 1e3f;
+#line 4442 ""
return 0;
+#line 4443 ""
}
/* Does the following properly account for left-shifted noteheads? */
/* Top-down rank of this note we just shifted */
+#line 4449 ""
if (mainnote) {
+#line 4450 ""
irank = *icrdot0;
+#line 4451 ""
} else {
+#line 4452 ""
irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, &
c__27);
+#line 4453 ""
}
/* Compare level-rank of this note vs. that of note that caused the shift. */
@@ -6522,158 +11013,264 @@ L4:
/* icrd: Chord-note accidental */
/* isetshft(i),i=1,naccid: what set shift for this accid, same codes */
+#line 4465 ""
if (isetshft[iwa - 1] < 0) {
+#line 4466 ""
iranksetter = 0;
+#line 4467 ""
} else if (isetshft[iwa - 1] == 0) {
+#line 4468 ""
iranksetter = *icrdot0;
+#line 4469 ""
} else {
+#line 4470 ""
iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1]
- 1], &c__3, &c__27);
+#line 4471 ""
}
+#line 4472 ""
if (iranksetter != 0 && irank != iranksetter + 1) {
+#line 4473 ""
*rmsshift = 1e3f;
+#line 4474 ""
return 0;
+#line 4475 ""
}
+#line 4476 ""
}
/* Computing 2nd power */
+#line 4477 ""
r__1 = shift;
+#line 4477 ""
*rmsshift += r__1 * r__1;
+#line 4478 ""
if (*lasttime && dabs(shift) > 1e-4f) {
+#line 4479 ""
if (mainnote) {
+#line 4480 ""
if (! bit_test(*nacc,29)) {
+#line 4480 ""
goto L10;
+#line 4480 ""
}
+#line 4481 ""
} else {
+#line 4482 ""
if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) {
+#line 4482 ""
goto L10;
+#line 4482 ""
}
+#line 4483 ""
}
/* 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 4489 ""
if (mainnote) {
+#line 4490 ""
shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f;
+#line 4491 ""
} else {
+#line 4492 ""
shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7,
&c__20) - 107) * .05f;
+#line 4493 ""
}
+#line 4494 ""
L10:
+#line 4495 ""
if (*twooftwo) {
/* Record the shift for this accidental */
+#line 4499 ""
if (shift < -5.35f) {
+#line 4500 ""
printl_(" ", (ftnlen)1);
- printl_("WARNING: auto-generated accidental shift too bi"
+#line 4501 ""
+ printl_("WARNING: auto-generated accidental shift too bi"\
"g for PMX, ignoring", (ftnlen)66);
+#line 4503 ""
} else {
+#line 4504 ""
r__1 = (shift + 5.35f) * 20;
+#line 4504 ""
ishift = i_nint(&r__1);
+#line 4505 ""
if (mainnote) {
+#line 4506 ""
setbits_(nacc, &c__7, &c__10, &ishift);
+#line 4507 ""
} else {
+#line 4508 ""
setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, &
c__20, &ishift);
+#line 4509 ""
}
+#line 4510 ""
}
+#line 4511 ""
} else {
/* This is the earlier call to precrd, so need minimum shift */
+#line 4515 ""
shiftmin = dmin(shiftmin,shift);
+#line 4516 ""
}
+#line 4517 ""
}
/* Bail out if this is the last accidental to check */
+#line 4521 ""
if (iwa == *naccid) {
+#line 4521 ""
goto L1;
+#line 4521 ""
}
/* 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 4526 ""
for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) {
+#line 4527 ""
if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + ((
nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) {
+#line 4529 ""
for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) {
+#line 4530 ""
if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype
+ 4]) {
+#line 4530 ""
goto L6;
+#line 4530 ""
}
+#line 4532 ""
/* L9: */
+#line 4532 ""
}
- s_wsle(&io___294);
+#line 4533 ""
+ s_wsle(&io___320);
+#line 4533 ""
do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6);
+#line 4533 ""
e_wsle();
+#line 4534 ""
stop1_();
+#line 4535 ""
}
+#line 4536 ""
/* L5: */
+#line 4536 ""
}
- s_wsle(&io___295);
+#line 4537 ""
+ s_wsle(&io___321);
+#line 4537 ""
do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16);
+#line 4537 ""
e_wsle();
+#line 4538 ""
stop1_();
+#line 4539 ""
L6:
+#line 4540 ""
netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot;
/* Shift high segments up */
+#line 4544 ""
if (netgain >= 0) {
+#line 4545 ""
i__2 = ibelowtop + 1;
+#line 4545 ""
for (isegrb = nsegrb; isegrb >= i__2; --isegrb) {
+#line 4546 ""
segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
+#line 4547 ""
segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
+#line 4548 ""
ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
+#line 4549 ""
/* L7: */
+#line 4549 ""
}
/* Set up 1st segment above accid */
+#line 4553 ""
segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
2];
+#line 4554 ""
segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
(nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
+#line 4556 ""
ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
+#line 4557 ""
} else {
/* netgain<0, must remove segments. Use same coding but reverse order, */
/* work from bottom up */
+#line 4562 ""
segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
2];
+#line 4563 ""
segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
(nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
+#line 4565 ""
ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
+#line 4566 ""
i__2 = nsegrb;
+#line 4566 ""
for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) {
+#line 4567 ""
segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
+#line 4568 ""
segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
+#line 4569 ""
ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
+#line 4570 ""
/* L12: */
+#line 4570 ""
}
+#line 4571 ""
}
/* Insert new segments */
+#line 4575 ""
i__2 = nsegal[iacctype - 1] - 1;
+#line 4575 ""
for (isega = 1; isega <= i__2; ++isega) {
+#line 4576 ""
segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + ((
isega << 1) + 1) * 5 - 16];
+#line 4577 ""
segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + ((
isega << 1) + 2) * 5 - 16];
+#line 4578 ""
if (mainnote) {
+#line 4579 ""
ksegrb[ibelowbot + isega - 1] = 0;
+#line 4580 ""
} else {
+#line 4581 ""
ksegrb[ibelowbot + isega - 1] = micrd[iwa];
+#line 4582 ""
}
+#line 4583 ""
/* L8: */
+#line 4583 ""
}
/* Update number of barrier segments */
+#line 4587 ""
nsegrb += netgain;
/* c */
/* c Temporary printout for boundary segments as built up */
@@ -6684,16 +11281,23 @@ L6:
/* write(15,'(a/(2i5))')' micrd isetshft', */
/* * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */
/* c */
+#line 4597 ""
L1:
+#line 4597 ""
;
+#line 4597 ""
}
/* next accidental */
+#line 4598 ""
if (*lasttime && ! (*twooftwo)) {
/* This is the final call on the pre-ask pass, so compute left-shift rqmt. */
+#line 4602 ""
r__1 = shiftmin * -20;
+#line 4602 ""
*icashft = i_nint(&r__1);
+#line 4603 ""
}
/* c */
/* c Temporary printout for boundary segments */
@@ -6706,6 +11310,7 @@ L1:
/* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */
/* end if */
/* c */
+#line 4615 ""
return 0;
} /* crdacc_ */
@@ -6742,7 +11347,7 @@ L1:
integer *);
/* Fortran I/O blocks */
- static cilist io___324 = { 0, 6, 0, 0, 0 };
+ static cilist io___350 = { 0, 6, 0, 0, 0 };
@@ -6775,16 +11380,27 @@ L1:
/* Initialize right-barrier */
+#line 4655 ""
/* Parameter adjustments */
+#line 4655 ""
--kicrd;
+#line 4655 ""
+#line 4655 ""
/* Function Body */
+#line 4655 ""
segrb0[0] = 0.f;
+#line 4656 ""
segrb0[1] = -1e3f;
+#line 4657 ""
segrb0[2] = 0.f;
+#line 4658 ""
segrb0[3] = 1e3f;
+#line 4659 ""
nsegrb0 = 2;
+#line 4660 ""
ksegrb0[0] = -1;
+#line 4661 ""
ksegrb0[1] = -1;
/* Search for left-shifted notes, Make up the initial right-barrier, which */
@@ -6792,77 +11408,124 @@ L1:
/* irest()(27) is set if any notes are left-shifted */
/* Must use ALL chord notes, not just ones w/ accid's. */
+#line 4668 ""
if (bit_test(*irest,27)) {
+#line 4669 ""
i__1 = comtrill_1.icrd2;
+#line 4669 ""
for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) {
+#line 4670 ""
if (icrd == comtrill_1.icrd1 - 1) {
/* Main note */
/* lshift = btest(ipl,8) */
+#line 4675 ""
lshift = bit_test(*ipl,8) || bit_test(*nacc,31);
+#line 4676 ""
if (lshift) {
+#line 4676 ""
nolev = *nolevm;
+#line 4676 ""
}
+#line 4677 ""
} else {
/* Chord note */
+#line 4681 ""
lshift = bit_test(comtrill_1.icrdat[icrd - 1],23);
/* if (lshift) nolev = igetbits(icrdat(icrd),7,12) */
+#line 4683 ""
if (lshift) {
+#line 4684 ""
nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &
c__12);
+#line 4685 ""
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 4691 ""
lshift = FALSE_;
+#line 4692 ""
}
+#line 4693 ""
}
+#line 4694 ""
}
+#line 4695 ""
if (lshift) {
+#line 4696 ""
i__2 = nsegrb0 - 1;
+#line 4696 ""
for (isegrb = 1; isegrb <= i__2; ++isegrb) {
+#line 4697 ""
if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) {
/* Add this notehead to the right boundary here. Move all higher segs up 2. */
+#line 4701 ""
i__3 = isegrb + 1;
+#line 4701 ""
for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) {
+#line 4702 ""
segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1)
- 2];
+#line 4703 ""
segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1)
- 1];
+#line 4704 ""
ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1];
+#line 4705 ""
/* L17: */
+#line 4705 ""
}
+#line 4706 ""
goto L18;
+#line 4707 ""
}
+#line 4708 ""
/* L16: */
+#line 4708 ""
}
+#line 4709 ""
L18:
/* Insert notehead into list. Set kseg=-2 to signal notehead shift. */
+#line 4713 ""
iiseg = isegrb + 1;
+#line 4714 ""
segrb0[(iiseg << 1) - 2] = -1.2f;
+#line 4715 ""
segrb0[(iiseg << 1) - 1] = nolev - 1.f;
+#line 4716 ""
ksegrb0[iiseg - 1] = -2;
+#line 4717 ""
segrb0[(iiseg + 1 << 1) - 2] = 0.f;
+#line 4718 ""
segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f;
+#line 4719 ""
ksegrb0[iiseg] = -1;
+#line 4720 ""
nsegrb0 += 2;
+#line 4721 ""
}
+#line 4722 ""
/* L15: */
+#line 4722 ""
}
+#line 4723 ""
}
/* Done setting right barrier for left-shifted noteheads */
+#line 4727 ""
tagged = FALSE_;
+#line 4728 ""
manual = FALSE_;
/* Preprocess to check for manual shifts. */
@@ -6876,179 +11539,302 @@ L18:
/* End if */
/* End if */
+#line 4741 ""
maxmanshft = 0;
+#line 4742 ""
i__1 = *naccid;
+#line 4742 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4743 ""
if (kicrd[i__] == 0) {
/* Main note */
+#line 4747 ""
manshft = igetbits_(nacc, &c__7, &c__10);
+#line 4748 ""
if (manshft != 0) {
+#line 4749 ""
manual = TRUE_;
+#line 4750 ""
if (bit_test(*nacc,29)) {
+#line 4751 ""
tagged = TRUE_;
+#line 4752 ""
} else {
/* maxmanshft = max(maxmanshft,64-manshft) */
/* Computing MAX */
+#line 4754 ""
i__2 = maxmanshft, i__3 = 107 - manshft;
+#line 4754 ""
maxmanshft = max(i__2,i__3);
+#line 4755 ""
}
+#line 4756 ""
}
+#line 4757 ""
} else {
/* Chord note */
+#line 4761 ""
manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
c__20);
+#line 4762 ""
if (manshft != 0) {
+#line 4763 ""
manual = TRUE_;
+#line 4764 ""
if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
+#line 4765 ""
tagged = TRUE_;
+#line 4766 ""
} else {
/* maxmanshft = max(maxmanshft,64-manshft) */
/* Computing MAX */
+#line 4768 ""
i__2 = maxmanshft, i__3 = 107 - manshft;
+#line 4768 ""
maxmanshft = max(i__2,i__3);
+#line 4769 ""
}
+#line 4770 ""
}
+#line 4771 ""
}
+#line 4772 ""
/* L13: */
+#line 4772 ""
}
+#line 4773 ""
if (manual) {
+#line 4774 ""
if (tagged) {
/* zero out all untagged shifts */
+#line 4778 ""
i__1 = *naccid;
+#line 4778 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4779 ""
if (kicrd[i__] == 0) {
+#line 4780 ""
if (! bit_test(*nacc,29)) {
+#line 4780 ""
setbits_(nacc, &c__7, &c__10, &c__0);
+#line 4780 ""
}
+#line 4781 ""
} else {
+#line 4782 ""
if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
+#line 4782 ""
setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
c__20, &c__0);
+#line 4782 ""
}
+#line 4784 ""
}
+#line 4785 ""
/* L14: */
+#line 4785 ""
}
+#line 4786 ""
} else {
/* There are manual shifts but none tagged. Only proceed if "Ao" was entered */
+#line 4790 ""
if (! bit_test(*nacc,28)) {
+#line 4791 ""
*icashft = maxmanshft;
+#line 4792 ""
return 0;
+#line 4793 ""
}
+#line 4794 ""
}
+#line 4795 ""
}
+#line 4796 ""
if (bit_test(*nacc,28)) {
/* Take the accidentals in order as originally input, then exit. */
+#line 4800 ""
crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy,
&idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
+#line 4802 ""
return 0;
/* end if */
+#line 4804 ""
} 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 4809 ""
for (i__ = 1; i__ <= 3; ++i__) {
+#line 4810 ""
if (kicrd[i__] == 0) {
+#line 4811 ""
irank = *icrdot0;
+#line 4812 ""
nolev = *nolevm;
+#line 4813 ""
} else {
+#line 4814 ""
irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, &
c__27);
+#line 4815 ""
nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, &
c__12);
+#line 4816 ""
}
+#line 4817 ""
if (irank == 1) {
+#line 4818 ""
micrd[0] = kicrd[i__];
+#line 4819 ""
} else {
+#line 4820 ""
micrd[5 - irank - 1] = kicrd[i__];
+#line 4821 ""
}
+#line 4822 ""
if (irank == 2) {
+#line 4823 ""
levmidacc = nolev;
+#line 4824 ""
}
+#line 4825 ""
/* L20: */
+#line 4825 ""
}
+#line 4826 ""
if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) {
+#line 4828 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy,
&idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
+#line 4830 ""
return 0;
+#line 4831 ""
}
+#line 4832 ""
}
+#line 4833 ""
rmsmin = 1e5f;
/* Initialize permutation array */
+#line 4837 ""
i__1 = *naccid;
+#line 4837 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4838 ""
iperm[i__ - 1] = i__;
+#line 4839 ""
/* L7: */
+#line 4839 ""
}
/* Start looping over permutations */
+#line 4843 ""
for (ip = 1; ip <= 5041; ++ip) {
+#line 4844 ""
if (ip != 1) {
/* Work the magic algorithm to get the next permutation */
+#line 4848 ""
for (k = *naccid - 1; k >= 1; --k) {
+#line 4849 ""
if (iperm[k - 1] <= iperm[k]) {
+#line 4849 ""
goto L2;
+#line 4849 ""
}
+#line 4850 ""
/* L1: */
+#line 4850 ""
}
/* If here, we just got the last permutation, so exit the loop over permutations */
+#line 4854 ""
goto L10;
+#line 4855 ""
L2:
+#line 4856 ""
for (j = *naccid; j >= 1; --j) {
+#line 4857 ""
if (iperm[k - 1] <= iperm[j - 1]) {
+#line 4857 ""
goto L4;
+#line 4857 ""
}
+#line 4858 ""
/* L3: */
+#line 4858 ""
}
+#line 4859 ""
L4:
+#line 4860 ""
it = iperm[j - 1];
+#line 4861 ""
iperm[j - 1] = iperm[k - 1];
+#line 4862 ""
iperm[k - 1] = it;
+#line 4863 ""
is = k + 1;
+#line 4864 ""
for (ir = *naccid; ir >= 1; --ir) {
+#line 4865 ""
if (ir <= is) {
+#line 4865 ""
goto L6;
+#line 4865 ""
}
+#line 4866 ""
it = iperm[ir - 1];
+#line 4867 ""
iperm[ir - 1] = iperm[is - 1];
+#line 4868 ""
iperm[is - 1] = it;
+#line 4869 ""
++is;
+#line 4870 ""
/* L5: */
+#line 4870 ""
}
+#line 4871 ""
L6:
+#line 4872 ""
;
+#line 4872 ""
}
/* New we have a permutation. Take icrd values out of kicrd and put them into */
/* micrd in the order of the permutation */
+#line 4877 ""
i__1 = *naccid;
+#line 4877 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4878 ""
micrd[i__ - 1] = kicrd[iperm[i__ - 1]];
+#line 4879 ""
/* L9: */
+#line 4879 ""
}
/* c */
/* c Temporary printout */
/* c */
/* write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */
/* c */
+#line 4885 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc,
icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
/* c */
@@ -7056,39 +11842,61 @@ L6:
/* c */
/* write(15,*)'perm done, rmsshift:',rmsshift */
/* c */
+#line 4892 ""
if (rmsshift < rmsmin) {
/* Save this permutation, reset minrms */
+#line 4896 ""
i__1 = *naccid;
+#line 4896 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4897 ""
ipermsav[i__ - 1] = iperm[i__ - 1];
+#line 4898 ""
rmsmin = rmsshift;
+#line 4899 ""
/* L11: */
+#line 4899 ""
}
+#line 4900 ""
}
+#line 4901 ""
/* L8: */
+#line 4901 ""
}
- s_wsle(&io___324);
+#line 4902 ""
+ s_wsle(&io___350);
+#line 4902 ""
do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24);
+#line 4902 ""
e_wsle();
+#line 4903 ""
stop1_();
+#line 4904 ""
L10:
/* Done looping, get info for the final choice */
+#line 4908 ""
i__1 = *naccid;
+#line 4908 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 4909 ""
micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]];
+#line 4910 ""
/* L12: */
+#line 4910 ""
}
/* c */
/* c Temporary printout */
/* c */
/* write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */
/* c */
+#line 4916 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy,
segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
+#line 4918 ""
return 0;
} /* crdaccs_ */
@@ -7122,108 +11930,191 @@ L10:
static char acsymq[3];
static integer lnoten;
+#line 4926 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 4926 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 4927 ""
if (*ihshft == -107) {
+#line 4927 ""
*ihshft = 0;
+#line 4927 ""
}
/* c */
/* c If main note shifted left, so shift accid. Terminate below, when acc. is done. */
/* c */
+#line 4931 ""
if (*ihshft != 0) {
/* Accid must be shifted horizontally */
+#line 4935 ""
if (*ihshft < 0) {
/* Writing concatenation */
+#line 4936 ""
i__1[0] = 1, a__1[0] = sq;
+#line 4936 ""
i__1[1] = 8, a__1[1] = "loffset{";
+#line 4936 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4937 ""
*ihshft = -(*ihshft);
+#line 4938 ""
} else {
/* Writing concatenation */
+#line 4939 ""
i__1[0] = 1, a__1[0] = sq;
+#line 4939 ""
i__1[1] = 8, a__1[1] = "roffset{";
+#line 4939 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4940 ""
}
+#line 4941 ""
hshft = *ihshft * .05f;
+#line 4942 ""
if (hshft < 1.f) {
+#line 4943 ""
ici__1.icierr = 0;
+#line 4943 ""
ici__1.icirnum = 1;
+#line 4943 ""
ici__1.icirlen = 3;
+#line 4943 ""
ici__1.iciunit = notexq + 9;
+#line 4943 ""
ici__1.icifmt = "(f3.2)";
+#line 4943 ""
s_wsfi(&ici__1);
+#line 4943 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
+#line 4943 ""
e_wsfi();
+#line 4944 ""
*lnote = 12;
+#line 4945 ""
} else {
+#line 4946 ""
ici__1.icierr = 0;
+#line 4946 ""
ici__1.icirnum = 1;
+#line 4946 ""
ici__1.icirlen = 4;
+#line 4946 ""
ici__1.iciunit = notexq + 9;
+#line 4946 ""
ici__1.icifmt = "(f4.2)";
+#line 4946 ""
s_wsfi(&ici__1);
+#line 4946 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
+#line 4946 ""
e_wsfi();
+#line 4947 ""
*lnote = 13;
+#line 4948 ""
}
/* Writing concatenation */
+#line 4949 ""
i__2[0] = *lnote, a__2[0] = notexq;
+#line 4949 ""
i__2[1] = 2, a__2[1] = "}{";
+#line 4949 ""
i__2[2] = 1, a__2[2] = sq;
+#line 4949 ""
s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
+#line 4950 ""
*lnote += 3;
+#line 4951 ""
} else {
+#line 4952 ""
s_copy(notexq, sq, (ftnlen)79, (ftnlen)1);
+#line 4953 ""
*lnote = 1;
+#line 4954 ""
}
+#line 4955 ""
if (bit_test(*nacc,3)) {
/* Writing concatenation */
+#line 4956 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 4956 ""
i__1[1] = 3, a__1[1] = "big";
+#line 4956 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4957 ""
*lnote += 3;
+#line 4958 ""
}
+#line 4959 ""
if (*caut) {
/* Cautionary accidental. Need to define bigcna,... in pmx.tex */
/* Writing concatenation */
+#line 4963 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 4963 ""
i__1[1] = 1, a__1[1] = "c";
+#line 4963 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4964 ""
++(*lnote);
+#line 4965 ""
}
+#line 4966 ""
accsym_(nacc, acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
+#line 4967 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 4967 ""
i__1[1] = lacc, a__1[1] = acsymq;
+#line 4967 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4968 ""
*lnote += lacc;
+#line 4969 ""
noleva = *nolev;
+#line 4970 ""
if (*ivshft != 0) {
+#line 4970 ""
noleva = noleva + *ivshft - 32;
+#line 4970 ""
}
+#line 4971 ""
notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8);
+#line 4972 ""
if (lnoten == 1) {
+#line 4972 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 4972 ""
}
/* Writing concatenation */
+#line 4973 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 4973 ""
i__1[1] = lnoten, a__1[1] = noteq;
+#line 4973 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4974 ""
*lnote += lnoten;
+#line 4975 ""
if (*ihshft != 0) {
/* Terminate horizontal shift */
/* Writing concatenation */
+#line 4979 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 4979 ""
i__1[1] = 1, a__1[1] = "}";
+#line 4979 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 4980 ""
++(*lnote);
+#line 4981 ""
}
+#line 4982 ""
return 0;
} /* doacc_ */
@@ -7231,17 +12122,19 @@ L10:
*ncm, integer *iv, real *tnow, char *soutq, integer *lsout, char *ulq,
integer *ibmcnt, integer *islur, integer *nvmx, integer *nv, logical
*beamon, integer *nolevm, integer *ihornb, integer *nornb, real *
- stemlen, logical *dotxtup, integer *nacc, ftnlen soutq_len, ftnlen
- ulq_len)
+ stemlen, logical *dotxtup, integer *nacc, integer *irest, ftnlen
+ soutq_len, ftnlen ulq_len)
{
/* System generated locals */
address a__1[2];
integer i__1, i__2, i__3[2], i__4, i__5, i__6;
+ real r__1;
logical L__1;
char ch__1[1];
/* Builtin functions */
- integer pow_ii(integer *, integer *), lbit_shift(integer, integer);
+ integer i_nint(real *), lbit_shift(integer, integer), pow_ii(integer *,
+ integer *);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char
@@ -7250,11 +12143,11 @@ L10:
/* Local variables */
extern /* Subroutine */ int addblank_(char *, integer *, ftnlen);
extern integer igetbits_(integer *, integer *, integer *);
- static integer kv;
+ static integer icrdatsav, icrdotsav, kv;
extern integer log2_(integer *);
static integer icrd;
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
- static integer lout, lsym;
+ static integer indm, lout, lsym;
static char outq[79];
extern /* Subroutine */ int stop1_(void), doacc_(integer *, integer *,
char *, integer *, integer *, integer *, integer *, logical *,
@@ -7269,9 +12162,11 @@ L10:
extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer
*, ftnlen);
static real updotc, rtdotc;
- static integer nolevo, lnoten;
+ static integer nolevo;
extern /* Subroutine */ int dotmov_(real *, real *, char *, integer *,
- integer *, ftnlen), putarp_(real *, integer *, integer *, integer
+ integer *, ftnlen);
+ static integer lnoten;
+ extern /* Subroutine */ int putarp_(real *, integer *, integer *, integer
*, integer *, char *, integer *, ftnlen);
static char notexq[79], nosymq[7];
extern /* Subroutine */ int putorn_(integer *, integer *, integer *,
@@ -7285,11 +12180,9 @@ L10:
integer *);
/* Fortran I/O blocks */
- static cilist io___349 = { 0, 6, 0, 0, 0 };
- static cilist io___350 = { 0, 6, 0, 0, 0 };
-
+ static cilist io___378 = { 0, 6, 0, 0, 0 };
+ static cilist io___379 = { 0, 6, 0, 0, 0 };
-/* 130316 */
/* This subr. once produced notexq for entire chord. 10/18/97 altered to write */
@@ -7300,34 +12193,195 @@ 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 5036 ""
/* Parameter adjustments */
+#line 5036 ""
+ irest -= 25;
+#line 5036 ""
--nornb;
+#line 5036 ""
ihornb -= 25;
+#line 5036 ""
ulq -= 25;
+#line 5036 ""
+#line 5036 ""
/* Function Body */
+#line 5036 ""
commidi_1.nmidcrd = 0;
+#line 5037 ""
commidi_1.notmain = TRUE_;
+#line 5038 ""
commidi_1.crdacc = FALSE_;
+#line 5039 ""
i__1 = comtrill_1.icrd2;
+#line 5039 ""
for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) {
+#line 5040 ""
lnote = 0;
+#line 5041 ""
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 5045 ""
nolevo = nolev;
/* Check for special situations with 2nds (see precrd). */
- if (bit_test(*nacc,30)) {
- if (nolev == *nolevm - 1) {
- nolev = *nolevm;
- }
- } else if (bit_test(*nacc,31)) {
- if (nolev == *nolevm + 1) {
- nolev = *nolevm;
+#line 5049 ""
+ if (bit_test(*nacc,30) && nolev == *nolevm - 1) {
+
+/* Upstem, 2nd with upper as main, interchange pitches, */
+/* rt-shift upper (now chord note). Lower (orig chord, now main) */
+/* if dotted, probably had shifted dot, dot parameters must be moved */
+/* from chord to main */
+
+#line 5056 ""
+ nolev = *nolevm;
+#line 5057 ""
+ if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
+
+/* Orig. chord note dot shift, must transfer to main. */
+
+#line 5061 ""
+ icrdotsav = comtrill_1.icrdot[icrd - 1];
+#line 5062 ""
+ icrdatsav = comtrill_1.icrdat[icrd - 1];
+#line 5063 ""
+ if (bit_test(irest[*ivx + *ip * 24],19)) {
+
+/* Main note (upper) had a dot shift, must move it to chord */
+
+#line 5067 ""
+ setbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__26, &
+ c__1);
+#line 5068 ""
+ r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1)
+ * 24 - 25] * 10;
+#line 5068 ""
+ i__2 = i_nint(&r__1) + 64;
+#line 5068 ""
+ setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &
+ i__2);
+#line 5070 ""
+ r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1)
+ * 24 - 25] * 10;
+#line 5070 ""
+ i__2 = i_nint(&r__1) + 64;
+#line 5070 ""
+ 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 5075 ""
+ } else {
+#line 5076 ""
+ comtrill_1.icrdat[icrd - 1] = bit_clear(comtrill_1.icrdat[
+ icrd - 1],26);
+#line 5077 ""
+ }
+
+/* We are adding a main note dot shift, so push any later ones back */
+
+#line 5082 ""
+ if (! bit_test(irest[*ivx + *ip * 24],19)) {
+#line 5083 ""
+ ++comcc_1.maxdotmv[*ivx - 1];
+#line 5084 ""
+ i__2 = comcc_1.ndotmv[*ivx - 1] + 2;
+#line 5084 ""
+ for (indm = comcc_1.maxdotmv[*ivx - 1]; indm >= i__2;
+ --indm) {
+#line 5085 ""
+ comcc_1.updot[*ivx + indm * 24 - 25] = comcc_1.updot[*
+ ivx + (indm - 1) * 24 - 25];
+#line 5086 ""
+ comcc_1.rtdot[*ivx + indm * 24 - 25] = comcc_1.rtdot[*
+ ivx + (indm - 1) * 24 - 25];
+#line 5087 ""
+/* L1: */
+#line 5087 ""
+ }
+#line 5088 ""
+ }
+#line 5089 ""
+ irest[*ivx + *ip * 24] = bit_set(irest[*ivx + *ip * 24],19);
+#line 5090 ""
+ comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25]
+ = ((127 & icrdotsav) - 64) * .1f;
+#line 5091 ""
+ comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25]
+ = ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) - 64) *
+ .1f;
+#line 5093 ""
+ }
+#line 5094 ""
+ } else if (bit_test(*nacc,31) && nolev == *nolevm + 1) {
+
+/* Downstem, 2nd with lower as main, interchange pitches, */
+/* left-shift lower (now chord note). Lower (orig main, now chord) */
+/* probably had shifted dot, dot parameters must be moved from */
+/* main to chord */
+
+#line 5101 ""
+ nolev = *nolevm;
+#line 5102 ""
+ if (bit_test(irest[*ivx + *ip * 24],19)) {
+#line 5103 ""
+ icrdotsav = comtrill_1.icrdot[icrd - 1];
+#line 5104 ""
+ icrdatsav = comtrill_1.icrdat[icrd - 1];
+#line 5105 ""
+ 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 5110 ""
+ r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) *
+ 24 - 25] * 10;
+#line 5110 ""
+ i__2 = i_nint(&r__1) + 64;
+#line 5110 ""
+ setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &i__2);
+#line 5112 ""
+ r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) *
+ 24 - 25] * 10;
+#line 5112 ""
+ i__2 = i_nint(&r__1) + 64;
+#line 5112 ""
+ 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 5117 ""
+ if (bit_test(icrdatsav,26)) {
+#line 5118 ""
+ comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
+ - 25] = ((127 & icrdotsav) - 64) * .1f;
+#line 5119 ""
+ comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
+ - 25] = ((127 & lbit_shift(icrdotsav, (ftnlen)-7))
+ - 64) * .1f;
+#line 5121 ""
+ } else {
+
+/* No dot move on original chord (now main) note, */
+
+#line 5125 ""
+ comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
+ - 25] = 0.f;
+#line 5126 ""
+ comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
+ - 25] = 0.f;
+#line 5127 ""
+ }
+#line 5128 ""
}
+#line 5129 ""
}
/* Lower dot for lower-voice notes?. Conditions are: */
@@ -7337,180 +12391,282 @@ L10:
/* 4. Not a rest (cannot be a rest in a chord!) */
/* . 5. Flag (lowdot) is set to true */
+#line 5138 ""
if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) {
+#line 5139 ""
i__2 = log2_(nodu);
+#line 5139 ""
if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) {
+#line 5140 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
/* Note already in movdot list. Drop by 2. */
+#line 5144 ""
i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &
c__0) - 20;
+#line 5144 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &
i__2);
+#line 5146 ""
} else {
/* Not in list so just move it right now */
+#line 5150 ""
i__2 = igetbits_(islur, &c__1, &c__3);
- dotmov_(&c_b773, &c_b774, soutq, lsout, &i__2, (ftnlen)80)
- ;
+#line 5150 ""
+ dotmov_(&c_b1008, &c_b1009, soutq, lsout, &i__2, (ftnlen)
+ 80);
+#line 5151 ""
}
+#line 5152 ""
}
+#line 5153 ""
}
+#line 5154 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
-/* Move the dot. */
+/* Move the dot. Basic call for chord notes, not main note. */
+#line 5158 ""
updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f;
+#line 5159 ""
rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen)
-7)) - 64) * .1f;
+#line 5160 ""
i__2 = igetbits_(islur, &c__1, &c__3);
+#line 5160 ""
dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80);
+#line 5161 ""
}
+#line 5162 ""
isleft = bit_test(comtrill_1.icrdat[icrd - 1],23);
+#line 5163 ""
isright = bit_test(comtrill_1.icrdat[icrd - 1],24);
/* Check for ornament in chord. */
+#line 5167 ""
if (comtrill_1.icrdorn[icrd - 1] > 0) {
+#line 5168 ""
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);
-
-/* subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx, */
-/* * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt, */
-/* * notcrd,beamon,iscrd) */
-
+#line 5171 ""
addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80);
+#line 5172 ""
}
/* Chord-note symbol. First check for breve */
+#line 5176 ""
if (*nodu == 128) {
/* Writing concatenation */
+#line 5177 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5177 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5177 ""
i__3[1] = 6, a__1[1] = "zbreve";
+#line 5177 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5178 ""
lsym = 7;
+#line 5179 ""
} else {
/* Not a breve chord. Get first letters in chord-note symbol */
+#line 5183 ""
if (isleft) {
/* Writing concatenation */
+#line 5184 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5184 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5184 ""
i__3[1] = 1, a__1[1] = "l";
+#line 5184 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5185 ""
} else if (isright) {
/* Writing concatenation */
+#line 5186 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5186 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5186 ""
i__3[1] = 1, a__1[1] = "r";
+#line 5186 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5187 ""
} else {
/* Writing concatenation */
+#line 5188 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5188 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5188 ""
i__3[1] = 1, a__1[1] = "z";
+#line 5188 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5189 ""
}
+#line 5190 ""
if (*nodu >= 64) {
/* Writing concatenation */
+#line 5191 ""
i__3[0] = 2, a__1[0] = nosymq;
+#line 5191 ""
i__3[1] = 1, a__1[1] = "w";
+#line 5191 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5192 ""
} else if (*nodu >= 32) {
/* Writing concatenation */
+#line 5193 ""
i__3[0] = 2, a__1[0] = nosymq;
+#line 5193 ""
i__3[1] = 1, a__1[1] = "h";
+#line 5193 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5194 ""
} else {
/* Writing concatenation */
+#line 5195 ""
i__3[0] = 2, a__1[0] = nosymq;
+#line 5195 ""
i__3[1] = 1, a__1[1] = "q";
+#line 5195 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5196 ""
}
+#line 5197 ""
i__2 = log2_(nodu);
+#line 5197 ""
if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) {
+#line 5198 ""
lsym = 3;
+#line 5199 ""
} else if (! bit_test(*islur,3) || *dotxtup) {
/* Single dot */
/* Writing concatenation */
+#line 5203 ""
i__3[0] = 3, a__1[0] = nosymq;
+#line 5203 ""
i__3[1] = 1, a__1[1] = "p";
+#line 5203 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5204 ""
lsym = 4;
+#line 5205 ""
} else {
/* Double dot */
/* Writing concatenation */
+#line 5209 ""
i__3[0] = 3, a__1[0] = nosymq;
+#line 5209 ""
i__3[1] = 2, a__1[1] = "pp";
+#line 5209 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
+#line 5210 ""
lsym = 5;
+#line 5211 ""
}
+#line 5212 ""
}
+#line 5213 ""
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 5217 ""
nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
/* Kluge for bigness. Only means 'As' has not been issued */
+#line 5221 ""
if (spfacs_1.bacfac != 1e6f) {
+#line 5221 ""
nactmp += 8;
+#line 5221 ""
}
+#line 5222 ""
i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) -
107;
+#line 5222 ""
i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14);
+#line 5222 ""
i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12);
+#line 5222 ""
i__6 = ncmid_(iv, ip);
+#line 5222 ""
L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31);
+#line 5222 ""
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 5229 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5229 ""
i__3[1] = 7, a__1[1] = nosymq;
+#line 5229 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5230 ""
commidi_1.crdacc = TRUE_;
+#line 5231 ""
} else {
+#line 5232 ""
s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7);
+#line 5233 ""
}
+#line 5234 ""
lnote += lsym;
/* Get note name (again if accid, due to possible octave jump) */
+#line 5238 ""
notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8);
+#line 5239 ""
if (lnoten == 1) {
+#line 5239 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 5239 ""
}
/* Put in note name */
/* Writing concatenation */
+#line 5243 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5243 ""
i__3[1] = 8, a__1[1] = noteq;
+#line 5243 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5244 ""
lnote += lnoten;
+#line 5245 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],25)) {
/* Arpeggio signal */
+#line 5249 ""
putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80);
+#line 5250 ""
}
+#line 5251 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
+#line 5252 ""
if (commidi_1.ismidi) {
/* Here is where we collect MIDI pitch info for the chord note. By checking */
@@ -7518,37 +12674,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 5259 ""
kv = 1;
+#line 5260 ""
if (*ivx > *iv) {
+#line 5260 ""
kv = 2;
+#line 5260 ""
}
+#line 5261 ""
++commidi_1.nmidcrd;
+#line 5262 ""
if (commidi_1.nmidcrd > 20) {
- s_wsle(&io___349);
+#line 5263 ""
+ s_wsle(&io___378);
+#line 5263 ""
e_wsle();
- s_wsle(&io___350);
- do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"
+#line 5264 ""
+ s_wsle(&io___379);
+#line 5264 ""
+ do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"\
"ocessor", (ftnlen)45);
+#line 5264 ""
e_wsle();
+#line 5265 ""
stop1_();
+#line 5266 ""
}
/* Use original saved pitch level, unaltered by 2nds logic. */
-/* 130316 */
-/* call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), */
+#line 5270 ""
i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1]
- 1];
+#line 5270 ""
i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
+#line 5270 ""
addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, &
- commidisig_1.midisig, &c_b819, &c_false, &c_false);
-/* * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) */
-/* 130316 */
-/* * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., */
+ commidisig_1.midisig, &c_b1054, &c_false, &c_false);
+#line 5273 ""
}
+#line 5274 ""
/* L5: */
+#line 5274 ""
}
+#line 5275 ""
commidi_1.notmain = FALSE_;
+#line 5276 ""
return 0;
} /* docrd_ */
@@ -7580,7 +12752,7 @@ L10:
, integer *, ftnlen, ftnlen);
static integer jtxtdyn1;
extern integer igetbits_(integer *, integer *, integer *);
- static integer lpretweak, id;
+ static integer lpretweak, id, idh;
static real hoff;
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static integer idno, lbot, idyn, jdyn;
@@ -7603,131 +12775,216 @@ L10:
static integer numdyn;
static logical upstem;
static char notexq[79];
- static integer lnumpq, icntdyn, ivxtent;
+ static integer lnumpq, icntdyn;
+ extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
+ integer *);
+ static integer ivxtent;
static char dynstrq[4];
static integer jtxtdyn, ltxtdyn;
/* Fortran I/O blocks */
- static icilist io___371 = { 0, numpq+1, 0, "(i2)", 2, 1 };
- static icilist io___373 = { 0, numpq+1, 0, "(i2)", 2, 1 };
- static icilist io___374 = { 0, numpq+1, 0, "(i3)", 3, 1 };
- static icilist io___381 = { 0, numpq+1, 0, "(i2)", 2, 1 };
- static icilist io___382 = { 0, numpq+1, 0, "(i2)", 2, 1 };
- static icilist io___383 = { 0, numpq+1, 0, "(i3)", 3, 1 };
- static cilist io___386 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___401 = { 0, numpq+1, 0, "(i2)", 2, 1 };
+ static icilist io___403 = { 0, numpq+1, 0, "(i2)", 2, 1 };
+ static icilist io___404 = { 0, numpq+1, 0, "(i3)", 3, 1 };
+ static icilist io___411 = { 0, numpq+1, 0, "(i2)", 2, 1 };
+ static icilist io___412 = { 0, numpq+1, 0, "(i2)", 2, 1 };
+ static icilist io___413 = { 0, numpq+1, 0, "(i3)", 3, 1 };
+ static cilist io___416 = { 0, 11, 0, "(a)", 0 };
/* Inputs are array *elements* except ihornb,nornb,ulq */
+#line 5304 ""
/* Parameter adjustments */
+#line 5304 ""
ulq -= 25;
+#line 5304 ""
--nornb;
+#line 5304 ""
ihornb -= 25;
+#line 5304 ""
+#line 5304 ""
/* Function Body */
+#line 5305 ""
numdyn = 0;
/* Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values */
/* in idynn(1...4) */
+#line 5310 ""
i__1 = comdyn_1.ndyn;
+#line 5310 ""
for (idyn = 1; idyn <= i__1; ++idyn) {
-/* ivxtent = iand(idyndat(idyn),15) */
+#line 5311 ""
ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(&
comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4);
+#line 5313 ""
if (ivxtent == *ivx) {
+#line 5314 ""
iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4);
+#line 5315 ""
if (iptent == *ip) {
+#line 5316 ""
++numdyn;
+#line 5317 ""
idynn[numdyn - 1] = idyn;
+#line 5318 ""
} else if (iptent > *ip) {
/* I don't think there are any more possible for this ivx,ip, so exit loop */
+#line 5322 ""
goto L2;
+#line 5323 ""
}
-/* else if (ivxtent .gt. ivx) then */
-/* go to 2 */
+#line 5324 ""
}
+#line 5325 ""
/* L1: */
+#line 5325 ""
}
+#line 5326 ""
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 5331 ""
hoffsd = 0.f;
/* Set upstem to false as default */
+#line 5335 ""
upstem = FALSE_;
+#line 5336 ""
if (bit_test(*irest,0)) {
/* It's a rest. Assume it doesn't go below the staff */
+#line 5340 ""
lbot = *ncm - 4;
+#line 5341 ""
} else if (! (*beamon)) {
+#line 5342 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv);
+#line 5342 ""
if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) {
+#line 5343 ""
upstem = TRUE_;
+#line 5344 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
+#line 5345 ""
i__1 = *nolev - 1, i__2 = *ncm - 4;
+#line 5345 ""
lbot = min(i__1,i__2);
+#line 5346 ""
} else {
/* Computing MIN */
+#line 5347 ""
i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
+#line 5347 ""
lbot = min(i__1,i__2);
+#line 5348 ""
}
+#line 5349 ""
} else {
+#line 5350 ""
hoffsd = -.5f;
+#line 5351 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
+#line 5352 ""
i__1 = *nolev - 7, i__2 = *ncm - 4;
+#line 5352 ""
lbot = min(i__1,i__2);
+#line 5353 ""
} else {
/* Computing MIN */
+#line 5354 ""
i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4;
+#line 5354 ""
lbot = min(i__1,i__2);
+#line 5355 ""
}
+#line 5356 ""
}
+#line 5357 ""
} else {
+#line 5358 ""
if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
+#line 5359 ""
upstem = TRUE_;
+#line 5360 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
+#line 5361 ""
i__1 = *nolev - 1, i__2 = *ncm - 4;
+#line 5361 ""
lbot = min(i__1,i__2);
+#line 5362 ""
} else {
/* Computing MIN */
+#line 5363 ""
i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
+#line 5363 ""
lbot = min(i__1,i__2);
+#line 5364 ""
}
+#line 5365 ""
} else {
+#line 5366 ""
hoffsd = -.5f;
- lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1;
+
+/* 171230 Desperation */
+/* lbot = ihornb(ivx,nornb(ivx))+1 */
+#line 5370 ""
+ if (nornb[*ivx] == 0) {
+#line 5371 ""
+ lbot = 1;
+#line 5372 ""
+ } else {
+#line 5373 ""
+ lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1;
+#line 5374 ""
+ }
+#line 5375 ""
if (lbot == 1) {
/* Kluge for non-beamed, down xtup, for which ihorb was never set. */
/* Assumes stem is shortened. */
+#line 5380 ""
lbot = *nolev - 5;
+#line 5381 ""
}
+#line 5382 ""
++nornb[*ivx];
+#line 5383 ""
}
+#line 5384 ""
}
+#line 5385 ""
lbot += -5;
+#line 5386 ""
jtxtdyn1 = 1;
/* Now ready to loop over current dyn's */
+#line 5390 ""
i__1 = numdyn;
+#line 5390 ""
for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) {
+#line 5391 ""
idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1];
+#line 5392 ""
idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1];
+#line 5393 ""
idno = igetbits_(&idynd, &c__4, &c__12);
/* ivx = iand(15,idynd) */
+#line 5395 ""
*ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4);
/* Build the command into notex in stages. Insert name & rq'd args in order: */
@@ -7743,174 +13000,366 @@ L2:
/* d-mark */
/* X */
+#line 5410 ""
if (idno == 0) {
/* Text-dynamic */
/* Writing concatenation */
+#line 5414 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5414 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5414 ""
i__3[1] = 6, a__1[1] = "txtdyn";
+#line 5414 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5415 ""
lnote = 7;
+#line 5416 ""
} else if (idno <= 12) {
/* Letter-group */
/* Writing concatenation */
+#line 5420 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5420 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5420 ""
i__3[1] = 6, a__1[1] = "pmxdyn";
+#line 5420 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5421 ""
lnote = 7;
+#line 5422 ""
} else if (comslur_1.fontslur) {
+#line 5423 ""
lnote = 7;
+#line 5424 ""
if (idno == 13) {
-/* Start a hairpin */
+/* Start a font-based hairpin */
/* Writing concatenation */
+#line 5428 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5428 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5428 ""
i__3[1] = 6, a__1[1] = "hpstrt";
+#line 5428 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5429 ""
} else if (idno == 14) {
/* End crescendo */
/* Writing concatenation */
+#line 5433 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5433 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5433 ""
i__3[1] = 6, a__1[1] = "hpcend";
+#line 5433 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5434 ""
} else {
/* End decrescendo */
/* Writing concatenation */
+#line 5438 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5438 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5438 ""
i__3[1] = 6, a__1[1] = "hpdend";
+#line 5438 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5439 ""
}
+
+/* Put in voice number as ID for font-based hairpin */
+
+#line 5443 ""
+ if (*ivx <= 9) {
+/* Writing concatenation */
+#line 5444 ""
+ i__3[0] = lnote, a__1[0] = notexq;
+#line 5444 ""
+ *(unsigned char *)&ch__1[0] = *ivx + 48;
+#line 5444 ""
+ i__3[1] = 1, a__1[1] = ch__1;
+#line 5444 ""
+ s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5445 ""
+ ++lnote;
+#line 5446 ""
+ } else if (*ivx <= 19) {
+/* Writing concatenation */
+#line 5447 ""
+ i__4[0] = lnote, a__2[0] = notexq;
+#line 5447 ""
+ i__4[1] = 2, a__2[1] = "{1";
+#line 5447 ""
+ *(unsigned char *)&ch__1[0] = *ivx + 38;
+#line 5447 ""
+ i__4[2] = 1, a__2[2] = ch__1;
+#line 5447 ""
+ i__4[3] = 1, a__2[3] = "}";
+#line 5447 ""
+ s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 5448 ""
+ lnote += 4;
+#line 5449 ""
+ } else {
+/* Writing concatenation */
+#line 5450 ""
+ i__4[0] = lnote, a__2[0] = notexq;
+#line 5450 ""
+ i__4[1] = 2, a__2[1] = "{2";
+#line 5450 ""
+ *(unsigned char *)&ch__1[0] = *ivx + 28;
+#line 5450 ""
+ i__4[2] = 1, a__2[2] = ch__1;
+#line 5450 ""
+ i__4[3] = 1, a__2[3] = "}";
+#line 5450 ""
+ s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 5451 ""
+ lnote += 4;
+#line 5452 ""
+ }
+#line 5453 ""
} else {
/* Postscript hairpins */
+#line 5457 ""
lnote = 7;
+#line 5458 ""
if (idno == 13) {
/* Writing concatenation */
+#line 5459 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5459 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5459 ""
i__3[1] = 6, a__1[1] = "Icresc";
+#line 5459 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5460 ""
} else if (idno == 14) {
/* Writing concatenation */
+#line 5461 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5461 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5461 ""
i__3[1] = 8, a__1[1] = "Idecresc";
+#line 5461 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5462 ""
lnote = 9;
+#line 5463 ""
} else {
/* Writing concatenation */
+#line 5464 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5464 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 5464 ""
i__3[1] = 6, a__1[1] = "Tcresc";
+#line 5464 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5465 ""
}
- }
- if (idno >= 13) {
+#line 5466 ""
+ if (idno <= 14) {
-/* Put in voice number */
+/* Get and record ID no for start of ps hairpin */
+/* Find first unused ID */
- if (*ivx <= 9) {
+#line 5471 ""
+ for (idh = 1; idh <= 24; ++idh) {
+#line 5472 ""
+ if (! bit_test(comhair_1.ihairuse,idh)) {
+#line 5472 ""
+ goto L9;
+#line 5472 ""
+ }
+#line 5473 ""
+/* L8: */
+#line 5473 ""
+ }
+#line 5474 ""
+ printl_("Bad place in putdyn, call Dr. Don", (ftnlen)33);
+#line 5475 ""
+ stop1_();
+#line 5476 ""
+L9:
+#line 5477 ""
+ comhair_1.ihairuse = bit_set(comhair_1.ihairuse,idh);
+#line 5478 ""
+ comhair_1.idhair[*ivx - 1] = idh;
+#line 5479 ""
+ } else {
+
+/* Unrecord ID no for end of ps hairpin */
+
+#line 5483 ""
+ setbits_(&comhair_1.ihairuse, &c__1, &comhair_1.idhair[*ivx -
+ 1], &c__0);
+#line 5484 ""
+ }
+
+/* Write ID # for start or end of ps hairpin */
+
+#line 5488 ""
+ idh = comhair_1.idhair[*ivx - 1];
+#line 5489 ""
+ if (idh <= 9) {
/* Writing concatenation */
+#line 5490 ""
i__3[0] = lnote, a__1[0] = notexq;
- *(unsigned char *)&ch__1[0] = *ivx + 48;
+#line 5490 ""
+ *(unsigned char *)&ch__1[0] = idh + 48;
+#line 5490 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 5490 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5491 ""
++lnote;
- } else if (*ivx <= 19) {
+#line 5492 ""
+ } else if (idh <= 19) {
/* Writing concatenation */
+#line 5493 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 5493 ""
i__4[1] = 2, a__2[1] = "{1";
- *(unsigned char *)&ch__1[0] = *ivx + 38;
+#line 5493 ""
+ *(unsigned char *)&ch__1[0] = idh + 38;
+#line 5493 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 5493 ""
i__4[3] = 1, a__2[3] = "}";
+#line 5493 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 5494 ""
lnote += 4;
+#line 5495 ""
} else {
/* Writing concatenation */
+#line 5496 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 5496 ""
i__4[1] = 2, a__2[1] = "{2";
- *(unsigned char *)&ch__1[0] = *ivx + 28;
+#line 5496 ""
+ *(unsigned char *)&ch__1[0] = idh + 28;
+#line 5496 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 5496 ""
i__4[3] = 1, a__2[3] = "}";
+#line 5496 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 5497 ""
lnote += 4;
+#line 5498 ""
}
+#line 5499 ""
}
/* Begin setting level */
+#line 5503 ""
lbot1 = lbot;
+#line 5504 ""
if (idno > 0 && idno <= 5) {
/* All letters are short so raise a bit. */
+#line 5508 ""
++lbot1;
+#line 5509 ""
} else if (idno >= 13) {
+#line 5510 ""
lbot1 += 2;
+#line 5511 ""
}
/* Convert so reference is bottom line */
+#line 5515 ""
lbot1 = lbot1 - *ncm + 4;
+#line 5516 ""
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 5521 ""
comdyn_1.levdsav[*ivx - 1] = lbot1;
+#line 5522 ""
comdyn_1.levhssav[*ivx - 1] = 0;
+#line 5523 ""
if (bit_test(idynd,16)) {
+#line 5523 ""
comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17)
- 64;
+#line 5523 ""
}
+#line 5524 ""
} else if (comslur_1.fontslur && idno >= 14 || idno == 15) {
/* Hairpin end; Compare level with saved start level before user-tweaks */
/* Computing MIN */
+#line 5528 ""
i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1];
+#line 5528 ""
lbot1 = min(i__2,i__5);
/* Save pre-tweak level */
+#line 5532 ""
lpretweak = lbot1;
+#line 5533 ""
}
/* Check for user-defined vertical tweak */
+#line 5537 ""
if (bit_test(idynd,16)) {
+#line 5537 ""
lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17);
+#line 5537 ""
}
/* Now horizontal stuff */
+#line 5541 ""
hoff = hoffsd;
/* Some special horizontal tweaks */
+#line 5545 ""
if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) {
+#line 5545 ""
hoff += .4f;
+#line 5545 ""
}
/* User-defined tweaks */
+#line 5550 ""
if (bit_test(idynd2,0)) {
+#line 5550 ""
hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f;
+#line 5550 ""
}
+#line 5552 ""
if (numdyn > 1) {
/* Horizontal-interaction-based tweaks. */
@@ -7922,19 +13371,23 @@ L2:
/* 2 hrpnend hrpnstrt - hoh2h1(1...2) */
/* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */
+#line 5563 ""
if (idno > 0 && idno <= 12) {
/* Word-group, may need vertical tweak to line up. */
+#line 5567 ""
lbot1 += comdyn_1.ivowg[idno - 1];
/* Protecting against hp start-stop on same note */
+#line 5571 ""
} else if ((comslur_1.fontslur && idno >= 14 || idno == 15) &&
icntdyn < numdyn) {
/* Hairpin ending, check next type */
+#line 5576 ""
if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
icntdyn] - 1], &c__4, &c__12) == 13 || !
comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[
@@ -7944,22 +13397,28 @@ L2:
/* Hairpin end then hairpin start, no words, (remember dealing with end now) */
+#line 5586 ""
hoff += comdyn_1.hoh2h1[0];
+#line 5587 ""
} else {
/* Hairpin end then word-group, need idno for w-g to set hp offset */
+#line 5591 ""
hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[
icntdyn] - 1], &c__4, &c__12) - 1];
+#line 5593 ""
}
/* Protecting against hp start-stop on same note */
+#line 5597 ""
} else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno
< 14 || ! comslur_1.fontslur && idno < 15)) {
/* Hairpin start, check prior type */
+#line 5603 ""
if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
icntdyn - 2] - 1], &c__4, &c__12) >= 14 || !
comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[
@@ -7967,21 +13426,30 @@ L2:
/* Hairpin end then hairpin start, (remember dealing with start now) */
+#line 5612 ""
hoff += comdyn_1.hoh2h1[1];
+#line 5613 ""
} else {
/* Hairpin start after word-group, need idno for w-g to set hp offset */
+#line 5617 ""
hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[
icntdyn - 2] - 1], &c__4, &c__12) - 1];
+#line 5619 ""
}
+#line 5620 ""
}
+#line 5621 ""
}
/* End of if-block for 2- or 3-way interactions. */
+#line 5625 ""
if (! comslur_1.fontslur && idno >= 13) {
+#line 5625 ""
hoff = (hoff + .5f) * 6.f / 2.5f;
+#line 5625 ""
}
/* Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */
@@ -7989,128 +13457,217 @@ L2:
/* Position corrections all done now. Put in the level. */
+#line 5633 ""
if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno
== 13 || idno == 14)) {
/* Hairpin start. */
+#line 5638 ""
if (! comslur_1.fontslur) {
/* Postscript hairpin start...inset placeholder for start level. */
/* Writing concatenation */
+#line 5642 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5642 ""
i__3[1] = 5, a__1[1] = "{ }";
+#line 5642 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5643 ""
lnote += 5;
+#line 5644 ""
}
+#line 5645 ""
} else {
/* Insert actual level in all cases except hairpin start */
/* Create string with level in it */
+#line 5650 ""
if (lbot1 > 9) {
+#line 5651 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___371);
+#line 5652 ""
+ s_wsfi(&io___401);
+#line 5652 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5652 ""
e_wsfi();
/* Writing concatenation */
+#line 5653 ""
i__3[0] = 3, a__1[0] = numpq;
+#line 5653 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5653 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5654 ""
lnumpq = 4;
+#line 5655 ""
} else if (lbot1 > -1) {
+#line 5656 ""
*(unsigned char *)&ch__1[0] = lbot1 + 48;
+#line 5656 ""
s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
+#line 5657 ""
lnumpq = 1;
+#line 5658 ""
} else if (lbot1 > -10) {
+#line 5659 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___373);
+#line 5660 ""
+ s_wsfi(&io___403);
+#line 5660 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5660 ""
e_wsfi();
/* Writing concatenation */
+#line 5661 ""
i__3[0] = 3, a__1[0] = numpq;
+#line 5661 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5661 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5662 ""
lnumpq = 4;
+#line 5663 ""
} else {
+#line 5664 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___374);
+#line 5665 ""
+ s_wsfi(&io___404);
+#line 5665 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5665 ""
e_wsfi();
/* Writing concatenation */
+#line 5666 ""
i__3[0] = 4, a__1[0] = numpq;
+#line 5666 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5666 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5667 ""
lnumpq = 5;
+#line 5668 ""
}
/* Level has now been computed and stored in numpq */
/* Append the level */
/* Writing concatenation */
+#line 5673 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5673 ""
i__3[1] = lnumpq, a__1[1] = numpq;
+#line 5673 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5674 ""
lnote += lnumpq;
+#line 5675 ""
}
+#line 5676 ""
if (dabs(hoff) < .001f) {
/* No horiz offset */
/* Writing concatenation */
+#line 5680 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5680 ""
i__3[1] = 1, a__1[1] = "0";
+#line 5680 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5681 ""
++lnote;
+#line 5682 ""
} else {
/* Horizontal tweak */
+#line 5686 ""
lform = lfmt1_(&hoff);
/* Writing concatenation */
+#line 5687 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5687 ""
i__3[1] = 1, a__1[1] = "{";
+#line 5687 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5688 ""
++lnote;
+#line 5689 ""
i__2 = lnote;
+#line 5689 ""
ici__1.icierr = 0;
+#line 5689 ""
ici__1.icirnum = 1;
+#line 5689 ""
ici__1.icirlen = lnote + lform - i__2;
+#line 5689 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 5689 ""
i__6[0] = 2, a__3[0] = "(f";
+#line 5689 ""
i__5 = lform + 48;
+#line 5689 ""
chax_(ch__1, (ftnlen)1, &i__5);
+#line 5689 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 5689 ""
i__6[2] = 3, a__3[2] = ".1)";
+#line 5689 ""
ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6),
ch__2);
+#line 5689 ""
s_wsfi(&ici__1);
+#line 5689 ""
do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real));
+#line 5689 ""
e_wsfi();
+#line 5691 ""
lnote += lform;
/* Writing concatenation */
+#line 5692 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 5692 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5692 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 5693 ""
++lnote;
+#line 5694 ""
}
+#line 5695 ""
if (idno == 0) {
/* text-dynamic. Find the string and append it */
+#line 5699 ""
i__2 = comdyn_1.ntxtdyn;
+#line 5699 ""
for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) {
/* ivxip = ivx+16*ip */
+#line 5701 ""
ivxip = *ivx + (*ip << 5);
+#line 5702 ""
if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) {
+#line 5702 ""
goto L5;
+#line 5702 ""
}
+#line 5703 ""
/* L4: */
+#line 5703 ""
}
+#line 5704 ""
printl_("Abnormal stop in putdyn", (ftnlen)23);
+#line 5705 ""
stop1_();
+#line 5706 ""
L5:
+#line 5707 ""
ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128,
(ftnlen)128);
@@ -8136,149 +13693,264 @@ L5:
/* Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) */
+#line 5731 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
+#line 5732 ""
if (commus_1.musize == 20) {
+#line 5733 ""
s_copy(notexq, "{\\medtype\\it ", (ftnlen)79, (ftnlen)13);
+#line 5734 ""
lnote = 13;
+#line 5735 ""
} else if (commus_1.musize == 16) {
+#line 5736 ""
s_copy(notexq, "{\\normtype\\it ", (ftnlen)79, (ftnlen)14);
+#line 5737 ""
lnote = 14;
+#line 5738 ""
} else if (commus_1.musize == 24) {
+#line 5739 ""
s_copy(notexq, "{\\bigtype\\it ", (ftnlen)79, (ftnlen)13);
+#line 5740 ""
lnote = 13;
+#line 5741 ""
} else if (commus_1.musize == 29) {
+#line 5742 ""
s_copy(notexq, "{\\Bigtype\\it ", (ftnlen)79, (ftnlen)13);
+#line 5743 ""
lnote = 13;
+#line 5744 ""
}
/* Writing concatenation */
+#line 5746 ""
i__6[0] = lnote, a__3[0] = notexq;
+#line 5746 ""
i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7)
;
+#line 5746 ""
i__6[2] = 1, a__3[2] = "}";
+#line 5746 ""
s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
+#line 5747 ""
lnote = lnote + ltxtdyn + 1;
/* Reset jtxtdyn1 just in case >1 txtdyn on same note. */
+#line 5751 ""
jtxtdyn1 = jtxtdyn + 1;
+#line 5752 ""
} else if (idno <= 12) {
/* Letter-group dynamic. Append the letter-group command */
+#line 5756 ""
id = idno << 2;
+#line 5757 ""
i__2 = id - 4;
+#line 5757 ""
s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2);
+#line 5758 ""
id = lenstr_(dynstrq, &c__4, (ftnlen)4);
/* Writing concatenation */
+#line 5759 ""
i__6[0] = lnote, a__3[0] = notexq;
+#line 5759 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5759 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 5759 ""
i__6[2] = id, a__3[2] = dynstrq;
+#line 5759 ""
s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
+#line 5760 ""
lnote = lnote + 1 + id;
+#line 5761 ""
}
+#line 5762 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
+#line 5763 ""
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 5768 ""
lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1];
+#line 5769 ""
if (lbot1 > 9) {
+#line 5770 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___381);
+#line 5771 ""
+ s_wsfi(&io___411);
+#line 5771 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5771 ""
e_wsfi();
/* Writing concatenation */
+#line 5772 ""
i__3[0] = 3, a__1[0] = numpq;
+#line 5772 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5772 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5773 ""
lnumpq = 4;
+#line 5774 ""
} else if (lbot1 > -1) {
+#line 5775 ""
*(unsigned char *)&ch__1[0] = lbot1 + 48;
+#line 5775 ""
s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
+#line 5776 ""
lnumpq = 1;
+#line 5777 ""
} else if (lbot1 > -10) {
+#line 5778 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___382);
+#line 5779 ""
+ s_wsfi(&io___412);
+#line 5779 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5779 ""
e_wsfi();
/* Writing concatenation */
+#line 5780 ""
i__3[0] = 3, a__1[0] = numpq;
+#line 5780 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5780 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5781 ""
lnumpq = 4;
+#line 5782 ""
} else {
+#line 5783 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
- s_wsfi(&io___383);
+#line 5784 ""
+ s_wsfi(&io___413);
+#line 5784 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
+#line 5784 ""
e_wsfi();
/* Writing concatenation */
+#line 5785 ""
i__3[0] = 4, a__1[0] = numpq;
+#line 5785 ""
i__3[1] = 1, a__1[1] = "}";
+#line 5785 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
+#line 5786 ""
lnumpq = 5;
+#line 5787 ""
}
/* Construct string to search backwards for placeholder */
- if (*ivx <= 9) {
+#line 5791 ""
+ if (idh <= 9) {
/* Writing concatenation */
+#line 5792 ""
i__6[0] = 5, a__3[0] = "cresc";
- *(unsigned char *)&ch__1[0] = *ivx + 48;
+#line 5792 ""
+ *(unsigned char *)&ch__1[0] = idh + 48;
+#line 5792 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 5792 ""
i__6[2] = 5, a__3[2] = "{ }";
+#line 5792 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
+#line 5793 ""
ltemp = 11;
- } else if (*ivx <= 19) {
+#line 5794 ""
+ } else if (idh <= 19) {
/* Writing concatenation */
+#line 5795 ""
i__6[0] = 7, a__3[0] = "cresc{1";
- *(unsigned char *)&ch__1[0] = *ivx + 38;
+#line 5795 ""
+ *(unsigned char *)&ch__1[0] = idh + 38;
+#line 5795 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 5795 ""
i__6[2] = 6, a__3[2] = "}{ }";
+#line 5795 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
+#line 5796 ""
ltemp = 14;
+#line 5797 ""
} else {
/* Writing concatenation */
+#line 5798 ""
i__6[0] = 7, a__3[0] = "cresc{2";
- *(unsigned char *)&ch__1[0] = *ivx + 28;
+#line 5798 ""
+ *(unsigned char *)&ch__1[0] = idh + 28;
+#line 5798 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 5798 ""
i__6[2] = 6, a__3[2] = "}{ }";
+#line 5798 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
+#line 5799 ""
ltemp = 14;
+#line 5800 ""
}
- s_wsfe(&io___386);
+#line 5801 ""
+ s_wsfe(&io___416);
/* Writing concatenation */
+#line 5801 ""
i__3[0] = *lsout, a__1[0] = soutq;
+#line 5801 ""
i__3[1] = 1, a__1[1] = "%";
+#line 5801 ""
s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81);
+#line 5801 ""
do_fio(&c__1, ch__3, *lsout + 1);
+#line 5801 ""
e_wsfe();
+#line 5802 ""
*lsout = 0;
/* Writing concatenation */
+#line 5803 ""
i__3[0] = ltemp - 5, a__1[0] = tempq;
+#line 5803 ""
i__3[1] = lnumpq, a__1[1] = numpq;
+#line 5803 ""
s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53);
+#line 5803 ""
i__2 = ltemp - 5 + lnumpq;
+#line 5803 ""
backfill_(&c__11, tempq, &ltemp, ch__4, &i__2, (ftnlen)48, ltemp
- 5 + lnumpq);
+#line 5805 ""
}
+#line 5806 ""
/* L3: */
+#line 5806 ""
}
/* Shrink arrays, decrease ndyn 111109 */
+#line 5810 ""
for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) {
+#line 5811 ""
i__1 = comdyn_1.ndyn - 1;
+#line 5811 ""
for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) {
+#line 5812 ""
comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn];
+#line 5813 ""
comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn];
+#line 5814 ""
/* L7: */
+#line 5814 ""
}
+#line 5815 ""
--comdyn_1.ndyn;
+#line 5816 ""
/* L6: */
+#line 5816 ""
}
+#line 5817 ""
return 0;
} /* dodyn_ */
@@ -8345,15 +14017,15 @@ L5:
static real wheadpt1;
/* Fortran I/O blocks */
- static cilist io___392 = { 0, 6, 0, 0, 0 };
- static cilist io___396 = { 0, 6, 0, 0, 0 };
- static cilist io___397 = { 0, 6, 0, 0, 0 };
- static cilist io___398 = { 0, 15, 0, "(/,a)", 0 };
- static icilist io___401 = { 0, notexq, 0, "(i2)", 2, 1 };
- static cilist io___402 = { 0, 6, 0, 0, 0 };
- static icilist io___426 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 };
- static icilist io___428 = { 0, notexq+13, 0, "(f4.1)", 4, 1 };
- static icilist io___430 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
+ static cilist io___422 = { 0, 6, 0, 0, 0 };
+ static cilist io___426 = { 0, 6, 0, 0, 0 };
+ static cilist io___427 = { 0, 6, 0, 0, 0 };
+ static cilist io___428 = { 0, 15, 0, "(/,a)", 0 };
+ static icilist io___431 = { 0, notexq, 0, "(i2)", 2, 1 };
+ static cilist io___432 = { 0, 6, 0, 0, 0 };
+ static icilist io___456 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 };
+ static icilist io___458 = { 0, notexq+13, 0, "(f4.1)", 4, 1 };
+ static icilist io___460 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
@@ -8361,836 +14033,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 5856 ""
/* Parameter adjustments */
+#line 5856 ""
ulq -= 25;
+#line 5856 ""
--ptgr;
+#line 5856 ""
+#line 5856 ""
/* Function Body */
+#line 5856 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 5856 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 5857 ""
isgaft = bit_test(*ipl,29);
+#line 5858 ""
iswaft = bit_test(*ipl,31);
+#line 5859 ""
normsp = ! isgaft;
/* Find ig. */
+#line 5863 ""
i__1 = comgrace_1.ngrace;
+#line 5863 ""
for (*ig = 1; *ig <= i__1; ++(*ig)) {
+#line 5864 ""
if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx)
{
+#line 5864 ""
goto L121;
+#line 5864 ""
}
+#line 5865 ""
/* L120: */
+#line 5865 ""
}
- s_wsle(&io___392);
+#line 5866 ""
+ s_wsle(&io___422);
+#line 5866 ""
do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38)
;
+#line 5866 ""
e_wsle();
+#line 5867 ""
s_stop("", (ftnlen)0);
+#line 5868 ""
L121:
+#line 5869 ""
ngs = comgrace_1.ngstrt[*ig - 1];
+#line 5870 ""
mg = comgrace_1.multg[*ig - 1];
/* wheadpt1 = wheadpt*fullsize(ivx) */
+#line 5872 ""
wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1];
/* For way-after-graces at end of bar, must set the octave. */
+#line 5876 ""
if (*farend) {
+#line 5877 ""
comoct_1.noctup = 0;
+#line 5878 ""
if (*ncm == 23) {
+#line 5878 ""
comoct_1.noctup = -2;
+#line 5878 ""
}
+#line 5879 ""
}
+#line 5880 ""
if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) {
+#line 5881 ""
if (comslur_1.listslur == 16777215) {
- s_wsle(&io___396);
+#line 5882 ""
+ s_wsle(&io___426);
+#line 5882 ""
e_wsle();
- s_wsle(&io___397);
- do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "
+#line 5883 ""
+ s_wsle(&io___427);
+#line 5883 ""
+ do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "\
"many!", (ftnlen)47);
+#line 5883 ""
e_wsle();
- s_wsfe(&io___398);
+#line 5884 ""
+ s_wsfe(&io___428);
+#line 5884 ""
do_fio(&c__1, "You defined the twentyfifth slur, one too many!", (
ftnlen)47);
+#line 5884 ""
e_wsfe();
+#line 5886 ""
stop1_();
+#line 5887 ""
}
/* Slur on fore-grace. Get index of next slur not in use, from 23 down. */
+#line 5891 ""
i__1 = 16777215 - comslur_1.listslur;
+#line 5891 ""
comslur_1.ndxslur = log2_(&i__1);
+#line 5893 ""
}
+#line 5894 ""
if (comgrace_1.nng[*ig - 1] == 1) {
/* Single grace. */
+#line 5898 ""
if (normsp) {
/* Anything but GA */
/* Writing concatenation */
+#line 5902 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5902 ""
i__2[1] = 5, a__1[1] = "shlft";
+#line 5902 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
+#line 5902 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
+#line 5903 ""
niptgr = i_nint(&ptgr[*ig]);
/* Empirical tweak for postscript. */
/* if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */
/* ++ */
+#line 5909 ""
if (niptgr < 10) {
/* Writing concatenation */
+#line 5910 ""
i__1 = niptgr + 48;
+#line 5910 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 5910 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 5910 ""
i__2[1] = 1, a__1[1] = "{";
+#line 5910 ""
s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2);
+#line 5910 ""
addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
+#line 5911 ""
} else if (niptgr < 100) {
- s_wsfi(&io___401);
+#line 5912 ""
+ s_wsfi(&io___431);
+#line 5912 ""
do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer));
+#line 5912 ""
e_wsfi();
/* Writing concatenation */
+#line 5913 ""
i__3[0] = 1, a__2[0] = "{";
+#line 5913 ""
i__3[1] = 2, a__2[1] = notexq;
+#line 5913 ""
i__3[2] = 2, a__2[2] = "}{";
+#line 5913 ""
s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5);
+#line 5913 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
+#line 5914 ""
} else {
- s_wsle(&io___402);
- do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "
+#line 5915 ""
+ s_wsle(&io___432);
+#line 5915 ""
+ do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "\
"note group > 99 pt", (ftnlen)56);
+#line 5915 ""
e_wsle();
+#line 5917 ""
s_stop("", (ftnlen)0);
+#line 5918 ""
}
+#line 5919 ""
} else {
/* Writing concatenation */
+#line 5920 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5920 ""
i__2[1] = 10, a__1[1] = "gaft{1.5}{";
+#line 5920 ""
s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
+#line 5920 ""
addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
/* GA. Compute aftshft, for later use. */
+#line 5924 ""
comgrace_1.aftshft = spfacs_1.grafac;
+#line 5925 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
+#line 5925 ""
comgrace_1.aftshft += spfacs_1.agc1fac;
+#line 5925 ""
}
+#line 5926 ""
comgrace_1.aftshft *= comask_1.wheadpt;
+#line 5927 ""
}
+#line 5928 ""
if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
/* Start slur on pre-grace. No accounting needed since will be ended very soon. */
+#line 5932 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
+#line 5933 ""
if (comslur_1.fontslur) {
+#line 5934 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 5935 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5935 ""
i__2[1] = 6, a__1[1] = "islurd";
+#line 5935 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
+#line 5935 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
+#line 5936 ""
} else {
/* Writing concatenation */
+#line 5937 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5937 ""
i__2[1] = 6, a__1[1] = "isluru";
+#line 5937 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
+#line 5937 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
+#line 5938 ""
}
+#line 5939 ""
} else {
/* Start Postscript slur. */
+#line 5943 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 5944 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5944 ""
i__2[1] = 3, a__1[1] = "isd";
+#line 5944 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
+#line 5944 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
+#line 5945 ""
} else {
/* Writing concatenation */
+#line 5946 ""
i__2[0] = 1, a__1[0] = sq;
+#line 5946 ""
i__2[1] = 3, a__1[1] = "isu";
+#line 5946 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
+#line 5946 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
+#line 5947 ""
}
+#line 5948 ""
}
/* Print slur number, 23-ndxslur */
+#line 5952 ""
lnote = 0;
+#line 5953 ""
if (23 - comslur_1.ndxslur < 10) {
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
+#line 5955 ""
i__1 = 71 - comslur_1.ndxslur;
+#line 5955 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 5955 ""
s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
+#line 5956 ""
lnote = 1;
+#line 5957 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
+#line 5959 ""
i__3[0] = 2, a__2[0] = "{1";
+#line 5959 ""
i__1 = 61 - comslur_1.ndxslur;
+#line 5959 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 5959 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 5959 ""
i__3[2] = 1, a__2[2] = "}";
+#line 5959 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 5960 ""
lnote = 4;
+#line 5961 ""
} else {
/* Writing concatenation */
+#line 5962 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 5962 ""
i__4[1] = 2, a__3[1] = "{2";
+#line 5962 ""
i__1 = 51 - comslur_1.ndxslur;
+#line 5962 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 5962 ""
i__4[2] = 1, a__3[2] = ch__1;
+#line 5962 ""
i__4[3] = 1, a__3[3] = "}";
+#line 5962 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 5963 ""
lnote = 4;
+#line 5964 ""
}
-/* if (11-ndxslur .lt. 10) then */
-/* call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten, */
-/* * soutq,lsout) */
-/* else */
-/* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */
-/* * 4+lnoten,soutq,lsout) */
-/* end if */
/* Writing concatenation */
+#line 5965 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 5965 ""
i__2[1] = lnoten, a__1[1] = noteq;
+#line 5965 ""
s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
+#line 5965 ""
i__1 = lnote + lnoten;
+#line 5965 ""
addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80);
+#line 5967 ""
if (! comslur_1.fontslur) {
/* Horizontal tweaks for postscript slur on single grace */
+#line 5971 ""
stemup = TRUE_;
+#line 5972 ""
if (comgrace_1.upg[*ig - 1]) {
/* Check for up-grace + down stem. Get stem direction */
+#line 5976 ""
if (! (*beamon)) {
/* Separate note. Get stem direction. */
+#line 5980 ""
udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx,
ivx, nv);
+#line 5980 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
+#line 5982 ""
} else {
/* In a beam */
+#line 5986 ""
stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24]
== 'u';
+#line 5987 ""
}
/* Stop the shift if whole note */
+#line 5991 ""
stemup = stemup || *tnote > 63.f;
+#line 5992 ""
}
+#line 5993 ""
if (stemup) {
+#line 5994 ""
addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
80);
+#line 5995 ""
} else {
+#line 5996 ""
addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
80);
+#line 5997 ""
}
+#line 5998 ""
}
+#line 5999 ""
}
+#line 6000 ""
if (comgrace_1.naccg[ngs - 1] > 0) {
+#line 6001 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Save for checking octave shifts in GA */
+#line 6005 ""
if (isgaft) {
+#line 6006 ""
lnotenga = lnoten;
+#line 6007 ""
s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
+#line 6008 ""
}
+#line 6010 ""
if (lnoten == 1) {
+#line 6010 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 6010 ""
}
+#line 6011 ""
accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
+#line 6012 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6012 ""
i__4[1] = 3, a__3[1] = "big";
+#line 6012 ""
i__4[2] = lacc, a__3[2] = acsymq;
+#line 6012 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6012 ""
s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
+#line 6012 ""
i__1 = lacc + 4 + lnoten;
+#line 6012 ""
addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80)
;
+#line 6014 ""
}
+#line 6015 ""
if (comgrace_1.slashg[*ig - 1]) {
/* Writing concatenation */
+#line 6016 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6016 ""
i__2[1] = 3, a__1[1] = "grc";
+#line 6016 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6017 ""
lnote = 4;
+#line 6018 ""
} else if (mg == 0) {
/* Writing concatenation */
+#line 6019 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6019 ""
i__2[1] = 2, a__1[1] = "zq";
+#line 6019 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6020 ""
lnote = 3;
+#line 6021 ""
} else {
/* Writing concatenation */
+#line 6022 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6022 ""
i__2[1] = 2, a__1[1] = "zc";
+#line 6022 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6023 ""
i__1 = mg;
+#line 6023 ""
for (i__ = 2; i__ <= i__1; ++i__) {
/* Writing concatenation */
+#line 6024 ""
i__2[0] = i__ + 1, a__1[0] = notexq;
+#line 6024 ""
i__2[1] = 1, a__1[1] = "c";
+#line 6024 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6025 ""
/* L61: */
+#line 6025 ""
}
+#line 6026 ""
lnote = mg + 2;
+#line 6027 ""
}
+#line 6028 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 6029 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 6029 ""
i__2[1] = 1, a__1[1] = "u";
+#line 6029 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6030 ""
} else {
/* Writing concatenation */
+#line 6031 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 6031 ""
i__2[1] = 1, a__1[1] = "l";
+#line 6031 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6032 ""
}
+#line 6033 ""
i__1 = lnote + 1;
+#line 6033 ""
addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80);
+#line 6034 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
+#line 6036 ""
if (isgaft && comgrace_1.naccg[ngs - 1] == 0) {
+#line 6037 ""
lnotenga = lnoten;
+#line 6038 ""
s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
+#line 6039 ""
}
+#line 6041 ""
if (lnoten == 1) {
+#line 6041 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 6041 ""
}
+#line 6042 ""
addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80);
+#line 6043 ""
if (comgrace_1.slashg[*ig - 1]) {
/* Writing concatenation */
+#line 6043 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6043 ""
i__4[1] = 5, a__3[1] = "off{-";
+#line 6043 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6043 ""
i__4[3] = 9, a__3[3] = "noteskip}";
+#line 6043 ""
s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16);
+#line 6043 ""
addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80);
+#line 6043 ""
}
/* Above code needed since slashg causes spacing */
+#line 6048 ""
if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) {
/* Terminate slur on single after-grace */
-/* ndxslur = igetbits(ipl,4,23) */
+#line 6052 ""
comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
+#line 6053 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
+#line 6054 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6054 ""
i__2[1] = 5, a__1[1] = "tslur";
+#line 6054 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
+#line 6054 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
-/* c Print 11-ndxslur */
/* Print 24-ndxslur */
/* if (11-ndxslur .lt. 10) then */
+#line 6059 ""
if (23 - comslur_1.ndxslur < 10) {
/* call addstr(chax(59-ndxslur)//noteq(1:lnoten), */
/* Writing concatenation */
+#line 6061 ""
i__1 = 71 - comslur_1.ndxslur;
+#line 6061 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6061 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 6061 ""
i__2[1] = lnoten, a__1[1] = noteq;
+#line 6061 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
+#line 6061 ""
i__5 = lnoten + 1;
+#line 6061 ""
addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
+#line 6063 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
+#line 6064 ""
i__4[0] = 2, a__3[0] = "{2";
+#line 6064 ""
i__1 = 61 - comslur_1.ndxslur;
+#line 6064 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6064 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6064 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6064 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6064 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6064 ""
i__5 = lnoten + 4;
+#line 6064 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
+#line 6066 ""
} else {
/* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */
/* Writing concatenation */
+#line 6068 ""
i__4[0] = 2, a__3[0] = "{1";
+#line 6068 ""
i__1 = 51 - comslur_1.ndxslur;
+#line 6068 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6068 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6068 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6068 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6068 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6068 ""
i__5 = lnoten + 4;
+#line 6068 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
+#line 6070 ""
}
+#line 6071 ""
comgrace_1.slurg[*ig - 1] = FALSE_;
+#line 6072 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
+#line 6073 ""
}
+#line 6074 ""
addstr_("}", &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
/* +++ Try to fix loss of octave with single gaft */
-/* if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}', */
-/* * 13+lnoten,soutq,lsout) */
+#line 6078 ""
if (isgaft) {
+#line 6079 ""
itrans = 0;
+#line 6080 ""
i__1 = lnotenga;
+#line 6080 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 6081 ""
chax_(ch__1, (ftnlen)1, &c__39);
+#line 6081 ""
if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned char *)&
ch__1[0]) {
+#line 6082 ""
itrans += 7;
+#line 6083 ""
} else /* if(complicated condition) */ {
+#line 6083 ""
chax_(ch__1, (ftnlen)1, &c__96);
+#line 6083 ""
if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned
char *)&ch__1[0]) {
+#line 6084 ""
itrans += -7;
+#line 6085 ""
}
+#line 6085 ""
}
+#line 6086 ""
/* L1: */
+#line 6086 ""
}
+#line 6087 ""
if (itrans == -14) {
/* Writing concatenation */
+#line 6088 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6088 ""
i__4[1] = 7, a__3[1] = "advance";
+#line 6088 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6088 ""
i__4[3] = 12, a__3[3] = "transpose-14";
+#line 6088 ""
s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21);
+#line 6088 ""
addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
+#line 6090 ""
} else if (itrans == -7) {
/* Writing concatenation */
+#line 6091 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6091 ""
i__4[1] = 7, a__3[1] = "advance";
+#line 6091 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6091 ""
i__4[3] = 11, a__3[3] = "transpose-7";
+#line 6091 ""
s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
+#line 6091 ""
addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
+#line 6093 ""
} else if (itrans == 7) {
/* Writing concatenation */
+#line 6094 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6094 ""
i__4[1] = 7, a__3[1] = "advance";
+#line 6094 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6094 ""
i__4[3] = 10, a__3[3] = "transpose7";
+#line 6094 ""
s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19);
+#line 6094 ""
addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80);
+#line 6096 ""
} else if (itrans == 14) {
/* Writing concatenation */
+#line 6097 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6097 ""
i__4[1] = 7, a__3[1] = "advance";
+#line 6097 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6097 ""
i__4[3] = 11, a__3[3] = "transpose14";
+#line 6097 ""
s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
+#line 6097 ""
addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
+#line 6099 ""
}
+#line 6100 ""
}
+#line 6101 ""
} else {
/* Multiple grace. Put in literally. Compute beam stuff */
+#line 6105 ""
sumx = 0.f;
+#line 6106 ""
sumy = 0.f;
+#line 6107 ""
sumxy = 0.f;
+#line 6108 ""
sumxx = 0.f;
+#line 6109 ""
sumyy = 0.f;
+#line 6110 ""
x = 0.f;
+#line 6111 ""
i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
+#line 6111 ""
for (ing = ngs; ing <= i__1; ++ing) {
+#line 6112 ""
if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) {
+#line 6112 ""
x += spfacs_1.acgfac;
+#line 6112 ""
}
+#line 6113 ""
y = (real) comgrace_1.nolevg[ing - 1];
+#line 6114 ""
sumx += x;
+#line 6115 ""
sumy += y;
+#line 6116 ""
sumxy += x * y;
+#line 6117 ""
sumxx += x * x;
+#line 6118 ""
sumyy += y * y;
+#line 6119 ""
x += spfacs_1.emgfac;
+#line 6120 ""
/* L118: */
+#line 6120 ""
}
+#line 6121 ""
delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx;
+#line 6122 ""
em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta;
+#line 6123 ""
r__1 = em * .5f * spfacs_1.gslfac;
+#line 6123 ""
islope = i_nint(&r__1);
+#line 6124 ""
if (abs(islope) > 9) {
+#line 6124 ""
islope = i_sign(&c__9, &islope);
+#line 6124 ""
}
+#line 6125 ""
beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig
- 1];
+#line 6126 ""
nolev1 = i_nint(&beta);
/* Back up */
/* Writing concatenation */
+#line 6130 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6130 ""
i__4[1] = 7, a__3[1] = "settiny";
+#line 6130 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6130 ""
i__4[3] = 4, a__3[3] = "off{";
+#line 6130 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 6131 ""
if (normsp) {
- s_wsfi(&io___426);
+#line 6132 ""
+ s_wsfi(&io___456);
+#line 6132 ""
do_fio(&c__1, "-", (ftnlen)1);
+#line 6132 ""
do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real));
+#line 6132 ""
e_wsfi();
/* Writing concatenation */
+#line 6133 ""
i__2[0] = 18, a__1[0] = notexq;
+#line 6133 ""
i__2[1] = 3, a__1[1] = "pt}";
+#line 6133 ""
s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21);
+#line 6133 ""
addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
+#line 6134 ""
finalshift = ptgr[*ig];
+#line 6135 ""
} else {
+#line 6136 ""
comgrace_1.aftshft = comask_1.wheadpt * 1.33f;
+#line 6137 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
+#line 6137 ""
comgrace_1.aftshft += comask_1.wheadpt * .5f;
+#line 6137 ""
}
- s_wsfi(&io___428);
+#line 6138 ""
+ s_wsfi(&io___458);
+#line 6138 ""
do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real));
+#line 6138 ""
e_wsfi();
/* Writing concatenation */
+#line 6139 ""
i__4[0] = 17, a__3[0] = notexq;
+#line 6139 ""
i__4[1] = 3, a__3[1] = "pt}";
+#line 6139 ""
i__4[2] = 1, a__3[2] = sq;
+#line 6139 ""
i__4[3] = 3, a__3[3] = "bsk";
+#line 6139 ""
s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24);
+#line 6139 ""
addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80);
+#line 6140 ""
}
/* Start the beam */
/* Writing concatenation */
+#line 6144 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6144 ""
i__2[1] = 2, a__1[1] = "ib";
+#line 6144 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6145 ""
i__1 = mg;
+#line 6145 ""
for (ing = 2; ing <= i__1; ++ing) {
/* Writing concatenation */
+#line 6146 ""
i__2[0] = ing + 1, a__1[0] = notexq;
+#line 6146 ""
i__2[1] = 1, a__1[1] = "b";
+#line 6146 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6147 ""
/* L119: */
+#line 6147 ""
}
+#line 6148 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 6149 ""
i__2[0] = mg + 2, a__1[0] = notexq;
+#line 6149 ""
i__2[1] = 1, a__1[1] = "u";
+#line 6149 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6150 ""
} else {
/* Writing concatenation */
+#line 6151 ""
i__2[0] = mg + 2, a__1[0] = notexq;
+#line 6151 ""
i__2[1] = 1, a__1[1] = "l";
+#line 6151 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6152 ""
}
/* Writing concatenation */
+#line 6153 ""
i__2[0] = mg + 3, a__1[0] = notexq;
+#line 6153 ""
i__2[1] = 1, a__1[1] = "0";
+#line 6153 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
/* Get starting note for beam */
+#line 6157 ""
notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8);
/* Writing concatenation */
+#line 6158 ""
i__2[0] = mg + 4, a__1[0] = notexq;
+#line 6158 ""
i__2[1] = lnoten, a__1[1] = noteq;
+#line 6158 ""
s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
+#line 6158 ""
i__1 = mg + 4 + lnoten;
+#line 6158 ""
addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80);
/* Put in the slope */
+#line 6163 ""
if (islope >= 0) {
+#line 6164 ""
i__1 = islope + 48;
+#line 6164 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6164 ""
addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
+#line 6165 ""
} else {
/* Writing concatenation */
+#line 6166 ""
i__3[0] = 2, a__2[0] = "{-";
+#line 6166 ""
i__1 = 48 - islope;
+#line 6166 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6166 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 6166 ""
i__3[2] = 1, a__2[2] = "}";
+#line 6166 ""
s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4);
+#line 6166 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80);
+#line 6167 ""
}
/* Start a slur on multiple fore-grace */
+#line 6171 ""
if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
+#line 6172 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
+#line 6173 ""
if (comslur_1.fontslur) {
+#line 6174 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 6175 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6175 ""
i__2[1] = 6, a__1[1] = "islurd";
+#line 6175 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
+#line 6175 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
+#line 6176 ""
} else {
/* Writing concatenation */
+#line 6177 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6177 ""
i__2[1] = 6, a__1[1] = "isluru";
+#line 6177 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
+#line 6177 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
+#line 6178 ""
}
+#line 6179 ""
} else {
/* Need a tweak for postscript slur */
+#line 6183 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 6184 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6184 ""
i__2[1] = 3, a__1[1] = "isd";
+#line 6184 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
+#line 6184 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
+#line 6185 ""
} else {
/* Writing concatenation */
+#line 6186 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6186 ""
i__2[1] = 3, a__1[1] = "isu";
+#line 6186 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
+#line 6186 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
+#line 6187 ""
}
+#line 6188 ""
}
-/* Print 11-ndxslur */
+/* Print 23-ndxslur */
+#line 6192 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
+#line 6193 ""
i__1 = 71 - comslur_1.ndxslur;
+#line 6193 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6193 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 6193 ""
i__2[1] = lnoten, a__1[1] = noteq;
+#line 6193 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
+#line 6193 ""
i__5 = lnoten + 1;
+#line 6193 ""
addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
+#line 6195 ""
} else if (23 - comslur_1.ndxslur < 2) {
/* Writing concatenation */
+#line 6196 ""
i__4[0] = 2, a__3[0] = "{1";
+#line 6196 ""
i__1 = 61 - comslur_1.ndxslur;
+#line 6196 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6196 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6196 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6196 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6196 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6196 ""
i__5 = lnoten + 4;
+#line 6196 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
+#line 6198 ""
} else {
/* Writing concatenation */
+#line 6199 ""
i__4[0] = 2, a__3[0] = "{1";
+#line 6199 ""
i__1 = 51 - comslur_1.ndxslur;
+#line 6199 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 6199 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6199 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6199 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6199 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6199 ""
i__5 = lnoten + 4;
+#line 6199 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
+#line 6201 ""
}
/* Put in tweak for postscript slur */
+#line 6205 ""
if (! comslur_1.fontslur) {
+#line 6205 ""
addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
+#line 6205 ""
}
+#line 6206 ""
}
/* Put in first note. Call notefq again in case octave changed */
+#line 6210 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
+#line 6211 ""
if (comgrace_1.naccg[ngs - 1] == 0) {
/* Writing concatenation */
+#line 6212 ""
i__3[0] = 1, a__2[0] = sq;
+#line 6212 ""
i__3[1] = 4, a__2[1] = "zqb0";
+#line 6212 ""
i__3[2] = lnoten, a__2[2] = noteq;
+#line 6212 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 6213 ""
lnote = lnoten + 5;
+#line 6214 ""
} else {
+#line 6215 ""
if (lnoten == 1) {
+#line 6215 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 6215 ""
}
+#line 6216 ""
accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
+#line 6217 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6217 ""
i__4[1] = 3, a__3[1] = "big";
+#line 6217 ""
i__4[2] = lacc, a__3[2] = acsymq;
+#line 6217 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6217 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 6218 ""
lnote = lacc + 4 + lnoten;
+#line 6219 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
+#line 6220 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 6220 ""
i__4[1] = 1, a__3[1] = sq;
+#line 6220 ""
i__4[2] = 4, a__3[2] = "zqb0";
+#line 6220 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6220 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 6221 ""
lnote = lnote + 5 + lnoten;
+#line 6222 ""
}
+#line 6223 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
+#line 6224 ""
i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
+#line 6224 ""
for (ing = ngs + 1; ing <= i__1; ++ing) {
/* Skip */
+#line 6228 ""
ptoff = wheadpt1 * spfacs_1.emgfac;
+#line 6229 ""
if (comgrace_1.naccg[ing - 1] > 0) {
+#line 6229 ""
ptoff += wheadpt1 * spfacs_1.acgfac;
+#line 6229 ""
}
+#line 6230 ""
if (isgaft && ! iswaft) {
+#line 6230 ""
comgrace_1.aftshft += ptoff;
+#line 6230 ""
}
/* Writing concatenation */
+#line 6231 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6231 ""
i__2[1] = 4, a__1[1] = "off{";
+#line 6231 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
- s_wsfi(&io___430);
+#line 6232 ""
+ s_wsfi(&io___460);
+#line 6232 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
+#line 6232 ""
e_wsfi();
+#line 6233 ""
if (normsp) {
+#line 6233 ""
finalshift -= ptoff;
+#line 6233 ""
}
/* Writing concatenation */
+#line 6234 ""
i__2[0] = 8, a__1[0] = notexq;
+#line 6234 ""
i__2[1] = 3, a__1[1] = "pt}";
+#line 6234 ""
s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
+#line 6234 ""
addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
+#line 6235 ""
if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) {
/* Terminate beam if needed */
+#line 6239 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
+#line 6240 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6240 ""
i__2[1] = 4, a__1[1] = "tbu0";
+#line 6240 ""
s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
+#line 6240 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
;
+#line 6241 ""
} else {
/* Writing concatenation */
+#line 6242 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6242 ""
i__2[1] = 4, a__1[1] = "tbl0";
+#line 6242 ""
s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
+#line 6242 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
;
+#line 6243 ""
}
/* Terminate after slur if needed */
+#line 6247 ""
if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) {
/* if (iswaft) ndxslur = igetbits(ipl,4,23) */
+#line 6249 ""
if (iswaft) {
+#line 6249 ""
comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
+#line 6249 ""
}
+#line 6250 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm,
(ftnlen)8);
/* Writing concatenation */
+#line 6251 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6251 ""
i__2[1] = 5, a__1[1] = "tslur";
+#line 6251 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
+#line 6251 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80)
;
/* Print 11-ndxslur */
/* c Print 23-ndxslur */
+#line 6256 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
+#line 6257 ""
i__5 = 71 - comslur_1.ndxslur;
+#line 6257 ""
chax_(ch__1, (ftnlen)1, &i__5);
+#line 6257 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 6257 ""
i__2[1] = lnoten, a__1[1] = noteq;
+#line 6257 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
+#line 6257 ""
i__6 = lnoten + 1;
+#line 6257 ""
addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, (
ftnlen)80);
+#line 6259 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
+#line 6260 ""
i__4[0] = 2, a__3[0] = "{2";
+#line 6260 ""
i__5 = 61 - comslur_1.ndxslur;
+#line 6260 ""
chax_(ch__1, (ftnlen)1, &i__5);
+#line 6260 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6260 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6260 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6260 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6260 ""
i__6 = lnoten + 4;
+#line 6260 ""
addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
ftnlen)80);
+#line 6262 ""
} else {
/* Writing concatenation */
+#line 6263 ""
i__4[0] = 2, a__3[0] = "{1";
+#line 6263 ""
i__5 = 51 - comslur_1.ndxslur;
+#line 6263 ""
chax_(ch__1, (ftnlen)1, &i__5);
+#line 6263 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 6263 ""
i__4[2] = 1, a__3[2] = "}";
+#line 6263 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6263 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
+#line 6263 ""
i__6 = lnoten + 4;
+#line 6263 ""
addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
ftnlen)80);
+#line 6265 ""
}
/* Stop slur terminator after exit from this subroutine */
+#line 6269 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
+#line 6270 ""
comgrace_1.slurg[*ig - 1] = FALSE_;
+#line 6271 ""
}
+#line 6272 ""
}
/* Accidental if needed */
+#line 6276 ""
if (comgrace_1.naccg[ing - 1] > 0) {
+#line 6277 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (
ftnlen)8);
+#line 6278 ""
if (lnoten == 1) {
+#line 6278 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 6278 ""
}
+#line 6279 ""
accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
+#line 6280 ""
i__4[0] = 1, a__3[0] = sq;
+#line 6280 ""
i__4[1] = 3, a__3[1] = "big";
+#line 6280 ""
i__4[2] = lacc, a__3[2] = acsymq;
+#line 6280 ""
i__4[3] = lnoten, a__3[3] = noteq;
+#line 6280 ""
s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
+#line 6280 ""
i__5 = lacc + 4 + lnoten;
+#line 6280 ""
addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, (
ftnlen)80);
+#line 6282 ""
}
/* Put in the (beamed) grace note */
+#line 6286 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
+#line 6287 ""
i__3[0] = 1, a__2[0] = sq;
+#line 6287 ""
i__3[1] = 4, a__2[1] = "zqb0";
+#line 6287 ""
i__3[2] = lnoten, a__2[2] = noteq;
+#line 6287 ""
s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13);
+#line 6287 ""
i__5 = lnoten + 5;
+#line 6287 ""
addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80);
+#line 6289 ""
/* L127: */
+#line 6289 ""
}
/* Terminate the grace */
@@ -9200,78 +15462,147 @@ L121:
/* notexq = '}'//sq//'off{' */
/* lnote = 6 */
/* Writing concatenation */
+#line 6297 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6297 ""
i__2[1] = 4, a__1[1] = "off{";
+#line 6297 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6298 ""
lnote = 5;
+#line 6299 ""
ptoff = comask_1.wheadpt * spfacs_1.emgfac;
+#line 6300 ""
if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) {
+#line 6300 ""
ptoff += comask_1.wheadpt * spfacs_1.accfac;
+#line 6300 ""
}
+#line 6302 ""
if (isgaft && ! iswaft) {
/* Writing concatenation */
+#line 6303 ""
i__2[0] = 5, a__1[0] = notexq;
+#line 6303 ""
i__2[1] = 1, a__1[1] = "-";
+#line 6303 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 6304 ""
lnote = 6;
+#line 6305 ""
ptoff = comgrace_1.aftshft;
+#line 6306 ""
}
+#line 6307 ""
if (normsp) {
+#line 6307 ""
ptoff = finalshift;
+#line 6307 ""
}
+#line 6308 ""
if (ptoff < 9.95f) {
+#line 6309 ""
i__1 = lnote;
+#line 6309 ""
ici__1.icierr = 0;
+#line 6309 ""
ici__1.icirnum = 1;
+#line 6309 ""
ici__1.icirlen = lnote + 3 - i__1;
+#line 6309 ""
ici__1.iciunit = notexq + i__1;
+#line 6309 ""
ici__1.icifmt = "(f3.1)";
+#line 6309 ""
s_wsfi(&ici__1);
+#line 6309 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
+#line 6309 ""
e_wsfi();
+#line 6310 ""
lnote += 3;
+#line 6311 ""
} else if (ptoff < 99.95f) {
+#line 6312 ""
i__1 = lnote;
+#line 6312 ""
ici__1.icierr = 0;
+#line 6312 ""
ici__1.icirnum = 1;
+#line 6312 ""
ici__1.icirlen = lnote + 4 - i__1;
+#line 6312 ""
ici__1.iciunit = notexq + i__1;
+#line 6312 ""
ici__1.icifmt = "(f4.1)";
+#line 6312 ""
s_wsfi(&ici__1);
+#line 6312 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
+#line 6312 ""
e_wsfi();
+#line 6313 ""
lnote += 4;
+#line 6314 ""
} else {
+#line 6315 ""
i__1 = lnote;
+#line 6315 ""
ici__1.icierr = 0;
+#line 6315 ""
ici__1.icirnum = 1;
+#line 6315 ""
ici__1.icirlen = lnote + 5 - i__1;
+#line 6315 ""
ici__1.iciunit = notexq + i__1;
+#line 6315 ""
ici__1.icifmt = "(f5.1)";
+#line 6315 ""
s_wsfi(&ici__1);
+#line 6315 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
+#line 6315 ""
e_wsfi();
+#line 6316 ""
lnote += 5;
+#line 6317 ""
}
/* Writing concatenation */
+#line 6318 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 6318 ""
i__2[1] = 3, a__1[1] = "pt}";
+#line 6318 ""
s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82);
+#line 6318 ""
i__1 = lnote + 3;
+#line 6318 ""
addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80);
+#line 6319 ""
if (isgaft && ! iswaft) {
/* Writing concatenation */
+#line 6319 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6319 ""
i__2[1] = 2, a__1[1] = "sk";
+#line 6319 ""
s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3);
+#line 6319 ""
addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80);
+#line 6319 ""
}
/* Writing concatenation */
+#line 6320 ""
i__2[0] = 1, a__1[0] = sq;
+#line 6320 ""
i__2[1] = 9, a__1[1] = "resetsize";
+#line 6320 ""
s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10);
+#line 6320 ""
addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80);
+#line 6321 ""
}
+#line 6322 ""
return 0;
} /* dograce_ */
@@ -9329,10 +15660,10 @@ L121:
static char slurudq[1];
/* Fortran I/O blocks */
- static cilist io___444 = { 0, 6, 0, 0, 0 };
- static cilist io___445 = { 0, 6, 0, 0, 0 };
- static cilist io___446 = { 0, 15, 0, "(/,a)", 0 };
- static cilist io___454 = { 0, 6, 0, 0, 0 };
+ static cilist io___474 = { 0, 6, 0, 0, 0 };
+ static cilist io___475 = { 0, 6, 0, 0, 0 };
+ static cilist io___476 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___484 = { 0, 6, 0, 0, 0 };
@@ -9354,6 +15685,7 @@ L121:
/* 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. */
/* 18 int(ndxslur/16), ditto. So this allows ndxslur>15. */
/* 2 stem slur flag */
+/* 1 flag for "x" slur (voice-independent) */
/* Bits in isdat2 */
/* 0 Chord switch. Not set on main note. */
@@ -9392,300 +15724,492 @@ L121:
/* If highest note has upslur, save slur height in islhgt in case */
/* ornament must be moved. */
+#line 6419 ""
/* Parameter adjustments */
+#line 6419 ""
--isdat4;
+#line 6419 ""
--isdat3;
+#line 6419 ""
--isdat2;
+#line 6419 ""
--isdat1;
+#line 6419 ""
+#line 6419 ""
/* Function Body */
+#line 6419 ""
*islhgt = 0;
+#line 6420 ""
if (*beamon) {
+#line 6421 ""
stemup = *(unsigned char *)ulq == 'u';
+#line 6422 ""
} else if (commvl_1.nvmx[*iv - 1] == 2) {
+#line 6423 ""
if (! bit_test(*islur,30)) {
/* Single note, 2 lines of music, stem direction not forced */
+#line 6427 ""
stemup = commvl_1.ivx > *nv;
+#line 6428 ""
} else {
+#line 6429 ""
stemup = bit_test(*islur,17);
+#line 6430 ""
}
+#line 6431 ""
} else {
+#line 6432 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
commvl_1.ivx, nv);
+#line 6432 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
+#line 6433 ""
}
+#line 6434 ""
iscrd = bit_test(*ipl,10);
+#line 6435 ""
if (commidi_1.ismidi) {
+#line 6436 ""
settie = FALSE_;
+#line 6437 ""
comslm_1.dbltie = FALSE_;
+#line 6438 ""
}
+#line 6439 ""
i__1 = *nsdat;
+#line 6439 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
+#line 6440 ""
isdata = isdat1[isdat];
+#line 6441 ""
if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(&
- isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, &
- c__12) + 1) {
+ isdata, &c__8, &c__3) && (*kv == igetbits_(&isdata, &c__1, &
+ c__12) + 1 || bit_test(isdata,1))) {
+/* * kv .eq. igetbits(isdata,1,12)+1) then */
/* Since iv and kv match, ivx will be correct */
+#line 6449 ""
idcode = igetbits_(&isdata, &c__7, &c__19);
+#line 6450 ""
ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
+#line 6451 ""
ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
+#line 6452 ""
iupdn = 0;
+#line 6453 ""
*(unsigned char *)slurudq = 'd';
+#line 6454 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
+#line 6455 ""
pstie = bit_test(isdat2[isdat],3) || idcode == 1;
+#line 6456 ""
if (bit_test(isdata,11)) {
/* Turnon */
/* Get slur direction */
+#line 6461 ""
if (bit_test(isdata,26)) {
/* Force slur direction */
+#line 6465 ""
if (bit_test(isdata,27)) {
+#line 6465 ""
*(unsigned char *)slurudq = 'u';
+#line 6465 ""
}
+#line 6466 ""
} else if (commvl_1.nvmx[*iv - 1] == 1) {
/* Only one voice per line */
+#line 6470 ""
if (! (*beamon)) {
/* Separate note. */
+#line 6474 ""
udfq_(ch__1, (ftnlen)1, nolev, ncm);
+#line 6474 ""
*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
0];
+#line 6475 ""
} else {
/* In a beam */
+#line 6479 ""
if (*(unsigned char *)ulq != 'u') {
+#line 6479 ""
*(unsigned char *)slurudq = 'u';
+#line 6479 ""
}
+#line 6480 ""
}
+#line 6481 ""
if (iscrd) {
+#line 6482 ""
if (nolevs > *ncm) {
+#line 6483 ""
*(unsigned char *)slurudq = 'u';
+#line 6484 ""
} else {
+#line 6485 ""
*(unsigned char *)slurudq = 'd';
+#line 6486 ""
}
+#line 6487 ""
}
+#line 6488 ""
} else {
/* Two voices per line. Get default */
+#line 6492 ""
if (commvl_1.ivx > *nv) {
+#line 6492 ""
*(unsigned char *)slurudq = 'u';
+#line 6492 ""
}
/* Upper voice of the two, so up slur */
+#line 6496 ""
}
+#line 6497 ""
if (bit_test(isdata,2)) {
/* ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. */
+#line 6501 ""
if (stemup) {
+#line 6502 ""
*(unsigned char *)slurudq = 'u';
+#line 6503 ""
ivoff += 4;
+#line 6504 ""
} else {
+#line 6505 ""
*(unsigned char *)slurudq = 'd';
+#line 6506 ""
ivoff += -4;
+#line 6507 ""
}
+#line 6508 ""
}
/* Set level for slur starting on rest */
+#line 6512 ""
if (nolevs == 0 || nolevs > 60) {
+#line 6513 ""
if (*(unsigned char *)slurudq == 'u') {
+#line 6514 ""
nolevs = *ncm + 2;
+#line 6515 ""
} else {
+#line 6516 ""
nolevs = *ncm - 2;
+#line 6517 ""
}
+#line 6518 ""
}
/* Save up/down-ness for use at termination */
+#line 6522 ""
if (*(unsigned char *)slurudq == 'u') {
+#line 6522 ""
isdata = bit_set(isdata,27);
+#line 6522 ""
}
/* End of section for setting slur direction, still in "Turnon" if-block. */
+#line 6526 ""
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 6530 ""
ivoffinc = 0;
+#line 6531 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
/* Must move the slur for _ or . */
+#line 6536 ""
if (stemup) {
+#line 6537 ""
ivoffinc = -1;
+#line 6538 ""
} else {
+#line 6539 ""
ivoffinc = 1;
+#line 6540 ""
}
+#line 6541 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
+#line 6541 ""
ivoffinc <<= 1;
+#line 6541 ""
}
+#line 6544 ""
ivoff += ivoffinc;
+#line 6545 ""
}
+#line 6546 ""
}
+#line 6547 ""
if (comslur_1.listslur == 16777215) {
- s_wsle(&io___444);
+#line 6548 ""
+ s_wsle(&io___474);
+#line 6548 ""
e_wsle();
- s_wsle(&io___445);
- do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"
+#line 6549 ""
+ s_wsle(&io___475);
+#line 6549 ""
+ do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"\
" one too many!", (ftnlen)48);
+#line 6549 ""
e_wsle();
- s_wsfe(&io___446);
- do_fio(&c__1, "You defined the twentyfifth slur, one too"
+#line 6550 ""
+ s_wsfe(&io___476);
+#line 6550 ""
+ do_fio(&c__1, "You defined the twentyfifth slur, one too"\
" many!", (ftnlen)47);
+#line 6550 ""
e_wsfe();
+#line 6552 ""
stop1_();
+#line 6553 ""
}
/* Get index of next slur not in use, starting from 12 down */
+#line 6557 ""
i__2 = 16777215 - comslur_1.listslur;
+#line 6557 ""
comslur_1.ndxslur = log2_(&i__2);
-/* write(*,'()') */
-/* write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur */
/* Record slur index */
+#line 6561 ""
comslur_1.listslur = bit_set(comslur_1.listslur,
comslur_1.ndxslur);
-/* write(*,'(10x,B24)')listslur */
/* Save for use on termination */
/* call setbits(isdata,4,28,ndxslur) */
/* 080531 Allow >16 slurs */
+#line 6567 ""
i__2 = comslur_1.ndxslur % 16;
+#line 6567 ""
setbits_(&isdata, &c__4, &c__28, &i__2);
+#line 6568 ""
i__2 = comslur_1.ndxslur / 16;
+#line 6568 ""
setbits_(&isdata, &c__1, &c__18, &i__2);
/* Shift for stem? */
+#line 6572 ""
if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
{
+#line 6573 ""
if (! pstie) {
+#line 6574 ""
ihoff += 8;
+#line 6575 ""
} else {
+#line 6576 ""
ihoff += 2;
+#line 6577 ""
}
+#line 6578 ""
}
+#line 6579 ""
if (iscrd) {
/* Additional horiz shifts for h-shifted noteheads? */
+#line 6583 ""
if (bit_test(isdat2[isdat],1)) {
/* Slur start on left-shifted chord notehead. ASSUME downstem. */
+#line 6587 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
+#line 6588 ""
ihoff += -2;
+#line 6589 ""
} else {
+#line 6590 ""
ihoff += -10;
+#line 6591 ""
}
+#line 6592 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
+#line 6596 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
+#line 6597 ""
ihoff += 2;
+#line 6598 ""
} else {
+#line 6599 ""
ihoff += 10;
+#line 6600 ""
}
+#line 6601 ""
}
+#line 6602 ""
}
+#line 6603 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6603 ""
s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
+#line 6604 ""
lnote = 1;
/* Check for local adjustment default changes */
+#line 6608 ""
if (bit_test(isdat2[isdat],26)) {
/* Writing concatenation */
+#line 6609 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6609 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6609 ""
i__3[1] = 10, a__1[1] = "sluradjust";
+#line 6609 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 6609 ""
i__3[2] = 1, a__1[2] = ch__2;
+#line 6609 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6610 ""
lnote = 12;
+#line 6611 ""
} else if (bit_test(isdat2[isdat],27)) {
/* Writing concatenation */
+#line 6612 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6612 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6612 ""
i__3[1] = 12, a__1[1] = "nosluradjust";
+#line 6612 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 6612 ""
i__3[2] = 1, a__1[2] = ch__2;
+#line 6612 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6613 ""
lnote = 14;
+#line 6614 ""
} else if (bit_test(isdat2[isdat],28)) {
/* Writing concatenation */
+#line 6615 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6615 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6615 ""
i__3[1] = 9, a__1[1] = "tieadjust";
+#line 6615 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 6615 ""
i__3[2] = 1, a__1[2] = ch__2;
+#line 6615 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6616 ""
lnote = 11;
+#line 6617 ""
} else if (bit_test(isdat2[isdat],29)) {
/* Writing concatenation */
+#line 6618 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6618 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6618 ""
i__3[1] = 11, a__1[1] = "notieadjust";
+#line 6618 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 6618 ""
i__3[2] = 1, a__1[2] = ch__2;
+#line 6618 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6619 ""
lnote = 13;
+#line 6620 ""
}
+#line 6621 ""
if (ihoff == 0) {
/* Write stuff for non-shifted start */
/* Writing concatenation */
+#line 6625 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 6625 ""
i__3[1] = 5, a__1[1] = "islur";
+#line 6625 ""
i__3[2] = 1, a__1[2] = slurudq;
+#line 6625 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6626 ""
lnote += 6;
+#line 6627 ""
} else {
/* Writing concatenation */
+#line 6628 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 6628 ""
i__3[1] = 2, a__1[1] = "is";
+#line 6628 ""
i__3[2] = 1, a__1[2] = slurudq;
+#line 6628 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6629 ""
lnote += 3;
+#line 6630 ""
}
/* Prepend postscript tie switch */
+#line 6634 ""
if (pstie) {
/* Writing concatenation */
+#line 6635 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6635 ""
i__4[0] = 1, a__2[0] = ch__1;
+#line 6635 ""
i__4[1] = 8, a__2[1] = "tieforis";
+#line 6635 ""
i__4[2] = 1, a__2[2] = slurudq;
+#line 6635 ""
i__4[3] = lnote, a__2[3] = notexq;
+#line 6635 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 6636 ""
lnote += 10;
+#line 6637 ""
}
+#line 6638 ""
if (bit_test(isdat2[isdat],4)) {
/* Dotted slur */
@@ -9693,183 +16217,289 @@ L121:
/* noteq = notexq */
/* notexq = chax(92)//'dotted'//noteq */
/* Writing concatenation */
+#line 6644 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6644 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6644 ""
i__3[1] = 6, a__1[1] = "dotted";
+#line 6644 ""
i__3[2] = lnote, a__1[2] = notexq;
+#line 6644 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6645 ""
lnote += 7;
+#line 6646 ""
}
/* Add slur index to string */
-/* c Print 11-ndxslur */
/* Print 23-ndxslur */
-/* if (11-ndxslur .lt. 10) then */
+#line 6651 ""
if (23 - comslur_1.ndxslur < 10) {
/* 5/25/08 Allow 24 slurs */
-/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
/* Writing concatenation */
+#line 6655 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6655 ""
i__2 = 71 - comslur_1.ndxslur;
+#line 6655 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6655 ""
i__5[1] = 1, a__3[1] = ch__1;
+#line 6655 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6656 ""
++lnote;
+#line 6657 ""
} else if (23 - comslur_1.ndxslur < 20) {
-/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
+#line 6658 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 6658 ""
i__4[1] = 2, a__2[1] = "{1";
+#line 6658 ""
i__2 = 61 - comslur_1.ndxslur;
+#line 6658 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6658 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 6658 ""
i__4[3] = 1, a__2[3] = "}";
+#line 6658 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 6659 ""
lnote += 4;
+#line 6660 ""
} else {
/* Writing concatenation */
+#line 6661 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 6661 ""
i__4[1] = 2, a__2[1] = "{2";
+#line 6661 ""
i__2 = 51 - comslur_1.ndxslur;
+#line 6661 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6661 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 6661 ""
i__4[3] = 1, a__2[3] = "}";
+#line 6661 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 6662 ""
lnote += 4;
+#line 6663 ""
}
/* Add note name to string */
-/* call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) */
+#line 6667 ""
*islhgt = nolevs + iupdn + ivoff;
+#line 6668 ""
notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8);
/* Writing concatenation */
+#line 6669 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6669 ""
i__5[1] = lnoten, a__3[1] = noteq;
+#line 6669 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6670 ""
lnote += lnoten;
/* Store height and staff mid level for use with LineBreakTies */
+#line 6674 ""
setbits_(&isdat3[isdat], &c__8, &c__14, islhgt);
+#line 6675 ""
setbits_(&isdat3[isdat], &c__8, &c__22, ncm);
/* Save height (for ornament and barnobox interference) if topmost slur is up */
+#line 6679 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
+#line 6681 ""
*islhgt = nolevs + iupdn + ivoff;
/* Save height & idcode if top voice and slur start */
+#line 6685 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
+#line 6686 ""
comsln_1.is1n1 = *islhgt;
+#line 6687 ""
comsln_1.is2n1 = idcode;
+#line 6688 ""
}
+#line 6689 ""
}
+#line 6690 ""
if ((real) ihoff != 0.f) {
+#line 6691 ""
shift = ihoff * .1f;
/* Writing concatenation */
+#line 6692 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6692 ""
i__5[1] = 1, a__3[1] = "{";
+#line 6692 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6693 ""
++lnote;
+#line 6694 ""
lform = lfmt1_(&shift);
+#line 6695 ""
i__2 = lnote;
+#line 6695 ""
ici__1.icierr = 0;
+#line 6695 ""
ici__1.icirnum = 1;
+#line 6695 ""
ici__1.icirlen = lnote + lform - i__2;
+#line 6695 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 6695 ""
i__3[0] = 2, a__1[0] = "(f";
+#line 6695 ""
i__6 = lform + 48;
+#line 6695 ""
chax_(ch__1, (ftnlen)1, &i__6);
+#line 6695 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 6695 ""
i__3[2] = 3, a__1[2] = ".1)";
+#line 6695 ""
ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
6), ch__3);
+#line 6695 ""
s_wsfi(&ici__1);
+#line 6695 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
+#line 6695 ""
e_wsfi();
+#line 6697 ""
lnote += lform;
/* Writing concatenation */
+#line 6698 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6698 ""
i__5[1] = 1, a__3[1] = "}";
+#line 6698 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6699 ""
++lnote;
+#line 6700 ""
}
+#line 6701 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Zero out ip1 to avoid problems if slur goes to next input blk. */
+#line 6705 ""
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 6709 ""
if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
/* levson(midchan(iv,kv)) = nolevs */
/* 130316 */
/* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */
+#line 6713 ""
comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1];
+#line 6714 ""
if (settie) {
+#line 6714 ""
comslm_1.dbltie = TRUE_;
+#line 6714 ""
}
/* 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 6719 ""
}
+#line 6720 ""
} else {
/* Slur is ending. Back thru list to find starting slur */
+#line 6724 ""
for (j = isdat - 1; j >= 1; --j) {
- if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv ==
- igetbits_(&isdat1[j], &c__1, &c__12) + 1) {
+#line 6725 ""
+ 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 6729 ""
if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
+#line 6730 ""
comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
c__28) + (igetbits_(&isdat1[j], &c__1, &
c__18) << 4);
/* 080531 Allow >16 slurs */
+#line 6735 ""
if (bit_test(isdat1[j],27)) {
+#line 6735 ""
*(unsigned char *)slurudq = 'u';
+#line 6735 ""
}
+#line 6736 ""
goto L4;
+#line 6737 ""
}
+#line 6738 ""
}
+#line 6739 ""
/* L3: */
+#line 6739 ""
}
- s_wsle(&io___454);
+#line 6740 ""
+ s_wsle(&io___484);
+#line 6740 ""
do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
+#line 6740 ""
e_wsle();
+#line 6741 ""
stop1_();
+#line 6742 ""
L4:
/* Bugfix 070901 for slur ending on rest in 2-voice staff */
-/* if (nolevs.eq.0 .or. nolevs.gt.60) then */
+#line 6746 ""
if (nolevs <= 2 || nolevs > 60) {
/* Ending is on a rest, reset nolevs to default starting height */
+#line 6750 ""
nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
+#line 6751 ""
}
+#line 6752 ""
if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) {
/* Deal with \curve or \midslur. isdat is ending, j is start. */
+#line 6756 ""
if (bit_test(isdat3[isdat],0)) {
+#line 6757 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
+#line 6758 ""
} else {
+#line 6759 ""
imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32;
+#line 6760 ""
}
/* Postscript slurs, and \midslur adjustment is needed. Invoke macro */
@@ -9882,227 +16512,384 @@ L4:
/* 6+ HH */
/* Writing concatenation */
+#line 6771 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6771 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6771 ""
i__3[1] = 7, a__1[1] = "psforts";
/* Computing MIN */
+#line 6771 ""
i__6 = abs(imid);
+#line 6771 ""
i__2 = min(i__6,6) + 48;
+#line 6771 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 6771 ""
i__3[2] = 1, a__1[2] = ch__2;
+#line 6771 ""
s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9);
+#line 6771 ""
addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80)
;
+#line 6773 ""
}
+#line 6774 ""
if (bit_test(isdata,2)) {
/* ADjust for stem slur. */
+#line 6778 ""
if (stemup) {
+#line 6779 ""
*(unsigned char *)slurudq = 'u';
+#line 6780 ""
ivoff += 4;
+#line 6781 ""
} else {
+#line 6782 ""
*(unsigned char *)slurudq = 'd';
+#line 6783 ""
ivoff += -4;
+#line 6784 ""
}
+#line 6785 ""
}
/* Shift slur ending for stem on any note? */
+#line 6789 ""
if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
63.f) {
+#line 6790 ""
if (! pstie) {
+#line 6791 ""
ihoff += -8;
+#line 6792 ""
} else {
+#line 6793 ""
ihoff += -3;
+#line 6794 ""
}
+#line 6795 ""
}
+#line 6796 ""
if (iscrd) {
/* Shift termination for shifted notehead? */
+#line 6800 ""
if (bit_test(isdat2[isdat],1)) {
/* Left-shifted chord notehead. ASSUME downstem. */
+#line 6804 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
+#line 6805 ""
ihoff += -2;
+#line 6806 ""
} else {
+#line 6807 ""
ihoff += -10;
+#line 6808 ""
}
+#line 6809 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
+#line 6813 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
+#line 6814 ""
ihoff += 2;
+#line 6815 ""
} else {
+#line 6816 ""
ihoff += 10;
+#line 6817 ""
}
+#line 6818 ""
}
+#line 6819 ""
}
+#line 6820 ""
if (ihoff == 0) {
/* Writing concatenation */
+#line 6821 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6821 ""
i__5[0] = 1, a__3[0] = ch__1;
+#line 6821 ""
i__5[1] = 5, a__3[1] = "tslur";
+#line 6821 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6822 ""
lnote = 6;
+#line 6823 ""
} else {
/* Shift needed */
/* Writing concatenation */
+#line 6827 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6827 ""
i__5[0] = 1, a__3[0] = ch__1;
+#line 6827 ""
i__5[1] = 2, a__3[1] = "ts";
+#line 6827 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6828 ""
lnote = 3;
+#line 6829 ""
}
/* Switch to postscript tie */
+#line 6833 ""
if (pstie) {
/* Writing concatenation */
+#line 6834 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 6834 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 6834 ""
i__3[1] = 8, a__1[1] = "tieforts";
+#line 6834 ""
i__3[2] = lnote, a__1[2] = notexq;
+#line 6834 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 6835 ""
lnote += 9;
+#line 6836 ""
}
/* Print 13-ndxslur */
/* 5/25/08 Allow 14 slurs */
+#line 6841 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
+#line 6842 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6842 ""
i__2 = 71 - comslur_1.ndxslur;
+#line 6842 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6842 ""
i__5[1] = 1, a__3[1] = ch__1;
+#line 6842 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6843 ""
++lnote;
+#line 6844 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
+#line 6845 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 6845 ""
i__4[1] = 2, a__2[1] = "{1";
+#line 6845 ""
i__2 = 61 - comslur_1.ndxslur;
+#line 6845 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6845 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 6845 ""
i__4[3] = 1, a__2[3] = "}";
+#line 6845 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 6846 ""
lnote += 4;
+#line 6847 ""
} else {
/* Writing concatenation */
+#line 6848 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 6848 ""
i__4[1] = 2, a__2[1] = "{2";
+#line 6848 ""
i__2 = 51 - comslur_1.ndxslur;
+#line 6848 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 6848 ""
i__4[2] = 1, a__2[2] = ch__1;
+#line 6848 ""
i__4[3] = 1, a__2[3] = "}";
+#line 6848 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
+#line 6849 ""
lnote += 4;
+#line 6850 ""
}
+#line 6851 ""
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 6855 ""
ivoffinc = 0;
+#line 6856 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
+#line 6858 ""
if (stemup) {
+#line 6859 ""
ivoffinc = -1;
+#line 6860 ""
} else {
+#line 6861 ""
ivoffinc = 1;
+#line 6862 ""
}
+#line 6863 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
+#line 6863 ""
ivoffinc <<= 1;
+#line 6863 ""
}
+#line 6866 ""
}
+#line 6867 ""
ivoff += ivoffinc;
+#line 6868 ""
}
+#line 6869 ""
i__2 = nolevs + iupdn + ivoff;
+#line 6869 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
+#line 6870 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
+#line 6872 ""
*islhgt = nolevs + iupdn + ivoff;
/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
+#line 6876 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && comsln_1.is1n1 > 0) {
+#line 6877 ""
if (idcode == comsln_1.is2n1) {
+#line 6877 ""
comsln_1.is1n1 = 0;
+#line 6877 ""
}
+#line 6878 ""
}
+#line 6879 ""
}
/* Writing concatenation */
+#line 6880 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6880 ""
i__5[1] = lnoten, a__3[1] = noteq;
+#line 6880 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6881 ""
lnote += lnoten;
+#line 6882 ""
if (ihoff != 0) {
+#line 6883 ""
shift = ihoff * .1f;
/* Writing concatenation */
+#line 6884 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6884 ""
i__5[1] = 1, a__3[1] = "{";
+#line 6884 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6885 ""
++lnote;
+#line 6886 ""
lform = lfmt1_(&shift);
+#line 6887 ""
i__2 = lnote;
+#line 6887 ""
ici__1.icierr = 0;
+#line 6887 ""
ici__1.icirnum = 1;
+#line 6887 ""
ici__1.icirlen = lnote + lform - i__2;
+#line 6887 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 6887 ""
i__3[0] = 2, a__1[0] = "(f";
+#line 6887 ""
i__6 = lform + 48;
+#line 6887 ""
chax_(ch__1, (ftnlen)1, &i__6);
+#line 6887 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 6887 ""
i__3[2] = 3, a__1[2] = ".1)";
+#line 6887 ""
ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
6), ch__3);
+#line 6887 ""
s_wsfi(&ici__1);
+#line 6887 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
+#line 6887 ""
e_wsfi();
+#line 6889 ""
lnote += lform;
/* Writing concatenation */
+#line 6890 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 6890 ""
i__5[1] = 1, a__3[1] = "}";
+#line 6890 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
+#line 6891 ""
++lnote;
+#line 6892 ""
}
+#line 6893 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Clear the bit from list of slurs in use */
+#line 6897 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
/* Zero out the entire strings for start and stop */
+#line 6901 ""
isdata = 0;
+#line 6902 ""
isdat2[isdat] = 0;
+#line 6903 ""
isdat3[isdat] = 0;
+#line 6904 ""
isdat4[isdat] = 0;
+#line 6905 ""
isdat1[j] = 0;
+#line 6906 ""
isdat2[j] = 0;
+#line 6907 ""
isdat3[j] = 0;
+#line 6908 ""
isdat4[j] = 0;
/* Set midi info for slur ending */
+#line 6912 ""
if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
+#line 6913 ""
icm = commidi_1.midchan[*iv + *kv * 24 - 25];
+#line 6914 ""
if (comslm_1.slmon[icm]) {
/* if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */
/* 130316 */
/* if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */
+#line 6918 ""
if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
*nacc) == 0) {
@@ -10112,44 +16899,77 @@ L4:
/* levsoff(icm) = nolevs */
/* 130316 */
/* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */
+#line 6926 ""
comslm_1.levsoff[icm] = nolevs +
commvel_1.miditran[cominsttrans_1.instno[*
iv - 1] - 1];
+#line 6927 ""
settie = TRUE_;
+#line 6928 ""
} else {
+#line 6929 ""
comslm_1.levsoff[icm] = 0;
+#line 6930 ""
comslm_1.levson[icm] = 0;
+#line 6931 ""
comslm_1.slmon[icm] = FALSE_;
+#line 6932 ""
}
+#line 6933 ""
}
+#line 6934 ""
}
+#line 6935 ""
}
+#line 6936 ""
isdat1[isdat] = isdata;
+#line 6937 ""
}
+#line 6938 ""
/* L1: */
+#line 6938 ""
}
/* Clear and collapse the slur data list */
+#line 6942 ""
numdrop = 0;
+#line 6943 ""
i__1 = *nsdat;
+#line 6943 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
+#line 6944 ""
if (isdat1[isdat] == 0) {
+#line 6945 ""
++numdrop;
+#line 6946 ""
} else if (numdrop > 0) {
+#line 6947 ""
isdat1[isdat - numdrop] = isdat1[isdat];
+#line 6948 ""
isdat2[isdat - numdrop] = isdat2[isdat];
+#line 6949 ""
isdat3[isdat - numdrop] = isdat3[isdat];
+#line 6950 ""
isdat4[isdat - numdrop] = isdat4[isdat];
+#line 6951 ""
isdat1[isdat] = 0;
+#line 6952 ""
isdat2[isdat] = 0;
+#line 6953 ""
isdat3[isdat] = 0;
+#line 6954 ""
isdat4[isdat] = 0;
+#line 6955 ""
}
+#line 6956 ""
/* L2: */
+#line 6956 ""
}
+#line 6957 ""
*nsdat -= numdrop;
/* call report(nsdat,isdat1,isdat2) */
+#line 6959 ""
return 0;
} /* dopsslur_ */
@@ -10211,11 +17031,11 @@ L4:
static char slurudq[1];
/* Fortran I/O blocks */
- static cilist io___475 = { 0, 6, 0, 0, 0 };
- static cilist io___477 = { 0, 6, 0, 0, 0 };
- static cilist io___478 = { 0, 6, 0, 0, 0 };
- static cilist io___479 = { 0, 15, 0, "(/,a)", 0 };
- static cilist io___487 = { 0, 6, 0, 0, 0 };
+ static cilist io___505 = { 0, 6, 0, 0, 0 };
+ static cilist io___507 = { 0, 6, 0, 0, 0 };
+ static cilist io___508 = { 0, 6, 0, 0, 0 };
+ static cilist io___509 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___517 = { 0, 6, 0, 0, 0 };
@@ -10259,75 +17079,129 @@ L4:
/* If highest note has upslur, save slur height in islhgt in case */
/* ornament must be moved. */
+#line 7037 ""
/* Parameter adjustments */
+#line 7037 ""
--isdat3;
+#line 7037 ""
--isdat2;
+#line 7037 ""
--isdat1;
+#line 7037 ""
+#line 7037 ""
/* Function Body */
+#line 7037 ""
*islhgt = 0;
+#line 7038 ""
if (*beamon) {
+#line 7039 ""
stemup = *(unsigned char *)ulq == 'u';
+#line 7040 ""
} else if (commvl_1.nvmx[*iv - 1] == 2) {
+#line 7041 ""
if (! bit_test(*islur,30)) {
/* Single note, 2 lines of music, stem direction not forced */
+#line 7045 ""
stemup = commvl_1.ivx > *nv;
+#line 7046 ""
} else {
+#line 7047 ""
stemup = bit_test(*islur,17);
+#line 7048 ""
}
+#line 7049 ""
} else {
+#line 7050 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
commvl_1.ivx, nv);
+#line 7050 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
+#line 7051 ""
}
+#line 7052 ""
iscrd = bit_test(*ipl,10);
+#line 7053 ""
if (bit_test(*islur,1)) {
/* 't'-slur (idcode=1) somewhere on this note. Find it, check height against */
/* 's'-slur (idcode=32) */
+#line 7058 ""
sfound = FALSE_;
+#line 7059 ""
tfound = FALSE_;
+#line 7060 ""
tmove = FALSE_;
+#line 7061 ""
i__1 = *nsdat;
+#line 7061 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
+#line 7062 ""
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 7065 ""
if (! tfound) {
+#line 7066 ""
tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1;
+#line 7067 ""
if (tfound) {
+#line 7068 ""
nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19);
+#line 7069 ""
isdatt = isdat;
+#line 7070 ""
if (sfound) {
+#line 7070 ""
goto L6;
+#line 7070 ""
}
+#line 7071 ""
}
+#line 7072 ""
}
+#line 7073 ""
if (! sfound) {
+#line 7074 ""
sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32;
+#line 7075 ""
if (sfound) {
+#line 7076 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
+#line 7077 ""
isdats = isdat;
+#line 7078 ""
if (tfound) {
+#line 7078 ""
goto L6;
+#line 7078 ""
}
+#line 7079 ""
}
+#line 7080 ""
}
+#line 7081 ""
}
+#line 7082 ""
/* L5: */
+#line 7082 ""
}
/* 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 7087 ""
L6:
+#line 7088 ""
if (sfound && tfound) {
+#line 7088 ""
tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) &&
bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats],
11) && ! bit_test(isdat1[isdatt],11));
+#line 7088 ""
}
/* Check if 2 starts or two stops */
@@ -10335,145 +17209,229 @@ L6:
/* This is a flag for later changing slur level, after we know slur dir'n. */
+#line 7099 ""
}
+#line 7100 ""
if (commidi_1.ismidi) {
+#line 7101 ""
settie = FALSE_;
+#line 7102 ""
comslm_1.dbltie = FALSE_;
+#line 7103 ""
}
+#line 7104 ""
i__1 = *nsdat;
+#line 7104 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
+#line 7105 ""
isdata = isdat1[isdat];
+#line 7106 ""
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 7112 ""
idcode = igetbits_(&isdata, &c__7, &c__19);
+#line 7113 ""
ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
+#line 7114 ""
ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
+#line 7115 ""
iupdn = 0;
+#line 7116 ""
*(unsigned char *)slurudq = 'd';
+#line 7117 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
+#line 7118 ""
if (bit_test(isdata,11)) {
/* Turnon, */
+#line 7122 ""
if (nolevs == 0 || nolevs > 60) {
/* Note was a rest, cannot start slur on rest. */
- s_wsle(&io___475);
+#line 7126 ""
+ s_wsle(&io___505);
+#line 7126 ""
e_wsle();
+#line 7127 ""
printl_("Cannot start slur on a rest", (ftnlen)27);
+#line 7128 ""
stop1_();
+#line 7129 ""
}
/* Get slur direction */
+#line 7133 ""
if (bit_test(isdata,26)) {
/* Force slur direction */
+#line 7137 ""
if (bit_test(isdata,27)) {
+#line 7137 ""
*(unsigned char *)slurudq = 'u';
+#line 7137 ""
}
+#line 7138 ""
} else if (commvl_1.nvmx[*iv - 1] == 1) {
/* Only one voice per line */
+#line 7142 ""
if (! (*beamon)) {
/* Separate note. */
+#line 7146 ""
udfq_(ch__1, (ftnlen)1, nolev, ncm);
+#line 7146 ""
*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
0];
+#line 7147 ""
} else {
/* In a beam */
+#line 7151 ""
if (*(unsigned char *)ulq != 'u') {
+#line 7151 ""
*(unsigned char *)slurudq = 'u';
+#line 7151 ""
}
+#line 7152 ""
}
+#line 7153 ""
if (iscrd) {
+#line 7154 ""
if (nolevs > *ncm) {
+#line 7155 ""
*(unsigned char *)slurudq = 'u';
+#line 7156 ""
} else {
+#line 7157 ""
*(unsigned char *)slurudq = 'd';
+#line 7158 ""
}
+#line 7159 ""
}
+#line 7160 ""
} else {
/* Two voices per line. Get default */
+#line 7164 ""
if (commvl_1.ivx > *nv) {
+#line 7164 ""
*(unsigned char *)slurudq = 'u';
+#line 7164 ""
}
/* Upper voice of the two, so up slur */
+#line 7168 ""
}
/* Save up/down-ness for use at termination */
+#line 7172 ""
if (*(unsigned char *)slurudq == 'u') {
+#line 7172 ""
isdata = bit_set(isdata,27);
+#line 7172 ""
}
/* End of section for setting slur direction, still in "Turnon" if-block. */
+#line 7176 ""
if (idcode == 1 && tmove) {
+#line 7177 ""
iupdn = 1;
+#line 7178 ""
if (*(unsigned char *)slurudq == 'd') {
+#line 7178 ""
iupdn = -1;
+#line 7178 ""
}
+#line 7179 ""
}
+#line 7180 ""
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 7184 ""
ivoffinc = 0;
+#line 7185 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
/* Must move the slur for _ or . */
+#line 7190 ""
if (stemup) {
+#line 7191 ""
ivoffinc = -1;
+#line 7192 ""
} else {
+#line 7193 ""
ivoffinc = 1;
+#line 7194 ""
}
+#line 7195 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
+#line 7195 ""
ivoffinc <<= 1;
+#line 7195 ""
}
+#line 7198 ""
ivoff += ivoffinc;
+#line 7199 ""
}
+#line 7200 ""
}
+#line 7201 ""
if (comslur_1.listslur == 16777215) {
- s_wsle(&io___477);
+#line 7202 ""
+ s_wsle(&io___507);
+#line 7202 ""
e_wsle();
- s_wsle(&io___478);
- do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"
+#line 7203 ""
+ s_wsle(&io___508);
+#line 7203 ""
+ do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"\
", one too many!", (ftnlen)49);
+#line 7203 ""
e_wsle();
- s_wsfe(&io___479);
- do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"
+#line 7204 ""
+ s_wsfe(&io___509);
+#line 7204 ""
+ do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"\
"oo many!", (ftnlen)49);
+#line 7204 ""
e_wsfe();
+#line 7206 ""
stop1_();
+#line 7207 ""
}
/* Get index of next slur not in use, starting from ? down */
+#line 7211 ""
i__2 = 16777215 - comslur_1.listslur;
+#line 7211 ""
comslur_1.ndxslur = log2_(&i__2);
/* Record slur index */
+#line 7215 ""
comslur_1.listslur = bit_set(comslur_1.listslur,
comslur_1.ndxslur);
@@ -10481,92 +17439,149 @@ L6:
/* call setbits(isdata,4,28,ndxslur) */
/* 080531 Allow >16 slurs */
+#line 7221 ""
i__2 = comslur_1.ndxslur % 16;
+#line 7221 ""
setbits_(&isdata, &c__4, &c__28, &i__2);
+#line 7222 ""
i__2 = comslur_1.ndxslur / 16;
+#line 7222 ""
setbits_(&isdata, &c__1, &c__18, &i__2);
/* Shift for stem? */
+#line 7226 ""
if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
{
+#line 7226 ""
ihoff += 8;
+#line 7226 ""
}
+#line 7228 ""
if (bit_test(isdat2[isdat],3)) {
/* Tie spacing, (slur start) */
+#line 7232 ""
if (*(unsigned char *)slurudq == 'd') {
+#line 7233 ""
++ivoff;
+#line 7234 ""
ihoff += 8;
+#line 7235 ""
} else if (*(unsigned char *)slurudq == 'u') {
+#line 7236 ""
--ivoff;
+#line 7237 ""
if (! (stemup && *tno < 63.f)) {
+#line 7237 ""
ihoff += 8;
+#line 7237 ""
}
/* (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */
+#line 7241 ""
}
+#line 7242 ""
}
+#line 7243 ""
if (iscrd) {
/* Additional horiz shifts for h-shifted noteheads? */
+#line 7247 ""
if (bit_test(isdat2[isdat],1)) {
/* Slur start on left-shifted chord notehead. ASSUME downstem. */
+#line 7251 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
+#line 7252 ""
ihoff += -2;
+#line 7253 ""
} else {
+#line 7254 ""
ihoff += -10;
+#line 7255 ""
}
+#line 7256 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
+#line 7260 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
+#line 7261 ""
ihoff += 2;
+#line 7262 ""
} else {
+#line 7263 ""
ihoff += 10;
+#line 7264 ""
}
+#line 7265 ""
}
+#line 7266 ""
}
+#line 7267 ""
if (ihoff == 0) {
/* Write stuff for non-shifted start */
/* Writing concatenation */
+#line 7271 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7271 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 7271 ""
i__3[1] = 5, a__1[1] = "islur";
+#line 7271 ""
i__3[2] = 1, a__1[2] = slurudq;
+#line 7271 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 7272 ""
lnote = 7;
+#line 7273 ""
} else {
/* Writing concatenation */
+#line 7274 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7274 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 7274 ""
i__3[1] = 2, a__1[1] = "is";
+#line 7274 ""
i__3[2] = 1, a__1[2] = slurudq;
+#line 7274 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 7275 ""
lnote = 4;
+#line 7276 ""
}
+#line 7277 ""
if (bit_test(isdat2[isdat],4)) {
/* Dotted slur */
+#line 7281 ""
s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79);
/* Writing concatenation */
+#line 7282 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7282 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 7282 ""
i__3[1] = 6, a__1[1] = "dotted";
+#line 7282 ""
i__3[2] = 8, a__1[2] = noteq;
+#line 7282 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
+#line 7283 ""
lnote += 7;
+#line 7284 ""
}
/* Add slur index to string */
@@ -10574,156 +17589,253 @@ L6:
/* Print 23-ndxslur */
/* if (11-ndxslur .lt. 10) then */
+#line 7291 ""
if (23 - comslur_1.ndxslur < 10) {
/* 5/25/08 Allow 24 slurs */
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
/* Writing concatenation */
+#line 7296 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7296 ""
i__2 = 71 - comslur_1.ndxslur;
+#line 7296 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7296 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 7296 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7297 ""
++lnote;
+#line 7298 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
+#line 7300 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 7300 ""
i__5[1] = 2, a__3[1] = "{1";
+#line 7300 ""
i__2 = 61 - comslur_1.ndxslur;
+#line 7300 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7300 ""
i__5[2] = 1, a__3[2] = ch__1;
+#line 7300 ""
i__5[3] = 1, a__3[3] = "}";
+#line 7300 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
+#line 7301 ""
lnote += 4;
+#line 7302 ""
} else {
/* Writing concatenation */
+#line 7303 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 7303 ""
i__5[1] = 2, a__3[1] = "{2";
+#line 7303 ""
i__2 = 51 - comslur_1.ndxslur;
+#line 7303 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7303 ""
i__5[2] = 1, a__3[2] = ch__1;
+#line 7303 ""
i__5[3] = 1, a__3[3] = "}";
+#line 7303 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
+#line 7304 ""
lnote += 4;
+#line 7305 ""
}
/* Add note name to string */
+#line 7309 ""
i__2 = nolevs + iupdn + ivoff;
+#line 7309 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
/* Writing concatenation */
+#line 7310 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7310 ""
i__4[1] = lnoten, a__2[1] = noteq;
+#line 7310 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7311 ""
lnote += lnoten;
/* Save height (for ornament and barnobox interference) if topmost slur is up */
+#line 7315 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
+#line 7317 ""
*islhgt = nolevs + iupdn + ivoff;
/* Save height & idcode if top voice and slur start */
+#line 7321 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
+#line 7322 ""
comsln_1.is1n1 = *islhgt;
+#line 7323 ""
comsln_1.is2n1 = idcode;
+#line 7324 ""
}
+#line 7325 ""
}
+#line 7326 ""
if ((real) ihoff != 0.f) {
+#line 7327 ""
shift = ihoff * .1f;
/* Writing concatenation */
+#line 7328 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7328 ""
i__4[1] = 1, a__2[1] = "{";
+#line 7328 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7329 ""
++lnote;
+#line 7330 ""
lform = lfmt1_(&shift);
+#line 7331 ""
i__2 = lnote;
+#line 7331 ""
ici__1.icierr = 0;
+#line 7331 ""
ici__1.icirnum = 1;
+#line 7331 ""
ici__1.icirlen = lnote + lform - i__2;
+#line 7331 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 7331 ""
i__3[0] = 2, a__1[0] = "(f";
+#line 7331 ""
i__6 = lform + 48;
+#line 7331 ""
chax_(ch__1, (ftnlen)1, &i__6);
+#line 7331 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 7331 ""
i__3[2] = 3, a__1[2] = ".1)";
+#line 7331 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
6), ch__2);
+#line 7331 ""
s_wsfi(&ici__1);
+#line 7331 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
+#line 7331 ""
e_wsfi();
+#line 7333 ""
lnote += lform;
/* Writing concatenation */
+#line 7334 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7334 ""
i__4[1] = 1, a__2[1] = "}";
+#line 7334 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7335 ""
++lnote;
+#line 7336 ""
}
+#line 7337 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Zero out ip1 to avoid problems if slur goes to next input blk. */
+#line 7341 ""
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 7345 ""
if (commidi_1.ismidi && idcode == 32) {
/* levson(midchan(iv,kv)) = nolevs */
/* 130316 */
/* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */
+#line 7349 ""
comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1];
+#line 7350 ""
if (settie) {
+#line 7350 ""
comslm_1.dbltie = TRUE_;
+#line 7350 ""
}
/* 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 7355 ""
}
+#line 7356 ""
} else {
/* Slur is ending. Back thru list to find starting slur */
+#line 7360 ""
for (j = isdat - 1; j >= 1; --j) {
+#line 7361 ""
if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv ==
igetbits_(&isdat1[j], &c__1, &c__12) + 1) {
+#line 7363 ""
if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
+#line 7364 ""
comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
c__28) + (igetbits_(&isdat1[j], &c__1, &
c__18) << 4);
/* 080531 Allow >16 slurs */
+#line 7369 ""
if (bit_test(isdat1[j],27)) {
+#line 7369 ""
*(unsigned char *)slurudq = 'u';
+#line 7369 ""
}
+#line 7370 ""
goto L4;
+#line 7371 ""
}
+#line 7372 ""
}
+#line 7373 ""
/* L3: */
+#line 7373 ""
}
- s_wsle(&io___487);
+#line 7374 ""
+ s_wsle(&io___517);
+#line 7374 ""
do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
+#line 7374 ""
e_wsle();
+#line 7375 ""
stop1_();
+#line 7376 ""
L4:
+#line 7377 ""
if (nolevs == 0 || nolevs > 60) {
/* Ending is on a rest, reset nolevs to default starting height */
+#line 7381 ""
nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
+#line 7382 ""
}
+#line 7383 ""
if (bit_test(isdat3[isdat],0)) {
/* Deal with \curve or \midslur */
+#line 7387 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
/* Remember, only dealing with non-ps slurs */
@@ -10733,309 +17845,528 @@ L4:
/* if (slurudq .eq. 'd') imid = -imid */
/* 3/8/03 added the following */
+#line 7396 ""
if (*(unsigned char *)slurudq == 'd') {
+#line 7396 ""
imid = -abs(imid);
+#line 7396 ""
}
+#line 7398 ""
if (bit_test(isdat3[isdat],1)) {
/* Writing concatenation */
+#line 7399 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7399 ""
i__4[0] = 1, a__2[0] = ch__1;
+#line 7399 ""
i__4[1] = 5, a__2[1] = "curve";
+#line 7399 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7400 ""
lnote = 6;
+#line 7401 ""
} else {
/* Writing concatenation */
+#line 7402 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7402 ""
i__4[0] = 1, a__2[0] = ch__1;
+#line 7402 ""
i__4[1] = 7, a__2[1] = "midslur";
+#line 7402 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7403 ""
lnote = 8;
+#line 7404 ""
}
+#line 7405 ""
if (imid < 0 || imid > 9) {
/* Need brackets */
/* Writing concatenation */
+#line 7409 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7409 ""
i__4[1] = 1, a__2[1] = "{";
+#line 7409 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7410 ""
++lnote;
+#line 7411 ""
if (imid < -9) {
+#line 7412 ""
i__2 = lnote;
+#line 7412 ""
ici__1.icierr = 0;
+#line 7412 ""
ici__1.icirnum = 1;
+#line 7412 ""
ici__1.icirlen = lnote + 3 - i__2;
+#line 7412 ""
ici__1.iciunit = notexq + i__2;
+#line 7412 ""
ici__1.icifmt = "(i3)";
+#line 7412 ""
s_wsfi(&ici__1);
+#line 7412 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
+#line 7412 ""
e_wsfi();
+#line 7413 ""
lnote += 3;
+#line 7414 ""
} else if (imid < 0 || imid > 9) {
+#line 7415 ""
i__2 = lnote;
+#line 7415 ""
ici__1.icierr = 0;
+#line 7415 ""
ici__1.icirnum = 1;
+#line 7415 ""
ici__1.icirlen = lnote + 2 - i__2;
+#line 7415 ""
ici__1.iciunit = notexq + i__2;
+#line 7415 ""
ici__1.icifmt = "(i2)";
+#line 7415 ""
s_wsfi(&ici__1);
+#line 7415 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
+#line 7415 ""
e_wsfi();
+#line 7416 ""
lnote += 2;
+#line 7417 ""
} else {
+#line 7418 ""
i__2 = lnote;
+#line 7418 ""
ici__1.icierr = 0;
+#line 7418 ""
ici__1.icirnum = 1;
+#line 7418 ""
ici__1.icirlen = lnote + 1 - i__2;
+#line 7418 ""
ici__1.iciunit = notexq + i__2;
+#line 7418 ""
ici__1.icifmt = "(i1)";
+#line 7418 ""
s_wsfi(&ici__1);
+#line 7418 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
+#line 7418 ""
e_wsfi();
+#line 7419 ""
++lnote;
+#line 7420 ""
}
/* Writing concatenation */
+#line 7421 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7421 ""
i__4[1] = 1, a__2[1] = "}";
+#line 7421 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7422 ""
++lnote;
+#line 7423 ""
} else {
/* 1=<imid=<9, no brackets */
/* Writing concatenation */
+#line 7427 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7427 ""
*(unsigned char *)&ch__1[0] = imid + 48;
+#line 7427 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 7427 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7428 ""
++lnote;
+#line 7429 ""
}
+#line 7430 ""
if (bit_test(isdat3[isdat],1)) {
/* \curve; 3 args */
/* Writing concatenation */
+#line 7434 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7434 ""
*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
, &c__3, &c__8) + 48;
+#line 7434 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 7434 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
/* Writing concatenation */
+#line 7436 ""
i__4[0] = lnote + 1, a__2[0] = notexq;
+#line 7436 ""
*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
, &c__3, &c__11) + 48;
+#line 7436 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 7436 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7438 ""
lnote += 2;
+#line 7439 ""
}
+#line 7440 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)
80);
+#line 7441 ""
}
/* Shift slur ending for stem on any note? */
+#line 7445 ""
if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
63.f) {
+#line 7445 ""
ihoff += -8;
+#line 7445 ""
}
+#line 7447 ""
if (bit_test(isdat2[isdat],3)) {
/* Shift ending for tie spacing */
+#line 7451 ""
if (*(unsigned char *)slurudq == 'u') {
+#line 7452 ""
ihoff += -8;
+#line 7453 ""
--ivoff;
+#line 7454 ""
} else if (*(unsigned char *)slurudq == 'd') {
+#line 7455 ""
++ivoff;
+#line 7456 ""
if (stemup || *tno > 63.f) {
+#line 7456 ""
ihoff += -8;
+#line 7456 ""
}
+#line 7457 ""
}
+#line 7458 ""
}
+#line 7459 ""
if (iscrd) {
/* Shift termination for shifted notehead? */
+#line 7463 ""
if (bit_test(isdat2[isdat],1)) {
/* Left-shifted chord notehead. ASSUME downstem. */
+#line 7467 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
+#line 7468 ""
ihoff += -2;
+#line 7469 ""
} else {
+#line 7470 ""
ihoff += -10;
+#line 7471 ""
}
+#line 7472 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
+#line 7476 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
+#line 7477 ""
ihoff += 2;
+#line 7478 ""
} else {
+#line 7479 ""
ihoff += 10;
+#line 7480 ""
}
+#line 7481 ""
}
+#line 7482 ""
}
+#line 7483 ""
if (ihoff == 0) {
/* Writing concatenation */
+#line 7484 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7484 ""
i__4[0] = 1, a__2[0] = ch__1;
+#line 7484 ""
i__4[1] = 5, a__2[1] = "tslur";
+#line 7484 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7485 ""
lnote = 6;
+#line 7486 ""
} else {
/* Shift needed */
/* Writing concatenation */
+#line 7490 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7490 ""
i__4[0] = 1, a__2[0] = ch__1;
+#line 7490 ""
i__4[1] = 2, a__2[1] = "ts";
+#line 7490 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7491 ""
lnote = 3;
+#line 7492 ""
}
/* Print 23-ndxslur */
/* 5/25/08 Allow 14 slurs (???????????) */
+#line 7497 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
+#line 7498 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7498 ""
i__2 = 71 - comslur_1.ndxslur;
+#line 7498 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7498 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 7498 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7499 ""
++lnote;
+#line 7500 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
+#line 7501 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 7501 ""
i__5[1] = 2, a__3[1] = "{1";
+#line 7501 ""
i__2 = 61 - comslur_1.ndxslur;
+#line 7501 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7501 ""
i__5[2] = 1, a__3[2] = ch__1;
+#line 7501 ""
i__5[3] = 1, a__3[3] = "}";
+#line 7501 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
+#line 7502 ""
lnote += 4;
+#line 7503 ""
} else {
/* Writing concatenation */
+#line 7504 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 7504 ""
i__5[1] = 2, a__3[1] = "{2";
+#line 7504 ""
i__2 = 51 - comslur_1.ndxslur;
+#line 7504 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7504 ""
i__5[2] = 1, a__3[2] = ch__1;
+#line 7504 ""
i__5[3] = 1, a__3[3] = "}";
+#line 7504 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
+#line 7505 ""
lnote += 4;
+#line 7506 ""
}
+#line 7507 ""
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 7511 ""
ivoffinc = 0;
+#line 7512 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
+#line 7514 ""
if (stemup) {
+#line 7515 ""
ivoffinc = -1;
+#line 7516 ""
} else {
+#line 7517 ""
ivoffinc = 1;
+#line 7518 ""
}
+#line 7519 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
+#line 7519 ""
ivoffinc <<= 1;
+#line 7519 ""
}
+#line 7522 ""
}
+#line 7523 ""
ivoff += ivoffinc;
+#line 7524 ""
}
+#line 7525 ""
if (idcode == 1 && tmove) {
/* t-slur height adjustment */
+#line 7529 ""
iupdn = 1;
+#line 7530 ""
if (*(unsigned char *)slurudq == 'd') {
+#line 7530 ""
iupdn = -1;
+#line 7530 ""
}
+#line 7531 ""
}
+#line 7532 ""
i__2 = nolevs + iupdn + ivoff;
+#line 7532 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
+#line 7533 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
+#line 7535 ""
*islhgt = nolevs + iupdn + ivoff;
/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
+#line 7539 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && comsln_1.is1n1 > 0) {
+#line 7540 ""
if (idcode == comsln_1.is2n1) {
+#line 7540 ""
comsln_1.is1n1 = 0;
+#line 7540 ""
}
+#line 7541 ""
}
+#line 7542 ""
}
/* Writing concatenation */
+#line 7543 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7543 ""
i__4[1] = lnoten, a__2[1] = noteq;
+#line 7543 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7544 ""
lnote += lnoten;
+#line 7545 ""
if (ihoff != 0) {
+#line 7546 ""
shift = ihoff * .1f;
/* Writing concatenation */
+#line 7547 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7547 ""
i__4[1] = 1, a__2[1] = "{";
+#line 7547 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7548 ""
++lnote;
+#line 7549 ""
lform = lfmt1_(&shift);
+#line 7550 ""
i__2 = lnote;
+#line 7550 ""
ici__1.icierr = 0;
+#line 7550 ""
ici__1.icirnum = 1;
+#line 7550 ""
ici__1.icirlen = lnote + lform - i__2;
+#line 7550 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 7550 ""
i__3[0] = 2, a__1[0] = "(f";
+#line 7550 ""
i__6 = lform + 48;
+#line 7550 ""
chax_(ch__1, (ftnlen)1, &i__6);
+#line 7550 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 7550 ""
i__3[2] = 3, a__1[2] = ".1)";
+#line 7550 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
6), ch__2);
+#line 7550 ""
s_wsfi(&ici__1);
+#line 7550 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
+#line 7550 ""
e_wsfi();
+#line 7552 ""
lnote += lform;
/* Writing concatenation */
+#line 7553 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 7553 ""
i__4[1] = 1, a__2[1] = "}";
+#line 7553 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 7554 ""
++lnote;
+#line 7555 ""
}
+#line 7556 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Clear the bit from list of slurs in use */
+#line 7560 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
/* Zero out the entire strings for start and stop */
+#line 7564 ""
isdata = 0;
+#line 7565 ""
isdat2[isdat] = 0;
+#line 7566 ""
isdat1[j] = 0;
+#line 7567 ""
isdat2[j] = 0;
+#line 7568 ""
isdat3[isdat] = 0;
/* Set midi info for slur ending */
+#line 7572 ""
if (commidi_1.ismidi && idcode == 32) {
+#line 7573 ""
icm = commidi_1.midchan[*iv + *kv * 24 - 25];
+#line 7574 ""
if (comslm_1.slmon[icm]) {
/* if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */
/* 130316 */
/* if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */
+#line 7578 ""
if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
*nacc) == 0) {
@@ -11045,42 +18376,73 @@ L4:
/* levsoff(icm) = nolevs */
/* 130316 */
/* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */
+#line 7586 ""
comslm_1.levsoff[icm] = nolevs +
commvel_1.miditran[cominsttrans_1.instno[*
iv - 1] - 1];
+#line 7587 ""
settie = TRUE_;
+#line 7588 ""
} else {
+#line 7589 ""
comslm_1.levsoff[icm] = 0;
+#line 7590 ""
comslm_1.levson[icm] = 0;
+#line 7591 ""
comslm_1.slmon[icm] = FALSE_;
+#line 7592 ""
}
+#line 7593 ""
}
+#line 7594 ""
}
+#line 7595 ""
}
+#line 7596 ""
isdat1[isdat] = isdata;
+#line 7597 ""
}
+#line 7598 ""
/* L1: */
+#line 7598 ""
}
/* Clear and collapse the slur data list */
+#line 7602 ""
numdrop = 0;
+#line 7603 ""
i__1 = *nsdat;
+#line 7603 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
+#line 7604 ""
if (isdat1[isdat] == 0) {
+#line 7605 ""
++numdrop;
+#line 7606 ""
} else if (numdrop > 0) {
+#line 7607 ""
isdat1[isdat - numdrop] = isdat1[isdat];
+#line 7608 ""
isdat2[isdat - numdrop] = isdat2[isdat];
+#line 7609 ""
isdat3[isdat - numdrop] = isdat3[isdat];
+#line 7610 ""
isdat1[isdat] = 0;
+#line 7611 ""
isdat2[isdat] = 0;
+#line 7612 ""
isdat3[isdat] = 0;
+#line 7613 ""
}
+#line 7614 ""
/* L2: */
+#line 7614 ""
}
+#line 7615 ""
*nsdat -= numdrop;
/* call report(nsdat,isdat1,isdat2) */
+#line 7617 ""
return 0;
} /* doslur_ */
@@ -11111,57 +18473,102 @@ L4:
/* iddot = 0 for single dot, 1 for double */
+#line 7625 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7625 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 7626 ""
lfmtup = lfmt1_(updot);
+#line 7627 ""
lfmtrt = lfmt1_(rtdot);
+#line 7628 ""
ici__1.icierr = 0;
+#line 7628 ""
ici__1.icirnum = 1;
+#line 7628 ""
ici__1.icirlen = 80;
+#line 7628 ""
ici__1.iciunit = notexq;
/* Writing concatenation */
+#line 7628 ""
i__1[0] = 6, a__1[0] = "(a37,f";
+#line 7628 ""
i__2 = lfmtup + 48;
+#line 7628 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7628 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 7628 ""
i__1[2] = 7, a__1[2] = ".1,a2,f";
+#line 7628 ""
i__3 = lfmtrt + 48;
+#line 7628 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7628 ""
i__1[3] = 1, a__1[3] = ch__3;
+#line 7628 ""
i__1[4] = 7, a__1[4] = ".1,a15)";
+#line 7628 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2);
+#line 7628 ""
s_wsfi(&ici__1);
/* Writing concatenation */
+#line 7628 ""
i__4[0] = 1, a__2[0] = sq;
+#line 7628 ""
i__4[1] = 12, a__2[1] = "makeatletter";
+#line 7628 ""
i__4[2] = 1, a__2[2] = sq;
+#line 7628 ""
i__4[3] = 3, a__2[3] = "def";
+#line 7628 ""
i__4[4] = 1, a__2[4] = sq;
+#line 7628 ""
i__4[5] = 12, a__2[5] = "C@Point#1#2{";
+#line 7628 ""
i__4[6] = 1, a__2[6] = sq;
+#line 7628 ""
i__4[7] = 6, a__2[7] = "PMXpt{";
+#line 7628 ""
s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37);
+#line 7628 ""
do_fio(&c__1, ch__4, (ftnlen)37);
+#line 7628 ""
do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real));
+#line 7628 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 7628 ""
do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real));
/* Writing concatenation */
+#line 7628 ""
i__5[0] = 1, a__3[0] = "}";
+#line 7628 ""
i__6 = *iddot + 48;
+#line 7628 ""
chax_(ch__6, (ftnlen)1, &i__6);
+#line 7628 ""
i__5[1] = 1, a__3[1] = ch__6;
+#line 7628 ""
i__5[2] = 1, a__3[2] = "}";
+#line 7628 ""
i__5[3] = 1, a__3[3] = sq;
+#line 7628 ""
i__5[4] = 11, a__3[4] = "makeatother";
+#line 7628 ""
s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15);
+#line 7628 ""
do_fio(&c__1, ch__5, (ftnlen)15);
+#line 7628 ""
e_wsfi();
/* Example of string just created: */
/* \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */
+#line 7637 ""
lnote = lfmtup + 54 + lfmtrt;
+#line 7638 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
+#line 7639 ""
return 0;
} /* dotmov_ */
@@ -11190,92 +18597,165 @@ L4:
static logical tronly;
/* Fortran I/O blocks */
- static cilist io___497 = { 0, 6, 0, 0, 0 };
+ static cilist io___527 = { 0, 6, 0, 0, 0 };
+#line 7649 ""
i__1 = comtrill_1.ntrill;
+#line 7649 ""
for (itr = 1; itr <= i__1; ++itr) {
+#line 7650 ""
if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[
itr - 1]) {
+#line 7650 ""
goto L2;
+#line 7650 ""
}
+#line 7651 ""
/* L1: */
+#line 7651 ""
}
- s_wsle(&io___497);
+#line 7652 ""
+ s_wsle(&io___527);
+#line 7652 ""
do_lio(&c__9, &c__1, "Problem in dotrill. Call Dr. Don", (ftnlen)33);
+#line 7652 ""
e_wsle();
+#line 7653 ""
s_stop("", (ftnlen)0);
+#line 7654 ""
L2:
+#line 7655 ""
tronly = comtrill_1.xnsktr[itr - 1] < .01f;
+#line 7656 ""
if (tronly) {
/* Writing concatenation */
+#line 7657 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7657 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 7657 ""
i__2[1] = 9, a__1[1] = "zcharnote";
+#line 7657 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 7658 ""
*lnote = 10;
+#line 7659 ""
} else if (bit_test(*iornq,7)) {
/* Writing concatenation */
+#line 7660 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7660 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 7660 ""
i__2[1] = 6, a__1[1] = "Trille";
+#line 7660 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 7661 ""
*lnote = 7;
+#line 7662 ""
} else {
/* Writing concatenation */
+#line 7663 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7663 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 7663 ""
i__2[1] = 6, a__1[1] = "trille";
+#line 7663 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 7664 ""
*lnote = 7;
+#line 7665 ""
}
/* Writing concatenation */
+#line 7666 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 7666 ""
i__3[1] = *lnoten, a__2[1] = noteq;
+#line 7666 ""
i__3[2] = 1, a__2[2] = "{";
+#line 7666 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 7667 ""
*lnote = *lnote + *lnoten + 1;
/* Write trill duration to nearest tenth of a noteskip */
+#line 7671 ""
if (tronly) {
/* Writing concatenation */
+#line 7672 ""
i__3[0] = *lnote, a__2[0] = notexq;
+#line 7672 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7672 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 7672 ""
i__3[2] = 6, a__2[2] = "it tr}";
+#line 7672 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 7673 ""
*lnote += 7;
+#line 7674 ""
return 0;
+#line 7675 ""
}
+#line 7676 ""
if (comtrill_1.xnsktr[itr - 1] < .95f) {
+#line 7677 ""
nfmt = 2;
+#line 7678 ""
} else if (comtrill_1.xnsktr[itr - 1] < 9.95f) {
+#line 7679 ""
nfmt = 3;
+#line 7680 ""
} else {
+#line 7681 ""
nfmt = 4;
+#line 7682 ""
}
+#line 7683 ""
i__1 = *lnote;
+#line 7683 ""
ici__1.icierr = 0;
+#line 7683 ""
ici__1.icirnum = 1;
+#line 7683 ""
ici__1.icirlen = *lnote + nfmt - i__1;
+#line 7683 ""
ici__1.iciunit = notexq + i__1;
/* Writing concatenation */
+#line 7683 ""
i__3[0] = 2, a__2[0] = "(f";
+#line 7683 ""
i__4 = nfmt + 48;
+#line 7683 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 7683 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 7683 ""
i__3[2] = 3, a__2[2] = ".1)";
+#line 7683 ""
ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2);
+#line 7683 ""
s_wsfi(&ici__1);
+#line 7683 ""
do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real));
+#line 7683 ""
e_wsfi();
+#line 7685 ""
*lnote += nfmt;
/* Writing concatenation */
+#line 7686 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 7686 ""
i__2[1] = 1, a__1[1] = "}";
+#line 7686 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 7687 ""
++(*lnote);
+#line 7688 ""
return 0;
} /* dotrill_ */
@@ -11305,27 +18785,41 @@ L2:
/* Only called to end slur started in dograce. */
+#line 7700 ""
shift = ! (*stemup) && ! (*upslur);
+#line 7701 ""
if (! shift) {
/* No shift needed */
/* Writing concatenation */
+#line 7705 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7705 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 7705 ""
i__1[1] = 5, a__1[1] = "tslur";
+#line 7705 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7706 ""
lnote = 6;
+#line 7707 ""
} else {
/* Shift needed */
/* Writing concatenation */
+#line 7711 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 7711 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 7711 ""
i__1[1] = 2, a__1[1] = "ts";
+#line 7711 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7712 ""
lnote = 3;
+#line 7713 ""
}
/* if (ndxslur .lt. 10) then */
/* notexq = notexq(1:lnote)//chax(48+ndxslur) */
@@ -11339,59 +18833,105 @@ L2:
/* Print 23-ndxslur */
/* if (11-ndxslur .lt. 10) then */
+#line 7726 ""
if (23 - *ndxslur < 10) {
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
/* Writing concatenation */
+#line 7728 ""
i__1[0] = lnote, a__1[0] = notexq;
+#line 7728 ""
i__2 = 71 - *ndxslur;
+#line 7728 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7728 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 7728 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7729 ""
++lnote;
+#line 7730 ""
} else if (23 - *ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
+#line 7732 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 7732 ""
i__3[1] = 2, a__2[1] = "{1";
+#line 7732 ""
i__2 = 61 - *ndxslur;
+#line 7732 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7732 ""
i__3[2] = 1, a__2[2] = ch__1;
+#line 7732 ""
i__3[3] = 1, a__2[3] = "}";
+#line 7732 ""
s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
+#line 7733 ""
lnote += 4;
+#line 7734 ""
} else {
/* Writing concatenation */
+#line 7735 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 7735 ""
i__3[1] = 2, a__2[1] = "{2";
+#line 7735 ""
i__2 = 51 - *ndxslur;
+#line 7735 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 7735 ""
i__3[2] = 1, a__2[2] = ch__1;
+#line 7735 ""
i__3[3] = 1, a__2[3] = "}";
+#line 7735 ""
s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
+#line 7736 ""
lnote += 4;
+#line 7737 ""
}
+#line 7738 ""
i__2 = *nolev + *iupdn + *ivoff;
+#line 7738 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
/* Writing concatenation */
+#line 7739 ""
i__1[0] = lnote, a__1[0] = notexq;
+#line 7739 ""
i__1[1] = lnoten, a__1[1] = noteq;
+#line 7739 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7740 ""
lnote += lnoten;
+#line 7741 ""
if (shift) {
+#line 7742 ""
if (*fontslur) {
/* Writing concatenation */
+#line 7743 ""
i__1[0] = lnote, a__1[0] = notexq;
+#line 7743 ""
i__1[1] = 5, a__1[1] = "{-.6}";
+#line 7743 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7744 ""
} else {
/* Writing concatenation */
+#line 7745 ""
i__1[0] = lnote, a__1[0] = notexq;
+#line 7745 ""
i__1[1] = 5, a__1[1] = "{-.8}";
+#line 7745 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 7746 ""
}
+#line 7747 ""
lnote += 5;
+#line 7748 ""
}
+#line 7749 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
+#line 7750 ""
return 0;
} /* endslur_ */
@@ -11426,27 +18966,40 @@ L2:
static integer ibarnop;
/* Fortran I/O blocks */
- static cilist io___507 = { 0, 6, 0, 0, 0 };
- static cilist io___510 = { 0, 19, 0, "(i6)", 0 };
- static cilist io___514 = { 0, 6, 0, "(1x,a)", 0 };
- static cilist io___515 = { 0, 15, 0, "(a)", 0 };
- static cilist io___518 = { 0, 6, 0, 0, 0 };
- static cilist io___519 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___537 = { 0, 6, 0, 0, 0 };
+ static cilist io___540 = { 0, 19, 0, "(i6)", 0 };
+ static cilist io___544 = { 0, 6, 0, "(1x,a)", 0 };
+ static cilist io___545 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___548 = { 0, 6, 0, 0, 0 };
+ static cilist io___549 = { 0, 15, 0, "(a)", 0 };
+#line 7762 ""
if (*iccount <= 78) {
+#line 7763 ""
s_copy(outq, lineq, (ftnlen)78, (ftnlen)78);
+#line 7764 ""
iposn = *iccount;
+#line 7765 ""
} else {
/* Writing concatenation */
+#line 7766 ""
i__1[0] = 4, a__1[0] = "... ";
+#line 7766 ""
i__1[1] = 74, a__1[1] = lineq + 54;
+#line 7766 ""
s_cat(outq, a__1, i__1, &c__2, (ftnlen)78);
+#line 7767 ""
iposn = *iccount - 50;
+#line 7768 ""
}
- s_wsle(&io___507);
+#line 7769 ""
+ s_wsle(&io___537);
+#line 7769 ""
e_wsle();
+#line 7770 ""
ibarnop = *ibarno;
+#line 7771 ""
if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline >
c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) {
@@ -11454,160 +19007,299 @@ L2:
/* nlinep = nline-linesinpmxmod */
/* Correct for comments not copied into buffer */
+#line 7778 ""
nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] -
c1omget_1.linesinpmxmod;
+#line 7779 ""
} else {
/* Error is in include file */
+#line 7783 ""
ibarnop = 0;
+#line 7784 ""
nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1;
+#line 7785 ""
printl_("ERROR in include file named above, description given below",
(ftnlen)58);
+#line 7787 ""
}
+#line 7788 ""
o__1.oerr = 0;
+#line 7788 ""
o__1.ounit = 19;
+#line 7788 ""
o__1.ofnmlen = 11;
+#line 7788 ""
o__1.ofnm = "pmxaerr.dat";
+#line 7788 ""
o__1.orl = 0;
+#line 7788 ""
o__1.osta = 0;
+#line 7788 ""
o__1.oacc = 0;
+#line 7788 ""
o__1.ofm = 0;
+#line 7788 ""
o__1.oblnk = 0;
+#line 7788 ""
f_open(&o__1);
- s_wsfe(&io___510);
+#line 7789 ""
+ s_wsfe(&io___540);
+#line 7789 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
+#line 7789 ""
e_wsfe();
+#line 7790 ""
cl__1.cerr = 0;
+#line 7790 ""
cl__1.cunit = 19;
+#line 7790 ""
cl__1.csta = 0;
+#line 7790 ""
f_clos(&cl__1);
/* Computing MAX */
+#line 7791 ""
r__1 = ibarnop + .1f;
+#line 7791 ""
i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1);
+#line 7791 ""
ndigbn = max(i__2,i__3);
+#line 7792 ""
r__1 = nlinep + .1f;
+#line 7792 ""
ndignl = (integer) (r_lg10(&r__1) + 1);
+#line 7793 ""
lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1;
/* Split off msgq(..) since UNIX compilers don't allow concat substring!!! */
+#line 7797 ""
ci__1.cierr = 0;
+#line 7797 ""
ci__1.ciunit = 6;
/* Writing concatenation */
+#line 7797 ""
i__4[0] = 8, a__2[0] = "(/,a15,i";
+#line 7797 ""
i__2 = ndignl + 48;
+#line 7797 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7797 ""
i__4[1] = 1, a__2[1] = ch__2;
+#line 7797 ""
i__4[2] = 5, a__2[2] = ",a6,i";
+#line 7797 ""
i__3 = ndigbn + 48;
+#line 7797 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7797 ""
i__4[3] = 1, a__2[3] = ch__3;
+#line 7797 ""
i__4[4] = 3, a__2[4] = ",$)";
+#line 7797 ""
ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
+#line 7797 ""
s_wsfe(&ci__1);
+#line 7797 ""
do_fio(&c__1, " ERROR in line ", (ftnlen)15);
+#line 7797 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
+#line 7797 ""
do_fio(&c__1, ", bar ", (ftnlen)6);
+#line 7797 ""
do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
+#line 7797 ""
e_wsfe();
- s_wsfe(&io___514);
+#line 7799 ""
+ s_wsfe(&io___544);
+#line 7799 ""
do_fio(&c__1, msgq, lenmsg);
+#line 7799 ""
e_wsfe();
+#line 7800 ""
ci__1.cierr = 0;
+#line 7800 ""
ci__1.ciunit = 15;
/* Writing concatenation */
+#line 7800 ""
i__4[0] = 8, a__2[0] = "(/,a15,i";
+#line 7800 ""
i__2 = ndignl + 48;
+#line 7800 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7800 ""
i__4[1] = 1, a__2[1] = ch__2;
+#line 7800 ""
i__4[2] = 5, a__2[2] = ",a6,i";
+#line 7800 ""
i__3 = ndigbn + 48;
+#line 7800 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7800 ""
i__4[3] = 1, a__2[3] = ch__3;
+#line 7800 ""
i__4[4] = 3, a__2[4] = ",$)";
+#line 7800 ""
ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
+#line 7800 ""
s_wsfe(&ci__1);
+#line 7800 ""
do_fio(&c__1, " ERROR in line ", (ftnlen)15);
+#line 7800 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
+#line 7800 ""
do_fio(&c__1, ", bar ", (ftnlen)6);
+#line 7800 ""
do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
+#line 7800 ""
e_wsfe();
- s_wsfe(&io___515);
+#line 7802 ""
+ s_wsfe(&io___545);
+#line 7802 ""
do_fio(&c__1, msgq, lenmsg);
+#line 7802 ""
e_wsfe();
+#line 7803 ""
i10 = iposn / 10;
+#line 7804 ""
i1 = iposn - i10 * 10;
+#line 7805 ""
ci__1.cierr = 0;
+#line 7805 ""
ci__1.ciunit = 6;
/* Writing concatenation */
+#line 7805 ""
i__5[0] = 1, a__3[0] = "(";
+#line 7805 ""
i__2 = i10 + 48;
+#line 7805 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7805 ""
i__5[1] = 1, a__3[1] = ch__2;
+#line 7805 ""
i__3 = i1 + 48;
+#line 7805 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7805 ""
i__5[2] = 1, a__3[2] = ch__3;
+#line 7805 ""
i__5[3] = 4, a__3[3] = "x,a)";
+#line 7805 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
+#line 7805 ""
s_wsfe(&ci__1);
+#line 7805 ""
do_fio(&c__1, "v", (ftnlen)1);
+#line 7805 ""
e_wsfe();
+#line 7806 ""
ci__1.cierr = 0;
+#line 7806 ""
ci__1.ciunit = 15;
/* Writing concatenation */
+#line 7806 ""
i__5[0] = 1, a__3[0] = "(";
+#line 7806 ""
i__2 = i10 + 48;
+#line 7806 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7806 ""
i__5[1] = 1, a__3[1] = ch__2;
+#line 7806 ""
i__3 = i1 + 48;
+#line 7806 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7806 ""
i__5[2] = 1, a__3[2] = ch__3;
+#line 7806 ""
i__5[3] = 4, a__3[3] = "x,a)";
+#line 7806 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
+#line 7806 ""
s_wsfe(&ci__1);
+#line 7806 ""
do_fio(&c__1, "v", (ftnlen)1);
+#line 7806 ""
e_wsfe();
- s_wsle(&io___518);
+#line 7807 ""
+ s_wsle(&io___548);
+#line 7807 ""
do_lio(&c__9, &c__1, outq, (ftnlen)78);
+#line 7807 ""
e_wsle();
- s_wsfe(&io___519);
+#line 7808 ""
+ s_wsfe(&io___549);
/* Writing concatenation */
+#line 7808 ""
i__1[0] = 1, a__1[0] = " ";
+#line 7808 ""
i__1[1] = 78, a__1[1] = outq;
+#line 7808 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79);
+#line 7808 ""
do_fio(&c__1, ch__5, (ftnlen)79);
+#line 7808 ""
e_wsfe();
+#line 7809 ""
ci__1.cierr = 0;
+#line 7809 ""
ci__1.ciunit = 6;
/* Writing concatenation */
+#line 7809 ""
i__5[0] = 1, a__3[0] = "(";
+#line 7809 ""
i__2 = i10 + 48;
+#line 7809 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7809 ""
i__5[1] = 1, a__3[1] = ch__2;
+#line 7809 ""
i__3 = i1 + 48;
+#line 7809 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7809 ""
i__5[2] = 1, a__3[2] = ch__3;
+#line 7809 ""
i__5[3] = 4, a__3[3] = "x,a)";
+#line 7809 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
+#line 7809 ""
s_wsfe(&ci__1);
+#line 7809 ""
do_fio(&c__1, "^", (ftnlen)1);
+#line 7809 ""
e_wsfe();
+#line 7810 ""
ci__1.cierr = 0;
+#line 7810 ""
ci__1.ciunit = 15;
/* Writing concatenation */
+#line 7810 ""
i__5[0] = 1, a__3[0] = "(";
+#line 7810 ""
i__2 = i10 + 48;
+#line 7810 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 7810 ""
i__5[1] = 1, a__3[1] = ch__2;
+#line 7810 ""
i__3 = i1 + 48;
+#line 7810 ""
chax_(ch__3, (ftnlen)1, &i__3);
+#line 7810 ""
i__5[2] = 1, a__3[2] = ch__3;
+#line 7810 ""
i__5[3] = 4, a__3[3] = "x,a)";
+#line 7810 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
+#line 7810 ""
s_wsfe(&ci__1);
+#line 7810 ""
do_fio(&c__1, "^", (ftnlen)1);
+#line 7810 ""
e_wsfe();
+#line 7811 ""
return 0;
} /* errmsg_ */
@@ -11628,50 +19320,82 @@ L2:
static integer itnd, nnsk, itprev;
/* Fortran I/O blocks */
- static cilist io___524 = { 0, 6, 0, 0, 0 };
+ static cilist io___554 = { 0, 6, 0, 0, 0 };
/* Get elemskips to previous note. Called only for graces, no xtups involved. */
+#line 7831 ""
/* Parameter adjustments */
+#line 7831 ""
--tstart;
+#line 7831 ""
--space;
+#line 7831 ""
+#line 7831 ""
/* Function Body */
+#line 7831 ""
itnd = i_nint(&all_1.to[*in - 1]);
+#line 7832 ""
if (*ip == 1 || itnd == *itrpt) {
/* Start of bar or after rpt. */
+#line 7836 ""
*esk = *fbar;
+#line 7837 ""
return 0;
+#line 7838 ""
} else {
+#line 7839 ""
*esk = 0.f;
+#line 7840 ""
itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25];
+#line 7841 ""
for (iib = *ib; iib >= 1; --iib) {
+#line 7842 ""
if (tstart[iib] < itprev + comtol_1.tol) {
/* This is the block */
+#line 7846 ""
r__1 = (real) (itnd - itprev) / space[iib];
+#line 7846 ""
nnsk = i_nint(&r__1);
+#line 7847 ""
*esk += nnsk * feon_(&space[iib]);
+#line 7848 ""
return 0;
+#line 7849 ""
} else {
+#line 7850 ""
r__1 = (itnd - tstart[iib]) / space[iib];
+#line 7850 ""
nnsk = i_nint(&r__1);
+#line 7851 ""
*esk += nnsk * feon_(&space[iib]);
+#line 7852 ""
itnd = i_nint(&tstart[iib]);
+#line 7853 ""
}
+#line 7854 ""
/* L1: */
+#line 7854 ""
}
+#line 7855 ""
}
- s_wsle(&io___524);
+#line 7856 ""
+ s_wsle(&io___554);
+#line 7856 ""
do_lio(&c__9, &c__1, "Problem in eskb4. Send files to Dr. Don", (ftnlen)
40);
+#line 7856 ""
e_wsle();
+#line 7857 ""
s_stop("", (ftnlen)0);
+#line 7858 ""
return 0;
} /* eskb4_ */
@@ -11683,7 +19407,9 @@ doublereal f1eon_(real *time)
/* Builtin functions */
double sqrt(doublereal);
+#line 7860 ""
ret_val = sqrt(*time / 2);
+#line 7861 ""
return ret_val;
} /* f1eon_ */
@@ -11696,9 +19422,13 @@ doublereal feon_(real *time)
/* Builtin functions */
double sqrt(doublereal), pow_dd(doublereal *, doublereal *);
+#line 7865 ""
d__1 = (doublereal) sqrt(*time / 2);
+#line 7865 ""
d__2 = (doublereal) (1.f - comeon_1.eonk);
+#line 7865 ""
ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk;
+#line 7866 ""
return ret_val;
} /* feon_ */
@@ -11771,7 +19501,7 @@ doublereal feon_(real *time)
static integer masknow;
/* Fortran I/O blocks */
- static cilist io___558 = { 0, 6, 0, 0, 0 };
+ static cilist io___588 = { 0, 6, 0, 0, 0 };
@@ -11780,256 +19510,425 @@ doublereal feon_(real *time)
/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */
/* * itr(48),nodue(48) */
/* logical short(48),eqonly */
+#line 7896 ""
/* Parameter adjustments */
+#line 7896 ""
--mapfb;
+#line 7896 ""
--numbms;
+#line 7896 ""
+#line 7896 ""
/* Function Body */
+#line 7917 ""
ip = 0;
+#line 7918 ""
nreal = 0;
+#line 7919 ""
itnow = 0;
+#line 7920 ""
L1:
+#line 7921 ""
++ip;
+#line 7922 ""
if (ip > all_1.nn[commvl_1.ivx - 1]) {
+#line 7922 ""
goto L9;
+#line 7922 ""
}
+#line 7923 ""
L11:
+#line 7923 ""
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 7929 ""
++ip;
+#line 7930 ""
goto L11;
+#line 7931 ""
}
+#line 7932 ""
++nreal;
+#line 7933 ""
nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
+#line 7934 ""
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 7940 ""
ipr[nreal - 1] = ip;
+#line 7941 ""
itr[nreal - 1] = itnow;
+#line 7942 ""
if (nodue[nreal - 1] == 1) {
/* 64th gap */
+#line 7946 ""
if (itnow % 2 == 0) {
/* Start of 32nd gap, lump with following note */
+#line 7950 ""
++ip;
+#line 7951 ""
nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1;
+#line 7952 ""
itnow += nodue[nreal - 1];
+#line 7953 ""
} else {
/* End of 32nd gap, lump with preceeding note */
+#line 7957 ""
--nreal;
+#line 7958 ""
++nodue[nreal - 1];
+#line 7959 ""
++itnow;
+#line 7960 ""
}
+#line 7961 ""
} else {
+#line 7962 ""
itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25];
+#line 7963 ""
}
+#line 7964 ""
goto L1;
+#line 7965 ""
L9:
+#line 7966 ""
ir1 = 1;
+#line 7967 ""
itseg = all_1.lenbar / *ibmrep;
+#line 7968 ""
i__1 = *ibmrep;
+#line 7968 ""
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 7974 ""
maps = 0;
+#line 7975 ""
mapm = 0;
+#line 7976 ""
mape = 0;
+#line 7977 ""
itend = itseg * irep;
+#line 7978 ""
itoff = itend - itseg;
+#line 7979 ""
i__2 = nreal;
+#line 7979 ""
for (ir = ir1; ir <= i__2; ++ir) {
+#line 7980 ""
it2 = itr[ir - 1] + nodue[ir - 1] - 2;
+#line 7981 ""
if (it2 >= itend) {
+#line 7982 ""
ir1 = ir;
+#line 7983 ""
goto L14;
+#line 7984 ""
}
/* if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */
/* Computing MAX */
+#line 7986 ""
i__3 = ir - 1;
+#line 7986 ""
if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir <
nreal && short__[ir])) {
+#line 7988 ""
ib1 = (itr[ir - 1] - itoff) / 2;
+#line 7989 ""
ib2 = (it2 - itoff) / 2;
+#line 7990 ""
if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) {
+#line 7990 ""
return 0;
+#line 7990 ""
}
/* Must have an odd number obe beats in a long bar. Auto-beam won't work */
+#line 7995 ""
nip1[ib1] = ipr[ir - 1];
+#line 7996 ""
nip2[ib2] = ipr[ir - 1];
/* nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */
+#line 8000 ""
maps = bit_set(maps,ib1);
+#line 8001 ""
mape = bit_set(mape,ib2);
+#line 8002 ""
i__3 = ib2;
+#line 8002 ""
for (ib = ib1; ib <= i__3; ++ib) {
+#line 8003 ""
mapm = bit_set(mapm,ib);
+#line 8004 ""
/* L3: */
+#line 8004 ""
}
+#line 8005 ""
}
+#line 8006 ""
/* L2: */
+#line 8006 ""
}
+#line 8007 ""
L14:
+#line 8008 ""
if (mapm == 0) {
+#line 8008 ""
goto L13;
+#line 8008 ""
}
/* Zero out bits from forced beams */
+#line 8012 ""
maps &= ~ mapfb[irep];
+#line 8013 ""
mapm &= ~ mapfb[irep];
+#line 8014 ""
mape &= ~ mapfb[irep];
/* Compare map with template. */
+#line 8018 ""
i__2 = nummask[combeam_1.ibmtyp - 1];
+#line 8018 ""
for (it = 1; it <= i__2; ++it) {
+#line 8019 ""
masknow = mask[it + combeam_1.ibmtyp * 49 - 50];
+#line 8020 ""
if ((masknow & mapm) == masknow) {
/* Find least significant bit in the mask to check start time */
+#line 8024 ""
mtemp = masknow;
+#line 8025 ""
maskm = masknow;
+#line 8026 ""
for (is1 = 0; is1 <= 47; ++is1) {
+#line 8027 ""
if ((1 & mtemp) == 1) {
+#line 8027 ""
goto L6;
+#line 8027 ""
}
+#line 8028 ""
mtemp = lbit_shift(mtemp, (ftnlen)-1);
+#line 8029 ""
/* L5: */
+#line 8029 ""
}
+#line 8030 ""
L6:
+#line 8031 ""
if ((lbit_shift((ftnlen)1, is1) & maps) == 0) {
+#line 8031 ""
goto L4;
+#line 8031 ""
}
/* is1 is the bit where the beam starts. Continue shifting to */
/* find most significant bit in the mask to check ending time */
+#line 8036 ""
for (is2 = is1; is2 <= 47; ++is2) {
+#line 8037 ""
mtemp = lbit_shift(mtemp, (ftnlen)-1);
+#line 8038 ""
if ((1 & ~ mtemp) == 1) {
+#line 8038 ""
goto L8;
+#line 8038 ""
}
+#line 8039 ""
/* L7: */
+#line 8039 ""
}
+#line 8040 ""
L8:
/* is2 is now the bit on which the beam ends. */
+#line 8044 ""
if ((lbit_shift((ftnlen)1, is2) & mape) == 0) {
+#line 8044 ""
goto L4;
+#line 8044 ""
}
/* Did we pick out a single note from the middle of a longer sequence? */
+#line 8048 ""
if (nip1[is1] == nip2[is2]) {
+#line 8048 ""
goto L4;
+#line 8048 ""
}
/* We almost have a beam. Check equality of notes if needed. */
+#line 8052 ""
if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) {
+#line 8053 ""
i__3 = nip2[is2];
+#line 8053 ""
for (ip = nip1[is1]; ip <= i__3; ++ip) {
+#line 8054 ""
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 8058 ""
if (is2 - is1 != 15) {
+#line 8058 ""
goto L4;
+#line 8058 ""
}
/* Beam is 2 quarters long. Check if can split in half. */
+#line 8062 ""
ithalf = 0;
+#line 8063 ""
i__4 = nip2[is2];
+#line 8063 ""
for (iip = nip1[is1]; iip <= i__4; ++iip) {
+#line 8064 ""
ithalf += all_1.nodur[commvl_1.ivx + iip * 24
- 25];
+#line 8065 ""
if (ithalf > 16) {
+#line 8065 ""
goto L4;
+#line 8065 ""
}
+#line 8066 ""
if (ithalf == 16) {
+#line 8066 ""
goto L21;
+#line 8066 ""
}
+#line 8067 ""
/* L20: */
+#line 8067 ""
}
- s_wsle(&io___558);
- do_lio(&c__9, &c__1, "Problem in findbeam, pleas"
+#line 8068 ""
+ s_wsle(&io___588);
+#line 8068 ""
+ do_lio(&c__9, &c__1, "Problem in findbeam, pleas"\
"e call Dr. Don", (ftnlen)40);
+#line 8068 ""
e_wsle();
+#line 8069 ""
goto L4;
+#line 8070 ""
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 8075 ""
is2 = is1 + 7;
/* Reset maskm (since only used part of mask), used later to zero out */
/* bits that contain beams */
+#line 8080 ""
maskm = 0;
+#line 8081 ""
i__4 = is2;
+#line 8081 ""
for (is = is1; is <= i__4; ++is) {
+#line 8082 ""
maskm = bit_set(maskm,is);
+#line 8083 ""
/* L15: */
+#line 8083 ""
}
+#line 8084 ""
goto L16;
+#line 8085 ""
}
+#line 8086 ""
/* L10: */
+#line 8086 ""
}
+#line 8087 ""
}
+#line 8088 ""
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 8094 ""
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;
- if ((r__1 = r_mod(&r__2, &c_b1655), dabs(r__1)) >
+#line 8094 ""
+ if ((r__1 = r_mod(&r__2, &c_b1902), dabs(r__1)) >
comtol_1.tol) {
+#line 8096 ""
++nip2[is2];
+#line 8097 ""
}
+#line 8098 ""
++numbms[commvl_1.ivx];
+#line 8099 ""
numnew = numbms[commvl_1.ivx];
+#line 8100 ""
logbeam_(&numnew, &nip1[is1], &nip2[is2]);
/* Zero out the appropriate bits so these notes don't get used again */
+#line 8104 ""
mapm &= ~ maskm;
+#line 8105 ""
if (mapm == 0) {
+#line 8105 ""
goto L13;
+#line 8105 ""
}
+#line 8106 ""
maps &= ~ maskm;
+#line 8107 ""
mape &= ~ maskm;
+#line 8108 ""
}
+#line 8109 ""
L4:
+#line 8109 ""
;
+#line 8109 ""
}
+#line 8110 ""
L13:
+#line 8110 ""
;
+#line 8110 ""
}
+#line 8111 ""
return 0;
} /* findbeam_ */
@@ -12062,48 +19961,83 @@ L13:
/* logical gotclef */
/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
+#line 8126 ""
comeon_1.eonk = *eonk0;
+#line 8127 ""
niter = 0;
+#line 8128 ""
L1:
+#line 8129 ""
d__1 = (doublereal) f1eon_(dtmax);
+#line 8129 ""
d__2 = (doublereal) comeon_1.eonk;
+#line 8129 ""
comeon_1.ewmxk = pow_dd(&d__1, &d__2);
+#line 8130 ""
++niter;
+#line 8131 ""
esum = 0.f;
+#line 8132 ""
desum = 0.f;
+#line 8133 ""
i__1 = *nptr2;
+#line 8133 ""
for (iptr = *nptr1; iptr <= i__1; ++iptr) {
+#line 8134 ""
targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1];
+#line 8135 ""
esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
feon_(&targ);
+#line 8136 ""
d__1 = (doublereal) (*dtmax / targ);
+#line 8136 ""
d__2 = (doublereal) comeon_1.eonk;
+#line 8136 ""
detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ);
+#line 8137 ""
desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
detarg;
+#line 8138 ""
/* L2: */
+#line 8138 ""
}
+#line 8139 ""
f = *wovera * feon_(dtmin) - *xelsk - esum;
+#line 8140 ""
d__1 = (doublereal) (*dtmax / *dtmin);
+#line 8140 ""
d__2 = (doublereal) comeon_1.eonk;
+#line 8140 ""
fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / *
dtmin) - desum;
+#line 8142 ""
if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) >
.5f || niter > 100) {
+#line 8143 ""
printl_("Error in findeonk. Please send source to Dr. Don", (ftnlen)
49);
+#line 8145 ""
comeon_1.eonk = 0.f;
+#line 8146 ""
comeon_1.ewmxk = 1.f;
+#line 8147 ""
return 0;
+#line 8148 ""
}
+#line 8149 ""
dsoln = -f / fp;
+#line 8150 ""
if (dabs(dsoln) < comtol_1.tol * .1f) {
+#line 8150 ""
return 0;
+#line 8150 ""
}
/* Not converged yet, try again */
+#line 8154 ""
comeon_1.eonk += dsoln;
+#line 8155 ""
goto L1;
} /* findeonk_ */
@@ -12123,80 +20057,143 @@ doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc)
extern /* Subroutine */ int printl_(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___574 = { 0, 6, 0, 0, 0 };
+ static cilist io___604 = { 0, 6, 0, 0, 0 };
+ static cilist io___605 = { 0, 6, 0, 0, 0 };
/* This return the real duration of a note */
+#line 8164 ""
/* Parameter adjustments */
+#line 8164 ""
nacc -= 25;
+#line 8164 ""
nodur -= 25;
+#line 8164 ""
+#line 8164 ""
/* Function Body */
+#line 8164 ""
ipback = *ip;
+#line 8165 ""
if (nodur[*ivx + *ip * 24] > 0) {
+#line 8166 ""
if (*ip > 1) {
/* Check if this is last note of xtup */
+#line 8170 ""
if (nodur[*ivx + (*ip - 1) * 24] == 0) {
+#line 8171 ""
ipback = *ip - 1;
+#line 8172 ""
goto L2;
+#line 8173 ""
}
+#line 8174 ""
}
+#line 8175 ""
ret_val = (real) nodur[*ivx + *ip * 24];
+#line 8176 ""
return ret_val;
+#line 8177 ""
}
+#line 8178 ""
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 8183 ""
ndoub = 0;
+#line 8184 ""
for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) {
+#line 8185 ""
if (nodur[*ivx + ip1m1 * 24] > 0) {
+#line 8185 ""
goto L4;
+#line 8185 ""
}
+#line 8186 ""
if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) {
+#line 8186 ""
++ndoub;
+#line 8186 ""
}
+#line 8187 ""
/* L1: */
+#line 8187 ""
}
+#line 8188 ""
L4:
/* count forward to next non-0 nodur. Start at ip in case last note of xtup. */
+#line 8192 ""
for (iip = *ip; iip <= 200; ++iip) {
/* Count doubled xtup notes from ip to end. */
+#line 8196 ""
if (bit_test(nacc[*ivx + iip * 24],18)) {
+#line 8196 ""
++ndoub;
+#line 8196 ""
}
+#line 8197 ""
if (nodur[*ivx + iip * 24] > 0) {
/* fnote = nodur(ivx,iip)/float(iip-ip1m1) */
+#line 8199 ""
ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub);
+#line 8200 ""
if (bit_test(nacc[*ivx + *ip * 24],18)) {
+#line 8201 ""
ret_val *= 2;
+#line 8202 ""
} else if (bit_test(nacc[*ivx + *ip * 24],27)) {
+#line 8203 ""
ret_val *= 1.5f;
+#line 8204 ""
} else if (*ip > 1) {
+#line 8205 ""
if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) {
+#line 8205 ""
ret_val *= .5f;
+#line 8205 ""
}
+#line 8206 ""
}
+#line 8207 ""
return ret_val;
+#line 8208 ""
}
+#line 8209 ""
/* L3: */
+#line 8209 ""
}
- s_wsle(&io___574);
+#line 8210 ""
+ s_wsle(&io___604);
+#line 8210 ""
do_lio(&c__9, &c__1, " ", (ftnlen)1);
+#line 8210 ""
e_wsle();
+#line 8211 ""
printl_("Probable misplaced barline or incorrect meter, stopping", (
ftnlen)55);
-/* call printl('Program error in fnote, send source to Dr. Don') */
+#line 8213 ""
+ s_wsle(&io___605);
+#line 8213 ""
+ do_lio(&c__9, &c__1, "ivx,ip:", (ftnlen)7);
+#line 8213 ""
+ do_lio(&c__3, &c__1, (char *)&(*ivx), (ftnlen)sizeof(integer));
+#line 8213 ""
+ do_lio(&c__3, &c__1, (char *)&(*ip), (ftnlen)sizeof(integer));
+#line 8213 ""
+ e_wsle();
+#line 8214 ""
stop1_();
+#line 8215 ""
return ret_val;
} /* fnote_ */
@@ -12217,28 +20214,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 8229 ""
if (*iccount == 128) {
+#line 8230 ""
read10_(lineq, &c1omget_1.lastchar, (ftnlen)128);
+#line 8231 ""
if (c1omget_1.lastchar) {
+#line 8231 ""
return 0;
+#line 8231 ""
}
+#line 8232 ""
if (! commac_1.endmac) {
+#line 8233 ""
*iccount = 0;
+#line 8234 ""
if (! commac_1.mplay) {
+#line 8234 ""
++c1omget_1.nline;
+#line 8234 ""
}
+#line 8235 ""
} else {
+#line 8236 ""
commac_1.endmac = FALSE_;
+#line 8237 ""
*iccount = commac_1.icchold;
+#line 8238 ""
s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
+#line 8239 ""
}
+#line 8240 ""
if (commac_1.mrecord) {
+#line 8241 ""
m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, (
ftnlen)128);
+#line 8242 ""
}
+#line 8243 ""
}
+#line 8244 ""
++(*iccount);
+#line 8245 ""
*(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
+#line 8246 ""
return 0;
} /* g1etchar_ */
@@ -12260,7 +20279,7 @@ 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[55], ch__4[54], ch__5[46];
+ char ch__1[42], ch__2[1], ch__3[2], ch__4[55], ch__5[54], ch__6[46];
icilist ici__1;
/* Builtin functions */
@@ -12329,2757 +20348,4540 @@ L4:
static integer lvoltxt;
/* Fortran I/O blocks */
- static cilist io___585 = { 0, 6, 0, 0, 0 };
- static cilist io___586 = { 0, 6, 0, 0, 0 };
- static cilist io___587 = { 0, 6, 0, 0, 0 };
- static cilist io___588 = { 0, 6, 0, 0, 0 };
- static cilist io___589 = { 0, 15, 0, "(/a)", 0 };
- static cilist io___590 = { 0, 15, 0, "(a11,2x,i3)", 0 };
- static cilist io___591 = { 0, 15, 0, 0, 0 };
- static cilist io___592 = { 0, 6, 0, 0, 0 };
- static cilist io___600 = { 0, 6, 0, 0, 0 };
- static cilist io___601 = { 0, 6, 0, 0, 0 };
- static cilist io___602 = { 0, 6, 0, 0, 0 };
- static cilist io___607 = { 0, 6, 0, 0, 0 };
- static cilist io___608 = { 0, 6, 0, 0, 0 };
- static cilist io___609 = { 0, 6, 0, 0, 0 };
+ static cilist io___616 = { 0, 6, 0, 0, 0 };
+ static cilist io___617 = { 0, 6, 0, 0, 0 };
+ static cilist io___618 = { 0, 6, 0, 0, 0 };
+ static cilist io___619 = { 0, 6, 0, 0, 0 };
+ static cilist io___620 = { 0, 15, 0, "(/a)", 0 };
+ static cilist io___621 = { 0, 15, 0, "(a11,2x,i3)", 0 };
+ static cilist io___622 = { 0, 15, 0, 0, 0 };
static cilist io___623 = { 0, 6, 0, 0, 0 };
- static cilist io___626 = { 0, 6, 0, 0, 0 };
- static cilist io___627 = { 0, 6, 0, 0, 0 };
- static cilist io___628 = { 0, 6, 0, 0, 0 };
static cilist io___631 = { 0, 6, 0, 0, 0 };
- static cilist io___637 = { 0, 6, 0, 0, 0 };
+ static cilist io___632 = { 0, 6, 0, 0, 0 };
+ static cilist io___633 = { 0, 6, 0, 0, 0 };
static cilist io___638 = { 0, 6, 0, 0, 0 };
- static cilist io___639 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___639 = { 0, 6, 0, 0, 0 };
static cilist io___640 = { 0, 6, 0, 0, 0 };
- static cilist io___641 = { 0, 6, 0, 0, 0 };
- static cilist io___642 = { 0, 15, 0, "(a)", 0 };
- static cilist io___643 = { 0, 15, 0, "(a)", 0 };
- static cilist io___648 = { 0, 6, 0, 0, 0 };
- static cilist io___649 = { 0, 15, 0, "(a)", 0 };
- static cilist io___653 = { 0, 6, 0, 0, 0 };
static cilist io___654 = { 0, 6, 0, 0, 0 };
- static cilist io___655 = { 0, 6, 0, 0, 0 };
- static cilist io___656 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 };
- static cilist io___660 = { 0, 6, 0, 0, 0 };
- static cilist io___661 = { 0, 6, 0, 0, 0 };
- static cilist io___662 = { 0, 5, 0, "(a)", 0 };
- static cilist io___666 = { 0, 6, 0, 0, 0 };
- static cilist io___667 = { 0, 6, 0, 0, 0 };
+ static cilist io___657 = { 0, 6, 0, 0, 0 };
+ static cilist io___658 = { 0, 6, 0, 0, 0 };
+ static cilist io___659 = { 0, 6, 0, 0, 0 };
+ static cilist io___662 = { 0, 6, 0, 0, 0 };
+ static cilist io___668 = { 0, 6, 0, 0, 0 };
+ static cilist io___669 = { 0, 6, 0, 0, 0 };
+ static cilist io___670 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___671 = { 0, 6, 0, 0, 0 };
+ static cilist io___672 = { 0, 6, 0, 0, 0 };
+ static cilist io___673 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___674 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___679 = { 0, 6, 0, 0, 0 };
+ static cilist io___680 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___684 = { 0, 6, 0, 0, 0 };
+ static cilist io___685 = { 0, 6, 0, 0, 0 };
+ static cilist io___686 = { 0, 6, 0, 0, 0 };
+ static cilist io___687 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 };
+ static cilist io___691 = { 0, 6, 0, 0, 0 };
+ static cilist io___692 = { 0, 6, 0, 0, 0 };
+ static cilist io___693 = { 0, 5, 0, "(a)", 0 };
+ static cilist io___697 = { 0, 6, 0, 0, 0 };
+ static cilist io___698 = { 0, 6, 0, 0, 0 };
/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
+#line 8315 ""
cdot = FALSE_;
+#line 8316 ""
L1:
+#line 8316 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 8317 ""
if (*(unsigned char *)charq != ' ') {
+#line 8317 ""
*(unsigned char *)charlq = *(unsigned char *)charq;
+#line 8317 ""
}
+#line 8318 ""
if (c1omget_1.lastchar) {
+#line 8319 ""
if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) {
- s_wsle(&io___585);
+#line 8320 ""
+ s_wsle(&io___616);
+#line 8320 ""
e_wsle();
- s_wsle(&io___586);
+#line 8321 ""
+ s_wsle(&io___617);
+#line 8321 ""
do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8);
+#line 8321 ""
e_wsle();
- s_wsle(&io___587);
+#line 8322 ""
+ s_wsle(&io___618);
+#line 8322 ""
do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29)
;
+#line 8322 ""
do_lio(&c__9, &c__1, charlq, (ftnlen)1);
+#line 8322 ""
do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12);
+#line 8322 ""
e_wsle();
- s_wsle(&io___588);
+#line 8323 ""
+ s_wsle(&io___619);
+#line 8323 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 8323 ""
i__1 = *(unsigned char *)charlq;
+#line 8323 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 8323 ""
e_wsle();
- s_wsfe(&io___589);
+#line 8324 ""
+ s_wsfe(&io___620);
/* Writing concatenation */
+#line 8324 ""
i__2[0] = 29, a__1[0] = "Last non-blank character is \"";
+#line 8324 ""
i__2[1] = 1, a__1[1] = charlq;
+#line 8324 ""
i__2[2] = 12, a__1[2] = "\", not \"/,%\"";
+#line 8324 ""
s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42);
+#line 8324 ""
do_fio(&c__1, ch__1, (ftnlen)42);
+#line 8324 ""
e_wsfe();
- s_wsfe(&io___590);
+#line 8326 ""
+ s_wsfe(&io___621);
+#line 8326 ""
do_fio(&c__1, "ASCII code:", (ftnlen)11);
+#line 8326 ""
i__1 = *(unsigned char *)charlq;
+#line 8326 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 8326 ""
e_wsfe();
/* Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. */
+#line 8330 ""
--inbuff_1.ilbuf;
+#line 8331 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[
inbuff_1.ilbuf - 1] + 2);
/* Writing concatenation */
+#line 8332 ""
i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq;
+#line 8332 ""
i__3[1] = 2, a__2[1] = " /";
- s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)65536);
- s_wsle(&io___591);
+#line 8332 ""
+ s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)131072);
+#line 8333 ""
+ s_wsle(&io___622);
+#line 8333 ""
do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
+#line 8333 ""
e_wsle();
- s_wsle(&io___592);
+#line 8334 ""
+ s_wsle(&io___623);
+#line 8334 ""
do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
+#line 8334 ""
e_wsle();
/* Writing concatenation */
+#line 8335 ""
i__3[0] = a1ll_2.iccount, a__2[0] = lineq;
+#line 8335 ""
i__3[1] = 2, a__2[1] = " /";
+#line 8335 ""
s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128);
+#line 8336 ""
c1omget_1.lastchar = FALSE_;
+#line 8337 ""
goto L1;
+#line 8338 ""
}
+#line 8339 ""
return 0;
+#line 8340 ""
}
+#line 8341 ""
if (*(unsigned char *)charq == ' ') {
+#line 8342 ""
goto L1;
+#line 8343 ""
} else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) {
+#line 8344 ""
a1ll_2.iccount = 128;
+#line 8345 ""
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 8350 ""
} 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 "/" */
+#line 8355 ""
if (cdot) {
+#line 8355 ""
goto L28;
+#line 8355 ""
}
/* if (gotclef) gotclef=.false. */
+#line 8357 ""
idotform = 0;
+#line 8358 ""
numnum = 0;
+#line 8359 ""
plusmin = FALSE_;
+#line 8360 ""
L28:
+#line 8360 ""
++a1ll_2.nnl[c1ommvl_1.ivx - 1];
+#line 8361 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) {
+#line 8362 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"
+#line 8362 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"\
"sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48);
+#line 8364 ""
stop1_();
+#line 8365 ""
}
+#line 8366 ""
*(unsigned char *)dotq = 'x';
/* Check if this is 'r ' and previous note was full-bar-pause */
+#line 8370 ""
i__1 = a1ll_2.iccount;
/* Computing MAX */
+#line 8370 ""
i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
/* Computing MAX */
+#line 8370 ""
i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
+#line 8370 ""
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 8373 ""
L2:
+#line 8373 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 8374 ""
ic = *(unsigned char *)durq;
+#line 8375 ""
if (ic <= 57 && ic >= 48) {
/* Digit */
+#line 8379 ""
if (numnum == 0) {
+#line 8380 ""
c1omnotes_1.nnodur = ic - 48;
+#line 8381 ""
numnum = 1;
+#line 8382 ""
goto L2;
+#line 8383 ""
} else if (numnum == 1) {
+#line 8384 ""
if (*(unsigned char *)charq == 'r') {
+#line 8385 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"
+#line 8385 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"\
"llowed after rest symbol \"r\"!", (ftnlen)128, (
ftnlen)45);
+#line 8387 ""
stop1_();
+#line 8388 ""
}
+#line 8389 ""
numnum = 2;
+#line 8390 ""
if (plusmin) {
- s_wsle(&io___600);
+#line 8391 ""
+ s_wsle(&io___631);
+#line 8391 ""
e_wsle();
- s_wsle(&io___601);
+#line 8392 ""
+ s_wsle(&io___632);
+#line 8392 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
25);
+#line 8392 ""
e_wsle();
+#line 8393 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"
+#line 8393 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\
".2, +/- was ignored if octave was!", (ftnlen)128,
(ftnlen)50);
- s_wsle(&io___602);
- do_lio(&c__9, &c__1, "explicitly specified. May need to"
+#line 8395 ""
+ s_wsle(&io___633);
+#line 8395 ""
+ do_lio(&c__9, &c__1, "explicitly specified. May need to"\
" edit old editions", (ftnlen)52);
+#line 8395 ""
e_wsle();
+#line 8397 ""
}
+#line 8398 ""
goto L2;
+#line 8399 ""
} else {
+#line 8400 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"
+#line 8400 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"\
"mbol!", (ftnlen)128, (ftnlen)25);
+#line 8402 ""
stop1_();
+#line 8403 ""
}
+#line 8404 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 8405 ""
*(unsigned char *)dotq = *(unsigned char *)durq;
+#line 8406 ""
i__1 = a1ll_2.iccount;
+#line 8406 ""
if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
+#line 8407 ""
c1omnotes_1.iddot = 1;
+#line 8408 ""
++a1ll_2.iccount;
/* Since we flow out, double dots won't work with other dot options */
+#line 8412 ""
}
+#line 8413 ""
i__1 = a1ll_2.iccount;
+#line 8413 ""
if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 -
i__1) > 0) {
/* move a dot, provided a number follows. */
+#line 8417 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8418 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8419 ""
if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0)
{
/* Backup, exit the loop normally */
+#line 8423 ""
a1ll_2.iccount += -2;
+#line 8424 ""
goto L2;
+#line 8425 ""
}
+#line 8426 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 8427 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift also */
+#line 8431 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 8432 ""
if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) ==
0) {
+#line 8433 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"
+#line 8433 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"\
"ber after 2nd +/- (shift dot)!", (ftnlen)128,
(ftnlen)42);
+#line 8435 ""
stop1_();
+#line 8436 ""
}
+#line 8437 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 8438 ""
}
+#line 8439 ""
--a1ll_2.iccount;
+#line 8440 ""
}
+#line 8441 ""
goto L2;
+#line 8442 ""
} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Accidental shift */
/* if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */
+#line 8447 ""
i__1 = a1ll_2.iccount - 2;
+#line 8447 ""
if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 -
i__1) == 0) {
+#line 8448 ""
i__1 = a1ll_2.iccount - 1;
+#line 8448 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o"
+#line 8448 ""
+ 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 8451 ""
stop1_();
+#line 8452 ""
}
+#line 8453 ""
ipm = 1;
+#line 8454 ""
if (*(unsigned char *)durq == '<') {
+#line 8454 ""
ipm = -1;
+#line 8454 ""
}
+#line 8455 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 8456 ""
if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 8457 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"
+#line 8457 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"\
"r </> (accidental shift)!", (ftnlen)128, (ftnlen)45);
+#line 8459 ""
stop1_();
+#line 8460 ""
}
+#line 8461 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 8462 ""
fnum = ipm * fnum;
+#line 8463 ""
if (fnum < -5.35f || fnum > 1.f) {
+#line 8464 ""
i__1 = a1ll_2.iccount - 1;
+#line 8464 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"
+#line 8464 ""
+ errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"\
"st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52);
+#line 8466 ""
stop1_();
+#line 8467 ""
}
+#line 8468 ""
--a1ll_2.iccount;
+#line 8469 ""
goto L2;
+#line 8470 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8471 ""
if (*(unsigned char *)charq != 'r') {
+#line 8472 ""
i__1 = a1ll_2.iccount - 2;
+#line 8472 ""
if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount -
1 - i__1) > 0) {
+#line 8473 ""
ipm = 1;
+#line 8474 ""
if (*(unsigned char *)durq == '-') {
+#line 8474 ""
ipm = -1;
+#line 8474 ""
}
+#line 8475 ""
i__1 = a1ll_2.iccount;
+#line 8475 ""
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 8480 ""
icsav = a1ll_2.iccount;
+#line 8481 ""
++a1ll_2.iccount;
+#line 8482 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 8483 ""
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 8488 ""
if (fnum > 30.5f) {
+#line 8489 ""
i__1 = a1ll_2.iccount - 1;
+#line 8489 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__1, &i__4, "Vertical accid"
+#line 8489 ""
+ errmsg_(lineq, &i__1, &i__4, "Vertical accid"\
"ental shift must be less than 31!", (
ftnlen)128, (ftnlen)47);
+#line 8491 ""
stop1_();
+#line 8492 ""
}
+#line 8493 ""
ipm = 1;
+#line 8494 ""
if (*(unsigned char *)durq == '-') {
+#line 8494 ""
ipm = -1;
+#line 8494 ""
}
+#line 8495 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
128, (ftnlen)1);
+#line 8496 ""
if (i_indx("1234567890.", durq, (ftnlen)11, (
ftnlen)1) == 0) {
+#line 8497 ""
i__1 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"
+#line 8497 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"\
"cted 2nd number of accidental shift)!"
, (ftnlen)128, (ftnlen)41);
+#line 8499 ""
stop1_();
+#line 8500 ""
}
+#line 8501 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
+#line 8502 ""
fnum = ipm * fnum;
+#line 8503 ""
if (fnum < -5.35f || fnum > 1.f) {
+#line 8504 ""
i__1 = a1ll_2.iccount - 1;
+#line 8504 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"
+#line 8504 ""
+ errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"\
"tal shift must be >-5.35 and <1.0!", (
ftnlen)128, (ftnlen)48);
+#line 8506 ""
stop1_();
+#line 8507 ""
}
+#line 8508 ""
--a1ll_2.iccount;
+#line 8509 ""
goto L2;
+#line 8510 ""
} else {
/* Not accid shift, reset, then flow out */
+#line 8514 ""
a1ll_2.iccount = icsav;
+#line 8515 ""
}
+#line 8516 ""
}
+#line 8517 ""
}
+#line 8518 ""
plusmin = TRUE_;
+#line 8519 ""
if (numnum == 2) {
- s_wsle(&io___607);
+#line 8520 ""
+ s_wsle(&io___638);
+#line 8520 ""
e_wsle();
- s_wsle(&io___608);
+#line 8521 ""
+ s_wsle(&io___639);
+#line 8521 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
25);
+#line 8521 ""
e_wsle();
+#line 8522 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"
+#line 8522 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\
".2, +/- was ignored if octave was!", (ftnlen)128,
(ftnlen)50);
- s_wsle(&io___609);
- do_lio(&c__9, &c__1, "explicitly specified. May need to"
+#line 8524 ""
+ s_wsle(&io___640);
+#line 8524 ""
+ do_lio(&c__9, &c__1, "explicitly specified. May need to"\
" edit old editions", (ftnlen)52);
+#line 8524 ""
e_wsle();
+#line 8526 ""
}
+#line 8527 ""
goto L2;
/* It's a rest containing +|- . Must refer to a vertical shift. Read past. */
+#line 8531 ""
} else {
+#line 8532 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8533 ""
readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (
ftnlen)1);
+#line 8534 ""
+ i__1 = a1ll_2.iccount - 2;
+#line 8534 ""
+ if (s_cmp(lineq + i__1, ".", a1ll_2.iccount - 1 - i__1, (
+ ftnlen)1) == 0) {
+#line 8534 ""
+ --a1ll_2.iccount;
+#line 8534 ""
+ }
+#line 8535 ""
--a1ll_2.iccount;
+#line 8536 ""
goto L2;
+#line 8537 ""
}
/* else if (index('ulare',durq) .gt. 0) then */
+#line 8539 ""
} else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 8540 ""
goto L2;
-/* else if (durq .eq. 'S') then */
+#line 8541 ""
} else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Stemlength change */
+#line 8545 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 8546 ""
if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) {
+#line 8547 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"
+#line 8547 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"\
"er or colon here!", (ftnlen)128, (ftnlen)37);
+#line 8549 ""
stop1_();
+#line 8550 ""
}
+#line 8551 ""
if (*(unsigned char *)durq == ':') {
+#line 8552 ""
if (! comkeys_1.stickys) {
+#line 8553 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"
+#line 8553 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"\
"y stemlegth changes without turning on!", (ftnlen)
128, (ftnlen)55);
+#line 8555 ""
stop1_();
+#line 8556 ""
}
+#line 8557 ""
comkeys_1.stickys = FALSE_;
+#line 8558 ""
goto L2;
+#line 8559 ""
}
+#line 8560 ""
readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen)
1);
/* if (dum.lt..5 .or. dum.gt.4.) then */
+#line 8562 ""
if (*(unsigned char *)durq == 'L' && dum > 20.f || *(unsigned
char *)durq == 'S' && dum > 4.f) {
+#line 8564 ""
i__1 = a1ll_2.iccount - 1;
+#line 8564 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b"
+#line 8564 ""
+ errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b"\
"ig!", (ftnlen)128, (ftnlen)33);
+#line 8566 ""
stop1_();
+#line 8567 ""
}
+#line 8568 ""
if (*(unsigned char *)durq != ':') {
+#line 8569 ""
--a1ll_2.iccount;
+#line 8570 ""
} else {
+#line 8571 ""
if (comkeys_1.stickys) {
+#line 8572 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"
+#line 8572 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"\
" stemshrinks when already on!", (ftnlen)128, (
ftnlen)45);
+#line 8574 ""
stop1_();
+#line 8575 ""
}
+#line 8576 ""
comkeys_1.stickys = TRUE_;
+#line 8577 ""
}
+#line 8578 ""
goto L2;
+#line 8579 ""
} 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 8584 ""
i__1 = a1ll_2.iccount;
+#line 8584 ""
if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
+#line 8584 ""
++a1ll_2.iccount;
+#line 8584 ""
}
+#line 8585 ""
goto L2;
+#line 8586 ""
} else if (*(unsigned char *)durq == 'p') {
+#line 8587 ""
fulbrp = *(unsigned char *)charq == 'r';
+#line 8588 ""
if (! fulbrp) {
+#line 8589 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"
+#line 8589 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"\
"y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42);
+#line 8591 ""
stop1_();
+#line 8592 ""
}
+#line 8593 ""
goto L2;
+#line 8594 ""
} else if (*(unsigned char *)durq == 'b') {
+#line 8595 ""
if (*(unsigned char *)charq != 'r') {
+#line 8596 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"
+#line 8596 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"\
" expected \"rb\"!", (ftnlen)128, (ftnlen)33);
+#line 8598 ""
stop1_();
+#line 8599 ""
} else if (numnum == 2) {
+#line 8600 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"
+#line 8600 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"\
" \"b\" with two numbers!", (ftnlen)128, (ftnlen)39);
+#line 8602 ""
}
+#line 8603 ""
goto L2;
+#line 8604 ""
} else if (*(unsigned char *)durq == 'x') {
/* Xtuplet. Count number of doubled notes (for unequal xtups) */
+#line 8608 ""
if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25],18)) {
+#line 8609 ""
ndoub = 1;
+#line 8610 ""
} else {
+#line 8611 ""
ndoub = 0;
+#line 8612 ""
}
/* Will set all durations to 0 except last one. */
+#line 8616 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 8617 ""
+ if (i_indx("123456789T", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 8618 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""
- "x\" in xtuplet must be \"1\"-\"9\"!", (ftnlen)128, (
- ftnlen)48);
+#line 8618 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""\
+ "x\" in xtuplet must be \"1\"-\"9\" or \"T\"!", (
+ ftnlen)128, (ftnlen)55);
+#line 8620 ""
stop1_();
+#line 8621 ""
}
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
- if (fnum > 99.f) {
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot have "
- "more than 99 notes!", (ftnlen)128, (ftnlen)39);
- stop1_();
- } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) {
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal character"
- "s here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)128, (
- ftnlen)47);
- stop1_();
+#line 8622 ""
+ if (*(unsigned char *)durq == 'T') {
+
+/* Check all x-tremolo inputs here; set fnum=2 */
+
+#line 8626 ""
+ fnum = 2.f;
+#line 8627 ""
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
+#line 8628 ""
+ if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 8629 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 8629 ""
+ 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 8631 ""
+ stop1_();
+#line 8632 ""
+ } else if (*(unsigned char *)durq != ' ') {
+#line 8633 ""
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 8634 ""
+ if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 8635 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 8635 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This char mu"\
+ "st be \"0\"-\"3\" or blank!", (ftnlen)128, (
+ ftnlen)35);
+#line 8637 ""
+ stop1_();
+#line 8638 ""
+ } else if (*(unsigned char *)durq != ' ') {
+#line 8639 ""
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+
+/* Probably blank unles other options entered */
+
+#line 8643 ""
+ }
+#line 8644 ""
+ }
+#line 8645 ""
+ } else {
+
+/* durq is digit, normal xtup */
+
+#line 8649 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+
+/* Leaves durq at next char after number */
+
+#line 8653 ""
+ if (fnum > 99.f) {
+#line 8654 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 8654 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot h"\
+ "ave more than 99 notes!", (ftnlen)128, (ftnlen)39)
+ ;
+#line 8656 ""
+ stop1_();
+#line 8657 ""
+ } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 8658 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 8658 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal chara"\
+ "cters here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)
+ 128, (ftnlen)47);
+#line 8660 ""
+ stop1_();
+#line 8661 ""
+ }
+#line 8662 ""
}
/* End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. */
+#line 8666 ""
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 8671 ""
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 8672 ""
ndoub = 1;
+#line 8673 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8674 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 8675 ""
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 8676 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8677 ""
}
+#line 8678 ""
if (*(unsigned char *)durq == 'n') {
/* Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. */
+#line 8682 ""
numshft = 0;
+#line 8683 ""
L30:
+#line 8683 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8684 ""
if (*(unsigned char *)durq == 'f') {
+#line 8685 ""
goto L30;
+#line 8686 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8687 ""
++numshft;
+#line 8688 ""
if (numshft == 3) {
+#line 8689 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"
+#line 8689 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"\
"s are allowed after \"n\" in xtup!", (ftnlen)
128, (ftnlen)44);
+#line 8691 ""
stop1_();
+#line 8692 ""
}
+#line 8693 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 8694 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
0) {
+#line 8695 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"
+#line 8695 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\
"er should be a digit or \".\"!", (ftnlen)128,
(ftnlen)40);
+#line 8697 ""
stop1_();
+#line 8698 ""
}
+#line 8699 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
+#line 8700 ""
--a1ll_2.iccount;
/* if ((numshft.eq.1 .and. snum.gt.15.1) .or. */
+#line 8702 ""
if (numshft == 1 && snum > 64.f || numshft == 2 && snum >
1.51f) {
+#line 8704 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"
+#line 8704 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"\
" after \"n\" in xtup is out of range!", (
ftnlen)128, (ftnlen)47);
+#line 8706 ""
stop1_();
+#line 8707 ""
}
+#line 8708 ""
goto L30;
+#line 8709 ""
} else if (*(unsigned char *)durq == 's') {
/* Slope alteration for bracket */
+#line 8713 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 8714 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 8715 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"
- "justment, this character must be \"+\" or \"-"
+#line 8715 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"\
+ "justment, this character must be \"+\" or \"-"\
"\"!", (ftnlen)128, (ftnlen)56);
+#line 8717 ""
stop1_();
+#line 8718 ""
}
+#line 8719 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 8720 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
{
+#line 8721 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"
+#line 8721 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\
"er should be a digit!", (ftnlen)128, (ftnlen)
33);
+#line 8723 ""
stop1_();
+#line 8724 ""
}
+#line 8725 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
+#line 8726 ""
--a1ll_2.iccount;
+#line 8727 ""
if (i_nint(&snum) > 15) {
+#line 8728 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"
+#line 8728 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"\
"ment cannot exceed 15!", (ftnlen)128, (ftnlen)
34);
+#line 8730 ""
stop1_();
+#line 8731 ""
}
+#line 8732 ""
goto L30;
+#line 8733 ""
} else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) >
0) {
/* Unsigned integer => alternate printed number */
+#line 8737 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
+#line 8738 ""
if (snum > 15.1f) {
+#line 8739 ""
i__1 = a1ll_2.iccount - 1;
+#line 8739 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "
+#line 8739 ""
+ errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "\
"after \"n\" must be <16!", (ftnlen)128, (
ftnlen)44);
+#line 8741 ""
stop1_();
+#line 8742 ""
}
+#line 8743 ""
--a1ll_2.iccount;
+#line 8744 ""
goto L30;
+#line 8745 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 8746 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 8746 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36);
+#line 8748 ""
stop1_();
+#line 8749 ""
}
+#line 8750 ""
}
+#line 8751 ""
ntup = i_nint(&fnum);
+#line 8752 ""
i__1 = ntup;
+#line 8752 ""
for (itup = 2; itup <= i__1; ++itup) {
+#line 8753 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = 0;
+#line 8754 ""
++a1ll_2.nnl[c1ommvl_1.ivx - 1];
+#line 8755 ""
L110:
+#line 8755 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 8756 ""
if (*(unsigned char *)durq == ' ') {
+#line 8757 ""
goto L110;
+#line 8758 ""
} else if (*(unsigned char *)durq == 'o') {
/* Ornament in xtup. "o" symbol must come AFTER the affected note */
+#line 8762 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8763 ""
if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, (
ftnlen)1) == 0) {
+#line 8764 ""
if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8765 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "
+#line 8765 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "\
"or segno not allowed in xtuplet!", (
ftnlen)128, (ftnlen)40);
+#line 8767 ""
} else {
+#line 8768 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "
+#line 8768 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\
"ornament!", (ftnlen)128, (ftnlen)17);
+#line 8770 ""
}
+#line 8771 ""
stop1_();
+#line 8772 ""
}
+#line 8773 ""
if (*(unsigned char *)dumq == 'T') {
/* Trill. may be followed by 't' and/or number. read 'til blank */
+#line 8777 ""
L29:
+#line 8777 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8778 ""
if (*(unsigned char *)dumq != ' ') {
+#line 8778 ""
goto L29;
+#line 8778 ""
}
+#line 8779 ""
} else if (*(unsigned char *)dumq == 'e') {
+#line 8780 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8781 ""
if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 8782 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "
- "character after \"e\" in edit. accid. sy"
+#line 8782 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\
+ "character after \"e\" in edit. accid. sy"\
"mbol!", (ftnlen)128, (ftnlen)51);
+#line 8784 ""
stop1_();
+#line 8785 ""
}
+#line 8786 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8787 ""
if (*(unsigned char *)dumq == '?') {
+#line 8787 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
128, (ftnlen)1);
+#line 8787 ""
}
+#line 8788 ""
} else if (*(unsigned char *)dumq == ':') {
+#line 8789 ""
i__4 = a1ll_2.iccount;
+#line 8789 ""
if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) != 0) {
+#line 8790 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"
+#line 8790 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\
"st be followed by blank in \"o: \"!", (
ftnlen)128, (ftnlen)39);
+#line 8792 ""
stop1_();
+#line 8793 ""
} else if (! comkeys_1.ornrpt) {
+#line 8794 ""
i__4 = a1ll_2.iccount - 1;
+#line 8794 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &i__4, &i__5, "Turned off repeate"
+#line 8794 ""
+ errmsg_(lineq, &i__4, &i__5, "Turned off repeate"\
"d ornaments before they were on!", (
ftnlen)128, (ftnlen)50);
+#line 8796 ""
stop1_();
+#line 8797 ""
}
+#line 8798 ""
comkeys_1.ornrpt = FALSE_;
+#line 8799 ""
} else {
+#line 8800 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8801 ""
}
+#line 8802 ""
if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 8803 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
+#line 8803 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in ornament symbol!", (ftnlen)128, (
ftnlen)37);
+#line 8805 ""
stop1_();
+#line 8806 ""
}
+#line 8807 ""
if (*(unsigned char *)dumq == ':') {
+#line 8808 ""
i__4 = a1ll_2.iccount;
+#line 8808 ""
if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) != 0) {
+#line 8809 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"
+#line 8809 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\
"st be followed by blank in \"o: \"!", (
ftnlen)128, (ftnlen)39);
+#line 8811 ""
stop1_();
+#line 8812 ""
} else if (comkeys_1.ornrpt) {
+#line 8813 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"
+#line 8813 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"\
"n repeated ornaments but already on!", (
ftnlen)128, (ftnlen)44);
+#line 8815 ""
stop1_();
+#line 8816 ""
}
+#line 8817 ""
comkeys_1.ornrpt = TRUE_;
+#line 8818 ""
}
+#line 8819 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8820 ""
i__4 = a1ll_2.iccount;
+#line 8820 ""
if (i_indx("0123456789", lineq + i__4, (ftnlen)10,
a1ll_2.iccount + 1 - i__4) == 0) {
+#line 8822 ""
i__4 = a1ll_2.iccount + 1;
+#line 8822 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &i__4, &i__5, "There should be an"
+#line 8822 ""
+ errmsg_(lineq, &i__4, &i__5, "There should be an"\
" integer here!", (ftnlen)128, (ftnlen)32);
+#line 8824 ""
stop1_();
+#line 8825 ""
}
+#line 8826 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 8827 ""
if (*(unsigned char *)durq == ':') {
+#line 8828 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"
+#line 8828 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"\
"hift AND repeat an ornament!", (ftnlen)
128, (ftnlen)36);
+#line 8830 ""
stop1_();
+#line 8831 ""
}
/* 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */
+#line 8835 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8836 ""
i__4 = a1ll_2.iccount;
+#line 8836 ""
if (i_indx(".0123456789", lineq + i__4, (ftnlen)
11, a1ll_2.iccount + 1 - i__4) == 0) {
+#line 8838 ""
i__4 = a1ll_2.iccount + 1;
+#line 8838 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__4, &i__5, "There should b"
+#line 8838 ""
+ errmsg_(lineq, &i__4, &i__5, "There should b"\
"e a number here!", (ftnlen)128, (
ftnlen)30);
+#line 8841 ""
stop1_();
+#line 8842 ""
}
+#line 8843 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
+#line 8844 ""
}
+#line 8845 ""
}
+#line 8846 ""
goto L110;
+#line 8847 ""
} else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) {
/* Slur in xtup */
+#line 8851 ""
iposn = 0;
+#line 8852 ""
numint = 0;
+#line 8853 ""
L15:
+#line 8853 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8854 ""
++iposn;
+#line 8855 ""
if (i_indx("udlbfnhtv", dumq, (ftnlen)9, (ftnlen)1) > 0) {
+#line 8856 ""
if (*(unsigned char *)dumq == 't' && *(unsigned char *
)durq == 't') {
+#line 8857 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"
+#line 8857 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"\
"se \"t\" as an option on a tie!", (ftnlen)
128, (ftnlen)37);
+#line 8859 ""
stop1_();
+#line 8860 ""
}
+#line 8861 ""
goto L15;
+#line 8862 ""
} else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8863 ""
++numint;
+#line 8864 ""
++a1ll_2.iccount;
+#line 8865 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 8866 ""
if (numint == 1) {
+#line 8867 ""
if (i_nint(&fnum) > 30) {
+#line 8868 ""
i__4 = a1ll_2.iccount - 1;
+#line 8868 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__4, &i__5, "Magnitude of s"
- "lur height adjustment cannot exceed "
+#line 8868 ""
+ errmsg_(lineq, &i__4, &i__5, "Magnitude of s"\
+ "lur height adjustment cannot exceed "\
"30!", (ftnlen)128, (ftnlen)53);
+#line 8870 ""
stop1_();
+#line 8871 ""
}
+#line 8872 ""
} else if (numint == 2) {
+#line 8873 ""
if (dabs(fnum) > 6.3f) {
+#line 8874 ""
i__4 = a1ll_2.iccount - 1;
+#line 8874 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"
+#line 8874 ""
+ errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\
"ft must be in the range (-6.3,6.3)!",
(ftnlen)128, (ftnlen)49);
+#line 8876 ""
stop1_();
+#line 8877 ""
}
+#line 8878 ""
} else {
/* Third signed integer, must be a midslur or curve spec. */
+#line 8882 ""
if (dabs(fnum) > 31.f) {
+#line 8883 ""
i__4 = a1ll_2.iccount - 1;
+#line 8883 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__4, &i__5, "Slur midheight"
+#line 8883 ""
+ errmsg_(lineq, &i__4, &i__5, "Slur midheight"\
" must be in the range (-31,31)!", (
ftnlen)128, (ftnlen)45);
+#line 8885 ""
stop1_();
+#line 8886 ""
}
+#line 8887 ""
if (*(unsigned char *)durq == ':') {
/* Expecting curve parameters. Get two numbers */
+#line 8891 ""
for (i__ = 1; i__ <= 2; ++i__) {
+#line 8892 ""
++a1ll_2.iccount;
+#line 8893 ""
fnum = (real) (*(unsigned char *)&lineq[
a1ll_2.iccount - 1] - 48);
+#line 8894 ""
if ((r__1 = fnum - 3.5f, dabs(r__1)) >
3.6f) {
+#line 8895 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 8895 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4,
- "Slur curve parameter must "
+ "Slur curve parameter must "\
"be in range (0,7)!", (ftnlen)
128, (ftnlen)44);
+#line 8898 ""
stop1_();
+#line 8899 ""
}
+#line 8900 ""
/* L40: */
+#line 8900 ""
}
+#line 8901 ""
++a1ll_2.iccount;
+#line 8902 ""
}
+#line 8903 ""
}
+#line 8904 ""
--a1ll_2.iccount;
+#line 8905 ""
goto L15;
+#line 8907 ""
} 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 8912 ""
if (comslur_1.fontslur) {
+#line 8913 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "
- "use linebreak slur options with font-bas"
+#line 8913 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "\
+ "use linebreak slur options with font-bas"\
"ed slurs!", (ftnlen)128, (ftnlen)57);
+#line 8915 ""
stop1_();
+#line 8916 ""
}
+#line 8917 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8918 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 8919 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"
+#line 8919 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"\
"racter must be \"+\" or \"-\"!", (ftnlen)
128, (ftnlen)34);
+#line 8921 ""
stop1_();
+#line 8922 ""
}
+#line 8923 ""
++a1ll_2.iccount;
+#line 8924 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 8925 ""
if (i_nint(&fnum) > 30) {
+#line 8926 ""
i__4 = a1ll_2.iccount - 1;
+#line 8926 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "
+#line 8926 ""
+ errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "\
"height adjustment cannot exceed 30!", (
ftnlen)128, (ftnlen)53);
+#line 8928 ""
stop1_();
+#line 8929 ""
}
+#line 8930 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 8931 ""
++a1ll_2.iccount;
+#line 8932 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (
ftnlen)128, (ftnlen)1);
+#line 8933 ""
if (dabs(fnum) > 6.3f) {
+#line 8934 ""
i__4 = a1ll_2.iccount - 1;
+#line 8934 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"
+#line 8934 ""
+ errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\
"ft must be in range (-6.3,6.3)!", (
ftnlen)128, (ftnlen)45);
+#line 8936 ""
stop1_();
+#line 8937 ""
}
+#line 8938 ""
}
+#line 8939 ""
--a1ll_2.iccount;
+#line 8940 ""
goto L15;
+#line 8941 ""
} else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
+#line 8942 ""
i__4 = a1ll_2.iccount;
+#line 8942 ""
if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) == 0) {
+#line 8942 ""
++a1ll_2.iccount;
+#line 8942 ""
}
+#line 8944 ""
goto L15;
+#line 8945 ""
} else if (*(unsigned char *)dumq == 'p') {
/* local change in postscript slur/tie adjustment default */
+#line 8949 ""
if (comslur_1.fontslur) {
+#line 8950 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"
- " postscript slurs (\"Ap\") to use this o"
+#line 8950 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"\
+ " postscript slurs (\"Ap\") to use this o"\
"ption!", (ftnlen)128, (ftnlen)52);
+#line 8952 ""
stop1_();
+#line 8953 ""
}
+#line 8954 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8955 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 8956 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"
+#line 8956 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\
"ed \"+\" or \"-\" here!", (ftnlen)128, (
ftnlen)25);
+#line 8958 ""
stop1_();
+#line 8959 ""
}
+#line 8960 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 8961 ""
if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 8962 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"
+#line 8962 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\
"ed \"s\" or \"t\" here!", (ftnlen)128, (
ftnlen)25);
+#line 8964 ""
stop1_();
+#line 8965 ""
}
+#line 8966 ""
goto L15;
+#line 8967 ""
} else if (*(unsigned char *)dumq != ' ') {
+#line 8968 ""
ic = *(unsigned char *)dumq;
+#line 8969 ""
if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) {
+#line 8971 ""
if (iposn == 1) {
+#line 8972 ""
if (*(unsigned char *)durq == 't' &&
comslur_1.fontslur) {
+#line 8973 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 8973 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4,
- "Slur ID not allowed on non-post"
+ "Slur ID not allowed on non-post"\
"script tie!", (ftnlen)128, (
ftnlen)42);
+#line 8975 ""
stop1_();
+#line 8976 ""
+ }
+#line 8977 ""
+ i__4 = a1ll_2.iccount;
+#line 8977 ""
+ if (s_cmp(lineq + i__4, "x", a1ll_2.iccount +
+ 1 - i__4, (ftnlen)1) == 0) {
+#line 8977 ""
+ ++a1ll_2.iccount;
+#line 8977 ""
}
+#line 8979 ""
goto L15;
+#line 8980 ""
}
+#line 8981 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "
+#line 8981 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "\
"must be 2nd character in slur symbol!", (
ftnlen)128, (ftnlen)45);
+#line 8983 ""
stop1_();
+#line 8984 ""
}
+#line 8985 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
+#line 8985 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in slur symbol!", (ftnlen)128, (ftnlen)
33);
+#line 8987 ""
stop1_();
+#line 8988 ""
}
+#line 8989 ""
goto L110;
+#line 8990 ""
} else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, (
ftnlen)1) > 0) {
/* We have a figure. Only allow on 1st note of xtup */
+#line 8994 ""
if (itup != 2) {
+#line 8995 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"
+#line 8995 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"\
"up only allowed on 1st note!", (ftnlen)128, (
ftnlen)40);
+#line 8997 ""
stop1_();
+#line 8998 ""
} else if (*(unsigned char *)durq == 'x') {
+#line 8999 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "
+#line 8999 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "\
"figures in xtuplets!", (ftnlen)128, (ftnlen)
32);
+#line 9001 ""
stop1_();
+#line 9002 ""
}
+#line 9003 ""
if (compage_1.usefig && c1ommvl_1.ivx == 1) {
+#line 9003 ""
*ifig = 1;
+#line 9003 ""
}
+#line 9004 ""
L26:
+#line 9004 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
/* if (index('0123456789#-n_.:',durq) .gt. 0) then */
+#line 9006 ""
if (i_indx("0123456789#-n_.:v", durq, (ftnlen)17, (ftnlen)
1) > 0) {
+#line 9007 ""
goto L26;
+#line 9008 ""
} else if (*(unsigned char *)durq == 's') {
+#line 9009 ""
comligfont_1.isligfont = TRUE_;
+#line 9010 ""
goto L26;
+#line 9011 ""
} else if (*(unsigned char *)durq == '+') {
/* vertical offset, must be integer then blank */
+#line 9015 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 9016 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) !=
0) {
+#line 9017 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "
+#line 9017 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "\
"for vertical offset expected here!", (
ftnlen)128, (ftnlen)42);
+#line 9019 ""
stop1_();
+#line 9020 ""
}
+#line 9021 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 9022 ""
if (*(unsigned char *)durq != ' ') {
+#line 9023 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"
+#line 9023 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"\
" offset must terminate figure!", (ftnlen)
128, (ftnlen)38);
+#line 9025 ""
stop1_();
+#line 9026 ""
}
+#line 9027 ""
--a1ll_2.iccount;
+#line 9028 ""
goto L26;
+#line 9029 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 9030 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"
+#line 9030 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in figure in xtuplet!", (ftnlen)128, (
ftnlen)39);
+#line 9032 ""
stop1_();
+#line 9033 ""
}
+#line 9034 ""
goto L110;
+#line 9035 ""
} else if (*(unsigned char *)durq == 'G') {
+#line 9036 ""
ngr = 1;
+#line 9037 ""
L79:
+#line 9037 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (
ftnlen)1);
+#line 9038 ""
if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0)
{
+#line 9039 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 9040 ""
ngr = i_nint(&fnum);
+#line 9041 ""
--a1ll_2.iccount;
+#line 9042 ""
goto L79;
+#line 9043 ""
} else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1)
> 0) {
+#line 9044 ""
goto L79;
+#line 9045 ""
} else if (*(unsigned char *)charq == 'm') {
+#line 9046 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
+#line 9047 ""
if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0)
{
+#line 9048 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "
- "less than 5 must follow \"m\" in a grace"
+#line 9048 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "\
+ "less than 5 must follow \"m\" in a grace"\
" note!", (ftnlen)128, (ftnlen)52);
+#line 9050 ""
stop1_();
+#line 9051 ""
}
+#line 9052 ""
goto L79;
+#line 9053 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note */
+#line 9057 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
+#line 9058 ""
if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)
1) > 0) {
+#line 9059 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
+#line 9060 ""
--a1ll_2.iccount;
+#line 9061 ""
goto L79;
+#line 9062 ""
} else {
+#line 9063 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"
+#line 9063 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"\
" must follow \"X\" in a grace note!", (
ftnlen)128, (ftnlen)41);
+#line 9065 ""
stop1_();
+#line 9066 ""
}
+#line 9067 ""
}
/* At this point, charq is first note name in rest (grace?) */
+#line 9071 ""
i__4 = ngr;
+#line 9071 ""
for (igr = 1; igr <= i__4; ++igr) {
+#line 9072 ""
numnum = 0;
+#line 9073 ""
if (igr > 1) {
+#line 9074 ""
L75:
+#line 9074 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)
128, (ftnlen)1);
+#line 9075 ""
if (*(unsigned char *)charq == ' ') {
+#line 9075 ""
goto L75;
+#line 9075 ""
}
+#line 9076 ""
}
+#line 9077 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) ==
0) {
+#line 9078 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"
+#line 9078 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"\
", expected \"a\"-\"g\"!", (ftnlen)128, (
ftnlen)27);
+#line 9080 ""
stop1_();
+#line 9081 ""
}
+#line 9082 ""
L78:
+#line 9082 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
+#line 9083 ""
if (*(unsigned char *)charq != ' ') {
+#line 9084 ""
if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1)
> 0) {
+#line 9085 ""
if (numnum == 1) {
+#line 9086 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9086 ""
errmsg_(lineq, &a1ll_2.iccount, &i__5,
- "Only one of \"+-1234567\" allow"
+ "Only one of \"+-1234567\" allow"\
"ed here in grace!", (ftnlen)128, (
ftnlen)46);
+#line 9088 ""
stop1_();
+#line 9089 ""
}
+#line 9090 ""
numnum = 1;
+#line 9091 ""
goto L78;
+#line 9092 ""
} else if (i_indx("+-nfs", charq, (ftnlen)5, (
ftnlen)1) > 0) {
+#line 9093 ""
goto L78;
+#line 9094 ""
}
/* Digits are possible octave numbers */
+#line 9098 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "
+#line 9098 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "\
"character after note name in grace!", (
ftnlen)128, (ftnlen)43);
+#line 9100 ""
stop1_();
+#line 9101 ""
}
+#line 9102 ""
/* L71: */
+#line 9102 ""
}
+#line 9103 ""
goto L110;
+#line 9104 ""
} else /* if(complicated condition) */ {
+#line 9104 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 9104 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0])
{
+#line 9105 ""
chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
+#line 9106 ""
if (literr > 0) {
+#line 9107 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
+#line 9107 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + (
literr - 1) * 51, (ftnlen)128, (ftnlen)51)
;
+#line 9109 ""
stop1_();
+#line 9110 ""
}
+#line 9111 ""
goto L110;
+#line 9112 ""
} else if (*(unsigned char *)durq == '"') {
/* pmx lyric */
+#line 9116 ""
chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)
128);
+#line 9117 ""
if (lyrerr > 0) {
+#line 9118 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
+#line 9118 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + (
lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51)
;
+#line 9120 ""
stop1_();
+#line 9121 ""
}
+#line 9122 ""
goto L110;
+#line 9123 ""
} else if (*(unsigned char *)durq == 'M') {
/* Temporary trap until I get around putting this in pmxb */
+#line 9127 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"
+#line 9127 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"\
"et allowed in xtuplets!", (ftnlen)128, (
ftnlen)35);
+#line 9129 ""
stop1_();
+#line 9130 ""
} else if (*(unsigned char *)durq == 'X') {
+#line 9131 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9131 ""
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 9133 ""
goto L110;
+#line 9134 ""
} else if (*(unsigned char *)durq == 'z') {
/* Chord note in xtup. Read past for now. */
+#line 9138 ""
L33:
+#line 9138 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 9139 ""
if (*(unsigned char *)durq != ' ') {
+#line 9139 ""
goto L33;
+#line 9139 ""
}
+#line 9140 ""
goto L110;
+#line 9141 ""
} else if (*(unsigned char *)durq == 'D') {
/* Dynamic mark */
+#line 9145 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9145 ""
checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128);
+#line 9146 ""
goto L110;
+#line 9147 ""
} else if (*(unsigned char *)durq == '%') {
+#line 9148 ""
if (a1ll_2.iccount != 1) {
+#line 9149 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "
+#line 9149 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "\
"must have \"%\" in column 1!", (ftnlen)
128, (ftnlen)34);
+#line 9151 ""
stop1_();
+#line 9152 ""
}
+#line 9153 ""
a1ll_2.iccount = 128;
+#line 9154 ""
goto L110;
+#line 9155 ""
} else if (*(unsigned char *)durq == '?') {
+#line 9156 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 9157 ""
if (*(unsigned char *)durq == ' ') {
+#line 9158 ""
--a1ll_2.iccount;
+#line 9159 ""
goto L110;
+#line 9160 ""
}
+#line 9161 ""
if (*(unsigned char *)durq != '-') {
+#line 9162 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"
+#line 9162 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\
"g \"-\"", (ftnlen)128, (ftnlen)13);
+#line 9164 ""
stop1_();
+#line 9165 ""
}
+#line 9166 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 9167 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1)
== 0) {
+#line 9168 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"
+#line 9168 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\
"g number", (ftnlen)128, (ftnlen)16);
+#line 9170 ""
stop1_();
+#line 9171 ""
}
+#line 9172 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 9173 ""
--a1ll_2.iccount;
+#line 9174 ""
goto L110;
/* 140215 Allow clef change inside xtup */
+#line 9178 ""
} else if (*(unsigned char *)durq == 'C') {
+#line 9179 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 9180 ""
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 9183 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"
+#line 9183 ""
+ 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 9185 ""
stop1_();
+#line 9186 ""
}
/* gotclef = .true. */
+#line 9188 ""
goto L110;
/* +++ */
+#line 9190 ""
} else /* if(complicated condition) */ {
+#line 9190 ""
i__4 = a1ll_2.iccount;
+#line 9190 ""
i__5 = a1ll_2.iccount + 1;
+#line 9190 ""
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 9192 ""
a1ll_2.iccount += 2;
+#line 9193 ""
goto L110;
/* +++ */
+#line 9195 ""
}
+#line 9195 ""
}
+#line 9195 ""
}
/* End of xtup options. At this point symbol can only be note or rest */
+#line 9199 ""
if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) {
+#line 9200 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"
+#line 9200 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"\
"aracter is not allowed!", (ftnlen)128, (ftnlen)39)
;
+#line 9202 ""
stop1_();
-/* else if (durq.eq.'r' .and. itup.eq.ntup) then */
-/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
-/* * 'Sorry, PMX cannot end an xtuplet with a rest!') */
-/* call stop1() */
- } else /* if(complicated condition) */ {
- i__4 = a1ll_2.iccount;
- if (*(unsigned char *)durq == 'r' && itup == ntup &&
- i_indx(lineq + i__4, "b", a1ll_2.iccount + 2 -
- i__4, (ftnlen)1) == 0) {
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Sorry, PMX c"
- "annot end an xtuplet with a non-blank rest!",
- (ftnlen)128, (ftnlen)55);
- stop1_();
- }
+#line 9203 ""
}
+#line 9204 ""
L7:
+#line 9204 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
- if (i_indx("2345678ulcb", durq, (ftnlen)11, (ftnlen)1) > 0) {
+/* if (index('2345678ulcb',durq) .gt. 0) then */
+#line 9206 ""
+ if (i_indx("12345678ulcb", durq, (ftnlen)12, (ftnlen)1) > 0) {
+#line 9207 ""
goto L7;
+#line 9208 ""
} else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */
+#line 9212 ""
i__4 = a1ll_2.iccount;
+#line 9212 ""
if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, (
ftnlen)1) == 0) {
+#line 9212 ""
++a1ll_2.iccount;
+#line 9212 ""
}
+#line 9213 ""
goto L7;
+#line 9214 ""
} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
/* May have either octave jump or shifted accid. on main xtup note */
+#line 9218 ""
i__4 = a1ll_2.iccount;
+#line 9218 ""
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 9218 ""
goto L7;
+#line 9218 ""
}
+#line 9221 ""
++a1ll_2.iccount;
+#line 9222 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 9223 ""
--a1ll_2.iccount;
+#line 9224 ""
goto L7;
+#line 9225 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double an xtup note to make an unequal xtup */
+#line 9229 ""
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 9230 ""
++ndoub;
+#line 9231 ""
goto L7;
+#line 9232 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 9233 ""
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 9234 ""
goto L7;
+#line 9235 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 9236 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"
+#line 9236 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"\
"n xtuplet note!", (ftnlen)128, (ftnlen)31);
+#line 9238 ""
stop1_();
+#line 9239 ""
}
+#line 9240 ""
if (itup == ntup - ndoub) {
+#line 9240 ""
goto L3;
+#line 9240 ""
}
+#line 9241 ""
/* L6: */
+#line 9241 ""
}
+#line 9242 ""
L3:
/* 6==End of loop for xtuplet input */
+#line 9246 ""
;
+#line 9246 ""
} else if (*(unsigned char *)durq == 'm') {
/* Multi-bar rest: next 1 or two digits are # of bars. */
+#line 9250 ""
if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) {
+#line 9251 ""
i__1 = a1ll_2.iccount - 1;
+#line 9251 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"
+#line 9251 ""
+ errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"\
"ginning of bar!", (ftnlen)128, (ftnlen)45);
+#line 9253 ""
stop1_();
+#line 9254 ""
} else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) {
+#line 9255 ""
i__1 = a1ll_2.iccount - 1;
+#line 9255 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"
+#line 9255 ""
+ errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"\
"ime per block!", (ftnlen)128, (ftnlen)44);
+#line 9257 ""
stop1_();
+#line 9258 ""
}
/* For some purposes, pretend its one bar only */
+#line 9262 ""
a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] =
a1ll_2.lenbar;
+#line 9263 ""
c1omnotes_1.ibarmbr = a1ll_2.nbars + 1;
+#line 9264 ""
c1omnotes_1.mbrest = 0;
/* 20 call g1etchar(lineq,iccount,durq) */
+#line 9266 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9267 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 9268 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "
+#line 9268 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "\
"after \"rm\"!", (ftnlen)128, (ftnlen)31);
+#line 9270 ""
stop1_();
+#line 9271 ""
}
+#line 9272 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9273 ""
c1omnotes_1.mbrest = i_nint(&fnum);
+#line 9274 ""
--a1ll_2.iccount;
/* if (ichar(durq).ge.48.and.ichar(durq).le.57) then */
/* mbrest = 10*mbrest+ichar(durq)-48 */
/* go to 20 */
/* end if */
+#line 9279 ""
if (a1ll_2.nv > 1) {
+#line 9280 ""
if (a1ll_2.iv == 1) {
+#line 9281 ""
comkeys_1.mbrestsav = c1omnotes_1.mbrest;
+#line 9282 ""
} else {
+#line 9283 ""
if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) {
+#line 9284 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"
+#line 9284 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"\
"ame multi-bar rest in every voice!", (ftnlen)
128, (ftnlen)46);
+#line 9286 ""
stop1_();
+#line 9287 ""
}
+#line 9288 ""
}
/* Zero out mbrestsav so can check at end of input block whether */
/* all voices have one */
+#line 9293 ""
if (a1ll_2.iv == a1ll_2.nv) {
+#line 9293 ""
comkeys_1.mbrestsav = 0;
+#line 9293 ""
}
+#line 9294 ""
}
+#line 9295 ""
if (*(unsigned char *)durq != ' ') {
+#line 9296 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
+#line 9296 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
"ter \"rm\"!", (ftnlen)128, (ftnlen)29);
+#line 9298 ""
stop1_();
+#line 9299 ""
}
+#line 9300 ""
} 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 9305 ""
idotform = 1;
+#line 9306 ""
} else if (*(unsigned char *)durq == ',') {
+#line 9307 ""
idotform = 3;
/* Now flow to duration setting, as if durq=' ' */
+#line 9311 ""
} else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Suppress full bar rest, or look left for height */
+#line 9315 ""
if (*(unsigned char *)charq != 'r') {
+#line 9316 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "
+#line 9316 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "\
"only legal for rest, not note!", (ftnlen)128, (ftnlen)
46);
+#line 9318 ""
stop1_();
+#line 9319 ""
}
+#line 9320 ""
goto L2;
+#line 9321 ""
} 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 9326 ""
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 9327 ""
goto L2;
+#line 9328 ""
} else if (*(unsigned char *)durq == 'A') {
/* Main note accidental option */
+#line 9332 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9333 ""
if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 9334 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""
+#line 9334 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""\
"<\",\">\" are the only legal options here!", (ftnlen)
128, (ftnlen)51);
+#line 9336 ""
stop1_();
+#line 9337 ""
}
/* Need more stuff here */
+#line 9341 ""
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 9346 ""
--a1ll_2.iccount;
+#line 9347 ""
}
+#line 9348 ""
goto L2;
+#line 9349 ""
+ } else if (*(unsigned char *)durq == 'T') {
+
+/* Single stem tremolo. Only option (optional) is 1,2,3, or 4. */
+
+#line 9353 ""
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9354 ""
+ if (i_indx("1234", durq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 9354 ""
+ --a1ll_2.iccount;
+#line 9354 ""
+ }
+#line 9355 ""
+ goto L2;
+#line 9356 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 9357 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
+#line 9357 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", (
ftnlen)128, (ftnlen)18);
- s_wsle(&io___623);
+#line 9359 ""
+ s_wsle(&io___654);
+#line 9359 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 9359 ""
i__1 = *(unsigned char *)durq;
+#line 9359 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 9359 ""
e_wsle();
+#line 9360 ""
stop1_();
+#line 9361 ""
}
/* End of block for note options. */
/* Set the duration */
+#line 9367 ""
if (idotform > 0) {
+#line 9368 ""
if (idotform == 1) {
+#line 9369 ""
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 9370 ""
} else if (idotform == 2) {
+#line 9371 ""
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 9372 ""
} else if (idotform == 3) {
+#line 9373 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (
ftnlen)1);
+#line 9374 ""
} else if (idotform == 4) {
+#line 9375 ""
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 9376 ""
}
+#line 9377 ""
} else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) {
+#line 9378 ""
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 9382 ""
if (c1omnotes_1.iddot == 1) {
+#line 9383 ""
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 9384 ""
c1omnotes_1.iddot = 0;
+#line 9385 ""
}
+#line 9386 ""
} else if (fulbrp) {
+#line 9387 ""
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 9391 ""
i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48;
+#line 9391 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 9391 ""
c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, (
ftnlen)1) - 1;
+#line 9393 ""
fulbrp = FALSE_;
+#line 9394 ""
}
+#line 9395 ""
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 9399 ""
if (c1omget_1.fbon) {
+#line 9400 ""
if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] < 16) {
+#line 9400 ""
goto L120;
+#line 9400 ""
}
+#line 9401 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) {
+#line 9402 ""
if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx -
1] - 1) * 24 - 25] == 0) {
+#line 9402 ""
goto L120;
+#line 9402 ""
}
+#line 9403 ""
}
+#line 9404 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"
+#line 9404 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"\
"ed beam!", (ftnlen)128, (ftnlen)32);
+#line 9406 ""
stop1_();
+#line 9407 ""
}
+#line 9408 ""
L120:
/* Get number of prior bars for later check on whether note spans bar line */
+#line 9412 ""
nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
+#line 9413 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx +
a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25];
+#line 9414 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) {
+#line 9415 ""
++a1ll_2.nbars;
+#line 9416 ""
if (comkeys_1.shifton) {
+#line 9416 ""
comkeys_1.barend = TRUE_;
+#line 9416 ""
}
/* Will check barend when 1st note of next bar is entered. */
+#line 9420 ""
if (a1ll_2.nbars > 15) {
+#line 9421 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"
+#line 9421 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"\
"n 15 bars in an input block!", (ftnlen)128, (ftnlen)
48);
+#line 9423 ""
stop1_();
+#line 9424 ""
}
+#line 9425 ""
a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[
c1ommvl_1.ivx - 1];
+#line 9426 ""
if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) {
/* Just finished the pickup bar for this voice. */
+#line 9430 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) {
+#line 9431 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"
+#line 9431 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"\
"h disagrees with mtrnum0!", (ftnlen)128, (ftnlen)
41);
+#line 9433 ""
stop1_();
+#line 9434 ""
}
+#line 9435 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
+#line 9436 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
+#line 9437 ""
}
+#line 9438 ""
} else if (comkeys_1.barend) {
+#line 9439 ""
if (comkeys_1.shifton) {
+#line 9440 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
+#line 9440 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
"defined shift still on!", (ftnlen)128, (ftnlen)43);
+#line 9442 ""
stop1_();
+#line 9443 ""
}
+#line 9444 ""
comkeys_1.barend = FALSE_;
+#line 9445 ""
} else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) {
+#line 9446 ""
i__1 = a1ll_2.iccount - 1;
+#line 9446 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
+#line 9446 ""
errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", (
ftnlen)128, (ftnlen)27);
+#line 9448 ""
stop1_();
+#line 9449 ""
}
+#line 9450 ""
if (idotform == 1 || idotform == 3) {
+#line 9451 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9452 ""
if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) {
+#line 9453 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"
+#line 9453 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"\
"r \"r\" here!", (ftnlen)128, (ftnlen)31);
+#line 9455 ""
stop1_();
+#line 9456 ""
}
+#line 9457 ""
++idotform;
+#line 9458 ""
numnum = 1;
+#line 9459 ""
goto L28;
+#line 9460 ""
}
/* End of sub block for note-rest */
+#line 9464 ""
} else if (*(unsigned char *)charq == 'z') {
+#line 9465 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9466 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
+#line 9467 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"
+#line 9467 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"\
" here!", (ftnlen)128, (ftnlen)30);
+#line 9469 ""
stop1_();
+#line 9470 ""
}
+#line 9471 ""
L25:
+#line 9471 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
/* if (index('dre12345678',durq) .gt. 0) then */
+#line 9473 ""
if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) {
+#line 9474 ""
goto L25;
+#line 9475 ""
} 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 9480 ""
i__1 = a1ll_2.iccount;
+#line 9480 ""
if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
+#line 9480 ""
++a1ll_2.iccount;
+#line 9480 ""
}
+#line 9481 ""
goto L25;
+#line 9482 ""
} else if (*(unsigned char *)durq == 'A') {
+#line 9483 ""
i__1 = a1ll_2.iccount - 2;
+#line 9483 ""
if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 -
i__1) == 0) {
+#line 9484 ""
i__1 = a1ll_2.iccount - 1;
+#line 9484 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""
+#line 9484 ""
+ errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""\
"A\" in chord note!", (ftnlen)128, (ftnlen)43);
+#line 9486 ""
stop1_();
+#line 9487 ""
}
+#line 9488 ""
goto L25;
+#line 9489 ""
} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9490 ""
i__1 = a1ll_2.iccount - 2;
+#line 9490 ""
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 9492 ""
i__1 = a1ll_2.iccount - 1;
+#line 9492 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"
+#line 9492 ""
+ errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"\
" \"<\" or \">\"!", (ftnlen)128, (ftnlen)38);
+#line 9494 ""
stop1_();
+#line 9495 ""
}
+#line 9496 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9497 ""
if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 9498 ""
i__1 = a1ll_2.iccount - 1;
+#line 9498 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"
+#line 9498 ""
+ errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"\
"e for accidental shift!", (ftnlen)128, (ftnlen)53);
+#line 9500 ""
stop1_();
+#line 9501 ""
}
+#line 9502 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9503 ""
--a1ll_2.iccount;
+#line 9504 ""
goto L25;
+#line 9505 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9506 ""
i__1 = a1ll_2.iccount;
+#line 9506 ""
if (i_indx("1234567890.", lineq + i__1, (ftnlen)11,
a1ll_2.iccount + 1 - i__1) == 0) {
+#line 9506 ""
goto L25;
+#line 9506 ""
}
/* Number or '.' (durq) follows +/- . Get it. */
+#line 9511 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9512 ""
i__1 = a1ll_2.iccount;
+#line 9512 ""
if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq +
i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) {
+#line 9514 ""
i__1 = a1ll_2.iccount - 1;
+#line 9514 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"
+#line 9514 ""
+ errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"\
" a digit!", (ftnlen)128, (ftnlen)37);
+#line 9516 ""
stop1_();
+#line 9517 ""
} else /* if(complicated condition) */ {
+#line 9517 ""
i__1 = a1ll_2.iccount - 3;
+#line 9517 ""
if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount -
2 - i__1) == 0) {
+#line 9518 ""
i__1 = a1ll_2.iccount - 1;
+#line 9518 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"
+#line 9518 ""
+ errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"\
"ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41);
+#line 9520 ""
stop1_();
+#line 9521 ""
}
+#line 9521 ""
}
+#line 9522 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9523 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 9524 ""
--a1ll_2.iccount;
+#line 9525 ""
goto L25;
+#line 9526 ""
}
/* 2nd +/- */
+#line 9530 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9531 ""
if (*(unsigned char *)durq == '.') {
+#line 9531 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 9531 ""
}
+#line 9532 ""
if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 9533 ""
i__1 = a1ll_2.iccount - 1;
+#line 9533 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9533 ""
errmsg_(lineq, &i__1, &i__4, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
+#line 9535 ""
stop1_();
+#line 9536 ""
}
+#line 9537 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9538 ""
--a1ll_2.iccount;
+#line 9539 ""
goto L25;
+#line 9540 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 9541 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"
+#line 9541 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"\
"rd note!", (ftnlen)128, (ftnlen)32);
+#line 9543 ""
stop1_();
+#line 9544 ""
}
+#line 9545 ""
} else if (*(unsigned char *)charq == 'G') {
+#line 9546 ""
ngr = 1;
+#line 9547 ""
L9:
+#line 9547 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9548 ""
if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
+#line 9549 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9550 ""
ngr = i_nint(&fnum);
+#line 9551 ""
--a1ll_2.iccount;
+#line 9552 ""
goto L9;
+#line 9553 ""
} else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 9554 ""
goto L9;
+#line 9555 ""
} else if (*(unsigned char *)charq == 'm') {
+#line 9556 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9557 ""
if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 9558 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "
+#line 9558 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "\
"must follow \"m\" in a grace note!", (ftnlen)128, (
ftnlen)52);
+#line 9560 ""
stop1_();
+#line 9561 ""
}
+#line 9562 ""
goto L9;
+#line 9563 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note */
+#line 9567 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9568 ""
if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) {
+#line 9569 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9570 ""
--a1ll_2.iccount;
+#line 9571 ""
goto L9;
+#line 9572 ""
} else {
+#line 9573 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"
+#line 9573 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"\
"ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41);
+#line 9575 ""
stop1_();
+#line 9576 ""
}
+#line 9577 ""
}
/* At this point, charq is first note name in rest (grace?) */
+#line 9581 ""
i__1 = ngr;
+#line 9581 ""
for (igr = 1; igr <= i__1; ++igr) {
+#line 9582 ""
numnum = 0;
+#line 9583 ""
if (igr > 1) {
+#line 9584 ""
L55:
+#line 9584 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
1);
+#line 9585 ""
if (*(unsigned char *)charq == ' ') {
+#line 9585 ""
goto L55;
+#line 9585 ""
}
+#line 9586 ""
}
+#line 9587 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
+#line 9588 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"
+#line 9588 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"\
" \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27);
+#line 9590 ""
stop1_();
+#line 9591 ""
}
+#line 9592 ""
L18:
+#line 9592 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9593 ""
if (*(unsigned char *)charq != ' ') {
+#line 9594 ""
if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) {
+#line 9595 ""
if (numnum == 1) {
+#line 9596 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"
+#line 9596 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"\
" \"+-1234567\" allowed here in grace!", (
ftnlen)128, (ftnlen)46);
+#line 9598 ""
stop1_();
+#line 9599 ""
}
+#line 9600 ""
numnum = 1;
+#line 9601 ""
goto L18;
/* else if (index('nfs',charq) .gt. 0) then */
+#line 9603 ""
} else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) {
+#line 9604 ""
goto L18;
+#line 9605 ""
}
/* Digits are possible octave numbers */
+#line 9609 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"
+#line 9609 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"\
"ter note name in grace!", (ftnlen)128, (ftnlen)43);
+#line 9611 ""
stop1_();
+#line 9612 ""
}
+#line 9613 ""
/* L19: */
+#line 9613 ""
}
+#line 9614 ""
} else /* if(complicated condition) */ {
+#line 9614 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 9614 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) {
+#line 9615 ""
chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
+#line 9616 ""
if (literr > 0) {
+#line 9617 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9617 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) *
51, (ftnlen)128, (ftnlen)51);
+#line 9619 ""
stop1_();
+#line 9620 ""
}
+#line 9621 ""
} else if (*(unsigned char *)charq == '"') {
/* pmx lyric */
+#line 9625 ""
chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128);
+#line 9626 ""
if (lyrerr > 0) {
+#line 9627 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9627 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - 1) *
51, (ftnlen)128, (ftnlen)51);
+#line 9629 ""
stop1_();
+#line 9630 ""
}
+#line 9631 ""
} else if (*(unsigned char *)charq == 'o') {
/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */
+#line 9635 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
+#line 9636 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"
+#line 9636 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"\
"e input block, after affected note!", (ftnlen)128, (
ftnlen)53);
+#line 9638 ""
stop1_();
+#line 9639 ""
}
+#line 9640 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */
+#line 9642 ""
if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (ftnlen)1)
== 0) {
+#line 9643 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9643 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", (
ftnlen)128, (ftnlen)17);
+#line 9645 ""
stop1_();
+#line 9646 ""
}
+#line 9647 ""
if (*(unsigned char *)dumq == ':') {
+#line 9648 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9649 ""
if (*(unsigned char *)dumq != ' ') {
+#line 9650 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"
+#line 9650 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"\
"fter \"o:\"!", (ftnlen)128, (ftnlen)26);
+#line 9652 ""
stop1_();
+#line 9653 ""
} else if (! comkeys_1.ornrpt) {
+#line 9654 ""
i__1 = a1ll_2.iccount - 1;
+#line 9654 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"
+#line 9654 ""
+ errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"\
"nts before they were on!", (ftnlen)128, (ftnlen)
50);
+#line 9656 ""
stop1_();
+#line 9657 ""
}
+#line 9658 ""
comkeys_1.ornrpt = FALSE_;
+#line 9659 ""
} else if (*(unsigned char *)dumq == 'g') {
+#line 9660 ""
if (c1omget_1.issegno) {
+#line 9661 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"
+#line 9661 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"\
" \"segno\" per input block!", (ftnlen)128, (
ftnlen)40);
+#line 9663 ""
stop1_();
+#line 9664 ""
} else if (c1ommvl_1.ivx != 1) {
+#line 9665 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"
+#line 9665 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"\
"e in voice 1!", (ftnlen)128, (ftnlen)29);
+#line 9667 ""
stop1_();
+#line 9668 ""
}
+#line 9669 ""
c1omget_1.issegno = TRUE_;
+#line 9670 ""
L12:
+#line 9670 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9671 ""
if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >=
48 && *(unsigned char *)dumq <= 58) {
+#line 9671 ""
goto L12;
+#line 9671 ""
}
+#line 9673 ""
if (*(unsigned char *)dumq != ' ') {
+#line 9674 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 9674 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r in segno ornament symbol!", (ftnlen)128, (
ftnlen)43);
+#line 9676 ""
stop1_();
+#line 9677 ""
}
+#line 9678 ""
} else if (*(unsigned char *)dumq == 'T') {
/* Trill. may be followed by 't' and/or number. read 'til blank */
+#line 9682 ""
L22:
+#line 9682 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9683 ""
if (*(unsigned char *)dumq == ':') {
+#line 9684 ""
i__1 = a1ll_2.iccount;
+#line 9684 ""
if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) != 0) {
+#line 9685 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"
+#line 9685 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\
"nk after \":\"!", (ftnlen)128, (ftnlen)25);
+#line 9687 ""
stop1_();
+#line 9688 ""
}
+#line 9689 ""
goto L32;
+#line 9690 ""
} else if (*(unsigned char *)dumq != ' ') {
+#line 9691 ""
goto L22;
+#line 9692 ""
}
+#line 9693 ""
} else if (*(unsigned char *)dumq == 'f') {
+#line 9694 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9695 ""
if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) {
+#line 9696 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 9696 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after \"f\" in fermata ornament symbol!", (
ftnlen)128, (ftnlen)55);
+#line 9698 ""
stop1_();
+#line 9699 ""
}
+#line 9700 ""
if (*(unsigned char *)dumq == 'd') {
+#line 9700 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 9700 ""
}
+#line 9701 ""
if (*(unsigned char *)dumq == ':') {
+#line 9701 ""
goto L32;
+#line 9701 ""
}
+#line 9702 ""
} else if (*(unsigned char *)dumq == 'e') {
+#line 9703 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9704 ""
if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 9705 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 9705 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after \"e\" in edit. accid. symbol!", (ftnlen)
128, (ftnlen)51);
+#line 9707 ""
stop1_();
+#line 9708 ""
}
+#line 9709 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9710 ""
if (*(unsigned char *)dumq == '?') {
+#line 9710 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 9710 ""
}
+#line 9711 ""
} else {
+#line 9712 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9713 ""
}
+#line 9714 ""
if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 9715 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
+#line 9715 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
" ornament symbol!", (ftnlen)128, (ftnlen)37);
+#line 9717 ""
stop1_();
+#line 9718 ""
}
+#line 9719 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9720 ""
i__1 = a1ll_2.iccount;
+#line 9720 ""
if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
a1ll_2.iccount + 1 - i__1) == 0) {
+#line 9721 ""
i__1 = a1ll_2.iccount + 1;
+#line 9721 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "There should be an integer"
+#line 9721 ""
+ errmsg_(lineq, &i__1, &i__4, "There should be an integer"\
" here!", (ftnlen)128, (ftnlen)32);
+#line 9723 ""
stop1_();
+#line 9724 ""
}
+#line 9725 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9726 ""
if (*(unsigned char *)durq == ':') {
+#line 9727 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"
+#line 9727 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"\
" repeat an ornament!", (ftnlen)128, (ftnlen)36);
+#line 9729 ""
stop1_();
+#line 9730 ""
}
/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */
+#line 9734 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9735 ""
i__1 = a1ll_2.iccount;
+#line 9735 ""
if (i_indx(".0123456789", lineq + i__1, (ftnlen)11,
a1ll_2.iccount + 1 - i__1) == 0) {
+#line 9737 ""
i__1 = a1ll_2.iccount + 1;
+#line 9737 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "There should be a numb"
+#line 9737 ""
+ errmsg_(lineq, &i__1, &i__4, "There should be a numb"\
"er here!", (ftnlen)128, (ftnlen)30);
+#line 9739 ""
stop1_();
+#line 9740 ""
}
+#line 9741 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 9742 ""
}
+#line 9743 ""
}
+#line 9744 ""
L32:
+#line 9745 ""
if (*(unsigned char *)dumq == ':') {
+#line 9746 ""
i__1 = a1ll_2.iccount;
+#line 9746 ""
if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) != 0) {
+#line 9747 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"
+#line 9747 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"\
"llowed by blank in \"o: \"!", (ftnlen)128, (
ftnlen)39);
+#line 9749 ""
stop1_();
+#line 9750 ""
} else if (comkeys_1.ornrpt) {
+#line 9751 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"
+#line 9751 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"\
"ed ornaments but already on!", (ftnlen)128, (
ftnlen)44);
+#line 9753 ""
stop1_();
+#line 9754 ""
}
+#line 9755 ""
comkeys_1.ornrpt = TRUE_;
+#line 9756 ""
}
+#line 9757 ""
} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 9758 ""
numint = 0;
+#line 9759 ""
iposn = 0;
+#line 9760 ""
L8:
+#line 9760 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
+#line 9761 ""
++iposn;
+#line 9762 ""
if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq ==
't') {
+#line 9763 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "
+#line 9763 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "\
"an option on a tie!", (ftnlen)128, (ftnlen)37);
+#line 9765 ""
stop1_();
+#line 9766 ""
}
+#line 9767 ""
if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == 0) {
/* Check for explicit ID code. */
+#line 9771 ""
ic = *(unsigned char *)dumq;
+#line 9772 ""
if (ic < 48 || ic > 57 && ic < 65 || ic > 90) {
/* Not 0-9 or A-Z, so exit */
+#line 9777 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 9777 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r in slur symbol!", (ftnlen)128, (ftnlen)33);
+#line 9779 ""
stop1_();
+#line 9780 ""
} else {
/* It is a possible ID code. Right place? */
+#line 9784 ""
if (iposn != 1) {
/* Slur ID is not 2nd! */
+#line 9788 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"
+#line 9788 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"\
" be second character in slur symbol!", (
ftnlen)128, (ftnlen)48);
+#line 9790 ""
stop1_();
+#line 9791 ""
} else if (*(unsigned char *)charq == 't' &&
comslur_1.fontslur) {
+#line 9792 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "
+#line 9792 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "\
"allowed on non-postscript tie!", (ftnlen)128,
(ftnlen)42);
+#line 9794 ""
stop1_();
+#line 9795 ""
+ } else /* if(complicated condition) */ {
+#line 9795 ""
+ i__1 = a1ll_2.iccount;
+#line 9795 ""
+ if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 -
+ i__1, (ftnlen)1) == 0) {
+#line 9796 ""
+ ++a1ll_2.iccount;
+#line 9797 ""
+ }
+#line 9797 ""
}
+#line 9798 ""
}
/* Slur ID is OK. Note it cannot be "H" at this point.. */
+#line 9802 ""
goto L8;
+#line 9803 ""
} else if (*(unsigned char *)dumq == 'H') {
+#line 9804 ""
if (iposn == 1) {
+#line 9804 ""
goto L8;
+#line 9804 ""
}
/* "H" is NOT an ID code. */
+#line 9808 ""
if (! comslur_1.fontslur && *(unsigned char *)charq == 't') {
+#line 9809 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"
+#line 9809 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"\
"ostscript ties this way!", (ftnlen)128, (ftnlen)
40);
+#line 9811 ""
stop1_();
+#line 9812 ""
}
+#line 9813 ""
i__1 = a1ll_2.iccount;
+#line 9813 ""
if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) == 0) {
+#line 9814 ""
++a1ll_2.iccount;
+#line 9815 ""
++iposn;
+#line 9816 ""
}
+#line 9817 ""
goto L8;
+#line 9818 ""
} else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && !
comslur_1.fontslur && *(unsigned char *)charq == 't') {
/* 3/9/03 Can't reshape postscript tie. */
+#line 9823 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"
+#line 9823 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"\
"cript ties this way!", (ftnlen)128, (ftnlen)40);
+#line 9825 ""
stop1_();
+#line 9826 ""
} else if (*(unsigned char *)dumq == 'p') {
/* local change in postscript slur/tie adjustment default */
+#line 9830 ""
if (comslur_1.fontslur) {
+#line 9831 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"
+#line 9831 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"\
"ipt slurs (\"Ap\") to use this option!", (ftnlen)
128, (ftnlen)52);
+#line 9833 ""
stop1_();
+#line 9834 ""
}
+#line 9835 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9836 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 9837 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"
+#line 9837 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"\
"r \"-\" here!", (ftnlen)128, (ftnlen)25);
+#line 9839 ""
stop1_();
+#line 9840 ""
}
+#line 9841 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9842 ""
if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 9843 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"
+#line 9843 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"\
"r \"t\" here!", (ftnlen)128, (ftnlen)25);
+#line 9845 ""
stop1_();
+#line 9846 ""
}
+#line 9847 ""
iposn += 2;
+#line 9848 ""
goto L8;
+#line 9849 ""
}
+#line 9850 ""
if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) {
+#line 9851 ""
goto L8;
+#line 9852 ""
} else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9853 ""
++numint;
+#line 9854 ""
if (comslur_1.fontslur && *(unsigned char *)charq == 't') {
+#line 9855 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"
+#line 9855 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"\
" height only allowed in \"s\"-slurs!", (ftnlen)
128, (ftnlen)48);
+#line 9857 ""
stop1_();
+#line 9858 ""
}
+#line 9859 ""
++a1ll_2.iccount;
+#line 9860 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9861 ""
if (numint == 1) {
+#line 9862 ""
if (i_nint(&fnum) > 30) {
+#line 9863 ""
i__1 = a1ll_2.iccount - 1;
+#line 9863 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"
+#line 9863 ""
+ errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\
"ht adjustment cannot exceed 30!", (ftnlen)128,
(ftnlen)53);
+#line 9865 ""
stop1_();
+#line 9866 ""
}
+#line 9867 ""
} else if (numint == 2) {
+#line 9868 ""
if (dabs(fnum) > 6.3f) {
+#line 9869 ""
i__1 = a1ll_2.iccount - 1;
+#line 9869 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "
+#line 9869 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\
"be in range (-6.3,6.3)!", (ftnlen)128, (
ftnlen)45);
+#line 9871 ""
stop1_();
+#line 9872 ""
}
+#line 9873 ""
} else {
/* Third signed integer, must be a midslur or curve spec. */
+#line 9877 ""
if (dabs(fnum) > 31.f) {
+#line 9878 ""
i__1 = a1ll_2.iccount - 1;
+#line 9878 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"
+#line 9878 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"\
" in the range (-31,31)!", (ftnlen)128, (
ftnlen)45);
+#line 9880 ""
stop1_();
+#line 9881 ""
}
+#line 9882 ""
if (*(unsigned char *)durq == ':') {
/* Expecting curve parameters. Get two numbers */
+#line 9886 ""
for (i__ = 1; i__ <= 2; ++i__) {
+#line 9887 ""
++a1ll_2.iccount;
+#line 9888 ""
fnum = (real) (*(unsigned char *)&lineq[
a1ll_2.iccount - 1] - 48);
+#line 9889 ""
if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) {
+#line 9890 ""
i__1 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"
- " curve parameter must be in range (0"
+#line 9890 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"\
+ " curve parameter must be in range (0"\
",7)!", (ftnlen)128, (ftnlen)44);
+#line 9892 ""
stop1_();
+#line 9893 ""
}
+#line 9894 ""
/* L41: */
+#line 9894 ""
}
+#line 9895 ""
++a1ll_2.iccount;
+#line 9896 ""
}
+#line 9897 ""
}
+#line 9898 ""
--a1ll_2.iccount;
+#line 9899 ""
goto L8;
+#line 9900 ""
} 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 9905 ""
if (comslur_1.fontslur) {
+#line 9906 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"
+#line 9906 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"\
"break slur options with font-based slurs!", (
ftnlen)128, (ftnlen)57);
+#line 9908 ""
stop1_();
+#line 9909 ""
}
+#line 9910 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
1);
+#line 9911 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 9912 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"
+#line 9912 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"\
"ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34);
+#line 9914 ""
stop1_();
+#line 9915 ""
}
+#line 9916 ""
++a1ll_2.iccount;
+#line 9917 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9918 ""
if (i_nint(&fnum) > 30) {
+#line 9919 ""
i__1 = a1ll_2.iccount - 1;
+#line 9919 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"
+#line 9919 ""
+ errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"\
"djustment cannot exceed 30!", (ftnlen)128, (
ftnlen)53);
+#line 9921 ""
stop1_();
+#line 9922 ""
}
+#line 9923 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 9924 ""
++a1ll_2.iccount;
+#line 9925 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 9926 ""
if (dabs(fnum) > 6.3f) {
+#line 9927 ""
i__1 = a1ll_2.iccount - 1;
+#line 9927 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "
+#line 9927 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\
"be in range (-6.3,6.3)!", (ftnlen)128, (
ftnlen)45);
+#line 9929 ""
stop1_();
+#line 9930 ""
}
+#line 9931 ""
}
+#line 9932 ""
--a1ll_2.iccount;
+#line 9933 ""
goto L8;
+#line 9934 ""
} else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
+#line 9935 ""
i__1 = a1ll_2.iccount;
+#line 9935 ""
if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) == 0) {
+#line 9935 ""
++a1ll_2.iccount;
+#line 9935 ""
}
+#line 9936 ""
goto L8;
+#line 9937 ""
}
+#line 9938 ""
} else if (*(unsigned char *)charq == '?') {
+#line 9939 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 9940 ""
if (*(unsigned char *)durq == ' ') {
+#line 9941 ""
--a1ll_2.iccount;
+#line 9942 ""
} else {
+#line 9943 ""
if (*(unsigned char *)durq != '-') {
+#line 9944 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9944 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!",
(ftnlen)128, (ftnlen)14);
+#line 9946 ""
stop1_();
+#line 9947 ""
}
+#line 9948 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
;
+#line 9949 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 9950 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 9950 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!"
, (ftnlen)128, (ftnlen)17);
+#line 9952 ""
stop1_();
+#line 9953 ""
}
+#line 9954 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9955 ""
--a1ll_2.iccount;
+#line 9956 ""
}
+#line 9957 ""
} 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 9962 ""
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 9967 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"
+#line 9967 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"\
"fore first note in block!", (ftnlen)128, (ftnlen)45);
+#line 9969 ""
stop1_();
+#line 9970 ""
}
+#line 9971 ""
if (*(unsigned char *)charq == 'x') {
+#line 9972 ""
indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - (
a1ll_2.iccount - 1), (ftnlen)1);
+#line 9973 ""
if (indxb < 5) {
+#line 9974 ""
i__1 = a1ll_2.iccount + indxb - 1;
+#line 9974 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"
+#line 9974 ""
+ errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"\
"n floating figure!", (ftnlen)128, (ftnlen)44);
+#line 9976 ""
stop1_();
+#line 9977 ""
}
+#line 9978 ""
}
+#line 9979 ""
if (compage_1.usefig) {
+#line 9979 ""
*ifig = 1;
+#line 9979 ""
}
+#line 9980 ""
L5:
+#line 9980 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 9981 ""
if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (ftnlen)1)
== 0) {
+#line 9982 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
+#line 9982 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
" figure!", (ftnlen)128, (ftnlen)28);
+#line 9984 ""
stop1_();
+#line 9985 ""
} else if (*(unsigned char *)charq == '+') {
/* vertical offset, must be integer, then blank */
+#line 9989 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
1);
+#line 9990 ""
if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 9991 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"
+#line 9991 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"\
"ical offset expected here!", (ftnlen)128, (ftnlen)
42);
+#line 9993 ""
stop1_();
+#line 9994 ""
}
+#line 9995 ""
readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 9996 ""
if (*(unsigned char *)charq != ' ') {
+#line 9997 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "
+#line 9997 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "\
"must terminate figure!", (ftnlen)128, (ftnlen)38);
+#line 9999 ""
stop1_();
+#line 10000 ""
}
+#line 10001 ""
--a1ll_2.iccount;
+#line 10002 ""
goto L5;
+#line 10003 ""
} else if (*(unsigned char *)charq == 's') {
+#line 10004 ""
comligfont_1.isligfont = TRUE_;
+#line 10005 ""
}
+#line 10006 ""
if (*(unsigned char *)charq != ' ') {
+#line 10006 ""
goto L5;
+#line 10006 ""
}
+#line 10007 ""
} else if (*(unsigned char *)charq == '[') {
+#line 10008 ""
if (c1omget_1.fbon) {
+#line 10009 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "
+#line 10009 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "\
"while another was open!", (ftnlen)128, (ftnlen)43);
+#line 10011 ""
stop1_();
+#line 10012 ""
}
+#line 10013 ""
c1omget_1.fbon = TRUE_;
+#line 10014 ""
L17:
+#line 10014 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 10015 ""
if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 10016 ""
goto L17;
+#line 10017 ""
} else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 10018 ""
++a1ll_2.iccount;
+#line 10019 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 10020 ""
--a1ll_2.iccount;
+#line 10021 ""
goto L17;
+#line 10022 ""
} else if (*(unsigned char *)charq == 'm') {
/* Forced multiplicity, next char should be 1-4 */
+#line 10026 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
1);
+#line 10027 ""
if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 10028 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"
+#line 10028 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"\
"ity for a beam must be 1, 2, 3, or 4!", (ftnlen)
128, (ftnlen)53);
+#line 10030 ""
stop1_();
+#line 10031 ""
}
+#line 10032 ""
goto L17;
+#line 10033 ""
} else if (*(unsigned char *)charq != ' ') {
+#line 10034 ""
if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) {
+#line 10035 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"
+#line 10035 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\
"its must now be preceeded by \"+\" or \"-\"!", (
ftnlen)128, (ftnlen)54);
- s_wsle(&io___626);
- do_lio(&c__9, &c__1, "You will have to edit older source"
+#line 10037 ""
+ s_wsle(&io___657);
+#line 10037 ""
+ do_lio(&c__9, &c__1, "You will have to edit older source"\
"s to meet this rqmt,", (ftnlen)54);
+#line 10037 ""
e_wsle();
- s_wsle(&io___627);
- do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"
+#line 10038 ""
+ s_wsle(&io___658);
+#line 10038 ""
+ do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"\
" height adjustments.", (ftnlen)54);
+#line 10038 ""
e_wsle();
- s_wsle(&io___628);
- do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"
+#line 10039 ""
+ s_wsle(&io___659);
+#line 10039 ""
+ do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"\
"e Management", (ftnlen)46);
+#line 10039 ""
e_wsle();
+#line 10040 ""
} else {
+#line 10041 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 10041 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after [!", (ftnlen)128, (ftnlen)26);
+#line 10043 ""
}
+#line 10044 ""
stop1_();
+#line 10045 ""
}
+#line 10046 ""
} else if (*(unsigned char *)charq == ']') {
+#line 10047 ""
if (! c1omget_1.fbon) {
+#line 10048 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"
+#line 10048 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"\
"h no corresponding start!", (ftnlen)128, (ftnlen)45);
+#line 10050 ""
stop1_();
+#line 10051 ""
}
+#line 10052 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 10053 ""
if (*(unsigned char *)charq == '-') {
+#line 10054 ""
i__1 = a1ll_2.iccount;
+#line 10054 ""
if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, (
ftnlen)2) != 0) {
+#line 10055 ""
i__1 = a1ll_2.iccount + 1;
+#line 10055 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"
+#line 10055 ""
+ errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"\
" is \"[ \"!", (ftnlen)128, (ftnlen)35);
+#line 10057 ""
stop1_();
+#line 10058 ""
} else {
+#line 10059 ""
a1ll_2.iccount += 2;
+#line 10060 ""
}
+#line 10061 ""
} else if (*(unsigned char *)charq == '[') {
+#line 10062 ""
i__1 = a1ll_2.iccount;
+#line 10062 ""
if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) != 0) {
+#line 10063 ""
i__1 = a1ll_2.iccount + 1;
+#line 10063 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "This character must be a b"
+#line 10063 ""
+ errmsg_(lineq, &i__1, &i__4, "This character must be a b"\
"lank!", (ftnlen)128, (ftnlen)31);
+#line 10065 ""
stop1_();
+#line 10066 ""
}
+#line 10067 ""
} else {
/* Forced beam is really ending */
+#line 10071 ""
c1omget_1.fbon = FALSE_;
+#line 10072 ""
if (*(unsigned char *)charq == 'j') {
+#line 10073 ""
i__1 = a1ll_2.iccount;
+#line 10073 ""
if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) != 0) {
+#line 10074 ""
i__1 = a1ll_2.iccount + 1;
+#line 10074 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "This character must be"
+#line 10074 ""
+ errmsg_(lineq, &i__1, &i__4, "This character must be"\
" a blank!", (ftnlen)128, (ftnlen)31);
+#line 10076 ""
stop1_();
+#line 10077 ""
}
+#line 10078 ""
} else if (*(unsigned char *)charq != ' ') {
+#line 10079 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"
+#line 10079 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"\
"llowed by blank, \"j\", \"-\", or \"[\"!", (
ftnlen)128, (ftnlen)48);
+#line 10081 ""
stop1_();
+#line 10082 ""
}
+#line 10083 ""
}
+#line 10084 ""
} else if (*(unsigned char *)charq == 'D') {
/* Dynamic mark */
+#line 10088 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
+#line 10089 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "
+#line 10089 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "\
"before any notes have been entered!", (ftnlen)128, (
ftnlen)53);
+#line 10091 ""
stop1_();
+#line 10092 ""
}
+#line 10093 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
+#line 10093 ""
checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128);
+#line 10094 ""
} else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) {
/* Save position for later check */
+#line 10098 ""
icclhw = a1ll_2.iccount;
+#line 10099 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10100 ""
if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) {
+#line 10101 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
+#line 10101 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
"ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41)
;
+#line 10103 ""
stop1_();
+#line 10104 ""
}
+#line 10105 ""
c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq
== 'h';
+#line 10106 ""
if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* There is a header (or lower string?) */
+#line 10110 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* User-defined vert offset (\internote). */
+#line 10114 ""
if (*(unsigned char *)charq != 'h') {
+#line 10115 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""
+#line 10115 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""\
"-\" not permitted here!", (ftnlen)128, (
ftnlen)30);
+#line 10117 ""
stop1_();
+#line 10118 ""
}
/* Have "h" followed by +/- . Check for digit. */
/* Can blow durq since not using fnum for now, but... */
+#line 10123 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10124 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
{
+#line 10125 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"
+#line 10125 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"\
"e a digit here!", (ftnlen)128, (ftnlen)27);
+#line 10127 ""
stop1_();
+#line 10128 ""
}
/* Have "h" followed by +/- followed by a digit. No need to get the number. */
/* call readnum(lineq,iccount,durq,fnum) */
+#line 10133 ""
}
+#line 10134 ""
if (*(unsigned char *)charq != 'w') {
/* Header or lower string. */
+#line 10138 ""
if (icclhw != 1) {
+#line 10139 ""
i__1 = a1ll_2.iccount - 1;
+#line 10139 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"
+#line 10139 ""
+ errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"\
" first character in line!", (ftnlen)128, (
ftnlen)43);
+#line 10141 ""
stop1_();
+#line 10142 ""
}
/* Read past the next line, which has the string. */
+#line 10146 ""
read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
+#line 10147 ""
++c1omget_1.nline;
+#line 10148 ""
a1ll_2.iccount = 128;
+#line 10149 ""
} else {
+#line 10150 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"
+#line 10150 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"\
"dth) must be followed by a digit!", (ftnlen)128, (
ftnlen)47);
+#line 10152 ""
stop1_();
+#line 10153 ""
}
+#line 10154 ""
} else {
/* Height or width change spec. Check if at start of piece. */
+#line 10158 ""
if (c1omnotes_1.ibarcnt > 0) {
+#line 10159 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"
+#line 10159 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"\
"t top of first input block!", (ftnlen)128, (
ftnlen)43);
+#line 10161 ""
stop1_();
+#line 10162 ""
}
+#line 10163 ""
readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, (
ftnlen)1);
/* Check units. Convert to points */
+#line 10167 ""
if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq ==
'p') {
+#line 10168 ""
dimen += .5f;
+#line 10169 ""
} else if (*(unsigned char *)durq == 'i') {
+#line 10170 ""
dimen = dimen * 72 + .5f;
+#line 10171 ""
} else if (*(unsigned char *)durq == 'm') {
+#line 10172 ""
dimen = dimen / 25.4f * 72 + .5f;
+#line 10173 ""
} else {
+#line 10174 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"
+#line 10174 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"\
"st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen)
36);
+#line 10176 ""
stop1_();
+#line 10177 ""
}
/* 151211 fix. May have extra character. */
+#line 10181 ""
if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Get another character, see if it's blank */
+#line 10185 ""
i__1 = a1ll_2.iccount;
+#line 10185 ""
if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
ftnlen)1) != 0) {
+#line 10186 ""
i__1 = a1ll_2.iccount + 1;
+#line 10186 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "This character should "
+#line 10186 ""
+ errmsg_(lineq, &i__1, &i__4, "This character should "\
"be a blank!", (ftnlen)128, (ftnlen)33);
+#line 10188 ""
stop1_();
+#line 10189 ""
}
+#line 10190 ""
}
+#line 10191 ""
if (*(unsigned char *)charq == 'h') {
+#line 10192 ""
compage_1.ptheight = (real) ((integer) dimen);
+#line 10193 ""
} else {
+#line 10194 ""
compage_1.widthpt = (real) ((integer) dimen);
+#line 10195 ""
}
+#line 10196 ""
}
+#line 10197 ""
} else if (*(unsigned char *)charq == 'm') {
/* Time signature change. Only allow at beginning of block. */
@@ -15088,28 +24890,44 @@ L17:
/* Check whether at beginning of a block */
+#line 10205 ""
if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
+#line 10206 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"
+#line 10206 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\
" in voice 1, at start of block!", (ftnlen)128, (
ftnlen)51);
- s_wsle(&io___631);
+#line 10208 ""
+ s_wsle(&io___662);
+#line 10208 ""
do_lio(&c__9, &c__1, "voice number is", (ftnlen)15);
+#line 10208 ""
do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof(
integer));
+#line 10208 ""
e_wsle();
+#line 10209 ""
stop1_();
+#line 10210 ""
}
+#line 10211 ""
a1ll_2.newmeter = TRUE_;
+#line 10212 ""
readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, (
ftnlen)128);
+#line 10213 ""
if (a1ll_2.mtrnuml == 0) {
+#line 10214 ""
i__1 = a1ll_2.iccount - 1;
+#line 10214 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
+#line 10214 ""
errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", (
ftnlen)128, (ftnlen)25);
+#line 10216 ""
stop1_();
/* else if (mtrdenl .eq. 1) then */
/* c */
@@ -15117,391 +24935,771 @@ L17:
/* c */
/* mtrdenl = 2 */
/* mtrnuml = 2*mtrnuml */
+#line 10223 ""
}
+#line 10224 ""
readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128);
/* Read past printed time signature; not used in pmxa. */
+#line 10228 ""
lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
+#line 10229 ""
lenmult = 1;
+#line 10230 ""
if (mtrdenl == 2) {
+#line 10231 ""
lenbeat = 16;
+#line 10232 ""
lenmult = 2;
+#line 10233 ""
}
+#line 10234 ""
a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat;
+#line 10235 ""
a1ll_2.mtrnuml = 0;
+#line 10236 ""
} else if (*(unsigned char *)charq == 'C') {
+#line 10237 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10238 ""
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.54))) then */
/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */
+#line 10242 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n,"
+#line 10242 ""
+ 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);
/* * 'Must have t,s,m,a,n,r,b,f or 1-6 after C!') */
+#line 10245 ""
stop1_();
+#line 10246 ""
}
/* gotclef = .true. */
+#line 10248 ""
} else if (*(unsigned char *)charq == 'R') {
+#line 10249 ""
if (c1ommvl_1.ivx != 1) {
+#line 10250 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "
+#line 10250 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "\
"in voice 1!", (ftnlen)128, (ftnlen)31);
+#line 10252 ""
stop1_();
+#line 10253 ""
}
-L10:
+/* 10 call g1etchar(lineq,iccount,durq) */
+/* if (index('lrdDbz',durq) .gt. 0) go to 10 */
+/* if (durq .ne. ' ') then */
+/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
+/* * 'Illegal character after "R" (repeat/double bar)!') */
+/* call stop1() */
+/* end if */
+#line 10261 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
- if (i_indx("lrdDbz", durq, (ftnlen)6, (ftnlen)1) > 0) {
- goto L10;
- }
- if (*(unsigned char *)durq != ' ') {
+#line 10262 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
+/* Writing concatenation */
+#line 10263 ""
+ i__3[0] = 1, a__2[0] = durq;
+#line 10263 ""
+ i__3[1] = 1, a__2[1] = dumq;
+#line 10263 ""
+ s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2);
+#line 10263 ""
+ if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, (ftnlen)
+ 2) == 0) {
+#line 10264 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"
- "ter \"R\" (repeat/double bar)!", (ftnlen)128, (ftnlen)
- 48);
+#line 10264 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
+ "ter \"R*\" (repeat/double bar)!", (ftnlen)128, (
+ ftnlen)49);
+#line 10266 ""
stop1_();
+#line 10267 ""
+ }
+#line 10268 ""
+ if (*(unsigned char *)dumq != ' ') {
+#line 10269 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10270 ""
+ if (*(unsigned char *)durq != ' ') {
+#line 10271 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10271 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have blank "\
+ "after \"R**\" (repeat/double bar)!", (ftnlen)128,
+ (ftnlen)48);
+#line 10273 ""
+ stop1_();
+#line 10274 ""
+ }
+#line 10275 ""
}
+#line 10276 ""
} else if (*(unsigned char *)charq == 'V') {
/* Ending */
+#line 10280 ""
if (a1ll_2.iv != 1) {
+#line 10281 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"
+#line 10281 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"\
"wed in voice #1!", (ftnlen)128, (ftnlen)36);
+#line 10283 ""
stop1_();
+#line 10284 ""
} else if (c1omget_1.isvolt) {
- s_wsle(&io___637);
+#line 10285 ""
+ s_wsle(&io___668);
+#line 10285 ""
e_wsle();
- s_wsle(&io___638);
+#line 10286 ""
+ s_wsle(&io___669);
+#line 10286 ""
do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22);
+#line 10286 ""
e_wsle();
- s_wsfe(&io___639);
+#line 10287 ""
+ s_wsfe(&io___670);
+#line 10287 ""
do_fio(&c__1, "*******WARNING********", (ftnlen)22);
+#line 10287 ""
e_wsfe();
+#line 10288 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"
+#line 10288 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\
"ne volta in this input block.!", (ftnlen)128, (ftnlen)
50);
- s_wsle(&io___640);
- do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"
+#line 10290 ""
+ s_wsle(&io___671);
+#line 10290 ""
+ do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"\
" work in parts.", (ftnlen)53);
+#line 10290 ""
e_wsle();
- s_wsle(&io___641);
- do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"
+#line 10291 ""
+ s_wsle(&io___672);
+#line 10291 ""
+ do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"\
" at the start of the block", (ftnlen)64);
+#line 10291 ""
e_wsle();
- s_wsfe(&io___642);
- do_fio(&c__1, "This may work in a score, but WILL NOT work i"
+#line 10293 ""
+ s_wsfe(&io___673);
+#line 10293 ""
+ do_fio(&c__1, "This may work in a score, but WILL NOT work i"\
"n parts.", (ftnlen)53);
+#line 10293 ""
e_wsfe();
- s_wsfe(&io___643);
- do_fio(&c__1, "Safest to have only 1 volta per block, at the"
+#line 10295 ""
+ s_wsfe(&io___674);
+#line 10295 ""
+ do_fio(&c__1, "Safest to have only 1 volta per block, at the"\
" start of the block", (ftnlen)64);
+#line 10295 ""
e_wsfe();
+#line 10297 ""
}
+#line 10298 ""
c1omget_1.isvolt = TRUE_;
+#line 10299 ""
lvoltxt = 0;
+#line 10300 ""
L11:
+#line 10300 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10301 ""
if (*(unsigned char *)durq != ' ') {
+#line 10302 ""
goto L11;
+#line 10303 ""
}
+#line 10304 ""
} else if (*(unsigned char *)charq == 'B') {
+#line 10306 ""
} else if (*(unsigned char *)charq == 'P') {
+#line 10307 ""
if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
+#line 10308 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"
+#line 10308 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"\
"nning of block!", (ftnlen)128, (ftnlen)35);
+#line 10310 ""
stop1_();
+#line 10311 ""
}
+#line 10312 ""
L16:
+#line 10312 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10313 ""
if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq ==
'r' || *(unsigned char *)durq >= 48 && *(unsigned char *)
durq <= 57) {
+#line 10313 ""
goto L16;
+#line 10313 ""
}
+#line 10315 ""
if (*(unsigned char *)durq == 'c') {
/* Expect a centered name, and it has to be last option */
+#line 10319 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10320 ""
if (*(unsigned char *)durq == '"') {
/* Quoted name, go to next quote mark */
+#line 10324 ""
for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
++a1ll_2.iccount) {
+#line 10325 ""
i__1 = a1ll_2.iccount - 2;
+#line 10325 ""
if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
'"' && s_cmp(lineq + i__1, "\\",
a1ll_2.iccount - 1 - i__1, (ftnlen)1) != 0) {
+#line 10325 ""
goto L36;
+#line 10325 ""
}
+#line 10327 ""
/* L35: */
+#line 10327 ""
}
+#line 10328 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"
+#line 10328 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"\
"ote after page number command (P)!", (ftnlen)128,
(ftnlen)50);
+#line 10330 ""
stop1_();
+#line 10331 ""
L36:
+#line 10332 ""
;
+#line 10332 ""
} else if (*(unsigned char *)durq != ' ') {
/* Space-delimited name, look for next blank */
+#line 10336 ""
for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
++a1ll_2.iccount) {
+#line 10337 ""
if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
' ') {
+#line 10337 ""
goto L38;
+#line 10337 ""
}
+#line 10338 ""
/* L37: */
+#line 10338 ""
}
+#line 10339 ""
L38:
+#line 10340 ""
;
+#line 10340 ""
}
+#line 10341 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 10342 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""
+#line 10342 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""\
"c\" or digit allowed after \"P\"!", (ftnlen)128, (
ftnlen)44);
+#line 10344 ""
stop1_();
+#line 10345 ""
}
+#line 10346 ""
} else if (*(unsigned char *)charq == 'W') {
+#line 10347 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10348 ""
if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 10349 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"
+#line 10349 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"\
" start here!", (ftnlen)128, (ftnlen)32);
+#line 10351 ""
stop1_();
+#line 10352 ""
}
+#line 10353 ""
readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[
c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen)
1);
+#line 10354 ""
} else if (*(unsigned char *)charq == 'T') {
/* Titles */
+#line 10358 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10359 ""
if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) {
+#line 10360 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""
+#line 10360 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""\
"t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36);
+#line 10362 ""
stop1_();
+#line 10363 ""
}
+#line 10364 ""
i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1;
+#line 10364 ""
c1omget_1.ihead += pow_ii(&c__2, &i__1);
/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */
+#line 10368 ""
read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
+#line 10369 ""
++c1omget_1.nline;
+#line 10370 ""
a1ll_2.iccount = 128;
+#line 10371 ""
} else if (*(unsigned char *)charq == 'A') {
+#line 10372 ""
L27:
+#line 10372 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
- if (i_indx("rbsdeK", durq, (ftnlen)6, (ftnlen)1) > 0) {
+/* if (index('rbsdeK',durq) .gt. 0) then */
+#line 10374 ""
+ if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) {
+#line 10375 ""
+ goto L27;
+#line 10376 ""
+ } 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. */
+
+#line 10382 ""
+ comis4bignv_1.is4bignv = a1ll_2.nv > 7 && !
+ comis4bignv_1.aiset;
+#line 10383 ""
goto L27;
+#line 10384 ""
} else if (*(unsigned char *)durq == 'v') {
+#line 10385 ""
if (c1omnotes_1.ibarcnt == 0) {
+#line 10385 ""
comnvst_1.novshrinktop = TRUE_;
+#line 10385 ""
}
+#line 10386 ""
goto L27;
+#line 10387 ""
} else if (*(unsigned char *)durq == 'a') {
+#line 10388 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10389 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 10390 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"
+#line 10390 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"\
"ed decimal number!", (ftnlen)128, (ftnlen)32);
+#line 10392 ""
stop1_();
+#line 10393 ""
}
+#line 10394 ""
readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, (
ftnlen)128, (ftnlen)1);
+#line 10395 ""
--a1ll_2.iccount;
+#line 10396 ""
goto L27;
+#line 10397 ""
} else if (*(unsigned char *)durq == 'i') {
+#line 10398 ""
+ comis4bignv_1.is4bignv = FALSE_;
+#line 10399 ""
+ comis4bignv_1.aiset = TRUE_;
+#line 10400 ""
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 10405 ""
readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128,
(ftnlen)1);
+#line 10406 ""
if (c1omnotes_1.ibarcnt == 0) {
+#line 10406 ""
compage_1.fintstf = tintstf;
+#line 10406 ""
}
+#line 10407 ""
--a1ll_2.iccount;
+#line 10408 ""
goto L27;
+#line 10409 ""
} else if (*(unsigned char *)durq == 'I') {
/* Global interstaff correction. Use in place of fintstf if fintstf<0 */
+#line 10413 ""
+ comis4bignv_1.is4bignv = FALSE_;
+#line 10414 ""
+ comis4bignv_1.aiset = TRUE_;
+#line 10415 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10416 ""
readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, (
ftnlen)128, (ftnlen)1);
+#line 10417 ""
--a1ll_2.iccount;
+#line 10418 ""
goto L27;
+#line 10419 ""
} else if (*(unsigned char *)durq == 'o') {
+#line 10420 ""
*optimize = TRUE_;
+#line 10421 ""
goto L27;
+#line 10422 ""
} else if (*(unsigned char *)durq == 'S') {
/* 130324 */
/* do 50 iiv = 1 , nv */
+#line 10425 ""
i__1 = comkeys_1.noinst;
+#line 10425 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 10426 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10427 ""
if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 10428 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""
+#line 10428 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""\
", need nv instances of \"s,t,-,0\"!", (ftnlen)
128, (ftnlen)43);
+#line 10430 ""
stop1_();
+#line 10431 ""
}
+#line 10432 ""
if (*(unsigned char *)durq == '-' || *(unsigned char *)
durq == 's') {
+#line 10433 ""
comsize_1.isize[iiv - 1] = 1;
+#line 10434 ""
} else if (*(unsigned char *)durq == 't') {
+#line 10435 ""
comsize_1.isize[iiv - 1] = 2;
+#line 10436 ""
}
+#line 10437 ""
/* L50: */
+#line 10437 ""
}
+#line 10438 ""
goto L27;
+#line 10439 ""
} else if (*(unsigned char *)durq == 'p') {
+#line 10440 ""
comslur_1.fontslur = FALSE_;
+#line 10441 ""
L42:
+#line 10442 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10443 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Characters to change defaults for ps slurs */
+#line 10447 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10448 ""
if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 10449 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"
+#line 10449 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"\
" allowed here are \"s\",\"h\",\"t\",\"c\"!", (
ftnlen)128, (ftnlen)46);
+#line 10451 ""
stop1_();
+#line 10452 ""
}
/* Now check for another default modifier */
+#line 10456 ""
goto L42;
+#line 10457 ""
} else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Flags for optional linebreak ties or header specials */
+#line 10461 ""
goto L42;
+#line 10462 ""
} else {
+#line 10463 ""
--a1ll_2.iccount;
+#line 10464 ""
}
+#line 10465 ""
goto L27;
+#line 10466 ""
} 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. */
+#line 10472 ""
if (a1ll_2.iccount != 2) {
+#line 10473 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"
+#line 10473 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"\
"t in column 1!", (ftnlen)128, (ftnlen)28);
+#line 10475 ""
stop1_();
+#line 10476 ""
}
+#line 10477 ""
ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1);
+#line 10478 ""
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 10481 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"
+#line 10481 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"\
"ollowed by inst. #, then quote!", (ftnlen)128, (
ftnlen)45);
+#line 10483 ""
stop1_();
+#line 10484 ""
}
+#line 10485 ""
i__1 = ndxquote;
+#line 10485 ""
ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
+#line 10486 ""
if (ndxquote == 0) {
+#line 10487 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "
+#line 10487 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "\
"name must be in quotes!", (ftnlen)128, (ftnlen)37)
;
+#line 10489 ""
stop1_();
+#line 10490 ""
}
+#line 10491 ""
a1ll_2.iccount = 128;
+#line 10492 ""
} else if (*(unsigned char *)durq == 'T') {
+#line 10493 ""
comnvst_1.cstuplet = TRUE_;
+#line 10494 ""
} else if (*(unsigned char *)durq == 'R') {
/* Get full name of normal include file; must occupy remainder of line */
+#line 10498 ""
i__1 = a1ll_2.iccount;
+#line 10498 ""
getpmxmod_(&c_false, lineq + i__1, 128 - i__1);
+#line 10499 ""
a1ll_2.iccount = 128;
+#line 10500 ""
} else if (*(unsigned char *)durq == 'c') {
+#line 10501 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10502 ""
if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10503 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"
+#line 10503 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"\
" \"4\" is allowed here!", (ftnlen)128, (ftnlen)32)
;
+#line 10505 ""
stop1_();
+#line 10506 ""
}
+#line 10507 ""
if (*(unsigned char *)durq == 'l') {
+#line 10508 ""
compage_1.hoffpt = -25.f;
+#line 10509 ""
compage_1.voffpt = -45.f;
+#line 10510 ""
} else if (*(unsigned char *)durq == '4') {
+#line 10511 ""
compage_1.ptheight = 745.f;
+#line 10512 ""
compage_1.widthpt = 499.f;
+#line 10513 ""
compage_1.hoffpt = -24.f;
+#line 10514 ""
compage_1.voffpt = -24.f;
+#line 10515 ""
}
+#line 10516 ""
goto L27;
+#line 10517 ""
+ } else if (*(unsigned char *)durq == 'V') {
+#line 10518 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10519 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10520 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10520 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\
+ " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32)
+ ;
+#line 10522 ""
+ stop1_();
+#line 10523 ""
+ }
+#line 10524 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10525 ""
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 10526 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10526 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\
+ "t shift before \\eject must start here!", (ftnlen)
+ 128, (ftnlen)54);
+#line 10528 ""
+ stop1_();
+#line 10529 ""
+ }
+#line 10530 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 10531 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10532 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10532 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\
+ " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32)
+ ;
+#line 10534 ""
+ stop1_();
+#line 10535 ""
+ }
+#line 10536 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10537 ""
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 10538 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10538 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\
+ "t shift after \\eject must start here!", (ftnlen)
+ 128, (ftnlen)53);
+#line 10540 ""
+ stop1_();
+#line 10541 ""
+ }
+#line 10542 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 10543 ""
+ --a1ll_2.iccount;
+#line 10544 ""
+ goto L27;
+#line 10545 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 10546 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"
- "low one of the letters abcdeiILNprRsST!", (ftnlen)128,
- (ftnlen)57);
+#line 10546 ""
+ 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!') */
- s_wsle(&io___648);
- do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"
+#line 10549 ""
+ s_wsle(&io___679);
+#line 10549 ""
+ do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"\
" noinst args.", (ftnlen)51);
+#line 10549 ""
e_wsle();
- s_wsfe(&io___649);
- do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"
+#line 10550 ""
+ s_wsfe(&io___680);
+#line 10550 ""
+ do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"\
" args.", (ftnlen)51);
+#line 10550 ""
e_wsfe();
+#line 10552 ""
stop1_();
+#line 10553 ""
}
+#line 10554 ""
} else if (*(unsigned char *)charq == 'K') {
/* Rules and function of K command */
@@ -15513,108 +25711,165 @@ 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 10565 ""
L77:
+#line 10566 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
/* if (index('+-i',durq) .eq. 0) then */
+#line 10568 ""
if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 10569 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "
+#line 10569 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "\
"key change) must be followed by \"+,-,i,n\"!", (
ftnlen)128, (ftnlen)60);
+#line 10571 ""
stop1_();
+#line 10572 ""
}
+#line 10573 ""
if (*(unsigned char *)durq == 'n') {
+#line 10573 ""
goto L77;
+#line 10573 ""
}
+#line 10574 ""
if (*(unsigned char *)durq != 'i') {
/* Normal key change and/or transposition) */
/* iccount = iccount+1 */
+#line 10579 ""
num1 = 44 - *(unsigned char *)durq;
/* num1= +1 or -1 */
+#line 10583 ""
ztrans = num1 == -1;
+#line 10584 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10585 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 10586 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "
+#line 10586 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "\
"followed by a number!", (ftnlen)128, (ftnlen)37);
+#line 10588 ""
stop1_();
+#line 10589 ""
}
/* iccount = iccount+1 */
+#line 10591 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 10592 ""
num1 = i_nint(&fnum) * num1;
+#line 10593 ""
ztrans = ztrans && num1 == 0;
+#line 10594 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10595 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"
+#line 10595 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"\
"er \"K\" must be followed by \"+,-\"!", (ftnlen)
128, (ftnlen)47);
+#line 10597 ""
stop1_();
+#line 10598 ""
}
+#line 10599 ""
++a1ll_2.iccount;
+#line 10600 ""
num2 = 44 - *(unsigned char *)durq;
+#line 10601 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 10602 ""
num2 *= (integer) (fnum + .1f);
+#line 10603 ""
if (num1 == 0 && ! ztrans) {
/* Key change, only one per block allowed */
+#line 10607 ""
if (comkeys_1.iskchb) {
+#line 10608 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"
+#line 10608 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"\
" change allowed per input block!", (ftnlen)
128, (ftnlen)44);
+#line 10610 ""
stop1_();
+#line 10611 ""
}
+#line 10612 ""
comkeys_1.iskchb = TRUE_;
+#line 10613 ""
++comkeys_1.nkeys;
+#line 10614 ""
comkeys_1.kchmid[comkeys_1.nkeys - 1] = a1ll_2.itsofar[
c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0;
/* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */
+#line 10618 ""
comkeys_1.ibrkch[comkeys_1.nkeys - 1] =
c1omnotes_1.ibarcnt + a1ll_2.nbars;
+#line 10619 ""
if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) {
+#line 10619 ""
++comkeys_1.ibrkch[comkeys_1.nkeys - 1];
+#line 10619 ""
}
+#line 10620 ""
comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 +
comkeys_1.idsig;
/* 130316 */
/* do 43 iinst = 1 , noinst */
+#line 10623 ""
commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys -
1];
/* 43 continue */
+#line 10625 ""
} else {
/* Transposition */
+#line 10629 ""
*fulltrans = TRUE_;
+#line 10630 ""
if (c1omnotes_1.ibarcnt > 0) {
+#line 10631 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"
+#line 10631 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"\
"n must be at top of first input block!", (
ftnlen)128, (ftnlen)50);
+#line 10633 ""
stop1_();
+#line 10634 ""
}
+#line 10635 ""
comkeys_1.isig1 = num2;
+#line 10636 ""
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 10641 ""
}
+#line 10642 ""
} else {
/* 110522/110529 */
@@ -15634,55 +25889,86 @@ L77:
/* call stop1() */
/* end if */
/* durq='i' */
+#line 10660 ""
getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, &
a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, &
comkeys_1.noinst, (ftnlen)128);
+#line 10662 ""
}
+#line 10663 ""
} else if (*(unsigned char *)charq == '|') {
/* Optional bar symbol */
+#line 10667 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
+#line 10668 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "
+#line 10668 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "\
"of place!", (ftnlen)128, (ftnlen)29);
+#line 10670 ""
stop1_();
+#line 10671 ""
} else if (comkeys_1.shifton) {
+#line 10672 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
+#line 10672 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
"defined shift still on!", (ftnlen)128, (ftnlen)43);
+#line 10674 ""
stop1_();
+#line 10675 ""
}
+#line 10676 ""
} else if (*(unsigned char *)charq == '/') {
+#line 10677 ""
if (comkeys_1.ornrpt) {
+#line 10678 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"
+#line 10678 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\
" with repeated ornament still on!", (ftnlen)128, (
ftnlen)53);
+#line 10680 ""
comkeys_1.ornrpt = FALSE_;
+#line 10681 ""
}
+#line 10682 ""
if (comkeys_1.stickys) {
+#line 10683 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"
+#line 10683 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\
" with sticky stemshrink still on!", (ftnlen)128, (
ftnlen)53);
+#line 10685 ""
comkeys_1.stickys = FALSE_;
+#line 10686 ""
}
+#line 10687 ""
if (c1omget_1.fbon) {
+#line 10688 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"
+#line 10688 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"\
"ced beam open!", (ftnlen)128, (ftnlen)34);
+#line 10690 ""
stop1_();
+#line 10691 ""
} else if (comkeys_1.shifton) {
+#line 10692 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"
+#line 10692 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
"defined shift still on!", (ftnlen)128, (ftnlen)43);
+#line 10694 ""
stop1_();
/* 140215 Temporary to allow clef change in stup */
@@ -15691,613 +25977,1001 @@ L77:
/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
/* * 'May not enter clef at end of input block!') */
/* call stop1() */
+#line 10702 ""
}
+#line 10703 ""
comkeys_1.barend = FALSE_;
/* Perform time checks */
+#line 10707 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
+#line 10708 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"
+#line 10708 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\
"ivisible by lenbar!", (ftnlen)128, (ftnlen)39);
- s_wsle(&io___653);
- do_lio(&c__9, &c__1, "lenbar is ", (ftnlen)10);
+#line 10710 ""
+ s_wsle(&io___684);
+#line 10710 ""
+ do_lio(&c__9, &c__1, "lenbar, timesofar are ", (ftnlen)22);
+#line 10710 ""
do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof(
integer));
+#line 10710 ""
+ do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[c1ommvl_1.ivx -
+ 1], (ftnlen)sizeof(integer));
+#line 10710 ""
e_wsle();
+#line 10711 ""
stop1_();
+#line 10712 ""
} else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1]
!= a1ll_2.itsofar[0]) {
- s_wsle(&io___654);
+#line 10713 ""
+ s_wsle(&io___685);
+#line 10713 ""
e_wsle();
- s_wsle(&io___655);
+#line 10714 ""
+ s_wsle(&io___686);
+#line 10714 ""
do_lio(&c__9, &c__1, "# of bars in voice 1, current voice:", (
ftnlen)36);
+#line 10714 ""
i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar;
+#line 10714 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 10714 ""
i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
+#line 10714 ""
do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer));
+#line 10714 ""
e_wsle();
+#line 10716 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"
+#line 10716 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"\
"qual to voice 1!", (ftnlen)128, (ftnlen)36);
+#line 10718 ""
stop1_();
+#line 10719 ""
}
+#line 10720 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10721 ""
if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) {
/* End of input block */
+#line 10725 ""
*loop = FALSE_;
+#line 10726 ""
} else {
/* Start a new voice */
+#line 10730 ""
if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) {
+#line 10730 ""
a1ll_2.lenbar = a1ll_2.lenbr0;
+#line 10730 ""
}
+#line 10731 ""
a1ll_2.nbars = 0;
+#line 10732 ""
if (*(unsigned char *)durq == ' ') {
/* New voice is on next staff */
+#line 10736 ""
++a1ll_2.iv;
+#line 10737 ""
c1ommvl_1.ivx = a1ll_2.iv;
+#line 10738 ""
} else {
/* New voice is on same staff. Set up for it */
+#line 10742 ""
c1ommvl_1.ivx = a1ll_2.nv + 1;
+#line 10743 ""
i__1 = a1ll_2.nv;
+#line 10743 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 10744 ""
if (c1ommvl_1.nvmx[iiv - 1] == 2) {
+#line 10744 ""
++c1ommvl_1.ivx;
+#line 10744 ""
}
+#line 10745 ""
/* L23: */
+#line 10745 ""
}
+#line 10746 ""
if (c1ommvl_1.ivx > 24) {
- s_wsfe(&io___656);
+#line 10747 ""
+ s_wsfe(&io___687);
+#line 10747 ""
do_fio(&c__1, "Cannot have more than", (ftnlen)21);
+#line 10747 ""
do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer))
;
+#line 10747 ""
do_fio(&c__1, " lines of music at once", (ftnlen)23);
+#line 10747 ""
e_wsfe();
+#line 10749 ""
stop1_();
+#line 10750 ""
}
+#line 10751 ""
c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2;
+#line 10752 ""
c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx;
+#line 10753 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
+#line 10754 ""
a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0;
+#line 10755 ""
for (j = 1; j <= 200; ++j) {
+#line 10756 ""
a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_;
+#line 10757 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0;
+#line 10758 ""
/* L24: */
+#line 10758 ""
}
/* For midi stuff, record that there is a 2nd line of music in this voice */
+#line 10762 ""
if (commidi_1.ismidi) {
+#line 10762 ""
commidi_1.twoline[a1ll_2.iv - 1] = TRUE_;
+#line 10762 ""
}
+#line 10763 ""
}
+#line 10764 ""
}
+#line 10765 ""
a1ll_2.iccount = 128;
+#line 10766 ""
} else if (*(unsigned char *)charq == 'S') {
/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */
+#line 10770 ""
if (c1omnotes_1.ibarcnt > 0) {
+#line 10771 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"
+#line 10771 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"\
" first input block!", (ftnlen)128, (ftnlen)37);
+#line 10773 ""
stop1_();
+#line 10774 ""
}
+#line 10775 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10776 ""
if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 10777 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"
+#line 10777 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"\
" \"S\"!", (ftnlen)128, (ftnlen)24);
+#line 10779 ""
stop1_();
+#line 10780 ""
}
+#line 10781 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
ftnlen)1);
+#line 10782 ""
compage_1.nsyst = i_nint(&fnsyst);
+#line 10783 ""
L14:
+#line 10784 ""
if (*(unsigned char *)durq == 'P') {
/* New npages for parts. */
+#line 10788 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10789 ""
if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 10790 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"
+#line 10790 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\
"er here!", (ftnlen)128, (ftnlen)24);
+#line 10792 ""
stop1_();
+#line 10793 ""
}
+#line 10794 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
ftnlen)1);
+#line 10795 ""
compage_1.npages = i_nint(&fnsyst);
+#line 10796 ""
goto L14;
+#line 10797 ""
} else if (*(unsigned char *)durq == 'm') {
/* Reset musize (musicsize). */
+#line 10801 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10802 ""
if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 10803 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"
+#line 10803 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\
"er here!", (ftnlen)128, (ftnlen)24);
+#line 10805 ""
stop1_();
+#line 10806 ""
}
+#line 10807 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
ftnlen)1);
+#line 10808 ""
commus_1.musize = i_nint(&fnsyst);
+#line 10809 ""
c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
+#line 10810 ""
goto L14;
+#line 10811 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 10812 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "
+#line 10812 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "\
"in \"S\" symbol!", (ftnlen)128, (ftnlen)32);
+#line 10814 ""
stop1_();
+#line 10815 ""
}
+#line 10816 ""
} else if (*(unsigned char *)charq == 'L') {
+#line 10817 ""
++compage_1.nflb;
+#line 10818 ""
compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt +
a1ll_2.nbars + 1;
+#line 10819 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10820 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 10821 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"
+#line 10821 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"\
"ne forced line break!", (ftnlen)128, (ftnlen)41);
+#line 10823 ""
stop1_();
+#line 10824 ""
}
+#line 10825 ""
readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, (
ftnlen)1);
+#line 10826 ""
compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb);
+#line 10827 ""
if (compage_1.nflb > 1) {
/* Check if new number is > prior one */
+#line 10831 ""
if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[
compage_1.nflb - 1]) {
+#line 10832 ""
i__1 = a1ll_2.iccount - 1;
+#line 10832 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "You already forced a line "
+#line 10832 ""
+ errmsg_(lineq, &i__1, &i__4, "You already forced a line "\
"break at a later line!", (ftnlen)128, (ftnlen)48);
+#line 10834 ""
stop1_();
+#line 10835 ""
}
+#line 10836 ""
}
+#line 10837 ""
if (compage_1.npages == 0) {
- s_wsle(&io___660);
+#line 10838 ""
+ s_wsle(&io___691);
+#line 10838 ""
e_wsle();
- s_wsle(&io___661);
- do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"
+#line 10839 ""
+ s_wsle(&io___692);
+#line 10839 ""
+ do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"\
"ne ", (ftnlen)41);
+#line 10839 ""
do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[
compage_1.nflb], (ftnlen)sizeof(integer));
+#line 10839 ""
do_lio(&c__9, &c__1, " but npage = 0. Continue?", (ftnlen)26)
;
+#line 10839 ""
e_wsle();
- s_rsfe(&io___662);
+#line 10841 ""
+ s_rsfe(&io___693);
+#line 10841 ""
do_fio(&c__1, charq, (ftnlen)1);
+#line 10841 ""
e_rsfe();
+#line 10842 ""
if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10842 ""
stop1_();
+#line 10842 ""
}
+#line 10843 ""
} else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) {
+#line 10844 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"
+#line 10844 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"\
" line num > nsyst!", (ftnlen)128, (ftnlen)38);
+#line 10846 ""
stop1_();
+#line 10847 ""
} else if (i_indx(" PM", durq, (ftnlen)3, (ftnlen)1) == 0) {
+#line 10848 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""
+#line 10848 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""\
"P\", or \"M\" here!", (ftnlen)128, (ftnlen)32);
+#line 10850 ""
stop1_();
+#line 10851 ""
}
+#line 10852 ""
if (*(unsigned char *)durq == 'P') {
/* Forced page break here, get page number. */
+#line 10856 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10857 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 10858 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "
+#line 10858 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "\
"define forced page break!", (ftnlen)128, (ftnlen)
41);
+#line 10860 ""
stop1_();
+#line 10861 ""
}
+#line 10862 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 10863 ""
++compage_1.nfpb;
+#line 10864 ""
compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum);
+#line 10865 ""
compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[
compage_1.nflb];
+#line 10866 ""
if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) {
+#line 10867 ""
i__1 = a1ll_2.iccount - 1;
+#line 10867 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Forced page break at page "
+#line 10867 ""
+ errmsg_(lineq, &i__1, &i__4, "Forced page break at page "\
"num > npages!", (ftnlen)128, (ftnlen)39);
+#line 10869 ""
stop1_();
+#line 10870 ""
} else if (compage_1.nfpb > 1) {
+#line 10871 ""
if (compage_1.ipagfpb[compage_1.nfpb] <=
compage_1.ipagfpb[compage_1.nfpb - 1]) {
+#line 10872 ""
i__1 = a1ll_2.iccount - 1;
+#line 10872 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &i__1, &i__4, "Forced page break numb"
+#line 10872 ""
+ errmsg_(lineq, &i__1, &i__4, "Forced page break numb"\
"ers must increase!", (ftnlen)128, (ftnlen)40);
+#line 10874 ""
stop1_();
+#line 10875 ""
}
+#line 10876 ""
}
+#line 10877 ""
}
+#line 10878 ""
if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10879 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"
+#line 10879 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
" linebreak symbol!", (ftnlen)128, (ftnlen)38);
+#line 10881 ""
stop1_();
+#line 10882 ""
} else if (*(unsigned char *)durq == 'M') {
+#line 10883 ""
++compage_1.nmovbrk;
+#line 10884 ""
compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[
compage_1.nflb];
+#line 10885 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
+#line 10886 ""
L31:
+#line 10886 ""
if (*(unsigned char *)durq == '+') {
/* Vertical spacing, read past number. */
+#line 10890 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10891 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
{
+#line 10892 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"
+#line 10892 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"\
"ired here!", (ftnlen)128, (ftnlen)22);
+#line 10894 ""
stop1_();
+#line 10895 ""
}
+#line 10896 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 10897 ""
goto L31;
+#line 10898 ""
} else if (*(unsigned char *)durq == 'i') {
/* Change indentation, */
+#line 10902 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10903 ""
if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) ==
0) {
+#line 10904 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"
+#line 10904 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"\
"er required here!", (ftnlen)128, (ftnlen)29);
+#line 10906 ""
stop1_();
+#line 10907 ""
}
/* fracsys was initialized in block data to all 0.'s */
+#line 10911 ""
readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[
compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1);
+#line 10912 ""
goto L31;
+#line 10913 ""
} else if (*(unsigned char *)durq == 'c') {
+#line 10914 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10915 ""
goto L31;
+#line 10916 ""
} else if (*(unsigned char *)durq == 'r') {
+#line 10917 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10918 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10919 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"
- " \"+\" or \"-\" after \"r\" as movement brea"
+#line 10919 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\
+ " \"+\" or \"-\" after \"r\" as movement brea"\
"k option!", (ftnlen)128, (ftnlen)56);
+#line 10921 ""
stop1_();
+#line 10922 ""
}
+#line 10923 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10924 ""
goto L31;
+#line 10925 ""
} else if (*(unsigned char *)durq == 'n') {
/* 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 10930 ""
a1ll_2.nv = 0;
+#line 10931 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10932 ""
if (*(unsigned char *)durq == ':') {
/* Signals a 2-digit number, get next two characters */
+#line 10936 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10937 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 10938 ""
if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 ||
i_indx("0123456789", dumq, (ftnlen)10, (
ftnlen)1) == 0) {
+#line 10940 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
/* Writing concatenation */
- i__8[0] = 34, a__3[0] = "Illegal new number of i"
+#line 10940 ""
+ i__8[0] = 34, a__3[0] = "Illegal new number of i"\
"nstruments ";
+#line 10940 ""
i__8[1] = 1, a__3[1] = durq;
+#line 10940 ""
i__8[2] = 1, a__3[2] = dumq;
+#line 10940 ""
i__8[3] = 19, a__3[3] = " at movement break!";
- s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55);
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__3, (
+#line 10940 ""
+ s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55);
+#line 10940 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, (
ftnlen)128, (ftnlen)55);
+#line 10943 ""
stop1_();
+#line 10944 ""
}
+#line 10945 ""
i__1 = a1ll_2.iccount - 2;
+#line 10945 ""
ici__1.icierr = 0;
+#line 10945 ""
ici__1.iciend = 0;
+#line 10945 ""
ici__1.icirnum = 1;
+#line 10945 ""
ici__1.icirlen = a1ll_2.iccount - i__1;
+#line 10945 ""
ici__1.iciunit = lineq + i__1;
+#line 10945 ""
ici__1.icifmt = "(i2)";
+#line 10945 ""
s_rsfi(&ici__1);
+#line 10945 ""
do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer))
;
+#line 10945 ""
e_rsfi();
+#line 10946 ""
} else {
/* durq is a single digit number for noinow */
+#line 10950 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) ==
0) {
+#line 10951 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
/* Writing concatenation */
- i__2[0] = 34, a__1[0] = "Illegal new number of i"
+#line 10951 ""
+ i__2[0] = 34, a__1[0] = "Illegal new number of i"\
"nstruments ";
+#line 10951 ""
i__2[1] = 1, a__1[1] = durq;
+#line 10951 ""
i__2[2] = 19, a__1[2] = " at movement break!";
- s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)54);
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, (
+#line 10951 ""
+ s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)54);
+#line 10951 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__5, (
ftnlen)128, (ftnlen)54);
+#line 10954 ""
stop1_();
+#line 10955 ""
}
+#line 10956 ""
ninow = *(unsigned char *)durq - 48;
+#line 10957 ""
}
+#line 10958 ""
if (ninow > comkeys_1.noinst) {
+#line 10959 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"
+#line 10959 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"\
"f instruments must be <= original!", (ftnlen)
128, (ftnlen)46);
+#line 10961 ""
stop1_();
+#line 10962 ""
}
+#line 10963 ""
i__1 = ninow;
+#line 10963 ""
for (iinow = 1; iinow <= i__1; ++iinow) {
+#line 10964 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 10965 ""
if (*(unsigned char *)durq == ':') {
/* Signals a 2-digit number */
+#line 10969 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
128, (ftnlen)1);
+#line 10970 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
128, (ftnlen)1);
+#line 10971 ""
if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0
|| i_indx("0123456789", dumq, (ftnlen)10,
(ftnlen)1) == 0) {
+#line 10973 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
/* Writing concatenation */
- i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"
+#line 10973 ""
+ i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"\
"trument number ";
+#line 10973 ""
i__8[1] = 1, a__3[1] = durq;
+#line 10973 ""
i__8[2] = 1, a__3[2] = dumq;
+#line 10973 ""
i__8[3] = 19, a__3[3] = " at movement break!";
- s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55);
- errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__3,
+#line 10973 ""
+ s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55);
+#line 10973 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__4,
(ftnlen)128, (ftnlen)55);
+#line 10976 ""
stop1_();
+#line 10977 ""
}
+#line 10978 ""
i__4 = a1ll_2.iccount - 2;
+#line 10978 ""
ici__1.icierr = 0;
+#line 10978 ""
ici__1.iciend = 0;
+#line 10978 ""
ici__1.icirnum = 1;
+#line 10978 ""
ici__1.icirlen = a1ll_2.iccount - i__4;
+#line 10978 ""
ici__1.iciunit = lineq + i__4;
+#line 10978 ""
ici__1.icifmt = "(i2)";
+#line 10978 ""
s_rsfi(&ici__1);
+#line 10978 ""
do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof(
integer));
+#line 10978 ""
e_rsfi();
+#line 10979 ""
} else {
/* durq is a single digit number for iorig */
+#line 10983 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)
1) == 0) {
+#line 10984 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
/* Writing concatenation */
- i__2[0] = 26, a__1[0] = "Illegal instrument "
+#line 10984 ""
+ i__2[0] = 26, a__1[0] = "Illegal instrument "\
"number ";
+#line 10984 ""
i__2[1] = 1, a__1[1] = durq;
+#line 10984 ""
i__2[2] = 19, a__1[2] = " at movement break!";
- s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)46);
- errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__5,
+#line 10984 ""
+ s_cat(ch__6, a__1, i__2, &c__3, (ftnlen)46);
+#line 10984 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__6,
(ftnlen)128, (ftnlen)46);
+#line 10987 ""
stop1_();
+#line 10988 ""
}
+#line 10989 ""
iorig = *(unsigned char *)durq - 48;
+#line 10990 ""
}
+#line 10991 ""
if (iorig > comkeys_1.noinst) {
+#line 10992 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"
+#line 10992 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"\
"rument number must be <= original noinst!"
, (ftnlen)128, (ftnlen)49);
+#line 10994 ""
stop1_();
+#line 10995 ""
}
+#line 10996 ""
a1ll_2.nv += c1omget_1.nsperi[iorig - 1];
+#line 10997 ""
/* L63: */
+#line 10997 ""
}
+#line 10998 ""
i__1 = a1ll_2.nv;
+#line 10998 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
/* Get clef names */
+#line 11002 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 11003 ""
if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1)
> 0 || *(unsigned char *)durq >= 48 && *(
unsigned char *)durq <= 55)) {
+#line 11005 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"
- "e t,s,m,a,n,r,b,f or 1-7 as clef symbol "
+#line 11005 ""
+ 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);
+#line 11007 ""
stop1_();
+#line 11008 ""
}
/* Initialize new voices */
+#line 11012 ""
c1ommvl_1.nvmx[iiv - 1] = 1;
+#line 11013 ""
c1ommvl_1.ivmx[iiv - 1] = iiv;
+#line 11014 ""
a1ll_2.itsofar[iiv - 1] = 0;
+#line 11015 ""
a1ll_2.nnl[iiv - 1] = 0;
+#line 11016 ""
for (j = 1; j <= 200; ++j) {
+#line 11017 ""
a1ll_2.rest[iiv + j * 24 - 25] = FALSE_;
+#line 11018 ""
/* L62: */
+#line 11018 ""
}
+#line 11019 ""
/* L61: */
+#line 11019 ""
}
/* Loop back up, this might not be last option in M */
+#line 11023 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 11024 ""
goto L31;
+#line 11025 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 11026 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"
+#line 11026 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after Movement break symbol!", (ftnlen)128, (
ftnlen)46);
+#line 11028 ""
stop1_();
+#line 11029 ""
}
+#line 11030 ""
if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) {
/* Since fracsys was not explicitly set, set it to prior value. */
+#line 11034 ""
if (compage_1.nmovbrk == 1) {
+#line 11035 ""
compage_1.fracsys[compage_1.nmovbrk - 1] =
c1omget_1.fracindent;
+#line 11036 ""
} else {
+#line 11037 ""
compage_1.fracsys[compage_1.nmovbrk - 1] =
compage_1.fracsys[compage_1.nmovbrk - 2];
+#line 11038 ""
}
+#line 11039 ""
}
+#line 11040 ""
}
/* Just before exiting if-block for forced line breaks, set counter to use when */
/* dealing with vertical space calcs */
+#line 11045 ""
compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1;
+#line 11046 ""
} else if (*(unsigned char *)charq == 'F') {
+#line 11047 ""
compage_1.usefig = FALSE_;
+#line 11048 ""
} else if (*(unsigned char *)charq == 'X') {
+#line 11049 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
+#line 11049 ""
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 11051 ""
} else if (*(unsigned char *)charq == 'I') {
/* MIDI settings. */
+#line 11055 ""
if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
+#line 11056 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"
+#line 11056 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"\
"wed at start of block!", (ftnlen)128, (ftnlen)42);
+#line 11058 ""
stop1_();
+#line 11059 ""
}
+#line 11060 ""
if (a1ll_2.nv > 15) {
+#line 11061 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "
+#line 11061 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "\
"not work with more than 15 voices!", (ftnlen)128, (
ftnlen)54);
+#line 11063 ""
stop1_();
+#line 11064 ""
}
+#line 11065 ""
commidi_1.ismidi = TRUE_;
/* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
+#line 11067 ""
getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, &
c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &a1ll_2.nbars,
&a1ll_2.lenbar, &mtrdenl, &c_true, (ftnlen)128);
+#line 11069 ""
} else if (*(unsigned char *)charq == 'M') {
+#line 11070 ""
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 11072 ""
} else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Continued rhythmic shortcut */
+#line 11076 ""
idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
+#line 11077 ""
if (idotform == 1) {
/* Change duration of prior note */
+#line 11081 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[
c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
25];
+#line 11082 ""
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 11083 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[
c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
25];
+#line 11084 ""
}
+#line 11085 ""
++idotform;
+#line 11086 ""
numnum = 1;
+#line 11087 ""
cdot = TRUE_;
+#line 11088 ""
goto L1;
+#line 11089 ""
} else {
- s_wsle(&io___666);
+#line 11090 ""
+ s_wsle(&io___697);
+#line 11090 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 11090 ""
i__1 = *(unsigned char *)charq;
+#line 11090 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 11090 ""
e_wsle();
+#line 11091 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"
+#line 11091 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\
"lowed here!", (ftnlen)128, (ftnlen)35);
- s_wsle(&io___667);
+#line 11093 ""
+ s_wsle(&io___698);
+#line 11093 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 11093 ""
i__1 = *(unsigned char *)charq;
+#line 11093 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 11093 ""
e_wsle();
+#line 11094 ""
stop1_();
+#line 11095 ""
}
+#line 11095 ""
}
+#line 11096 ""
return 0;
} /* g1etnote_ */
@@ -16333,95 +27007,159 @@ L31:
static integer iccount;
/* Fortran I/O blocks */
- static cilist io___670 = { 0, 6, 0, 0, 0 };
- static cilist io___671 = { 0, 6, 0, "(1x,a46,i3)", 0 };
- static cilist io___672 = { 0, 6, 0, "(a)", 0 };
- static cilist io___675 = { 0, 6, 0, "(a)", 0 };
- static cilist io___676 = { 0, 6, 0, "(a)", 0 };
- static cilist io___677 = { 0, 6, 0, 0, 0 };
+ static cilist io___701 = { 0, 6, 0, 0, 0 };
+ static cilist io___702 = { 0, 6, 0, "(1x,a46,i3)", 0 };
+ static cilist io___703 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___706 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___707 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___708 = { 0, 6, 0, 0, 0 };
/* Get the first line */
+#line 11114 ""
iccount = 0;
+#line 11115 ""
c1omget_1.nline = 1;
+#line 11116 ""
L9:
+#line 11116 ""
getbuf_(lineq, (ftnlen)128);
+#line 11117 ""
if (*(unsigned char *)lineq == '%') {
+#line 11118 ""
++c1omget_1.nline;
+#line 11119 ""
goto L9;
+#line 11120 ""
}
+#line 11121 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) {
/* Have TeX input until next line that starts with '---' */
+#line 11125 ""
L3:
+#line 11125 ""
++c1omget_1.nline;
+#line 11126 ""
getbuf_(lineq, (ftnlen)128);
+#line 11127 ""
if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
+#line 11127 ""
goto L1;
+#line 11127 ""
}
+#line 11128 ""
goto L2;
+#line 11129 ""
L1:
- s_wsle(&io___670);
- do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""
+#line 11129 ""
+ s_wsle(&io___701);
+#line 11129 ""
+ do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""\
"---\"", (ftnlen)49);
+#line 11129 ""
e_wsle();
+#line 11130 ""
stop1_();
+#line 11131 ""
L2:
+#line 11132 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
+#line 11132 ""
goto L3;
+#line 11132 ""
}
/* Force a new line read on first call to readin */
+#line 11136 ""
iccount = 128;
+#line 11137 ""
}
/* Here, lineq and nline are first non-TeX lines. */
+#line 11141 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11141 ""
*nv = i_nint(&r__1);
+#line 11142 ""
if (*nv > 24) {
- s_wsfe(&io___671);
+#line 11143 ""
+ s_wsfe(&io___702);
+#line 11143 ""
do_fio(&c__1, "In setup data, number of voices cannot exceed", (
ftnlen)45);
+#line 11143 ""
do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer));
+#line 11143 ""
e_wsfe();
+#line 11145 ""
stop1_();
+#line 11146 ""
}
+#line 11147 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11147 ""
*noinst = i_nint(&r__1);
+#line 11148 ""
if (*noinst > *nv) {
- s_wsfe(&io___672);
- do_fio(&c__1, "In setup data, cannot have more instruments than stav"
+#line 11149 ""
+ s_wsfe(&io___703);
+#line 11149 ""
+ do_fio(&c__1, "In setup data, cannot have more instruments than stav"\
"es", (ftnlen)55);
+#line 11149 ""
e_wsfe();
+#line 11151 ""
stop1_();
+#line 11152 ""
}
+#line 11153 ""
newway = *noinst <= 0;
+#line 11154 ""
if (newway) {
+#line 11154 ""
*noinst = -(*noinst);
+#line 11154 ""
}
+#line 11155 ""
i__1 = *noinst;
+#line 11155 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* Seve # of staves per inst in case later drop some inst's. */
+#line 11159 ""
if (newway) {
+#line 11160 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11160 ""
c1omget_1.nsperi[iinst - 1] = i_nint(&r__1);
+#line 11161 ""
} else if (iinst > 1) {
+#line 11162 ""
c1omget_1.nsperi[iinst - 1] = 1;
+#line 11163 ""
} else {
+#line 11164 ""
c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1;
+#line 11165 ""
}
+#line 11166 ""
/* L10: */
+#line 11166 ""
}
+#line 11167 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11167 ""
*mtrnuml = i_nint(&r__1);
+#line 11168 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11168 ""
*mtrdenl = i_nint(&r__1);
/* c */
/* c Kluge!!! */
@@ -16430,120 +27168,208 @@ L2:
/* mtrdenl = 2 */
/* mtrnuml = mtrnuml*2 */
/* end if */
+#line 11176 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11176 ""
*mtrnmp = i_nint(&r__1);
+#line 11177 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11177 ""
*mtrdnp = i_nint(&r__1);
+#line 11178 ""
if (*mtrnmp == 0 && *mtrdnp >= 8) {
- s_wsfe(&io___675);
+#line 11179 ""
+ s_wsfe(&io___706);
+#line 11179 ""
do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", (
ftnlen)47);
+#line 11179 ""
e_wsfe();
+#line 11180 ""
stop1_();
+#line 11181 ""
}
+#line 11182 ""
*xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11183 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11183 ""
*newkey = i_nint(&r__1);
/* 130316 */
/* do 11 iinst = 1 , noinst */
+#line 11186 ""
commidisig_1.midisig = *newkey;
/* 11 continue */
+#line 11188 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11188 ""
*npages = i_nint(&r__1);
+#line 11189 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11189 ""
*nsyst = i_nint(&r__1);
+#line 11190 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
+#line 11190 ""
*musize = i_nint(&r__1);
+#line 11191 ""
c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)
128);
+#line 11192 ""
if (c1omget_1.fracindent >= 1.f) {
- s_wsfe(&io___676);
+#line 11193 ""
+ s_wsfe(&io___707);
+#line 11193 ""
do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36);
+#line 11193 ""
e_wsfe();
+#line 11194 ""
stop1_();
+#line 11195 ""
}
+#line 11196 ""
if (*npages > *nsyst) {
- s_wsle(&io___677);
+#line 11197 ""
+ s_wsle(&io___708);
+#line 11197 ""
do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen)
35);
+#line 11197 ""
e_wsle();
+#line 11198 ""
stop1_();
+#line 11199 ""
} else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize -
29) != 0) {
+#line 11200 ""
printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35);
+#line 11201 ""
stop1_();
+#line 11202 ""
}
/* Next noinst non-comment lines are names of instruments. */
+#line 11206 ""
i__1 = abs(*noinst);
+#line 11206 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 11207 ""
L5:
+#line 11207 ""
getbuf_(lineq, (ftnlen)128);
+#line 11208 ""
++c1omget_1.nline;
+#line 11209 ""
if (*(unsigned char *)lineq == '%') {
+#line 11209 ""
goto L5;
+#line 11209 ""
}
+#line 11210 ""
/* L4: */
+#line 11210 ""
}
/* Mext non-comment line has nv clef names */
+#line 11214 ""
L6:
+#line 11214 ""
getbuf_(lineq, (ftnlen)128);
+#line 11215 ""
++c1omget_1.nline;
+#line 11216 ""
if (*(unsigned char *)lineq == '%') {
+#line 11216 ""
goto L6;
+#line 11216 ""
}
+#line 11217 ""
i__1 = *nv;
+#line 11217 ""
for (iv = 1; iv <= i__1; ++iv) {
/* if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then */
+#line 11219 ""
if (i_indx("brnamstf012345678", lineq + (iv - 1), (ftnlen)17, (ftnlen)
1) == 0) {
+#line 11220 ""
errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!",
(ftnlen)128, (ftnlen)35);
+#line 11222 ""
stop1_();
+#line 11223 ""
}
+#line 11224 ""
/* L7: */
+#line 11224 ""
}
+#line 11225 ""
i__1 = *nv;
+#line 11225 ""
if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) {
+#line 11226 ""
i__1 = *nv + 1;
+#line 11226 ""
errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen)
128, (ftnlen)29);
+#line 11228 ""
stop1_();
+#line 11229 ""
}
/* Set flag if voice 1 is treble, since it affects vertical spacing */
/* bottreb = lineq(1:1).eq.'t' */
+#line 11234 ""
*bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0;
/* Next non-comment line has path name */
+#line 11238 ""
L8:
+#line 11238 ""
getbuf_(lineq, (ftnlen)128);
+#line 11239 ""
++c1omget_1.nline;
+#line 11240 ""
if (*(unsigned char *)lineq == '%') {
+#line 11240 ""
goto L8;
+#line 11240 ""
}
+#line 11241 ""
lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1;
/* Writing concatenation */
+#line 11242 ""
i__2[0] = 2, a__1[0] = "/:";
+#line 11242 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 11242 ""
i__2[1] = 1, a__1[1] = ch__2;
+#line 11242 ""
s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3);
+#line 11242 ""
if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) {
/* Writing concatenation */
- i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""
+#line 11243 ""
+ i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""\
":\", or \"";
+#line 11243 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 11243 ""
i__3[1] = 1, a__2[1] = ch__2;
+#line 11243 ""
i__3[2] = 2, a__2[2] = "\"!";
+#line 11243 ""
s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50);
+#line 11243 ""
errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50);
+#line 11246 ""
stop1_();
+#line 11247 ""
}
+#line 11248 ""
return 0;
} /* g1etset_ */
@@ -16572,88 +27398,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 11258 ""
number = FALSE_;
+#line 11259 ""
npbsc = 0;
+#line 11260 ""
L1:
+#line 11260 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11261 ""
if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) {
/* Continue checking here even if "P". */
+#line 11265 ""
ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1);
+#line 11266 ""
if (bit_test(npbsc,ipbsc)) {
+#line 11267 ""
errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", (
ftnlen)128, (ftnlen)28);
+#line 11268 ""
stop1_();
+#line 11269 ""
}
+#line 11270 ""
npbsc = bit_set(npbsc,ipbsc);
+#line 11271 ""
goto L1;
+#line 11272 ""
} else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
+#line 11273 ""
number = TRUE_;
+#line 11274 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 11275 ""
g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1);
+#line 11276 ""
if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 11277 ""
errmsg_(lineq, iccount, ibar, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
+#line 11278 ""
stop1_();
+#line 11279 ""
}
+#line 11280 ""
}
+#line 11281 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11282 ""
if (*(unsigned char *)charq == '-') {
+#line 11282 ""
fnum = -fnum;
+#line 11282 ""
}
+#line 11283 ""
if (*(unsigned char *)dumq != 'p') {
+#line 11284 ""
--(*iccount);
+#line 11285 ""
fnum *= *wheadpt;
+#line 11286 ""
}
+#line 11287 ""
goto L1;
+#line 11288 ""
} else if (*(unsigned char *)charq != ' ') {
+#line 11289 ""
errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen)
128, (ftnlen)26);
+#line 11290 ""
stop1_();
+#line 11291 ""
}
/* Done with parsing. Other checks */
+#line 11295 ""
if ((6 & npbsc) == 6 || (24 & npbsc) == 24) {
+#line 11296 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""
+#line 11296 ""
+ errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""\
"S\" and \":\"!", (ftnlen)128, (ftnlen)44);
+#line 11298 ""
stop1_();
+#line 11299 ""
}
+#line 11300 ""
if (bit_test(npbsc,4)) {
+#line 11301 ""
if (number) {
+#line 11302 ""
if (*shifton) {
+#line 11303 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Started a group shift without s"
+#line 11303 ""
+ errmsg_(lineq, &i__1, ibar, "Started a group shift without s"\
"topping prior one!", (ftnlen)128, (ftnlen)49);
+#line 11305 ""
stop1_();
+#line 11306 ""
} else {
+#line 11307 ""
*shifton = TRUE_;
+#line 11308 ""
}
+#line 11309 ""
} else {
+#line 11310 ""
if (! (*shifton)) {
+#line 11311 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"
+#line 11311 ""
+ errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"\
"rting one!", (ftnlen)128, (ftnlen)41);
+#line 11313 ""
stop1_();
+#line 11314 ""
} else {
+#line 11315 ""
*shifton = FALSE_;
+#line 11316 ""
}
+#line 11317 ""
}
+#line 11318 ""
}
/* P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) */
+#line 11322 ""
if ((npbsc & 26) == 0) {
+#line 11322 ""
*udsp += fnum;
+#line 11322 ""
}
+#line 11323 ""
if (! number && ! bit_test(npbsc,4)) {
+#line 11324 ""
i__1 = *iccount - 1;
- errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "
+#line 11324 ""
+ errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "\
"in \"X\" symbol!", (ftnlen)128, (ftnlen)51);
+#line 11326 ""
stop1_();
+#line 11327 ""
}
+#line 11328 ""
return 0;
} /* g1etx_ */
@@ -16672,11 +27565,16 @@ L1:
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
+#line 11343 ""
i__1 = inbuff_1.ipbuf;
+#line 11343 ""
s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf +
inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1);
+#line 11344 ""
inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
+#line 11345 ""
++inbuff_1.ilbuf;
+#line 11346 ""
return 0;
} /* getbuf_ */
@@ -16695,24 +27593,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 11362 ""
if (*iccount == 128) {
+#line 11363 ""
read10_(lineq, &comget_1.lastchar, (ftnlen)128);
+#line 11364 ""
if (comget_1.lastchar) {
+#line 11364 ""
return 0;
+#line 11364 ""
}
+#line 11365 ""
if (! commac_1.endmac) {
+#line 11366 ""
*iccount = 0;
+#line 11367 ""
} else {
+#line 11368 ""
commac_1.endmac = FALSE_;
+#line 11369 ""
*iccount = commac_1.icchold;
+#line 11370 ""
s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
+#line 11371 ""
}
+#line 11372 ""
if (commac_1.mrecord) {
+#line 11373 ""
mrec1_(lineq, iccount, &ndxm, (ftnlen)128);
+#line 11374 ""
}
+#line 11375 ""
}
+#line 11376 ""
++(*iccount);
+#line 11377 ""
*(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
+#line 11378 ""
return 0;
} /* getchar_ */
@@ -16769,178 +27686,284 @@ L1:
/* 01-09 (horizontal offset)/10 + 25.6 notehead widths */
/* 10 5th bit for ivx (5/15/10) */
+#line 11415 ""
*irest = bit_set(*irest,26);
+#line 11416 ""
++comdyn_1.ndyn;
+#line 11417 ""
idyn = *ivx;
+#line 11418 ""
comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0;
+#line 11419 ""
if (*ivx >= 16) {
+#line 11419 ""
setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1);
+#line 11419 ""
}
+#line 11420 ""
setbits_(&idyn, &c__8, &c__4, ip);
+#line 11421 ""
i__1 = *iccount;
+#line 11421 ""
if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
/* text-dynamic */
+#line 11425 ""
++comdyn_1.ntxtdyn;
+#line 11426 ""
iccountt = *iccount;
+#line 11427 ""
L3:
+#line 11428 ""
i__1 = iccountt + 1;
+#line 11428 ""
iend = iccountt + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) +
2;
+#line 11429 ""
i__1 = iend - 3;
+#line 11429 ""
if (s_cmp(lineq + i__1, "\\", iend - 2 - i__1, (ftnlen)1) == 0) {
+#line 11430 ""
iccountt = iend - 2;
+#line 11431 ""
goto L3;
+#line 11432 ""
}
+#line 11433 ""
i__1 = *iccount + 1;
+#line 11433 ""
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 11437 ""
comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5);
+#line 11438 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
+#line 11439 ""
idno = 0;
+#line 11440 ""
} else {
/* Word-group or hairpin */
+#line 11444 ""
for (iend = *iccount + 2; iend <= 128; ++iend) {
+#line 11445 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
/* Exit the loop at first blank, "+", or "-" */
+#line 11449 ""
if (ipm > 0) {
+#line 11449 ""
goto L2;
+#line 11449 ""
}
+#line 11450 ""
/* L1: */
+#line 11450 ""
}
+#line 11451 ""
L2:
+#line 11452 ""
i__1 = *iccount;
+#line 11452 ""
ici__1.icierr = 0;
+#line 11452 ""
ici__1.iciend = 0;
+#line 11452 ""
ici__1.icirnum = 1;
+#line 11452 ""
ici__1.icirlen = iend - 1 - i__1;
+#line 11452 ""
ici__1.iciunit = lineq + i__1;
/* Writing concatenation */
+#line 11452 ""
i__2[0] = 2, a__1[0] = "(a";
+#line 11452 ""
i__3 = iend + 47 - *iccount;
+#line 11452 ""
chax_(ch__2, (ftnlen)1, &i__3);
+#line 11452 ""
i__2[1] = 1, a__1[1] = ch__2;
+#line 11452 ""
i__2[2] = 1, a__1[2] = ")";
+#line 11452 ""
ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
+#line 11452 ""
s_rsfi(&ici__1);
+#line 11452 ""
do_fio(&c__1, dynsymq, (ftnlen)4);
+#line 11452 ""
e_rsfi();
- idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff "
+#line 11454 ""
+ 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 11460 ""
idno1 = idno;
+#line 11461 ""
}
/* Set flag to check level later if in beam */
+#line 11465 ""
*iornq = bit_set(*iornq,23);
+#line 11466 ""
if (idno >= 14) {
/* Hairpin here. Check if opposite type from one that's already on */
+#line 11470 ""
if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 &&
bit_test(comdyn_1.listcresc,*ivx)) {
+#line 11472 ""
printl_(" ", (ftnlen)1);
+#line 11473 ""
printl_("Started one kind of hairpin while other is on", (ftnlen)
45);
+#line 11474 ""
stop1_();
+#line 11475 ""
}
/* Start or stop? */
+#line 11479 ""
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 11483 ""
if (! comslur_1.fontslur) {
+#line 11483 ""
idno = 15;
+#line 11483 ""
}
+#line 11484 ""
} else if (comslur_1.fontslur) {
/* Start of font slur */
+#line 11488 ""
idno = 13;
+#line 11489 ""
} else {
/* Start of postscript slur */
+#line 11493 ""
--idno;
+#line 11494 ""
}
+#line 11495 ""
}
/* Now that we used list[de]cresc, update */
+#line 11499 ""
if (idno >= 13) {
+#line 11500 ""
if (idno == 15 || comslur_1.fontslur && idno == 14) {
/* Something's ending */
+#line 11504 ""
if (bit_test(comdyn_1.listcresc,*ivx)) {
/* It's a cresc! */
+#line 11508 ""
comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx);
+#line 11509 ""
} else {
+#line 11510 ""
comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx);
+#line 11511 ""
}
+#line 11512 ""
} else {
/* Something's starting */
+#line 11516 ""
if (idno1 == 14) {
/* It's a cresc! */
+#line 11520 ""
comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx);
+#line 11521 ""
} else {
+#line 11522 ""
comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx);
+#line 11523 ""
}
+#line 11524 ""
}
+#line 11525 ""
}
+#line 11526 ""
setbits_(&idyn, &c__4, &c__12, &idno);
+#line 11527 ""
*iccount = iend;
+#line 11528 ""
if (ipm != 2) {
/* There is a vertical shift */
+#line 11532 ""
idyn = bit_set(idyn,16);
+#line 11533 ""
++(*iccount);
+#line 11534 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11535 ""
idno = i_nint(&fnum);
+#line 11536 ""
i__1 = (ipm - 2) * idno + 64;
+#line 11536 ""
setbits_(&idyn, &c__7, &c__17, &i__1);
+#line 11537 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
+#line 11538 ""
if (ipm != 2) {
/* There is a horizontal shift */
/* idynda2(ndyn) = ibset(idyn,23) */
+#line 11543 ""
comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[
comdyn_1.ndyn - 1],0);
+#line 11544 ""
++(*iccount);
+#line 11545 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11546 ""
r__1 = fnum * 10;
+#line 11546 ""
idno = i_nint(&r__1);
+#line 11547 ""
i__1 = (ipm - 2) * idno + 256;
+#line 11547 ""
setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, &
i__1);
+#line 11548 ""
}
/* iccount should be on the blank at the end of the entire symbol */
+#line 11552 ""
}
+#line 11553 ""
comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn;
+#line 11554 ""
return 0;
} /* getdyn_ */
@@ -16972,74 +27995,129 @@ L2:
extern integer ifnodur_(integer *, char *, ftnlen);
/* * itsofar,nodur,figq,ivupfig,nfigs) */
+#line 11563 ""
++(*nfigs);
+#line 11564 ""
*ivupfig = 0;
+#line 11565 ""
*ivvfig = 0;
+#line 11566 ""
*itoff = 0;
+#line 11567 ""
if (*(unsigned char *)charq == 'x') {
/* Floating figure. */
+#line 11571 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11572 ""
ici__1.icierr = 0;
+#line 11572 ""
ici__1.iciend = 0;
+#line 11572 ""
ici__1.icirnum = 1;
+#line 11572 ""
ici__1.icirlen = 1;
+#line 11572 ""
ici__1.iciunit = charq;
+#line 11572 ""
ici__1.icifmt = "(i1)";
+#line 11572 ""
s_rsfi(&ici__1);
+#line 11572 ""
do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer));
+#line 11572 ""
e_rsfi();
+#line 11573 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11574 ""
ici__1.icierr = 0;
+#line 11574 ""
ici__1.iciend = 0;
+#line 11574 ""
ici__1.icirnum = 1;
+#line 11574 ""
ici__1.icirlen = 1;
+#line 11574 ""
ici__1.iciunit = charq;
+#line 11574 ""
ici__1.icifmt = "(i1)";
+#line 11574 ""
s_rsfi(&ici__1);
+#line 11574 ""
do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer));
+#line 11574 ""
e_rsfi();
+#line 11575 ""
*itoff = noff * ifnodur_(&loff, "x", (ftnlen)1);
+#line 11576 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11577 ""
} else {
/* Figure on a note */
+#line 11581 ""
*isfig = TRUE_;
+#line 11582 ""
}
+#line 11583 ""
*itfig = *itsofar + *itoff - *nodur;
+#line 11584 ""
lfig = 1;
+#line 11585 ""
s_copy(figq, charq, (ftnlen)10, (ftnlen)1);
+#line 11586 ""
L5:
+#line 11586 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
/* if (index(' +',charq) .eq. 0) then */
+#line 11588 ""
if (i_indx(" +v", charq, (ftnlen)3, (ftnlen)1) == 0) {
/* Writing concatenation */
+#line 11589 ""
i__1[0] = lfig, a__1[0] = figq;
+#line 11589 ""
i__1[1] = 1, a__1[1] = charq;
+#line 11589 ""
s_cat(figq, a__1, i__1, &c__2, (ftnlen)10);
+#line 11590 ""
++lfig;
+#line 11591 ""
goto L5;
+#line 11592 ""
} else if (*(unsigned char *)charq == '+') {
/* Get vertical offset for figure. Next character after number has to be blank. */
+#line 11596 ""
++(*iccount);
+#line 11597 ""
readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11598 ""
*ivupfig = i_nint(&fnum);
+#line 11599 ""
} else if (*(unsigned char *)charq == 'v') {
/* Get vertical change in figdrop. Must be last item in figure word. */
+#line 11603 ""
isign = 1;
+#line 11604 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11605 ""
if (*(unsigned char *)charq == '-') {
+#line 11606 ""
isign = -1;
+#line 11607 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11608 ""
}
+#line 11609 ""
*ivvfig = isign * (*(unsigned char *)charq - 48);
+#line 11610 ""
}
+#line 11611 ""
return 0;
} /* getfig_ */
@@ -17077,169 +28155,289 @@ L5:
/* These data MUST precede note name of first note */
/* nolevg, naccg: lists of levels and accid's, indexed as described above. */
+#line 11645 ""
/* Parameter adjustments */
+#line 11645 ""
ndlev -= 25;
+#line 11645 ""
ipl -= 25;
+#line 11645 ""
--iornq;
+#line 11645 ""
islur -= 25;
+#line 11645 ""
--nnl;
+#line 11645 ""
+#line 11645 ""
/* Function Body */
+#line 11645 ""
++comgrace_1.ngrace;
+#line 11646 ""
comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx;
+#line 11647 ""
comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1;
+#line 11648 ""
if (comgrace_1.ngrace == 1) {
+#line 11649 ""
comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1;
+#line 11650 ""
} else {
+#line 11651 ""
comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[
comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2]
;
+#line 11652 ""
}
+#line 11653 ""
islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1)
* 24],4);
+#line 11654 ""
comgrace_1.nng[comgrace_1.ngrace - 1] = 1;
+#line 11655 ""
comgrace_1.multg[comgrace_1.ngrace - 1] = 1;
+#line 11656 ""
comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_;
+#line 11657 ""
comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_;
+#line 11658 ""
comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_;
+#line 11659 ""
L18:
+#line 11659 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11660 ""
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 11665 ""
comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx];
+#line 11666 ""
islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx]
+ 1) * 24],4);
+#line 11667 ""
islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4)
;
+#line 11668 ""
if (comgrace_1.slurg[comgrace_1.ngrace - 1]) {
+#line 11668 ""
iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] *
24],24);
+#line 11668 ""
}
+#line 11670 ""
if (*(unsigned char *)charq == 'A') {
/* close After, clear way-after bit, to ensure priority of most recent A/W */
+#line 11674 ""
ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
ivx] * 24],31),29);
+#line 11675 ""
} else {
/* Way after; later assign to following note, and position like normal grace. */
+#line 11679 ""
ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
ivx] * 24],29),31);
+#line 11680 ""
}
+#line 11681 ""
} else if (*(unsigned char *)charq == 'm') {
+#line 11682 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11683 ""
comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq -
48;
+#line 11684 ""
} else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
+#line 11685 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11686 ""
--(*iccount);
+#line 11687 ""
comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum);
+#line 11688 ""
} else if (*(unsigned char *)charq == 'l') {
+#line 11689 ""
comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_;
+#line 11690 ""
} else if (*(unsigned char *)charq == 's') {
+#line 11691 ""
comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_;
+#line 11692 ""
if (nnl[*ivx] > 0) {
/* If A- or W-grace, set signal to start slur on main note. */
+#line 11696 ""
if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx
+ nnl[*ivx] * 24],29)) {
+#line 11696 ""
iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx]
* 24],24);
+#line 11696 ""
}
+#line 11699 ""
}
+#line 11700 ""
} else if (*(unsigned char *)charq == 'x') {
+#line 11701 ""
comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_;
+#line 11702 ""
} else if (*(unsigned char *)charq == 'u') {
+#line 11703 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note of grace. Number will come next. */
+#line 11707 ""
++(*iccount);
+#line 11708 ""
readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace
- 1], (ftnlen)128, (ftnlen)1);
+#line 11709 ""
--(*iccount);
+#line 11710 ""
}
+#line 11711 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
+#line 11711 ""
goto L18;
+#line 11711 ""
}
/* At this point, charq is first note name in grace */
+#line 11715 ""
i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[
comgrace_1.ngrace - 1] - 1;
+#line 11715 ""
for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) {
+#line 11716 ""
comgrace_1.naccg[ing - 1] = 0;
+#line 11717 ""
ioct = 0;
+#line 11718 ""
if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) {
+#line 11719 ""
L55:
+#line 11719 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 11720 ""
if (*(unsigned char *)charq == ' ') {
+#line 11720 ""
goto L55;
+#line 11720 ""
}
+#line 11721 ""
}
+#line 11722 ""
iclastlev = 0;
+#line 11723 ""
L9:
+#line 11723 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11724 ""
if (*(unsigned char *)durq != ' ') {
+#line 11725 ""
if (*(unsigned char *)durq == '+') {
+#line 11726 ""
*lastlev += 7;
+#line 11727 ""
iclastlev += 7;
+#line 11728 ""
} else if (*(unsigned char *)durq == '-') {
+#line 11729 ""
*lastlev += -7;
+#line 11730 ""
iclastlev += -7;
+#line 11731 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
+#line 11732 ""
if (comgrace_1.naccg[ing - 1] == 0) {
+#line 11733 ""
comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3,
(ftnlen)1);
+#line 11734 ""
} else {
/* Double accidental */
+#line 11738 ""
comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing
- 1],2);
+#line 11739 ""
}
+#line 11740 ""
} else {
+#line 11741 ""
ioct = *(unsigned char *)durq - 48;
+#line 11742 ""
}
+#line 11743 ""
goto L9;
+#line 11744 ""
}
+#line 11745 ""
if (ioct > 0) {
+#line 11746 ""
*lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[
cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1);
+#line 11747 ""
} else {
+#line 11748 ""
if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace
- 1]) {
+#line 11749 ""
if (*ivx <= *nv) {
+#line 11750 ""
kv = 1;
+#line 11751 ""
} else {
+#line 11752 ""
kv = 2;
+#line 11753 ""
}
+#line 11754 ""
*lastlev = ndlev[*iv + kv * 24] + iclastlev;
+#line 11755 ""
}
+#line 11756 ""
*lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, &
cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] -
1], (ftnlen)1) - *lastlev + 3) % 7;
+#line 11758 ""
}
+#line 11759 ""
comgrace_1.nolevg[ing - 1] = *lastlev;
+#line 11760 ""
/* L19: */
+#line 11760 ""
}
/* Grace could come before first note of block, so reset end level. */
+#line 11764 ""
if (nnl[*ivx] == 0) {
+#line 11765 ""
if (*ivx <= *nv) {
+#line 11766 ""
kv = 1;
+#line 11767 ""
} else {
+#line 11768 ""
kv = 2;
+#line 11769 ""
}
+#line 11770 ""
ndlev[*iv + kv * 24] = *lastlev;
+#line 11771 ""
}
+#line 11772 ""
return 0;
} /* getgrace_ */
@@ -17295,96 +28493,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 11811 ""
*(unsigned char *)durq = 'x';
/* Can't initialize in declaration stmt, only works onc */
+#line 11812 ""
if (! cominsttrans_1.earlytranson) {
+#line 11812 ""
cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0;
+#line 11812 ""
}
+#line 11813 ""
store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && !
(*from1);
+#line 11815 ""
cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0;
+#line 11816 ""
if (store) {
+#line 11816 ""
cominsttrans_1.ninsttrans = 0;
+#line 11816 ""
}
+#line 11817 ""
L1:
+#line 11818 ""
if (*(unsigned char *)durq == ' ') {
+#line 11818 ""
return 0;
+#line 11818 ""
}
+#line 11819 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11820 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 11821 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"
+#line 11821 ""
+ errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"\
"ere!", (ftnlen)128, (ftnlen)40);
+#line 11823 ""
stop1_();
+#line 11824 ""
}
+#line 11825 ""
if (store) {
+#line 11825 ""
++cominsttrans_1.ninsttrans;
+#line 11825 ""
}
+#line 11826 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11827 ""
instn = i_nint(&fnum);
+#line 11828 ""
if (instn > *noinst) {
+#line 11829 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 11829 ""
errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", (
ftnlen)128, (ftnlen)31);
+#line 11831 ""
stop1_();
+#line 11832 ""
}
+#line 11833 ""
if (store) {
+#line 11833 ""
cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn;
+#line 11833 ""
}
/* durq is +/- following inst # (for iTransAmt), iccount is on it. */
+#line 11837 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 11838 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"
+#line 11838 ""
+ errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"\
"r must be \"+,-\"!", (ftnlen)128, (ftnlen)52);
+#line 11840 ""
stop1_();
+#line 11841 ""
}
+#line 11842 ""
itramt = 44 - *(unsigned char *)durq;
/* +1/-1 for itramt */
+#line 11843 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11844 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 11845 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"
+#line 11845 ""
+ errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"\
" here!", (ftnlen)128, (ftnlen)42);
+#line 11847 ""
stop1_();
+#line 11848 ""
}
+#line 11849 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11850 ""
if (store) {
+#line 11850 ""
cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt;
+#line 11850 ""
}
/* durq is +/- following iTransAmt (for iTransKey), iccount is on it. */
+#line 11854 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 11855 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "1st character after transposition am"
+#line 11855 ""
+ errmsg_(lineq, iccount, &i__1, "1st character after transposition am"\
"ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55);
+#line 11857 ""
stop1_();
+#line 11858 ""
}
+#line 11859 ""
ikey = 44 - *(unsigned char *)durq;
/* +1/-1 */
+#line 11860 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11861 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 11862 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 11862 ""
errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!",
(ftnlen)128, (ftnlen)35);
+#line 11864 ""
stop1_();
+#line 11865 ""
}
+#line 11866 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 11867 ""
if (store) {
+#line 11867 ""
cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(&
fnum) * ikey;
+#line 11867 ""
}
/* durq is now 1st character after iTransKey, should be either 'i' or ' ' */
+#line 11871 ""
if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') {
+#line 11872 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 11872 ""
errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", (
ftnlen)128, (ftnlen)32);
+#line 11874 ""
stop1_();
+#line 11875 ""
}
+#line 11876 ""
goto L1;
} /* getitransinfo_ */
@@ -17426,8 +28694,8 @@ L1:
char *, real *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___726 = { 0, 6, 0, "(a)", 0 };
- static cilist io___727 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___757 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___758 = { 0, 15, 0, "(a)", 0 };
/* subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
@@ -17447,278 +28715,467 @@ L1:
/* bsXobXbaXclXflXreXctXvo */
+#line 11924 ""
L1:
+#line 11924 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11925 ""
if (*(unsigned char *)durq == 't') {
/* Tempo in beats ber minute */
+#line 11929 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11930 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 11931 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"
+#line 11931 ""
+ errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\
" pause!", (ftnlen)128, (ftnlen)39);
+#line 11933 ""
stop1_();
/* else if (mmacrec) then */
/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
/* * 'Cannot change MIDI tempo while recording a MidiMacro!') */
/* call stop1() */
+#line 11938 ""
}
+#line 11939 ""
readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1);
+#line 11940 ""
--(*iccount);
+#line 11941 ""
if (! (*first)) {
+#line 11942 ""
i__1 = i_nint(&qpm);
+#line 11942 ""
midievent_("t", &i__1, &c__0, (ftnlen)1);
+#line 11943 ""
commmac_1.gottempo = TRUE_;
+#line 11944 ""
}
+#line 11945 ""
goto L1;
+#line 11946 ""
} else if (*(unsigned char *)durq == 'p') {
/* Insert a pause. pausemid = pause in 1/4's */
+#line 11950 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11951 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+#line 11952 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"
+#line 11952 ""
+ errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"\
"ause!", (ftnlen)128, (ftnlen)37);
+#line 11954 ""
stop1_();
+#line 11955 ""
}
+#line 11956 ""
readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1);
+#line 11957 ""
--(*iccount);
+#line 11958 ""
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 11963 ""
r__1 = pausemid * 4;
+#line 11963 ""
numb16 = i_nint(&r__1);
+#line 11964 ""
midievent_("m", &numb16, &c__16, (ftnlen)1);
/* Put in pausemid beats of rest */
+#line 11968 ""
i__1 = commidi_1.numchan - 1;
+#line 11968 ""
for (icm = 0; icm <= i__1; ++icm) {
+#line 11969 ""
r__1 = numb16 * 4.f;
+#line 11969 ""
addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false);
+#line 11970 ""
/* L3: */
+#line 11970 ""
}
+#line 11971 ""
r__1 = pausemid * 240;
+#line 11971 ""
comevent_1.miditime += i_nint(&r__1);
/* Restore meter */
+#line 11975 ""
i__1 = *mtrdenl * *lenbar / 64;
+#line 11975 ""
midievent_("m", &i__1, mtrdenl, (ftnlen)1);
+#line 11976 ""
}
+#line 11977 ""
goto L1;
+#line 11978 ""
} else if (*(unsigned char *)durq == 'i') {
/* c Instrument numbers or letters. Expect nv of them. */
/* Instrument numbers or letters. Expect noinst of them. */
/* do 2 ivx = 1 , nv */
+#line 11984 ""
i__1 = *noinstarg;
+#line 11984 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
+#line 11985 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 11986 ""
if (*(unsigned char *)durq > 96) {
/* It's a lowercase letter. Get another, find corr. instrument #. */
+#line 11990 ""
*(unsigned char *)instq = *(unsigned char *)durq;
+#line 11991 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Writing concatenation */
+#line 11992 ""
i__2[0] = 1, a__1[0] = instq;
+#line 11992 ""
i__2[1] = 1, a__1[1] = durq;
+#line 11992 ""
s_cat(instq, a__1, i__2, &c__2, (ftnlen)2);
- iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"
+#line 11993 ""
+ iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"\
"frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen)
79, (ftnlen)2) / 3;
+#line 11995 ""
if (iname == 0) {
+#line 11996 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"
+#line 11996 ""
+ errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"\
"di instrument name!", (ftnlen)128, (ftnlen)43);
+#line 11998 ""
stop1_();
+#line 11999 ""
}
+#line 12000 ""
commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1;
+#line 12001 ""
} 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 12007 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 12008 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"
+#line 12008 ""
+ errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"\
"nt number here!", (ftnlen)128, (ftnlen)39);
+#line 12010 ""
stop1_();
+#line 12011 ""
}
+#line 12012 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12013 ""
commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1;
+#line 12014 ""
if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx -
1] > 255) {
+#line 12015 ""
i__3 = *iccount - 1;
+#line 12015 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"
+#line 12015 ""
+ errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"\
"t be in range 1-128!", (ftnlen)128, (ftnlen)46);
+#line 12017 ""
stop1_();
+#line 12018 ""
}
+#line 12019 ""
if (*(unsigned char *)durq != ':') {
+#line 12019 ""
--(*iccount);
+#line 12019 ""
}
+#line 12020 ""
}
+#line 12021 ""
/* L2: */
+#line 12021 ""
}
+#line 12022 ""
goto L1;
+#line 12023 ""
} else if (*(unsigned char *)durq == 'v') {
/* Get volumes for each instrument. Expect nv of them. */
/* Follow same pattern as for insttrument numbers above. */
/* do 7 ivx = 1 , nv */
+#line 12029 ""
i__1 = *noinstarg;
+#line 12029 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
+#line 12030 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12031 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 12032 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"
+#line 12032 ""
+ errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"\
"ber here!", (ftnlen)128, (ftnlen)37);
+#line 12034 ""
stop1_();
+#line 12035 ""
}
+#line 12036 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12037 ""
commvel_2.midivel[ivx - 1] = i_nint(&fnum) - 1;
+#line 12038 ""
if (commvel_2.midivel[ivx - 1] < 0 || commvel_2.midivel[ivx - 1]
> 127) {
+#line 12039 ""
i__3 = *iccount - 1;
+#line 12039 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"
+#line 12039 ""
+ errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"\
" 1-128!", (ftnlen)128, (ftnlen)37);
+#line 12041 ""
stop1_();
+#line 12042 ""
}
+#line 12043 ""
if (*(unsigned char *)durq != ':') {
+#line 12043 ""
--(*iccount);
+#line 12043 ""
}
+#line 12044 ""
/* L7: */
+#line 12044 ""
}
+#line 12045 ""
goto L1;
+#line 12046 ""
} else if (*(unsigned char *)durq == 'b') {
/* Get balance for each instrument. Expect nv of them. */
/* Follow same pattern as for instrument numbers above. */
/* do 8 ivx = 1 , nv */
+#line 12052 ""
i__1 = *noinstarg;
+#line 12052 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
+#line 12053 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12054 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 12055 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__3, "Expected a balance number he"
+#line 12055 ""
+ errmsg_(lineq, iccount, &i__3, "Expected a balance number he"\
"re!", (ftnlen)128, (ftnlen)31);
+#line 12057 ""
stop1_();
+#line 12058 ""
}
+#line 12059 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12060 ""
commvel_2.midibal[ivx - 1] = i_nint(&fnum) - 1;
+#line 12061 ""
if (commvel_2.midibal[ivx - 1] < 0 || commvel_2.midibal[ivx - 1]
> 127) {
+#line 12062 ""
i__3 = *iccount - 1;
+#line 12062 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "
+#line 12062 ""
+ errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "\
"1-128!", (ftnlen)128, (ftnlen)36);
+#line 12064 ""
stop1_();
+#line 12065 ""
}
+#line 12066 ""
if (*(unsigned char *)durq != ':') {
+#line 12066 ""
--(*iccount);
+#line 12066 ""
}
+#line 12067 ""
/* L8: */
+#line 12067 ""
}
+#line 12068 ""
goto L1;
+#line 12069 ""
} else if (*(unsigned char *)durq == 'T') {
/* Get transposition for each instrument. Expect nv of them. */
/* Follow similar pattern as above, but separator is +|-. */
/* do 9 ivx = 1 , nv */
+#line 12075 ""
i__1 = *noinstarg;
+#line 12075 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
+#line 12076 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12077 ""
ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1);
+#line 12078 ""
if (ipm == 0) {
+#line 12079 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "
+#line 12079 ""
+ errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "\
"midi transposition here!", (ftnlen)128, (ftnlen)48);
+#line 12081 ""
stop1_();
+#line 12082 ""
}
+#line 12083 ""
ipm = (ipm << 1) - 3;
+#line 12084 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12085 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 12086 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 12086 ""
errmsg_(lineq, iccount, &i__3, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
+#line 12088 ""
stop1_();
+#line 12089 ""
}
+#line 12090 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12091 ""
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 12097 ""
--(*iccount);
+#line 12098 ""
/* L9: */
+#line 12098 ""
}
+#line 12099 ""
goto L1;
+#line 12100 ""
} else if (*(unsigned char *)durq == 'g') {
+#line 12101 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12102 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 12103 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"
+#line 12103 ""
+ errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\
" midi gap!", (ftnlen)128, (ftnlen)42);
+#line 12105 ""
stop1_();
+#line 12106 ""
}
+#line 12107 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12108 ""
commidi_1.mgap = i_nint(&fnum);
+#line 12109 ""
--(*iccount);
+#line 12110 ""
goto L1;
+#line 12111 ""
} else if (*(unsigned char *)durq == 'M') {
/* MidiMacros */
+#line 12115 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12116 ""
if (*(unsigned char *)durq == 'R') {
/* Start recording */
+#line 12120 ""
if (commmac_1.mmacrec) {
+#line 12121 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"
+#line 12121 ""
+ errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"\
"cro while already recording!", (ftnlen)128, (ftnlen)
56);
+#line 12123 ""
stop1_();
+#line 12124 ""
}
+#line 12125 ""
commmac_1.mmacrec = TRUE_;
+#line 12126 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12127 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 12128 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"
+#line 12128 ""
+ errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\
" here!", (ftnlen)128, (ftnlen)34);
+#line 12130 ""
stop1_();
+#line 12131 ""
}
+#line 12132 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12133 ""
--(*iccount);
+#line 12134 ""
if (! (*first)) {
+#line 12135 ""
commmac_1.immac = i_nint(&fnum);
+#line 12136 ""
if (commmac_1.immac > 20) {
+#line 12137 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"
+#line 12137 ""
+ errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"\
"ed 20!", (ftnlen)128, (ftnlen)30);
+#line 12139 ""
stop1_();
+#line 12140 ""
}
/* Save the start time */
+#line 12144 ""
commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime;
+#line 12145 ""
i__1 = commidi_1.numchan;
+#line 12145 ""
for (icm = 0; icm <= i__1; ++icm) {
+#line 12146 ""
if (icm < commidi_1.numchan) {
+#line 12147 ""
if (commidi_1.restpend[icm]) {
/* Adjust if there's a rest at end of prior section. Insert dummy turnoff. */
@@ -17727,175 +29184,294 @@ L1:
/* Before: section1 ------rest------- section2(to be recorded) */
/* After: section1 rest1 now rest2 section2(recorded) */
+#line 12155 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
+#line 12156 ""
commidi_1.trest[icm] = 0.f;
+#line 12157 ""
commidi_1.restpend[icm] = FALSE_;
+#line 12158 ""
}
+#line 12159 ""
} else {
+#line 12160 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track */
+#line 12164 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
+#line 12164 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
+#line 12166 ""
comevent_1.lasttime = comevent_1.miditime;
+#line 12167 ""
}
+#line 12168 ""
}
+#line 12169 ""
commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] =
commidi_1.imidi[icm] + 1;
+#line 12170 ""
/* L4: */
+#line 12170 ""
}
+#line 12171 ""
}
+#line 12172 ""
goto L1;
+#line 12173 ""
} else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) {
/* End recording; close the open macro. Get immac from common. */
+#line 12177 ""
if (! commmac_1.mmacrec) {
+#line 12178 ""
i__1 = *iccount - 1;
+#line 12178 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"
+#line 12178 ""
+ errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"\
"efore starting one!", (ftnlen)128, (ftnlen)49);
+#line 12180 ""
stop1_();
+#line 12181 ""
}
+#line 12182 ""
commmac_1.mmacrec = FALSE_;
+#line 12183 ""
--(*iccount);
+#line 12184 ""
if (! (*first)) {
/* Save the macro duration */
+#line 12188 ""
commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime
- commmac_1.mmactime[commmac_1.immac - 1];
+#line 12189 ""
i__1 = commidi_1.numchan;
+#line 12189 ""
for (icm = 0; icm <= i__1; ++icm) {
+#line 12190 ""
if (icm < commidi_1.numchan) {
+#line 12191 ""
if (commidi_1.restpend[icm]) {
+#line 12192 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
+#line 12193 ""
commidi_1.trest[icm] = 0.f;
+#line 12194 ""
commidi_1.restpend[icm] = FALSE_;
+#line 12195 ""
}
+#line 12196 ""
} else {
+#line 12197 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track if needed. */
+#line 12201 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
+#line 12201 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
+#line 12203 ""
comevent_1.lasttime = comevent_1.miditime;
+#line 12204 ""
}
+#line 12205 ""
}
+#line 12206 ""
commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] =
commidi_1.imidi[icm];
+#line 12207 ""
/* L5: */
+#line 12207 ""
}
+#line 12208 ""
}
+#line 12209 ""
if (*(unsigned char *)durq != ' ') {
+#line 12209 ""
goto L1;
+#line 12209 ""
}
+#line 12210 ""
} else if (*(unsigned char *)durq == 'P') {
/* Play Back a Macro */
+#line 12214 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12215 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 12216 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"
+#line 12216 ""
+ errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\
" here!", (ftnlen)128, (ftnlen)34);
+#line 12218 ""
stop1_();
+#line 12219 ""
}
+#line 12220 ""
if (commmac_1.mmacrec) {
+#line 12221 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"
+#line 12221 ""
+ errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"\
"o before ending recording!", (ftnlen)128, (ftnlen)54);
+#line 12223 ""
stop1_();
+#line 12224 ""
}
+#line 12225 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 12226 ""
--(*iccount);
+#line 12227 ""
if (! (*first)) {
+#line 12228 ""
commmac_1.immac = i_nint(&fnum);
+#line 12229 ""
if (commmac_1.mmactime[commmac_1.immac - 1] == 0) {
+#line 12230 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"
+#line 12230 ""
+ errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"\
" before recording it!", (ftnlen)128, (ftnlen)45);
+#line 12232 ""
stop1_();
+#line 12233 ""
}
+#line 12234 ""
i__1 = commidi_1.numchan;
+#line 12234 ""
for (icm = 0; icm <= i__1; ++icm) {
+#line 12235 ""
if (icm < commidi_1.numchan) {
+#line 12236 ""
if (commidi_1.restpend[icm]) {
+#line 12237 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
+#line 12238 ""
commidi_1.trest[icm] = 0.f;
+#line 12239 ""
commidi_1.restpend[icm] = FALSE_;
+#line 12240 ""
}
+#line 12241 ""
} else {
+#line 12242 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track */
+#line 12246 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
+#line 12246 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
+#line 12248 ""
}
+#line 12249 ""
}
+#line 12250 ""
commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] =
commidi_1.imidi[icm];
+#line 12251 ""
commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 -
25] = commmac_1.mmacstrt[icm + commmac_1.immac *
25 - 25];
+#line 12252 ""
commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25]
= commmac_1.mmacend[icm + commmac_1.immac * 25 -
25];
+#line 12253 ""
commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 -
25] = commidi_1.imidi[icm] + 1;
+#line 12254 ""
/* L6: */
+#line 12254 ""
}
+#line 12255 ""
commmac_1.nmidsec += 2;
/* Update running time */
+#line 12259 ""
comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1]
;
+#line 12260 ""
comevent_1.lasttime = comevent_1.miditime;
+#line 12261 ""
}
+#line 12262 ""
goto L1;
+#line 12263 ""
} else {
+#line 12264 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"
+#line 12264 ""
+ errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"\
"ub-command!", (ftnlen)128, (ftnlen)43);
+#line 12266 ""
stop1_();
+#line 12267 ""
}
+#line 12268 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 12269 ""
commidi_1.debugmidi = TRUE_;
+#line 12270 ""
goto L1;
+#line 12271 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 12272 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 12272 ""
errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!"
, (ftnlen)128, (ftnlen)37);
- s_wsfe(&io___726);
- do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "
+#line 12274 ""
+ s_wsfe(&io___757);
+#line 12274 ""
+ 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 12274 ""
e_wsfe();
- s_wsfe(&io___727);
- do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "
+#line 12277 ""
+ s_wsfe(&io___758);
+#line 12277 ""
+ 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 12277 ""
e_wsfe();
+#line 12280 ""
stop1_();
+#line 12281 ""
}
+#line 12282 ""
if (! commmac_1.gottempo && ! (*first)) {
/* If no tempo is set on first call on the pmxb pass, then set it */
+#line 12286 ""
midievent_("t", &c__96, &c__0, (ftnlen)1);
+#line 12287 ""
commmac_1.gottempo = TRUE_;
+#line 12288 ""
}
+#line 12289 ""
return 0;
} /* getmidi_ */
@@ -17927,6 +29503,7 @@ L1:
integer s_wsfi(icilist *), e_wsfi(void);
/* Local variables */
+ static real tintstf;
static integer lentemp;
extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
ftnlen), getgrace_(integer *, integer *, char *, integer *,
@@ -17935,12 +29512,14 @@ L1:
extern integer igetbits_(integer *, integer *, integer *);
static integer idotform;
extern /* Subroutine */ int newvoice_(integer *, char *, logical *,
- ftnlen), dopmxlyr_(char *, integer *, ftnlen);
- static integer j;
+ ftnlen);
+ static integer multtrem;
+ extern /* Subroutine */ int dopmxlyr_(char *, integer *, ftnlen);
+ static integer j, note1xtup;
extern /* Subroutine */ int readmeter_(char *, integer *, integer *,
integer *, ftnlen), midievent_(char *, integer *, integer *,
ftnlen);
- static integer ic, jv, kv, iip, ipm, ivf, ndx, isl, iiv;
+ static integer ic, jv, kv, nnb, iip, ipm, ivf, ndx, isl, iiv;
static real dum;
static integer iis, npg1, num1, iadj, nadj, lclf;
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
@@ -17956,6 +29535,7 @@ L1:
static integer ipg1r;
extern /* Subroutine */ int stop1_(void);
static integer lhead;
+ static real pmfac;
static char charq[1], lineq[128];
static logical moved;
static integer ndoub;
@@ -17968,8 +29548,9 @@ L1:
integer *, integer *, integer *, integer *, ftnlen);
static logical quoted;
static char lineqt[128], hdlndq[59];
+ static logical inxtup;
extern integer lenstr_(char *, integer *, ftnlen);
- static integer numnum;
+ static integer numnum, nsolid;
extern /* Subroutine */ int getorn_(char *, integer *, integer *, integer
*, logical *, integer *, integer *, integer *, logical *, logical
*, integer *, ftnlen);
@@ -17993,121 +29574,164 @@ L1:
ftnlen), getmidi_(integer *, char *, integer *, integer *,
integer *, integer *, integer *, integer *, logical *, ftnlen),
readnum_(char *, integer *, char *, real *, ftnlen, ftnlen);
- static integer iofforn;
+ static integer nindent;
extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
integer *), chkpm4ac_(char *, integer *, integer *, logical *,
ftnlen);
- static integer numshft;
+ extern integer ifnodur_(integer *, char *, ftnlen);
+ static integer numshft, iofforn;
static real xofforn;
- extern integer ifnolev_(char *, integer *, integer *, ftnlen), ifnodur_(
- integer *, char *, ftnlen), numclef_(char *, ftnlen);
+ extern integer ifnolev_(char *, integer *, integer *, ftnlen), numclef_(
+ char *, ftnlen);
static integer itother;
- static real fmovbrk;
extern /* Subroutine */ int spsslur_(char *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, logical *, integer *, char *, ftnlen, ftnlen);
+ static real fmovbrk;
static integer lvoltxt, ltopnam, namstrt;
- static real tintstf;
/* Fortran I/O blocks */
- static cilist io___731 = { 0, 11, 0, "(a)", 0 };
- static cilist io___739 = { 0, 6, 0, 0, 0 };
- static cilist io___755 = { 0, 6, 0, 0, 0 };
- static cilist io___756 = { 0, 6, 0, 0, 0 };
- static cilist io___768 = { 0, 6, 0, 0, 0 };
- static cilist io___770 = { 0, 6, 0, 0, 0 };
+ static cilist io___763 = { 0, 11, 0, "(a)", 0 };
static cilist io___771 = { 0, 6, 0, 0, 0 };
- static cilist io___774 = { 0, 6, 0, 0, 0 };
- static cilist io___779 = { 0, 11, 0, "(a)", 0 };
- static cilist io___780 = { 0, 11, 0, "(a)", 0 };
- static cilist io___783 = { 0, 11, 0, "(a)", 0 };
- static cilist io___784 = { 0, 11, 0, "(a)", 0 };
- static cilist io___785 = { 0, 11, 0, "(a)", 0 };
- static cilist io___786 = { 0, 11, 0, "(a)", 0 };
- static cilist io___787 = { 0, 11, 0, "(a)", 0 };
- static cilist io___788 = { 0, 11, 0, "(a11,i2,a)", 0 };
- static cilist io___789 = { 0, 11, 0, "(a9,i2,a)", 0 };
- static cilist io___791 = { 0, 11, 0, "(a8,i1,a3)", 0 };
- static cilist io___792 = { 0, 11, 0, "(a9,i2,a4)", 0 };
- static cilist io___793 = { 0, 11, 0, "(a8,i1,a)", 0 };
- static cilist io___794 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___782 = { 0, 6, 0, 0, 0 };
+ static cilist io___783 = { 0, 6, 0, 0, 0 };
+ static cilist io___794 = { 0, 6, 0, 0, 0 };
static cilist io___795 = { 0, 6, 0, 0, 0 };
- static cilist io___796 = { 0, 6, 0, 0, 0 };
- static cilist io___805 = { 0, 6, 0, 0, 0 };
- static cilist io___807 = { 0, 11, 0, "(a)", 0 };
- static cilist io___808 = { 0, 11, 0, "(a)", 0 };
- static cilist io___809 = { 0, 11, 0, "(a)", 0 };
- static cilist io___810 = { 0, 11, 0, "(a)", 0 };
- static cilist io___812 = { 0, 11, 0, "(a)", 0 };
- static cilist io___815 = { 0, 11, 0, "(a)", 0 };
- static cilist io___816 = { 0, 11, 0, "(a)", 0 };
- static cilist io___817 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___808 = { 0, 6, 0, 0, 0 };
+ static cilist io___810 = { 0, 6, 0, 0, 0 };
+ static cilist io___811 = { 0, 6, 0, 0, 0 };
+ static cilist io___813 = { 0, 6, 0, 0, 0 };
static cilist io___818 = { 0, 11, 0, "(a)", 0 };
static cilist io___819 = { 0, 11, 0, "(a)", 0 };
- static cilist io___820 = { 0, 11, 0, "(a)", 0 };
- static cilist io___821 = { 0, 11, 0, "(a)", 0 };
static cilist io___822 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___823 = { 0, 11, 0, "(a)", 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___827 = { 0, 11, 0, "(a11,i2,a)", 0 };
+ static cilist io___828 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___830 = { 0, 11, 0, "(a8,i1,a3)", 0 };
+ static cilist io___831 = { 0, 11, 0, "(a9,i2,a4)", 0 };
+ static cilist io___832 = { 0, 11, 0, "(a8,i1,a)", 0 };
+ static cilist io___833 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___834 = { 0, 6, 0, 0, 0 };
+ static cilist io___835 = { 0, 6, 0, 0, 0 };
+ static cilist io___837 = { 0, 6, 0, 0, 0 };
+ static cilist io___845 = { 0, 6, 0, 0, 0 };
+ static cilist io___847 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___848 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___849 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___850 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___852 = { 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___857 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___858 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___859 = { 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 };
/* 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 12411 ""
cdot = FALSE_;
+#line 12412 ""
+ inxtup = FALSE_;
+#line 12413 ""
L1:
+#line 12413 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 12414 ""
if (comget_1.lastchar) {
+#line 12414 ""
return 0;
+#line 12414 ""
}
+#line 12415 ""
if (*(unsigned char *)charq == ' ') {
+#line 12415 ""
goto L1;
+#line 12415 ""
}
+#line 12416 ""
if (*(unsigned char *)charq == '%') {
/* Check for a bar number format: */
+#line 12420 ""
if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' &&
i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0)
{
+#line 12422 ""
if (comlast_1.islast) {
- s_wsfe(&io___731);
+#line 12422 ""
+ s_wsfe(&io___763);
+#line 12422 ""
do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128));
+#line 12422 ""
e_wsfe();
+#line 12422 ""
}
+#line 12423 ""
}
+#line 12424 ""
all_1.iccount = 128;
+#line 12425 ""
goto L1;
+#line 12426 ""
}
/* Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */
+#line 12430 ""
if (comget_1.rptprev) {
+#line 12431 ""
comget_1.rptnd1 = *(unsigned char *)charq == '/';
+#line 12432 ""
comget_1.rptprev = FALSE_;
+#line 12433 ""
}
/* Repeat at end of a piece */
+#line 12437 ""
if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *(
unsigned char *)charq == 'r') {
+#line 12439 ""
if (cdot) {
+#line 12439 ""
goto L28;
+#line 12439 ""
}
/* This is a note/rest. */
+#line 12443 ""
idotform = 0;
+#line 12444 ""
numnum = 0;
/* If start of line of music, set pitch from previous */
+#line 12448 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 12449 ""
kv = 1;
+#line 12450 ""
} else {
+#line 12451 ""
kv = 2;
+#line 12452 ""
}
+#line 12453 ""
if (all_1.nnl[commvl_1.ivx - 1] == 0) {
+#line 12453 ""
comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25];
+#line 12453 ""
}
/* notcrd is used to tell if orn. goes on main note or chord note */
@@ -18116,45 +29740,63 @@ L1:
/* Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */
+#line 12461 ""
L28:
/* Moved this from just above, 2 Feb 02 */
+#line 12465 ""
comnotes_1.notcrd = TRUE_;
+#line 12466 ""
++all_1.nnl[commvl_1.ivx - 1];
+#line 12467 ""
if (comget_1.ornrpt) {
/* Replicate ornament bits, also bit 23 for beam handling if chord. */
+#line 12471 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1]
|= all_1.iornq[commvl_1.ivx - 1];
+#line 12472 ""
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 12476 ""
++comtrill_1.ntrill;
+#line 12477 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
+#line 12478 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
+#line 12479 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[
comtrill_1.ntrill - 2];
+#line 12480 ""
}
+#line 12481 ""
}
+#line 12482 ""
if (comget_1.stickys) {
/* Grab stemlength shortening parameters from prior note */
+#line 12486 ""
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 12489 ""
i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10);
+#line 12489 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &c__6, &c__10, &i__1);
+#line 12491 ""
}
+#line 12492 ""
if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && !
comget_1.fbon) {
@@ -18162,337 +29804,660 @@ L28:
/* starts a period. */
/* if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */
+#line 12498 ""
r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
+#line 12498 ""
if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
/* Start a forced beam here */
+#line 12502 ""
++comfb_1.nfb[commvl_1.ivx - 1];
+#line 12503 ""
comget_1.fbon = TRUE_;
+#line 12504 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
commvl_1.ivx - 1] * 24 - 25] = 'x';
+#line 12505 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
+#line 12506 ""
}
+#line 12507 ""
}
+#line 12508 ""
if (comget_1.fbon) {
+#line 12508 ""
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 12508 ""
}
+#line 12509 ""
*(unsigned char *)dotq = 'x';
+#line 12510 ""
if (*(unsigned char *)charq == 'r') {
+#line 12510 ""
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 12510 ""
}
+#line 12512 ""
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 12516 ""
i__1 = all_1.iccount;
+#line 12516 ""
if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1)
== 0 && all_1.nnl[commvl_1.ivx - 1] > 1) {
+#line 12518 ""
if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25],19)) {
+#line 12518 ""
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 12518 ""
}
+#line 12520 ""
}
/* 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 12526 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 12527 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = 0;
+#line 12528 ""
} else {
+#line 12529 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = 2;
+#line 12530 ""
}
+#line 12531 ""
}
+#line 12532 ""
L2:
+#line 12532 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12533 ""
ic = *(unsigned char *)durq;
+#line 12534 ""
if (ic <= 57 && ic >= 48) {
/* Digit */
+#line 12538 ""
if (numnum == 0) {
+#line 12539 ""
comnotes_1.nnodur = ic - 48;
+#line 12540 ""
numnum = 1;
+#line 12541 ""
goto L2;
+#line 12542 ""
} else if (numnum == 1) {
+#line 12543 ""
ioct = ic - 48;
+#line 12544 ""
numnum = 2;
+#line 12545 ""
goto L2;
+#line 12546 ""
} else {
- s_wsle(&io___739);
+#line 12547 ""
+ s_wsle(&io___771);
+#line 12547 ""
do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", (
ftnlen)31);
+#line 12547 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
+#line 12547 ""
do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
ftnlen)sizeof(integer));
+#line 12547 ""
e_wsle();
+#line 12548 ""
stop1_();
+#line 12549 ""
}
+#line 12550 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 12551 ""
*(unsigned char *)dotq = *(unsigned char *)durq;
+#line 12552 ""
i__1 = all_1.iccount;
+#line 12552 ""
if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1)
== 0) {
/* Double dot. */
+#line 12556 ""
++all_1.iccount;
+#line 12557 ""
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 12558 ""
}
+#line 12559 ""
i__1 = all_1.iccount;
+#line 12559 ""
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 12563 ""
i__1 = all_1.iccount + 1;
+#line 12563 ""
if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
all_1.iccount + 2 - i__1) == 0) {
+#line 12563 ""
goto L2;
+#line 12563 ""
}
+#line 12565 ""
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 12566 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12567 ""
++comcc_1.ndotmv[commvl_1.ivx - 1];
+#line 12568 ""
++all_1.iccount;
+#line 12569 ""
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 12570 ""
if (*(unsigned char *)durq == '-') {
+#line 12570 ""
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 12570 ""
}
+#line 12572 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift also */
+#line 12576 ""
++all_1.iccount;
+#line 12577 ""
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 12578 ""
if (*(unsigned char *)dumq == '-') {
+#line 12578 ""
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 12578 ""
}
+#line 12580 ""
} else {
+#line 12581 ""
comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx
- 1] * 24 - 25] = 0.f;
+#line 12582 ""
}
+#line 12583 ""
--all_1.iccount;
+#line 12584 ""
}
+#line 12585 ""
goto L2;
+#line 12586 ""
} else if (*(unsigned char *)durq == 'p') {
/* Full-bar rest as pause */
+#line 12590 ""
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 12591 ""
goto L2;
+#line 12592 ""
} else if (*(unsigned char *)durq == 'b') {
/* Blank rest */
+#line 12596 ""
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 12597 ""
goto L2;
+#line 12598 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Accidental */
- if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
- 25] == 0) {
+/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */
+/* 171209 May have set bit 18 earlier if D or F preceded accidental */
+#line 12604 ""
+ 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 12609 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
- 25] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1);
+ 25] |= i_indx("fsn", durq, (ftnlen)3, (ftnlen)1);
+#line 12611 ""
} else {
/* Repeated accid, so must be double */
+#line 12615 ""
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 12616 ""
}
+#line 12617 ""
goto L2;
+#line 12618 ""
} else if (*(unsigned char *)durq == 'i') {
/* Set flag for MIDI-only accidental. */
+#line 12622 ""
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 12623 ""
goto L2;
+#line 12624 ""
} else if (*(unsigned char *)durq == 'c') {
/* Set flags for cautionary accidental */
+#line 12628 ""
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 12629 ""
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 12630 ""
goto L2;
+#line 12631 ""
} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
+#line 12632 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
+#line 12633 ""
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 12637 ""
chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, (
ftnlen)128);
+#line 12638 ""
if (moved) {
+#line 12638 ""
goto L2;
+#line 12638 ""
}
/* Octave jump with a note */
+#line 12642 ""
if (numnum < 2) {
+#line 12643 ""
comnotes_1.lastlev += ipm * 7;
+#line 12644 ""
} else {
+#line 12645 ""
ioct += ipm;
+#line 12646 ""
}
+#line 12647 ""
goto L2;
+#line 12648 ""
} else {
/* Override default height of a rest */
+#line 12652 ""
++all_1.iccount;
+#line 12653 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 12654 ""
i__1 = all_1.iccount - 2;
+#line 12654 ""
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 ",") */
- all_1.iccount += -2;
- goto L2;
+#line 12659 ""
+ --all_1.iccount;
+/* go to 2 */
+#line 12661 ""
}
+#line 12662 ""
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 12666 ""
--all_1.iccount;
+#line 12667 ""
goto L2;
+#line 12668 ""
}
+#line 12669 ""
} else if (*(unsigned char *)durq == 'x') {
/* Xtuplet. Count number of doubled notes (for unequal xtups) */
+#line 12673 ""
if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],18)) {
+#line 12674 ""
ndoub = 1;
+#line 12675 ""
} else {
+#line 12676 ""
ndoub = 0;
+#line 12677 ""
+ }
+
+/* Initialize counter for # of non-rests, so can later unbeam if = 1. */
+
+#line 12681 ""
+ inxtup = TRUE_;
+#line 12682 ""
+ note1xtup = all_1.nnl[commvl_1.ivx - 1];
+#line 12683 ""
+ nnb = 0;
+#line 12684 ""
+ if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
+ - 1] * 24 - 25],0)) {
+#line 12684 ""
+ nnb = 1;
+#line 12684 ""
}
/* Will set all durations to 0 except last one. Set flag on this note. */
+#line 12688 ""
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 */
+/* Next input will be digit unless its a "T" */
+#line 12692 ""
++all_1.iccount;
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
- ntup = i_nint(&fnum);
+#line 12693 ""
+ if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'T') {
+
+/* Set up tremolo */
+
+#line 12697 ""
+ 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 12698 ""
+ ntup = 2;
+
+/* Set default beaming, based on Wikipedia article */
+/* May be a problem here is nnodur is inherited */
+
+#line 12703 ""
+ if (comnotes_1.nnodur == 4) {
+#line 12704 ""
+ nsolid = 0;
+#line 12705 ""
+ nindent = 3;
+#line 12706 ""
+ } else if (comnotes_1.nnodur == 2) {
+#line 12707 ""
+ nsolid = 3;
+#line 12708 ""
+ nindent = 0;
+#line 12709 ""
+ } else if (comnotes_1.nnodur == 8) {
+#line 12710 ""
+ nsolid = 1;
+#line 12711 ""
+ nindent = 2;
+#line 12712 ""
+ }
+#line 12713 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12714 ""
+ if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) {
+#line 12715 ""
+ nsolid = i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1)
+ - 1;
+#line 12716 ""
+ if (nsolid == 0 && comnotes_1.nnodur == 2) {
+#line 12717 ""
+ s_wsle(&io___782);
+#line 12717 ""
+ do_lio(&c__9, &c__1, "", (ftnlen)0);
+#line 12717 ""
+ e_wsle();
+#line 12718 ""
+ s_wsle(&io___783);
+#line 12718 ""
+ do_lio(&c__9, &c__1, "Unbeamed half-note 2-note trem"\
+ "olo forbidden.", (ftnlen)44);
+#line 12718 ""
+ e_wsle();
+#line 12719 ""
+ stop1_();
+#line 12720 ""
+ }
+#line 12721 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 12722 ""
+ if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0)
+ {
+#line 12723 ""
+ nindent = i_indx("0123456789", durq, (ftnlen)10, (
+ ftnlen)1) - 1;
+#line 12724 ""
+ }
+#line 12725 ""
+ }
+#line 12726 ""
+ setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
+ 1] * 24 - 25], &c__2, &c__3, &nsolid);
+#line 12727 ""
+ setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
+ 1] * 24 - 25], &c__2, &c__5, &nindent);
+#line 12728 ""
+ if (nsolid == 0) {
+#line 12729 ""
+ 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 12731 ""
+ }
+#line 12732 ""
+ 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 12733 ""
+ 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 12734 ""
+ setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
+ - 1] + 1) * 24 - 25], &c__3, &c__22, &nsolid);
+
+/* Set some force-beam parameters for the tremolo */
+
+/* Need to check if there's already a forced beam explicitly set here. */
+/* If there was, shouldn't do any harm resetting parameters. */
+
+#line 12741 ""
+ 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 12741 ""
+ ++comfb_1.nfb[commvl_1.ivx - 1];
+#line 12741 ""
+ }
+#line 12743 ""
+ comget_1.fbon = TRUE_;
+#line 12744 ""
+ *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
+ commvl_1.ivx - 1] * 24 - 25] = 'x';
+#line 12745 ""
+ comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
+ 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
+#line 12746 ""
+ 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 12747 ""
+ nadj = 0;
+
+/* Set open beamed notehead flag for half-note tremolo */
+/* Just gave 2 quarters with or without flag set. Need to fix */
+
+#line 12752 ""
+ } else {
+#line 12753 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 12754 ""
+ ntup = i_nint(&fnum);
+#line 12755 ""
+ }
+#line 12756 ""
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 12762 ""
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 12763 ""
if (*(unsigned char *)durq == 'F') {
+#line 12763 ""
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 12763 ""
}
+#line 12765 ""
ndoub = 1;
+#line 12766 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12767 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 12768 ""
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 12769 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 12770 ""
}
/* Only other possibilities here are ' ' or 'n' */
+#line 12774 ""
if (*(unsigned char *)durq == 'n') {
/* Alter xtup number */
+#line 12778 ""
i__1 = all_1.iccount;
+#line 12778 ""
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 12782 ""
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 12783 ""
} else {
+#line 12784 ""
numshft = 0;
+#line 12785 ""
L30:
+#line 12785 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 12786 ""
if (*(unsigned char *)durq == 'f') {
/* Flip up-down-ness */
+#line 12790 ""
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 12791 ""
goto L30;
+#line 12792 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical or horiz shift */
+#line 12796 ""
++numshft;
+#line 12797 ""
iofforn = 1;
+#line 12798 ""
if (*(unsigned char *)durq == '-') {
+#line 12798 ""
iofforn = -1;
+#line 12798 ""
}
+#line 12799 ""
++all_1.iccount;
+#line 12800 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
+#line 12801 ""
--all_1.iccount;
+#line 12802 ""
if (numshft == 1) {
/* Vertical shift */
/* 160214 Allow (-64,64) */
/* iofforn = iofforn*nint(xofforn) + 16 */
+#line 12807 ""
iofforn = iofforn * i_nint(&xofforn) + 64;
/* c Turn on bit 1; set bits 2-6 to iofforn */
@@ -18500,249 +30465,386 @@ L30:
/* irest(ivx,nnl(ivx)) = */
/* * ior(irest(ivx,nnl(ivx)),2+4*iofforn) */
+#line 12814 ""
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 12815 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__8, &
c__16, &iofforn);
+#line 12816 ""
} else {
/* Horizontal shift */
+#line 12820 ""
r__1 = xofforn * 10;
+#line 12820 ""
iofforn = iofforn * i_nint(&r__1) + 16;
+#line 12821 ""
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 12822 ""
setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &
c__9, &iofforn);
+#line 12823 ""
}
+#line 12824 ""
goto L30;
+#line 12825 ""
} else if (*(unsigned char *)durq == 's') {
/* Slope adjustment for bracket */
+#line 12829 ""
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 12830 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 12831 ""
iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
2;
+#line 12832 ""
++all_1.iccount;
+#line 12833 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
+#line 12834 ""
--all_1.iccount;
+#line 12835 ""
r__1 = iofforn * xofforn + 16;
+#line 12835 ""
iofforn = i_nint(&r__1);
+#line 12836 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, &
iofforn);
+#line 12837 ""
} else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1)
> 0) {
/* Replacement printed number */
+#line 12841 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
+#line 12842 ""
i__1 = i_nint(&xofforn);
+#line 12842 ""
setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, &
i__1);
+#line 12843 ""
--all_1.iccount;
+#line 12844 ""
goto L30;
+#line 12845 ""
}
+#line 12846 ""
}
+#line 12847 ""
}
/* Set note level of 1st note of xtup, provided not a rest */
+#line 12851 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],0)) {
+#line 12852 ""
if (numnum == 2) {
+#line 12853 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[
all_1.iv - 1] - 1], (ftnlen)1);
+#line 12854 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = comnotes_1.lastlev;
+#line 12855 ""
} else {
+#line 12856 ""
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 12858 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = comnotes_1.lastlev;
+#line 12859 ""
}
+#line 12860 ""
}
+#line 12861 ""
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 12865 ""
setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
c__7, &c__19, &comnotes_1.lastlev);
+#line 12866 ""
/* L40: */
+#line 12866 ""
}
+#line 12867 ""
numnum = 0;
+#line 12868 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= 0;
+#line 12869 ""
i__1 = ntup;
+#line 12869 ""
for (itup = 2; itup <= i__1; ++itup) {
+#line 12870 ""
if (comget_1.ornrpt) {
+#line 12871 ""
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 12873 ""
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 12877 ""
++comtrill_1.ntrill;
+#line 12878 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] =
commvl_1.ivx;
+#line 12879 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
+#line 12880 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
comtrill_1.xnsktr[comtrill_1.ntrill - 2];
+#line 12881 ""
}
+#line 12882 ""
}
+#line 12883 ""
++all_1.nnl[commvl_1.ivx - 1];
+#line 12884 ""
if (comget_1.fbon) {
+#line 12884 ""
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 12884 ""
}
+#line 12885 ""
L7:
+#line 12885 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1)
;
+#line 12886 ""
if (*(unsigned char *)charq == ' ') {
+#line 12887 ""
goto L7;
+#line 12888 ""
} else if (*(unsigned char *)charq == '%') {
+#line 12889 ""
all_1.iccount = 128;
+#line 12890 ""
goto L7;
+#line 12891 ""
} else if (*(unsigned char *)charq == 'o') {
/* Ornament in xtuplet. "o" symbol must come AFTER the affected note */
+#line 12895 ""
if (comnotes_1.notcrd) {
+#line 12896 ""
nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25];
+#line 12897 ""
} else {
+#line 12898 ""
nole = 127 & lbit_shift(comtrill_1.icrdat[
comtrill_1.ncrd - 1], (ftnlen)-12);
+#line 12899 ""
}
+#line 12900 ""
i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 12900 ""
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 12903 ""
goto L7;
+#line 12904 ""
} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0)
{
+#line 12905 ""
nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 12906 ""
if (*(unsigned char *)charq == '(' || *(unsigned char *)
charq == '{') {
/* Detected preslur in xtuplet loop, non-chord note */
+#line 12910 ""
++nnlivx;
+#line 12911 ""
++comnotes_1.npreslur;
+#line 12912 ""
}
+#line 12913 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0);
+#line 12914 ""
if (*(unsigned char *)charq == 't') {
+#line 12914 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] =
bit_set(all_1.islur[commvl_1.ivx + nnlivx *
24 - 25],1);
+#line 12914 ""
}
+#line 12916 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 12917 ""
kv = 1;
+#line 12918 ""
} else {
+#line 12919 ""
kv = 2;
+#line 12920 ""
}
+#line 12921 ""
if (comslur_1.fontslur) {
+#line 12922 ""
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 12924 ""
} else {
+#line 12925 ""
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 12927 ""
}
+#line 12928 ""
goto L7;
+#line 12929 ""
} else if (*(unsigned char *)charq == 'G') {
/* Kluge to get grace in xtup at right location */
+#line 12933 ""
--all_1.nnl[commvl_1.ivx - 1];
+#line 12934 ""
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 12936 ""
++all_1.nnl[commvl_1.ivx - 1];
+#line 12937 ""
goto L7;
+#line 12938 ""
} else if (*(unsigned char *)charq == *(unsigned char *)
all_1.sq) {
+#line 12939 ""
littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
+#line 12940 ""
goto L7;
+#line 12941 ""
} else if (*(unsigned char *)charq == '"') {
/* pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ */
+#line 12945 ""
if (! comlyr_1.inputmlyr) {
+#line 12946 ""
ictemp = 0;
/* Writing concatenation */
+#line 12947 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 12947 ""
i__3[1] = 1, a__1[1] = all_1.sq;
+#line 12947 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 12947 ""
i__3[3] = 15, a__1[3] = "input musixlyr ";
+#line 12947 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 12947 ""
s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
+#line 12948 ""
i__2 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 12948 ""
littex_(all_1.islur, &i__2, &commvl_1.ivx, &
comas3_1.topmods, lineqt, &ictemp, (ftnlen)
128);
+#line 12949 ""
comlyr_1.inputmlyr = TRUE_;
+#line 12950 ""
}
+#line 12951 ""
dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
+#line 12952 ""
*(unsigned char *)charq = *(unsigned char *)all_1.sq;
+#line 12953 ""
littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
+#line 12954 ""
goto L7;
+#line 12955 ""
} else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (
ftnlen)1) > 0) {
/* Figure. Must come AFTER the first note of xtup */
+#line 12959 ""
ivf = 1;
+#line 12960 ""
if (commvl_1.ivx > 1) {
+#line 12961 ""
if (comfig_1.ivxfig2 == 0) {
+#line 12962 ""
comfig_1.ivxfig2 = commvl_1.ivx;
+#line 12963 ""
} else if (commvl_1.ivx != comfig_1.ivxfig2) {
- s_wsle(&io___755);
+#line 12964 ""
+ s_wsle(&io___794);
+#line 12964 ""
e_wsle();
- s_wsle(&io___756);
- do_lio(&c__9, &c__1, "Figures not allowed in >1 "
+#line 12965 ""
+ s_wsle(&io___795);
+#line 12965 ""
+ do_lio(&c__9, &c__1, "Figures not allowed in >1 "\
"voice above first", (ftnlen)43);
+#line 12965 ""
e_wsle();
+#line 12966 ""
s_stop("", (ftnlen)0);
+#line 12967 ""
}
+#line 12968 ""
ivf = 2;
+#line 12969 ""
}
+#line 12970 ""
nfig1 = comfig_1.nfigs[ivf - 1] + 1;
+#line 12971 ""
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], &
@@ -18754,10 +30856,14 @@ L7:
comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (
ftnlen)10);
/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */
+#line 12976 ""
goto L7;
+#line 12977 ""
} else if (*(unsigned char *)charq == 'X') {
/* Computing MAX */
+#line 12978 ""
i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 12978 ""
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 +
@@ -18767,146 +30873,211 @@ L7:
all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, &
comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, (
ftnlen)1);
+#line 12982 ""
goto L7;
+#line 12983 ""
} else if (*(unsigned char *)charq == 'z') {
/* Chord note in xtup. Goes with *prior* note. */
+#line 12987 ""
comnotes_1.notcrd = FALSE_;
+#line 12988 ""
++comtrill_1.ncrd;
+#line 12989 ""
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 12990 ""
numnum = 0;
/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
+#line 12992 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[
commvl_1.ivx - 1] - 1;
+#line 12993 ""
i__2 = commvl_1.ivx % 16;
+#line 12993 ""
setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &
c__8, &i__2);
+#line 12994 ""
if (commvl_1.ivx >= 16) {
+#line 12994 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
+#line 12994 ""
}
+#line 12995 ""
comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
/* Get note name */
+#line 12999 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
ftnlen)1);
/* Get optional inputs */
+#line 13003 ""
L34:
+#line 13003 ""
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 13007 ""
ndx = i_indx("fsn+-<>12345678reic", durq, (ftnlen)19, (
ftnlen)1);
+#line 13008 ""
if (ndx > 0) {
+#line 13009 ""
if (ndx <= 3) {
+#line 13010 ""
if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd
- 1],19)) {
+#line 13011 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] =
bit_set(comtrill_1.icrdat[
comtrill_1.ncrd - 1],19);
+#line 13012 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx
<< 20;
+#line 13013 ""
} else {
+#line 13014 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] =
bit_set(comtrill_1.icrdat[
comtrill_1.ncrd - 1],22);
+#line 13015 ""
}
+#line 13016 ""
} else if (ndx == 19) {
/* Set flags for cautionary accidental */
+#line 13020 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],31)
;
+#line 13021 ""
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 13023 ""
} else if (ndx <= 7) {
/* +/-/</> Check whether octave or accidental shift */
+#line 13027 ""
nactmp = 0;
+#line 13028 ""
chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved,
(ftnlen)128);
+#line 13029 ""
if (moved) {
/* Transfer accidental shift values */
+#line 13033 ""
i__2 = igetbits_(&nactmp, &c__6, &c__4);
+#line 13033 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
1], &c__6, &c__14, &i__2);
+#line 13035 ""
i__2 = igetbits_(&nactmp, &c__7, &c__10);
+#line 13035 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
1], &c__7, &c__20, &i__2);
+#line 13037 ""
} else {
+#line 13038 ""
if (*(unsigned char *)durq == '+') {
+#line 13039 ""
comnotes_1.lastlev += 7;
+#line 13040 ""
} else if (*(unsigned char *)durq == '-') {
+#line 13041 ""
comnotes_1.lastlev += -7;
+#line 13042 ""
}
+#line 13043 ""
}
+#line 13044 ""
} else if (*(unsigned char *)durq == 'e') {
+#line 13045 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],23)
;
+#line 13046 ""
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 13047 ""
} else if (*(unsigned char *)durq == 'r') {
+#line 13048 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],24)
;
+#line 13049 ""
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 13051 ""
} else if (*(unsigned char *)durq == 'i') {
/* Midi-only accidental */
+#line 13055 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],27)
;
+#line 13056 ""
} else {
/* must be a number, save it in ioct */
+#line 13060 ""
numnum = 1;
+#line 13061 ""
ioct = ndx - 7;
+#line 13062 ""
}
+#line 13063 ""
goto L34;
+#line 13064 ""
}
+#line 13065 ""
if (numnum == 1) {
+#line 13066 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (
ftnlen)1);
+#line 13067 ""
} else {
+#line 13068 ""
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 13070 ""
}
+#line 13071 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |=
comnotes_1.lastlev << 12;
+#line 13072 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set note level for preslur on chord note in xtup */
+#line 13076 ""
setbits_(&all_1.isdat2[all_1.nsdat -
comnotes_1.npreslur], &c__7, &c__19, &
comnotes_1.lastlev);
@@ -18914,346 +31085,505 @@ L34:
/* Following lines copied from loop for non-xtup, chord note, preslur */
/* Initially I assigned the slur(s) to next note, so fix. */
+#line 13081 ""
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 13082 ""
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 13083 ""
all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] =
bit_set(all_1.isdat2[all_1.nsdat -
comnotes_1.npreslur],0);
+#line 13085 ""
i__2 = igetbits_(&all_1.isdat1[all_1.nsdat -
comnotes_1.npreslur], &c__8, &c__3) - 1;
+#line 13085 ""
setbits_(&all_1.isdat1[all_1.nsdat -
comnotes_1.npreslur], &c__8, &c__3, &i__2);
+#line 13087 ""
/* L41: */
+#line 13087 ""
}
+#line 13088 ""
goto L7;
+#line 13089 ""
} else if (*(unsigned char *)charq == '?') {
/* Arpeggio */
+#line 13093 ""
if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 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 13098 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
+#line 13099 ""
} else {
+#line 13100 ""
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 13101 ""
}
/* Check for shift */
+#line 13105 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 13106 ""
if (*(unsigned char *)durq == ' ') {
+#line 13107 ""
--all_1.iccount;
+#line 13108 ""
} else {
/* durq must be "-" */
+#line 13112 ""
++all_1.iccount;
+#line 13113 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 13114 ""
--all_1.iccount;
/* record the shift */
+#line 13118 ""
++comarpshift_1.numarpshift;
+#line 13119 ""
comarpshift_1.ivarpshift[comarpshift_1.numarpshift -
1] = commvl_1.ivx;
+#line 13120 ""
comarpshift_1.iparpshift[comarpshift_1.numarpshift -
1] = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 13121 ""
comarpshift_1.arpshift[comarpshift_1.numarpshift - 1]
= fnum;
+#line 13122 ""
}
+#line 13123 ""
goto L7;
+#line 13124 ""
} else if (*(unsigned char *)charq == 'D') {
+#line 13125 ""
i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 13125 ""
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 13127 ""
goto L7;
/* 140215 Allow clef change inside xtuplet. With normal code, came out one */
/* note too late, so try making it come earlier. */
+#line 13132 ""
} else if (*(unsigned char *)charq == 'C') {
/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
/* if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 */
+#line 13137 ""
if (all_1.nnl[all_1.iv - 1] - 1 > 0) {
+#line 13137 ""
++comcc_1.ncc[all_1.iv - 1];
+#line 13137 ""
}
/* 140218 Need to get time differently inside xtup, since itsofar doesn't get */
/* updated until after xtup is done */
-/* tcc(iv,ncc(iv)) = itsofar(iv) */
+#line 13142 ""
nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
+#line 13143 ""
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)));
-/* print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' */
-/* print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) */
-/* isl = ibset(islur(iv,nnl(iv)+1),11) */
+#line 13144 ""
isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[all_1.iv -
1] * 24 - 25],11);
+#line 13145 ""
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 13149 ""
i__2 = numclef_(durq, (ftnlen)1);
+#line 13149 ""
isl |= min(i__2,7) << 12;
+#line 13150 ""
comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24
- 25] = ncmidf_(durq, (ftnlen)1);
+#line 13151 ""
if (*(unsigned char *)durq == '8') {
+#line 13152 ""
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 13153 ""
cominsttrans_1.itransamt[cominsttrans_1.instno[
- all_1.iv - 1] - 1] = 7;
+ all_1.iv - 1] - 1] += 7;
+#line 13154 ""
}
/* Set marker on note with lowest voice # starting at same time. */
+#line 13158 ""
if (all_1.iv == 1) {
+#line 13159 ""
isl = bit_set(isl,15);
+#line 13160 ""
} else {
+#line 13161 ""
i__2 = all_1.iv;
+#line 13161 ""
for (iiv = 1; iiv <= i__2; ++iiv) {
/* nnliiv = nnl(iiv) */
+#line 13163 ""
nnliiv = all_1.nnl[iiv - 1] - 1;
+#line 13164 ""
if (iiv == all_1.iv) {
+#line 13164 ""
++nnliiv;
+#line 13164 ""
}
+#line 13165 ""
itother = 0;
+#line 13166 ""
i__4 = nnliiv;
+#line 13166 ""
for (iip = 1; iip <= i__4; ++iip) {
+#line 13167 ""
if (itother < all_1.itsofar[all_1.iv - 1]) {
+#line 13168 ""
itother += all_1.nodur[iiv + iip * 24 -
25];
+#line 13169 ""
goto L71;
+#line 13170 ""
} else if (itother == all_1.itsofar[all_1.iv
- 1]) {
+#line 13171 ""
all_1.islur[iiv + iip * 24 - 25] =
bit_set(all_1.islur[iiv + iip *
24 - 25],15);
+#line 13172 ""
goto L72;
+#line 13173 ""
}
+#line 13174 ""
L71:
+#line 13174 ""
;
+#line 13174 ""
}
+#line 13175 ""
/* L70: */
+#line 13175 ""
}
+#line 13176 ""
L72:
+#line 13177 ""
;
+#line 13177 ""
}
/* 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 13182 ""
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 13183 ""
goto L7;
/* +++ */
+#line 13185 ""
} else if (*(unsigned char *)charq == ']') {
/* Multiplicity up-down, must have '][ ' */
+#line 13189 ""
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 13190 ""
all_1.iccount += 2;
+#line 13191 ""
goto L7;
/* c+++ */
+#line 13193 ""
}
/* End of loop for xtup options. If here, charq must be a (non-crd) note name. */
/* or rest */
+#line 13198 ""
if (*(unsigned char *)charq == 'r') {
/* Rest in xtup */
+#line 13202 ""
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 13203 ""
i__2 = all_1.iccount;
+#line 13203 ""
if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount
+ 1 - i__2) > 0) {
+#line 13204 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 13205 ""
if (*(unsigned char *)durq == 'b') {
/* Blank rest in middle of xtup */
+#line 13209 ""
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 13210 ""
} else {
/* Override height of embedded xtup rest */
+#line 13214 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
2;
+#line 13215 ""
++all_1.iccount;
+#line 13216 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
+#line 13217 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = ipm * i_nint(&fnum) +
100;
+#line 13218 ""
--all_1.iccount;
+#line 13219 ""
}
+#line 13220 ""
} else if (commvl_1.ivx <= all_1.nv) {
+#line 13221 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = 0;
+#line 13222 ""
} else {
+#line 13223 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = 2;
+#line 13224 ""
}
+/* end if */
+#line 13226 ""
+ } else {
+
+/* Counter for non-rests */
+
+#line 13230 ""
+ ++nnb;
+#line 13231 ""
}
+#line 13232 ""
comnotes_1.notcrd = TRUE_;
+#line 13233 ""
L8:
+#line 13233 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13234 ""
if (*(unsigned char *)durq != ' ') {
+#line 13235 ""
if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
/* Accidental horizontal shift */
+#line 13239 ""
chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &moved, (ftnlen)128);
+#line 13240 ""
if (! moved) {
+#line 13241 ""
if (*(unsigned char *)durq == '+') {
+#line 13242 ""
comnotes_1.lastlev += 7;
+#line 13243 ""
} else if (*(unsigned char *)durq == '-') {
+#line 13244 ""
comnotes_1.lastlev += -7;
+#line 13245 ""
}
+#line 13246 ""
}
+#line 13247 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0)
{
- if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- - 1] * 24 - 25] == 0) {
+
+/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */
+/* May have set other bits earlier */
+#line 13251 ""
+ if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25], &c__2, &c__0) ==
+ 0) {
/* No accid set yet */
+/* nacc(ivx,nnl(ivx)) = index('fsn',durq) */
+#line 13256 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- - 1] * 24 - 25] = i_indx("fsn", durq, (
+ - 1] * 24 - 25] |= i_indx("fsn", durq, (
ftnlen)3, (ftnlen)1);
+#line 13258 ""
} else {
/* Symbol must be repeated, so it's a double */
+#line 13262 ""
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 13263 ""
}
+#line 13264 ""
} else if (*(unsigned char *)durq == 'i') {
/* Set flag for midi-only accidental */
+#line 13268 ""
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 13270 ""
} else if (*(unsigned char *)durq == 'c') {
/* Set flags for cautionary accidental */
+#line 13274 ""
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 13275 ""
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 13276 ""
} else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Force stem direction for non-beamed xtup note */
+#line 13280 ""
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 13281 ""
if (*(unsigned char *)durq == 'u') {
+#line 13281 ""
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 13281 ""
}
+#line 13283 ""
} else if (*(unsigned char *)durq == 'e') {
/* Left-shift main xtup note */
+#line 13287 ""
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 13288 ""
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 13289 ""
} else if (*(unsigned char *)durq == 'r') {
/* Right-shift main xtup note */
+#line 13293 ""
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 13294 ""
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 13295 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double an xtup note to make an unequal xtup */
+#line 13299 ""
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 13300 ""
if (*(unsigned char *)durq == 'F') {
+#line 13300 ""
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 13300 ""
}
+#line 13302 ""
++ndoub;
+#line 13303 ""
} else if (*(unsigned char *)durq == 'd') {
/* Dotted xtup note */
+#line 13307 ""
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 13308 ""
} else {
/* Must be an octave number */
+#line 13312 ""
i__2 = *(unsigned char *)durq - 48;
+#line 13312 ""
comnotes_1.lastlev = ifnolev_(charq, &i__2, &
cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (
ftnlen)1);
+#line 13314 ""
}
+#line 13315 ""
goto L8;
+#line 13316 ""
}
+#line 13317 ""
if (itup < ntup) {
/* Last note is handled *after* flowing out of the xtup if block, but still */
@@ -19261,117 +31591,170 @@ 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 13324 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],0)) {
+#line 13325 ""
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 13327 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = comnotes_1.lastlev;
+#line 13328 ""
}
+#line 13329 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = 0;
+#line 13330 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set note level for preslur on internal xtup note */
+#line 13334 ""
setbits_(&all_1.isdat2[all_1.nsdat -
comnotes_1.npreslur], &c__7, &c__19, &
comnotes_1.lastlev);
+#line 13335 ""
/* L42: */
+#line 13335 ""
}
+#line 13336 ""
}
+#line 13337 ""
if (itup == ntup - ndoub) {
+#line 13337 ""
goto L12;
+#line 13337 ""
}
+#line 13338 ""
/* L6: */
+#line 13338 ""
}
+#line 13339 ""
L12:
+#line 13340 ""
if (comget_1.ornrpt) {
+#line 13341 ""
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 13343 ""
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 13347 ""
++comtrill_1.ntrill;
+#line 13348 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
+#line 13349 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
+#line 13350 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
comtrill_1.xnsktr[comtrill_1.ntrill - 2];
+#line 13351 ""
}
+#line 13352 ""
}
/* End of if-block for xtuplet input */
+#line 13356 ""
} 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 13361 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= all_1.lenbar;
+#line 13362 ""
comgrace_1.ibarmbr = all_1.nbars + 1;
+#line 13363 ""
comgrace_1.mbrest = 0;
+#line 13364 ""
comgrace_1.xb4mbr = 0.f;
+#line 13365 ""
L20:
+#line 13365 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13366 ""
if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57)
{
+#line 13367 ""
comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char *
)durq - 48;
+#line 13368 ""
goto L20;
+#line 13369 ""
}
+#line 13370 ""
} else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Set stem flipper */
+#line 13374 ""
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 13375 ""
if (*(unsigned char *)durq == 'u') {
+#line 13375 ""
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 13375 ""
}
+#line 13377 ""
goto L2;
+#line 13378 ""
} else if (*(unsigned char *)durq == 'a') {
/* "Alone", i.e., prohibit beam */
+#line 13382 ""
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 13383 ""
goto L2;
+#line 13384 ""
} else if (*(unsigned char *)durq == 'r') {
/* Right offset by one notehead */
+#line 13388 ""
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 13389 ""
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 13390 ""
goto L2;
+#line 13391 ""
} else if (*(unsigned char *)durq == 'e') {
/* Left offset by one notehead */
+#line 13395 ""
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 13396 ""
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 13397 ""
goto L2;
-/* else if (durq .eq. 'S') then */
+#line 13398 ""
} else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 */
@@ -19379,260 +31762,428 @@ L20:
/* interbeams = internotes*2/3. */
+#line 13405 ""
isign = 1;
+#line 13406 ""
if (*(unsigned char *)durq == 'S') {
+#line 13406 ""
isign = -1;
+#line 13406 ""
}
+#line 13407 ""
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 13408 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13409 ""
if (*(unsigned char *)durq == ':') {
/* End stickyS. Grab data now from prior note, since we have to shut off stickyS. */
+#line 13413 ""
i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10);
+#line 13413 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25], &c__6, &c__10, &i__1);
+#line 13415 ""
comget_1.stickys = FALSE_;
+#line 13416 ""
goto L2;
+#line 13417 ""
}
/* If durq .ne. ':' then iccount is now on the start of the number */
+#line 13421 ""
readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen)
1);
+#line 13422 ""
dum = isign * dum;
+#line 13423 ""
r__1 = (dum + 4.f) * 2;
+#line 13423 ""
i__1 = i_nint(&r__1);
+#line 13423 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &c__6, &c__10, &i__1);
+#line 13424 ""
if (*(unsigned char *)durq == ':') {
+#line 13425 ""
comget_1.stickys = TRUE_;
+#line 13426 ""
} else {
+#line 13427 ""
--all_1.iccount;
+#line 13428 ""
}
+#line 13429 ""
goto L2;
+#line 13430 ""
} else if (*(unsigned char *)durq == ',') {
/* 2:1 pattern */
+#line 13434 ""
idotform = 3;
/* Now flow to duration setting, as if durq=' ' */
+#line 13438 ""
} 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 13443 ""
idotform = 1;
+#line 13444 ""
} else if (*(unsigned char *)durq == 'o') {
/* Suppress rest centering */
+#line 13448 ""
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 13449 ""
goto L2;
+#line 13450 ""
} else if (*(unsigned char *)durq == 'L') {
/* With keyboard rest option, look left */
/* iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) */
+#line 13455 ""
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 13456 ""
goto L2;
+#line 13457 ""
} 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 13462 ""
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 13463 ""
if (*(unsigned char *)durq == 'F') {
+#line 13463 ""
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 13463 ""
}
+#line 13465 ""
goto L2;
+#line 13466 ""
} else if (*(unsigned char *)durq == 'A') {
/* Accidental option */
+#line 13470 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13472 ""
if (*(unsigned char *)durq == 'o') {
/* Ordered accidentals in a chord. Mark the main note. */
+#line 13476 ""
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 13477 ""
} else {
/* Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */
+#line 13481 ""
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 13482 ""
+ --all_1.iccount;
+#line 13483 ""
+ }
+#line 13484 ""
+ goto L2;
+#line 13485 ""
+ } else if (*(unsigned char *)durq == 'T') {
+#line 13486 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13487 ""
+ multtrem = i_indx("1234", durq, (ftnlen)4, (ftnlen)1);
+#line 13488 ""
+ if (multtrem == 0) {
+#line 13489 ""
--all_1.iccount;
+#line 13490 ""
+ multtrem = 1;
+#line 13491 ""
}
+#line 13492 ""
+ 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 13493 ""
+ i__1 = multtrem - 1;
+#line 13493 ""
+ setbits_(&all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
+ 24 - 25], &c__2, &c__5, &i__1);
+#line 13494 ""
goto L2;
+#line 13495 ""
} else if (*(unsigned char *)durq != ' ') {
- s_wsle(&io___768);
+#line 13496 ""
+ s_wsle(&io___808);
+#line 13496 ""
do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27);
+#line 13496 ""
do_lio(&c__9, &c__1, durq, (ftnlen)1);
+#line 13496 ""
do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9);
+#line 13496 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
+#line 13496 ""
do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
ftnlen)sizeof(integer));
+#line 13496 ""
e_wsle();
+#line 13498 ""
stop1_();
+#line 13499 ""
}
/* Done with note/rest options. Set level and duration. */
+#line 13503 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],0)) {
+#line 13504 ""
if (numnum == 2) {
+#line 13505 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[
all_1.iv - 1] - 1], (ftnlen)1);
+#line 13506 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = comnotes_1.lastlev;
+#line 13507 ""
} else {
+#line 13508 ""
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 13510 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = comnotes_1.lastlev;
+#line 13511 ""
}
+#line 13512 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set level for preslur on normal note, non-chord */
+#line 13516 ""
setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
c__7, &c__19, &comnotes_1.lastlev);
+#line 13517 ""
/* L43: */
+#line 13517 ""
}
+
+/* Only matters if last note, non-rest of xtuplet */
+
+#line 13521 ""
+ ++nnb;
+#line 13522 ""
+ }
+
+/* Set flag for unbeamed xtup if it just has 1 note */
+
+#line 13526 ""
+ if (inxtup && nnb == 1) {
+/* ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19) */
+#line 13528 ""
+ all_1.islur[commvl_1.ivx + note1xtup * 24 - 25] = bit_set(
+ all_1.islur[commvl_1.ivx + note1xtup * 24 - 25],18);
+#line 13529 ""
}
+#line 13530 ""
if (idotform > 0) {
+#line 13531 ""
if (idotform == 1) {
+#line 13532 ""
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 13533 ""
} else if (idotform == 2) {
+#line 13534 ""
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 13535 ""
} else if (idotform == 3) {
+#line 13536 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
+#line 13537 ""
} else if (idotform == 4) {
+#line 13538 ""
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 13539 ""
}
+#line 13540 ""
} 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 13544 ""
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 13548 ""
i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48;
+#line 13548 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 13548 ""
comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, (
ftnlen)1) - 1;
+#line 13550 ""
} else if (comgrace_1.ibarmbr != all_1.nbars + 1) {
+#line 13551 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
+#line 13552 ""
if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],3)) {
+#line 13552 ""
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 13552 ""
}
+#line 13554 ""
}
+#line 13555 ""
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 13559 ""
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 13563 ""
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 13564 ""
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 13565 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
+#line 13566 ""
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 13567 ""
}
+#line 13568 ""
}
+#line 13569 ""
all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
+#line 13570 ""
if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol &&
comget_1.fbon) {
/* Check to see if need to terminate auto forced beam */
+#line 13574 ""
r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
+#line 13574 ""
if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
/* Terminate autofb */
+#line 13578 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
+#line 13579 ""
comget_1.fbon = FALSE_;
+#line 13580 ""
}
+#line 13581 ""
}
+#line 13582 ""
if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar ==
0) {
/* Finished a bar */
+#line 13586 ""
++all_1.nbars;
+#line 13587 ""
all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[
commvl_1.ivx - 1];
+#line 13588 ""
if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) {
/* Just finished the pickup bar for this voice. */
+#line 13592 ""
all_1.lenbar = all_1.lenb1;
+#line 13593 ""
}
+#line 13594 ""
}
+#line 13595 ""
if (idotform == 1) {
+#line 13596 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 13597 ""
idotform = 2;
+#line 13598 ""
numnum = 1;
+#line 13599 ""
goto L28;
+#line 13600 ""
} else if (idotform == 3) {
+#line 13601 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 13602 ""
idotform = 4;
+#line 13603 ""
numnum = 1;
+#line 13604 ""
goto L28;
+#line 13605 ""
}
/* End of sub block for note-rest */
+#line 13609 ""
} else if (*(unsigned char *)charq == 'z') {
/* Chord note. Must have note name, may have octave#,+,-,s,f,n,d */
@@ -19664,212 +32215,331 @@ L20:
/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
+#line 13640 ""
++comtrill_1.ncrd;
+#line 13641 ""
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 13642 ""
numnum = 0;
/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
+#line 13644 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1];
+#line 13645 ""
i__1 = commvl_1.ivx % 16;
+#line 13645 ""
setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1)
;
+#line 13646 ""
if (commvl_1.ivx >= 16) {
+#line 13646 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
+#line 13646 ""
}
+#line 13647 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0;
+#line 13648 ""
comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
/* Get note name */
+#line 13652 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
/* Get optional inputs */
+#line 13656 ""
L25:
+#line 13656 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* ndx = index('fsn+-<>12345678rediA',durq) */
+#line 13658 ""
ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1);
+#line 13659 ""
if (ndx == 20) {
/* Expect +|-|<|> , set tag, loop */
+#line 13663 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],29);
+#line 13664 ""
goto L25;
+#line 13665 ""
} else if (ndx > 0) {
+#line 13666 ""
if (ndx <= 3) {
+#line 13667 ""
if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) {
+#line 13668 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],19);
+#line 13669 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20;
+#line 13670 ""
} else {
+#line 13671 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],22);
+#line 13672 ""
}
+#line 13673 ""
} else if (ndx == 21) {
/* Set flags for cautionary accidental */
+#line 13677 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],31);
+#line 13678 ""
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 13679 ""
} else if (ndx <= 7) {
/* +/-/</> Check whether octave or accidental shift */
+#line 13683 ""
nactmp = 0;
+#line 13684 ""
chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128)
;
+#line 13685 ""
if (moved) {
/* Transfer accidental shift values */
+#line 13689 ""
i__1 = igetbits_(&nactmp, &c__6, &c__4);
+#line 13689 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, &
c__14, &i__1);
+#line 13690 ""
i__1 = igetbits_(&nactmp, &c__7, &c__10);
+#line 13690 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, &
c__20, &i__1);
+#line 13691 ""
} else {
+#line 13692 ""
if (*(unsigned char *)durq == '+') {
+#line 13693 ""
comnotes_1.lastlev += 7;
+#line 13694 ""
} else if (*(unsigned char *)durq == '-') {
+#line 13695 ""
comnotes_1.lastlev += -7;
+#line 13696 ""
}
+#line 13697 ""
}
+#line 13698 ""
} else if (*(unsigned char *)durq == 'e') {
+#line 13699 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],23);
+#line 13700 ""
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 13701 ""
} else if (*(unsigned char *)durq == 'r') {
+#line 13702 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],24);
+#line 13703 ""
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 13704 ""
} else if (*(unsigned char *)durq == 'i') {
/* Midi-only accidental on chord note */
+#line 13708 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],27);
+#line 13709 ""
} else if (*(unsigned char *)durq == 'd') {
/* Must keep 'd' optional (backward compatibility), unless it is moved! */
+#line 13713 ""
i__1 = all_1.iccount;
+#line 13713 ""
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 13717 ""
i__1 = all_1.iccount + 1;
+#line 13717 ""
if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
all_1.iccount + 2 - i__1) == 0) {
+#line 13717 ""
goto L25;
+#line 13717 ""
}
+#line 13719 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],26);
+#line 13720 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 13721 ""
++all_1.iccount;
+#line 13722 ""
readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128,
(ftnlen)1);
+#line 13723 ""
if (*(unsigned char *)durq == '+') {
+#line 13724 ""
r__1 = fnum * 10;
+#line 13724 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(&
r__1) + 64;
+#line 13725 ""
} else {
+#line 13726 ""
r__1 = fnum * 10;
+#line 13726 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(&
r__1) + 64;
+#line 13727 ""
}
+#line 13728 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift specified also */
+#line 13732 ""
++all_1.iccount;
+#line 13733 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
+#line 13734 ""
if (*(unsigned char *)dumq == '+') {
+#line 13735 ""
r__1 = fnum * 10;
+#line 13735 ""
ifnum = i_nint(&r__1) + 64;
+#line 13736 ""
} else {
+#line 13737 ""
r__1 = fnum * 10;
+#line 13737 ""
ifnum = -i_nint(&r__1) + 64;
+#line 13738 ""
}
+#line 13739 ""
} else {
+#line 13740 ""
ifnum = 64;
+#line 13741 ""
}
+#line 13742 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7;
+#line 13743 ""
--all_1.iccount;
+#line 13744 ""
}
+#line 13745 ""
} else {
/* must be a single digit, save it in ioct */
+#line 13749 ""
numnum = 1;
+#line 13750 ""
ioct = ndx - 7;
+#line 13751 ""
}
+#line 13752 ""
goto L25;
+#line 13753 ""
}
+#line 13754 ""
if (numnum == 1) {
+#line 13755 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv -
1] - 1], (ftnlen)1);
+#line 13756 ""
} else {
+#line 13757 ""
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 13759 ""
}
+#line 13760 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12;
+#line 13761 ""
for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >=
1; --comnotes_1.npreslur) {
+#line 13762 ""
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 13767 ""
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 13768 ""
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 13769 ""
all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set(
all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0);
+#line 13770 ""
i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur],
&c__8, &c__3) - 1;
+#line 13770 ""
setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8,
&c__3, &i__1);
+#line 13772 ""
/* L44: */
+#line 13772 ""
}
+#line 13773 ""
if (comnotes_1.notcrd) {
/* This is the first chord note in this chord. */
/* Computing MIN */
+#line 13777 ""
i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25];
+#line 13777 ""
comtrill_1.minlev = min(i__1,comnotes_1.lastlev);
/* Computing MAX */
+#line 13778 ""
i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25];
+#line 13778 ""
comtrill_1.maxlev = max(i__1,comnotes_1.lastlev);
+#line 13779 ""
} else {
+#line 13780 ""
comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev);
+#line 13781 ""
comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev);
+#line 13782 ""
}
+#line 13783 ""
comnotes_1.notcrd = FALSE_;
+#line 13784 ""
} else if (*(unsigned char *)charq == 'G') {
+#line 13785 ""
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);
@@ -19887,146 +32557,228 @@ L25:
/* These data MUST precede note name of first note */
/* nolevg, naccg: lists of levels and accid's, indexed as described above. */
+#line 13801 ""
} else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) {
/* Literal TeX string */
+#line 13805 ""
i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 13805 ""
littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
+#line 13806 ""
} else if (*(unsigned char *)charq == '"') {
/* pmxlyr string. Expand "..." to \pmxlyr{...}\ */
+#line 13810 ""
if (! comlyr_1.inputmlyr) {
+#line 13811 ""
ictemp = 0;
/* Writing concatenation */
+#line 13812 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 13812 ""
i__3[1] = 1, a__1[1] = all_1.sq;
+#line 13812 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 13812 ""
i__3[3] = 15, a__1[3] = "input musixlyr ";
+#line 13812 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 13812 ""
s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
+#line 13813 ""
i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 13813 ""
littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods,
lineqt, &ictemp, (ftnlen)128);
+#line 13814 ""
comlyr_1.inputmlyr = TRUE_;
+#line 13815 ""
}
+#line 13816 ""
dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
+#line 13817 ""
*(unsigned char *)charq = *(unsigned char *)all_1.sq;
+#line 13818 ""
i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 13818 ""
littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
+#line 13819 ""
} else if (*(unsigned char *)charq == 'o') {
/* Ornament on non-xtup note. Symbol must come AFTER the affected note */
+#line 13823 ""
if (comnotes_1.notcrd) {
+#line 13824 ""
nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25];
+#line 13825 ""
} else {
+#line 13826 ""
nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], (
ftnlen)-12);
+#line 13827 ""
}
+#line 13828 ""
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 13831 ""
} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 13832 ""
nnlivx = all_1.nnl[commvl_1.ivx - 1];
+#line 13833 ""
if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{')
{
/* Detect preslur on normal non-chord note */
+#line 13837 ""
++nnlivx;
+#line 13838 ""
++comnotes_1.npreslur;
+#line 13839 ""
}
+#line 13840 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[
commvl_1.ivx + nnlivx * 24 - 25],0);
+#line 13841 ""
if (*(unsigned char *)charq == 't') {
+#line 13841 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1);
+#line 13841 ""
}
+#line 13843 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 13844 ""
kv = 1;
+#line 13845 ""
} else {
+#line 13846 ""
kv = 2;
+#line 13847 ""
}
+#line 13848 ""
if (comslur_1.fontslur) {
+#line 13849 ""
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 13851 ""
} else {
+#line 13852 ""
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 13854 ""
}
+#line 13855 ""
} else if (*(unsigned char *)charq == '?') {
/* Arpeggio */
+#line 13859 ""
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 13864 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
+#line 13865 ""
} else {
+#line 13866 ""
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 13867 ""
}
/* Check for shift */
+#line 13871 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 13872 ""
if (*(unsigned char *)durq == ' ') {
+#line 13873 ""
--all_1.iccount;
+#line 13874 ""
} else {
/* durq must be "-" */
+#line 13878 ""
++all_1.iccount;
+#line 13879 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 13880 ""
--all_1.iccount;
/* record the shift */
+#line 13884 ""
++comarpshift_1.numarpshift;
+#line 13885 ""
comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] =
commvl_1.ivx;
+#line 13886 ""
comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] =
all_1.nnl[commvl_1.ivx - 1];
+#line 13887 ""
comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum;
+#line 13888 ""
}
+#line 13889 ""
} else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > 0) {
/* We have a figure. Must come AFTER the note it goes under */
+#line 13894 ""
ivf = 1;
+#line 13895 ""
if (commvl_1.ivx > 1) {
+#line 13896 ""
if (comfig_1.ivxfig2 == 0) {
+#line 13897 ""
comfig_1.ivxfig2 = commvl_1.ivx;
+#line 13898 ""
} else if (commvl_1.ivx != comfig_1.ivxfig2) {
- s_wsle(&io___770);
+#line 13899 ""
+ s_wsle(&io___810);
+#line 13899 ""
e_wsle();
- s_wsle(&io___771);
- do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "
+#line 13900 ""
+ s_wsle(&io___811);
+#line 13900 ""
+ do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "\
"first", (ftnlen)43);
+#line 13900 ""
e_wsle();
+#line 13901 ""
s_stop("", (ftnlen)0);
+#line 13902 ""
}
+#line 13903 ""
ivf = 2;
+#line 13904 ""
}
+#line 13905 ""
nfig1 = comfig_1.nfigs[ivf - 1] + 1;
+#line 13906 ""
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], &
@@ -20036,30 +32788,46 @@ L25:
- 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 13911 ""
} else if (*(unsigned char *)charq == '[') {
/* Start forced beam. Record barno & time since start of inp. blk. Set signal */
+#line 13915 ""
++comfb_1.nfb[commvl_1.ivx - 1];
+#line 13916 ""
comget_1.fbon = TRUE_;
+#line 13917 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
commvl_1.ivx - 1] * 24 - 25] = 'x';
+#line 13918 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] =
(real) all_1.itsofar[commvl_1.ivx - 1];
+#line 13919 ""
nadj = 0;
+#line 13920 ""
if (comfb_1.autofbon) {
+#line 13921 ""
comfb_1.autofbon = FALSE_;
+#line 13922 ""
}
+#line 13923 ""
L17:
+#line 13923 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 13924 ""
if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) {
+#line 13925 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq;
+#line 13926 ""
goto L17;
+#line 13927 ""
} else if (*(unsigned char *)charq == 'j') {
/* Continuing a jumped beam here */
+#line 13931 ""
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);
@@ -20067,283 +32835,457 @@ L17:
/* 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 13936 ""
combjmp_1.isbj2 = TRUE_;
+#line 13937 ""
goto L17;
+#line 13938 ""
} else if (*(unsigned char *)charq == 'h') {
+#line 13939 ""
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 13940 ""
goto L17;
+#line 13941 ""
} else if (*(unsigned char *)charq == 'm') {
/* Force multiplicity. Next input is digit */
+#line 13945 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 13946 ""
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 13947 ""
i__1 = *(unsigned char *)charq - 48;
+#line 13947 ""
setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
+ 1) * 24 - 25], &c__3, &c__22, &i__1);
+#line 13948 ""
goto L17;
+#line 13949 ""
} else if (*(unsigned char *)charq == ':') {
/* Start auto forced beam pattern */
+#line 13953 ""
comfb_1.autofbon = TRUE_;
/* When forced later beam ends, check whether tautofv <=0; if so set it. */
+#line 13957 ""
comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]);
+#line 13958 ""
comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1];
+#line 13959 ""
goto L17;
+#line 13960 ""
} else if (*(unsigned char *)charq != ' ') {
/* Must be '+/-' for height or slope shift */
+#line 13964 ""
++nadj;
/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */
+#line 13968 ""
++all_1.iccount;
+#line 13969 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 13970 ""
--all_1.iccount;
+#line 13971 ""
iadj = i_nint(&fnum);
+#line 13972 ""
if (*(unsigned char *)charq == '-') {
+#line 13972 ""
iadj = -iadj;
+#line 13972 ""
}
+#line 13973 ""
if (nadj == 1) {
/* This is a level shift. Note if 0 was entered, iadj = 30 */
+#line 13977 ""
i__1 = iadj + 30;
+#line 13977 ""
setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
1] + 1) * 24 - 25], &c__6, &c__11, &i__1);
+#line 13978 ""
} else if (nadj == 2) {
/* Must be a slope shift */
+#line 13982 ""
i__1 = iadj + 30;
+#line 13982 ""
setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
1] + 1) * 24 - 25], &c__6, &c__17, &i__1);
+#line 13983 ""
} else {
/* Beam-thk fine tune */
+#line 13987 ""
setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
- 1] + 1) * 24 - 25], &c__2, &c__27, &iadj);
+#line 13988 ""
}
+#line 13989 ""
goto L17;
+#line 13990 ""
}
+#line 13991 ""
} else if (*(unsigned char *)charq == ']') {
+#line 13992 ""
if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) {
+#line 13993 ""
comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] +
comfb_1.tautofb;
+#line 13994 ""
}
+#line 13995 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 13996 ""
if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */
+#line 14000 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 -
25] = (real) all_1.itsofar[commvl_1.ivx - 1];
+#line 14001 ""
comget_1.fbon = FALSE_;
+#line 14002 ""
if (*(unsigned char *)charq == 'j') {
+#line 14002 ""
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 14002 ""
}
+#line 14004 ""
if (combjmp_1.isbj2) {
/* 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 14009 ""
if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) {
+#line 14009 ""
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 14009 ""
}
+#line 14011 ""
combjmp_1.isbj2 = FALSE_;
+#line 14012 ""
}
+#line 14013 ""
} else if (*(unsigned char *)charq == '[') {
/* Multiplicity down-up signal */
+#line 14017 ""
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 14018 ""
} else if (*(unsigned char *)charq == '-') {
/* Set signals for gap in single-slope beam [...]-[...] */
+#line 14022 ""
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 14023 ""
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);
/* Next two characters must be "[ ". Skip over them. */
+#line 14027 ""
all_1.iccount += 2;
+#line 14028 ""
}
+#line 14029 ""
} else if (*(unsigned char *)charq == 'D') {
+#line 14030 ""
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 14032 ""
} else if (*(unsigned char *)charq == 'h') {
/* Heading or height. For heading, only OK if at start of block */
/* Check whether at beginning of a block */
+#line 14037 ""
if (all_1.iv != 1 || all_1.nnl[0] != 0) {
- s_wsle(&io___774);
+#line 14038 ""
+ s_wsle(&io___813);
+#line 14038 ""
do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block"
, (ftnlen)41);
+#line 14038 ""
e_wsle();
+#line 14039 ""
stop1_();
+#line 14040 ""
}
+#line 14041 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14042 ""
comhead_1.ihdvrt = 0;
+#line 14043 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical offset */
+#line 14047 ""
++all_1.iccount;
+#line 14048 ""
readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 14049 ""
comhead_1.ihdvrt = fnum + .1f;
+#line 14050 ""
if (*(unsigned char *)durq == '-') {
+#line 14050 ""
comhead_1.ihdvrt = -comhead_1.ihdvrt;
+#line 14050 ""
}
+#line 14051 ""
*(unsigned char *)durq = *(unsigned char *)charq;
+#line 14052 ""
}
+#line 14053 ""
if (*(unsigned char *)durq != ' ') {
/* Height symbol. Read past (until next blank) */
+#line 14057 ""
L3:
+#line 14057 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14058 ""
if (*(unsigned char *)durq != ' ') {
+#line 14058 ""
goto L3;
+#line 14058 ""
}
+#line 14059 ""
} else {
/* Set flag for header & read it in */
+#line 14063 ""
comhead_1.ihdht = 16;
+#line 14064 ""
getbuf_(comhead_1.headrq, (ftnlen)80);
+#line 14065 ""
all_1.iccount = 128;
+#line 14066 ""
}
+#line 14067 ""
} else if (*(unsigned char *)charq == 'L') {
/* Linebreak, already handled in pmxa, but check for movement break */
+#line 14071 ""
++all_1.iccount;
+#line 14072 ""
readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen)
1);
+#line 14073 ""
if (*(unsigned char *)durq == 'P') {
+#line 14074 ""
++all_1.iccount;
+#line 14075 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 14076 ""
}
+#line 14077 ""
if (*(unsigned char *)durq == 'M') {
+#line 14078 ""
comget_1.movbrk = i_nint(&fmovbrk);
+#line 14079 ""
comget_1.movgap = 0;
+#line 14080 ""
comget_1.parmov = -1.f;
+#line 14081 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14082 ""
L31:
+#line 14082 ""
if (*(unsigned char *)durq == '+') {
/* Get vertical space (\internotes) */
+#line 14086 ""
++all_1.iccount;
+#line 14087 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 14088 ""
comget_1.movgap = i_nint(&fnum);
+#line 14089 ""
goto L31;
+#line 14090 ""
} else if (*(unsigned char *)durq == 'i') {
+#line 14091 ""
++all_1.iccount;
+#line 14092 ""
readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, (
ftnlen)128, (ftnlen)1);
+#line 14093 ""
goto L31;
+#line 14094 ""
} else if (*(unsigned char *)durq == 'c') {
+#line 14095 ""
comnotes_1.nobar1 = TRUE_;
+#line 14096 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14097 ""
goto L31;
+#line 14098 ""
} else if (*(unsigned char *)durq == 'r') {
/* "rename" can be set on or off. */
+#line 14102 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14103 ""
comnvi_1.rename = *(unsigned char *)durq == '+';
+#line 14104 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14105 ""
goto L31;
+#line 14106 ""
} 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 14111 ""
nvold = all_1.nv;
+#line 14112 ""
all_1.nv = 0;
+#line 14113 ""
comnvi_1.rename = TRUE_;
+#line 14114 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14115 ""
if (*(unsigned char *)durq == ':') {
+#line 14116 ""
all_1.iccount += 2;
+#line 14117 ""
i__1 = all_1.iccount - 2;
+#line 14117 ""
ici__1.icierr = 0;
+#line 14117 ""
ici__1.iciend = 0;
+#line 14117 ""
ici__1.icirnum = 1;
+#line 14117 ""
ici__1.icirlen = all_1.iccount - i__1;
+#line 14117 ""
ici__1.iciunit = lineq + i__1;
+#line 14117 ""
ici__1.icifmt = "(i2)";
+#line 14117 ""
s_rsfi(&ici__1);
+#line 14117 ""
do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof(
integer));
+#line 14117 ""
e_rsfi();
+#line 14118 ""
} else {
+#line 14119 ""
comnotes_1.ninow = *(unsigned char *)durq - 48;
+#line 14120 ""
}
+#line 14121 ""
iiv = 0;
+#line 14122 ""
i__1 = comnotes_1.ninow;
+#line 14122 ""
for (iinow = 1; iinow <= i__1; ++iinow) {
+#line 14123 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
+#line 14124 ""
if (*(unsigned char *)durq == ':') {
+#line 14125 ""
all_1.iccount += 2;
+#line 14126 ""
i__2 = all_1.iccount - 2;
+#line 14126 ""
ici__1.icierr = 0;
+#line 14126 ""
ici__1.iciend = 0;
+#line 14126 ""
ici__1.icirnum = 1;
+#line 14126 ""
ici__1.icirlen = all_1.iccount - i__2;
+#line 14126 ""
ici__1.iciunit = lineq + i__2;
+#line 14126 ""
ici__1.icifmt = "(i2)";
+#line 14126 ""
s_rsfi(&ici__1);
+#line 14126 ""
do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], (
ftnlen)sizeof(integer));
+#line 14126 ""
e_rsfi();
+#line 14127 ""
} else {
+#line 14128 ""
comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq -
48;
+#line 14129 ""
}
+#line 14130 ""
comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[
comnvi_1.iiorig[iinow - 1] - 1];
+#line 14131 ""
all_1.nv += comnvi_1.nspern[iinow - 1];
+#line 14132 ""
*(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[
iinow - 1] - 1] = '&';
+#line 14133 ""
if (comnvi_1.nspern[iinow - 1] > 1) {
+#line 14134 ""
i__2 = comnvi_1.nspern[iinow - 1] - 1;
+#line 14134 ""
for (iis = 1; iis <= i__2; ++iis) {
+#line 14135 ""
*(unsigned char *)&all_1.sepsymq[iiv + iis - 1] =
'|';
+#line 14136 ""
/* L64: */
+#line 14136 ""
}
+#line 14137 ""
}
+#line 14138 ""
iiv += comnvi_1.nspern[iinow - 1];
+#line 14139 ""
/* L63: */
+#line 14139 ""
}
/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */
@@ -20355,284 +33297,503 @@ L31:
/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */
/* end if */
/* end if */
+#line 14150 ""
if (all_1.nv == 1 && nvold > 1) {
+#line 14151 ""
if (comlast_1.islast) {
- s_wsfe(&io___779);
+#line 14151 ""
+ s_wsfe(&io___818);
/* Writing concatenation */
+#line 14151 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14151 ""
i__5[1] = 11, a__2[1] = "nostartrule";
+#line 14151 ""
s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
+#line 14151 ""
do_fio(&c__1, ch__2, (ftnlen)12);
+#line 14151 ""
e_wsfe();
+#line 14151 ""
}
+#line 14152 ""
} else if (all_1.nv > 1 && nvold == 1) {
+#line 14153 ""
if (comlast_1.islast) {
- s_wsfe(&io___780);
+#line 14153 ""
+ s_wsfe(&io___819);
/* Writing concatenation */
+#line 14153 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14153 ""
i__5[1] = 9, a__2[1] = "startrule";
+#line 14153 ""
s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14153 ""
do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14153 ""
e_wsfe();
+#line 14153 ""
}
+#line 14154 ""
}
+#line 14155 ""
iiv = 0;
+#line 14156 ""
i__1 = comnotes_1.ninow;
+#line 14156 ""
for (iinow = 1; iinow <= i__1; ++iinow) {
+#line 14157 ""
i__2 = comnvi_1.nspern[iinow - 1];
+#line 14157 ""
for (iis = 1; iis <= i__2; ++iis) {
+#line 14158 ""
++iiv;
/* 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. */
+#line 14163 ""
getchar_(lineq, &all_1.iccount, comclefq_1.clefq + (
iiv - 1), (ftnlen)128, (ftnlen)1);
+#line 14164 ""
newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true,
(ftnlen)1);
+#line 14165 ""
if (comnvi_1.nspern[iinow - 1] == 1) {
+#line 14166 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
ftnlen)1) + 48;
+#line 14166 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 14166 ""
s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1);
+#line 14167 ""
lclf = 1;
+#line 14168 ""
} else if (iis == 1) {
/* Writing concatenation */
+#line 14169 ""
i__5[0] = 1, a__2[0] = "{";
+#line 14169 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
ftnlen)1) + 48;
+#line 14169 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 14169 ""
i__5[1] = 1, a__2[1] = ch__1;
+#line 14169 ""
s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
+#line 14170 ""
lclf = 2;
+#line 14171 ""
} else if (iis < comnvi_1.nspern[iinow - 1]) {
/* Writing concatenation */
+#line 14172 ""
i__5[0] = lclf, a__2[0] = hdlndq;
+#line 14172 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
ftnlen)1) + 48;
+#line 14172 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 14172 ""
i__5[1] = 1, a__2[1] = ch__1;
+#line 14172 ""
s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
+#line 14173 ""
++lclf;
+#line 14174 ""
} else {
/* Writing concatenation */
+#line 14175 ""
i__6[0] = lclf, a__3[0] = hdlndq;
+#line 14175 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
ftnlen)1) + 48;
+#line 14175 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 14175 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 14175 ""
i__6[2] = 1, a__3[2] = "}";
+#line 14175 ""
s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
+#line 14177 ""
lclf += 2;
+#line 14178 ""
}
+#line 14179 ""
/* L61: */
+#line 14179 ""
}
/* setstaffs & setclef go by instrument, not voice */
+#line 14183 ""
if (comlast_1.islast) {
+#line 14184 ""
if (iinow < 10) {
- s_wsfe(&io___783);
+#line 14185 ""
+ s_wsfe(&io___822);
/* Writing concatenation */
+#line 14185 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14185 ""
i__3[1] = 9, a__1[1] = "setstaffs";
+#line 14185 ""
i__2 = iinow + 48;
+#line 14185 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14185 ""
i__3[2] = 1, a__1[2] = ch__1;
+#line 14185 ""
i__4 = comnvi_1.nspern[iinow - 1] + 48;
+#line 14185 ""
chax_(ch__5, (ftnlen)1, &i__4);
+#line 14185 ""
i__3[3] = 1, a__1[3] = ch__5;
+#line 14185 ""
i__3[4] = 1, a__1[4] = "%";
+#line 14185 ""
s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13);
+#line 14185 ""
do_fio(&c__1, ch__4, (ftnlen)13);
+#line 14185 ""
e_wsfe();
- s_wsfe(&io___784);
+#line 14187 ""
+ s_wsfe(&io___823);
/* Writing concatenation */
+#line 14187 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14187 ""
i__3[1] = 7, a__1[1] = "setclef";
+#line 14187 ""
i__2 = iinow + 48;
+#line 14187 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14187 ""
i__3[2] = 1, a__1[2] = ch__1;
+#line 14187 ""
i__3[3] = lclf, a__1[3] = hdlndq;
+#line 14187 ""
i__3[4] = 1, a__1[4] = "%";
+#line 14187 ""
s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69);
+#line 14187 ""
do_fio(&c__1, ch__6, lclf + 10);
+#line 14187 ""
e_wsfe();
+#line 14189 ""
if (comfig_1.fullsize[comnvi_1.iiorig[iinow - 1]
- 1] > .9f) {
- s_wsfe(&io___785);
+#line 14190 ""
+ s_wsfe(&io___824);
/* Writing concatenation */
+#line 14190 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14190 ""
i__3[1] = 7, a__1[1] = "setsize";
+#line 14190 ""
i__2 = iinow + 48;
+#line 14190 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14190 ""
i__3[2] = 1, a__1[2] = ch__1;
+#line 14190 ""
i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14190 ""
i__3[4] = 12, a__1[4] = "normalvalue%";
+#line 14190 ""
s_cat(ch__7, a__1, i__3, &c__5, (ftnlen)22);
+#line 14190 ""
do_fio(&c__1, ch__7, (ftnlen)22);
+#line 14190 ""
e_wsfe();
/* 140526 Account for staff size specs when noinst changes. May be confusion */
/* here if more than one staff per instrument */
+#line 14196 ""
} else if (comfig_1.fullsize[comnvi_1.iiorig[
iinow - 1] - 1] > .7f) {
- s_wsfe(&io___786);
+#line 14197 ""
+ s_wsfe(&io___825);
/* Writing concatenation */
+#line 14197 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14197 ""
i__3[1] = 7, a__1[1] = "setsize";
+#line 14197 ""
i__2 = iinow + 48;
+#line 14197 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14197 ""
i__3[2] = 1, a__1[2] = ch__1;
+#line 14197 ""
i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14197 ""
i__3[4] = 11, a__1[4] = "smallvalue%";
+#line 14197 ""
s_cat(ch__8, a__1, i__3, &c__5, (ftnlen)21);
+#line 14197 ""
do_fio(&c__1, ch__8, (ftnlen)21);
+#line 14197 ""
e_wsfe();
+#line 14199 ""
} else {
- s_wsfe(&io___787);
+#line 14200 ""
+ s_wsfe(&io___826);
/* Writing concatenation */
+#line 14200 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14200 ""
i__3[1] = 7, a__1[1] = "setsize";
+#line 14200 ""
i__2 = iinow + 48;
+#line 14200 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14200 ""
i__3[2] = 1, a__1[2] = ch__1;
+#line 14200 ""
i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14200 ""
i__3[4] = 10, a__1[4] = "tinyvalue%";
+#line 14200 ""
s_cat(ch__9, a__1, i__3, &c__5, (ftnlen)20);
+#line 14200 ""
do_fio(&c__1, ch__9, (ftnlen)20);
+#line 14200 ""
e_wsfe();
+#line 14202 ""
}
+#line 14203 ""
} else {
- s_wsfe(&io___788);
+#line 14204 ""
+ s_wsfe(&io___827);
/* Writing concatenation */
+#line 14204 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14204 ""
i__5[1] = 10, a__2[1] = "setstaffs{";
+#line 14204 ""
s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+#line 14204 ""
do_fio(&c__1, ch__10, (ftnlen)11);
+#line 14204 ""
do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 14204 ""
i__6[0] = 1, a__3[0] = "}";
+#line 14204 ""
i__2 = comnvi_1.nspern[iinow - 1] + 48;
+#line 14204 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 14204 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 14204 ""
i__6[2] = 1, a__3[2] = "%";
+#line 14204 ""
s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3);
+#line 14204 ""
do_fio(&c__1, ch__11, (ftnlen)3);
+#line 14204 ""
e_wsfe();
- s_wsfe(&io___789);
+#line 14206 ""
+ s_wsfe(&io___828);
/* Writing concatenation */
+#line 14206 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14206 ""
i__5[1] = 8, a__2[1] = "setclef{";
+#line 14206 ""
s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14206 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14206 ""
do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 14206 ""
i__6[0] = 1, a__3[0] = "}";
+#line 14206 ""
i__6[1] = lclf, a__3[1] = hdlndq;
+#line 14206 ""
i__6[2] = 1, a__3[2] = "%";
+#line 14206 ""
s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61);
+#line 14206 ""
do_fio(&c__1, ch__13, lclf + 2);
+#line 14206 ""
e_wsfe();
+#line 14208 ""
}
+#line 14209 ""
}
+#line 14210 ""
/* L60: */
+#line 14210 ""
}
/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */
+#line 14214 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14215 ""
goto L31;
+#line 14216 ""
}
/* Write instrument names */
+#line 14220 ""
if (! comnvi_1.rename) {
+#line 14221 ""
i__1 = comnotes_1.ninow;
+#line 14221 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
+#line 14222 ""
if (comlast_1.islast) {
+#line 14223 ""
if (iinst < 10) {
- s_wsfe(&io___791);
+#line 14224 ""
+ s_wsfe(&io___830);
/* Writing concatenation */
+#line 14224 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14224 ""
i__5[1] = 7, a__2[1] = "setname";
+#line 14224 ""
s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
+#line 14224 ""
do_fio(&c__1, ch__14, (ftnlen)8);
+#line 14224 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
+#line 14224 ""
do_fio(&c__1, "{}%", (ftnlen)3);
+#line 14224 ""
e_wsfe();
+#line 14225 ""
} else {
- s_wsfe(&io___792);
+#line 14226 ""
+ s_wsfe(&io___831);
/* Writing concatenation */
+#line 14226 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14226 ""
i__5[1] = 8, a__2[1] = "setname{";
+#line 14226 ""
s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14226 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14226 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
+#line 14226 ""
do_fio(&c__1, "}{}%", (ftnlen)4);
+#line 14226 ""
e_wsfe();
+#line 14227 ""
}
+#line 14228 ""
}
+#line 14229 ""
/* L62: */
+#line 14229 ""
}
+#line 14230 ""
} else {
+#line 14231 ""
i__1 = comnotes_1.ninow;
+#line 14231 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
+#line 14232 ""
if (comlast_1.islast) {
+#line 14233 ""
if (iinst < 10) {
- s_wsfe(&io___793);
+#line 14234 ""
+ s_wsfe(&io___832);
/* Writing concatenation */
+#line 14234 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14234 ""
i__5[1] = 7, a__2[1] = "setname";
+#line 14234 ""
s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
+#line 14234 ""
do_fio(&c__1, ch__14, (ftnlen)8);
+#line 14234 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 14234 ""
i__6[0] = 1, a__3[0] = "{";
+#line 14234 ""
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 14234 ""
i__6[2] = 2, a__3[2] = "}%";
+#line 14234 ""
s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82);
+#line 14234 ""
do_fio(&c__1, ch__15, comtop_1.lnam[
comnvi_1.iiorig[iinst - 1] - 1] + 3);
+#line 14234 ""
e_wsfe();
+#line 14236 ""
} else {
- s_wsfe(&io___794);
+#line 14237 ""
+ s_wsfe(&io___833);
/* Writing concatenation */
+#line 14237 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14237 ""
i__5[1] = 8, a__2[1] = "setname{";
+#line 14237 ""
s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14237 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14237 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 14237 ""
i__6[0] = 2, a__3[0] = "}{";
+#line 14237 ""
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 14237 ""
i__6[2] = 2, a__3[2] = "}%";
+#line 14237 ""
s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83);
+#line 14237 ""
do_fio(&c__1, ch__16, comtop_1.lnam[
comnvi_1.iiorig[iinst - 1] - 1] + 4);
+#line 14237 ""
e_wsfe();
+#line 14239 ""
}
+#line 14240 ""
}
+#line 14241 ""
/* L65: */
+#line 14241 ""
}
+#line 14242 ""
comnvi_1.rename = FALSE_;
+#line 14243 ""
}
+#line 14244 ""
}
+#line 14245 ""
} else if (*(unsigned char *)charq == '|') {
/* End of bar symbol. Check about end of bar hardspace. */
+#line 14249 ""
if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
+ 1) * 24 - 1],26)) {
@@ -20640,44 +33801,67 @@ L31:
/* list, store with shifts instead, set special bit. Need to repeat this code */
/* at '/'. */
+#line 14255 ""
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 14256 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
+#line 14257 ""
comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
* 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
+#line 14258 ""
--comudsp_1.nudsp;
+#line 14259 ""
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 14260 ""
}
+#line 14261 ""
} else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Width symbol or new nsyst. Read past (until blank) */
+#line 14265 ""
L4:
+#line 14265 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14266 ""
if (*(unsigned char *)durq != ' ') {
+#line 14266 ""
goto L4;
+#line 14266 ""
}
+#line 14267 ""
} else if (*(unsigned char *)charq == 'l') {
/* Lower string. Only OK if at start of block */
/* Check whether at beginning of a block */
+#line 14272 ""
if (all_1.iv != 1 || all_1.nnl[0] != 0) {
- s_wsle(&io___795);
+#line 14273 ""
+ s_wsle(&io___834);
+#line 14273 ""
do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block"
, (ftnlen)41);
+#line 14273 ""
e_wsle();
+#line 14274 ""
stop1_();
+#line 14275 ""
}
/* Set flag for lower string & read it in */
+#line 14279 ""
comhead_1.lower = TRUE_;
+#line 14280 ""
getbuf_(comhead_1.lowerq, (ftnlen)80);
+#line 14281 ""
all_1.iccount = 128;
+#line 14282 ""
} else if (*(unsigned char *)charq == 'm') {
/* Meter change. Only allow at beginning of block. */
@@ -20686,342 +33870,595 @@ L4:
/* Check whether at beginning of a block */
+#line 14290 ""
if (all_1.iv != 1 || all_1.nnl[0] != 0) {
- s_wsle(&io___796);
+#line 14291 ""
+ s_wsle(&io___835);
+#line 14291 ""
do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block"
, (ftnlen)41);
+#line 14291 ""
e_wsle();
+#line 14292 ""
stop1_();
+#line 14293 ""
}
+#line 14294 ""
readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, (
ftnlen)128);
+#line 14295 ""
readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, (
ftnlen)128);
+#line 14296 ""
lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
+#line 14297 ""
if (all_1.mtrdenl == 2) {
+#line 14297 ""
lenbeat = 16;
+#line 14297 ""
}
+#line 14298 ""
all_1.lenbar = all_1.mtrnuml * lenbeat;
+#line 14299 ""
if (all_1.mtrdenl == 2) {
+#line 14299 ""
all_1.lenbar <<= 1;
+#line 14299 ""
}
+#line 14300 ""
all_1.lenb1 = all_1.lenbar;
+#line 14301 ""
all_1.lenb0 = 0;
+#line 14302 ""
if (commidi_1.ismidi) {
+#line 14302 ""
midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
+#line 14302 ""
}
+#line 14303 ""
} else if (*(unsigned char *)charq == 'C') {
/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
+#line 14307 ""
if (all_1.nnl[all_1.iv - 1] > 0) {
+#line 14307 ""
++comcc_1.ncc[all_1.iv - 1];
+#line 14307 ""
}
+#line 14308 ""
comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real)
all_1.itsofar[all_1.iv - 1];
+#line 14309 ""
isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) *
24 - 25],11);
+#line 14310 ""
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 14314 ""
i__1 = numclef_(durq, (ftnlen)1);
+#line 14314 ""
isl |= min(i__1,7) << 12;
+#line 14315 ""
comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] =
ncmidf_(durq, (ftnlen)1);
+#line 14316 ""
if (*(unsigned char *)durq == '8') {
+#line 14317 ""
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 14318 ""
cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1]
- = 7;
+ += 7;
+#line 14319 ""
+ comnotes_1.lastlev += 7;
+#line 14320 ""
} 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. */
+
+#line 14325 ""
if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1]
- 1] == 7) {
+#line 14326 ""
cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1]
- - 1] = 0;
+ - 1] += -7;
+#line 14327 ""
+ comnotes_1.lastlev += -7;
+#line 14328 ""
+ s_wsle(&io___837);
+#line 14328 ""
+ do_lio(&c__9, &c__1, "Reset itransamt to ", (ftnlen)19);
+#line 14328 ""
+ do_lio(&c__3, &c__1, (char *)&cominsttrans_1.itransamt[
+ cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)
+ sizeof(integer));
+#line 14328 ""
+ e_wsle();
+#line 14329 ""
}
+#line 14330 ""
}
/* Set marker on note with lowest voice # starting at same time. */
+#line 14334 ""
if (all_1.iv == 1) {
+#line 14335 ""
isl = bit_set(isl,15);
+#line 14336 ""
} else {
+#line 14337 ""
i__1 = all_1.iv;
+#line 14337 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 14338 ""
nnliiv = all_1.nnl[iiv - 1];
+#line 14339 ""
if (iiv == all_1.iv) {
+#line 14339 ""
++nnliiv;
+#line 14339 ""
}
+#line 14340 ""
itother = 0;
+#line 14341 ""
i__2 = nnliiv;
+#line 14341 ""
for (iip = 1; iip <= i__2; ++iip) {
+#line 14342 ""
if (itother < all_1.itsofar[all_1.iv - 1]) {
+#line 14343 ""
itother += all_1.nodur[iiv + iip * 24 - 25];
+#line 14344 ""
goto L14;
+#line 14345 ""
} else if (itother == all_1.itsofar[all_1.iv - 1]) {
+#line 14346 ""
all_1.islur[iiv + iip * 24 - 25] = bit_set(
all_1.islur[iiv + iip * 24 - 25],15);
+#line 14347 ""
goto L15;
+#line 14348 ""
}
+#line 14349 ""
L14:
+#line 14349 ""
;
+#line 14349 ""
}
+#line 14350 ""
/* L13: */
+#line 14350 ""
}
+#line 14351 ""
L15:
+#line 14352 ""
;
+#line 14352 ""
}
/* Need 'or' since may have set bit 15 in the above loop */
+#line 14356 ""
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 14357 ""
} else if (*(unsigned char *)charq == 'R') {
/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */
+#line 14361 ""
L10:
+#line 14361 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* Save designator in case it's a terminal Rr or Rd */
+#line 14365 ""
if (*(unsigned char *)durq == 'l') {
+#line 14366 ""
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[(
all_1.nnl[0] + 1) * 24 - 24],5);
+#line 14367 ""
goto L10;
+#line 14368 ""
} else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) {
+#line 14369 ""
if (*(unsigned char *)durq == 'r') {
+#line 14370 ""
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6);
+#line 14371 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 14372 ""
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8);
+#line 14373 ""
} else if (*(unsigned char *)durq == 'D') {
+#line 14374 ""
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26);
+#line 14375 ""
} else if (*(unsigned char *)durq == 'b') {
+#line 14376 ""
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25);
+#line 14377 ""
} else if (*(unsigned char *)durq == 'z') {
/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */
+#line 14379 ""
all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.ipl[(
all_1.nnl[0] + 1) * 24 - 24],0);
+#line 14380 ""
}
+#line 14381 ""
comget_1.rptprev = TRUE_;
+#line 14382 ""
*(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq;
+#line 14383 ""
goto L10;
+#line 14384 ""
}
+#line 14385 ""
} else if (*(unsigned char *)charq == 'V') {
/* Ending */
+#line 14389 ""
nnnl = all_1.nnl[0] + 1;
+#line 14390 ""
lvoltxt = 0;
+#line 14391 ""
L11:
+#line 14391 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14392 ""
if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') {
/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */
+#line 14396 ""
all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24],
9);
+#line 14397 ""
if (*(unsigned char *)durq == 'b') {
+#line 14397 ""
all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
24],10);
+#line 14397 ""
}
+#line 14398 ""
goto L11;
+#line 14399 ""
} else if (*(unsigned char *)durq != ' ') {
/* Start volta; Get text */
+#line 14403 ""
if (lvoltxt == 0) {
/* First character for text */
+#line 14407 ""
lvoltxt = 1;
+#line 14408 ""
all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
24],7);
+#line 14409 ""
++comgrace_1.nvolt;
+#line 14410 ""
s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq,
(ftnlen)20, (ftnlen)1);
+#line 14411 ""
} else {
/* Writing concatenation */
+#line 14412 ""
i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + (
comgrace_1.nvolt - 1) * 20;
+#line 14412 ""
i__5[1] = 1, a__2[1] = durq;
+#line 14412 ""
s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__2,
i__5, &c__2, (ftnlen)20);
+#line 14413 ""
++lvoltxt;
+#line 14414 ""
}
+#line 14415 ""
goto L11;
+#line 14416 ""
}
+#line 14417 ""
} else if (*(unsigned char *)charq == 'B') {
+#line 14418 ""
combc_1.bcspec = ! combc_1.bcspec;
+#line 14419 ""
} else if (*(unsigned char *)charq == 'P') {
/* Page numbers. Print stuff right now. */
+#line 14423 ""
npg1 = 0;
/* Will use ltopnam to signal whether there's a centered heading */
+#line 14427 ""
ltopnam = 0;
+#line 14428 ""
ipg1r = 0;
+#line 14429 ""
L16:
+#line 14429 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14430 ""
if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) {
+#line 14431 ""
npg1 = npg1 * 10 + *(unsigned char *)durq - 48;
+#line 14432 ""
goto L16;
+#line 14433 ""
} else if (*(unsigned char *)durq == 'l') {
+#line 14434 ""
if (npg1 == 0 || npg1 % 2 == 1) {
+#line 14434 ""
ipg1r = 1;
+#line 14434 ""
}
+#line 14435 ""
goto L16;
+#line 14436 ""
} else if (*(unsigned char *)durq == 'r') {
+#line 14437 ""
if (npg1 > 0 && npg1 % 2 == 0) {
+#line 14437 ""
ipg1r = 1;
+#line 14437 ""
}
+#line 14438 ""
goto L16;
+#line 14439 ""
} else if (*(unsigned char *)durq == 'c') {
/* Top-centered name. Assume this is last option. Read the name. */
/* May surround name in double quotes (to allow blanks). */
+#line 14444 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14445 ""
if (*(unsigned char *)durq == ' ') {
+#line 14446 ""
ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60);
+#line 14447 ""
} else {
+#line 14448 ""
namstrt = all_1.iccount;
+#line 14449 ""
if (*(unsigned char *)durq == '"') {
/* Using quote delimiters. */
+#line 14453 ""
quoted = TRUE_;
+#line 14454 ""
++namstrt;
+#line 14455 ""
} else {
+#line 14456 ""
quoted = FALSE_;
+#line 14457 ""
}
+#line 14458 ""
for (all_1.iccount = namstrt + 1; all_1.iccount <= 128;
++all_1.iccount) {
/* if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or. */
+#line 14460 ""
i__1 = all_1.iccount - 2;
+#line 14460 ""
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 14460 ""
goto L36;
+#line 14460 ""
}
/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */
+#line 14467 ""
/* L35: */
+#line 14467 ""
}
- s_wsle(&io___805);
+#line 14468 ""
+ s_wsle(&io___845);
+#line 14468 ""
do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", (
ftnlen)31);
+#line 14468 ""
e_wsle();
+#line 14469 ""
stop1_();
+#line 14470 ""
L36:
+#line 14471 ""
ltopnam = all_1.iccount - namstrt;
+#line 14472 ""
s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60,
all_1.iccount - 1 - (namstrt - 1));
+#line 14473 ""
}
+#line 14474 ""
}
/* Done getting data, now assemble the command */
+#line 14478 ""
if (npg1 == 0) {
+#line 14478 ""
npg1 = 1;
+#line 14478 ""
}
/* 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 14483 ""
i__7[0] = 1, a__4[0] = all_1.sq;
+#line 14483 ""
i__7[1] = 3, a__4[1] = "def";
+#line 14483 ""
i__7[2] = 1, a__4[2] = all_1.sq;
+#line 14483 ""
i__7[3] = 11, a__4[3] = "atnextline{";
+#line 14483 ""
i__7[4] = 1, a__4[4] = all_1.sq;
+#line 14483 ""
i__7[5] = 10, a__4[5] = "toppageno{";
+#line 14483 ""
s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59);
+#line 14484 ""
lhead = 27;
/* else */
/* hdlndq = sq//'toppageno{' */
/* lhead = 11 */
/* end if */
+#line 14489 ""
if (npg1 < 10) {
/* Note we are overwriting the last "{" */
+#line 14493 ""
ici__1.icierr = 0;
+#line 14493 ""
ici__1.icirnum = 1;
+#line 14493 ""
ici__1.icirlen = 1;
+#line 14493 ""
ici__1.iciunit = hdlndq + (lhead - 1);
+#line 14493 ""
ici__1.icifmt = "(i1)";
+#line 14493 ""
s_wsfi(&ici__1);
+#line 14493 ""
do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14493 ""
e_wsfi();
+#line 14494 ""
} else if (npg1 < 100) {
+#line 14495 ""
lhead += 3;
+#line 14496 ""
i__1 = lhead - 3;
+#line 14496 ""
ici__1.icierr = 0;
+#line 14496 ""
ici__1.icirnum = 1;
+#line 14496 ""
ici__1.icirlen = lhead - i__1;
+#line 14496 ""
ici__1.iciunit = hdlndq + i__1;
+#line 14496 ""
ici__1.icifmt = "(i2,a1)";
+#line 14496 ""
s_wsfi(&ici__1);
+#line 14496 ""
do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14496 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 14496 ""
e_wsfi();
+#line 14497 ""
} else {
+#line 14498 ""
lhead += 4;
+#line 14499 ""
i__1 = lhead - 4;
+#line 14499 ""
ici__1.icierr = 0;
+#line 14499 ""
ici__1.icirnum = 1;
+#line 14499 ""
ici__1.icirlen = lhead - i__1;
+#line 14499 ""
ici__1.iciunit = hdlndq + i__1;
+#line 14499 ""
ici__1.icifmt = "(i3,a1)";
+#line 14499 ""
s_wsfi(&ici__1);
+#line 14499 ""
do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14499 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 14499 ""
e_wsfi();
+#line 14500 ""
}
/* Writing concatenation */
+#line 14501 ""
i__6[0] = lhead, a__3[0] = hdlndq;
+#line 14501 ""
i__1 = ipg1r + 48;
+#line 14501 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 14501 ""
i__6[1] = 1, a__3[1] = ch__1;
+#line 14501 ""
i__6[2] = 1, a__3[2] = "{";
+#line 14501 ""
s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
+#line 14502 ""
lhead += 2;
/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */
+#line 14504 ""
if (ltopnam == 0) {
+#line 14505 ""
if (comlast_1.islast) {
- s_wsfe(&io___807);
+#line 14505 ""
+ s_wsfe(&io___847);
/* Writing concatenation */
+#line 14505 ""
i__5[0] = lhead, a__2[0] = hdlndq;
+#line 14505 ""
i__5[1] = 3, a__2[1] = "}}%";
+#line 14505 ""
s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62);
+#line 14505 ""
do_fio(&c__1, ch__17, lhead + 3);
+#line 14505 ""
e_wsfe();
+#line 14505 ""
}
+#line 14506 ""
} else {
+#line 14507 ""
if (comlast_1.islast) {
- s_wsfe(&io___808);
+#line 14507 ""
+ s_wsfe(&io___848);
/* Writing concatenation */
+#line 14507 ""
i__6[0] = lhead, a__3[0] = hdlndq;
+#line 14507 ""
i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq;
+#line 14507 ""
i__6[2] = 3, a__3[2] = "}}%";
+#line 14507 ""
s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122);
+#line 14507 ""
do_fio(&c__1, ch__18, lhead + ltopnam + 3);
+#line 14507 ""
e_wsfe();
+#line 14507 ""
}
+#line 14509 ""
}
/* else */
/* if (ltopnam .eq. 0) then */
@@ -21031,491 +34468,861 @@ L36:
/* * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */
/* end if */
/* end if */
+#line 14518 ""
} else if (*(unsigned char *)charq == 'W') {
/* Just eat the number that must follow, it was used in pmxa */
+#line 14522 ""
++all_1.iccount;
+#line 14523 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 14524 ""
} else if (*(unsigned char *)charq == 'T') {
+#line 14525 ""
comtitl_1.headlog = TRUE_;
+#line 14526 ""
comtitl_1.inhead = 0;
+#line 14527 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14528 ""
if (*(unsigned char *)durq == 'i') {
+#line 14529 ""
getbuf_(comtitl_1.instrq, (ftnlen)120);
/* A kluge for parts from separate score file for later movements. */
+#line 14533 ""
if (*(unsigned char *)comtitl_1.instrq == ' ') {
+#line 14533 ""
comtitl_1.headlog = FALSE_;
+#line 14533 ""
}
+#line 14534 ""
s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen)
60);
+#line 14535 ""
} else if (*(unsigned char *)durq == 't') {
+#line 14536 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* Optionally can include extra vertical \internotes above inbothd */
+#line 14540 ""
if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) {
+#line 14541 ""
ipm = 1;
+#line 14542 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Don't trust readnum to round this negative integer properly */
+#line 14546 ""
++all_1.iccount;
+#line 14547 ""
if (*(unsigned char *)durq == '-') {
+#line 14547 ""
ipm = -1;
+#line 14547 ""
}
+#line 14548 ""
}
+#line 14549 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 14550 ""
comtitl_1.inhead = ipm * i_nint(&fnum);
+#line 14551 ""
}
+#line 14552 ""
getbuf_(comtitl_1.titleq, (ftnlen)120);
+#line 14553 ""
} else {
+#line 14554 ""
getbuf_(comtitl_1.compoq, (ftnlen)120);
+#line 14555 ""
}
+#line 14556 ""
comtitl_1.inhead += cominbot_1.inbothd;
+#line 14557 ""
all_1.iccount = 128;
+#line 14558 ""
} else if (*(unsigned char *)charq == 'A') {
/* Accidental handling etc. */
+#line 14562 ""
L27:
+#line 14562 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14563 ""
if (*(unsigned char *)durq == 'r') {
+#line 14564 ""
if (comlast_1.islast) {
+#line 14565 ""
commidi_1.relacc = TRUE_;
- s_wsfe(&io___809);
+#line 14566 ""
+ s_wsfe(&io___849);
/* Writing concatenation */
+#line 14566 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14566 ""
i__5[1] = 14, a__2[1] = "relativeaccid%";
+#line 14566 ""
s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15);
+#line 14566 ""
do_fio(&c__1, ch__19, (ftnlen)15);
+#line 14566 ""
e_wsfe();
+#line 14567 ""
}
+#line 14568 ""
} else if (*(unsigned char *)durq == 's') {
+#line 14569 ""
spfacs_1.bacfac = 1e6f;
+#line 14570 ""
} else if (*(unsigned char *)durq == 'b') {
+#line 14571 ""
if (comlast_1.islast) {
- s_wsfe(&io___810);
+#line 14571 ""
+ s_wsfe(&io___850);
/* Writing concatenation */
+#line 14571 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14571 ""
i__5[1] = 9, a__2[1] = "bigaccid%";
+#line 14571 ""
s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14571 ""
do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14571 ""
e_wsfe();
+#line 14571 ""
}
+#line 14572 ""
spfacs_1.accfac = spfacs_1.bacfac;
+#line 14573 ""
} else if (*(unsigned char *)durq == 'a') {
+#line 14574 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14575 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 14576 ""
--all_1.iccount;
+#line 14577 ""
} else if (*(unsigned char *)durq == 'i') {
+#line 14578 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14579 ""
readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, (
ftnlen)1);
+#line 14580 ""
if (! all_1.firstgulp) {
+#line 14580 ""
comget_1.fintstf = tintstf;
+#line 14580 ""
}
/* Local corrections for first page were handled by pmxa */
+#line 14584 ""
--all_1.iccount;
+#line 14585 ""
} else if (*(unsigned char *)durq == 'I') {
+#line 14586 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14587 ""
readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen)
128, (ftnlen)1);
+#line 14588 ""
--all_1.iccount;
+#line 14589 ""
} else if (*(unsigned char *)durq == 'd') {
+#line 14590 ""
comarp_1.lowdot = TRUE_;
+#line 14591 ""
} else if (*(unsigned char *)durq == 'o') {
+#line 14593 ""
} else if (*(unsigned char *)durq == 'S') {
/* 130324 */
/* do 50 iiv = 1 , nv */
+#line 14596 ""
i__1 = comkeys_2.noinst;
+#line 14596 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 14597 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14598 ""
if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 14599 ""
comfig_1.fullsize[iiv - 1] = .8f;
+#line 14600 ""
} else if (*(unsigned char *)durq == 't') {
+#line 14601 ""
comfig_1.fullsize[iiv - 1] = .64f;
+#line 14602 ""
} else {
/* fullsize(ivx) = 1.0 */
+#line 14604 ""
comfig_1.fullsize[iiv - 1] = 1.f;
+#line 14605 ""
}
+#line 14606 ""
/* L50: */
+#line 14606 ""
}
+#line 14607 ""
} else if (*(unsigned char *)durq == 'e') {
/* Line-spacing equalization */
+#line 14611 ""
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. */
- s_wsfe(&io___812);
+#line 14617 ""
+ s_wsfe(&io___852);
/* Writing concatenation */
+#line 14617 ""
i__8[0] = 1, a__5[0] = all_1.sq;
+#line 14617 ""
i__8[1] = 6, a__5[1] = "global";
+#line 14617 ""
i__8[2] = 1, a__5[2] = all_1.sq;
+#line 14617 ""
i__8[3] = 19, a__5[3] = "parskip 0pt plus 12";
+#line 14617 ""
i__8[4] = 1, a__5[4] = all_1.sq;
+#line 14617 ""
i__8[5] = 19, a__5[5] = "Interligne minus 99";
+#line 14617 ""
i__8[6] = 1, a__5[6] = all_1.sq;
+#line 14617 ""
i__8[7] = 11, a__5[7] = "Interligne%";
+#line 14617 ""
s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59);
+#line 14617 ""
do_fio(&c__1, ch__20, (ftnlen)59);
+#line 14617 ""
e_wsfe();
+#line 14619 ""
s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1);
+#line 14620 ""
lentemp = 1;
+#line 14621 ""
i__1 = all_1.nv - 1;
+#line 14621 ""
for (iiv = 2; iiv <= i__1; ++iiv) {
/* Writing concatenation */
+#line 14622 ""
i__5[0] = lentemp, a__2[0] = tempq;
+#line 14622 ""
i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1);
+#line 14622 ""
s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24);
+#line 14623 ""
++lentemp;
+#line 14624 ""
/* L51: */
+#line 14624 ""
}
- s_wsfe(&io___815);
+#line 14625 ""
+ s_wsfe(&io___855);
/* Writing concatenation */
+#line 14625 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 14625 ""
i__9[1] = 3, a__6[1] = "def";
+#line 14625 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 14625 ""
i__9[3] = 8, a__6[3] = "upstrut{";
+#line 14625 ""
i__9[4] = 1, a__6[4] = all_1.sq;
+#line 14625 ""
i__9[5] = 6, a__6[5] = "znotes";
+#line 14625 ""
i__9[6] = lentemp, a__6[6] = tempq;
+#line 14625 ""
i__9[7] = 1, a__6[7] = all_1.sq;
+#line 14625 ""
i__9[8] = 10, a__6[8] = "zcharnote{";
+#line 14625 ""
i__9[9] = 1, a__6[9] = all_1.sq;
+#line 14625 ""
i__9[10] = 9, a__6[10] = "upamt}{~}";
+#line 14625 ""
i__9[11] = 1, a__6[11] = all_1.sq;
+#line 14625 ""
i__9[12] = 4, a__6[12] = "en}%";
+#line 14625 ""
s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70);
+#line 14625 ""
do_fio(&c__1, ch__21, lentemp + 46);
+#line 14625 ""
e_wsfe();
+#line 14628 ""
} else if (*(unsigned char *)durq == 'v') {
/* Toggle usevshrink */
+#line 14632 ""
comlast_1.usevshrink = ! comlast_1.usevshrink;
+#line 14633 ""
} else if (*(unsigned char *)durq == 'p') {
/* Postscript slurs. fontslur is already false (set in g1etnote) */
+#line 14637 ""
if (! comslur_1.wrotepsslurdefaults) {
/* Set postscrirpt slur adjustment defaults */
- s_wsfe(&io___816);
+#line 14641 ""
+ s_wsfe(&io___856);
/* Writing concatenation */
+#line 14641 ""
i__7[0] = 1, a__4[0] = all_1.sq;
+#line 14641 ""
i__7[1] = 12, a__4[1] = "Nosluradjust";
+#line 14641 ""
i__7[2] = 1, a__4[2] = all_1.sq;
+#line 14641 ""
i__7[3] = 11, a__4[3] = "Notieadjust";
+#line 14641 ""
i__7[4] = 1, a__4[4] = all_1.sq;
+#line 14641 ""
i__7[5] = 10, a__4[5] = "nohalfties";
+#line 14641 ""
s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36);
+#line 14641 ""
do_fio(&c__1, ch__22, (ftnlen)36);
+#line 14641 ""
e_wsfe();
+#line 14643 ""
comslur_1.wrotepsslurdefaults = TRUE_;
+#line 14644 ""
}
+#line 14645 ""
L52:
+#line 14646 ""
g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* might be "+", "-", "h" or */
+#line 14647 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Characters to change defaults for ps slurs */
+#line 14651 ""
g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)
1);
/* charq will be "s,t,h,c */
+#line 14652 ""
if (*(unsigned char *)durq == '+') {
+#line 14653 ""
if (*(unsigned char *)charq == 's') {
- s_wsfe(&io___817);
+#line 14654 ""
+ s_wsfe(&io___857);
/* Writing concatenation */
+#line 14654 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14654 ""
i__5[1] = 10, a__2[1] = "Sluradjust";
+#line 14654 ""
s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+#line 14654 ""
do_fio(&c__1, ch__10, (ftnlen)11);
+#line 14654 ""
e_wsfe();
+#line 14655 ""
} else if (*(unsigned char *)charq == 't') {
- s_wsfe(&io___818);
+#line 14656 ""
+ s_wsfe(&io___858);
/* Writing concatenation */
+#line 14656 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14656 ""
i__5[1] = 9, a__2[1] = "Tieadjust";
+#line 14656 ""
s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14656 ""
do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14656 ""
e_wsfe();
+#line 14657 ""
} else if (*(unsigned char *)charq == 'h') {
- s_wsfe(&io___819);
+#line 14658 ""
+ s_wsfe(&io___859);
/* Writing concatenation */
+#line 14658 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14658 ""
i__5[1] = 8, a__2[1] = "halfties";
+#line 14658 ""
s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14658 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14658 ""
e_wsfe();
+#line 14659 ""
} else {
+#line 14660 ""
comslur_1.slurcurve += 1;
+#line 14661 ""
if (comslur_1.slurcurve > 3.1f) {
+#line 14662 ""
printl_("WARNING!", (ftnlen)8);
- printl_("Default slur curvature advanced past HH"
+#line 14663 ""
+ printl_("Default slur curvature advanced past HH"\
", resetting", (ftnlen)50);
+#line 14665 ""
comslur_1.slurcurve = 3.f;
+#line 14666 ""
}
+#line 14667 ""
}
+#line 14668 ""
} else {
+#line 14669 ""
if (*(unsigned char *)charq == 's') {
- s_wsfe(&io___820);
+#line 14670 ""
+ s_wsfe(&io___860);
/* Writing concatenation */
+#line 14670 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14670 ""
i__5[1] = 12, a__2[1] = "Nosluradjust";
+#line 14670 ""
s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13);
+#line 14670 ""
do_fio(&c__1, ch__4, (ftnlen)13);
+#line 14670 ""
e_wsfe();
+#line 14671 ""
} else if (*(unsigned char *)charq == 't') {
- s_wsfe(&io___821);
+#line 14672 ""
+ s_wsfe(&io___861);
/* Writing concatenation */
+#line 14672 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14672 ""
i__5[1] = 11, a__2[1] = "Notieadjust";
+#line 14672 ""
s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
+#line 14672 ""
do_fio(&c__1, ch__2, (ftnlen)12);
+#line 14672 ""
e_wsfe();
+#line 14673 ""
} else if (*(unsigned char *)charq == 'h') {
- s_wsfe(&io___822);
+#line 14674 ""
+ s_wsfe(&io___862);
/* Writing concatenation */
+#line 14674 ""
i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14674 ""
i__5[1] = 10, a__2[1] = "nohalfties";
+#line 14674 ""
s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+#line 14674 ""
do_fio(&c__1, ch__10, (ftnlen)11);
+#line 14674 ""
e_wsfe();
+#line 14675 ""
} else {
+#line 14676 ""
comslur_1.slurcurve += -1;
+#line 14677 ""
if (comslur_1.slurcurve < -1.1f) {
+#line 14678 ""
printl_("WARNING!", (ftnlen)8);
- printl_("Default slur curvature decremented belo"
+#line 14679 ""
+ printl_("Default slur curvature decremented belo"\
"w f, resetting", (ftnlen)53);
+#line 14681 ""
comslur_1.slurcurve = -1.f;
+#line 14682 ""
}
+#line 14683 ""
}
+#line 14684 ""
}
+#line 14685 ""
goto L52;
/* Check for another set of default changes */
+#line 14686 ""
} else if (*(unsigned char *)durq == 'l') {
/* Set optional linebreak ties */
+#line 14690 ""
comnotes_1.optlinebreakties = TRUE_;
+#line 14691 ""
goto L52;
+#line 14692 ""
} else if (*(unsigned char *)durq == 'h') {
/* Set flag to write header special on every page */
+#line 14696 ""
comnotes_1.headerspecial = TRUE_;
+#line 14697 ""
goto L52;
+#line 14698 ""
} else {
+#line 14699 ""
--all_1.iccount;
+#line 14700 ""
}
+#line 14701 ""
} else if (*(unsigned char *)durq == 'K') {
/* Toggle keyboard rest placement flag */
+#line 14705 ""
comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests;
+#line 14706 ""
} else if (*(unsigned char *)durq == 'c') {
+#line 14707 ""
g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* Just eat the input; it was used in pmxa */
+#line 14711 ""
+ goto L27;
+#line 14712 ""
+ } else if (*(unsigned char *)durq == 'V') {
+#line 14713 ""
+ combottop_1.bottopgap = TRUE_;
+#line 14714 ""
+ combottop_1.topamt = 0.f;
+#line 14715 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14716 ""
+ pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2);
+#line 14717 ""
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14718 ""
+ readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, (
+ ftnlen)128, (ftnlen)1);
+#line 14719 ""
+ combottop_1.botamt *= pmfac;
+#line 14720 ""
+ pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2);
+#line 14721 ""
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14722 ""
+ readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, (
+ ftnlen)128, (ftnlen)1);
+#line 14723 ""
+ combottop_1.topamt *= pmfac;
+#line 14724 ""
+ --all_1.iccount;
+#line 14725 ""
goto L27;
+#line 14726 ""
}
+#line 14727 ""
if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Override default part names for scor2prt, or normal include file. */
/* Just bypass rest of input line */
+#line 14732 ""
all_1.iccount = 128;
+#line 14733 ""
} else if (*(unsigned char *)durq != ' ') {
+#line 14734 ""
goto L27;
+#line 14735 ""
}
+#line 14736 ""
} else if (*(unsigned char *)charq == 'K') {
+#line 14737 ""
L77:
+#line 14738 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14739 ""
if (*(unsigned char *)durq == 'n') {
+#line 14740 ""
comignorenats_1.ignorenats = TRUE_;
+#line 14741 ""
goto L77;
+#line 14742 ""
}
+#line 14743 ""
if (*(unsigned char *)durq != 'i') {
/* Normal, full-score key change and/or transposition */
+#line 14747 ""
num1 = 44 - *(unsigned char *)durq;
+#line 14748 ""
++all_1.iccount;
+#line 14749 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 14750 ""
num1 *= i_nint(&fnum);
/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */
+#line 14754 ""
++all_1.iccount;
+#line 14755 ""
readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
ftnlen)1);
+#line 14756 ""
if (commidi_1.ismidi) {
+#line 14757 ""
commidisig_1.midisig = i_nint(&fnum);
+#line 14758 ""
if (*(unsigned char *)durq == '-') {
+#line 14758 ""
commidisig_1.midisig = -commidisig_1.midisig;
+#line 14758 ""
}
/* 130317 */
+#line 14760 ""
commidisig_1.midisig += comtop_1.idsig;
+#line 14761 ""
midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1);
+#line 14763 ""
}
/* 70 continue */
+#line 14765 ""
if (num1 == 0) {
/* Key change, not transposition. */
+#line 14769 ""
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 14770 ""
comtop_1.lastisig = comtop_1.isig;
+#line 14771 ""
comtop_1.isig = i_nint(&fnum);
+#line 14772 ""
if (*(unsigned char *)durq == '-') {
+#line 14772 ""
comtop_1.isig = -comtop_1.isig;
+#line 14772 ""
}
+#line 14773 ""
comtop_1.isig += comtop_1.idsig;
+#line 14774 ""
if (commidi_1.ismidi) {
+#line 14774 ""
midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1);
+#line 14774 ""
}
+#line 14775 ""
} 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 14781 ""
jv = 0;
+#line 14782 ""
while(jv < 24) {
+#line 14783 ""
++jv;
+#line 14784 ""
cominsttrans_1.itransamt[jv - 1] = num1;
+#line 14785 ""
}
+#line 14786 ""
comtop_1.idsig = comtop_1.isig - comtop_1.isig0;
+#line 14787 ""
}
+#line 14788 ""
} else {
/* Instrument specific transposition. */
+#line 14792 ""
getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, &
all_1.iccount, &ibaroff, &all_1.nbars, &comkeys_2.noinst,
(ftnlen)128);
/* The sig parameters will have been set 1st time but that's OK */
+#line 14797 ""
}
+#line 14798 ""
} else if (*(unsigned char *)charq == '/') {
+#line 14799 ""
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 14804 ""
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 14805 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
+#line 14806 ""
comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
* 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
+#line 14807 ""
--comudsp_1.nudsp;
+#line 14808 ""
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 14809 ""
}
+#line 14810 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* Save ending note level: */
+#line 14814 ""
if (commvl_1.ivx <= all_1.nv) {
/* 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 14820 ""
if (! comnotes_1.was2[all_1.iv - 1]) {
+#line 14820 ""
comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv -
1];
+#line 14820 ""
}
+#line 14821 ""
comnotes_1.was2[all_1.iv - 1] = FALSE_;
+#line 14822 ""
comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev;
+#line 14823 ""
} else {
/* This is the 2nd line of music on this staff. */
+#line 14827 ""
comnotes_1.was2[all_1.iv - 1] = TRUE_;
+#line 14828 ""
comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev;
+#line 14829 ""
}
+#line 14830 ""
if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) {
/* End of input block */
+#line 14834 ""
*loop = FALSE_;
+#line 14835 ""
} else {
/* Start a new line of music */
+#line 14839 ""
if (all_1.lenb0 != 0 && all_1.firstgulp) {
+#line 14839 ""
all_1.lenbar = all_1.lenb0;
+#line 14839 ""
}
+#line 14840 ""
all_1.nbars = 0;
+#line 14841 ""
if (*(unsigned char *)durq == ' ') {
/* New line of music is on next staff */
+#line 14845 ""
++all_1.iv;
+#line 14846 ""
commvl_1.ivx = all_1.iv;
+#line 14847 ""
} else {
/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */
+#line 14851 ""
commvl_1.ivx = all_1.nv + 1;
+#line 14852 ""
i__1 = all_1.nv;
+#line 14852 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 14853 ""
if (commvl_1.nvmx[iiv - 1] == 2) {
+#line 14853 ""
++commvl_1.ivx;
+#line 14853 ""
}
+#line 14854 ""
/* L23: */
+#line 14854 ""
}
+#line 14855 ""
commvl_1.nvmx[all_1.iv - 1] = 2;
+#line 14856 ""
commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx;
+#line 14857 ""
all_1.itsofar[commvl_1.ivx - 1] = 0;
+#line 14858 ""
all_1.nnl[commvl_1.ivx - 1] = 0;
+#line 14859 ""
comfb_1.nfb[commvl_1.ivx - 1] = 0;
+#line 14860 ""
comudsp_1.nudoff[commvl_1.ivx - 1] = 0;
+#line 14861 ""
comcc_1.ndotmv[commvl_1.ivx - 1] = 0;
+#line 14862 ""
for (j = 1; j <= 200; ++j) {
+#line 14863 ""
all_1.irest[commvl_1.ivx + j * 24 - 25] = 0;
+#line 14864 ""
all_1.islur[commvl_1.ivx + j * 24 - 25] = 0;
+#line 14865 ""
all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0;
+#line 14866 ""
all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0;
+#line 14867 ""
all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0;
+#line 14868 ""
all_1.mult[commvl_1.ivx + j * 24 - 25] = 0;
+#line 14869 ""
/* L24: */
+#line 14869 ""
}
/* Go back and lower the rests in voice "a" that don't have over-ridden heights */
+#line 14873 ""
i__1 = all_1.nnl[all_1.iv - 1];
+#line 14873 ""
for (j = 1; j <= i__1; ++j) {
+#line 14874 ""
if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) &&
all_1.nolev[all_1.iv + j * 24 - 25] == 0) {
+#line 14874 ""
all_1.nolev[all_1.iv + j * 24 - 25] = -4;
+#line 14874 ""
}
+#line 14876 ""
/* L26: */
+#line 14876 ""
}
+#line 14877 ""
}
+#line 14878 ""
}
+#line 14879 ""
all_1.iccount = 128;
+#line 14880 ""
} else if (*(unsigned char *)charq == 'X') {
/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */
@@ -21523,7 +35330,9 @@ L77:
/* keep group shifts for crossing block boundaries. */
/* Computing MAX */
+#line 14886 ""
i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1];
+#line 14886 ""
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) *
@@ -21531,91 +35340,140 @@ L77:
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 14889 ""
} else if (*(unsigned char *)charq == 'I') {
/* Midi controls. */
/* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */
+#line 14894 ""
getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, &
combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &all_1.lenbar,
&all_1.mtrdenl, &c_false, (ftnlen)128);
+#line 14896 ""
} else if (*(unsigned char *)charq == 'M') {
/* Macro action */
+#line 14900 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 14901 ""
if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Record or save a macro. Get the number of the macro. */
+#line 14905 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14906 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 14907 ""
commac_1.macnum = i_nint(&fnum);
+#line 14908 ""
commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
+#line 14909 ""
if (*(unsigned char *)charq == 'R') {
+#line 14910 ""
mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
+#line 14911 ""
} else {
/* Save (Record but don't activate) */
+#line 14915 ""
L5:
+#line 14915 ""
mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
+#line 14916 ""
if (commac_1.mrecord) {
+#line 14917 ""
getbuf_(lineq, (ftnlen)128);
+#line 14918 ""
all_1.iccount = 0;
+#line 14919 ""
goto L5;
+#line 14920 ""
}
+#line 14921 ""
all_1.iccount = all_1.iccount + ndxm + 1;
+#line 14922 ""
}
+#line 14923 ""
} else if (*(unsigned char *)charq == 'P') {
/* Playback the macro */
+#line 14927 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 14928 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
1);
+#line 14929 ""
commac_1.macnum = i_nint(&fnum);
+#line 14930 ""
commac_1.icchold = all_1.iccount;
+#line 14931 ""
s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
+#line 14932 ""
all_1.iccount = 128;
+#line 14933 ""
c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
+#line 14934 ""
commac_1.mplay = TRUE_;
+#line 14935 ""
}
+#line 14936 ""
} else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Continued rhythmic shortcut */
+#line 14940 ""
idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
+#line 14941 ""
if (idotform == 1) {
/* Check for start of forced beam on 2nd member of dotform=1 shortcut */
+#line 14945 ""
if (comget_1.fbon) {
+#line 14946 ""
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 14946 ""
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 14946 ""
}
+#line 14949 ""
}
/* Change duration of prior note */
+#line 14953 ""
all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
+#line 14954 ""
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 14955 ""
all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
+#line 14956 ""
}
+#line 14957 ""
++idotform;
+#line 14958 ""
numnum = 1;
+#line 14959 ""
cdot = TRUE_;
+#line 14960 ""
goto L1;
+#line 14961 ""
}
+#line 14962 ""
return 0;
} /* getnote_ */
@@ -21650,7 +35508,7 @@ L5:
static real xofforn;
/* Fortran I/O blocks */
- static cilist io___834 = { 0, 6, 0, 0, 0 };
+ static cilist io___875 = { 0, 6, 0, 0, 0 };
@@ -21664,7 +35522,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 14986 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 14987 ""
if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */
@@ -21674,74 +35534,117 @@ L5:
/* bit 27 = 0 if caesura, 1 if breath */
/* bit 28: 5th bit of ivx */
+#line 14996 ""
*iornq = bit_set(*iornq,28);
+#line 14997 ""
++comcb_1.nbc;
/* ibcdata(nbc) = ivx+16*ip */
+#line 14999 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4);
+#line 15000 ""
if (*ivx >= 16) {
+#line 15000 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
comcb_1.nbc - 1],28);
+#line 15000 ""
}
+#line 15001 ""
if (*(unsigned char *)charq == 'b') {
+#line 15001 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
comcb_1.nbc - 1],27);
+#line 15001 ""
}
+#line 15002 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15003 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* We have a vertical shift, get it */
+#line 15007 ""
++(*iccount);
+#line 15008 ""
readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 15009 ""
if (*(unsigned char *)durq == '-') {
+#line 15009 ""
fnum = -fnum;
+#line 15009 ""
}
+#line 15010 ""
r__1 = fnum + 32;
+#line 15010 ""
i__1 = i_nint(&r__1);
+#line 15010 ""
setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1);
+#line 15011 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Horizontal shift, get it */
+#line 15015 ""
++(*iccount);
+#line 15016 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 15017 ""
if (*(unsigned char *)charq == '-') {
+#line 15017 ""
fnum = -fnum;
+#line 15017 ""
}
+#line 15018 ""
r__1 = fnum * 10;
+#line 15018 ""
i__1 = i_nint(&r__1) + 128;
+#line 15018 ""
setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, &
i__1);
+#line 15019 ""
}
+#line 15020 ""
}
+#line 15021 ""
return 0;
+#line 15022 ""
}
/* 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 15027 ""
*iornq = bit_set(*iornq,23);
/* Isolate 21 bits defining exisiting ornaments */
+#line 15031 ""
if (*notcrd) {
/* iorni = iand(4194303,iornq) */
/* iorni = iand(541065215,iornq) */
+#line 15034 ""
iorni = 1614807039 & *iornq;
+#line 15035 ""
} else {
+#line 15036 ""
iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1];
+#line 15037 ""
}
/* korn = index('stmgx+Tupf._)e:XXX>^',charq) */
+#line 15039 ""
korn = i_indx("stmgx+Tupf._)e:XXX>^XXXXXXXXCG", charq, (ftnlen)30, (
ftnlen)1);
+#line 15040 ""
if (korn != 15) {
+#line 15040 ""
iorni = bit_set(iorni,korn);
+#line 15040 ""
}
/* 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 15046 ""
if (korn == 15) {
/* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */
@@ -21751,147 +35654,236 @@ L5:
/* iorni = ior(iorni,iand(iornq0,1638383)) */
/* iorni = ior(iorni,iand(iornq0,3735535)) */
/* iorni = ior(iorni,iand(iornq0,540606447)) */
+#line 15055 ""
iorni |= *iornq0 & 1614348271;
+#line 15056 ""
*ornrpt = FALSE_;
+#line 15057 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* durq will be ' ' */
+#line 15061 ""
} else if (korn == 14) {
/* Editorial accidental */
+#line 15065 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* korn = 15+index('sfn',durq) */
+#line 15067 ""
korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15;
+#line 15068 ""
if (korn == 19) {
+#line 15068 ""
korn = 21;
+#line 15068 ""
}
+#line 15069 ""
iorni = bit_set(bit_clear(iorni,14),korn);
+#line 15070 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15071 ""
if (*(unsigned char *)durq == '?') {
/* This is "oe[s|f|n]?". Set 21st bit also. */
+#line 15075 ""
iorni = bit_set(iorni,21);
+#line 15076 ""
korn += 6;
+#line 15077 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15078 ""
}
/* iorni = ibset(ibclr(iorni,14),korn) */
+#line 15080 ""
} else if (korn == 4 && *noxtup) {
/* segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points */
+#line 15084 ""
*noffseg = 0;
+#line 15085 ""
negseg = FALSE_;
+#line 15086 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15087 ""
if (*(unsigned char *)durq != ' ') {
/* Segno shift is specified */
+#line 15091 ""
if (*(unsigned char *)durq == '-') {
+#line 15092 ""
negseg = TRUE_;
+#line 15093 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15094 ""
}
+#line 15095 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 15096 ""
*noffseg = (integer) fnum;
+#line 15097 ""
if (negseg) {
+#line 15097 ""
*noffseg = -(*noffseg);
+#line 15097 ""
}
+#line 15098 ""
}
+#line 15099 ""
} else if (korn == 7) {
/* Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" */
+#line 15103 ""
++comtrill_1.ntrill;
+#line 15104 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx;
+#line 15105 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip;
+#line 15106 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f;
+#line 15107 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15108 ""
if (*(unsigned char *)durq == 't') {
/* Convert to new internal symbol for non-'"tr" trill */
+#line 15112 ""
korn = 15;
+#line 15113 ""
iorni = bit_set(bit_clear(iorni,7),15);
+#line 15114 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15115 ""
}
+#line 15116 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
/* We have a number for the length */
+#line 15120 ""
readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[
comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1);
+#line 15121 ""
}
+#line 15122 ""
} else if (korn == 10 && *noxtup) {
/* Fermata */
+#line 15126 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15127 ""
if (*(unsigned char *)durq == 'd') {
+#line 15128 ""
korn = 14;
+#line 15129 ""
iorni = bit_set(bit_clear(iorni,10),14);
+#line 15130 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15131 ""
}
+#line 15132 ""
} else {
+#line 15133 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 15134 ""
}
+#line 15135 ""
if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) {
- s_wsle(&io___834);
+#line 15136 ""
+ s_wsle(&io___875);
+#line 15136 ""
do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", (
ftnlen)41);
+#line 15136 ""
do_lio(&c__9, &c__1, durq, (ftnlen)1);
+#line 15136 ""
e_wsle();
+#line 15137 ""
stop1_();
+#line 15138 ""
}
+#line 15139 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Shift ornament up or down */
+#line 15143 ""
++comtrill_1.nudorn;
/* Set bit 25 in iorni as a signal. This may not really be necessary. */
+#line 15147 ""
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 15152 ""
xofforn = (real) (44 - *(unsigned char *)durq);
+#line 15153 ""
++(*iccount);
+#line 15154 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 15155 ""
r__1 = xofforn * fnum;
+#line 15155 ""
iofforn = i_nint(&r__1);
+#line 15156 ""
comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (*
nole << 12) + (korn << 19) + (iofforn + 32 << 25);
+#line 15158 ""
comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx;
+#line 15159 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Horizontal shift */
+#line 15163 ""
comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set(
comtrill_1.kudorn[comtrill_1.nudorn - 1],31);
+#line 15164 ""
xofforn = (real) (44 - *(unsigned char *)durq);
+#line 15165 ""
++(*iccount);
+#line 15166 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
/* 141226 ornhshft(nudorn) = nint(xofforn*fnum) */
+#line 15168 ""
comtrill_1.ornhshft[comtrill_1.nudorn - 1] = xofforn * fnum;
+#line 15169 ""
}
+#line 15170 ""
} else if (*(unsigned char *)durq == ':') {
/* Turn on repeated ornaments */
+#line 15174 ""
*ornrpt = TRUE_;
/* Save the ornament value just set */
+#line 15178 ""
*iornq0 = iorni;
+#line 15179 ""
}
+#line 15180 ""
if (*notcrd) {
+#line 15181 ""
*iornq |= iorni;
+#line 15182 ""
} else {
+#line 15183 ""
comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni;
+#line 15184 ""
}
+#line 15185 ""
return 0;
} /* getorn_ */
@@ -21927,9 +35919,9 @@ L5:
static char lnholdq[128];
/* Fortran I/O blocks */
- static cilist io___840 = { 0, 6, 0, 0, 0 };
- static cilist io___841 = { 0, 15, 0, "()", 0 };
- static cilist io___845 = { 0, 18, 1, "(a)", 0 };
+ static cilist io___881 = { 0, 6, 0, 0, 0 };
+ static cilist io___882 = { 0, 15, 0, "()", 0 };
+ static cilist io___886 = { 0, 18, 1, "(a)", 0 };
@@ -21952,229 +35944,410 @@ L5:
/* ipbufmod = points to last character of most recent inserted line */
/* from pmx.mod */
+#line 15219 ""
c1omget_1.line1pmxmod = inbuff_1.ilbuf;
+#line 15220 ""
if (! (*global)) {
+#line 15221 ""
ioin__1.inerr = 0;
+#line 15221 ""
ioin__1.infilen = includeq_len;
+#line 15221 ""
ioin__1.infile = includeq;
+#line 15221 ""
ioin__1.inex = &fexist;
+#line 15221 ""
ioin__1.inopen = 0;
+#line 15221 ""
ioin__1.innum = 0;
+#line 15221 ""
ioin__1.innamed = 0;
+#line 15221 ""
ioin__1.inname = 0;
+#line 15221 ""
ioin__1.inacc = 0;
+#line 15221 ""
ioin__1.inseq = 0;
+#line 15221 ""
ioin__1.indir = 0;
+#line 15221 ""
ioin__1.infmt = 0;
+#line 15221 ""
ioin__1.inform = 0;
+#line 15221 ""
ioin__1.inunf = 0;
+#line 15221 ""
ioin__1.inrecl = 0;
+#line 15221 ""
ioin__1.innrec = 0;
+#line 15221 ""
ioin__1.inblank = 0;
+#line 15221 ""
f_inqu(&ioin__1);
/* Transfer includeq to temporary char variable with known length */
+#line 15225 ""
s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len);
+#line 15226 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
- s_wsle(&io___840);
+#line 15227 ""
+ s_wsle(&io___881);
+#line 15227 ""
e_wsle();
- s_wsfe(&io___841);
+#line 15228 ""
+ s_wsfe(&io___882);
+#line 15228 ""
e_wsfe();
+#line 15229 ""
if (! fexist) {
/* Writing concatenation */
+#line 15230 ""
i__1[0] = 15, a__1[0] = "Could not find ";
+#line 15230 ""
i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
+#line 15230 ""
i__1[2] = 19, a__1[2] = ", checking further.";
+#line 15230 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114);
+#line 15230 ""
printl_(ch__1, lpmxmoddirq + 34);
/* File named includeq doesn't not exist. Get directory from PMXMODDIR and */
/* see if it's there */
+#line 15236 ""
getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
+#line 15237 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
+#line 15238 ""
if (lpmxmoddirq > 0) {
/* Writing concatenation */
+#line 15239 ""
i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
+#line 15239 ""
i__2[1] = includeq_len, a__2[1] = includeq;
+#line 15239 ""
s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
+#line 15240 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
+#line 15241 ""
} else {
+#line 15242 ""
printl_("No other directory defined by PMXMODDIR, stopping", (
ftnlen)49);
+#line 15244 ""
stop1_();
+#line 15245 ""
}
+#line 15246 ""
ioin__1.inerr = 0;
+#line 15246 ""
ioin__1.infilen = 80;
+#line 15246 ""
ioin__1.infile = pmxmoddirq;
+#line 15246 ""
ioin__1.inex = &fexist;
+#line 15246 ""
ioin__1.inopen = 0;
+#line 15246 ""
ioin__1.innum = 0;
+#line 15246 ""
ioin__1.innamed = 0;
+#line 15246 ""
ioin__1.inname = 0;
+#line 15246 ""
ioin__1.inacc = 0;
+#line 15246 ""
ioin__1.inseq = 0;
+#line 15246 ""
ioin__1.indir = 0;
+#line 15246 ""
ioin__1.infmt = 0;
+#line 15246 ""
ioin__1.inform = 0;
+#line 15246 ""
ioin__1.inunf = 0;
+#line 15246 ""
ioin__1.inrecl = 0;
+#line 15246 ""
ioin__1.innrec = 0;
+#line 15246 ""
ioin__1.inblank = 0;
+#line 15246 ""
f_inqu(&ioin__1);
+#line 15247 ""
if (! fexist) {
/* Writing concatenation */
+#line 15248 ""
i__1[0] = 15, a__1[0] = "Could not find ";
+#line 15248 ""
i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
+#line 15248 ""
i__1[2] = 11, a__1[2] = ", stopping.";
+#line 15248 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106);
+#line 15248 ""
printl_(ch__2, lpmxmoddirq + 26);
+#line 15250 ""
stop1_();
+#line 15251 ""
}
+#line 15252 ""
}
/* Writing concatenation */
+#line 15253 ""
i__2[0] = 28, a__2[0] = "Opening normal include file ";
+#line 15253 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
+#line 15253 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
+#line 15253 ""
printl_(ch__3, lpmxmoddirq + 28);
+#line 15255 ""
o__1.oerr = 0;
+#line 15255 ""
o__1.ounit = 18;
+#line 15255 ""
o__1.ofnmlen = 80;
+#line 15255 ""
o__1.ofnm = pmxmoddirq;
+#line 15255 ""
o__1.orl = 0;
+#line 15255 ""
o__1.osta = 0;
+#line 15255 ""
o__1.oacc = 0;
+#line 15255 ""
o__1.ofm = 0;
+#line 15255 ""
o__1.oblnk = 0;
+#line 15255 ""
f_open(&o__1);
+#line 15256 ""
} else {
/* Check for existence of pmx.mod */
+#line 15260 ""
getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
+#line 15261 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
+#line 15262 ""
if (lpmxmoddirq == 0) {
+#line 15262 ""
return 0;
+#line 15262 ""
}
/* Writing concatenation */
+#line 15263 ""
i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
+#line 15263 ""
i__2[1] = 7, a__2[1] = "pmx.mod";
+#line 15263 ""
s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
+#line 15264 ""
lpmxmoddirq += 7;
+#line 15265 ""
ioin__1.inerr = 0;
+#line 15265 ""
ioin__1.infilen = 80;
+#line 15265 ""
ioin__1.infile = pmxmoddirq;
+#line 15265 ""
ioin__1.inex = &fexist;
+#line 15265 ""
ioin__1.inopen = 0;
+#line 15265 ""
ioin__1.innum = 0;
+#line 15265 ""
ioin__1.innamed = 0;
+#line 15265 ""
ioin__1.inname = 0;
+#line 15265 ""
ioin__1.inacc = 0;
+#line 15265 ""
ioin__1.inseq = 0;
+#line 15265 ""
ioin__1.indir = 0;
+#line 15265 ""
ioin__1.infmt = 0;
+#line 15265 ""
ioin__1.inform = 0;
+#line 15265 ""
ioin__1.inunf = 0;
+#line 15265 ""
ioin__1.inrecl = 0;
+#line 15265 ""
ioin__1.innrec = 0;
+#line 15265 ""
ioin__1.inblank = 0;
+#line 15265 ""
f_inqu(&ioin__1);
+#line 15266 ""
if (! fexist) {
+#line 15266 ""
return 0;
+#line 15266 ""
}
/* Writing concatenation */
+#line 15267 ""
i__2[0] = 28, a__2[0] = "Opening global include file ";
+#line 15267 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
+#line 15267 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
+#line 15267 ""
printl_(ch__3, lpmxmoddirq + 28);
+#line 15269 ""
o__1.oerr = 0;
+#line 15269 ""
o__1.ounit = 18;
+#line 15269 ""
o__1.ofnmlen = lpmxmoddirq;
+#line 15269 ""
o__1.ofnm = pmxmoddirq;
+#line 15269 ""
o__1.orl = 0;
+#line 15269 ""
o__1.osta = 0;
+#line 15269 ""
o__1.oacc = 0;
+#line 15269 ""
o__1.ofm = 0;
+#line 15269 ""
o__1.oblnk = 0;
+#line 15269 ""
f_open(&o__1);
+#line 15270 ""
}
+#line 15271 ""
printl_("Adding include data", (ftnlen)19);
/* Read lines in from pmx.mod one at a time */
+#line 15275 ""
ipbufmod = inbuff_1.ipbuf;
+#line 15276 ""
lenbufmod = c1omget_1.lenbuf0;
- for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 4000; ++ilbufmod) {
- i__3 = s_rsfe(&io___845);
+#line 15277 ""
+ for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 9600; ++ilbufmod) {
+#line 15278 ""
+ i__3 = s_rsfe(&io___886);
+#line 15278 ""
if (i__3 != 0) {
+#line 15278 ""
goto L3;
+#line 15278 ""
}
+#line 15278 ""
i__3 = do_fio(&c__1, lnholdq, (ftnlen)128);
+#line 15278 ""
if (i__3 != 0) {
+#line 15278 ""
goto L3;
+#line 15278 ""
}
+#line 15278 ""
i__3 = e_rsfe();
+#line 15278 ""
if (i__3 != 0) {
+#line 15278 ""
goto L3;
+#line 15278 ""
}
/* A line was read. Slide all existing lengths from here forward ahead by 1 */
+#line 15282 ""
i__3 = ilbufmod;
+#line 15282 ""
for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) {
+#line 15283 ""
inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1];
+#line 15284 ""
/* L2: */
+#line 15284 ""
}
/* Get length of line from include file */
+#line 15288 ""
lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128);
+#line 15289 ""
if (lenmodline == 0) {
/* Blank line. Make it a single blank with length 1 */
+#line 15293 ""
lenmodline = 1;
+#line 15294 ""
s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
+#line 15295 ""
}
+#line 15296 ""
inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline;
+#line 15297 ""
printl_(lnholdq, lenmodline);
/* Insert new stuff into bufq */
+#line 15301 ""
i__3 = ipbufmod;
/* Writing concatenation */
+#line 15301 ""
i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq;
+#line 15301 ""
i__1[1] = lenmodline, a__1[1] = lnholdq;
+#line 15301 ""
i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3;
- s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)65536);
+#line 15301 ""
+ s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)131072);
/* Update internal parameters */
+#line 15306 ""
ipbufmod += inbuff_1.lbuf[ilbufmod - 1];
+#line 15307 ""
lenbufmod += inbuff_1.lbuf[ilbufmod - 1];
+#line 15308 ""
++inbuff_1.nlbuf;
+#line 15309 ""
/* L1: */
+#line 15309 ""
}
+#line 15310 ""
L3:
/* Writing concatenation */
+#line 15311 ""
i__2[0] = 8, a__2[0] = "Closing ";
+#line 15311 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
+#line 15311 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88);
+#line 15311 ""
printl_(ch__4, lpmxmoddirq + 8);
+#line 15312 ""
cl__1.cerr = 0;
+#line 15312 ""
cl__1.cunit = 18;
+#line 15312 ""
cl__1.csta = 0;
+#line 15312 ""
f_clos(&cl__1);
+#line 15313 ""
c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod -
inbuff_1.ilbuf;
+#line 15314 ""
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 15319 ""
c1omget_1.nline += -2;
+#line 15321 ""
return 0;
} /* getpmxmod_ */
@@ -22207,86 +36380,145 @@ L3:
static integer iccount, nvsofar;
/* Fortran I/O blocks */
- static cilist io___851 = { 0, 17, 0, "(a)", 0 };
- static cilist io___861 = { 0, 6, 0, 0, 0 };
+ static cilist io___892 = { 0, 17, 0, "(a)", 0 };
+ static cilist io___902 = { 0, 6, 0, 0, 0 };
/* Get the first line */
+#line 15337 ""
/* Parameter adjustments */
+#line 15337 ""
--sepsymq;
+#line 15337 ""
--clefq;
+#line 15337 ""
inameq -= 79;
+#line 15337 ""
+#line 15337 ""
/* Function Body */
+#line 15337 ""
iccount = 0;
+#line 15338 ""
L9:
+#line 15338 ""
getbuf_(lineq, (ftnlen)128);
+#line 15339 ""
if (*(unsigned char *)lineq == '%') {
+#line 15339 ""
goto L9;
+#line 15339 ""
}
+#line 15340 ""
*istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0;
+#line 15341 ""
if (*istype0) {
/* Have TeX input until next line that starts with '---'. Save in scratch. */
+#line 15345 ""
o__1.oerr = 0;
+#line 15345 ""
o__1.ounit = 17;
+#line 15345 ""
o__1.ofnm = 0;
+#line 15345 ""
o__1.orl = 0;
+#line 15345 ""
o__1.osta = "SCRATCH";
+#line 15345 ""
o__1.oacc = 0;
+#line 15345 ""
o__1.ofm = 0;
+#line 15345 ""
o__1.oblnk = 0;
+#line 15345 ""
f_open(&o__1);
+#line 15346 ""
L3:
+#line 15346 ""
getbuf_(lineq, (ftnlen)128);
+#line 15347 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
- s_wsfe(&io___851);
+#line 15348 ""
+ s_wsfe(&io___892);
+#line 15348 ""
do_fio(&c__1, lineq, (ftnlen)128);
+#line 15348 ""
e_wsfe();
+#line 15349 ""
goto L3;
+#line 15350 ""
}
/* Force a new line read on first call to readin */
+#line 15354 ""
iccount = 128;
+#line 15355 ""
}
/* Here, lineq is first line w/ numerical setup data. */
+#line 15359 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15359 ""
*nv = i_nint(&r__1);
+#line 15360 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15360 ""
*noinst = i_nint(&r__1);
+#line 15361 ""
newway = *noinst <= 0;
+#line 15362 ""
if (newway) {
+#line 15362 ""
*noinst = -(*noinst);
+#line 15362 ""
}
+#line 15363 ""
i__1 = *noinst;
+#line 15363 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* Seve # of staves per inst in case later drop some inst's. */
+#line 15367 ""
if (newway) {
/* Read in nvi for each instrument */
+#line 15371 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15371 ""
comnvi_1.nsperi[iinst - 1] = i_nint(&r__1);
+#line 15372 ""
} else if (iinst > 1) {
+#line 15373 ""
comnvi_1.nsperi[iinst - 1] = 1;
+#line 15374 ""
} else {
+#line 15375 ""
comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1;
+#line 15376 ""
}
+#line 15377 ""
comnvi_1.iiorig[iinst - 1] = iinst;
+#line 15378 ""
comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1];
+#line 15379 ""
/* L2: */
+#line 15379 ""
}
+#line 15380 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15380 ""
*mtrnuml = i_nint(&r__1);
+#line 15381 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15381 ""
*mtrdenl = i_nint(&r__1);
/* c */
/* c Kluge to make mtrdenl work */
@@ -22295,90 +36527,154 @@ L3:
/* mtrdenl = 2 */
/* mtrnuml = mtrnuml*2 */
/* end if */
+#line 15389 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15389 ""
*mtrnmp = i_nint(&r__1);
+#line 15390 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15390 ""
*mtrdnp = i_nint(&r__1);
+#line 15391 ""
*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 15397 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15397 ""
*isig0 = i_nint(&r__1);
/* 130316 */
/* do 11 iinst = 1 , noinst */
/* midisig(iinst) = isig0 */
+#line 15401 ""
commidisig_1.midisig = *isig0;
/* 11 continue */
+#line 15403 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15403 ""
*npages = i_nint(&r__1);
+#line 15404 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15404 ""
*nsyst = i_nint(&r__1);
+#line 15405 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
+#line 15405 ""
*musicsize = i_nint(&r__1);
+#line 15406 ""
*fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128);
/* Next noinst non-comment lines are names of instruments. */
+#line 15410 ""
i__1 = *noinst;
+#line 15410 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 15411 ""
L5:
+#line 15411 ""
getbuf_(inameq + i__ * 79, (ftnlen)79);
+#line 15412 ""
if (*(unsigned char *)&inameq[i__ * 79] == '%') {
+#line 15412 ""
goto L5;
+#line 15412 ""
}
+#line 15413 ""
/* L4: */
+#line 15413 ""
}
/* Next non-comment line has nv clef names */
+#line 15417 ""
L6:
+#line 15417 ""
getbuf_(lineq, (ftnlen)128);
+#line 15418 ""
if (*(unsigned char *)lineq == '%') {
+#line 15418 ""
goto L6;
+#line 15418 ""
}
+#line 15419 ""
iv = 0;
+#line 15420 ""
nvsofar = 0;
+#line 15421 ""
i__1 = *noinst;
+#line 15421 ""
for (jinst = 1; jinst <= i__1; ++jinst) {
+#line 15422 ""
nvsofar += comnvi_1.nsperi[jinst - 1];
+#line 15423 ""
i__2 = comnvi_1.nsperi[jinst - 1];
+#line 15423 ""
for (ivi = 1; ivi <= i__2; ++ivi) {
+#line 15424 ""
++iv;
+#line 15425 ""
*(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1];
+#line 15426 ""
if (iv == nvsofar) {
+#line 15427 ""
*(unsigned char *)&sepsymq[iv] = '&';
+#line 15428 ""
} else {
+#line 15429 ""
*(unsigned char *)&sepsymq[iv] = '|';
+#line 15430 ""
}
+#line 15431 ""
/* L10: */
+#line 15431 ""
}
+#line 15432 ""
/* L1: */
+#line 15432 ""
}
/* Mext non-comment line has path name */
+#line 15436 ""
L8:
+#line 15436 ""
getbuf_(pathnameq, (ftnlen)40);
+#line 15437 ""
if (*(unsigned char *)pathnameq == '%') {
+#line 15437 ""
goto L8;
+#line 15437 ""
}
+#line 15438 ""
*lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1;
/* 160130 Replace '\' by '/' */
+#line 15442 ""
L12:
+#line 15442 ""
ipos = i_indx(pathnameq, "\\", (ftnlen)40, (ftnlen)1);
+#line 15443 ""
if (ipos > 0) {
+#line 15444 ""
*(unsigned char *)&pathnameq[ipos - 1] = '/';
- s_wsle(&io___861);
+#line 15445 ""
+ s_wsle(&io___902);
+#line 15445 ""
do_lio(&c__9, &c__1, "Changed pathname to ", (ftnlen)20);
+#line 15445 ""
do_lio(&c__9, &c__1, pathnameq, (*lpath));
+#line 15445 ""
e_wsle();
+#line 15446 ""
goto L12;
+#line 15447 ""
}
+#line 15448 ""
return 0;
} /* getset_ */
@@ -22402,34 +36698,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 15462 ""
/* Parameter adjustments */
+#line 15462 ""
--to;
+#line 15462 ""
--tnote;
+#line 15462 ""
+#line 15462 ""
/* Function Body */
+#line 15462 ""
tgovern = 1e3f;
+#line 15463 ""
tend = to[*n] + *space;
+#line 15464 ""
i__1 = *ntot;
+#line 15464 ""
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 15469 ""
if (to[in] > to[*n] + comtol_1.tol) {
+#line 15469 ""
goto L2;
+#line 15469 ""
}
+#line 15470 ""
if (to[in] + tnote[in] > tend - comtol_1.tol) {
/* If here, this note overlaps and must be tested. */
/* Computing MIN */
+#line 15474 ""
r__1 = tgovern, r__2 = tnote[in];
+#line 15474 ""
tgovern = dmin(r__1,r__2);
+#line 15475 ""
}
+#line 15476 ""
/* L1: */
+#line 15476 ""
}
+#line 15477 ""
L2:
+#line 15478 ""
ret_val = *space / tgovern;
+#line 15479 ""
return ret_val;
} /* getsquez_ */
@@ -22460,84 +36777,140 @@ L2:
/* during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if */
/* not in xtup. */
+#line 15495 ""
colon = FALSE_;
+#line 15496 ""
ess = FALSE_;
+#line 15497 ""
number = FALSE_;
+#line 15498 ""
nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount -
1), (ftnlen)1) - 1;
+#line 15499 ""
if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen)
1) > 0) {
/* "Parts only", ignore entire symbol */
+#line 15503 ""
*iccount = nextbl;
+#line 15504 ""
return 0;
+#line 15505 ""
}
+#line 15506 ""
L1:
+#line 15506 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 15507 ""
if (*(unsigned char *)charq == 'B') {
/* "Both parts and score," ignore character */
+#line 15511 ""
goto L1;
+#line 15512 ""
} else if (*(unsigned char *)charq == ':') {
+#line 15513 ""
colon = TRUE_;
+#line 15514 ""
goto L1;
+#line 15515 ""
} else if (*(unsigned char *)charq == 'S') {
+#line 15516 ""
ess = TRUE_;
+#line 15517 ""
goto L1;
+#line 15518 ""
} else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
+#line 15519 ""
number = TRUE_;
+#line 15520 ""
if (*(unsigned char *)charq == '-') {
+#line 15520 ""
++(*iccount);
+#line 15520 ""
}
+#line 15521 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 15522 ""
if (*(unsigned char *)charq == '-') {
+#line 15522 ""
fnum = -fnum;
+#line 15522 ""
}
+#line 15523 ""
if (*(unsigned char *)durq != 'p') {
+#line 15524 ""
fnum *= *wheadpt;
+#line 15525 ""
--(*iccount);
+#line 15526 ""
}
+#line 15527 ""
goto L1;
+#line 15528 ""
}
/* charq must be blank, so done parsing */
+#line 15532 ""
if (! ess && ! colon) {
/* Ordinary hardspace. Goes before next note. */
/* (Later, at "|" or "/", check for presence and switch to udoff if there!) */
+#line 15537 ""
++comudsp_1.nudsp;
+#line 15538 ""
*iornq1 = bit_set(*iornq1,26);
+#line 15539 ""
comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum;
+#line 15540 ""
comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar);
+#line 15541 ""
if (*ntup > 0) {
+#line 15541 ""
comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + *
ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1);
+#line 15541 ""
}
/* * +float(itup-1)/ntup*ifnodur(nnodur,dotq) */
+#line 15544 ""
} else if (! number) {
/* Must be "X:" End a group offset. */
+#line 15548 ""
*irest = bit_set(*irest,17);
+#line 15549 ""
*shifton = FALSE_;
+#line 15550 ""
return 0;
+#line 15551 ""
} else {
/* Only other possibility is start offset, "S" for single, ':' for multiple */
+#line 15555 ""
++comudsp_1.nudoff[*ivx - 1];
+#line 15556 ""
comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum;
+#line 15557 ""
if (ess) {
+#line 15558 ""
*irest1 = bit_set(*irest1,15);
+#line 15559 ""
} else {
+#line 15560 ""
*irest1 = bit_set(*irest1,16);
+#line 15561 ""
*shifton = TRUE_;
+#line 15562 ""
}
+#line 15563 ""
}
+#line 15564 ""
return 0;
} /* getx_ */
@@ -22554,44 +36927,75 @@ integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len)
extern /* Subroutine */ int stop1_(void);
/* Fortran I/O blocks */
- static cilist io___872 = { 0, 6, 0, 0, 0 };
- static cilist io___873 = { 0, 6, 0, 0, 0 };
+ static cilist io___913 = { 0, 6, 0, 0, 0 };
+ static cilist io___914 = { 0, 6, 0, 0, 0 };
+#line 15568 ""
if (*idur == 6) {
+#line 15569 ""
ret_val = 1;
+#line 15570 ""
} else if (*idur == 3) {
+#line 15571 ""
ret_val = 2;
+#line 15572 ""
} else if (*idur == 1) {
+#line 15573 ""
ret_val = 4;
+#line 15574 ""
} else if (*idur == 8) {
+#line 15575 ""
ret_val = 8;
+#line 15576 ""
} else if (*idur == 4) {
+#line 15577 ""
ret_val = 16;
+#line 15578 ""
} else if (*idur == 2) {
+#line 15579 ""
ret_val = 32;
+#line 15580 ""
} else if (*idur == 0) {
+#line 15581 ""
ret_val = 64;
+#line 15582 ""
} else if (*idur == 16) {
/* Only used for denominator of time signatures, not for notes */
+#line 15586 ""
ret_val = 4;
+#line 15587 ""
} else if (*idur == 9) {
+#line 15588 ""
ret_val = 128;
+#line 15589 ""
} else {
- s_wsle(&io___872);
+#line 15590 ""
+ s_wsle(&io___913);
+#line 15590 ""
e_wsle();
- s_wsle(&io___873);
+#line 15591 ""
+ s_wsle(&io___914);
+#line 15591 ""
do_lio(&c__9, &c__1, "You entered an invalid note-length value:", (
ftnlen)41);
+#line 15591 ""
do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer));
+#line 15591 ""
e_wsle();
+#line 15592 ""
stop1_();
+#line 15593 ""
}
+#line 15594 ""
if (*(unsigned char *)dotq == 'd') {
+#line 15594 ""
ret_val = ret_val * 3 / 2;
+#line 15594 ""
}
+#line 15595 ""
return ret_val;
} /* i1fnodur_ */
@@ -22609,7 +37013,9 @@ integer iashft_(integer *nacc)
/* System generated locals */
integer ret_val;
+#line 15605 ""
ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4];
+#line 15606 ""
return ret_val;
} /* iashft_ */
@@ -22624,39 +37030,67 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
/* Subroutine */ int s_stop(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___875 = { 0, 6, 0, 0, 0 };
+ static cilist io___916 = { 0, 6, 0, 0, 0 };
+#line 15610 ""
if (*idur == 6) {
+#line 15611 ""
ret_val = 1;
+#line 15612 ""
} else if (*idur == 3) {
+#line 15613 ""
ret_val = 2;
+#line 15614 ""
} else if (*idur == 1) {
+#line 15615 ""
ret_val = 4;
+#line 15616 ""
} else if (*idur == 8) {
+#line 15617 ""
ret_val = 8;
+#line 15618 ""
} else if (*idur == 4) {
+#line 15619 ""
ret_val = 16;
+#line 15620 ""
} else if (*idur == 2) {
+#line 15621 ""
ret_val = 32;
+#line 15622 ""
} else if (*idur == 0) {
+#line 15623 ""
ret_val = 64;
+#line 15624 ""
} else if (*idur == 9) {
+#line 15625 ""
ret_val = 128;
+#line 15626 ""
} else if (*idur == 16) {
/* Only used for denominator of time signatures, not for notes */
+#line 15630 ""
ret_val = 4;
+#line 15631 ""
} else {
- s_wsle(&io___875);
+#line 15632 ""
+ s_wsle(&io___916);
+#line 15632 ""
do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33);
+#line 15632 ""
e_wsle();
+#line 15633 ""
s_stop("", (ftnlen)0);
+#line 15634 ""
}
+#line 15635 ""
if (*(unsigned char *)dotq == 'd') {
+#line 15635 ""
ret_val = ret_val * 3 / 2;
+#line 15635 ""
}
+#line 15636 ""
return ret_val;
} /* ifnodur_ */
@@ -22665,7 +37099,9 @@ integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len)
/* System generated locals */
integer ret_val;
+#line 15641 ""
ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans;
+#line 15642 ""
return ret_val;
} /* ifnolev_ */
@@ -22709,7 +37145,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 15677 ""
ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift));
+#line 15678 ""
return ret_val;
} /* igetbits_ */
@@ -22727,31 +37165,48 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer *
extern /* Subroutine */ int stop1_(void);
/* Fortran I/O blocks */
- static cilist io___876 = { 0, 6, 0, 0, 0 };
+ static cilist io___917 = { 0, 6, 0, 0, 0 };
/* Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */
+#line 15686 ""
/* Parameter adjustments */
+#line 15686 ""
mmidi -= 25;
+#line 15686 ""
+#line 15686 ""
/* Function Body */
+#line 15686 ""
ret_val = 0;
+#line 15687 ""
for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
+#line 15688 ""
ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) *
25]);
/* * +iand(127,longi(mmidi(icm,imidi+nbytes))) */
+#line 15691 ""
if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) {
+#line 15691 ""
return ret_val;
+#line 15691 ""
}
/* if (.not.btest(longi(mmidi(icm,imidi+nbytes)),7)) return */
+#line 15693 ""
/* L1: */
+#line 15693 ""
}
- s_wsle(&io___876);
+#line 15694 ""
+ s_wsle(&io___917);
+#line 15694 ""
do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20);
+#line 15694 ""
e_wsle();
+#line 15695 ""
stop1_();
+#line 15696 ""
return ret_val;
} /* igetvarlen_ */
@@ -22768,25 +37223,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 15705 ""
/* Parameter adjustments */
+#line 15705 ""
nodur -= 25;
+#line 15705 ""
+#line 15705 ""
/* Function Body */
+#line 15705 ""
if (nodur[*ivx + *ip * 24] == 0) {
+#line 15706 ""
ret_val = FALSE_;
+#line 15707 ""
return ret_val;
+#line 15708 ""
} else if (*ip > 1) {
+#line 15709 ""
if (nodur[*ivx + (*ip - 1) * 24] == 0) {
+#line 15710 ""
ret_val = FALSE_;
+#line 15711 ""
return ret_val;
+#line 15712 ""
}
+#line 15713 ""
}
/* Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */
+#line 15717 ""
r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol *
.5f;
- ret_val = r_mod(&r__1, &c_b819) > comtol_1.tol;
+#line 15717 ""
+ ret_val = r_mod(&r__1, &c_b1054) > comtol_1.tol;
+#line 15719 ""
return ret_val;
} /* isdotted_ */
@@ -22805,27 +37276,46 @@ integer isetvarlen_(integer *idur, integer *nbytes)
static integer itemp;
/* Fortran I/O blocks */
- static cilist io___878 = { 0, 6, 0, 0, 0 };
+ static cilist io___919 = { 0, 6, 0, 0, 0 };
+#line 15722 ""
ret_val = 0;
+#line 15723 ""
itemp = *idur;
+#line 15724 ""
for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
+#line 15725 ""
i__1 = *nbytes - 1;
+#line 15725 ""
ret_val += (itemp & 127) * pow_ii(&c__256, &i__1);
+#line 15726 ""
itemp = lbit_shift(itemp, (ftnlen)-7);
+#line 15727 ""
if (itemp > 0) {
+#line 15728 ""
i__1 = (*nbytes << 3) + 7;
+#line 15728 ""
ret_val += pow_ii(&c__2, &i__1);
+#line 15729 ""
} else {
+#line 15730 ""
return ret_val;
+#line 15731 ""
}
+#line 15732 ""
/* L1: */
+#line 15732 ""
}
- s_wsle(&io___878);
+#line 15733 ""
+ s_wsle(&io___919);
+#line 15733 ""
do_lio(&c__9, &c__1, "Problem in function isetvarlen", (ftnlen)30);
+#line 15733 ""
e_wsle();
+#line 15734 ""
stop1_();
+#line 15735 ""
return ret_val;
} /* isetvarlen_ */
@@ -22850,41 +37340,75 @@ integer isetvarlen_(integer *idur, integer *nbytes)
/* Returns string with integer only if length is 1, otherwise enclosed in */
/* brackets. */
+#line 15742 ""
if (*i__ != 0) {
+#line 15743 ""
r__1 = abs(*i__) * 1.0001f;
+#line 15743 ""
*len = r_lg10(&r__1) + 1;
+#line 15744 ""
if (*i__ < 0) {
+#line 15744 ""
++(*len);
+#line 15744 ""
}
+#line 15745 ""
} else {
+#line 15746 ""
s_copy(string, "0", string_len, (ftnlen)1);
+#line 15747 ""
*len = 1;
+#line 15748 ""
return 0;
+#line 15749 ""
}
+#line 15750 ""
if (*len == 1) {
+#line 15751 ""
*(unsigned char *)&ch__1[0] = *i__ + 48;
+#line 15751 ""
s_copy(string, ch__1, string_len, (ftnlen)1);
+#line 15752 ""
} else {
+#line 15753 ""
s_copy(string, "{", string_len, (ftnlen)1);
+#line 15754 ""
ici__1.icierr = 0;
+#line 15754 ""
ici__1.icirnum = 1;
+#line 15754 ""
ici__1.icirlen = *len;
+#line 15754 ""
ici__1.iciunit = string + 1;
/* Writing concatenation */
+#line 15754 ""
i__1[0] = 2, a__1[0] = "(i";
+#line 15754 ""
*(unsigned char *)&ch__1[0] = *len + 48;
+#line 15754 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 15754 ""
i__1[2] = 1, a__1[2] = ")";
+#line 15754 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2);
+#line 15754 ""
s_wsfi(&ici__1);
+#line 15754 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
+#line 15754 ""
e_wsfi();
/* Writing concatenation */
+#line 15755 ""
i__2[0] = *len + 1, a__2[0] = string;
+#line 15755 ""
i__2[1] = 1, a__2[1] = "}";
+#line 15755 ""
s_cat(string, a__2, i__2, &c__2, string_len);
+#line 15756 ""
*len += 2;
+#line 15757 ""
}
+#line 15758 ""
return 0;
} /* istring_ */
@@ -22893,13 +37417,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
/* System generated locals */
integer ret_val;
+#line 15762 ""
for (ret_val = *n; ret_val >= 1; --ret_val) {
+#line 15763 ""
if (*(unsigned char *)&string[ret_val - 1] != ' ') {
+#line 15763 ""
return ret_val;
+#line 15763 ""
}
+#line 15764 ""
/* L1: */
+#line 15764 ""
}
+#line 15765 ""
ret_val = 0;
+#line 15766 ""
return ret_val;
} /* lenstr_ */
@@ -22916,28 +37448,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 15774 ""
if (! bit_test(*irest,0)) {
+#line 15775 ""
ret_val = *nolev;
+#line 15776 ""
} else {
/* Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. */
+#line 15780 ""
if (*mult > 0) {
+#line 15781 ""
if (*mult == 2) {
+#line 15782 ""
ioff = (*iud << 1) - 1;
+#line 15783 ""
} else if (*mult != 4) {
+#line 15784 ""
ioff = *iud * *mult;
+#line 15785 ""
} else {
+#line 15786 ""
ioff = (*iud << 2) + 1;
+#line 15787 ""
}
+#line 15788 ""
} else {
/* May need to futz with this later for non-beamed xtups (quarter, half rests) */
+#line 15792 ""
ioff = *iud << 1;
+#line 15793 ""
}
+#line 15794 ""
ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff;
+#line 15795 ""
}
+#line 15796 ""
return ret_val;
} /* levrn_ */
@@ -22957,17 +37506,29 @@ integer lfmt1_(real *x)
/* Computes total length of an "f" format with one decimal place. */
/* First round to nearest 0.1 */
+#line 15803 ""
if (dabs(*x) < .001f) {
+#line 15804 ""
ret_val = 2;
+#line 15805 ""
} else {
+#line 15806 ""
r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f;
+#line 15806 ""
y = r_sign(&r__1, x);
+#line 15807 ""
r__1 = dabs(y) * 1000 + .001f;
+#line 15807 ""
ret_val = (integer) r_lg10(&r__1);
+#line 15808 ""
if (y < 0.f) {
+#line 15808 ""
++ret_val;
+#line 15808 ""
}
+#line 15809 ""
}
+#line 15810 ""
return ret_val;
} /* lfmt1_ */
@@ -23004,7 +37565,7 @@ integer lfmt1_(real *x)
static char notexq[128];
/* Fortran I/O blocks */
- static cilist io___900 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___941 = { 0, 11, 0, "(a)", 0 };
@@ -23019,172 +37580,300 @@ integer lfmt1_(real *x)
/* closing of full tie are not used except for shape alterations. */
/* do 1 ndx = 0 , 11 */
+#line 15835 ""
/* Parameter adjustments */
+#line 15835 ""
--sepsymq;
+#line 15835 ""
--isdat4;
+#line 15835 ""
--isdat3;
+#line 15835 ""
--isdat2;
+#line 15835 ""
--isdat1;
+#line 15835 ""
+#line 15835 ""
/* Function Body */
+#line 15835 ""
for (ndx = 0; ndx <= 23; ++ndx) {
+#line 15836 ""
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 15840 ""
i__1 = *nsdat;
+#line 15840 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
/* if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */
+#line 15842 ""
if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(&
isdat1[isdat], &c__1, &c__18) << 4) != ndx) {
+#line 15842 ""
goto L2;
+#line 15842 ""
}
/* Wron */
+#line 15844 ""
if (! bit_test(isdat1[isdat],11)) {
+#line 15844 ""
goto L2;
+#line 15844 ""
}
/* Bypass if stop */
+#line 15845 ""
if (bit_test(isdat2[isdat],3)) {
+#line 15845 ""
goto L3;
+#line 15845 ""
}
/* "st" */
+#line 15846 ""
idcode = igetbits_(&isdat1[isdat], &c__7, &c__19);
+#line 15847 ""
if (idcode == 1) {
+#line 15847 ""
goto L3;
+#line 15847 ""
}
/* "t" */
+#line 15848 ""
tie = FALSE_;
+#line 15849 ""
goto L5;
+#line 15850 ""
L2:
+#line 15850 ""
;
+#line 15850 ""
}
+#line 15851 ""
}
+#line 15852 ""
goto L1;
+#line 15853 ""
L3:
+#line 15854 ""
tie = TRUE_;
+#line 15855 ""
L5:
/* A slur or tie is open, with index ndx */
+#line 15859 ""
iv = igetbits_(&isdat1[isdat], &c__5, &c__13);
+#line 15860 ""
kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1;
+#line 15861 ""
*(unsigned char *)udq = 'd';
+#line 15862 ""
if (bit_test(isdat1[isdat],27)) {
+#line 15862 ""
*(unsigned char *)udq = 'u';
+#line 15862 ""
}
/* Writing concatenation */
+#line 15863 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15863 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 15863 ""
i__2[1] = 6, a__1[1] = "znotes";
+#line 15863 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15864 ""
lnote = 7;
+#line 15865 ""
i__1 = iv - 1;
+#line 15865 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
/* Writing concatenation */
+#line 15866 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15866 ""
i__2[1] = 1, a__1[1] = sepsymq + iiv;
+#line 15866 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15867 ""
++lnote;
+#line 15868 ""
/* L4: */
+#line 15868 ""
}
+#line 15869 ""
if (kv == 2) {
/* Writing concatenation */
+#line 15870 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 15870 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15870 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 15870 ""
i__3[2] = 9, a__2[2] = "nextvoice";
+#line 15870 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 15871 ""
lnote += 10;
+#line 15872 ""
}
/* Compute horiz and vert offsets */
/* nolev = igetbits(isdat2(isdat),7,19) */
+#line 15877 ""
islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14);
+#line 15878 ""
ilb12 = 0;
+#line 15879 ""
if (*ispstie) {
+#line 15879 ""
ilb12 = 1;
+#line 15879 ""
}
+#line 15880 ""
i__1 = ilb12 << 4;
+#line 15880 ""
ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32;
+#line 15881 ""
if (ivoff == -32) {
+#line 15881 ""
ivoff = 0;
+#line 15881 ""
}
/* nolev = nolev+ivoff */
+#line 15883 ""
islhgt += ivoff;
+#line 15884 ""
i__1 = (ilb12 << 4) + 6;
+#line 15884 ""
ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64;
/* This is 10X */
+#line 15885 ""
if (ihoff == -64) {
+#line 15885 ""
ihoff = 0;
+#line 15885 ""
}
/* Add starting stuff for command */
+#line 15889 ""
if (! (*ispstie)) {
/* End 1st segment */
/* Writing concatenation */
+#line 15890 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 15890 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15890 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 15890 ""
i__3[2] = 8, a__2[2] = "roffset{";
+#line 15890 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 15891 ""
lnote += 9;
/* hoff = ihoff*.1-.5 */
/* hoff = ihoff*.1-.8 */
+#line 15894 ""
hoff = ihoff * .1f - .4f;
+#line 15895 ""
if (hoff < 0.f) {
+#line 15896 ""
hoff = -hoff;
/* Writing concatenation */
+#line 15897 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15897 ""
i__2[1] = 1, a__1[1] = "-";
+#line 15897 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15898 ""
++lnote;
+#line 15899 ""
}
+#line 15900 ""
writflot_(&hoff, notexq, &lnote, (ftnlen)128);
/* Writing concatenation */
+#line 15901 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15901 ""
i__2[1] = 2, a__1[1] = "}{";
+#line 15901 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15902 ""
lnote += 2;
+#line 15903 ""
} else {
/* Writing concatenation */
+#line 15904 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 15904 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15904 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 15904 ""
i__4[2] = 5, a__3[2] = "off{-";
+#line 15904 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 15904 ""
i__4[3] = 1, a__3[3] = ch__2;
+#line 15904 ""
i__4[4] = 14, a__3[4] = "afterruleskip}";
+#line 15904 ""
s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
+#line 15906 ""
lnote += 21;
/* 091025 add dotting for 2nd segment if needed */
+#line 15910 ""
if (bit_test(isdat2[isdat],4)) {
/* Writing concatenation */
+#line 15911 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15911 ""
i__3[0] = 1, a__2[0] = ch__1;
+#line 15911 ""
i__3[1] = 6, a__2[1] = "dotted";
+#line 15911 ""
i__3[2] = lnote, a__2[2] = notexq;
+#line 15911 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 15912 ""
lnote += 7;
+#line 15913 ""
}
+#line 15914 ""
}
+#line 15915 ""
if (*ispstie && tie) {
/* Writing concatenation */
+#line 15916 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15916 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15916 ""
i__5[1] = 1, a__4[1] = ch__1;
+#line 15916 ""
i__5[2] = 8, a__4[2] = "tieforis";
+#line 15916 ""
i__5[3] = 1, a__4[3] = udq;
+#line 15916 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15917 ""
lnote += 10;
+#line 15918 ""
}
+#line 15919 ""
if (bit_test(isdat3[isdat],0)) {
/* Curvature tweak on termination of 1st seg */
+#line 15923 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
/* Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: */
@@ -23195,48 +37884,82 @@ L5:
/* 6 HH */
/* Writing concatenation */
+#line 15932 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15932 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15932 ""
i__5[1] = 1, a__4[1] = ch__1;
+#line 15932 ""
i__5[2] = 7, a__4[2] = "psforts";
+#line 15932 ""
i__1 = imid + 48;
+#line 15932 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 15932 ""
i__5[3] = 1, a__4[3] = ch__2;
+#line 15932 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15933 ""
lnote += 9;
/* Zero out the flag in case there's a different curv on term of 2nd, */
+#line 15937 ""
isdat3[isdat] = bit_clear(isdat3[isdat],0);
+#line 15938 ""
}
/* Add the command name */
+#line 15942 ""
if (*ispstie) {
/* Writing concatenation */
+#line 15943 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15943 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15943 ""
i__5[1] = 1, a__4[1] = ch__1;
+#line 15943 ""
i__5[2] = 2, a__4[2] = "is";
+#line 15943 ""
i__5[3] = 1, a__4[3] = udq;
+#line 15943 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15944 ""
lnote += 4;
+#line 15945 ""
} else if (tie) {
/* Writing concatenation */
+#line 15946 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 15946 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15946 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 15946 ""
i__3[2] = 4, a__2[2] = "ttie";
+#line 15946 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 15947 ""
lnote += 5;
+#line 15948 ""
} else {
/* Writing concatenation */
+#line 15949 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 15949 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 15949 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 15949 ""
i__3[2] = 5, a__2[2] = "tslur";
+#line 15949 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 15950 ""
lnote += 6;
+#line 15951 ""
}
/* Add index */
@@ -23248,120 +37971,214 @@ L5:
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */
/* lnote = lnote+4 */
/* end if */
+#line 15962 ""
if (23 - ndx < 10) {
/* Writing concatenation */
+#line 15963 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15963 ""
i__1 = 71 - ndx;
+#line 15963 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 15963 ""
i__2[1] = 1, a__1[1] = ch__1;
+#line 15963 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15964 ""
++lnote;
+#line 15965 ""
} else if (23 - ndx < 20) {
/* Writing concatenation */
+#line 15966 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15966 ""
i__5[1] = 2, a__4[1] = "{1";
+#line 15966 ""
i__1 = 61 - ndx;
+#line 15966 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 15966 ""
i__5[2] = 1, a__4[2] = ch__1;
+#line 15966 ""
i__5[3] = 1, a__4[3] = "}";
+#line 15966 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15967 ""
lnote += 4;
+#line 15968 ""
} else {
/* Writing concatenation */
+#line 15969 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15969 ""
i__5[1] = 2, a__4[1] = "{2";
+#line 15969 ""
i__1 = 51 - ndx;
+#line 15969 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 15969 ""
i__5[2] = 1, a__4[2] = ch__1;
+#line 15969 ""
i__5[3] = 1, a__4[3] = "}";
+#line 15969 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15970 ""
lnote += 4;
+#line 15971 ""
}
+#line 15972 ""
if (*ispstie || ! tie) {
/* Add note name for slur height */
+#line 15976 ""
comoct_1.noctup = 0;
+#line 15977 ""
ncm = igetbits_(&isdat3[isdat], &c__8, &c__22);
+#line 15978 ""
if (ncm == 23) {
+#line 15978 ""
comoct_1.noctup = -2;
+#line 15978 ""
}
/* call notefq(noteq,lnoten,nolev,ncm) */
+#line 15980 ""
notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8);
/* Writing concatenation */
+#line 15981 ""
i__5[0] = lnote, a__4[0] = notexq;
+#line 15981 ""
i__5[1] = 1, a__4[1] = "{";
+#line 15981 ""
i__5[2] = lnoten, a__4[2] = noteq;
+#line 15981 ""
i__5[3] = 1, a__4[3] = "}";
+#line 15981 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
+#line 15982 ""
lnote = lnote + 1 + lnoten + 1;
+#line 15983 ""
}
+#line 15984 ""
if (*ispstie) {
/* Horizontal shift start of new thing */
/* Writing concatenation */
+#line 15988 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15988 ""
i__2[1] = 1, a__1[1] = "{";
+#line 15988 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15989 ""
++lnote;
/* ihoff = ihoff-13 */
+#line 15991 ""
if (tie) {
+#line 15992 ""
ihoff += -12;
+#line 15993 ""
} else {
+#line 15994 ""
ihoff += -7;
+#line 15995 ""
}
+#line 15996 ""
if (ihoff < 0) {
+#line 15997 ""
ihoff = -ihoff;
/* Writing concatenation */
+#line 15998 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 15998 ""
i__2[1] = 1, a__1[1] = "-";
+#line 15998 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 15999 ""
++lnote;
+#line 16000 ""
}
+#line 16001 ""
r__1 = ihoff * .1f;
+#line 16001 ""
writflot_(&r__1, notexq, &lnote, (ftnlen)128);
/* Writing concatenation */
+#line 16002 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 16002 ""
i__2[1] = 1, a__1[1] = "}";
+#line 16002 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 16003 ""
++lnote;
+#line 16004 ""
}
/* Add closing stuff */
+#line 16008 ""
if (*ispstie) {
/* Writing concatenation */
+#line 16009 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 16009 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16009 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 16009 ""
i__4[2] = 4, a__3[2] = "off{";
+#line 16009 ""
chax_(ch__2, (ftnlen)1, &c__92);
+#line 16009 ""
i__4[3] = 1, a__3[3] = ch__2;
+#line 16009 ""
i__4[4] = 14, a__3[4] = "afterruleskip}";
+#line 16009 ""
s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
+#line 16011 ""
lnote += 20;
+#line 16012 ""
} else {
/* Writing concatenation */
+#line 16013 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 16013 ""
i__2[1] = 1, a__1[1] = "}";
+#line 16013 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
+#line 16014 ""
++lnote;
+#line 16015 ""
}
/* Writing concatenation */
+#line 16016 ""
i__3[0] = lnote, a__2[0] = notexq;
+#line 16016 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16016 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 16016 ""
i__3[2] = 3, a__2[2] = "en%";
+#line 16016 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
+#line 16017 ""
lnote += 4;
- s_wsfe(&io___900);
+#line 16018 ""
+ s_wsfe(&io___941);
+#line 16018 ""
do_fio(&c__1, notexq, lnote);
+#line 16018 ""
e_wsfe();
+#line 16019 ""
L1:
+#line 16019 ""
;
+#line 16019 ""
}
+#line 16020 ""
*ispstie = ! (*ispstie);
+#line 16021 ""
return 0;
} /* linebreakties_ */
@@ -23390,152 +38207,250 @@ L1:
ftnlen);
/* Fortran I/O blocks */
- static cilist io___904 = { 0, 6, 0, 0, 0 };
- static cilist io___905 = { 0, 6, 0, 0, 0 };
- static cilist io___906 = { 0, 15, 0, "(/,a)", 0 };
- static cilist io___907 = { 0, 11, 0, "(a)", 0 };
- static cilist io___908 = { 0, 16, 0, "(a)", 0 };
+ static cilist io___945 = { 0, 6, 0, 0, 0 };
+ static cilist io___946 = { 0, 6, 0, 0, 0 };
+ static cilist io___947 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___948 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___949 = { 0, 16, 0, "(a)", 0 };
+#line 16039 ""
/* Parameter adjustments */
+#line 16039 ""
islur -= 25;
+#line 16039 ""
+#line 16039 ""
/* Function Body */
+#line 16039 ""
merge = FALSE_;
+#line 16040 ""
if (comgrace_1.nlit > 0) {
+#line 16041 ""
merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl ==
comgrace_1.iplit[comgrace_1.nlit - 1];
+#line 16042 ""
}
+#line 16043 ""
++comgrace_1.nlit;
+#line 16044 ""
comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv;
+#line 16045 ""
comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl;
+#line 16046 ""
itype = 1;
+#line 16047 ""
L17:
+#line 16047 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 16048 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16048 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
+#line 16049 ""
++itype;
+#line 16050 ""
goto L17;
+#line 16051 ""
}
/* Writing concatenation */
+#line 16052 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16052 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 16052 ""
i__1[1] = 1, a__1[1] = durq;
+#line 16052 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, (
ftnlen)128);
+#line 16053 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] = 2;
+#line 16054 ""
L18:
+#line 16054 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 16055 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16055 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
+#line 16056 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 16057 ""
if (*(unsigned char *)durq != ' ') {
/* Starting a new tex command within the string */
/* Writing concatenation */
+#line 16061 ""
i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
+#line 16061 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 16061 ""
i__2[1] = 1, a__2[1] = ch__1;
+#line 16061 ""
i__2[2] = 1, a__2[2] = durq;
+#line 16061 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, &
c__3, (ftnlen)128);
+#line 16062 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] += 2;
+#line 16063 ""
goto L18;
+#line 16064 ""
}
+#line 16065 ""
} else {
/* Writing concatenation */
+#line 16066 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
+#line 16066 ""
i__1[1] = 1, a__1[1] = durq;
+#line 16066 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2,
(ftnlen)128);
+#line 16067 ""
++comgrace_1.lenlit[comgrace_1.nlit - 1];
+#line 16068 ""
goto L18;
+#line 16069 ""
}
/* If here, just read backslash-blank so string is done */
+#line 16073 ""
if (itype == 1) {
+#line 16074 ""
islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16);
+#line 16075 ""
if (merge) {
/* There are 2 separate strings on the same note, so merge them. */
+#line 16079 ""
--comgrace_1.nlit;
/* Writing concatenation */
+#line 16080 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
+#line 16080 ""
i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] =
comgrace_1.litq + (comgrace_1.nlit << 7);
+#line 16080 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &
c__2, (ftnlen)128);
+#line 16082 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[
comgrace_1.nlit];
+#line 16083 ""
if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) {
- s_wsle(&io___904);
+#line 16084 ""
+ s_wsle(&io___945);
+#line 16084 ""
e_wsle();
- s_wsle(&io___905);
- do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "
+#line 16085 ""
+ s_wsle(&io___946);
+#line 16085 ""
+ do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "\
"128 characters", (ftnlen)52);
+#line 16085 ""
e_wsle();
- s_wsfe(&io___906);
- do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"
+#line 16087 ""
+ s_wsfe(&io___947);
+#line 16087 ""
+ do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"\
"racters", (ftnlen)52);
+#line 16087 ""
e_wsfe();
+#line 16089 ""
stop1_();
+#line 16090 ""
}
+#line 16091 ""
}
+#line 16092 ""
} else {
/* Type 2 or 3. */
+#line 16096 ""
if (itype == 3) {
/* Write the string NOW */
+#line 16100 ""
if (comlast_1.islast) {
- s_wsfe(&io___907);
+#line 16100 ""
+ s_wsfe(&io___948);
/* Writing concatenation */
+#line 16100 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
+#line 16100 ""
i__1[1] = 1, a__1[1] = "%";
+#line 16100 ""
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
+#line 16100 ""
do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] +
1);
+#line 16100 ""
e_wsfe();
+#line 16100 ""
}
+#line 16102 ""
} else {
/* Must go at top */
+#line 16106 ""
if (! (*topmods)) {
+#line 16107 ""
*topmods = TRUE_;
+#line 16108 ""
o__1.oerr = 0;
+#line 16108 ""
o__1.ounit = 16;
+#line 16108 ""
o__1.ofnm = 0;
+#line 16108 ""
o__1.orl = 0;
+#line 16108 ""
o__1.osta = "SCRATCH";
+#line 16108 ""
o__1.oacc = 0;
+#line 16108 ""
o__1.ofm = 0;
+#line 16108 ""
o__1.oblnk = 0;
+#line 16108 ""
f_open(&o__1);
+#line 16109 ""
}
/* Must write '%' here rather than later, in case string ends with blank. */
- s_wsfe(&io___908);
+#line 16113 ""
+ s_wsfe(&io___949);
/* Writing concatenation */
+#line 16113 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
+#line 16113 ""
i__1[1] = 1, a__1[1] = "%";
+#line 16113 ""
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
+#line 16113 ""
do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1);
+#line 16113 ""
e_wsfe();
+#line 16114 ""
}
+#line 16115 ""
--comgrace_1.nlit;
+#line 16116 ""
}
+#line 16117 ""
return 0;
} /* littex_ */
@@ -23544,12 +38459,19 @@ integer llen_(char *strq, integer *n, ftnlen strq_len)
/* System generated locals */
integer ret_val;
+#line 16121 ""
for (ret_val = *n; ret_val >= 0; --ret_val) {
+#line 16122 ""
if (*(unsigned char *)&strq[ret_val - 1] != ' ') {
+#line 16122 ""
return ret_val;
+#line 16122 ""
}
+#line 16123 ""
/* L1: */
+#line 16123 ""
}
+#line 16124 ""
return ret_val;
} /* llen_ */
@@ -23566,7 +38488,9 @@ integer log2_(integer *n)
/* log2 = alog(1.*n)/0.6931472+.0001 */
/* log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */
+#line 16131 ""
ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8);
+#line 16132 ""
return ret_val;
} /* log2_ */
@@ -23594,153 +38518,242 @@ integer log2_(integer *n)
extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
integer *);
+#line 16151 ""
all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1;
+#line 16152 ""
all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2;
+#line 16153 ""
numnow = *numnew;
+#line 16154 ""
if (*numnew > 1) {
/* If it starts before any others, must put it in order */
+#line 16158 ""
for (ib = *numnew - 1; ib >= 1; --ib) {
+#line 16159 ""
if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) {
+#line 16159 ""
goto L12;
+#line 16159 ""
}
+#line 16160 ""
all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[
commvl_1.ivx + ib * 24 - 25];
+#line 16161 ""
all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[
commvl_1.ivx + ib * 24 - 25];
+#line 16162 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] =
*(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25];
+#line 16163 ""
all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1;
+#line 16164 ""
all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2;
+#line 16165 ""
numnow = ib;
+#line 16166 ""
/* L11: */
+#line 16166 ""
}
+#line 16167 ""
L12:
+#line 16168 ""
;
+#line 16168 ""
}
+#line 16169 ""
sum = 0.f;
/* Beam has non-xtup within */
+#line 16173 ""
nrests = 0;
+#line 16174 ""
isxtup = FALSE_;
+#line 16175 ""
i__1 = *nip2;
+#line 16175 ""
for (iip = *nip1; iip <= i__1; ++iip) {
+#line 16176 ""
if (bit_test(all_1.islur[commvl_1.ivx + *nip1 * 24 - 25],21)) {
/* Forced multiplicity */
-/* mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22) */
+#line 16180 ""
i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], &
c__3, &c__22) + 8;
+#line 16180 ""
setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0,
&i__2);
+#line 16182 ""
} else if (! isxtup) {
+#line 16183 ""
if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
-/* mult(ivx,iip) = 4-log2(nodur(ivx,iip)) */
+#line 16184 ""
i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25])
+ 8;
+#line 16184 ""
setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &
c__0, &i__2);
+#line 16185 ""
} else {
/* Start xtup within forced beam */
+#line 16189 ""
isxtup = TRUE_;
+#line 16190 ""
iip1 = iip;
+#line 16191 ""
}
+#line 16192 ""
} else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
/* End of xtup within forced beam. Must count doubled notes */
+#line 16196 ""
ndoub = 0;
+#line 16197 ""
i__2 = iip;
+#line 16197 ""
for (iiip = iip1; iiip <= i__2; ++iiip) {
+#line 16198 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
+#line 16198 ""
++ndoub;
+#line 16198 ""
}
+#line 16199 ""
/* L1: */
+#line 16199 ""
}
+#line 16200 ""
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 16202 ""
i__2 = iip;
+#line 16202 ""
for (iiip = iip1; iiip <= i__2; ++iiip) {
-/* mult(ivx,iiip) = multx */
+#line 16203 ""
i__3 = multx + 8;
+#line 16203 ""
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 16207 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
+#line 16207 ""
--all_1.mult[commvl_1.ivx + iiip * 24 - 25];
+#line 16207 ""
}
+#line 16209 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) {
+#line 16210 ""
++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
+#line 16211 ""
} else if (iiip > 1) {
+#line 16212 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 -
25],19)) {
+#line 16212 ""
++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
+#line 16212 ""
}
+#line 16214 ""
}
+#line 16215 ""
/* L74: */
+#line 16215 ""
}
+#line 16216 ""
isxtup = FALSE_;
+#line 16217 ""
}
+#line 16218 ""
if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) {
+#line 16219 ""
++nrests;
+#line 16220 ""
} else {
+#line 16221 ""
sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25];
+#line 16222 ""
}
+#line 16223 ""
/* L9: */
+#line 16223 ""
}
/* Set beam up-down-ness */
+#line 16227 ""
if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
max(1,comfb_1.ifb) * 24 - 25] != 'x') {
+#line 16228 ""
if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24
- 25] == 'f') {
/* Get default, then trade "l" and "u" */
+#line 16232 ""
r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
+#line 16232 ""
i__1 = ncmid_(&all_1.iv, nip1);
+#line 16232 ""
ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
+#line 16232 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = (
char) (225 - *(unsigned char *)&ch__1[0]);
+#line 16234 ""
} else {
+#line 16235 ""
*(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 16236 ""
}
/* This probably works only because forced beams are done first, so they */
/* don't have to be re-sorted within each voice. ???? */
+#line 16241 ""
} else if (commvl_1.nvmx[all_1.iv - 1] == 2) {
/* Multi-voice per staff */
+#line 16245 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 16246 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
'l';
+#line 16247 ""
} else {
+#line 16248 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
'u';
+#line 16249 ""
}
+#line 16250 ""
} else {
/* Defaults */
+#line 16254 ""
r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
+#line 16254 ""
i__1 = ncmid_(&all_1.iv, nip1);
+#line 16254 ""
ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
+#line 16254 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *(
unsigned char *)&ch__1[0];
+#line 16256 ""
}
+#line 16257 ""
return 0;
} /* logbeam_ */
@@ -23763,44 +38776,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 16273 ""
inbuff_1.lbuf[0] = inbuff_1.lbuf[0];
+#line 16274 ""
if (! commac_1.mrecord) {
/* Starting the macro */
+#line 16278 ""
c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
+#line 16279 ""
c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
+#line 16280 ""
c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
+#line 16281 ""
commac_1.mrecord = TRUE_;
+#line 16282 ""
}
+#line 16283 ""
if (*iccount < 128) {
+#line 16284 ""
i__1 = *iccount;
+#line 16284 ""
*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
+#line 16285 ""
if (*ndxm > 0) {
+#line 16285 ""
i__1 = *iccount;
+#line 16285 ""
i__2 = 128 - *iccount;
+#line 16285 ""
*ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
+#line 16285 ""
}
+#line 16287 ""
if (*ndxm > 0) {
/* This line ends the macro. */
+#line 16291 ""
i__1 = *iccount + *ndxm;
+#line 16291 ""
if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen)
1) != 0) {
+#line 16292 ""
i__1 = *iccount + *ndxm + 1;
+#line 16292 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 16292 ""
errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", (
ftnlen)128, (ftnlen)27);
+#line 16294 ""
stop1_();
+#line 16295 ""
}
+#line 16296 ""
c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
+#line 16297 ""
c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
+#line 16298 ""
commac_1.mrecord = FALSE_;
+#line 16299 ""
}
+#line 16300 ""
}
+#line 16301 ""
return 0;
} /* m1rec1_ */
@@ -23849,116 +38891,182 @@ L12:
setbits_(integer *, integer *, integer *, integer *);
/* Fortran I/O blocks */
- static cilist io___953 = { 0, 6, 0, 0, 0 };
- static cilist io___954 = { 0, 6, 0, 0, 0 };
- static cilist io___955 = { 0, 15, 0, "(/a)", 0 };
+ static cilist io___994 = { 0, 6, 0, 0, 0 };
+ static cilist io___995 = { 0, 6, 0, 0, 0 };
+ static cilist io___996 = { 0, 15, 0, "(/a)", 0 };
/* Above are factors for grace note, clef spacing. (fraction of wheadpt) */
/* In 1.04, moved to block data subprogram */
+#line 16393 ""
/* Parameter adjustments */
+#line 16393 ""
--istart;
+#line 16393 ""
--numbms;
+#line 16393 ""
--istop;
+#line 16393 ""
--squez;
+#line 16393 ""
--cwrest;
+#line 16393 ""
--tstart;
+#line 16393 ""
+#line 16393 ""
/* Function Body */
+#line 16393 ""
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 16398 ""
i__1 = all_1.nv;
+#line 16398 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 16399 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 16399 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 16400 ""
commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] =
0;
+#line 16401 ""
/* L45: */
+#line 16401 ""
}
+#line 16401 ""
}
+#line 16402 ""
}
/* Time from start of gulp to end of bar, used with forced beams */
+#line 16406 ""
tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1);
+#line 16407 ""
if (all_1.lenb0 > 0) {
+#line 16407 ""
tglp2 -= all_1.lenb1;
+#line 16407 ""
}
+#line 16408 ""
*tglp1 = tglp2 - all_1.lenbar;
/* infbmx will only be true if in xtup that is NOT in explicit forced beam. */
+#line 16412 ""
i__2 = all_1.nv;
+#line 16412 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 16413 ""
i__1 = commvl_1.nvmx[all_1.iv - 1];
+#line 16413 ""
for (kv = 1; kv <= i__1; ++kv) {
+#line 16414 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 16415 ""
cwrest[commvl_1.ivx] = FALSE_;
+#line 16416 ""
infbmx[commvl_1.ivx - 1] = FALSE_;
+#line 16417 ""
inxtup[commvl_1.ivx - 1] = FALSE_;
+#line 16418 ""
if (all_1.ibar > 1) {
+#line 16419 ""
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 16420 ""
} else {
+#line 16421 ""
all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx +
all_1.ibar * 24 - 25];
+#line 16422 ""
}
+#line 16423 ""
/* L1: */
+#line 16423 ""
}
+#line 16423 ""
}
/* initialize list note counter, time(iv), curr. note(iv). The loop to 4 */
/* ONLY initializes each voice. */
+#line 16428 ""
in = 1;
+#line 16429 ""
nxtup = 0;
+#line 16430 ""
comarp_1.narp = 0;
+#line 16431 ""
i__1 = all_1.nv;
+#line 16431 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 16432 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 16432 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 16433 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 16434 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
+#line 16435 ""
cnn[commvl_1.ivx - 1] = 1;
+#line 16436 ""
all_1.ivxo[in - 1] = commvl_1.ivx;
+#line 16437 ""
all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
+#line 16438 ""
all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1,
all_1.nacc);
+#line 16439 ""
all_1.to[in - 1] = 0.f;
+#line 16440 ""
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 16444 ""
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 16448 ""
++nxtup;
+#line 16449 ""
nxtnow[commvl_1.ivx - 1] = nxtup;
+#line 16450 ""
inxtup[commvl_1.ivx - 1] = TRUE_;
+#line 16451 ""
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 16456 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
+#line 16457 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
+#line 16457 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
{
+#line 16458 ""
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 16462 ""
goto L61;
+#line 16463 ""
} 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 +
@@ -23967,96 +39075,156 @@ L12:
/* IS explicit fb here; must NOT insert one */
+#line 16468 ""
goto L62;
+#line 16469 ""
}
+#line 16470 ""
/* L60: */
+#line 16470 ""
}
+#line 16471 ""
}
+#line 16472 ""
L61:
/* If here, xtup isn't in explicit fb, so must insert one */
+#line 16476 ""
infbmx[commvl_1.ivx - 1] = TRUE_;
+#line 16477 ""
r__1 = t1xtup[nxtup - 1] + *tglp1;
+#line 16477 ""
addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
+#line 16479 ""
ifbnow[commvl_1.ivx - 1] = ifbadd;
+#line 16480 ""
}
+#line 16481 ""
L62:
+#line 16482 ""
if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) <
comtol_1.tol) {
+#line 16482 ""
xit[commvl_1.ivx - 1] = 1e3f;
+#line 16482 ""
}
+#line 16483 ""
++in;
+#line 16484 ""
/* L4: */
+#line 16484 ""
}
+#line 16484 ""
}
/* Build the list: This is a manual loop starting at 5 */
+#line 16488 ""
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 16493 ""
tmin = 1e3f;
+#line 16494 ""
i__2 = all_1.nv;
+#line 16494 ""
for (iiv = 1; iiv <= i__2; ++iiv) {
+#line 16495 ""
i__1 = commvl_1.nvmx[iiv - 1];
+#line 16495 ""
for (kv = 1; kv <= i__1; ++kv) {
+#line 16496 ""
iivx = commvl_1.ivmx[iiv + kv * 24 - 25];
/* Computing MIN */
+#line 16497 ""
r__1 = tmin, r__2 = xit[iivx - 1];
+#line 16497 ""
tminn = dmin(r__1,r__2);
+#line 16498 ""
if (tminn < tmin - comtol_1.tol) {
+#line 16499 ""
tmin = tminn;
+#line 16500 ""
commvl_1.ivx = iivx;
+#line 16501 ""
}
+#line 16502 ""
/* L6: */
+#line 16502 ""
}
+#line 16502 ""
}
+#line 16503 ""
if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) {
+#line 16503 ""
goto L7;
+#line 16503 ""
}
+#line 16504 ""
all_1.ivxo[in - 1] = commvl_1.ivx;
+#line 16505 ""
++cnn[commvl_1.ivx - 1];
+#line 16506 ""
all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
+#line 16507 ""
all_1.to[in - 1] = tmin;
/* Check if this voice is done */
+#line 16511 ""
all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[
commvl_1.ivx - 1], all_1.nacc);
+#line 16512 ""
if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) {
+#line 16513 ""
xit[commvl_1.ivx - 1] = 1e3f;
+#line 16514 ""
} else {
+#line 16515 ""
xit[commvl_1.ivx - 1] += all_1.tnote[in - 1];
+#line 16516 ""
}
/* Flag xtups */
+#line 16520 ""
if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) {
+#line 16521 ""
if (! inxtup[commvl_1.ivx - 1]) {
/* First note of xtup, not at start of bar. */
+#line 16525 ""
++nxtup;
+#line 16526 ""
nxtnow[commvl_1.ivx - 1] = nxtup;
+#line 16527 ""
inxtup[commvl_1.ivx - 1] = TRUE_;
+#line 16528 ""
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 16533 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
+#line 16534 ""
i__1 = comfb_1.nfb[commvl_1.ivx - 1];
+#line 16534 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) {
+#line 16535 ""
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 16539 ""
goto L71;
+#line 16540 ""
} 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 +
@@ -24065,38 +39233,59 @@ L5:
/* IS explicit bm. Don't put one */
+#line 16545 ""
goto L72;
+#line 16546 ""
}
+#line 16547 ""
/* L70: */
+#line 16547 ""
}
+#line 16548 ""
}
+#line 16549 ""
L71:
/* If here, no explicit bm, so put one in */
+#line 16553 ""
infbmx[commvl_1.ivx - 1] = TRUE_;
+#line 16554 ""
r__1 = t1xtup[nxtup - 1] + *tglp1;
+#line 16554 ""
addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
+#line 16556 ""
ifbnow[commvl_1.ivx - 1] = ifbadd;
+#line 16557 ""
}
+#line 16558 ""
L72:
+#line 16559 ""
;
+#line 16559 ""
} else if (inxtup[commvl_1.ivx - 1]) {
/* This test is sufficient because already know nodur>0 */
+#line 16563 ""
inxtup[commvl_1.ivx - 1] = FALSE_;
+#line 16564 ""
if (infbmx[commvl_1.ivx - 1]) {
/* Xtup is in auto-forced beam, so end it */
+#line 16568 ""
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 16570 ""
infbmx[commvl_1.ivx - 1] = FALSE_;
+#line 16571 ""
}
+#line 16572 ""
}
+#line 16573 ""
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)) {
@@ -24104,35 +39293,62 @@ L72:
/* For staff jumped beam, flag the first note (lowest voice) at same time. */
/* Later will start new notes group here. */
+#line 16579 ""
inj = in;
+#line 16580 ""
if (all_1.ivxo[in - 1] > 1) {
+#line 16581 ""
for (iin = in - 1; iin >= 1; --iin) {
+#line 16582 ""
if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) {
+#line 16582 ""
goto L41;
+#line 16582 ""
}
+#line 16583 ""
if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1))
< comtol_1.tol) {
+#line 16584 ""
inj = iin;
+#line 16585 ""
goto L40;
+#line 16586 ""
}
+#line 16587 ""
L40:
+#line 16587 ""
;
+#line 16587 ""
}
+#line 16588 ""
}
+#line 16589 ""
L41:
+#line 16590 ""
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 16591 ""
}
+#line 16592 ""
++in;
+#line 16593 ""
goto L5;
+#line 16594 ""
L7:
+#line 16595 ""
comntot_1.ntot = in - 1;
+#line 16596 ""
i__1 = comntot_1.ntot - 1;
+#line 16596 ""
for (in = 1; in <= i__1; ++in) {
+#line 16597 ""
all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1];
+#line 16598 ""
/* L8: */
+#line 16598 ""
}
+#line 16599 ""
all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1];
/* Debug writes */
@@ -24148,21 +39364,32 @@ L7:
/* Done w/ list. Loop for parsing into note blocks: */
+#line 16614 ""
ib = 1;
+#line 16615 ""
istart[1] = 1;
+#line 16616 ""
comnsp_2.space[0] = 0.f;
+#line 16617 ""
in = 1;
/* A manual loop to set space(ib) and istop(ib) */
+#line 16621 ""
L9:
/* Computing MIN */
+#line 16623 ""
i__1 = in + 1;
+#line 16623 ""
commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1];
/* Computing MIN */
+#line 16624 ""
i__1 = in + 1;
+#line 16624 ""
ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1];
+#line 16625 ""
isl = all_1.islur[commvl_1.ivx + ip * 24 - 25];
+#line 16626 ""
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[
@@ -24184,224 +39411,353 @@ L9:
/* 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */
/* changes on last note in the list? */
+#line 16647 ""
if (bit_test(isl,15) && in < comntot_1.ntot) {
+#line 16648 ""
for (iin = in; iin >= 1; --iin) {
+#line 16649 ""
if (all_1.tno[iin - 1] > comtol_1.tol) {
+#line 16650 ""
in = iin;
+#line 16651 ""
all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear(
all_1.islur[commvl_1.ivx + ip * 24 - 25],15);
+#line 16652 ""
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 16654 ""
goto L51;
+#line 16655 ""
}
+#line 16656 ""
/* L50: */
+#line 16656 ""
}
+#line 16657 ""
L51:
+#line 16658 ""
;
+#line 16658 ""
}
+#line 16659 ""
if (comnsp_2.space[ib - 1] < comtol_1.tol) {
+#line 16660 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
+#line 16661 ""
squez[ib] = 1.f;
+#line 16662 ""
}
+#line 16663 ""
istop[ib] = in;
+#line 16664 ""
} else if (comnsp_2.space[ib - 1] < comtol_1.tol) {
/* space hasn't been set yet, so tentatively set: */
+#line 16668 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
+#line 16669 ""
if (comnsp_2.space[ib - 1] < comtol_1.tol) {
+#line 16670 ""
++in;
+#line 16671 ""
} else {
+#line 16672 ""
squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib -
1], all_1.tnote, all_1.to);
+#line 16673 ""
istop[ib] = in;
+#line 16674 ""
}
+#line 16675 ""
goto L9;
+#line 16676 ""
} else if (all_1.tno[in] < comtol_1.tol) {
/* This is not the last note in the group, so */
+#line 16680 ""
++in;
+#line 16681 ""
goto L9;
+#line 16682 ""
} else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) <
comtol_1.tol) {
+#line 16683 ""
i__1 = in + 1;
+#line 16683 ""
xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1],
all_1.tnote, all_1.to);
+#line 16684 ""
if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) {
/* Keep spacing the same, update tentative stop point */
+#line 16688 ""
++in;
+#line 16689 ""
istop[ib] = in;
+#line 16690 ""
goto L9;
+#line 16691 ""
}
+#line 16692 ""
}
/* At this point istart and istop are good, so finalize block */
+#line 16696 ""
tstart[ib] = all_1.to[istart[ib] - 1];
+#line 16697 ""
if (istop[ib] == comntot_1.ntot) {
+#line 16697 ""
goto L15;
+#line 16697 ""
}
+#line 16698 ""
++ib;
+#line 16699 ""
istart[ib] = istop[ib - 1] + 1;
+#line 16700 ""
in = istart[ib];
/* Set tentative block space and squeeze-factor for upcoming block */
+#line 16704 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
+#line 16705 ""
if (comnsp_2.space[ib - 1] > comtol_1.tol) {
+#line 16705 ""
squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1],
all_1.tnote, all_1.to);
+#line 16705 ""
}
+#line 16707 ""
istop[ib] = in;
+#line 16708 ""
goto L9;
+#line 16709 ""
L15:
+#line 16710 ""
comnsp_2.nb = ib;
/* Invert the list of places into ipl(0-7), making it easier to analyze a voice */
+#line 16714 ""
i__1 = comntot_1.ntot;
+#line 16714 ""
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 16719 ""
comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in;
+#line 16720 ""
/* L13: */
+#line 16720 ""
}
/* Compute elemskips from start of bar to each note in the bar, for beam slopes */
+#line 16724 ""
eskzb = 0.f;
+#line 16725 ""
ib = 1;
+#line 16726 ""
i__1 = comntot_1.ntot;
+#line 16726 ""
for (in = 1; in <= i__1; ++in) {
+#line 16727 ""
if (in == istart[ib]) {
+#line 16728 ""
r__1 = comnsp_2.space[ib - 1] / squez[ib];
+#line 16728 ""
deskb = squez[ib] * feon_(&r__1);
+#line 16729 ""
} else if (all_1.tno[in - 2] > comtol_1.tol) {
+#line 16730 ""
eskzb += deskb;
+#line 16731 ""
}
+#line 16732 ""
all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb;
+#line 16733 ""
comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] =
eskzb;
+#line 16734 ""
if (in == istop[ib]) {
+#line 16735 ""
eskzb += deskb;
+#line 16736 ""
++ib;
+#line 16737 ""
}
+#line 16738 ""
/* L30: */
+#line 16738 ""
}
-/* Debug writes */
-
-/* print* */
-/* write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot) */
-/* print*,'PMXB has now got blocks' */
-/* write(*,'(16i5)')(istart(ib),ib=1,nb) */
-/* write(*,'(16i5)')(istop(ib),ib=1,nb) */
-/* write(*,'(16f5.1)')(space(ib),ib=1,nb) */
-/* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */
-/* write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) */
-/* c write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048, */
-/* * in=1,ntot) */
-/* write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot) */
-
-
/* Analyze for beams. */
+#line 16742 ""
i__1 = all_1.nv;
+#line 16742 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 16743 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 16743 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 16744 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 16745 ""
numbms[commvl_1.ivx] = 0;
+#line 16746 ""
mapfb[0] = 0;
+#line 16747 ""
mapfb[1] = 0;
+#line 16748 ""
mapfb[2] = 0;
+#line 16749 ""
mapfb[3] = 0;
/* First forced beams. */
+#line 16753 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
/* tglp2 is time from start of gulp to end of current bar. */
+#line 16757 ""
nfbbar = 0;
+#line 16758 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
+#line 16758 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) {
+#line 16759 ""
if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] >
tglp2 - comtol_1.tol) {
+#line 16759 ""
goto L81;
+#line 16759 ""
}
+#line 16760 ""
++nfbbar;
+#line 16761 ""
++numbms[commvl_1.ivx];
+#line 16762 ""
numnew = numbms[commvl_1.ivx];
/* Times from beginning of bar */
+#line 16766 ""
itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx +
comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
+#line 16767 ""
itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx +
comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
+#line 16768 ""
i__4 = all_1.nn[commvl_1.ivx - 1];
+#line 16768 ""
for (ip = 1; ip <= i__4; ++ip) {
+#line 16769 ""
if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx +
ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) {
+#line 16770 ""
nip1fb = ip;
+#line 16771 ""
i__5 = all_1.nn[commvl_1.ivx - 1];
+#line 16771 ""
for (ip1 = ip; ip1 <= i__5; ++ip1) {
+#line 16772 ""
inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 *
24 - 25];
+#line 16773 ""
if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[
inip1 - 1] - itbb2, dabs(r__1)) <
comtol_1.tol) {
+#line 16774 ""
nip2fb = ip1;
+#line 16775 ""
itbb3 = itbb2 - 2;
+#line 16776 ""
goto L85;
+#line 16777 ""
}
+#line 16778 ""
/* L84: */
+#line 16778 ""
}
+#line 16779 ""
}
+#line 16780 ""
/* L83: */
+#line 16780 ""
}
- s_wsle(&io___953);
+#line 16781 ""
+ s_wsle(&io___994);
+#line 16781 ""
e_wsle();
- s_wsle(&io___954);
+#line 16782 ""
+ s_wsle(&io___995);
+#line 16782 ""
do_lio(&c__9, &c__1, "Timing problem w/ forced beams", (
ftnlen)30);
+#line 16782 ""
e_wsle();
- s_wsfe(&io___955);
+#line 16783 ""
+ s_wsfe(&io___996);
+#line 16783 ""
do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen)
30);
+#line 16783 ""
e_wsfe();
+#line 16784 ""
L85:
+#line 16785 ""
logbeam_(&numnew, &nip1fb, &nip2fb);
/* Set up mapfb for forced beam just logged: */
+#line 16789 ""
ib1 = itbb1 / 2;
+#line 16790 ""
ib2 = itbb3 / 2;
+#line 16791 ""
ibrep = all_1.lenbar / *ibmrep / 2;
+#line 16792 ""
i__4 = *ibmrep;
+#line 16792 ""
for (irep = 1; irep <= i__4; ++irep) {
/* Computing MAX */
+#line 16793 ""
i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep;
+#line 16793 ""
ib1now = max(i__5,i__6);
/* Computing MIN */
+#line 16794 ""
i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) *
ibrep;
+#line 16794 ""
ib2now = min(i__5,i__6);
+#line 16795 ""
mapnow = 0;
+#line 16796 ""
i__5 = ib2now;
+#line 16796 ""
for (ib = ib1now; ib <= i__5; ++ib) {
+#line 16797 ""
mapnow = bit_set(mapnow,ib);
+#line 16798 ""
/* L87: */
+#line 16798 ""
}
+#line 16799 ""
mapfb[irep - 1] |= mapnow;
+#line 16800 ""
/* L86: */
+#line 16800 ""
}
/* Since we are cycling thru forced beams, for those that start with a rest and */
@@ -24409,6 +39765,7 @@ L85:
/* 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */
/* start of beam */
+#line 16807 ""
if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25],
0)) {
/* call setbits(ipl(ivx,nip1fb+1),6,11, */
@@ -24417,57 +39774,88 @@ L85:
/* * igetbits(ipl(ivx,nip1fb),6,17)) */
/* call setbits(islur(ivx,nip1fb+1),2,27, */
/* * igetbits(islur(ivx,nip1fb),2,27)) */
+#line 16814 ""
i__4 = nip2fb;
+#line 16814 ""
for (kp = nip1fb + 1; kp <= i__4; ++kp) {
+#line 16815 ""
i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
* 24 - 25], &c__6, &c__11);
+#line 16815 ""
setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
&c__6, &c__11, &i__5);
+#line 16817 ""
i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
* 24 - 25], &c__6, &c__17);
+#line 16817 ""
setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
&c__6, &c__17, &i__5);
+#line 16819 ""
i__5 = igetbits_(&all_1.islur[commvl_1.ivx +
nip1fb * 24 - 25], &c__2, &c__27);
+#line 16819 ""
setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25]
, &c__2, &c__27, &i__5);
+#line 16821 ""
/* L88: */
+#line 16821 ""
}
+#line 16822 ""
}
+#line 16823 ""
/* L80: */
+#line 16823 ""
}
+#line 16824 ""
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 16829 ""
if (nfbbar > 0) {
+#line 16830 ""
comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar;
+#line 16831 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
+#line 16831 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
{
+#line 16832 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb +
nfbbar) * 24 - 25];
+#line 16833 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb +
nfbbar) * 24 - 25];
+#line 16834 ""
*(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 16835 ""
/* L82: */
+#line 16835 ""
}
+#line 16836 ""
}
+#line 16837 ""
}
+#line 16838 ""
comfb_1.ifb = 0;
/* Done with forced beam masks for this bar and voice. Now get normal beams. */
+#line 16842 ""
findbeam_(ibmrep, &numbms[1], mapfb);
+#line 16843 ""
/* L20: */
+#line 16843 ""
}
+#line 16843 ""
}
+#line 16844 ""
return 0;
} /* make1bar_ */
@@ -24497,6 +39885,7 @@ L81:
char *, ftnlen), e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
integer pow_ii(integer *, integer *);
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
double r_lg10(real *);
integer s_cmp(char *, char *, ftnlen, ftnlen);
@@ -24507,6 +39896,7 @@ L81:
extern /* Subroutine */ int beamstrt_(char *, integer *, integer *,
integer *, real *, real *, integer *, ftnlen);
static real ptsavail;
+ static integer multtrem;
extern /* Subroutine */ int dopsslur_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, logical *, integer *, char *, integer *, char *,
@@ -24516,9 +39906,13 @@ L81:
static integer ib, ig, il, in, ip, kv;
extern /* Subroutine */ int adjusteskz_(integer *, integer *, real *);
static integer iib, icm, ing, len;
- static real esk, xnd;
- static integer ivf, iiv;
- static real wgr, pts;
+ static real esk;
+ static char udq[1];
+ static real xnd;
+ static integer ivf;
+ static real wgr;
+ static integer iiv;
+ static real pts;
static logical secondgrace;
extern integer log2_(integer *);
extern /* Subroutine */ int chkkbdrests_(integer *, integer *, integer *,
@@ -24556,10 +39950,10 @@ L81:
char *, integer *, ftnlen, ftnlen), docrd_(integer *, integer *,
integer *, integer *, integer *, real *, char *, integer *, char *
, integer *, integer *, integer *, integer *, logical *, integer *
- , integer *, integer *, real *, logical *, integer *, ftnlen,
- ftnlen), putcb_(integer *, integer *, char *, integer *, ftnlen),
- beamn1_(char *, integer *, ftnlen), notex_(char *, integer *,
- ftnlen);
+ , integer *, integer *, real *, logical *, integer *, integer *,
+ ftnlen, ftnlen), putcb_(integer *, integer *, char *, integer *,
+ ftnlen), beamn1_(char *, integer *, ftnlen), notex_(char *,
+ integer *, ftnlen);
static logical iscacc;
extern /* Subroutine */ int addask_(real *, real *, real *, real *, real *
, real *, logical *);
@@ -24610,7 +40004,7 @@ L81:
static integer icashft;
static real ptbneed;
extern /* Subroutine */ int beamid_(char *, integer *, ftnlen);
- static integer itleft, itendb;
+ static integer lineno, itleft;
static real ptsneed;
extern /* Subroutine */ int clefsym_(integer *, char *, integer *,
integer *, ftnlen);
@@ -24621,53 +40015,54 @@ L81:
integer *, integer *, integer *, integer *, char *, integer *,
logical *, ftnlen), setbits_(integer *, integer *, integer *,
integer *);
- static integer itright;
+ static integer itright, itendb;
extern integer iashft_(integer *);
static integer nolevc, ivlast;
+ static real wheadpt1;
extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
;
- static real wheadpt1;
static integer mtrspc;
/* Fortran I/O blocks */
- static icilist io___975 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 };
- static icilist io___977 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 };
- static icilist io___978 = { 0, noteq, 0, "(i1)", 1, 1 };
- static cilist io___981 = { 0, 11, 0, "(a)", 0 };
- static cilist io___982 = { 0, 11, 0, "(a)", 0 };
- static cilist io___985 = { 0, 11, 0, "(a20,i1,a)", 0 };
- static cilist io___986 = { 0, 11, 0, "(a20,i2,a)", 0 };
- static cilist io___987 = { 0, 11, 0, "(a)", 0 };
- static icilist io___990 = { 0, soutq+8, 0, "(f4.1)", 4, 1 };
- static icilist io___991 = { 0, soutq+8, 0, "(f4.2)", 4, 1 };
- static icilist io___992 = { 0, soutq+10, 0, "(i2)", 2, 1 };
- static icilist io___993 = { 0, soutq+11, 0, "(i1)", 1, 1 };
- static cilist io___998 = { 0, 6, 0, 0, 0 };
- static cilist io___999 = { 0, 6, 0, 0, 0 };
- static cilist io___1019 = { 0, 6, 0, 0, 0 };
- static cilist io___1035 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1036 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1037 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1038 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1039 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___1016 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 };
+ static icilist io___1018 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 };
+ static icilist io___1019 = { 0, noteq, 0, "(i1)", 1, 1 };
+ static cilist io___1022 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1023 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1026 = { 0, 11, 0, "(a20,i1,a)", 0 };
+ static cilist io___1027 = { 0, 11, 0, "(a20,i2,a)", 0 };
+ static cilist io___1028 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___1031 = { 0, soutq+8, 0, "(f4.1)", 4, 1 };
+ static icilist io___1032 = { 0, soutq+8, 0, "(f4.2)", 4, 1 };
+ static icilist io___1033 = { 0, soutq+10, 0, "(i2)", 2, 1 };
+ static icilist io___1034 = { 0, soutq+11, 0, "(i1)", 1, 1 };
+ static cilist io___1039 = { 0, 6, 0, 0, 0 };
static cilist io___1040 = { 0, 6, 0, 0, 0 };
- static cilist io___1041 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1042 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1043 = { 0, 11, 0, "(a)", 0 };
- static icilist io___1047 = { 0, notexq+11, 0, "(i2)", 2, 1 };
- static icilist io___1053 = { 0, notexq+6, 0, "(f3.1)", 3, 1 };
- static icilist io___1054 = { 0, notexq+6, 0, "(f4.1)", 4, 1 };
- static icilist io___1056 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
- static icilist io___1057 = { 0, notexq+5, 0, "(f4.1)", 4, 1 };
- static cilist io___1059 = { 0, 6, 0, 0, 0 };
- static cilist io___1060 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1061 = { 0, 11, 0, "(a)", 0 };
- static icilist io___1069 = { 0, notexq, 0, "(f4.1)", 79, 1 };
- static cilist io___1072 = { 0, 6, 0, 0, 0 };
- static cilist io___1085 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1088 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1091 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1093 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1060 = { 0, 6, 0, 0, 0 };
+ static cilist io___1076 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1077 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1078 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1079 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1080 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1081 = { 0, 6, 0, 0, 0 };
+ static cilist io___1082 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1083 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1084 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___1088 = { 0, notexq+11, 0, "(i2)", 2, 1 };
+ static icilist io___1094 = { 0, notexq+6, 0, "(f3.1)", 3, 1 };
+ static icilist io___1095 = { 0, notexq+6, 0, "(f4.1)", 4, 1 };
+ static icilist io___1097 = { 0, notexq+5, 0, "(f3.1)", 3, 1 };
+ static icilist io___1098 = { 0, notexq+5, 0, "(f4.1)", 4, 1 };
+ static cilist io___1100 = { 0, 6, 0, 0, 0 };
+ static cilist io___1101 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1102 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___1110 = { 0, notexq, 0, "(f4.1)", 79, 1 };
+ static icilist io___1116 = { 0, noteq, 0, "(a1,i2,a1)", 8, 1 };
+ static cilist io___1117 = { 0, 6, 0, 0, 0 };
+ static cilist io___1130 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1133 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1136 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1138 = { 0, 11, 0, "(a)", 0 };
@@ -24675,234 +40070,419 @@ L81:
/* In 1.04, moved to block data subprogram */
/* 130316 */
+#line 16964 ""
/* Parameter adjustments */
+#line 16964 ""
--clefq;
+#line 16964 ""
--istart;
+#line 16964 ""
--numbms;
+#line 16964 ""
--istop;
+#line 16964 ""
--squez;
+#line 16964 ""
--cwrest;
+#line 16964 ""
--tstart;
+#line 16964 ""
+#line 16964 ""
/* Function Body */
+#line 16964 ""
xjbeambrests_1.nbrests = 0;
/* Set up main ib loop within which a block (notes group) is written */
+#line 16968 ""
i__1 = all_1.nv;
+#line 16968 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 16969 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 16969 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 16970 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 16971 ""
all_1.ibmcnt[commvl_1.ivx - 1] = 1;
+#line 16972 ""
ibmcnt1[commvl_1.ivx - 1] = 1;
+#line 16973 ""
all_1.beamon[commvl_1.ivx - 1] = FALSE_;
+#line 16974 ""
beamon1[commvl_1.ivx - 1] = FALSE_;
+#line 16975 ""
nornb[commvl_1.ivx - 1] = 0;
+#line 16976 ""
iaskb[commvl_1.ivx - 1] = 1;
+#line 16977 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
+#line 16978 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
+#line 16979 ""
/* L25: */
+#line 16979 ""
}
+#line 16979 ""
}
+#line 16980 ""
comas1_1.naskb = 0;
+#line 16981 ""
ifig[0] = 1;
+#line 16982 ""
ifig[1] = 1;
+#line 16983 ""
comxtup_1.ixtup = 0;
+#line 16984 ""
bspend = FALSE_;
+#line 16985 ""
iscwr = FALSE_;
+#line 16986 ""
rpndot = FALSE_;
+#line 16987 ""
i__2 = comnsp_2.nb;
+#line 16987 ""
for (ib = 1; ib <= i__2; ++ib) {
/* Check for segno */
+#line 16991 ""
if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) &&
all_1.ivxo[istart[ib] - 1] == 1) {
+#line 16993 ""
if (comgrace_1.noffseg <= -10) {
- s_wsfi(&io___975);
+#line 16994 ""
+ s_wsfi(&io___1016);
+#line 16994 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
+#line 16994 ""
e_wsfi();
+#line 16995 ""
lnoten = 5;
+#line 16996 ""
} else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) {
- s_wsfi(&io___977);
+#line 16997 ""
+ s_wsfi(&io___1018);
+#line 16997 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
+#line 16997 ""
e_wsfi();
+#line 16998 ""
lnoten = 4;
+#line 16999 ""
} else {
- s_wsfi(&io___978);
+#line 17000 ""
+ s_wsfi(&io___1019);
+#line 17000 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
+#line 17000 ""
e_wsfi();
+#line 17001 ""
lnoten = 1;
+#line 17002 ""
}
/* Writing concatenation */
+#line 17003 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 17003 ""
i__3[1] = 6, a__1[1] = "znotes";
+#line 17003 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 17003 ""
i__3[3] = 6, a__1[3] = "segnoo";
+#line 17003 ""
i__3[4] = lnoten, a__1[4] = noteq;
+#line 17003 ""
i__3[5] = 1, a__1[5] = "9";
+#line 17003 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
+#line 17004 ""
lnote = lnoten + 15;
+#line 17005 ""
i__1 = all_1.nv;
+#line 17005 ""
for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) {
+#line 17006 ""
if (lnote > 60) {
+#line 17007 ""
if (comlast_1.islast) {
- s_wsfe(&io___981);
+#line 17007 ""
+ s_wsfe(&io___1022);
/* Writing concatenation */
+#line 17007 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 17007 ""
i__4[1] = 1, a__2[1] = "%";
+#line 17007 ""
s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80);
+#line 17007 ""
do_fio(&c__1, ch__1, lnote + 1);
+#line 17007 ""
e_wsfe();
+#line 17007 ""
}
/* Writing concatenation */
+#line 17008 ""
i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2);
+#line 17008 ""
i__5[1] = 1, a__3[1] = all_1.sq;
+#line 17008 ""
i__5[2] = 6, a__3[2] = "segnoo";
+#line 17008 ""
i__5[3] = lnoten, a__3[3] = noteq;
+#line 17008 ""
i__5[4] = 1, a__3[4] = "9";
+#line 17008 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 17010 ""
lnote = lnoten + 9;
+#line 17011 ""
} else {
/* Writing concatenation */
+#line 17012 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 17012 ""
i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2);
+#line 17012 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 17012 ""
i__3[3] = 6, a__1[3] = "segnoo";
+#line 17012 ""
i__3[4] = lnoten, a__1[4] = noteq;
+#line 17012 ""
i__3[5] = 1, a__1[5] = "9";
+#line 17012 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
+#line 17014 ""
lnote = lnote + lnoten + 9;
+#line 17015 ""
}
+#line 17016 ""
/* L130: */
+#line 17016 ""
}
+#line 17017 ""
if (comlast_1.islast) {
- s_wsfe(&io___982);
+#line 17017 ""
+ s_wsfe(&io___1023);
/* Writing concatenation */
+#line 17017 ""
i__6[0] = lnote, a__4[0] = notexq;
+#line 17017 ""
i__6[1] = 1, a__4[1] = all_1.sq;
+#line 17017 ""
i__6[2] = 2, a__4[2] = "en";
+#line 17017 ""
s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
+#line 17017 ""
do_fio(&c__1, ch__2, lnote + 3);
+#line 17017 ""
e_wsfe();
+#line 17017 ""
}
+#line 17018 ""
lnote = 0;
+#line 17019 ""
}
/* Check for new clefs */
+#line 17023 ""
isclef = FALSE_;
+#line 17024 ""
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 17029 ""
i__1 = istop[ib];
+#line 17029 ""
for (in = istart[ib]; in <= i__1; ++in) {
+#line 17030 ""
if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in -
1] * 24 - 25],11)) {
+#line 17031 ""
i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] +
all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7;
+#line 17031 ""
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 17037 ""
if (bit_test(all_1.ipl[all_1.ivxo[in - 1] + all_1.ipo[in
- 1] * 24 - 25],2)) {
+#line 17038 ""
if (all_1.iv <= 9) {
- s_wsfe(&io___985);
+#line 17039 ""
+ s_wsfe(&io___1026);
/* Writing concatenation */
+#line 17039 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17039 ""
i__4[1] = 19, a__2[1] = "settrebleclefsymbol";
+#line 17039 ""
s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20);
+#line 17039 ""
do_fio(&c__1, ch__3, (ftnlen)20);
- do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof(
+#line 17039 ""
+ do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 17039 ""
i__8[0] = 1, a__5[0] = all_1.sq;
+#line 17039 ""
i__8[1] = 13, a__5[1] = "treblelowoct%";
+#line 17039 ""
s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14);
+#line 17039 ""
do_fio(&c__1, ch__4, (ftnlen)14);
+#line 17039 ""
e_wsfe();
+#line 17041 ""
} else {
- s_wsfe(&io___986);
+#line 17042 ""
+ s_wsfe(&io___1027);
/* Writing concatenation */
+#line 17042 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17042 ""
i__4[1] = 19, a__2[1] = "settrebleclefsymbol";
+#line 17042 ""
s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20);
+#line 17042 ""
do_fio(&c__1, ch__3, (ftnlen)20);
- do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof(
+#line 17042 ""
+ do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 17042 ""
i__8[0] = 1, a__5[0] = all_1.sq;
+#line 17042 ""
i__8[1] = 13, a__5[1] = "treblelowoct%";
+#line 17042 ""
s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14);
+#line 17042 ""
do_fio(&c__1, ch__4, (ftnlen)14);
+#line 17042 ""
e_wsfe();
+#line 17044 ""
}
+#line 17045 ""
}
+#line 17046 ""
}
+#line 17047 ""
/* L140: */
+#line 17047 ""
}
+#line 17048 ""
if (comlast_1.islast) {
- s_wsfe(&io___987);
+#line 17048 ""
+ s_wsfe(&io___1028);
/* Writing concatenation */
+#line 17048 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17048 ""
i__4[1] = 11, a__2[1] = "pmxnewclefs";
+#line 17048 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
+#line 17048 ""
do_fio(&c__1, ch__5, (ftnlen)12);
+#line 17048 ""
e_wsfe();
+#line 17048 ""
}
+#line 17049 ""
isclef = TRUE_;
+#line 17050 ""
}
/* Start a notes group. We're just gonna define every one using pnotes{n}, */
/* where \def\pnotes#1{\vnotes#1\elemskip} */
/* Writing concatenation */
+#line 17055 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17055 ""
i__4[1] = 7, a__2[1] = "pnotes{";
+#line 17055 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
+#line 17056 ""
r__1 = comnsp_2.space[ib - 1] / squez[ib];
+#line 17056 ""
eonsqz = squez[ib] * feon_(&r__1);
+#line 17057 ""
if (eonsqz > 9.995f) {
- s_wsfi(&io___990);
+#line 17058 ""
+ s_wsfi(&io___1031);
+#line 17058 ""
do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
+#line 17058 ""
e_wsfi();
+#line 17059 ""
} else if (eonsqz > .995f) {
- s_wsfi(&io___991);
+#line 17060 ""
+ s_wsfi(&io___1032);
+#line 17060 ""
do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
+#line 17060 ""
e_wsfi();
+#line 17061 ""
} else if (eonsqz > .095f) {
/* Writing concatenation */
+#line 17062 ""
i__4[0] = 8, a__2[0] = soutq;
+#line 17062 ""
i__4[1] = 2, a__2[1] = "0.";
+#line 17062 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
- s_wsfi(&io___992);
+#line 17063 ""
+ s_wsfi(&io___1033);
+#line 17063 ""
r__1 = eonsqz * 100;
+#line 17063 ""
i__1 = i_nint(&r__1);
+#line 17063 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 17063 ""
e_wsfi();
+#line 17064 ""
} else {
/* Writing concatenation */
+#line 17065 ""
i__4[0] = 8, a__2[0] = soutq;
+#line 17065 ""
i__4[1] = 3, a__2[1] = "0.0";
+#line 17065 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
- s_wsfi(&io___993);
+#line 17066 ""
+ s_wsfi(&io___1034);
+#line 17066 ""
r__1 = eonsqz * 100;
+#line 17066 ""
i__1 = i_nint(&r__1);
+#line 17066 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 17066 ""
e_wsfi();
+#line 17067 ""
}
/* Writing concatenation */
+#line 17068 ""
i__4[0] = 12, a__2[0] = soutq;
+#line 17068 ""
i__4[1] = 1, a__2[1] = "}";
+#line 17068 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
+#line 17069 ""
lsout = 13;
/* Check whole block, flag accidentals etc that are too close, one per *time*. */
@@ -24910,52 +40490,87 @@ L81:
/* (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */
/* (dotsfac*wheadpt) is presumed to be filled up. */
+#line 17076 ""
in = istart[ib] - 1;
+#line 17077 ""
itrpt = -1;
+#line 17078 ""
itsig = -1;
/* Begin big manual loop over notes in this block; ends at 112 */
+#line 17082 ""
L111:
+#line 17082 ""
++in;
+#line 17083 ""
if (in > istop[ib]) {
+#line 17083 ""
goto L112;
+#line 17083 ""
}
+#line 17084 ""
ip = all_1.ipo[in - 1];
+#line 17085 ""
commvl_1.ivx = all_1.ivxo[in - 1];
+#line 17086 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 17087 ""
all_1.iv = commvl_1.ivx;
+#line 17088 ""
} else {
+#line 17089 ""
i__1 = all_1.nv;
+#line 17089 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 17090 ""
if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[
all_1.iv + 23] == commvl_1.ivx) {
+#line 17090 ""
goto L129;
+#line 17090 ""
}
+#line 17091 ""
/* L128: */
+#line 17091 ""
}
- s_wsle(&io___998);
+#line 17092 ""
+ s_wsle(&io___1039);
+#line 17092 ""
do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", (
ftnlen)35);
+#line 17092 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
+#line 17092 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof(
integer));
+#line 17092 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof(
integer));
+#line 17092 ""
e_wsle();
- s_wsle(&io___999);
+#line 17093 ""
+ s_wsle(&io___1040);
+#line 17093 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof(
integer));
+#line 17093 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof(
integer));
+#line 17093 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof(
integer));
+#line 17093 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof(
integer));
+#line 17093 ""
e_wsle();
+#line 17094 ""
s_stop("", (ftnlen)0);
+#line 17095 ""
}
+#line 17096 ""
L129:
/* Call precrd here so we know how much space to add for accid's in chords */
@@ -24969,47 +40584,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 17109 ""
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 17111 ""
beamon1[commvl_1.ivx - 1] = TRUE_;
+#line 17112 ""
}
+#line 17113 ""
icashft = 0;
+#line 17114 ""
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 17118 ""
if (beamon1[commvl_1.ivx - 1]) {
+#line 17119 ""
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 17122 ""
} else {
+#line 17123 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 17123 ""
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],
&commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
all_1.nv);
+#line 17123 ""
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 17127 ""
}
+#line 17128 ""
}
/* Turn beam off? */
+#line 17132 ""
if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[
commvl_1.ivx - 1] * 24 - 25] == ip) {
+#line 17133 ""
beamon1[commvl_1.ivx - 1] = FALSE_;
+#line 17134 ""
++ibmcnt1[commvl_1.ivx - 1];
+#line 17135 ""
}
/* Remember, rpts & internal sigs can only come at start of (internal) block */
+#line 17139 ""
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);
@@ -25018,6 +40651,7 @@ L129:
/* !!! Need to do this for chord notes too. Maybe in chkarp? */
+#line 17147 ""
isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0);
/* 5/15/02 Add check for ) ornament of prior note. */
@@ -25025,100 +40659,154 @@ L129:
/* if (ip .gt. 1) then */
/* isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */
/* end if */
+#line 17154 ""
isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27);
+#line 17155 ""
iscacc = FALSE_;
+#line 17156 ""
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 17161 ""
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 17163 ""
chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, &
iscacc, &isarp);
+#line 17164 ""
}
/* When we get motivated, will do spacing for arpeggios here. */
+#line 17168 ""
if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] &
96) > 0) {
+#line 17168 ""
itrpt = i_nint(&all_1.to[in - 1]);
+#line 17168 ""
}
+#line 17170 ""
issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28);
+#line 17171 ""
if (commvl_1.ivx == 1 && issig) {
+#line 17171 ""
itsig = i_nint(&all_1.to[in - 1]);
+#line 17171 ""
}
+#line 17172 ""
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 17174 ""
isgaft = FALSE_;
+#line 17175 ""
if (ip > 1) {
+#line 17176 ""
xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 -
25] - 1];
+#line 17177 ""
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 17178 ""
isgrace = isgrace || isgaft;
+#line 17179 ""
}
+#line 17180 ""
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 17184 ""
isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol;
+#line 17185 ""
if (isflag) {
+#line 17185 ""
i__7 = ip - 1;
+#line 17185 ""
i__1 = ncmid_(&all_1.iv, &i__7);
+#line 17185 ""
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], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
all_1.nv);
+#line 17185 ""
isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25]
,0) && *(unsigned char *)&ch__6[0] == 'u';
+#line 17185 ""
}
+#line 17189 ""
if (isflag) {
+#line 17190 ""
i__1 = numbms[commvl_1.ivx];
+#line 17190 ""
for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) {
+#line 17191 ""
if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) {
+#line 17192 ""
goto L117;
/* Add check for non-beamed xtuplets. May be problem with stem direction. */
+#line 17196 ""
} 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 17198 ""
isflag = FALSE_;
+#line 17199 ""
goto L117;
+#line 17200 ""
}
+#line 17201 ""
/* L116: */
+#line 17201 ""
}
+#line 17202 ""
}
+#line 17203 ""
L117:
/* If isflag, then won't need to check for dot on prev. note. */
/* 5/16/02 ??? Try using this for ) ornament. */
+#line 17209 ""
isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24
- 1],13);
+#line 17210 ""
isdot = ip > 1;
+#line 17211 ""
if (isdot) {
+#line 17211 ""
i__1 = ip - 1;
+#line 17211 ""
isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1);
+#line 17211 ""
}
+#line 17212 ""
isrshft = ip > 1;
+#line 17213 ""
if (isrshft) {
+#line 17213 ""
isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],
20);
+#line 17213 ""
}
+#line 17214 ""
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 17214 ""
goto L111;
+#line 17214 ""
}
/* Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */
@@ -25126,42 +40814,71 @@ L117:
/* 130324 */
/* wheadpt1 = wheadpt*fullsize(iv) */
+#line 17224 ""
wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[
all_1.iv - 1] - 1];
+#line 17225 ""
pts = wheadpt1;
/* Set up for possible cautionary accidental here */
+#line 17229 ""
if (isaccs || iscacc) {
+#line 17230 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) {
+#line 17231 ""
taccfac = spfacs_1.accfac;
+#line 17232 ""
} else {
+#line 17233 ""
taccfac = spfacs_1.accfac * 1.4f;
/* cautionary accidental */
+#line 17234 ""
}
+#line 17235 ""
}
+#line 17236 ""
if (isgrace) {
+#line 17237 ""
secondgrace = FALSE_;
+#line 17238 ""
i__1 = comgrace_1.ngrace;
+#line 17238 ""
for (ig = 1; ig <= i__1; ++ig) {
+#line 17239 ""
if (! isgaft) {
+#line 17240 ""
if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1]
== commvl_1.ivx) {
+#line 17240 ""
goto L123;
+#line 17240 ""
}
+#line 17241 ""
} else if (ip > 1) {
+#line 17242 ""
if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig
- 1] == commvl_1.ivx) {
+#line 17242 ""
goto L123;
+#line 17242 ""
}
+#line 17243 ""
}
+#line 17244 ""
/* L122: */
+#line 17244 ""
}
- s_wsle(&io___1019);
+#line 17245 ""
+ s_wsle(&io___1060);
+#line 17245 ""
do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", (
ftnlen)39);
+#line 17245 ""
e_wsle();
+#line 17246 ""
s_stop("", (ftnlen)0);
+#line 17247 ""
L123:
/* wgr = distance to backspace (in headwidths), less main acc. */
@@ -25169,87 +40886,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 17254 ""
if (comgrace_1.nng[ig - 1] == 1) {
+#line 17255 ""
wgr = spfacs_1.grafac;
+#line 17256 ""
if (comgrace_1.multg[ig - 1] == 0) {
+#line 17256 ""
wgr += -.4f;
+#line 17256 ""
}
+#line 17257 ""
} else {
+#line 17258 ""
wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
+#line 17259 ""
i__1 = comgrace_1.nng[ig - 1];
+#line 17259 ""
for (ing = 2; ing <= i__1; ++ing) {
+#line 17260 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing
- 1] > 0) {
+#line 17260 ""
wgr += spfacs_1.acgfac;
+#line 17260 ""
}
+#line 17261 ""
/* L126: */
+#line 17261 ""
}
+#line 17262 ""
}
+#line 17263 ""
if (comgrace_1.graspace[ig - 1] > 0.f) {
/* User-defined space before grace */
+#line 17267 ""
wgr += comgrace_1.graspace[ig - 1];
+#line 17268 ""
}
+#line 17269 ""
ptgr[ig - 1] = wgr * wheadpt1;
+#line 17270 ""
spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1;
/* !!! May need to mod for chord accid's */
+#line 17274 ""
if (isaccs || iscacc) {
+#line 17274 ""
ptgr[ig - 1] += taccfac * wheadpt1;
+#line 17274 ""
}
+#line 17275 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) {
+#line 17275 ""
spgr += wheadpt1 * spfacs_1.agc1fac;
+#line 17275 ""
}
+#line 17276 ""
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 17281 ""
if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) {
+#line 17282 ""
if (comgrace_1.ipg[ig] == ip) {
+#line 17283 ""
secondgrace = TRUE_;
+#line 17284 ""
++ig;
+#line 17285 ""
goto L123;
+#line 17286 ""
}
+#line 17287 ""
}
+#line 17288 ""
}
+#line 17289 ""
if (iscln) {
+#line 17290 ""
pts += spfacs_1.clefac * wheadpt1;
/* How far to backspace when printing the clef */
+#line 17294 ""
ptclef[commvl_1.ivx - 1] = 0.f;
/* !!! May need to mod for chord accid's */
+#line 17298 ""
if (isaccs || iscacc) {
+#line 17298 ""
ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1;
+#line 17298 ""
}
+#line 17300 ""
if (isgrace) {
+#line 17300 ""
ptclef[commvl_1.ivx - 1] += spgr;
+#line 17300 ""
}
+#line 17301 ""
}
+#line 17302 ""
if (isrshft) {
+#line 17303 ""
pts += spfacs_1.rtshfac * wheadpt1;
+#line 17304 ""
} else if (isflag) {
+#line 17305 ""
pts += spfacs_1.flagfac * wheadpt1;
+#line 17306 ""
} else if (isdot) {
+#line 17307 ""
pts += spfacs_1.dotfac * wheadpt1;
+#line 17308 ""
}
+#line 17309 ""
if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) {
/* Repeat, need a little extra space */
+#line 17313 ""
pts += spfacs_1.dotsfac * wheadpt1;
+#line 17314 ""
}
+#line 17315 ""
if (isarp) {
+#line 17316 ""
pts += spfacs_1.arpfac * wheadpt1;
+#line 17317 ""
}
/* Add in padding space */
+#line 17321 ""
pts += spfacs_1.xspfac * wheadpt1;
/* Now done with all items needing space except accidentals, */
@@ -25258,26 +41034,37 @@ L123:
/* Get available space in elemskips (esk) */
+#line 17329 ""
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 17331 ""
if (isfirst) {
/* At start of bar or after repeat sign or new signature */
+#line 17335 ""
if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol)
{
+#line 17336 ""
esk = 0.f;
+#line 17337 ""
} else {
+#line 17338 ""
esk = comask_1.fbar;
+#line 17339 ""
}
+#line 17340 ""
} else {
/* Not 1st note of bar */
+#line 17344 ""
esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
commvl_1.ivx + (ip - 1) * 24 - 25];
+#line 17345 ""
}
+#line 17346 ""
if (isgrace) {
/* Since graces can be very long, cannot assume no interference if prior */
@@ -25287,647 +41074,1059 @@ L123:
/* 10/8/05 Kluge to not zero out esk if in xtup */
+#line 17355 ""
esksav = esk;
/* Computing MAX */
+#line 17356 ""
i__1 = 1, i__7 = ip - 2;
+#line 17356 ""
if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__1,i__7) * 24 -
25] > 0) && (r__1 = all_1.to[in - 1] - itsig, dabs(r__1))
> comtol_1.tol) {
+#line 17356 ""
eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[
1], &comask_1.fbar, &itrpt, &esk);
+#line 17356 ""
}
/* * to(in).ne.itsig) */
+#line 17360 ""
if (dabs(esk) < comtol_1.tol) {
+#line 17360 ""
esk = esksav;
+#line 17360 ""
}
+#line 17361 ""
}
/* Done getting available elemskips. Remove headwidth if first. Must do here */
/* rather than earlier since check uses isfirst */
+#line 17366 ""
if (isfirst) {
+#line 17366 ""
pts -= wheadpt1;
+#line 17366 ""
}
/* Deal with accidental shifts and left-notehead shifts */
+#line 17370 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* In a chord */
+#line 17374 ""
ptsl = 0.f;
+#line 17375 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) {
+#line 17375 ""
ptsl = wheadpt1;
+#line 17375 ""
}
/* Computing MAX */
+#line 17376 ""
r__1 = ptsl, r__2 = icashft * .05f * wheadpt1;
+#line 17376 ""
ptsadd = dmax(r__1,r__2);
/* Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */
+#line 17380 ""
} else {
/* Not in a chord */
+#line 17384 ""
ihshft = 0;
+#line 17385 ""
if (isaccs) {
+#line 17386 ""
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 17388 ""
if (ihshft != 0) {
/* Computing MAX */
+#line 17388 ""
i__1 = 0, i__7 = 107 - ihshft;
+#line 17388 ""
ihshft = max(i__1,i__7);
+#line 17388 ""
}
+#line 17389 ""
}
/* Check for left-shifted main note */
+#line 17393 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
+#line 17393 ""
ihshft = max(20,ihshft);
+#line 17393 ""
}
+#line 17394 ""
ptsadd = ihshft * .05f * wheadpt1;
+#line 17395 ""
}
+#line 17396 ""
pts += ptsadd;
+#line 17397 ""
if (isgrace) {
+#line 17397 ""
ptgr[ig - 1] += ptsadd;
+#line 17397 ""
}
+#line 17398 ""
if (iscln) {
+#line 17398 ""
ptclef[commvl_1.ivx - 1] += ptsadd;
+#line 17398 ""
}
/* Left-shifted, non-chord note before? */
+#line 17402 ""
if (ip > 1) {
+#line 17403 ""
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 17403 ""
pts -= wheadpt1;
+#line 17403 ""
}
+#line 17405 ""
}
/* Try big accidentals first */
+#line 17409 ""
ptbneed = pts;
+#line 17410 ""
if (isaccs || iscacc) {
+#line 17411 ""
ptbneed += wheadpt1 * spfacs_1.bacfac;
+#line 17412 ""
}
+#line 17413 ""
if (comask_1.poenom * esk > ptbneed) {
/* Set flag for big accidental */
+#line 17417 ""
if (isacc) {
+#line 17417 ""
all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[
commvl_1.ivx + ip * 24 - 25],3);
+#line 17417 ""
}
+#line 17418 ""
goto L99;
+#line 17419 ""
}
/* Cannot use big, so try small */
+#line 17423 ""
ptsneed = pts;
+#line 17424 ""
if (isaccs || iscacc) {
+#line 17425 ""
ptsneed += taccfac * wheadpt1;
+#line 17426 ""
}
+/* if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, */
+/* * esk,fixednew,scaldold,0.,.false.) */
+#line 17429 ""
if (comask_1.poenom * esk < ptsneed) {
+#line 17430 ""
addask_(&all_1.to[in - 1], &ptsneed, &esk, &comask_1.fixednew, &
- comask_1.scaldold, &c_b774, &c_false);
+ comask_1.scaldold, &c_b1009, &c_false);
+#line 17432 ""
}
+#line 17433 ""
L99:
+#line 17434 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) {
/* User-defined space. Warning, "zero" may change value in addask! */
+#line 17438 ""
zero = 0.f;
+#line 17439 ""
addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, &
comask_1.scaldold, tglp1, &c_true);
+#line 17441 ""
}
/* End of big manual loop over "in" for accidental checking */
+#line 17445 ""
goto L111;
+#line 17446 ""
L112:
/* End of ask analysis for this block. */
/* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */
+#line 17452 ""
if (comas1_1.naskb > 0) {
+#line 17452 ""
adjusteskz_(&ib, &istart[1], &comask_1.poenom);
+#line 17452 ""
}
/* Check for internal repeat or sig change. */
+#line 17456 ""
if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) {
+#line 17457 ""
iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] &
67109216;
+#line 17458 ""
if (iirpt > 0) {
/* Internal repeat */
+#line 17462 ""
if (comlast_1.islast) {
- s_wsfe(&io___1035);
+#line 17462 ""
+ s_wsfe(&io___1076);
/* Writing concatenation */
+#line 17462 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 17462 ""
i__9[1] = 7, a__6[1] = "advance";
+#line 17462 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 17462 ""
i__9[3] = 8, a__6[3] = "barno-1%";
+#line 17462 ""
s_cat(ch__7, a__6, i__9, &c__4, (ftnlen)17);
+#line 17462 ""
do_fio(&c__1, ch__7, (ftnlen)17);
+#line 17462 ""
e_wsfe();
+#line 17462 ""
}
+#line 17463 ""
if (iirpt == 96) {
+#line 17464 ""
if (comlast_1.islast) {
- s_wsfe(&io___1036);
+#line 17464 ""
+ s_wsfe(&io___1077);
/* Writing concatenation */
+#line 17464 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17464 ""
i__4[1] = 15, a__2[1] = "leftrightrepeat";
+#line 17464 ""
s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)16);
+#line 17464 ""
do_fio(&c__1, ch__8, (ftnlen)16);
+#line 17464 ""
e_wsfe();
+#line 17464 ""
}
+#line 17465 ""
comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt;
+#line 17466 ""
} else if (bit_test(iirpt,5)) {
+#line 17467 ""
if (comlast_1.islast) {
- s_wsfe(&io___1037);
+#line 17467 ""
+ s_wsfe(&io___1078);
/* Writing concatenation */
+#line 17467 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17467 ""
i__4[1] = 10, a__2[1] = "leftrepeat";
+#line 17467 ""
s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11);
+#line 17467 ""
do_fio(&c__1, ch__9, (ftnlen)11);
+#line 17467 ""
e_wsfe();
+#line 17467 ""
}
+#line 17468 ""
comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
+#line 17469 ""
} else if (bit_test(iirpt,6)) {
+#line 17470 ""
if (comlast_1.islast) {
- s_wsfe(&io___1038);
+#line 17470 ""
+ s_wsfe(&io___1079);
/* Writing concatenation */
+#line 17470 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17470 ""
i__4[1] = 11, a__2[1] = "rightrepeat";
+#line 17470 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
+#line 17470 ""
do_fio(&c__1, ch__5, (ftnlen)12);
+#line 17470 ""
e_wsfe();
+#line 17470 ""
}
+#line 17471 ""
comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
+#line 17472 ""
} else if (bit_test(iirpt,8)) {
+#line 17473 ""
if (comlast_1.islast) {
- s_wsfe(&io___1039);
+#line 17473 ""
+ s_wsfe(&io___1080);
/* Writing concatenation */
+#line 17473 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17473 ""
i__4[1] = 9, a__2[1] = "doublebar";
+#line 17473 ""
s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10);
+#line 17473 ""
do_fio(&c__1, ch__10, (ftnlen)10);
+#line 17473 ""
e_wsfe();
+#line 17473 ""
}
+#line 17474 ""
} else {
- s_wsle(&io___1040);
- do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "
+#line 17475 ""
+ s_wsle(&io___1081);
+#line 17475 ""
+ do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "\
"R*", (ftnlen)36);
+#line 17475 ""
e_wsle();
+#line 17476 ""
stop1_();
+#line 17477 ""
}
+#line 17478 ""
comask_1.scaldold -= comask_1.fbar;
+#line 17479 ""
}
+#line 17480 ""
if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) {
/* Internal signature change. */
/* Writing concatenation */
+#line 17484 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17484 ""
i__4[1] = 17, a__2[1] = "generalsignature{";
+#line 17484 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17485 ""
lnote = 18;
+#line 17486 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
+#line 17487 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 17487 ""
i__4[1] = 1, a__2[1] = "-";
+#line 17487 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17488 ""
++lnote;
+#line 17489 ""
}
+#line 17490 ""
if (comlast_1.islast) {
- s_wsfe(&io___1041);
+#line 17490 ""
+ s_wsfe(&io___1082);
/* Writing concatenation */
+#line 17490 ""
i__6[0] = lnote, a__4[0] = notexq;
+#line 17490 ""
i__1 = abs(comtop_1.isig) + 48;
+#line 17490 ""
chax_(ch__6, (ftnlen)1, &i__1);
+#line 17490 ""
i__6[1] = 1, a__4[1] = ch__6;
+#line 17490 ""
i__6[2] = 2, a__4[2] = "}%";
+#line 17490 ""
s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
+#line 17490 ""
do_fio(&c__1, ch__2, lnote + 3);
+#line 17490 ""
e_wsfe();
+#line 17490 ""
}
+#line 17492 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
- s_wsfe(&io___1042);
+#line 17492 ""
+ s_wsfe(&io___1083);
/* Writing concatenation */
+#line 17492 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17492 ""
i__4[1] = 11, a__2[1] = "ignorenats%";
+#line 17492 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
+#line 17492 ""
do_fio(&c__1, ch__5, (ftnlen)12);
+#line 17492 ""
e_wsfe();
+#line 17492 ""
}
+#line 17494 ""
if (comlast_1.islast) {
- s_wsfe(&io___1043);
+#line 17494 ""
+ s_wsfe(&io___1084);
/* Writing concatenation */
+#line 17494 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 17494 ""
i__3[1] = 14, a__1[1] = "zchangecontext";
+#line 17494 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 17494 ""
i__3[3] = 12, a__1[3] = "addspace{-.5";
+#line 17494 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 17494 ""
i__3[5] = 15, a__1[5] = "afterruleskip}%";
+#line 17494 ""
s_cat(ch__11, a__1, i__3, &c__6, (ftnlen)44);
+#line 17494 ""
do_fio(&c__1, ch__11, (ftnlen)44);
+#line 17494 ""
e_wsfe();
+#line 17494 ""
}
+#line 17496 ""
lnote = 0;
+#line 17497 ""
}
+#line 17498 ""
}
+#line 17499 ""
comnsp_2.flgndb = FALSE_;
/* Done with start-of-block stuff. Begin main loop over voices. */
+#line 17503 ""
i__1 = all_1.nv;
+#line 17503 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 17504 ""
i__7 = commvl_1.nvmx[all_1.iv - 1];
+#line 17504 ""
for (kv = 1; kv <= i__7; ++kv) {
+#line 17505 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 17506 ""
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 17511 ""
if (all_1.figbass) {
+#line 17512 ""
ivf = 0;
+#line 17513 ""
if (commvl_1.ivx == 1) {
+#line 17514 ""
ivf = 1;
+#line 17515 ""
} else if (commvl_1.ivx == comfig_1.ivxfig2) {
+#line 17516 ""
ivf = 2;
+#line 17517 ""
}
+#line 17518 ""
if (ivf > 0) {
+#line 17518 ""
all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0;
+#line 17518 ""
}
+#line 17519 ""
}
+#line 17520 ""
if (commvl_1.ivx > 1) {
+#line 17521 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 17522 ""
addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq,
&lsout, (ftnlen)1, (ftnlen)80);
+#line 17523 ""
} else {
/* Writing concatenation */
+#line 17524 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17524 ""
i__4[1] = 9, a__2[1] = "nextvoice";
+#line 17524 ""
s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10);
+#line 17524 ""
addstr_(ch__10, &c__10, soutq, &lsout, (ftnlen)10, (
ftnlen)80);
+#line 17525 ""
}
+#line 17526 ""
}
+#line 17527 ""
if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) {
/* Write header. First adjust height if needed to miss barno. */
+#line 17531 ""
if (comask_1.bar1syst && all_1.iline != 1) {
+#line 17532 ""
comhead_1.ihdht = comsln_1.irzbnd + 15 +
comsln_1.isnx;
+#line 17533 ""
}
/* Add user-defined vertical shift */
+#line 17537 ""
comhead_1.ihdht += comhead_1.ihdvrt;
+#line 17538 ""
lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80);
/* Writing concatenation */
+#line 17539 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17539 ""
i__4[1] = 10, a__2[1] = "zcharnote{";
+#line 17539 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
- s_wsfi(&io___1047);
+#line 17540 ""
+ s_wsfi(&io___1088);
+#line 17540 ""
do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof(
integer));
+#line 17540 ""
e_wsfi();
/* Writing concatenation */
+#line 17541 ""
i__3[0] = 13, a__1[0] = notexq;
+#line 17541 ""
i__3[1] = 2, a__1[1] = "}{";
+#line 17541 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 17541 ""
i__3[3] = 7, a__1[3] = "bigfont";
+#line 17541 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 17541 ""
i__3[5] = 10, a__1[5] = "kern-30pt ";
+#line 17541 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
+#line 17542 ""
addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
/* Writing concatenation */
+#line 17543 ""
i__4[0] = lchead, a__2[0] = comhead_1.headrq;
+#line 17543 ""
i__4[1] = 1, a__2[1] = "}";
+#line 17543 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
+#line 17543 ""
i__10 = lchead + 1;
+#line 17543 ""
addstr_(ch__12, &i__10, soutq, &lsout, lchead + 1, (
ftnlen)80);
+#line 17544 ""
comhead_1.ihdht = 0;
+#line 17545 ""
}
+#line 17546 ""
if (comhead_1.lower && commvl_1.ivx == all_1.nv) {
+#line 17547 ""
lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80);
/* Writing concatenation */
+#line 17548 ""
i__11[0] = 1, a__7[0] = all_1.sq;
+#line 17548 ""
i__11[1] = 14, a__7[1] = "zcharnote{-6}{";
+#line 17548 ""
i__11[2] = 1, a__7[2] = all_1.sq;
+#line 17548 ""
i__11[3] = 5, a__7[3] = "tempo";
+#line 17548 ""
i__11[4] = 1, a__7[4] = all_1.sq;
+#line 17548 ""
i__11[5] = 10, a__7[5] = "kern-10pt ";
+#line 17548 ""
i__11[6] = lclow, a__7[6] = comhead_1.lowerq;
+#line 17548 ""
i__11[7] = 1, a__7[7] = "}";
+#line 17548 ""
s_cat(ch__13, a__7, i__11, &c__8, (ftnlen)113);
+#line 17548 ""
i__10 = lclow + 33;
+#line 17548 ""
addstr_(ch__13, &i__10, soutq, &lsout, lclow + 33, (
ftnlen)80);
+#line 17551 ""
comhead_1.lower = FALSE_;
+#line 17552 ""
}
+#line 17553 ""
tnow = tstart[ib];
+#line 17554 ""
nofirst = TRUE_;
/* Done setting up voice ivx for start of block ib. Loop over notes in voice. */
+#line 17558 ""
i__10 = istop[ib];
+#line 17558 ""
for (all_1.jn = istart[ib]; all_1.jn <= i__10; ++all_1.jn) {
+#line 17559 ""
if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) {
+#line 17559 ""
goto L10;
+#line 17559 ""
}
+#line 17560 ""
ip = all_1.ipo[all_1.jn - 1];
/* May have problem with not initializing islhgt, so do it here */
+#line 17564 ""
islhgt = 0;
+#line 17566 ""
if (nofirst) {
+#line 17567 ""
comoct_1.noctup = 0;
+#line 17568 ""
if (ncmid_(&all_1.iv, &ip) == 23) {
+#line 17568 ""
comoct_1.noctup = -2;
+#line 17568 ""
}
+#line 17569 ""
nofirst = FALSE_;
+#line 17570 ""
}
/* Check for internal floating figure (before last note of group). */
+#line 17574 ""
L12:
+#line 17574 ""
if (all_1.figbass) {
+#line 17575 ""
if (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
+#line 17576 ""
ivf = 1;
+#line 17577 ""
if (commvl_1.ivx > 1) {
+#line 17577 ""
ivf = 2;
+#line 17577 ""
}
+#line 17578 ""
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 17583 ""
offnsk = (tnow - comfig_1.itfig[ivf + (ifig[
ivf - 1] << 1) - 3]) / comnsp_2.space[
ib - 1];
+#line 17584 ""
putfig_(&ivf, &ifig[ivf - 1], &offnsk, &
all_1.figchk[ivf - 1], soutq, &lsout,
(ftnlen)80);
+#line 17586 ""
goto L12;
+#line 17587 ""
}
+#line 17588 ""
}
+#line 17589 ""
}
/* Put in \sk if needed */
+#line 17593 ""
if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) {
/* Writing concatenation */
+#line 17594 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17594 ""
i__4[1] = 2, a__2[1] = "sk";
+#line 17594 ""
s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3);
+#line 17594 ""
addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (
ftnlen)80);
+#line 17595 ""
tnow += comnsp_2.space[ib - 1];
+#line 17596 ""
goto L12;
+#line 17597 ""
}
/* Check for user-defined shifts */
+#line 17601 ""
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 17601 ""
putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, (
ftnlen)80);
+#line 17601 ""
}
+#line 17603 ""
L21:
+#line 17603 ""
if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow >
comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] -
comtol_1.tol) {
+#line 17605 ""
if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] >
tstart[ib] - comtol_1.tol) {
/* Insert placeholder for accidental skip */
/* Writing concatenation */
+#line 17609 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17609 ""
i__4[1] = 8, a__2[1] = "ask ";
+#line 17609 ""
s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)9);
+#line 17609 ""
addstr_(ch__15, &c__9, soutq, &lsout, (ftnlen)9, (
ftnlen)80);
+#line 17610 ""
++comas2_1.nasksys;
+#line 17611 ""
comas2_1.wasksys[comas2_1.nasksys - 1] =
comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1]
;
+#line 17612 ""
if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] >
0.f) {
+#line 17613 ""
comas2_1.elasksys[comas2_1.nasksys - 1] =
comas1_1.elask[iaskb[commvl_1.ivx - 1]
- 1];
+#line 17614 ""
} else {
/* This is a signal to permit negative ask's. Should really have elask>=0. */
+#line 17618 ""
comas2_1.elasksys[comas2_1.nasksys - 1] =
-comas1_1.elask[iaskb[commvl_1.ivx -
1] - 1];
+#line 17619 ""
}
+#line 17620 ""
}
/* May have skipped some task's in earlier blocks (due to void voice) */
+#line 17624 ""
++iaskb[commvl_1.ivx - 1];
+#line 17625 ""
goto L21;
+#line 17626 ""
}
+#line 17627 ""
if (all_1.figbass) {
+#line 17628 ""
if (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
+#line 17629 ""
ivf = 1;
+#line 17630 ""
if (commvl_1.ivx > 1) {
+#line 17630 ""
ivf = 2;
+#line 17630 ""
}
+#line 17631 ""
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. */
- putfig_(&ivf, &ifig[ivf - 1], &c_b774, &
+#line 17636 ""
+ putfig_(&ivf, &ifig[ivf - 1], &c_b1009, &
all_1.figchk[ivf - 1], soutq, &lsout,
(ftnlen)80);
+#line 17637 ""
}
+#line 17638 ""
}
+#line 17639 ""
}
/* Check for new clef here. */
+#line 17643 ""
if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24
- 25],11)) {
-/* print*,'At clef insertion, ptclef:',ptclef(iv) */
+#line 17644 ""
if (ptclef[all_1.iv - 1] > 0.f) {
/* Writing concatenation */
+#line 17645 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17645 ""
i__4[1] = 5, a__2[1] = "off{-";
+#line 17645 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17646 ""
if (ptclef[all_1.iv - 1] < 9.95f) {
- s_wsfi(&io___1053);
+#line 17647 ""
+ s_wsfi(&io___1094);
+#line 17647 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
+#line 17647 ""
e_wsfi();
+#line 17648 ""
lnote = 9;
+#line 17649 ""
} else {
- s_wsfi(&io___1054);
+#line 17650 ""
+ s_wsfi(&io___1095);
+#line 17650 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
+#line 17650 ""
e_wsfi();
+#line 17651 ""
lnote = 10;
+#line 17652 ""
}
/* Writing concatenation */
+#line 17653 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 17653 ""
i__4[1] = 3, a__2[1] = "pt}";
+#line 17653 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17654 ""
lnote += 3;
+#line 17655 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
(ftnlen)80);
-/* print*,'Just added: ',notexq(1:lnote) */
+#line 17656 ""
}
+#line 17657 ""
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 17661 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],2)
) {
/* Writing concatenation */
+#line 17661 ""
i__6[0] = 8, a__4[0] = notexq;
+#line 17661 ""
i__6[1] = 1, a__4[1] = "8";
+#line 17661 ""
i__6[2] = 1, a__4[2] = notexq + 9;
+#line 17661 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79);
+#line 17661 ""
}
+#line 17663 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 17664 ""
if (ptclef[all_1.iv - 1] > 0.f) {
/* Writing concatenation */
+#line 17665 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17665 ""
i__4[1] = 4, a__2[1] = "off{";
+#line 17665 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17666 ""
if (ptclef[all_1.iv - 1] < 9.95f) {
- s_wsfi(&io___1056);
+#line 17667 ""
+ s_wsfi(&io___1097);
+#line 17667 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
+#line 17667 ""
e_wsfi();
+#line 17668 ""
lnote = 8;
+#line 17669 ""
} else {
- s_wsfi(&io___1057);
+#line 17670 ""
+ s_wsfi(&io___1098);
+#line 17670 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
+#line 17670 ""
e_wsfi();
+#line 17671 ""
lnote = 9;
+#line 17672 ""
}
/* Writing concatenation */
+#line 17673 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 17673 ""
i__4[1] = 3, a__2[1] = "pt}";
+#line 17673 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 17674 ""
lnote += 3;
+#line 17675 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
(ftnlen)80);
+#line 17676 ""
}
+#line 17677 ""
}
/* Checking for literal TeX string BEFORE starting beams!! */
+#line 17681 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16))
{
+#line 17682 ""
i__12 = comgrace_1.nlit;
+#line 17682 ""
for (il = 1; il <= i__12; ++il) {
+#line 17683 ""
if (comgrace_1.iplit[il - 1] == ip &&
comgrace_1.ivlit[il - 1] == commvl_1.ivx)
{
+#line 17683 ""
goto L125;
+#line 17683 ""
}
+#line 17684 ""
/* L124: */
+#line 17684 ""
}
- s_wsle(&io___1059);
- do_lio(&c__9, &c__1, "Problem finding index for lite"
+#line 17685 ""
+ s_wsle(&io___1100);
+#line 17685 ""
+ do_lio(&c__9, &c__1, "Problem finding index for lite"\
"ral string", (ftnlen)40);
+#line 17685 ""
e_wsle();
+#line 17686 ""
stop1_();
+#line 17687 ""
L125:
/* Write a type 1 tex string. */
+#line 17691 ""
if (comgrace_1.lenlit[il - 1] < 71) {
/* Add normally */
+#line 17695 ""
addstr_(comgrace_1.litq + (il - 1 << 7), &
comgrace_1.lenlit[il - 1], soutq, &lsout,
(ftnlen)128, (ftnlen)80);
+#line 17696 ""
} else {
/* Longer than 71. Write souq, Write string, start new soutq. */
+#line 17700 ""
if (comlast_1.islast) {
- s_wsfe(&io___1060);
+#line 17700 ""
+ s_wsfe(&io___1101);
/* Writing concatenation */
+#line 17700 ""
i__4[0] = lsout, a__2[0] = soutq;
+#line 17700 ""
i__4[1] = 1, a__2[1] = "%";
+#line 17700 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
+#line 17700 ""
do_fio(&c__1, ch__12, lsout + 1);
+#line 17700 ""
e_wsfe();
+#line 17700 ""
}
+#line 17701 ""
if (comlast_1.islast) {
- s_wsfe(&io___1061);
+#line 17701 ""
+ s_wsfe(&io___1102);
/* Writing concatenation */
+#line 17701 ""
i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] =
comgrace_1.litq + (il - 1 << 7);
+#line 17701 ""
i__4[1] = 1, a__2[1] = "%";
+#line 17701 ""
s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)129);
+#line 17701 ""
do_fio(&c__1, ch__16, comgrace_1.lenlit[il -
1] + 1);
+#line 17701 ""
e_wsfe();
+#line 17701 ""
}
+#line 17702 ""
lsout = 0;
+#line 17703 ""
}
+#line 17704 ""
}
/* Arpeggio on a main (non-chordal) note? */
+#line 17708 ""
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 17710 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17710 ""
putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &i__12, soutq, &
lsout, (ftnlen)80);
+#line 17712 ""
}
/* See if a beam starts here */
+#line 17716 ""
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 17719 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],24)) {
/* Not a jump start */
+#line 17723 ""
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 17723 ""
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,
@@ -25936,80 +42135,117 @@ L125:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
+#line 17723 ""
}
+#line 17729 ""
beamstrt_(notexq, &lnote, nornb, ihornb,
comnsp_2.space, &squez[1], &ib, (ftnlen)
79);
/* Shift beam start if notehead was shifted */
+#line 17733 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],8)) {
/* Writing concatenation */
+#line 17734 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17734 ""
i__4[1] = 5, a__2[1] = "loff{";
+#line 17734 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
+#line 17734 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)
6, (ftnlen)80);
+#line 17735 ""
} else if (bit_test(all_1.ipl[commvl_1.ivx + ip *
24 - 25],9)) {
/* Writing concatenation */
+#line 17736 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 17736 ""
i__4[1] = 5, a__2[1] = "roff{";
+#line 17736 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
+#line 17736 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)
6, (ftnlen)80);
+#line 17737 ""
}
+#line 17738 ""
if (lnote > 0) {
+#line 17738 ""
addstr_(notexq, &lnote, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
+#line 17738 ""
}
+#line 17739 ""
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 17739 ""
addstr_("}", &c__1, soutq, &lsout, (ftnlen)1,
(ftnlen)80);
+#line 17739 ""
}
+#line 17741 ""
} 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 17746 ""
combjmp_1.ivbj2 = commvl_1.ivx;
/* Check for xtup since we bypassed beamstrt wherein vxtup is normally set */
+#line 17750 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],28) && strtmid_1.ixrest[commvl_1.ivx
- 1] != 2) {
+#line 17750 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
+#line 17750 ""
}
/* 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 17757 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
+#line 17758 ""
}
+#line 17759 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
+#line 17760 ""
all_1.beamon[commvl_1.ivx - 1] = TRUE_;
+#line 17761 ""
bspend = TRUE_;
+#line 17762 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
- 25],24)) {
+#line 17762 ""
bspend = TRUE_;
+#line 17762 ""
}
+#line 17763 ""
}
+#line 17764 ""
}
/* Setup for chords and possible slurs in chords */
+#line 17768 ""
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 17774 ""
if (all_1.beamon[commvl_1.ivx - 1]) {
+#line 17775 ""
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[
@@ -26018,42 +42254,57 @@ L125:
all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &c_true, &
icashft, (ftnlen)1);
+#line 17778 ""
} else {
+#line 17779 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17779 ""
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 17779 ""
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 17783 ""
}
+#line 17784 ""
}
/* Is there slur or grace activity? */
+#line 17788 ""
isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 -
25],4);
+#line 17789 ""
if (ip > 1) {
+#line 17789 ""
isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx
+ (ip - 1) * 24 - 25],31);
+#line 17789 ""
}
/* isgrace if not 1st note in bar and previous note has Way-after grace. */
+#line 17793 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0)
|| isgrace) {
+#line 17794 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
0)) {
+#line 17795 ""
if (comslur_1.fontslur) {
/* Call routine for non-postscript slurs */
+#line 17799 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17799 ""
doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 -
25], all_1.isdat1, all_1.isdat2,
all_1.isdat3, &all_1.nsdat, &ip, &
@@ -26070,11 +42321,14 @@ L125:
- 25] - 1], &all_1.nacc[commvl_1.ivx
+ ip * 24 - 25], (ftnlen)80, (ftnlen)
1);
+#line 17804 ""
} else {
/* Postscript slurs */
+#line 17808 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17808 ""
dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24
- 25], all_1.isdat1, all_1.isdat2,
all_1.isdat3, all_1.isdat4, &
@@ -26091,21 +42345,33 @@ L125:
commvl_1.ivx + ip * 24 - 25] - 1], &
all_1.nacc[commvl_1.ivx + ip * 24 -
25], (ftnlen)80, (ftnlen)1);
+#line 17814 ""
}
+#line 17815 ""
}
+#line 17816 ""
if (isgrace) {
/* Grace note. */
+#line 17820 ""
iphold = ip;
+#line 17821 ""
isgrace = FALSE_;
+#line 17822 ""
if (ip > 1) {
+#line 17822 ""
isgrace = bit_test(all_1.ipl[commvl_1.ivx + (
ip - 1) * 24 - 25],31);
+#line 17822 ""
}
+#line 17823 ""
if (isgrace) {
+#line 17823 ""
--iphold;
+#line 17823 ""
}
+#line 17824 ""
isgrace = isgrace || ! bit_test(all_1.ipl[
commvl_1.ivx + ip * 24 - 25],31) && !
bit_test(all_1.ipl[commvl_1.ivx + ip * 24
@@ -26114,9 +42380,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 17830 ""
if (isgrace) {
+#line 17831 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17831 ""
i__13 = ncmid_(&all_1.iv, &ip);
+#line 17831 ""
dograce_(&commvl_1.ivx, &iphold, ptgr, soutq,
&lsout, &i__12, &all_1.nacc[
commvl_1.ivx + ip * 24 - 25], &ig, &
@@ -26133,153 +42403,233 @@ L125:
all_1.iv - 1], (ftnlen)80, (ftnlen)1);
/* 130324 */
/* * tnote(ipl2(ivx,ip)),ulq) */
+#line 17838 ""
if (comgrace_1.slurg[ig - 1]) {
/* Terminate slur started in dograce. Get direction of main note stem */
+#line 17842 ""
if (! all_1.beamon[commvl_1.ivx - 1]) {
/* Separate note. Get stem direction. */
+#line 17846 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17846 ""
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 17846 ""
stemup = *(unsigned char *)&ch__6[0]
== 'u';
+#line 17848 ""
} else {
/* In a beam */
+#line 17852 ""
stemup = *(unsigned char *)&all_1.ulq[
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25]
== 'u';
+#line 17853 ""
}
/* Stop the shift if whole note */
+#line 17857 ""
stemup = stemup || all_1.tnote[
comipl2_1.ipl2[commvl_1.ivx + ip *
24 - 25] - 1] > 63.f;
+#line 17859 ""
L__1 = ! comgrace_1.upg[ig - 1];
+#line 17859 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17859 ""
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 17861 ""
}
+#line 17862 ""
}
+#line 17863 ""
}
+#line 17864 ""
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 17869 ""
i__12 = 16777215 - comslur_1.listslur;
+#line 17869 ""
comslur_1.ndxslur = log2_(&i__12);
/* Get note name */
+#line 17873 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17873 ""
notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__12, (ftnlen)8);
/* Get slur direction */
+#line 17877 ""
*(unsigned char *)slurudq = 'u';
+#line 17878 ""
if (! all_1.beamon[commvl_1.ivx - 1]) {
+#line 17879 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17879 ""
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 17879 ""
if (*(unsigned char *)&ch__6[0] == 'u') {
+#line 17879 ""
*(unsigned char *)slurudq = 'd';
+#line 17879 ""
}
+#line 17881 ""
} else {
+#line 17882 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24
- 25] == 'u') {
+#line 17882 ""
*(unsigned char *)slurudq = 'd';
+#line 17882 ""
}
+#line 17883 ""
}
/* c Replace ndxslur by 11-ndxslur when printing only. */
/* Replace ndxslur by 23-ndxslur when printing only. */
/* if (11-ndxslur .lt. 10) then */
+#line 17889 ""
if (23 - comslur_1.ndxslur < 10) {
/* notexq = sq//'islur'//slurudq//chax(59-ndxslur) */
/* Writing concatenation */
+#line 17891 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 17891 ""
i__5[1] = 5, a__3[1] = "islur";
+#line 17891 ""
i__5[2] = 1, a__3[2] = slurudq;
+#line 17891 ""
i__12 = 71 - comslur_1.ndxslur;
+#line 17891 ""
chax_(ch__6, (ftnlen)1, &i__12);
+#line 17891 ""
i__5[3] = 1, a__3[3] = ch__6;
+#line 17891 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 17891 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 17893 ""
i__12 = lnoten + 8;
+#line 17893 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
+#line 17894 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
+#line 17895 ""
i__14[0] = 1, a__8[0] = all_1.sq;
+#line 17895 ""
i__14[1] = 5, a__8[1] = "islur";
+#line 17895 ""
i__14[2] = 1, a__8[2] = slurudq;
+#line 17895 ""
i__14[3] = 2, a__8[3] = "{1";
+#line 17895 ""
i__12 = 61 - comslur_1.ndxslur;
+#line 17895 ""
chax_(ch__6, (ftnlen)1, &i__12);
+#line 17895 ""
i__14[4] = 1, a__8[4] = ch__6;
+#line 17895 ""
i__14[5] = 1, a__8[5] = "}";
+#line 17895 ""
i__14[6] = lnoten, a__8[6] = noteq;
+#line 17895 ""
s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79);
+#line 17897 ""
i__12 = lnoten + 11;
+#line 17897 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
+#line 17898 ""
} else {
/* Writing concatenation */
+#line 17899 ""
i__14[0] = 1, a__8[0] = all_1.sq;
+#line 17899 ""
i__14[1] = 5, a__8[1] = "islur";
+#line 17899 ""
i__14[2] = 1, a__8[2] = slurudq;
+#line 17899 ""
i__14[3] = 2, a__8[3] = "{2";
+#line 17899 ""
i__12 = 51 - comslur_1.ndxslur;
+#line 17899 ""
chax_(ch__6, (ftnlen)1, &i__12);
+#line 17899 ""
i__14[4] = 1, a__8[4] = ch__6;
+#line 17899 ""
i__14[5] = 1, a__8[5] = "}";
+#line 17899 ""
i__14[6] = lnoten, a__8[6] = noteq;
+#line 17899 ""
s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79);
+#line 17901 ""
i__12 = lnoten + 11;
+#line 17901 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
+#line 17902 ""
}
/* call setbits(ipl(ivx,ip),4,23,ndxslur) */
+#line 17904 ""
setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25],
&c__5, &c__23, &comslur_1.ndxslur);
+#line 17905 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],31)) {
+#line 17905 ""
comslur_1.listslur = bit_set(
comslur_1.listslur,comslur_1.ndxslur);
+#line 17905 ""
}
/* Starting slur on W-grace on THIS note. Record ndxslur. */
+#line 17910 ""
}
+#line 17911 ""
}
/* Process dynamic marks */
+#line 17915 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26))
{
+#line 17916 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17916 ""
L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64;
+#line 17916 ""
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[
@@ -26289,10 +42639,12 @@ 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 17920 ""
}
/* Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. */
+#line 17924 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* Need a duration to set type of note head */
@@ -26301,20 +42653,61 @@ L125:
/* Clumsy test, but vxtup is not set until main note is processed. */
+#line 17932 ""
if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],28)))
{
+#line 17933 ""
nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-/* else if (mult(ivx,ip) .lt. 0) then */
+/* c else if (iand(mult(ivx,ip),15)-8 .lt. 0) then */
+/* else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or. */
+/* * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or. */
+/* * (ip.gt.1.and.btest(irest(ivx,ip-1),2) */
+/* * .and.nodur(ivx,ip).eq.32)) then */
+/* nodu = 32 */
+/* else */
+/* nodu = 16 */
+/* end if */
+#line 17943 ""
+ } 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 17948 ""
+ if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
+ 25],2)) {
+
+/* First note of tremolo, duration is on next note */
+
+#line 17952 ""
+ nodu = all_1.nodur[commvl_1.ivx + (ip + 1) *
+ 24 - 25];
+#line 17953 ""
+ } else {
+#line 17954 ""
+ nodu = all_1.nodur[commvl_1.ivx + ip * 24 -
+ 25];
+#line 17955 ""
+ }
+#line 17956 ""
} else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] &
15) - 8 < 0) {
+#line 17957 ""
nodu = 32;
+#line 17958 ""
} else {
+#line 17959 ""
nodu = 16;
+#line 17960 ""
}
+#line 17961 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 17961 ""
L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 -
25],27);
+#line 17961 ""
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
@@ -26322,22 +42715,29 @@ L125:
&all_1.nv, &all_1.beamon[commvl_1.ivx - 1], &
all_1.nolev[commvl_1.ivx + ip * 24 - 25],
ihornb, nornb, &all_1.stemlen, &L__1, &
- all_1.nacc[commvl_1.ivx + ip * 24 - 25], (
- ftnlen)80, (ftnlen)1);
+ all_1.nacc[commvl_1.ivx + ip * 24 - 25],
+ all_1.irest, (ftnlen)80, (ftnlen)1);
+#line 17966 ""
}
/* Now that chords are done, add stuff to midi file */
+#line 17970 ""
if (commidi_1.ismidi) {
+#line 17970 ""
i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] +
commvel_1.miditran[cominsttrans_1.instno[
all_1.iv - 1] - 1];
+#line 17970 ""
i__13 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7;
+#line 17970 ""
L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],0);
+#line 17970 ""
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 17970 ""
}
/* 130316 */
/* * nolev(ivx,ip)-iTransAmt(instno(iv)), */
@@ -26345,12 +42745,16 @@ L125:
/* Check for breath or caesura */
+#line 17981 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28))
{
+#line 17982 ""
putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79)
;
+#line 17983 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 17984 ""
}
/* Check for main-note ornaments. ')' on dotted notes go in with note, not here. */
@@ -26359,53 +42763,73 @@ L125:
/* isacc = iand(iornq(ivx,ip),4194287) .gt. 0 */
/* isacc = iand(iornq(ivx,ip),541065199) .gt. 0 */
+#line 17992 ""
isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
1614807023) > 0;
/* isacc=.true. if any ornament except segno */
+#line 17996 ""
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 18000 ""
i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
25]);
+#line 18000 ""
if (pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx
+ ip * 24 - 25]) {
+#line 18001 ""
if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
516079) == 0) {
/* ). is the only non-segno ornament */
+#line 18005 ""
isacc = FALSE_;
+#line 18006 ""
} else {
/* There are other ornaments in addition */
+#line 18010 ""
rpndot = TRUE_;
+#line 18011 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] =
bit_clear(all_1.iornq[commvl_1.ivx +
ip * 24 - 1],13);
+#line 18012 ""
}
+#line 18013 ""
}
+#line 18014 ""
}
+#line 18015 ""
if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
/* Check for centered whole-bar rest with fermata (bits 10 or 14). */
+#line 18019 ""
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 18023 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_;
+#line 18024 ""
goto L30;
+#line 18025 ""
}
+#line 18026 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 18026 ""
L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
,10);
+#line 18026 ""
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], &
@@ -26417,45 +42841,66 @@ L125:
all_1.stemlen, notexq, &lnote, &ip, &islhgt, &
all_1.beamon[commvl_1.ivx - 1], &L__1, (
ftnlen)1, (ftnlen)79);
+#line 18031 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 18032 ""
}
+#line 18033 ""
if (rpndot) {
+#line 18034 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
all_1.iornq[commvl_1.ivx + ip * 24 - 1],13);
+#line 18035 ""
rpndot = FALSE_;
+#line 18036 ""
}
+#line 18037 ""
L30:
/* Check for main note accidental */
+#line 18041 ""
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 18043 ""
ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
- 25], &c__7, &c__10);
+#line 18044 ""
if (ihshft != 0) {
+#line 18044 ""
ihshft += -107;
+#line 18044 ""
}
+#line 18045 ""
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 18045 ""
ihshft += -20;
+#line 18045 ""
}
/* Not a chord, and left-shifted main note, so left-shift accid */
+#line 18050 ""
i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
- 25], &c__6, &c__4);
+#line 18050 ""
i__13 = ncmid_(&all_1.iv, &ip);
+#line 18050 ""
L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],31);
+#line 18050 ""
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 18053 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 18054 ""
}
/* Lower dot for lower-voice notes. Conditions are: */
@@ -26466,111 +42911,158 @@ L30:
/* . 5. Flag (lowdot) is set to true */
/* 6. Not in an xtuplet */
+#line 18064 ""
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 18066 ""
i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
25]);
+#line 18066 ""
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 18069 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],19)) {
/* Note already in movdot list. Drop by 2. */
+#line 18073 ""
comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[
commvl_1.ivx - 1] + 1) * 24 - 25] +=
-2.f;
+#line 18075 ""
} else {
/* Not in list so just move it right now */
+#line 18079 ""
i__12 = igetbits_(&all_1.islur[commvl_1.ivx +
ip * 24 - 25], &c__1, &c__3);
- dotmov_(&c_b773, &c_b774, soutq, &lsout, &
+#line 18079 ""
+ dotmov_(&c_b1008, &c_b1009, soutq, &lsout, &
i__12, (ftnlen)80);
+#line 18081 ""
}
+#line 18082 ""
}
+#line 18083 ""
}
-/* Check for dotted notes with moved dots */
+/* 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 18089 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19))
{
+#line 18090 ""
++comcc_1.ndotmv[commvl_1.ivx - 1];
+#line 18091 ""
i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24
- 25], &c__1, &c__3);
+#line 18091 ""
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 18093 ""
}
/* Stemlength changes */
+#line 18097 ""
if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27))
{
+#line 18098 ""
dstemlen = igetbits_(&all_1.mult[commvl_1.ivx + ip *
24 - 25], &c__6, &c__10) * .5f - 4.f;
+#line 18099 ""
stemshort = dstemlen * .667f + 4.66f;
/* Writing concatenation */
+#line 18100 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18100 ""
i__4[1] = 11, a__2[1] = "stemlength{";
+#line 18100 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
+#line 18100 ""
addstr_(ch__5, &c__12, soutq, &lsout, (ftnlen)12, (
ftnlen)80);
- s_wsfi(&io___1069);
+#line 18101 ""
+ s_wsfi(&io___1110);
+#line 18101 ""
do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real)
);
+#line 18101 ""
e_wsfi();
/* Writing concatenation */
+#line 18102 ""
i__4[0] = 4, a__2[0] = notexq;
+#line 18102 ""
i__4[1] = 1, a__2[1] = "}";
+#line 18102 ""
s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5);
+#line 18102 ""
addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (
ftnlen)80);
+#line 18103 ""
} else if (ip > 1) {
+#line 18104 ""
if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24
- 25],27)) {
/* Writing concatenation */
+#line 18104 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18104 ""
i__4[1] = 16, a__2[1] = "stemlength{4.66}";
+#line 18104 ""
s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)17);
+#line 18104 ""
addstr_(ch__7, &c__17, soutq, &lsout, (ftnlen)17,
(ftnlen)80);
+#line 18104 ""
}
/* Cancel shortening. Looks like it gets automatically restored if new inst. or */
/* new line, so no need to worry about affecting other lines */
+#line 18110 ""
}
/* Zero out slur-height marker for raising ornaments */
+#line 18114 ""
islhgt = 0;
/* Now start with spacing notes. Is a beam start pending? */
+#line 18118 ""
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 18120 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
/* Special path for single note at end of otherwise beamed xtup */
+#line 18124 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
+#line 18125 ""
} else {
+#line 18126 ""
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 18126 ""
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,
@@ -26579,58 +43071,84 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
+#line 18126 ""
}
+#line 18132 ""
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 18134 ""
chax_(ch__6, (ftnlen)1, &c__92);
+#line 18134 ""
i__4[0] = 1, a__2[0] = ch__6;
+#line 18134 ""
i__4[1] = 2, a__2[1] = "sk";
+#line 18134 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18135 ""
lnote = 3;
+#line 18136 ""
} else {
+#line 18137 ""
beamn1_(notexq, &lnote, (ftnlen)79);
+#line 18138 ""
}
+#line 18139 ""
}
+#line 18140 ""
bspend = FALSE_;
/* Is a beam ending? */
+#line 18144 ""
} 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))) {
/* * .and. ibm2(ivx,ibmcnt(ivx)) .eq. ip) then */
+#line 18148 ""
if (bspend) {
/* Must be a single-note ending of a jump-beam */
+#line 18152 ""
bspend = FALSE_;
+#line 18153 ""
}
+#line 18154 ""
beamend_(notexq, &lnote, (ftnlen)79);
+#line 18155 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25]
,20)) {
+#line 18156 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
+#line 18157 ""
nornb[commvl_1.ivx - 1] = 0;
+#line 18158 ""
++all_1.ibmcnt[commvl_1.ivx - 1];
+#line 18159 ""
all_1.beamon[commvl_1.ivx - 1] = FALSE_;
+#line 18160 ""
}
/* Or if we're in the middle of a beam */
+#line 18164 ""
} else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[
commvl_1.ivx - 1]) {
/* Added 130127 */
+#line 18168 ""
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 18168 ""
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, &
@@ -26639,11 +43157,14 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
+#line 18168 ""
}
+#line 18174 ""
beamid_(notexq, &lnote, (ftnlen)79);
/* Or whole-bar rest */
+#line 18178 ""
} 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 &&
@@ -26654,12 +43175,18 @@ L30:
/* Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp */
+#line 18186 ""
cwrest[commvl_1.ivx] = TRUE_;
+#line 18187 ""
iscwr = TRUE_;
+#line 18188 ""
notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[
commvl_1.ivx - 1], (ftnlen)79);
+#line 18189 ""
tnow += all_1.lenbar;
+#line 18190 ""
goto L10;
+#line 18191 ""
} else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
/* Before writing note or rest, check for keyboard rest height adjustment. */
@@ -26667,103 +43194,15 @@ L30:
/* 1. kbdrests = .true. */
/* 2. There are two voices on the staff */
/* 3. No user-def height adjustments have been applied (nolev<50) */
-/* c 4. Not last note in bar */
-/* c 5. Followed by note (add better test later) */
+#line 18199 ""
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) {
-/* * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) */
-/* * .and. .not.(btest(irest(ivx,ip+1),0))) then */
-
-/* 130127 Replaced following code with a subroutine */
-
-/* c Get reference level: next following note if no intervening blank rests, */
-/* c otherwise next prior note. */
-/* c */
-/* c levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line */
-/* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) 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 */
-/* if (ip .eq. 1) go to 2 ! 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 */
-/* go to 2 ! 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 */
-/* go to 2 */
-/* end if */
-/* levother = -iupdown*50 */
-/* end if */
-/* 7 continue */
-/* indxr = log2(nodur(ivx,ip))+1 */
-/* 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 */
-
-/* The new subroutine call, to replace above code */
-
+#line 18202 ""
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, &
@@ -26772,50 +43211,199 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
+#line 18205 ""
+ }
+#line 18206 ""
+ 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 18211 ""
+ i__12 = ncmid_(&all_1.iv, &ip);
+#line 18211 ""
+ 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 18211 ""
+ if (*(unsigned char *)&ch__6[0] == 'u') {
+#line 18213 ""
+ *(unsigned char *)udq = 'u';
+#line 18214 ""
+ } else {
+#line 18215 ""
+ *(unsigned char *)udq = 'l';
+#line 18216 ""
+ }
+#line 18217 ""
+ multtrem = igetbits_(&all_1.ipl[commvl_1.ivx + ip
+ * 24 - 25], &c__2, &c__5) + 1;
+#line 18218 ""
+ if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] < 64)
+ {
+/* Writing concatenation */
+#line 18219 ""
+ i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18219 ""
+ i__4[1] = 2, a__2[1] = "tr";
+#line 18219 ""
+ s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18220 ""
+ } else {
+/* Writing concatenation */
+#line 18221 ""
+ i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18221 ""
+ i__4[1] = 2, a__2[1] = "Tr";
+#line 18221 ""
+ s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18222 ""
+ }
+#line 18223 ""
+ lnote = 3;
+#line 18224 ""
+ if (multtrem == 2) {
+/* Writing concatenation */
+#line 18225 ""
+ i__4[0] = 3, a__2[0] = notexq;
+#line 18225 ""
+ i__4[1] = 1, a__2[1] = "r";
+#line 18225 ""
+ s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18226 ""
+ lnote = 4;
+#line 18227 ""
+ } else if (multtrem == 3) {
+/* Writing concatenation */
+#line 18228 ""
+ i__4[0] = 3, a__2[0] = notexq;
+#line 18228 ""
+ i__4[1] = 2, a__2[1] = "rr";
+#line 18228 ""
+ s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18229 ""
+ lnote = 5;
+#line 18230 ""
+ }
+
+/* Get a numerical pitch argument */
+
+#line 18234 ""
+ lineno = all_1.nolev[commvl_1.ivx + ip * 24 - 25]
+ - ncmid_(&all_1.iv, &ip) + 4;
+#line 18235 ""
+ if (lineno < 0 || lineno > 9) {
+#line 18236 ""
+ s_wsfi(&io___1116);
+#line 18236 ""
+ do_fio(&c__1, "{", (ftnlen)1);
+#line 18236 ""
+ do_fio(&c__1, (char *)&lineno, (ftnlen)sizeof(
+ integer));
+#line 18236 ""
+ do_fio(&c__1, "}", (ftnlen)1);
+#line 18236 ""
+ e_wsfi();
+#line 18237 ""
+ lnoten = 4;
+#line 18238 ""
+ } else {
+#line 18239 ""
+ *(unsigned char *)&ch__6[0] = lineno + 48;
+#line 18239 ""
+ s_copy(noteq, ch__6, (ftnlen)8, (ftnlen)1);
+#line 18240 ""
+ lnoten = 1;
+#line 18241 ""
+ }
+/* Writing concatenation */
+#line 18242 ""
+ i__9[0] = lnote, a__6[0] = notexq;
+#line 18242 ""
+ i__9[1] = 1, a__6[1] = "m";
+#line 18242 ""
+ i__9[2] = 1, a__6[2] = udq;
+#line 18242 ""
+ i__9[3] = lnoten, a__6[3] = noteq;
+#line 18242 ""
+ s_cat(notexq, a__6, i__9, &c__4, (ftnlen)79);
+#line 18243 ""
+ lnote = lnote + 2 + lnoten;
+#line 18244 ""
+ addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
+ (ftnlen)80);
+#line 18245 ""
}
-/* Write a separate note or rest */
+/* 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 18251 ""
notex_(notexq, &lnote, (ftnlen)79);
+#line 18252 ""
}
/* Right offset? This may cause trouble */
+#line 18256 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
/* Writing concatenation */
+#line 18257 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18257 ""
i__4[1] = 5, a__2[1] = "loff{";
+#line 18257 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
+#line 18257 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, (
ftnlen)80);
+#line 18258 ""
} else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
,9)) {
/* Writing concatenation */
+#line 18259 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18259 ""
i__4[1] = 5, a__2[1] = "roff{";
+#line 18259 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
+#line 18259 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, (
ftnlen)80);
+#line 18260 ""
}
+#line 18261 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0)
{
+#line 18262 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 18263 ""
}
+#line 18264 ""
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 18264 ""
addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)
80);
+#line 18264 ""
}
/* Terminate user-defined offsets. Fix format */
+#line 18269 ""
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 18269 ""
putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, (
ftnlen)80);
+#line 18269 ""
}
/* Deal with After- and Way-after-graces. First, if end of bar, compute space */
@@ -26823,142 +43411,225 @@ 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 18277 ""
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 18279 ""
i__12 = comgrace_1.ngrace;
+#line 18279 ""
for (ig = 1; ig <= i__12; ++ig) {
+#line 18280 ""
if (comgrace_1.ipg[ig - 1] == ip &&
comgrace_1.ivg[ig - 1] == commvl_1.ivx) {
+#line 18280 ""
goto L78;
+#line 18280 ""
}
+#line 18281 ""
/* L77: */
+#line 18281 ""
}
- s_wsle(&io___1072);
- do_lio(&c__9, &c__1, "Problem finding grace index "
+#line 18282 ""
+ s_wsle(&io___1117);
+#line 18282 ""
+ do_lio(&c__9, &c__1, "Problem finding grace index "\
"at \"do 77\"", (ftnlen)38);
+#line 18282 ""
e_wsle();
+#line 18283 ""
stop1_();
+#line 18284 ""
L78:
/* Get elemskip to end of bar. WON'T WORK IF XTUPS !! */
+#line 18288 ""
esk = 0.f;
+#line 18289 ""
i__12 = comnsp_2.nb;
+#line 18289 ""
for (iib = ib; iib <= i__12; ++iib) {
+#line 18290 ""
if (iib == ib) {
+#line 18291 ""
itleft = i_nint(&all_1.to[comipl2_1.ipl2[
commvl_1.ivx + ip * 24 - 25] - 1]);
+#line 18292 ""
} else {
+#line 18293 ""
itleft = i_nint(&tstart[ib]);
+#line 18294 ""
}
+#line 18295 ""
if (iib < comnsp_2.nb) {
+#line 18296 ""
itright = i_nint(&tstart[iib + 1]);
+#line 18297 ""
} else {
+#line 18298 ""
itright = all_1.lenbar;
+#line 18299 ""
}
+#line 18300 ""
esk += feon_(&comnsp_2.space[ib - 1]) * (itright
- itleft) / comnsp_2.space[ib - 1];
+#line 18302 ""
/* L40: */
+#line 18302 ""
}
+#line 18303 ""
ptsavail = comask_1.poenom * esk - comask_1.wheadpt;
+#line 18304 ""
if (comgrace_1.nng[ig - 1] == 1) {
+#line 18305 ""
wgr = spfacs_1.grafac;
+#line 18306 ""
} else {
+#line 18307 ""
wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
+#line 18308 ""
i__12 = comgrace_1.nng[ig - 1];
+#line 18308 ""
for (ing = 1; ing <= i__12; ++ing) {
+#line 18309 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1]
- 1 + ing - 1] > 0) {
+#line 18309 ""
wgr += spfacs_1.acgfac;
+#line 18309 ""
}
+#line 18310 ""
/* L41: */
+#line 18310 ""
}
+#line 18311 ""
}
+#line 18312 ""
ptgr[ig - 1] = wgr * comask_1.wheadpt;
+#line 18313 ""
ptsneed = (wgr + .5f) * comask_1.wheadpt;
+#line 18314 ""
ptsndg[commvl_1.ivx - 1] = 0.f;
+#line 18315 ""
if (ptsavail < ptsneed) {
+#line 18316 ""
ptsndg[commvl_1.ivx - 1] = ptsneed;
+#line 18317 ""
eskndg[commvl_1.ivx - 1] = esk;
+#line 18318 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],31)) {
/* Convert GW to GA */
+#line 18322 ""
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 18323 ""
}
+#line 18324 ""
}
+#line 18325 ""
}
/* Check for GA */
+#line 18329 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) {
+#line 18329 ""
i__12 = ncmid_(&all_1.iv, &ip);
+#line 18329 ""
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 -
25], &c_false, &c_false, &c__0, &c__0, &c__0,
- &c__0, &c__0, &c__0, &c_b774, all_1.ulq, &
+ &c__0, &c__0, &c__0, &c_b1009, all_1.ulq, &
cominsttrans_1.instno[all_1.iv - 1], (ftnlen)
80, (ftnlen)1);
+#line 18329 ""
}
/* 130324 */
/* * .false.,0,0,0,0,0,0,0.,ulq) */
/* Update running time */
+#line 18338 ""
tnow += comnsp_2.space[ib - 1];
+#line 18339 ""
L10:
+#line 18339 ""
;
+#line 18339 ""
}
/* Have finished last note in this voice and block */
+#line 18343 ""
r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1];
+#line 18343 ""
itendb = i_nint(&r__1);
+#line 18344 ""
if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
+#line 18345 ""
ivf = 1;
+#line 18346 ""
if (commvl_1.ivx > 1) {
+#line 18346 ""
ivf = 2;
+#line 18346 ""
}
+#line 18347 ""
L17:
+#line 18347 ""
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 18351 ""
offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1]
<< 1) - 3]) / comnsp_2.space[ib - 1];
+#line 18352 ""
putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[
ivf - 1], soutq, &lsout, (ftnlen)80);
+#line 18353 ""
goto L17;
+#line 18354 ""
}
+#line 18355 ""
}
/* Check for flag, dot, or upstem on last note of bar. */
+#line 18359 ""
if (ib == comnsp_2.nb) {
+#line 18360 ""
ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[
commvl_1.ivx - 1] * 24 - 25] - 1];
+#line 18361 ""
comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f;
+#line 18362 ""
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 18363 ""
if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) {
/* Note in last space, smaller than a quarter note. */
+#line 18367 ""
i__10 = ncmid_(&all_1.iv, &ip);
+#line 18367 ""
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 18367 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
- 25],0) && *(unsigned char *)&ch__6[0] ==
'u' || isdotted_(all_1.nodur, &
@@ -26967,7 +43638,9 @@ L17:
/* Upstem non-rest, or dotted */
/* Computing MAX */
+#line 18374 ""
i__10 = 1, i__12 = numbms[commvl_1.ivx];
+#line 18374 ""
if (numbms[commvl_1.ivx] > 0 && ip ==
all_1.ibm2[commvl_1.ivx + max(i__10,
i__12) * 24 - 25] && ! isdotted_(
@@ -26975,48 +43648,70 @@ L17:
/* In beam and not dotted, so use smaller space */
+#line 18381 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.upstmfac;
+#line 18382 ""
} else {
+#line 18383 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.flagfac;
+#line 18384 ""
}
+#line 18385 ""
}
+#line 18386 ""
} else {
/* Last space, nonflagged (no beam) only worry dot or up */
+#line 18390 ""
if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
+#line 18391 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.flagfac;
+#line 18392 ""
} else /* if(complicated condition) */ {
+#line 18392 ""
i__10 = ncmid_(&all_1.iv, &ip);
+#line 18392 ""
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 18392 ""
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 18398 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.upstmfac;
+#line 18399 ""
}
+#line 18399 ""
}
+#line 18400 ""
}
+#line 18401 ""
}
/* Check for right-shifted chordal note */
+#line 18405 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20))
{
+#line 18405 ""
comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac;
+#line 18405 ""
}
+#line 18406 ""
comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[
commvl_1.ivx - 1] > 0.f;
+#line 18407 ""
if (commidi_1.ismidi) {
/* For midi, set flags for accidentals on last note of bar. Assume they affect */
@@ -27028,64 +43723,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 18418 ""
if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0)
{
/* Explicit accidental on last main note in bar */
+#line 18422 ""
i__10 = comslm_1.naccbl[icm];
+#line 18422 ""
for (kacc = 1; kacc <= i__10; ++kacc) {
+#line 18423 ""
if (comslm_1.laccbl[icm + kacc * 25 - 25] ==
all_1.nolev[commvl_1.ivx + ip * 24 -
25]) {
+#line 18423 ""
goto L56;
+#line 18423 ""
}
+#line 18424 ""
/* L55: */
+#line 18424 ""
}
+#line 18425 ""
++comslm_1.naccbl[icm];
+#line 18426 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = all_1.nolev[commvl_1.ivx + ip * 24
- 25];
+#line 18427 ""
i__10 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] &
7;
+#line 18427 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = iashft_(&i__10);
+#line 18428 ""
}
+#line 18429 ""
L56:
+#line 18430 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
10) && commidi_1.crdacc) {
+#line 18431 ""
i__10 = comtrill_1.icrd2;
+#line 18431 ""
for (icrd = comtrill_1.icrd1; icrd <= i__10;
++icrd) {
+#line 18432 ""
iacc = igetbits_(&comtrill_1.icrdat[icrd - 1],
&c__3, &c__20);
+#line 18433 ""
if (iacc > 0) {
/* Explicit accidental on chord note at end of bar */
+#line 18437 ""
nolevc = igetbits_(&comtrill_1.icrdat[
icrd - 1], &c__7, &c__12);
+#line 18438 ""
i__12 = comslm_1.naccbl[icm];
+#line 18438 ""
for (kacc = 1; kacc <= i__12; ++kacc) {
+#line 18439 ""
if (comslm_1.laccbl[icm + kacc * 25 -
25] == nolevc) {
+#line 18439 ""
goto L59;
+#line 18439 ""
}
+#line 18440 ""
/* L58: */
+#line 18440 ""
}
+#line 18441 ""
++comslm_1.naccbl[icm];
+#line 18442 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm]
* 25 - 25] = nolevc;
+#line 18443 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm]
* 25 - 25] = iashft_(&iacc);
+#line 18444 ""
}
+#line 18445 ""
L59:
+#line 18446 ""
/* L57: */
+#line 18446 ""
;
+#line 18446 ""
}
+#line 18447 ""
}
/* if (lbacc(icm).eq.0 .and. accb4(icm)) then */
+#line 18449 ""
i__10 = commidi_1.naccim[icm];
+#line 18449 ""
for (kacc = 1; kacc <= i__10; ++kacc) {
/* If naccim(icm)>0, */
@@ -27094,336 +43827,570 @@ 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 18457 ""
if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] ==
commidi_1.laccim[icm + kacc * 25 - 25]) {
+#line 18457 ""
goto L66;
+#line 18457 ""
}
+#line 18458 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],10)) {
+#line 18459 ""
i__12 = comtrill_1.icrd2;
+#line 18459 ""
for (icrd = comtrill_1.icrd1; icrd <= i__12;
++icrd) {
+#line 18460 ""
if ((lbit_shift(comtrill_1.icrdat[icrd -
1], (ftnlen)-12) & 127) ==
commidi_1.laccim[icm + kacc * 25
- 25]) {
+#line 18460 ""
goto L66;
+#line 18460 ""
}
+#line 18462 ""
/* L67: */
+#line 18462 ""
}
+#line 18463 ""
}
+#line 18464 ""
goto L65;
+#line 18465 ""
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 18470 ""
i__12 = comslm_1.naccbl[icm];
+#line 18470 ""
for (macc = 1; macc <= i__12; ++macc) {
+#line 18471 ""
if (comslm_1.laccbl[icm + macc * 25 - 25] ==
commidi_1.laccim[icm + kacc * 25 - 25]
) {
+#line 18471 ""
goto L65;
+#line 18471 ""
}
+#line 18472 ""
/* L68: */
+#line 18472 ""
}
+#line 18473 ""
++comslm_1.naccbl[icm];
+#line 18474 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = commidi_1.laccim[icm + kacc * 25 -
25];
+#line 18475 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = commidi_1.jaccim[icm + kacc * 25 -
25];
+#line 18476 ""
L65:
+#line 18476 ""
;
+#line 18476 ""
}
+#line 18477 ""
}
+#line 18478 ""
}
+#line 18479 ""
/* L11: */
+#line 18479 ""
}
+#line 18479 ""
}
/* Close out the notes group */
/* Writing concatenation */
+#line 18483 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18483 ""
i__4[1] = 2, a__2[1] = "en";
+#line 18483 ""
s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3);
+#line 18483 ""
addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80);
+#line 18484 ""
if (comlast_1.islast && lsout > 0) {
- s_wsfe(&io___1085);
+#line 18484 ""
+ s_wsfe(&io___1130);
/* Writing concatenation */
+#line 18484 ""
i__4[0] = lsout, a__2[0] = soutq;
+#line 18484 ""
i__4[1] = 1, a__2[1] = "%";
+#line 18484 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
+#line 18484 ""
do_fio(&c__1, ch__12, lsout + 1);
+#line 18484 ""
e_wsfe();
+#line 18484 ""
}
+#line 18485 ""
/* L16: */
+#line 18485 ""
}
/* 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 18491 ""
isgrace = FALSE_;
+#line 18492 ""
i__2 = all_1.nv;
+#line 18492 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 18493 ""
comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1];
+#line 18494 ""
i__7 = commvl_1.nvmx[all_1.iv - 1];
+#line 18494 ""
for (kv = 1; kv <= i__7; ++kv) {
+#line 18495 ""
comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[
all_1.iv + kv * 24 - 25];
+#line 18496 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 18497 ""
comnsp_2.ptsgnd = 0.f;
+#line 18498 ""
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 18500 ""
comnsp_2.flgndb = TRUE_;
+#line 18501 ""
if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) {
+#line 18502 ""
comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1];
+#line 18503 ""
comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1];
+#line 18504 ""
}
+#line 18505 ""
}
+#line 18506 ""
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 18510 ""
if (! isgrace) {
/* This is the first one, so set up the string */
+#line 18514 ""
isgrace = TRUE_;
+#line 18515 ""
ivlast = 1;
/* Writing concatenation */
+#line 18516 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18516 ""
i__4[1] = 6, a__2[1] = "znotes";
+#line 18516 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
+#line 18517 ""
lsout = 7;
+#line 18518 ""
}
+#line 18519 ""
i__1 = all_1.iv - 1;
+#line 18519 ""
for (iiv = ivlast; iiv <= i__1; ++iiv) {
+#line 18520 ""
addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, (
ftnlen)1, (ftnlen)80);
+#line 18521 ""
/* L76: */
+#line 18521 ""
}
+#line 18522 ""
ivlast = all_1.iv;
/* No need to put in 'nextvoice', even if 2 lines/staff */
+#line 18526 ""
i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]);
+#line 18526 ""
dograce_(&commvl_1.ivx, &all_1.nn[commvl_1.ivx - 1], ptgr,
soutq, &lsout, &i__1, &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, &
- c__0, &c__0, &c__0, &c_b774, all_1.ulq, &
+ c__0, &c__0, &c__0, &c_b1009, all_1.ulq, &
cominsttrans_1.instno[all_1.iv - 1], (ftnlen)80, (
ftnlen)1);
/* 130324 */
/* * .false.,0,0,0,0,0,0,0.,ulq) */
+#line 18531 ""
}
+#line 18532 ""
/* L75: */
+#line 18532 ""
}
+#line 18532 ""
}
+#line 18533 ""
if (isgrace) {
/* Writing concatenation */
+#line 18534 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18534 ""
i__4[1] = 3, a__2[1] = "en%";
+#line 18534 ""
s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)4);
+#line 18534 ""
addstr_(ch__19, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80);
+#line 18535 ""
if (comlast_1.islast && lsout > 0) {
- s_wsfe(&io___1088);
+#line 18535 ""
+ s_wsfe(&io___1133);
+#line 18535 ""
do_fio(&c__1, soutq, lsout);
+#line 18535 ""
e_wsfe();
+#line 18535 ""
}
+#line 18536 ""
}
+#line 18537 ""
lsout = 0;
/* Write multibar rest. Assuming nv = 1 and do not worry about cwbrest */
/* This has to be the only use of atnextbar */
+#line 18542 ""
if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) {
/* Writing concatenation */
+#line 18543 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 18543 ""
i__3[1] = 3, a__1[1] = "def";
+#line 18543 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 18543 ""
i__3[3] = 10, a__1[3] = "atnextbar{";
+#line 18543 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 18543 ""
i__3[5] = 6, a__1[5] = "znotes";
+#line 18543 ""
s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80);
+#line 18544 ""
lsout = 22;
/* Writing concatenation */
+#line 18545 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18545 ""
i__4[1] = 6, a__2[1] = "mbrest";
+#line 18545 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18546 ""
lnote = 7;
+#line 18547 ""
istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8);
/* Writing concatenation */
+#line 18548 ""
i__4[0] = lnote, a__2[0] = notexq;
+#line 18548 ""
i__4[1] = len, a__2[1] = noteq;
+#line 18548 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
+#line 18549 ""
lnote += len;
+#line 18550 ""
mtrspc = i_nint(&comgrace_1.xb4mbr);
+#line 18551 ""
comgrace_1.xb4mbr = 0.f;
+#line 18552 ""
istring_(&mtrspc, noteq, &len, (ftnlen)8);
/* Writing concatenation */
+#line 18553 ""
i__6[0] = lnote, a__4[0] = notexq;
+#line 18553 ""
i__6[1] = len, a__4[1] = noteq;
+#line 18553 ""
i__6[2] = 1, a__4[2] = "0";
+#line 18553 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79);
+#line 18554 ""
lnote = lnote + len + 1;
+#line 18555 ""
i__7 = all_1.nv;
+#line 18555 ""
for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
+#line 18556 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80);
+#line 18557 ""
if (all_1.iv < all_1.nv) {
+#line 18557 ""
addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
(ftnlen)1, (ftnlen)80);
+#line 18557 ""
}
+#line 18558 ""
/* L62: */
+#line 18558 ""
}
/* Writing concatenation */
+#line 18559 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18559 ""
i__4[1] = 4, a__2[1] = "en}%";
+#line 18559 ""
s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5);
+#line 18559 ""
addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80);
- s_wsfe(&io___1091);
+#line 18560 ""
+ s_wsfe(&io___1136);
+#line 18560 ""
do_fio(&c__1, soutq, lsout);
+#line 18560 ""
e_wsfe();
+#line 18561 ""
lsout = 0;
+#line 18562 ""
if (comgrace_1.mbrest > 1) {
+#line 18563 ""
r__1 = comgrace_1.mbrest - 1 + .01f;
+#line 18563 ""
ndig = (integer) r_lg10(&r__1) + 1;
+#line 18564 ""
ci__1.cierr = 0;
+#line 18564 ""
ci__1.ciunit = 11;
/* Writing concatenation */
+#line 18564 ""
i__6[0] = 6, a__4[0] = "(a14,i";
+#line 18564 ""
i__7 = ndig + 48;
+#line 18564 ""
chax_(ch__6, (ftnlen)1, &i__7);
+#line 18564 ""
i__6[1] = 1, a__4[1] = ch__6;
+#line 18564 ""
i__6[2] = 4, a__4[2] = ",a1)";
+#line 18564 ""
ci__1.cifmt = (s_cat(ch__9, a__4, i__6, &c__3, (ftnlen)11), ch__9)
;
+#line 18564 ""
s_wsfe(&ci__1);
/* Writing concatenation */
+#line 18564 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 18564 ""
i__9[1] = 7, a__6[1] = "advance";
+#line 18564 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 18564 ""
i__9[3] = 5, a__6[3] = "barno";
+#line 18564 ""
s_cat(ch__4, a__6, i__9, &c__4, (ftnlen)14);
+#line 18564 ""
do_fio(&c__1, ch__4, (ftnlen)14);
+#line 18564 ""
i__2 = comgrace_1.mbrest - 1;
+#line 18564 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 18564 ""
do_fio(&c__1, "%", (ftnlen)1);
+#line 18564 ""
e_wsfe();
+#line 18566 ""
}
+#line 18567 ""
} 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 18572 ""
comclefrests_1.centrests = TRUE_;
/* Writing concatenation */
+#line 18573 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 18573 ""
i__9[1] = 3, a__6[1] = "def";
+#line 18573 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 18573 ""
i__9[3] = 8, a__6[3] = "value{0}";
+#line 18573 ""
s_cat(ch__20, a__6, i__9, &c__4, (ftnlen)13);
+#line 18573 ""
addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, (ftnlen)80);
/* Writing concatenation */
+#line 18574 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 18574 ""
i__3[1] = 3, a__1[1] = "def";
+#line 18574 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 18574 ""
i__3[3] = 10, a__1[3] = "atnextbar{";
+#line 18574 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 18574 ""
i__3[5] = 6, a__1[5] = "znotes";
+#line 18574 ""
s_cat(ch__21, a__1, i__3, &c__6, (ftnlen)22);
+#line 18574 ""
addstr_(ch__21, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80);
+#line 18576 ""
i__7 = all_1.nv;
+#line 18576 ""
for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
/* added */
+#line 18578 ""
lnote = 0;
+#line 18580 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 18580 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 18581 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 18582 ""
if (cwrest[commvl_1.ivx]) {
/* Writing concatenation */
+#line 18583 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18583 ""
i__4[1] = 10, a__2[1] = "CenterBar{";
+#line 18583 ""
s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11);
+#line 18583 ""
addstr_(ch__9, &c__11, soutq, &lsout, (ftnlen)11, (ftnlen)
80);
+#line 18584 ""
if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
+#line 18585 ""
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 18589 ""
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 18589 ""
*(unsigned char *)&cwrq[(commvl_1.ivx - 1) *
79 + 9] = 'c';
+#line 18589 ""
}
+#line 18592 ""
}
+#line 18593 ""
addstr_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[
commvl_1.ivx - 1], soutq, &lsout, lcwr[
commvl_1.ivx - 1], (ftnlen)80);
/* Writing concatenation */
+#line 18595 ""
i__6[0] = 6, a__4[0] = "}{-2}{";
+#line 18595 ""
i__6[1] = 1, a__4[1] = all_1.sq;
+#line 18595 ""
i__6[2] = 6, a__4[2] = "value}";
+#line 18595 ""
s_cat(ch__20, a__4, i__6, &c__3, (ftnlen)13);
+#line 18595 ""
addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, (
ftnlen)80);
+#line 18596 ""
} 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 18601 ""
i__15[0] = lnote, a__9[0] = notexq;
+#line 18601 ""
i__15[1] = 1, a__9[1] = all_1.sq;
+#line 18601 ""
i__15[2] = 13, a__9[2] = "loffset{.33}{";
+#line 18601 ""
i__15[3] = 1, a__9[3] = all_1.sq;
+#line 18601 ""
i__15[4] = 11, a__9[4] = "fermataup7}";
+#line 18601 ""
i__15[5] = lcwr[commvl_1.ivx - 1], a__9[5] = cwrq + (
commvl_1.ivx - 1) * 79;
+#line 18601 ""
i__15[6] = 6, a__9[6] = "}{-2}{";
+#line 18601 ""
i__15[7] = 1, a__9[7] = all_1.sq;
+#line 18601 ""
i__15[8] = 6, a__9[8] = "value}";
+#line 18601 ""
s_cat(notexq, a__9, i__15, &c__9, (ftnlen)79);
+#line 18604 ""
lnote = lnote + 26 + lcwr[commvl_1.ivx - 1] + 13;
+#line 18605 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
+#line 18606 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
+#line 18607 ""
}
+#line 18608 ""
}
+#line 18609 ""
/* L61: */
+#line 18609 ""
}
+#line 18610 ""
if (all_1.iv != all_1.nv) {
+#line 18610 ""
addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
(ftnlen)1, (ftnlen)80);
+#line 18610 ""
}
+#line 18611 ""
/* L60: */
+#line 18611 ""
}
+#line 18612 ""
if (comlast_1.islast) {
/* Writing concatenation */
+#line 18613 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 18613 ""
i__4[1] = 4, a__2[1] = "en}%";
+#line 18613 ""
s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5);
+#line 18613 ""
addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80);
+#line 18614 ""
if (lsout > 0) {
- s_wsfe(&io___1093);
+#line 18614 ""
+ s_wsfe(&io___1138);
+#line 18614 ""
do_fio(&c__1, soutq, lsout);
+#line 18614 ""
e_wsfe();
+#line 18614 ""
}
+#line 18615 ""
}
+#line 18616 ""
}
/* End of block for centered whole-bar rests and multi-bar rests */
@@ -27431,33 +44398,52 @@ 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 18623 ""
if (all_1.ibar == all_1.nbars) {
+#line 18624 ""
i__7 = all_1.nv;
+#line 18624 ""
for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
+#line 18625 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 18625 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 18626 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 18627 ""
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 18628 ""
/* L63: */
+#line 18628 ""
}
+#line 18628 ""
}
+#line 18629 ""
}
/* Update time for midi. This is only used for the event track */
+#line 18633 ""
if (commidi_1.ismidi) {
+#line 18634 ""
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 18639 ""
if (all_1.lenb0 == all_1.lenbar) {
+#line 18639 ""
i__2 = all_1.mtrdenl * all_1.lenb1 / 64;
+#line 18639 ""
midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1);
+#line 18639 ""
}
+#line 18641 ""
}
+#line 18642 ""
return 0;
} /* make2bar_ */
@@ -27523,106 +44509,185 @@ L65:
/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
/* logical rest,firstline,newmeter,gotclef */
+#line 18691 ""
linecom_1.elskb = 0.f;
+#line 18692 ""
linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f;
+#line 18693 ""
i__1 = a1ll_2.nv;
+#line 18693 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
+#line 18694 ""
i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 18694 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 18695 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
+#line 18696 ""
if (a1ll_2.ibar > 1) {
+#line 18697 ""
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 18698 ""
} else {
+#line 18699 ""
a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx +
a1ll_2.ibar * 24 - 25];
+#line 18700 ""
}
+#line 18701 ""
/* L1: */
+#line 18701 ""
}
+#line 18701 ""
}
/* initialize list note counter, time(iv), curr. note(iv) */
+#line 18705 ""
ilnc = 1;
+#line 18706 ""
i__2 = a1ll_2.nv;
+#line 18706 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
+#line 18707 ""
i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 18707 ""
for (kv = 1; kv <= i__1; ++kv) {
+#line 18708 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
+#line 18709 ""
cnn[c1ommvl_1.ivx - 1] = 1;
+#line 18710 ""
a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx;
+#line 18711 ""
a1ll_2.ipo[ilnc - 1] = 1;
+#line 18712 ""
a1ll_2.to[ilnc - 1] = 0.f;
+#line 18713 ""
tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1,
c1ommvl_1.nacc);
+#line 18714 ""
xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1];
+#line 18715 ""
if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) <
comtol_1.tol) {
+#line 18715 ""
xit[c1ommvl_1.ivx - 1] = 1e3f;
+#line 18715 ""
}
+#line 18716 ""
++ilnc;
+#line 18717 ""
/* L4: */
+#line 18717 ""
}
+#line 18717 ""
}
/* Build the list */
+#line 18721 ""
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 18726 ""
tmin = 1e3f;
+#line 18727 ""
i__1 = a1ll_2.nv;
+#line 18727 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
+#line 18728 ""
i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 18728 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 18729 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
/* Computing MIN */
+#line 18730 ""
r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1];
+#line 18730 ""
tminn = dmin(r__1,r__2);
+#line 18731 ""
if (tminn < tmin) {
+#line 18732 ""
tmin = tminn;
+#line 18733 ""
ivnext = c1ommvl_1.ivx;
+#line 18734 ""
}
+#line 18735 ""
/* L6: */
+#line 18735 ""
}
+#line 18735 ""
}
+#line 18736 ""
if (tmin > 999.f) {
+#line 18736 ""
goto L7;
+#line 18736 ""
}
+#line 18737 ""
a1ll_2.ivxo[ilnc - 1] = ivnext;
+#line 18738 ""
++cnn[ivnext - 1];
+#line 18739 ""
a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1];
+#line 18740 ""
a1ll_2.to[ilnc - 1] = tmin;
/* Check if this voice is done */
+#line 18744 ""
tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1],
c1ommvl_1.nacc);
+#line 18745 ""
if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) {
+#line 18746 ""
xit[ivnext - 1] = 1e3f;
+#line 18747 ""
} else {
+#line 18748 ""
xit[ivnext - 1] += tnote[ilnc - 1];
+#line 18749 ""
}
+#line 18750 ""
++ilnc;
+#line 18751 ""
goto L5;
+#line 18752 ""
L7:
+#line 18753 ""
ntot = ilnc - 1;
+#line 18754 ""
if (ntot > 600) {
+#line 18755 ""
printl_(" ", (ftnlen)1);
+#line 18756 ""
printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen)
49);
+#line 18757 ""
stop1_();
+#line 18758 ""
}
+#line 18759 ""
i__2 = ntot - 1;
+#line 18759 ""
for (in = 1; in <= i__2; ++in) {
+#line 18760 ""
a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1];
+#line 18761 ""
/* L8: */
+#line 18761 ""
}
+#line 18762 ""
a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], &
a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc);
+#line 18763 ""
tnote[ntot - 1] = a1ll_2.tno[ntot - 1];
/* Debug writes */
@@ -27637,130 +44702,198 @@ L7:
/* Done w/ list. Initialize loop for building note blocks: */
+#line 18777 ""
ib = 1;
+#line 18778 ""
istart[0] = 1;
+#line 18779 ""
space[0] = 0.f;
+#line 18780 ""
in = 1;
/* Start the loop */
+#line 18784 ""
L9:
+#line 18785 ""
if (in == ntot) {
+#line 18786 ""
if (space[ib - 1] < comtol_1.tol) {
+#line 18787 ""
space[ib - 1] = a1ll_2.tno[in - 1];
/* Last gap in bar is spanned by a note, so cannot need a squeeze. */
+#line 18791 ""
squez[ib - 1] = 1.f;
+#line 18792 ""
}
+#line 18793 ""
istop[ib - 1] = ntot;
/* From here flow out of this if block and into block-setup */
+#line 18797 ""
} else if (space[ib - 1] < comtol_1.tol) {
/* space hasn't been set yet, so tentatively set: */
+#line 18801 ""
space[ib - 1] = a1ll_2.tno[in - 1];
+#line 18802 ""
if (space[ib - 1] < comtol_1.tol) {
+#line 18803 ""
++in;
+#line 18804 ""
} 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 18809 ""
squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
a1ll_2.to);
+#line 18810 ""
istop[ib - 1] = in;
+#line 18811 ""
}
+#line 18812 ""
goto L9;
+#line 18813 ""
} else if (a1ll_2.tno[in] < comtol_1.tol) {
/* This is not the last note in the space, so */
+#line 18817 ""
++in;
+#line 18818 ""
goto L9;
+#line 18819 ""
} 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 18823 ""
i__2 = in + 1;
+#line 18823 ""
xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to);
/* If it does have the same squez, loop, otherwise flow out */
+#line 18827 ""
if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) {
/* Keep spacing the same, update tentative stop point */
+#line 18831 ""
++in;
+#line 18832 ""
istop[ib - 1] = in;
+#line 18833 ""
goto L9;
+#line 18834 ""
}
+#line 18835 ""
}
/* At this point istart, istop, space, and squez are good, so close out block */
+#line 18839 ""
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 18845 ""
r__1 = space[ib - 1] * squez[ib - 1];
+#line 18845 ""
elsperns = f1eon_(&r__1);
+#line 18846 ""
if (istop[ib - 1] == ntot) {
+#line 18847 ""
r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1];
+#line 18847 ""
nnsk = i_nint(&r__1);
+#line 18848 ""
} else {
+#line 18849 ""
r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1];
+#line 18849 ""
nnsk = i_nint(&r__1);
+#line 18850 ""
}
+#line 18851 ""
linecom_1.elskb += elsperns * nnsk;
+#line 18852 ""
if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[
c1omnotes_1.ibarcnt - 1]) {
+#line 18853 ""
catspace_(&space[ib - 1], &squez[ib - 1], &nnsk);
+#line 18854 ""
} else {
/* This is the first entry for this bar */
+#line 18858 ""
c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
nnsk;
+#line 18859 ""
c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
space[ib - 1];
+#line 18860 ""
c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
squez[ib - 1];
+#line 18861 ""
++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
+#line 18862 ""
}
/* Update minimum space spanned by a note */
+#line 18866 ""
if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) {
/* Computing MIN */
+#line 18866 ""
r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1]
;
+#line 18866 ""
linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3);
+#line 18866 ""
}
+#line 18868 ""
if (istop[ib - 1] == ntot) {
+#line 18868 ""
goto L15;
+#line 18868 ""
}
/* End of spatial accounting for now */
+#line 18872 ""
++ib;
+#line 18873 ""
istart[ib - 1] = istop[ib - 2] + 1;
+#line 18874 ""
in = istart[ib - 1];
/* Set tentative block space for new block */
+#line 18878 ""
space[ib - 1] = a1ll_2.tno[in - 1];
+#line 18879 ""
if (space[ib - 1] > comtol_1.tol) {
+#line 18879 ""
squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
a1ll_2.to);
+#line 18879 ""
}
+#line 18881 ""
istop[ib - 1] = in;
+#line 18882 ""
goto L9;
+#line 18883 ""
L15:
/* nb = ib */
@@ -27771,6 +44904,7 @@ L15:
/* write(*,'(16f5.1)')(space(ib),ib=1,nb) */
/* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */
+#line 18893 ""
return 0;
} /* makeabar_ */
@@ -27793,89 +44927,136 @@ L15:
static integer nbytes, misperq;
/* Fortran I/O blocks */
- static cilist io___1117 = { 0, 6, 0, 0, 0 };
+ static cilist io___1162 = { 0, 6, 0, 0, 0 };
/* We now store "conductor" events in mmidi(numchan,.), and count bytes */
/* with imidi(numchan) */
+#line 18912 ""
i__1 = comevent_1.miditime - comevent_1.lasttime;
+#line 18912 ""
idur = isetvarlen_(&i__1, &nbytes);
+#line 18913 ""
commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] +
nbytes + 1;
+#line 18914 ""
i__1 = nbytes;
+#line 18914 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 18915 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256)
;
+#line 18916 ""
idur = lbit_shift(idur, (ftnlen)-8);
+#line 18917 ""
/* L1: */
+#line 18917 ""
}
+#line 18918 ""
commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] *
25 - 25] = 255;
+#line 18919 ""
if (*(unsigned char *)typeq == 't') {
/* Tempo event. in1 = quarters per minute (integer) */
+#line 18923 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 81;
+#line 18924 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 3;
+#line 18925 ""
r__1 = 6e7f / *in1;
+#line 18925 ""
misperq = i_nint(&r__1);
+#line 18926 ""
for (i__ = 1; i__ <= 3; ++i__) {
+#line 18927 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) (
misperq % 256);
+#line 18928 ""
misperq = lbit_shift(misperq, (ftnlen)-8);
+#line 18929 ""
/* L2: */
+#line 18929 ""
}
+#line 18930 ""
commidi_1.imidi[commidi_1.numchan] += 5;
+#line 18931 ""
} else if (*(unsigned char *)typeq == 'm') {
/* Meter event. in1=numerator, in2=denom (power of 2) */
+#line 18935 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 88;
+#line 18936 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 4;
+#line 18937 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1);
+#line 18938 ""
if (*in2 > 0) {
+#line 18939 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2)
;
+#line 18940 ""
} else {
+#line 18941 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = 0;
+#line 18942 ""
}
+#line 18943 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 5) * 25 - 25] = 24;
+#line 18944 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 6) * 25 - 25] = 8;
+#line 18945 ""
commidi_1.imidi[commidi_1.numchan] += 6;
+#line 18946 ""
} else if (*(unsigned char *)typeq == 'k') {
/* Keychange event. in1 = isig */
+#line 18950 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 89;
+#line 18951 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 2;
+#line 18952 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256)
% 256);
+#line 18953 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = 0;
+#line 18954 ""
commidi_1.imidi[commidi_1.numchan] += 4;
+#line 18955 ""
} else {
- s_wsle(&io___1117);
+#line 18956 ""
+ s_wsle(&io___1162);
+#line 18956 ""
do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29);
+#line 18956 ""
e_wsle();
+#line 18957 ""
stop1_();
+#line 18958 ""
}
+#line 18959 ""
comevent_1.lasttime = comevent_1.miditime;
+#line 18960 ""
return 0;
} /* midievent_ */
@@ -27894,32 +45075,55 @@ L15:
static integer lenout;
/* Fortran I/O blocks */
- static cilist io___1118 = { 0, 0, 1, "(a)", 0 };
- static cilist io___1121 = { 0, 0, 0, "(a)", 0 };
+ static cilist io___1163 = { 0, 0, 1, "(a)", 0 };
+ static cilist io___1166 = { 0, 0, 0, "(a)", 0 };
+#line 18965 ""
*done = FALSE_;
- io___1118.ciunit = *iuin;
- i__1 = s_rsfe(&io___1118);
+#line 18966 ""
+ io___1163.ciunit = *iuin;
+#line 18966 ""
+ i__1 = s_rsfe(&io___1163);
+#line 18966 ""
if (i__1 != 0) {
+#line 18966 ""
goto L1;
+#line 18966 ""
}
+#line 18966 ""
i__1 = do_fio(&c__1, outq, (ftnlen)129);
+#line 18966 ""
if (i__1 != 0) {
+#line 18966 ""
goto L1;
+#line 18966 ""
}
+#line 18966 ""
i__1 = e_rsfe();
+#line 18966 ""
if (i__1 != 0) {
+#line 18966 ""
goto L1;
+#line 18966 ""
}
+#line 18967 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
- io___1121.ciunit = *iuout;
- s_wsfe(&io___1121);
+#line 18968 ""
+ io___1166.ciunit = *iuout;
+#line 18968 ""
+ s_wsfe(&io___1166);
+#line 18968 ""
do_fio(&c__1, outq, lenout);
+#line 18968 ""
e_wsfe();
+#line 18969 ""
return 0;
+#line 18970 ""
L1:
+#line 18970 ""
*done = TRUE_;
+#line 18971 ""
return 0;
} /* moveln_ */
@@ -27939,34 +45143,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 18987 ""
if (! commac_1.mrecord) {
/* Starting the macro */
+#line 18991 ""
c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
+#line 18992 ""
c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
+#line 18993 ""
c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
+#line 18994 ""
commac_1.mrecord = TRUE_;
+#line 18995 ""
}
+#line 18996 ""
if (*iccount < 128) {
+#line 18997 ""
i__1 = *iccount;
+#line 18997 ""
*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
+#line 18998 ""
if (*ndxm > 0) {
+#line 18998 ""
i__1 = *iccount;
+#line 18998 ""
i__2 = 128 - *iccount;
+#line 18998 ""
*ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
+#line 18998 ""
}
+#line 19000 ""
if (*ndxm > 0) {
/* This line ends the macro. */
+#line 19004 ""
c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
+#line 19005 ""
c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
+#line 19006 ""
commac_1.mrecord = FALSE_;
+#line 19007 ""
}
+#line 19008 ""
}
+#line 19009 ""
return 0;
} /* mrec1_ */
@@ -27985,25 +45210,42 @@ integer ncmid_(integer *iv, integer *ip)
static real xtime;
/* Fortran I/O blocks */
- static cilist io___1124 = { 0, 6, 0, 0, 0 };
+ static cilist io___1169 = { 0, 6, 0, 0, 0 };
+#line 19029 ""
if (comcc_1.ncc[*iv - 1] == 1) {
+#line 19030 ""
ret_val = comcc_1.ncmidcc[*iv - 1];
+#line 19031 ""
} else {
+#line 19032 ""
xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1];
+#line 19033 ""
for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) {
+#line 19034 ""
if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) {
+#line 19035 ""
ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25];
+#line 19036 ""
return ret_val;
+#line 19037 ""
}
+#line 19038 ""
/* L1: */
+#line 19038 ""
}
- s_wsle(&io___1124);
+#line 19039 ""
+ s_wsle(&io___1169);
+#line 19039 ""
do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18);
+#line 19039 ""
e_wsle();
+#line 19040 ""
s_stop("", (ftnlen)0);
+#line 19041 ""
}
+#line 19042 ""
return ret_val;
} /* ncmid_ */
@@ -28018,32 +45260,21 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
/* Return middle line of a clef */
-/* if (clefq.eq.'t' .or. clefq.eq.'0') then */
-/* ncmidf = 35 */
-/* else if (clefq.eq.'s' .or. clefq.eq.'1') then */
-/* ncmidf = 33 */
-/* else if (clefq.eq.'m' .or. clefq.eq.'2') then */
-/* ncmidf = 31 */
-/* else if (clefq.eq.'a' .or. clefq.eq.'3') then */
-/* ncmidf = 29 */
-/* else if (clefq.eq.'n' .or. clefq.eq.'4') then */
-/* ncmidf = 27 */
-/* else if (clefq.eq.'r' .or. clefq.eq.'5') then */
-/* ncmidf = 25 */
-/* else if (clefq.eq.'f' .or. clefq.eq.'7') then */
-/* ncmidf = 37 */
-/* else */
-/* ncmidf = 23 */
-/* end if */
+#line 19048 ""
if (*(unsigned char *)clefq == '8') {
/* treblelowoct; will treat as treble for this purpose */
+#line 19052 ""
ret_val = 35;
+#line 19053 ""
} else {
+#line 19054 ""
ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) /
2 << 1) + 21;
+#line 19055 ""
}
+#line 19056 ""
return ret_val;
} /* ncmidf_ */
@@ -28053,33 +45284,60 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
static integer j;
extern integer ncmidf_(char *, ftnlen);
+#line 19079 ""
commvl_1.nvmx[*jv - 1] = 1;
+#line 19080 ""
commvl_1.ivmx[*jv - 1] = *jv;
+#line 19081 ""
all_1.itsofar[*jv - 1] = 0;
+#line 19082 ""
all_1.nnl[*jv - 1] = 0;
+#line 19083 ""
comfb_1.nfb[*jv - 1] = 0;
+#line 19084 ""
if (all_1.firstgulp || *change) {
+#line 19085 ""
comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1);
+#line 19086 ""
} else {
+#line 19087 ""
comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1]
* 24 - 25];
+#line 19088 ""
}
+#line 19089 ""
comcc_1.tcc[*jv - 1] = 0.f;
+#line 19090 ""
comcc_1.ncc[*jv - 1] = 1;
+#line 19091 ""
comudsp_1.nudoff[*jv - 1] = 0;
+#line 19092 ""
comcc_1.ndotmv[*jv - 1] = 0;
+#line 19093 ""
for (j = 1; j <= 200; ++j) {
+#line 19094 ""
all_1.irest[*jv + j * 24 - 25] = 0;
+#line 19095 ""
all_1.islur[*jv + j * 24 - 25] = 0;
+#line 19096 ""
all_1.ipl[*jv + j * 24 - 25] = 0;
+#line 19097 ""
all_1.nacc[*jv + j * 24 - 25] = 0;
+#line 19098 ""
all_1.iornq[*jv + j * 24 - 1] = 0;
+#line 19099 ""
all_1.mult[*jv + j * 24 - 25] = 0;
+#line 19100 ""
if (*jv <= 2) {
+#line 19100 ""
all_1.isfig[*jv + (j << 1) - 3] = FALSE_;
+#line 19100 ""
}
+#line 19101 ""
/* L5: */
+#line 19101 ""
}
+#line 19102 ""
return 0;
} /* newvoice_ */
@@ -28106,66 +45364,118 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
/* Returns name of note level with octave transpositions, updates noctup. */
+#line 19111 ""
nupfroma = (*nolev + 1) % 7;
+#line 19112 ""
iname = nupfroma + 97;
+#line 19113 ""
ioctup = (*nolev + 1) / 7 - 4;
+#line 19114 ""
chax_(ch__1, (ftnlen)1, &iname);
+#line 19114 ""
*(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
+#line 19115 ""
if (*ncmid == 23) {
+#line 19115 ""
upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1);
+#line 19115 ""
*(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
+#line 19115 ""
}
+#line 19116 ""
if (ioctup == comoct_1.noctup) {
+#line 19117 ""
s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1);
+#line 19118 ""
*lnote = 1;
/* Must ALWAYS check if lnote=1 for use with functions requiring a blank */
+#line 19122 ""
} else if (ioctup > comoct_1.noctup) {
/* Raise octave. Encase in {} */
+#line 19126 ""
ici__1.icierr = 0;
+#line 19126 ""
ici__1.icirnum = 1;
+#line 19126 ""
ici__1.icirlen = 8;
+#line 19126 ""
ici__1.iciunit = noteq;
+#line 19126 ""
ici__1.icifmt = "(8a1)";
+#line 19126 ""
s_wsfi(&ici__1);
+#line 19126 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 19126 ""
i__1 = ioctup - 1;
+#line 19126 ""
for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) {
+#line 19126 ""
chax_(ch__2, (ftnlen)1, &c__39);
+#line 19126 ""
*(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
+#line 19126 ""
do_fio(&c__1, ch__1, (ftnlen)1);
+#line 19126 ""
}
+#line 19126 ""
do_fio(&c__1, noteqt, (ftnlen)1);
+#line 19126 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 19126 ""
e_wsfi();
+#line 19128 ""
*lnote = ioctup + 3 - comoct_1.noctup;
+#line 19129 ""
comoct_1.noctup = ioctup;
+#line 19130 ""
} else {
/* Lower octave */
+#line 19134 ""
ici__1.icierr = 0;
+#line 19134 ""
ici__1.icirnum = 1;
+#line 19134 ""
ici__1.icirlen = 8;
+#line 19134 ""
ici__1.iciunit = noteq;
+#line 19134 ""
ici__1.icifmt = "(8a1)";
+#line 19134 ""
s_wsfi(&ici__1);
+#line 19134 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 19134 ""
i__1 = comoct_1.noctup - 1;
+#line 19134 ""
for (i__ = ioctup; i__ <= i__1; ++i__) {
+#line 19134 ""
chax_(ch__2, (ftnlen)1, &c__96);
+#line 19134 ""
*(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
+#line 19134 ""
do_fio(&c__1, ch__1, (ftnlen)1);
+#line 19134 ""
}
+#line 19134 ""
do_fio(&c__1, noteqt, (ftnlen)1);
+#line 19134 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 19134 ""
e_wsfi();
+#line 19136 ""
*lnote = comoct_1.noctup + 3 - ioctup;
+#line 19137 ""
comoct_1.noctup = ioctup;
+#line 19138 ""
}
+#line 19139 ""
return 0;
} /* notefq_ */
@@ -28208,575 +45518,980 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
static integer lnoten;
/* Fortran I/O blocks */
- static icilist io___1143 = { 0, noteq, 0, "(i2)", 2, 1 };
- static icilist io___1147 = { 0, numq, 0, "(i2)", 2, 1 };
- static icilist io___1148 = { 0, noteq+1, 0, "(i2)", 2, 1 };
- static icilist io___1149 = { 0, noteq+1, 0, "(i3)", 3, 1 };
+ static icilist io___1188 = { 0, noteq, 0, "(i2)", 2, 1 };
+ static icilist io___1192 = { 0, numq, 0, "(i2)", 2, 1 };
+ static icilist io___1193 = { 0, noteq+1, 0, "(i2)", 2, 1 };
+ static icilist io___1194 = { 0, noteq+1, 0, "(i3)", 3, 1 };
/* Returns non-beamed full note name */
+#line 19169 ""
ip = all_1.ipo[all_1.jn - 1];
+#line 19170 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
+#line 19174 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
+#line 19175 ""
--nole;
+#line 19176 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
+#line 19177 ""
++nole;
+#line 19178 ""
}
+#line 19179 ""
nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
+#line 19180 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 19181 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 19181 ""
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 19181 ""
*(unsigned char *)udq = *(unsigned char *)&ch__1[0];
+#line 19183 ""
}
/* Check figure level */
/* if (figbass .and. isfig(ivx,ip) */
/* * .and. .not.btest(irest(ivx,ip),0)) then */
+#line 19189 ""
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 19192 ""
if (*(unsigned char *)udq == 'u' || nodu >= 64) {
/* Upper or no stem, fnole (in noleunits) set by notehead */
+#line 19196 ""
fnole = (real) nole;
+#line 19197 ""
} else {
/* Lower stem, fnole set by bottom of stem */
+#line 19201 ""
fnole = nole - all_1.stemlen;
+#line 19202 ""
}
+#line 19203 ""
zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4;
+#line 19204 ""
if (commvl_1.ivx == 1) {
/* Computing MAX */
+#line 19205 ""
r__1 = 4 - zmin;
+#line 19205 ""
i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1);
+#line 19205 ""
all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2);
+#line 19206 ""
} else {
/* Computing MAX */
+#line 19207 ""
r__1 = 4 - zmin;
+#line 19207 ""
i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1);
+#line 19207 ""
all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2);
+#line 19208 ""
}
+#line 19209 ""
}
+#line 19210 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 19211 ""
i__1 = ncmid_(&all_1.iv, &ip);
+#line 19211 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
+#line 19212 ""
if (lnoten == 1) {
+#line 19212 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 19212 ""
}
+#line 19213 ""
if (nodu == 1) {
/* Writing concatenation */
+#line 19214 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19214 ""
i__3[1] = 4, a__1[1] = "cccc";
+#line 19214 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19214 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19214 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19215 ""
*lnote = lnoten + 6;
+#line 19216 ""
} else if (nodu == 2) {
/* Writing concatenation */
+#line 19217 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19217 ""
i__3[1] = 3, a__1[1] = "ccc";
+#line 19217 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19217 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19217 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19218 ""
*lnote = lnoten + 5;
+#line 19219 ""
} else if (nodu == 4) {
/* Writing concatenation */
+#line 19220 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19220 ""
i__3[1] = 2, a__1[1] = "cc";
+#line 19220 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19220 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19220 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19221 ""
*lnote = lnoten + 4;
+#line 19222 ""
} else if (nodu == 8) {
/* Writing concatenation */
+#line 19223 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19223 ""
i__3[1] = 1, a__1[1] = "c";
+#line 19223 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19223 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19223 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19224 ""
*lnote = lnoten + 3;
+#line 19225 ""
} else if (nodu == 16) {
/* Writing concatenation */
+#line 19226 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19226 ""
i__3[1] = 1, a__1[1] = "q";
+#line 19226 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19226 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19226 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19227 ""
*lnote = lnoten + 3;
+#line 19228 ""
} else if (nodu == 32) {
/* Writing concatenation */
+#line 19229 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19229 ""
i__3[1] = 1, a__1[1] = "h";
+#line 19229 ""
i__3[2] = 1, a__1[2] = udq;
+#line 19229 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19229 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19230 ""
*lnote = lnoten + 3;
+#line 19231 ""
} else if (nodu == 64) {
/* Writing concatenation */
+#line 19232 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 19232 ""
i__4[1] = 2, a__2[1] = "wh";
+#line 19232 ""
i__4[2] = lnoten, a__2[2] = noteq;
+#line 19232 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
+#line 19233 ""
*lnote = lnoten + 3;
+#line 19234 ""
} else if (nodu == 128) {
/* notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */
/* lnote = lnoten+10 */
/* Writing concatenation */
+#line 19237 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 19237 ""
i__4[1] = 5, a__2[1] = "breve";
+#line 19237 ""
i__4[2] = lnoten, a__2[2] = noteq;
+#line 19237 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
+#line 19238 ""
*lnote = lnoten + 6;
+#line 19239 ""
} else {
+#line 19240 ""
s_copy(dotq, "p", (ftnlen)4, (ftnlen)1);
+#line 19241 ""
ldot = 1;
+#line 19242 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
/* Dotted note with ')' ornament */
+#line 19246 ""
s_copy(dotq, "m", (ftnlen)4, (ftnlen)1);
+#line 19247 ""
} else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
/* Double dot */
+#line 19251 ""
s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2);
+#line 19252 ""
ldot = 2;
+#line 19253 ""
}
+#line 19254 ""
if (nodu >= 192) {
/* Writing concatenation */
+#line 19255 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19255 ""
i__3[1] = 5, a__1[1] = "breve";
+#line 19255 ""
i__3[2] = ldot, a__1[2] = dotq;
+#line 19255 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19255 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19256 ""
*lnote = lnoten + 6 + ldot;
+#line 19257 ""
} else if (nodu >= 96) {
/* Writing concatenation */
+#line 19258 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 19258 ""
i__3[1] = 2, a__1[1] = "wh";
+#line 19258 ""
i__3[2] = ldot, a__1[2] = dotq;
+#line 19258 ""
i__3[3] = lnoten, a__1[3] = noteq;
+#line 19258 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19259 ""
*lnote = lnoten + 3 + ldot;
+#line 19260 ""
} else if (nodu >= 48) {
/* Writing concatenation */
+#line 19261 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19261 ""
i__5[1] = 1, a__3[1] = "h";
+#line 19261 ""
i__5[2] = 1, a__3[2] = udq;
+#line 19261 ""
i__5[3] = ldot, a__3[3] = dotq;
+#line 19261 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 19261 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19262 ""
*lnote = lnoten + 3 + ldot;
+#line 19263 ""
} else if (nodu >= 24) {
/* Writing concatenation */
+#line 19264 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19264 ""
i__5[1] = 1, a__3[1] = "q";
+#line 19264 ""
i__5[2] = 1, a__3[2] = udq;
+#line 19264 ""
i__5[3] = ldot, a__3[3] = dotq;
+#line 19264 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 19264 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19265 ""
*lnote = lnoten + 3 + ldot;
+#line 19266 ""
} else if (nodu >= 12) {
/* Writing concatenation */
+#line 19267 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19267 ""
i__5[1] = 1, a__3[1] = "c";
+#line 19267 ""
i__5[2] = 1, a__3[2] = udq;
+#line 19267 ""
i__5[3] = ldot, a__3[3] = dotq;
+#line 19267 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 19267 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19268 ""
*lnote = lnoten + 3 + ldot;
+#line 19269 ""
} else if (nodu >= 6) {
/* Writing concatenation */
+#line 19270 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19270 ""
i__5[1] = 2, a__3[1] = "cc";
+#line 19270 ""
i__5[2] = 1, a__3[2] = udq;
+#line 19270 ""
i__5[3] = ldot, a__3[3] = dotq;
+#line 19270 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 19270 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19271 ""
*lnote = lnoten + 4 + ldot;
+#line 19272 ""
compoi_1.ispoi = TRUE_;
+#line 19273 ""
} else {
/* Writing concatenation */
+#line 19274 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19274 ""
i__5[1] = 3, a__3[1] = "ccc";
+#line 19274 ""
i__5[2] = 1, a__3[2] = udq;
+#line 19274 ""
i__5[3] = ldot, a__3[3] = dotq;
+#line 19274 ""
i__5[4] = lnoten, a__3[4] = noteq;
+#line 19274 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19275 ""
*lnote = lnoten + 5 + ldot;
+#line 19276 ""
compoi_1.ispoi = TRUE_;
+#line 19277 ""
}
+#line 19278 ""
if (*(unsigned char *)dotq == 'm') {
/* Need another call to the note, in case the first one has octave shifts */
+#line 19282 ""
if (lnoten == 2) {
/* Writing concatenation */
+#line 19283 ""
i__3[0] = *lnote, a__1[0] = notexq;
+#line 19283 ""
i__3[1] = 1, a__1[1] = "{";
+#line 19283 ""
i__3[2] = 1, a__1[2] = noteq + 1;
+#line 19283 ""
i__3[3] = 1, a__1[3] = "}";
+#line 19283 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
+#line 19284 ""
*lnote += 3;
+#line 19285 ""
} else {
+#line 19286 ""
i__1 = lnoten - 2;
/* Writing concatenation */
+#line 19286 ""
i__6[0] = *lnote, a__4[0] = notexq;
+#line 19286 ""
i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1;
+#line 19286 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19287 ""
++(*lnote);
+#line 19288 ""
}
+#line 19289 ""
}
+#line 19290 ""
}
+#line 19291 ""
} else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
/* Blank rest */
/* Writing concatenation */
+#line 19295 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19295 ""
i__6[1] = 2, a__4[1] = "sk";
+#line 19295 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19296 ""
*lnote = 3;
+#line 19297 ""
} else {
/* Non-blank rest */
+#line 19301 ""
*lnote = 0;
+#line 19302 ""
nole = (nole + 20) % 100 - 20;
/* Kluge to get pause symbol for rp: */
+#line 19306 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) {
+#line 19306 ""
nodu = 64;
+#line 19306 ""
}
+#line 19307 ""
if (nodu <= 28) {
/* Normal rest < or = double-dotted quarter */
+#line 19311 ""
lrest = 3;
+#line 19312 ""
if (nodu > 14) {
/* Writing concatenation */
+#line 19313 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19313 ""
i__6[1] = 2, a__4[1] = "qp";
+#line 19313 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19314 ""
} else if (nodu > 7) {
/* Writing concatenation */
+#line 19315 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19315 ""
i__6[1] = 2, a__4[1] = "ds";
+#line 19315 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19316 ""
} else if (nodu > 3) {
/* Writing concatenation */
+#line 19317 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19317 ""
i__6[1] = 2, a__4[1] = "qs";
+#line 19317 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19318 ""
} else if (nodu > 1) {
/* Writing concatenation */
+#line 19319 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19319 ""
i__6[1] = 2, a__4[1] = "hs";
+#line 19319 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19320 ""
} else {
/* Writing concatenation */
+#line 19321 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19321 ""
i__6[1] = 3, a__4[1] = "qqs";
+#line 19321 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19322 ""
lrest = 4;
+#line 19323 ""
}
-/* if (2**log2(nodu) .ne. nodu) then */
-/* c */
-/* c One or two dots on rest */
-/* c */
-/* restq = restq(1:3)//'p' */
-/* lrest = 4 */
-/* if (2*nodu .gt. 3*2**log2(nodu)) then */
-/* c */
-/* c Double dotted rest */
-/* c */
-/* restq = restq(1:4)//'p' */
-/* lrest = 5 */
-/* end if */
-/* end if */
+
+/* Special case for rest at start of F-tuplet inside a forced beam */
+
+#line 19327 ""
+ 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 19329 ""
+ i__4[0] = 1, a__2[0] = all_1.sq;
+#line 19329 ""
+ i__4[1] = 3, a__2[1] = "pt4";
+#line 19329 ""
+ i__4[2] = lrest, a__2[2] = restq;
+#line 19329 ""
+ s_cat(restq, a__2, i__4, &c__3, (ftnlen)40);
+#line 19330 ""
+ lrest += 4;
+#line 19331 ""
+ }
+#line 19332 ""
s_copy(notexq, restq, (ftnlen)79, (ftnlen)40);
+#line 19333 ""
*lnote = lrest;
/* At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. */
+#line 19337 ""
if (nole != 0) {
+#line 19338 ""
if (abs(nole) < 10) {
+#line 19339 ""
i__1 = abs(nole) + 48;
+#line 19339 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 19339 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
+#line 19340 ""
lnoten = 1;
+#line 19341 ""
} else {
- s_wsfi(&io___1143);
+#line 19342 ""
+ s_wsfi(&io___1188);
+#line 19342 ""
i__1 = abs(nole);
+#line 19342 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
+#line 19342 ""
e_wsfi();
+#line 19343 ""
lnoten = 2;
+#line 19344 ""
}
+#line 19345 ""
if (nole > 0) {
/* Writing concatenation */
+#line 19346 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19346 ""
i__5[1] = 5, a__3[1] = "raise";
+#line 19346 ""
i__5[2] = lnoten, a__3[2] = noteq;
+#line 19346 ""
i__5[3] = 1, a__3[3] = all_1.sq;
+#line 19346 ""
i__5[4] = 9, a__3[4] = "internote";
+#line 19346 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19347 ""
} else {
/* Writing concatenation */
+#line 19348 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 19348 ""
i__5[1] = 5, a__3[1] = "lower";
+#line 19348 ""
i__5[2] = lnoten, a__3[2] = noteq;
+#line 19348 ""
i__5[3] = 1, a__3[3] = all_1.sq;
+#line 19348 ""
i__5[4] = 9, a__3[4] = "internote";
+#line 19348 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
+#line 19349 ""
}
+#line 19350 ""
*lnote = lnoten + 16;
-/* if (2**log2(nodu) .ne. nodu) then */
-/* c */
-/* c Have dot in raised rest. must put in hbox! */
-/* c */
-/* notexq = notexq(1:lnote)//sq//'hbox{' */
-/* lnote = lnote+6 */
-/* end if */
/* Writing concatenation */
+#line 19351 ""
i__6[0] = *lnote, a__4[0] = notexq;
+#line 19351 ""
i__6[1] = lrest, a__4[1] = restq;
+#line 19351 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19352 ""
*lnote += lrest;
-/* if (2**log2(nodu) .ne. nodu) then */
-/* notexq = notexq(1:lnote)//'}' */
-/* lnote = lnote+1 */
-/* end if */
+#line 19353 ""
}
+#line 19354 ""
i__1 = log2_(&nodu);
+#line 19354 ""
if (pow_ii(&c__2, &i__1) != nodu) {
/* Deal with dots (on rests shorter than half rest) */
/* Writing concatenation */
+#line 19358 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19358 ""
i__6[1] = 2, a__4[1] = "pt";
+#line 19358 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19359 ""
lrest = 3;
+#line 19360 ""
i__1 = log2_(&nodu);
+#line 19360 ""
if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
/* Writing concatenation */
+#line 19361 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19361 ""
i__6[1] = 3, a__4[1] = "ppt";
+#line 19361 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19362 ""
lrest = 4;
+#line 19363 ""
}
+#line 19364 ""
nole += 4;
+#line 19365 ""
raisedot = 0.f;
/* Tweak dot positions for special cases */
+#line 19369 ""
even = (nole + 100) % 2 == 0;
/* if (.not.even.and.nodu.gt.8.and. */
/* * (nole.lt.0.or.nole.gt.8)) then */
+#line 19372 ""
if (! even && (nole < 0 || nole > 8)) {
+#line 19373 ""
raisedot = 1.f;
+#line 19374 ""
}
+#line 19375 ""
if (nole >= 10 || nole <= -1) {
- s_wsfi(&io___1147);
+#line 19376 ""
+ s_wsfi(&io___1192);
+#line 19376 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
+#line 19376 ""
e_wsfi();
/* Writing concatenation */
+#line 19377 ""
i__3[0] = lrest, a__1[0] = restq;
+#line 19377 ""
i__3[1] = 1, a__1[1] = "{";
+#line 19377 ""
i__3[2] = 2, a__1[2] = numq;
+#line 19377 ""
i__3[3] = 1, a__1[3] = "}";
+#line 19377 ""
s_cat(restq, a__1, i__3, &c__4, (ftnlen)40);
+#line 19378 ""
lrest += 4;
+#line 19379 ""
} else {
/* Writing concatenation */
+#line 19380 ""
i__6[0] = lrest, a__4[0] = restq;
+#line 19380 ""
i__1 = nole + 48;
+#line 19380 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 19380 ""
i__6[1] = 1, a__4[1] = ch__1;
+#line 19380 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
+#line 19381 ""
++lrest;
+#line 19382 ""
}
+#line 19383 ""
if (raisedot > 0.f) {
/* Writing concatenation */
+#line 19384 ""
i__7[0] = 1, a__5[0] = all_1.sq;
+#line 19384 ""
i__7[1] = 5, a__5[1] = "raise";
+#line 19384 ""
i__7[2] = 1, a__5[2] = all_1.sq;
+#line 19384 ""
i__7[3] = 9, a__5[3] = "internote";
+#line 19384 ""
i__7[4] = 1, a__5[4] = all_1.sq;
+#line 19384 ""
i__7[5] = 5, a__5[5] = "hbox{";
+#line 19384 ""
i__7[6] = lrest, a__5[6] = restq;
+#line 19384 ""
i__7[7] = 1, a__5[7] = "}";
+#line 19384 ""
s_cat(restq, a__5, i__7, &c__8, (ftnlen)40);
+#line 19386 ""
lrest += 23;
+#line 19387 ""
}
/* Writing concatenation */
+#line 19388 ""
i__6[0] = lrest, a__4[0] = restq;
+#line 19388 ""
i__6[1] = *lnote, a__4[1] = notexq;
+#line 19388 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19389 ""
*lnote += lrest;
+#line 19390 ""
}
+#line 19391 ""
} else {
/* Half rest or longer */
+#line 19395 ""
if (nole == 0) {
/* Half or longer rest is not raised or lowered */
+#line 19399 ""
if (nodu <= 56) {
/* Writing concatenation */
+#line 19400 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19400 ""
i__6[1] = 6, a__4[1] = "hpause";
+#line 19400 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19401 ""
*lnote = 7;
+#line 19402 ""
} else if (nodu <= 112) {
+#line 19403 ""
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 19405 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19405 ""
i__6[1] = 5, a__4[1] = "pause";
+#line 19405 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19406 ""
} else {
/* Writing concatenation */
+#line 19407 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19407 ""
i__6[1] = 5, a__4[1] = "pausc";
+#line 19407 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19408 ""
}
+#line 19409 ""
*lnote = 6;
+#line 19410 ""
} else {
/* Writing concatenation */
+#line 19411 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19411 ""
i__6[1] = 5, a__4[1] = "PAuse";
+#line 19411 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19412 ""
*lnote = 6;
+#line 19413 ""
}
+#line 19414 ""
i__1 = log2_(&nodu);
+#line 19414 ""
if (pow_ii(&c__2, &i__1) != nodu) {
/* Dotted rest, hpause or longer */
/* Writing concatenation */
+#line 19418 ""
i__6[0] = *lnote, a__4[0] = notexq;
+#line 19418 ""
i__6[1] = 1, a__4[1] = "p";
+#line 19418 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19419 ""
++(*lnote);
+#line 19420 ""
i__1 = log2_(&nodu);
+#line 19420 ""
if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
/* Double dotted long rest */
/* Writing concatenation */
+#line 19424 ""
i__6[0] = *lnote, a__4[0] = notexq;
+#line 19424 ""
i__6[1] = 1, a__4[1] = "p";
+#line 19424 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19425 ""
++(*lnote);
+#line 19426 ""
}
+#line 19427 ""
}
+#line 19428 ""
} else {
/* Raised or lowered half or whole rest */
+#line 19432 ""
if (nodu == 32) {
/* Writing concatenation */
+#line 19433 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19433 ""
i__6[1] = 10, a__4[1] = "lifthpause";
+#line 19433 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19434 ""
*lnote = 11;
+#line 19435 ""
} else if (nodu == 48) {
/* Writing concatenation */
+#line 19436 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19436 ""
i__6[1] = 11, a__4[1] = "lifthpausep";
+#line 19436 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19437 ""
*lnote = 12;
+#line 19438 ""
} else if (nodu == 56) {
/* Writing concatenation */
+#line 19439 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19439 ""
i__6[1] = 12, a__4[1] = "lifthpausepp";
+#line 19439 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19440 ""
*lnote = 13;
+#line 19441 ""
} else if (nodu == 64) {
/* Writing concatenation */
+#line 19442 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19442 ""
i__6[1] = 9, a__4[1] = "liftpause";
+#line 19442 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19443 ""
*lnote = 10;
+#line 19444 ""
} else if (nodu == 96) {
/* Writing concatenation */
+#line 19445 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19445 ""
i__6[1] = 10, a__4[1] = "liftpausep";
+#line 19445 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19446 ""
*lnote = 11;
+#line 19447 ""
} else if (nodu == 112) {
/* Writing concatenation */
+#line 19448 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19448 ""
i__6[1] = 11, a__4[1] = "liftpausepp";
+#line 19448 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19449 ""
*lnote = 12;
+#line 19450 ""
} else if (nodu == 128) {
/* Writing concatenation */
+#line 19451 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19451 ""
i__6[1] = 9, a__4[1] = "liftPAuse";
+#line 19451 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19452 ""
*lnote = 10;
+#line 19453 ""
} else {
/* Assume dotted double whole rest */
/* Writing concatenation */
+#line 19457 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 19457 ""
i__6[1] = 10, a__4[1] = "liftPAusep";
+#line 19457 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19458 ""
*lnote = 11;
+#line 19459 ""
}
/* Set up height spec */
+#line 19463 ""
i__1 = abs(nole) / 2;
+#line 19463 ""
nole = i_sign(&i__1, &nole);
+#line 19464 ""
if (nole <= 9 && nole >= 0) {
+#line 19465 ""
i__1 = nole + 48;
+#line 19465 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 19465 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
+#line 19466 ""
lnoten = 1;
+#line 19467 ""
} else {
+#line 19468 ""
s_copy(noteq, "{", (ftnlen)8, (ftnlen)1);
+#line 19469 ""
if (nole >= -9) {
- s_wsfi(&io___1148);
+#line 19470 ""
+ s_wsfi(&io___1193);
+#line 19470 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
+#line 19470 ""
e_wsfi();
+#line 19471 ""
lnoten = 3;
+#line 19472 ""
} else {
- s_wsfi(&io___1149);
+#line 19473 ""
+ s_wsfi(&io___1194);
+#line 19473 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
+#line 19473 ""
e_wsfi();
+#line 19474 ""
lnoten = 4;
+#line 19475 ""
}
/* Writing concatenation */
+#line 19476 ""
i__6[0] = lnoten, a__4[0] = noteq;
+#line 19476 ""
i__6[1] = 1, a__4[1] = "}";
+#line 19476 ""
s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8);
+#line 19477 ""
++lnoten;
+#line 19478 ""
}
/* Writing concatenation */
+#line 19479 ""
i__6[0] = *lnote, a__4[0] = notexq;
+#line 19479 ""
i__6[1] = lnoten, a__4[1] = noteq;
+#line 19479 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 19480 ""
*lnote += lnoten;
+#line 19481 ""
}
+#line 19482 ""
}
+#line 19483 ""
}
+#line 19484 ""
return 0;
} /* notex_ */
@@ -28803,56 +46518,98 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
/* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */
+#line 19493 ""
ndxs2 = i_indx(line, s2q, line_len, s2q_len);
+#line 19494 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 19494 ""
ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1);
+#line 19495 ""
if (ndxbs == 0 || ndxs2 < ndxbs) {
+#line 19496 ""
ret_val = ndxs2;
+#line 19497 ""
} 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 19502 ""
len = lenstr_(line, lenline, line_len);
+#line 19503 ""
intex = TRUE_;
+#line 19504 ""
i__1 = len;
+#line 19504 ""
for (ic = ndxbs + 1; ic <= i__1; ++ic) {
+#line 19505 ""
if (ic == ndxs2) {
+#line 19506 ""
if (intex) {
+#line 19507 ""
ret_val = 0;
+#line 19508 ""
i__2 = ic;
+#line 19508 ""
ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) +
ic;
+#line 19509 ""
} else {
+#line 19510 ""
ret_val = ndxs2;
+#line 19511 ""
return ret_val;
+#line 19512 ""
}
+#line 19513 ""
} else /* if(complicated condition) */ {
+#line 19513 ""
i__2 = ic;
/* Writing concatenation */
+#line 19513 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 19513 ""
i__3[0] = 1, a__1[0] = ch__1;
+#line 19513 ""
i__3[1] = 1, a__1[1] = " ";
+#line 19513 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
+#line 19513 ""
if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen)
2) == 0) {
+#line 19514 ""
intex = FALSE_;
+#line 19515 ""
} else /* if(complicated condition) */ {
+#line 19515 ""
i__2 = ic;
/* Writing concatenation */
+#line 19515 ""
i__3[0] = 1, a__1[0] = " ";
+#line 19515 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 19515 ""
i__3[1] = 1, a__1[1] = ch__1;
+#line 19515 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
+#line 19515 ""
if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (
ftnlen)2) == 0) {
+#line 19517 ""
intex = TRUE_;
+#line 19518 ""
}
+#line 19518 ""
}
+#line 19518 ""
}
+#line 19519 ""
/* L1: */
+#line 19519 ""
}
+#line 19520 ""
}
+#line 19521 ""
return ret_val;
} /* ntindex_ */
@@ -28879,32 +46636,56 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
/* This appends to notexq e.g. '\ibbbu1' */
+#line 19532 ""
if (*n >= 5) {
+#line 19532 ""
combbm_1.isbbm = TRUE_;
+#line 19532 ""
}
+#line 19533 ""
if (*lnote > 0) {
/* Writing concatenation */
+#line 19534 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 19534 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 19534 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 19534 ""
i__1[2] = 1, a__1[2] = char1q;
+#line 19534 ""
s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
+#line 19535 ""
} else {
/* Writing concatenation */
+#line 19536 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 19536 ""
i__2[0] = 1, a__2[0] = ch__1;
+#line 19536 ""
i__2[1] = 1, a__2[1] = char1q;
+#line 19536 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 19537 ""
}
+#line 19538 ""
*lnote += 2;
+#line 19539 ""
i__3 = *n;
+#line 19539 ""
for (im = 1; im <= i__3; ++im) {
/* Writing concatenation */
+#line 19540 ""
i__2[0] = *lnote, a__2[0] = notexq;
+#line 19540 ""
i__2[1] = 1, a__2[1] = "b";
+#line 19540 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
+#line 19541 ""
++(*lnote);
+#line 19542 ""
/* L3: */
+#line 19542 ""
}
/* add the number, 0 if 12 */
@@ -28912,21 +46693,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 19549 ""
if (*iv < 24) {
+#line 19550 ""
istring_(iv, tempq, &len, (ftnlen)4);
+#line 19551 ""
} else if (*iv == 24) {
+#line 19552 ""
*(unsigned char *)tempq = '0';
+#line 19553 ""
len = 1;
+#line 19554 ""
} else {
+#line 19555 ""
printl_("Sorry, too man open beams", (ftnlen)25);
+#line 19556 ""
stop1_();
+#line 19557 ""
}
/* Writing concatenation */
+#line 19558 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 19558 ""
i__1[1] = 1, a__1[1] = ulqq;
+#line 19558 ""
i__1[2] = len, a__1[2] = tempq;
+#line 19558 ""
s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
+#line 19559 ""
*lnote = *lnote + 1 + len;
+#line 19560 ""
return 0;
} /* ntrbbb_ */
@@ -28944,17 +46740,27 @@ integer numclef_(char *clefq, ftnlen clefq_len)
/* 7 f 9 */
/* 8 0 */
+#line 19570 ""
if (*(unsigned char *)clefq < 55) {
/* if (ichar(clefq) .le. 55) then */
+#line 19572 ""
ret_val = *(unsigned char *)clefq - 48;
/* if (numclef .eq. 7) numclef = 9 */
+#line 19574 ""
} else if (*(unsigned char *)clefq == '7') {
+#line 19575 ""
ret_val = 9;
+#line 19576 ""
} else if (*(unsigned char *)clefq == '8') {
+#line 19577 ""
ret_val = 0;
+#line 19578 ""
} else {
+#line 19579 ""
ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1;
+#line 19580 ""
}
+#line 19581 ""
return ret_val;
} /* numclef_ */
@@ -28976,65 +46782,121 @@ integer numclef_(char *clefq, ftnlen clefq_len)
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static integer nfmt;
+#line 19585 ""
r__1 = *i__ + .5f;
+#line 19585 ""
nfmt = r_lg10(&r__1) + 2;
+#line 19586 ""
if (*jlast + 5 + nfmt < 80) {
+#line 19587 ""
ci__1.cierr = 0;
+#line 19587 ""
ci__1.ciunit = 6;
/* Writing concatenation */
+#line 19587 ""
i__1[0] = 5, a__1[0] = "(a5,i";
+#line 19587 ""
i__2 = nfmt + 48;
+#line 19587 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 19587 ""
i__1[1] = 1, a__1[1] = ch__2;
+#line 19587 ""
i__1[2] = 3, a__1[2] = ",$)";
+#line 19587 ""
ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
+#line 19587 ""
s_wsfe(&ci__1);
+#line 19587 ""
do_fio(&c__1, " Bar", (ftnlen)5);
+#line 19587 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
+#line 19587 ""
e_wsfe();
+#line 19588 ""
ci__1.cierr = 0;
+#line 19588 ""
ci__1.ciunit = 15;
/* Writing concatenation */
+#line 19588 ""
i__1[0] = 5, a__1[0] = "(a5,i";
+#line 19588 ""
i__2 = nfmt + 48;
+#line 19588 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 19588 ""
i__1[1] = 1, a__1[1] = ch__2;
+#line 19588 ""
i__1[2] = 3, a__1[2] = ",$)";
+#line 19588 ""
ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
+#line 19588 ""
s_wsfe(&ci__1);
+#line 19588 ""
do_fio(&c__1, " Bar", (ftnlen)5);
+#line 19588 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
+#line 19588 ""
e_wsfe();
+#line 19589 ""
*jlast = *jlast + 5 + nfmt;
+#line 19590 ""
} else {
+#line 19591 ""
ci__1.cierr = 0;
+#line 19591 ""
ci__1.ciunit = 6;
/* Writing concatenation */
+#line 19591 ""
i__1[0] = 7, a__1[0] = "(/,a5,i";
+#line 19591 ""
i__2 = nfmt + 48;
+#line 19591 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 19591 ""
i__1[1] = 1, a__1[1] = ch__2;
+#line 19591 ""
i__1[2] = 3, a__1[2] = ",$)";
+#line 19591 ""
ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
+#line 19591 ""
s_wsfe(&ci__1);
+#line 19591 ""
do_fio(&c__1, " Bar", (ftnlen)5);
+#line 19591 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
+#line 19591 ""
e_wsfe();
+#line 19592 ""
ci__1.cierr = 0;
+#line 19592 ""
ci__1.ciunit = 15;
/* Writing concatenation */
+#line 19592 ""
i__1[0] = 7, a__1[0] = "(/,a5,i";
+#line 19592 ""
i__2 = nfmt + 48;
+#line 19592 ""
chax_(ch__2, (ftnlen)1, &i__2);
+#line 19592 ""
i__1[1] = 1, a__1[1] = ch__2;
+#line 19592 ""
i__1[2] = 3, a__1[2] = ",$)";
+#line 19592 ""
ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
+#line 19592 ""
s_wsfe(&ci__1);
+#line 19592 ""
do_fio(&c__1, " Bar", (ftnlen)5);
+#line 19592 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
+#line 19592 ""
e_wsfe();
+#line 19593 ""
*jlast = nfmt + 5;
+#line 19594 ""
}
+#line 19595 ""
return 0;
} /* outbar_ */
@@ -29125,32 +46987,32 @@ integer numclef_(char *clefq, ftnlen clefq_len)
static integer instnow, nsystpp;
/* Fortran I/O blocks */
- static cilist io___1162 = { 0, 6, 0, 0, 0 };
- static cilist io___1163 = { 0, 6, 0, 0, 0 };
- static cilist io___1164 = { 0, 15, 0, "(a)", 0 };
- static cilist io___1165 = { 0, 19, 0, "(i6)", 0 };
- static cilist io___1177 = { 0, 6, 0, 0, 0 };
- static cilist io___1181 = { 0, 6, 0, 0, 0 };
- static cilist io___1187 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
- static cilist io___1188 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
- static cilist io___1193 = { 0, 6, 0, 0, 0 };
- static cilist io___1195 = { 0, 6, 0, 0, 0 };
- static cilist io___1196 = { 0, 6, 0, 0, 0 };
- static cilist io___1197 = { 0, 6, 0, 0, 0 };
- static cilist io___1198 = { 0, 15, 0, "(a,2i5)", 0 };
- static cilist io___1199 = { 0, 15, 0, "(a)", 0 };
- static cilist io___1201 = { 0, 12, 0, "(a)", 0 };
- static cilist io___1202 = { 0, 12, 0, 0, 0 };
- static cilist io___1203 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 };
- static cilist io___1204 = { 0, 12, 0, 0, 0 };
- static cilist io___1223 = { 0, 12, 0, 0, 0 };
- static cilist io___1238 = { 0, 12, 0, "(i5)", 0 };
- static cilist io___1256 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 };
- static cilist io___1257 = { 0, 13, 0, "(i5)", 0 };
- static cilist io___1258 = { 0, 6, 0, "(/,a)", 0 };
- static cilist io___1259 = { 0, 6, 0, 0, 0 };
- static cilist io___1260 = { 0, 15, 0, "(/,a)", 0 };
- static cilist io___1261 = { 0, 15, 0, "()", 0 };
+ static cilist io___1207 = { 0, 6, 0, 0, 0 };
+ static cilist io___1208 = { 0, 6, 0, 0, 0 };
+ static cilist io___1209 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___1210 = { 0, 19, 0, "(i6)", 0 };
+ static cilist io___1222 = { 0, 6, 0, 0, 0 };
+ static cilist io___1226 = { 0, 6, 0, 0, 0 };
+ static cilist io___1232 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
+ static cilist io___1233 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
+ static cilist io___1238 = { 0, 6, 0, 0, 0 };
+ static cilist io___1240 = { 0, 6, 0, 0, 0 };
+ static cilist io___1241 = { 0, 6, 0, 0, 0 };
+ static cilist io___1242 = { 0, 6, 0, 0, 0 };
+ static cilist io___1243 = { 0, 15, 0, "(a,2i5)", 0 };
+ static cilist io___1244 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___1246 = { 0, 12, 0, "(a)", 0 };
+ static cilist io___1247 = { 0, 12, 0, 0, 0 };
+ static cilist io___1248 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 };
+ static cilist io___1249 = { 0, 12, 0, 0, 0 };
+ static cilist io___1268 = { 0, 12, 0, 0, 0 };
+ static cilist io___1283 = { 0, 12, 0, "(i5)", 0 };
+ static cilist io___1301 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 };
+ static cilist io___1302 = { 0, 13, 0, "(i5)", 0 };
+ static cilist io___1303 = { 0, 6, 0, "(/,a)", 0 };
+ static cilist io___1304 = { 0, 6, 0, 0, 0 };
+ static cilist io___1305 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___1306 = { 0, 15, 0, "()", 0 };
/* ccccccccccccccccccccccccccccccccccccccccccccccc */
@@ -29184,195 +47046,359 @@ integer numclef_(char *clefq, ftnlen clefq_len)
/* cccccccccccccccccccccccccccccccccc */
/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
/* logical mrecord,mplay,endmac,gotclef,cstuplet */
+#line 19680 ""
/* Parameter adjustments */
+#line 19680 ""
--nbarss;
+#line 19680 ""
+#line 19680 ""
/* Function Body */
+#line 19682 ""
+ comis4bignv_1.is4bignv = FALSE_;
+#line 19683 ""
+ comis4bignv_1.aiset = FALSE_;
+#line 19684 ""
commus_1.whead20 = .3f;
+#line 19685 ""
if (! (*optimize)) {
- s_wsle(&io___1162);
+#line 19686 ""
+ s_wsle(&io___1207);
+#line 19686 ""
e_wsle();
- s_wsle(&io___1163);
+#line 19687 ""
+ s_wsle(&io___1208);
+#line 19687 ""
do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23);
+#line 19687 ""
e_wsle();
- s_wsfe(&io___1164);
+#line 19688 ""
+ s_wsfe(&io___1209);
+#line 19688 ""
do_fio(&c__1, " Starting first PMX pass", (ftnlen)24);
+#line 19688 ""
e_wsfe();
+#line 19689 ""
}
+#line 19690 ""
if (*isfirst) {
+#line 19691 ""
o__1.oerr = 0;
+#line 19691 ""
o__1.ounit = 19;
+#line 19691 ""
o__1.ofnmlen = 11;
+#line 19691 ""
o__1.ofnm = "pmxaerr.dat";
+#line 19691 ""
o__1.orl = 0;
+#line 19691 ""
o__1.osta = 0;
+#line 19691 ""
o__1.oacc = 0;
+#line 19691 ""
o__1.ofm = 0;
+#line 19691 ""
o__1.oblnk = 0;
+#line 19691 ""
f_open(&o__1);
- s_wsfe(&io___1165);
+#line 19692 ""
+ s_wsfe(&io___1210);
+#line 19692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 19692 ""
e_wsfe();
+#line 19693 ""
cl__1.cerr = 0;
+#line 19693 ""
cl__1.cunit = 19;
+#line 19693 ""
cl__1.csta = 0;
+#line 19693 ""
f_clos(&cl__1);
+#line 19694 ""
}
+#line 19695 ""
if (! (*optimize)) {
+#line 19695 ""
jprntb = 81;
+#line 19695 ""
}
+#line 19696 ""
commac_1.macuse = 0;
+#line 19697 ""
comkeys_1.ornrpt = FALSE_;
+#line 19698 ""
comkeys_1.stickys = FALSE_;
+#line 19699 ""
commac_1.mrecord = FALSE_;
+#line 19700 ""
commac_1.mplay = FALSE_;
+#line 19701 ""
c1omget_1.lastchar = FALSE_;
+#line 19702 ""
comnvst_2.novshrinktop = FALSE_;
+#line 19703 ""
cstuplet = FALSE_;
+#line 19704 ""
comslur_1.fontslur = TRUE_;
+#line 19705 ""
comligfont_1.isligfont = FALSE_;
+#line 19706 ""
fulltrans = FALSE_;
+#line 19707 ""
for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999;
++c1omnotes_1.ibarcnt) {
+#line 19708 ""
c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f;
+#line 19709 ""
c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f;
+#line 19710 ""
/* L42: */
+#line 19710 ""
}
/* Initialize input buffer */
+#line 19714 ""
c1omget_1.lenbuf0 = inbuff_1.ipbuf;
+#line 19715 ""
inbuff_1.ipbuf = 0;
+#line 19716 ""
inbuff_1.ilbuf = 1;
+#line 19717 ""
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 19722 ""
ivnow = 0;
+#line 19723 ""
i__1 = comkeys_1.noinst;
+#line 19723 ""
for (instnow = 1; instnow <= i__1; ++instnow) {
+#line 19724 ""
i__2 = c1omget_1.nsperi[instnow - 1];
+#line 19724 ""
for (iscount = 1; iscount <= i__2; ++iscount) {
+#line 19725 ""
++ivnow;
+#line 19726 ""
cominsttrans_1.instno[ivnow - 1] = instnow;
+#line 19727 ""
/* L14: */
+#line 19727 ""
}
+#line 19728 ""
/* L13: */
+#line 19728 ""
}
/* Save initial meter for midi */
+#line 19732 ""
if (! (*isfirst) && compage_1.npages == 0) {
- s_wsle(&io___1177);
+#line 19733 ""
+ s_wsle(&io___1222);
+#line 19733 ""
do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", (
ftnlen)43);
+#line 19733 ""
e_wsle();
+#line 19734 ""
stop1_();
+#line 19735 ""
}
+#line 19736 ""
*nsyout = compage_1.nsyst;
/* isig1 will be changed in getnote if there is a transposition */
+#line 19740 ""
comkeys_1.isig1 = comkeys_1.newkey[0];
+#line 19741 ""
if (compage_1.npages > compage_1.nsyst) {
+#line 19742 ""
printl_("npages > nsyst in input. Please fix the input.", (ftnlen)47)
;
+#line 19743 ""
stop1_();
+#line 19744 ""
}
/* fbar = afterruleskip/elemskip */
/* apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */
+#line 19749 ""
c1ommvl_1.fbar = 1.f;
+#line 19750 ""
c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
+#line 19751 ""
ifig = 0;
+#line 19752 ""
compage_1.usefig = TRUE_;
+#line 19753 ""
lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
+#line 19754 ""
lenmult = 1;
+#line 19755 ""
if (mtrdenl == 2) {
+#line 19756 ""
lenbeat = 16;
+#line 19757 ""
lenmult = 2;
+#line 19758 ""
}
+#line 19759 ""
a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat;
+#line 19760 ""
r__1 = lenmult * xmtrnum0 * lenbeat;
+#line 19760 ""
a1ll_2.lenbr0 = i_nint(&r__1);
+#line 19761 ""
a1ll_2.mtrnuml = 0;
+#line 19762 ""
if (a1ll_2.lenbr0 != 0) {
+#line 19763 ""
c1omnotes_1.ibaroff = 1;
+#line 19764 ""
a1ll_2.lenbar = a1ll_2.lenbr0;
+#line 19765 ""
} else {
+#line 19766 ""
c1omnotes_1.ibaroff = 0;
+#line 19767 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
+#line 19768 ""
}
+#line 19769 ""
c1omnotes_1.ibarcnt = 0;
+#line 19770 ""
c1omnotes_1.nptr[0] = 1;
+#line 19771 ""
a1ll_2.iccount = 128;
+#line 19772 ""
compage_1.nmovbrk = 0;
+#line 19773 ""
compage_1.nflb = 0;
+#line 19774 ""
compage_1.nfpb = 0;
+#line 19775 ""
compage_1.ipagfpb[0] = 1;
+#line 19776 ""
compage_1.isysfpb[0] = 1;
+#line 19777 ""
compage_1.ibarflb[0] = 1;
+#line 19778 ""
compage_1.isysflb[0] = 1;
+#line 19779 ""
compage_1.nistaff[0] = a1ll_2.nv - 1;
/* Check for pmx.mod */
+#line 19783 ""
c1omget_1.linesinpmxmod = 0;
/* line1pmxmod = ilbuf */
+#line 19785 ""
getpmxmod_(&c_true, " ", (ftnlen)1);
+#line 19786 ""
if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) {
- s_wsle(&io___1181);
- do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"
+#line 19787 ""
+ s_wsle(&io___1226);
+#line 19787 ""
+ do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"\
"ile", (ftnlen)49);
+#line 19787 ""
e_wsle();
+#line 19788 ""
stop1_();
+#line 19789 ""
}
/* Initialize for loop over lines */
+#line 19793 ""
comkeys_1.nkeys = 1;
+#line 19794 ""
comkeys_1.ibrkch[0] = 1;
+#line 19795 ""
comkeys_1.mbrestsav = 0;
+#line 19796 ""
comkeys_1.shifton = FALSE_;
+#line 19797 ""
a1ll_2.firstline = TRUE_;
+#line 19798 ""
a1ll_2.newmeter = FALSE_;
+#line 19799 ""
c1omget_1.ihead = 0;
+#line 19800 ""
c1omget_1.isheadr = FALSE_;
/* gotclef = .false. */
+#line 19802 ""
comkeys_1.idsig = 0;
+#line 19803 ""
c1omnotes_1.iddot = 0;
+#line 19804 ""
compage_1.fintstf = -1.f;
+#line 19805 ""
compage_1.gintstf = 1.f;
+#line 19806 ""
listcresc = 0;
+#line 19807 ""
listdecresc = 0;
+#line 19808 ""
L30:
+#line 19808 ""
loop = TRUE_;
+#line 19809 ""
comkeys_1.iskchb = FALSE_;
+#line 19810 ""
c1omget_1.issegno = FALSE_;
+#line 19811 ""
a1ll_2.nbars = 0;
+#line 19812 ""
c1omnotes_1.ibarmbr = 0;
+#line 19813 ""
i__1 = a1ll_2.nv;
+#line 19813 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
+#line 19814 ""
c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1;
+#line 19815 ""
c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv;
+#line 19816 ""
a1ll_2.itsofar[a1ll_2.iv - 1] = 0;
+#line 19817 ""
a1ll_2.nnl[a1ll_2.iv - 1] = 0;
+#line 19818 ""
for (j = 1; j <= 200; ++j) {
+#line 19819 ""
a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_;
+#line 19820 ""
c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f;
+#line 19821 ""
/* L5: */
+#line 19821 ""
}
+#line 19822 ""
/* L4: */
+#line 19822 ""
}
+#line 19823 ""
a1ll_2.iv = 1;
+#line 19824 ""
c1ommvl_1.ivx = 1;
+#line 19825 ""
c1omget_1.fbon = FALSE_;
+#line 19826 ""
comkeys_1.barend = FALSE_;
+#line 19827 ""
c1omget_1.isvolt = FALSE_;
+#line 19828 ""
L2:
+#line 19828 ""
if (loop) {
/* Within this short loop, nv voices are filled up for the duration of a block. */
@@ -29380,293 +47406,525 @@ L2:
/* nodur(..),rest(..). nnl will later be */
/* increased and things slid around as accidental skips are added. */
+#line 19835 ""
g1etnote_(&loop, &ifig, optimize, &fulltrans);
+#line 19836 ""
if (c1omget_1.lastchar) {
+#line 19836 ""
goto L20;
+#line 19836 ""
}
+#line 19837 ""
goto L2;
+#line 19838 ""
}
+#line 19839 ""
if (comkeys_1.mbrestsav > 0) {
+#line 19840 ""
printl_(" ", (ftnlen)1);
+#line 19841 ""
printl_("You must enter the same multibar rest in ALL parts", (ftnlen)
50);
+#line 19843 ""
stop1_();
+#line 19844 ""
}
+#line 19845 ""
i__1 = a1ll_2.nbars;
+#line 19845 ""
for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
+#line 19846 ""
++c1omnotes_1.ibarcnt;
/* The following is just a signal to start a new bar when cataloging spaces */
/* for catspace(...) */
+#line 19851 ""
c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[
c1omnotes_1.ibarcnt - 1];
+#line 19852 ""
newmb[c1omnotes_1.ibarcnt - 1] = FALSE_;
+#line 19853 ""
if (a1ll_2.newmeter && a1ll_2.ibar == 1) {
+#line 19853 ""
newmb[c1omnotes_1.ibarcnt - 1] = TRUE_;
+#line 19853 ""
}
/* Above is only for spacing calcs later on. Remember new meter can only occur */
/* at START of a new input line (ibar = 1) */
+#line 19858 ""
if (a1ll_2.ibar != c1omnotes_1.ibarmbr) {
+#line 19859 ""
if (! (*optimize)) {
+#line 19859 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
+#line 19859 ""
outbar_(&i__2, &jprntb);
+#line 19859 ""
}
+#line 19860 ""
} else {
+#line 19861 ""
if (! (*optimize)) {
- s_wsfe(&io___1187);
+#line 19862 ""
+ s_wsfe(&io___1232);
+#line 19862 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
+#line 19862 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
+#line 19862 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 19862 ""
do_fio(&c__1, "-", (ftnlen)1);
+#line 19862 ""
i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
c1omnotes_1.mbrest - 1;
+#line 19862 ""
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
+#line 19862 ""
e_wsfe();
- s_wsfe(&io___1188);
+#line 19864 ""
+ s_wsfe(&io___1233);
+#line 19864 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
+#line 19864 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
+#line 19864 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 19864 ""
do_fio(&c__1, "-", (ftnlen)1);
+#line 19864 ""
i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
c1omnotes_1.mbrest - 1;
+#line 19864 ""
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
+#line 19864 ""
e_wsfe();
+#line 19866 ""
jprntb = 0;
+#line 19867 ""
}
+#line 19868 ""
c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest +
1;
+#line 19869 ""
}
+#line 19870 ""
if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) {
+#line 19871 ""
if (a1ll_2.ibar == 1) {
+#line 19872 ""
a1ll_2.lenbar = a1ll_2.lenbr0;
+#line 19873 ""
} else {
+#line 19874 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
+#line 19875 ""
}
+#line 19876 ""
}
+#line 19877 ""
if (a1ll_2.ibar > 1) {
/* For bars after first, slide all stuff down to beginning of arrays */
+#line 19881 ""
i__2 = a1ll_2.nv;
+#line 19881 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
+#line 19882 ""
i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 19882 ""
for (kv = 1; kv <= i__3; ++kv) {
+#line 19883 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
+#line 19884 ""
ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24
- 25];
+#line 19885 ""
i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25]
- ioff;
+#line 19885 ""
for (ip = 1; ip <= i__4; ++ip) {
+#line 19886 ""
a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] =
a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24
- 25];
+#line 19887 ""
a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] =
a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24
- 25];
+#line 19888 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] =
c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) *
24 - 25];
+#line 19889 ""
/* L12: */
+#line 19889 ""
}
+#line 19890 ""
/* L11: */
+#line 19890 ""
}
+#line 19890 ""
}
+#line 19891 ""
}
+#line 19892 ""
i__3 = a1ll_2.nv;
+#line 19892 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) {
+#line 19893 ""
i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 19893 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 19894 ""
ioff = 0;
+#line 19895 ""
if (a1ll_2.ibar > 1) {
+#line 19895 ""
ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]
+ (a1ll_2.ibar - 1) * 24 - 25];
+#line 19895 ""
}
+#line 19896 ""
/* L67: */
+#line 19896 ""
}
+#line 19896 ""
}
+#line 19897 ""
makeabar_();
+#line 19898 ""
elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar;
+#line 19899 ""
/* L10: */
+#line 19899 ""
}
+#line 19900 ""
a1ll_2.newmeter = FALSE_;
+#line 19901 ""
a1ll_2.firstline = FALSE_;
+#line 19902 ""
goto L30;
+#line 19903 ""
L20:
/* Vertical analysis. */
+#line 19907 ""
if (compage_1.npages == 0) {
+#line 19908 ""
if (compage_1.nsyst == 0) {
- s_wsle(&io___1193);
- do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"
+#line 19909 ""
+ s_wsle(&io___1238);
+#line 19909 ""
+ do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"\
"ot 0", (ftnlen)46);
+#line 19909 ""
e_wsle();
+#line 19910 ""
stop1_();
+#line 19911 ""
}
+#line 19912 ""
compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1;
+#line 19913 ""
if (a1ll_2.nv == 1) {
+#line 19914 ""
nsystpp = 12;
+#line 19915 ""
} else if (a1ll_2.nv == 2) {
+#line 19916 ""
nsystpp = 7;
+#line 19917 ""
} else if (a1ll_2.nv == 3) {
+#line 19918 ""
nsystpp = 5;
+#line 19919 ""
} else if (a1ll_2.nv == 4) {
+#line 19920 ""
nsystpp = 3;
+#line 19921 ""
} else if (a1ll_2.nv <= 7) {
+#line 19922 ""
nsystpp = 2;
+#line 19923 ""
} else {
+#line 19924 ""
nsystpp = 1;
+#line 19925 ""
}
+#line 19926 ""
compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1;
+#line 19927 ""
}
/* Check nsyst vs ibarcnt */
+#line 19931 ""
if (compage_1.nsyst > c1omnotes_1.ibarcnt) {
- s_wsle(&io___1195);
+#line 19932 ""
+ s_wsle(&io___1240);
+#line 19932 ""
e_wsle();
- s_wsle(&io___1196);
+#line 19933 ""
+ s_wsle(&io___1241);
+#line 19933 ""
do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14);
+#line 19933 ""
do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)
);
+#line 19933 ""
do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(
integer));
+#line 19933 ""
e_wsle();
- s_wsle(&io___1197);
+#line 19934 ""
+ s_wsle(&io___1242);
+#line 19934 ""
do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33);
+#line 19934 ""
e_wsle();
- s_wsfe(&io___1198);
+#line 19935 ""
+ s_wsfe(&io___1243);
+#line 19935 ""
do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15);
+#line 19935 ""
do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
+#line 19935 ""
do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer));
+#line 19935 ""
e_wsfe();
- s_wsfe(&io___1199);
+#line 19936 ""
+ s_wsfe(&io___1244);
+#line 19936 ""
do_fio(&c__1, " There are more systems than bars.", (ftnlen)34);
+#line 19936 ""
e_wsfe();
+#line 19937 ""
stop1_();
+#line 19938 ""
}
/* Set up dummy forced line & page breaks after last real one */
+#line 19942 ""
++compage_1.nflb;
+#line 19943 ""
compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1;
+#line 19944 ""
compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1;
+#line 19945 ""
++compage_1.nfpb;
+#line 19946 ""
compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1;
+#line 19947 ""
compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1;
+#line 19948 ""
heightil = compage_1.ptheight * 4.f / commus_1.musize;
+#line 19949 ""
o__1.oerr = 0;
+#line 19949 ""
o__1.ounit = 12;
+#line 19949 ""
o__1.ofnm = 0;
+#line 19949 ""
o__1.orl = 0;
+#line 19949 ""
o__1.osta = "SCRATCH";
+#line 19949 ""
o__1.oacc = 0;
+#line 19949 ""
o__1.ofm = 0;
+#line 19949 ""
o__1.oblnk = 0;
+#line 19949 ""
f_open(&o__1);
- s_wsfe(&io___1201);
+#line 19950 ""
+ s_wsfe(&io___1246);
+#line 19950 ""
do_fio(&c__1, basenameq, (*lbase));
+#line 19950 ""
e_wsfe();
- s_wsle(&io___1202);
+#line 19951 ""
+ s_wsle(&io___1247);
+#line 19951 ""
do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer));
+#line 19951 ""
e_wsle();
/* Pass to pmxb the initial signature, including effect of transposition. */
- s_wsfe(&io___1203);
+#line 19955 ""
+ s_wsfe(&io___1248);
+#line 19955 ""
do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real));
+#line 19955 ""
do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer));
+#line 19955 ""
do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer));
+#line 19955 ""
do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer));
+#line 19955 ""
e_wsfe();
- s_wsle(&io___1204);
+#line 19957 ""
+ s_wsle(&io___1249);
+#line 19957 ""
do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer));
+#line 19957 ""
do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real));
+#line 19957 ""
do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real));
+#line 19957 ""
do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real));
+#line 19957 ""
do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real));
+#line 19957 ""
do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
+#line 19957 ""
e_wsle();
+#line 19958 ""
iflbnow = -1;
+#line 19959 ""
isysb4 = 0;
+#line 19960 ""
i__1 = compage_1.nfpb;
+#line 19960 ""
for (ifpb = 1; ifpb <= i__1; ++ifpb) {
/* Each time thru this loop is like a single score with several pages */
+#line 19964 ""
compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb -
1];
+#line 19965 ""
compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb -
1];
+#line 19966 ""
nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1;
+#line 19967 ""
nshort = nomnsystp * compage_1.npages - compage_1.nsyst;
+#line 19968 ""
i__2 = compage_1.npages;
+#line 19968 ""
for (ipage = 1; ipage <= i__2; ++ipage) {
+#line 19969 ""
nsystp = nomnsystp;
+#line 19970 ""
if (ipage <= nshort) {
+#line 19970 ""
--nsystp;
+#line 19970 ""
}
/* Last system number on this page: */
+#line 19973 ""
isysendpg = isysb4 + nsystp;
+#line 19974 ""
nintpg = 0;
+#line 19975 ""
i__3 = isysendpg;
+#line 19975 ""
for (isy = isysb4 + 1; isy <= i__3; ++isy) {
+#line 19976 ""
if (compage_1.isysflb[iflbnow + 1] == isy) {
+#line 19976 ""
++iflbnow;
+#line 19976 ""
}
+#line 19977 ""
nintpg += compage_1.nistaff[iflbnow];
+#line 19978 ""
/* L15: */
+#line 19978 ""
}
+#line 19979 ""
xilfrac = 0.f;
+#line 19980 ""
xiltxt = 0.f;
+#line 19981 ""
if (ipage == 1 && c1omget_1.ihead > 0) {
/* Needn't zero out ihead after printing titles if we only allow titles at top? */
+#line 19985 ""
if ((c1omget_1.ihead & 1) == 1) {
+#line 19986 ""
xiltxt += cblock_1.hgtin * 4 / commus_1.musize;
+#line 19987 ""
xilfrac += cblock_1.etait;
+#line 19988 ""
}
+#line 19989 ""
if ((c1omget_1.ihead & 2) == 2) {
+#line 19990 ""
xiltxt += cblock_1.hgtti * 4 / commus_1.musize;
+#line 19991 ""
xilfrac += cblock_1.etatc;
+#line 19992 ""
}
+#line 19993 ""
if ((c1omget_1.ihead & 4) == 4) {
+#line 19994 ""
xiltxt += cblock_1.hgtco * 4 / commus_1.musize;
+#line 19995 ""
xilfrac += cblock_1.etacs1;
+#line 19996 ""
} else {
/* Use double the title-composer space if there is no composer */
+#line 20000 ""
xilfrac += cblock_1.etatc;
+#line 20001 ""
}
+#line 20002 ""
}
+#line 20003 ""
d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot;
/* C = nsystp*(nv-1) */
+#line 20005 ""
c__ = (real) nintpg;
/* xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */
+#line 20007 ""
xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) *
cblock_1.xilbn;
+#line 20008 ""
if (bottreb) {
+#line 20008 ""
xn -= (nsystp - 1) * cblock_1.xilbtc;
+#line 20008 ""
}
+#line 20009 ""
if (c1omget_1.ihead == 0 && c1omget_1.isheadr) {
+#line 20009 ""
xn -= cblock_1.xilhdr;
+#line 20009 ""
}
+#line 20010 ""
if (ifig == 1) {
+#line 20011 ""
xn -= nsystp * cblock_1.xilfig;
+#line 20012 ""
}
+#line 20013 ""
glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__);
+#line 20014 ""
omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a
* c__);
@@ -29695,335 +47953,573 @@ L20:
/* Only the first page will get local adjustment now if needed, others in pmxb */
+#line 20041 ""
if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) {
+#line 20042 ""
facins = compage_1.fintstf;
+#line 20043 ""
compage_1.fintstf = -1.f;
+#line 20044 ""
} else {
/* gintstf = 1.0 by default, but may be changed with AI<x> */
+#line 20048 ""
facins = compage_1.gintstf;
+#line 20049 ""
}
- s_wsle(&io___1223);
+#line 20050 ""
+ s_wsle(&io___1268);
+#line 20050 ""
do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer));
/* Computing MAX */
+#line 20050 ""
r__2 = 0.f, r__3 = cblock_1.etatop * glueil;
+#line 20050 ""
r__1 = dmax(r__2,r__3);
+#line 20050 ""
do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 20050 ""
r__4 = facins * (omegag + 4);
+#line 20050 ""
do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real));
+#line 20050 ""
e_wsle();
+#line 20051 ""
c1omget_1.ihead = 0;
+#line 20052 ""
c1omget_1.isheadr = FALSE_;
+#line 20053 ""
isysb4 = isysendpg;
+#line 20054 ""
/* L7: */
+#line 20054 ""
}
+#line 20055 ""
/* L8: */
+#line 20055 ""
}
/* Done with vertical, now do horizontals */
+#line 20059 ""
celsk[1] = elsk[0];
+#line 20060 ""
i__1 = c1omnotes_1.ibarcnt;
+#line 20060 ""
for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
+#line 20061 ""
celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1];
+#line 20062 ""
/* L21: */
+#line 20062 ""
}
+#line 20063 ""
lastbar[0] = 0;
+#line 20064 ""
ibar1 = 1;
+#line 20065 ""
wmins = -1.f;
+#line 20066 ""
iflb = 1;
+#line 20067 ""
imovbrk = 0;
+#line 20068 ""
ikey = 1;
/* Return nsyst to its *total* value */
+#line 20072 ""
compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1;
+#line 20073 ""
i__1 = compage_1.nsyst;
+#line 20073 ""
for (isyst = 1; isyst <= i__1; ++isyst) {
+#line 20074 ""
if (isyst == compage_1.isysflb[iflb]) {
+#line 20074 ""
++iflb;
+#line 20074 ""
}
+#line 20075 ""
if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) {
+#line 20076 ""
if (isyst == compage_1.isysmb[imovbrk + 1]) {
+#line 20076 ""
++imovbrk;
+#line 20076 ""
}
+#line 20077 ""
}
+#line 20078 ""
ibarb4 = lastbar[isyst - 1];
+#line 20079 ""
if (isyst == 1) {
+#line 20080 ""
if (*isfirst) {
+#line 20080 ""
elsstarg = celsk[compage_1.ibarflb[1] - 1] / (
compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1
- c1omget_1.fracindent);
+#line 20080 ""
}
+#line 20082 ""
celskb4 = 0.f;
+#line 20083 ""
} else {
+#line 20084 ""
celskb4 = celsk[ibarb4];
/* Must dimension isysmb(0:*) just so I can execute this test! */
+#line 20088 ""
if (*isfirst) {
+#line 20089 ""
if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[
imovbrk]) {
/* First syst after forced line break. There may be indentation. */
+#line 20093 ""
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 20096 ""
} else {
/* There is no indentation to deal with */
+#line 20100 ""
elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4)
/ (compage_1.isysflb[iflb] - isyst);
+#line 20102 ""
}
+#line 20103 ""
}
+#line 20104 ""
}
+#line 20105 ""
if (*isfirst) {
+#line 20106 ""
diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1));
+#line 20107 ""
i__2 = c1omnotes_1.ibarcnt;
+#line 20107 ""
for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar)
{
+#line 20108 ""
diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4);
+#line 20109 ""
if (dabs(diff) >= diff1) {
+#line 20109 ""
goto L24;
+#line 20109 ""
}
+#line 20110 ""
diff1 = dabs(diff);
+#line 20111 ""
/* L23: */
+#line 20111 ""
}
+#line 20112 ""
L24:
+#line 20112 ""
--a1ll_2.ibar;
+#line 20113 ""
lastbar[isyst] = a1ll_2.ibar;
+#line 20114 ""
nbarss[isyst] = a1ll_2.ibar - ibarb4;
+#line 20115 ""
} else {
/* nbarss is given as an input, must compute lastbar and ibar */
+#line 20119 ""
lastbar[isyst] = nbarss[isyst] + ibarb4;
+#line 20120 ""
a1ll_2.ibar = lastbar[isyst];
+#line 20121 ""
}
/* elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */
+#line 20125 ""
elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4;
- s_wsfe(&io___1238);
+#line 20126 ""
+ s_wsfe(&io___1283);
+#line 20126 ""
i__2 = lastbar[isyst - 1] + 1;
+#line 20126 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 20126 ""
e_wsfe();
/* Transposed sigs are isig1, newkey(2,3,...). */
+#line 20130 ""
if (ikey == 1) {
+#line 20131 ""
key1 = comkeys_1.isig1;
+#line 20132 ""
} else {
+#line 20133 ""
key1 = comkeys_1.newkey[ikey - 1];
+#line 20134 ""
}
+#line 20135 ""
fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize;
+#line 20136 ""
xelsk = 0.f;
+#line 20137 ""
L1:
+#line 20137 ""
if (ikey < comkeys_1.nkeys) {
+#line 20138 ""
if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) {
/* Add space for all key changes */
+#line 20142 ""
++ikey;
+#line 20143 ""
key2 = comkeys_1.newkey[ikey - 1];
/* Computing MAX */
/* Computing MAX */
+#line 20144 ""
i__5 = abs(key1), i__6 = abs(key2);
+#line 20144 ""
i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6);
+#line 20144 ""
naccs = max(i__3,i__4);
+#line 20145 ""
fsyst += naccs * wkeysig;
/* Account for afterruleskips (fbar) */
+#line 20149 ""
xelsk += c1ommvl_1.fbar / 2;
+#line 20150 ""
if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && !
comkeys_1.kchmid[ikey - 1]) {
+#line 20150 ""
xelsk += -1.f;
+#line 20150 ""
}
+#line 20152 ""
key1 = key2;
+#line 20153 ""
goto L1;
+#line 20154 ""
}
+#line 20155 ""
}
/* Add extra fixed space for double bar */
+#line 20159 ""
if (isyst == compage_1.nsyst) {
+#line 20160 ""
fsyst += 4.5f / commus_1.musize;
+#line 20161 ""
}
/* Add extra fixed space for initial time signature */
+#line 20165 ""
if (isyst == 1) {
+#line 20166 ""
fsyst += wtimesig;
+#line 20167 ""
}
/* Add extra fixed space for time signature changes & user-defined spaces */
+#line 20171 ""
i__2 = lastbar[isyst];
+#line 20171 ""
for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) {
+#line 20172 ""
if (newmb[ibars - 1]) {
+#line 20172 ""
fsyst += wtimesig;
+#line 20172 ""
}
+#line 20173 ""
fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize;
+#line 20174 ""
/* L26: */
+#line 20174 ""
}
+#line 20175 ""
if (isyst == 1) {
+#line 20176 ""
wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent);
+#line 20177 ""
} else {
+#line 20178 ""
if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
compage_1.isysmb[imovbrk]) {
+#line 20180 ""
wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1]
);
+#line 20181 ""
} else {
+#line 20182 ""
wdpt = compage_1.widthpt;
+#line 20183 ""
}
+#line 20184 ""
}
+#line 20185 ""
wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f;
/* Checks for min spacing */
/* Get min allowable space */
+#line 20190 ""
dtmin = 1e3f;
+#line 20191 ""
i__2 = ibar1 + nbarss[isyst] - 1;
+#line 20191 ""
for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) {
/* Computing MIN */
+#line 20192 ""
r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1];
+#line 20192 ""
dtmin = dmin(r__1,r__2);
+#line 20193 ""
if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) {
+#line 20193 ""
wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1];
+#line 20193 ""
}
+#line 20194 ""
/* L45: */
+#line 20194 ""
}
+#line 20195 ""
if (wmins < 0.f) {
+#line 20195 ""
wmins = .3f;
+#line 20195 ""
}
+#line 20196 ""
wminpt = (wmins + 1) * .3f * commus_1.musize;
/* Find max duration & # of notes for this system */
+#line 20200 ""
dtmax = 0.f;
+#line 20201 ""
nns = 0;
+#line 20202 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
+#line 20202 ""
for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
/* Computing MAX */
+#line 20203 ""
r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1];
+#line 20203 ""
dtmax = dmax(r__1,r__2);
+#line 20204 ""
nns += c1omnotes_1.nnpd[iptr - 1];
+#line 20205 ""
/* L43: */
+#line 20205 ""
}
+#line 20206 ""
elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk);
+#line 20207 ""
if (elmin0 >= wminpt) {
/* Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */
/* there is no need to "flatten" */
+#line 20212 ""
sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst];
+#line 20213 ""
comeon_1.eonk = 0.f;
+#line 20214 ""
comeon_1.ewmxk = 1.f;
+#line 20215 ""
} else {
+#line 20216 ""
elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) /
f1eon_(&dtmax) + nns);
+#line 20217 ""
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 20222 ""
comeon_1.eonk = .9f;
+#line 20223 ""
} else {
/* Find eonk by Newton method */
-/* eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) */
+#line 20227 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
+#line 20227 ""
r__1 = wsyspt / wminpt;
+#line 20227 ""
r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk;
+#line 20227 ""
r__3 = (wminpt - elmin0) / (elmin1 - elmin0);
+#line 20227 ""
findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, &
dtmin, &dtmax, &r__3);
+#line 20230 ""
comeon_1.eonk = dmin(.9f,comeon_1.eonk);
+#line 20231 ""
}
+#line 20232 ""
d__1 = (doublereal) f1eon_(&dtmax);
+#line 20232 ""
d__2 = (doublereal) comeon_1.eonk;
+#line 20232 ""
comeon_1.ewmxk = pow_dd(&d__1, &d__2);
/* Recompute poenom! */
+#line 20236 ""
sumelsk = 0.f;
+#line 20237 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
+#line 20237 ""
for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
+#line 20238 ""
r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]
;
+#line 20238 ""
sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr
- 1] * feon_(&r__1);
+#line 20240 ""
/* L44: */
+#line 20240 ""
}
+#line 20241 ""
}
+#line 20242 ""
poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk);
/* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */
+#line 20246 ""
if (isyst > 0) {
+#line 20247 ""
if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
compage_1.isysmb[imovbrk]) {
+#line 20249 ""
c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1];
+#line 20250 ""
} else {
+#line 20251 ""
c1omget_1.fracindent = 0.f;
+#line 20252 ""
}
+#line 20253 ""
}
- s_wsfe(&io___1256);
+#line 20254 ""
+ s_wsfe(&io___1301);
+#line 20254 ""
do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real));
+#line 20254 ""
do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer));
+#line 20254 ""
do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real));
+#line 20254 ""
do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real));
+#line 20254 ""
do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real));
+#line 20254 ""
do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real));
+#line 20254 ""
do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real));
+#line 20254 ""
e_wsfe();
+#line 20256 ""
ibar1 += nbarss[isyst];
+#line 20257 ""
/* L22: */
+#line 20257 ""
}
+#line 20258 ""
al__1.aerr = 0;
+#line 20258 ""
al__1.aunit = 12;
+#line 20258 ""
f_rew(&al__1);
+#line 20259 ""
o__1.oerr = 0;
+#line 20259 ""
o__1.ounit = 13;
+#line 20259 ""
o__1.ofnm = 0;
+#line 20259 ""
o__1.orl = 0;
+#line 20259 ""
o__1.osta = "SCRATCH";
+#line 20259 ""
o__1.oacc = 0;
+#line 20259 ""
o__1.ofm = 0;
+#line 20259 ""
o__1.oblnk = 0;
+#line 20259 ""
f_open(&o__1);
- s_wsfe(&io___1257);
+#line 20260 ""
+ s_wsfe(&io___1302);
+#line 20260 ""
do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer));
+#line 20260 ""
e_wsfe();
+#line 20261 ""
al__1.aerr = 0;
+#line 20261 ""
al__1.aunit = 13;
+#line 20261 ""
f_rew(&al__1);
+#line 20262 ""
inbuff_1.ilbuf = 1;
+#line 20263 ""
inbuff_1.ipbuf = 0;
+#line 20264 ""
if (! (*optimize)) {
- s_wsfe(&io___1258);
+#line 20265 ""
+ s_wsfe(&io___1303);
+#line 20265 ""
do_fio(&c__1, " Done with first pass", (ftnlen)21);
+#line 20265 ""
e_wsfe();
- s_wsle(&io___1259);
+#line 20266 ""
+ s_wsle(&io___1304);
+#line 20266 ""
e_wsle();
- s_wsfe(&io___1260);
+#line 20267 ""
+ s_wsfe(&io___1305);
+#line 20267 ""
do_fio(&c__1, " Done with first pass", (ftnlen)21);
+#line 20267 ""
e_wsfe();
- s_wsfe(&io___1261);
+#line 20268 ""
+ s_wsfe(&io___1306);
+#line 20268 ""
e_wsfe();
+#line 20269 ""
}
/* Following syntax is needed since pmxa is called with literal argument .false. */
+#line 20273 ""
if (*isfirst) {
+#line 20273 ""
*isfirst = FALSE_;
+#line 20273 ""
}
+#line 20274 ""
return 0;
} /* pmxa_ */
@@ -30042,8 +48538,9 @@ L1:
107], ch__13[17], ch__14[12], ch__15[11], ch__16[15], ch__17[13],
ch__18[9], ch__19[32], ch__20[10], ch__21[4], ch__22[16], ch__23[
33], ch__24[18], ch__25[82], ch__26[66], ch__27[60], ch__28[45],
- ch__29[6], ch__30[76], ch__31[40], ch__32[69], ch__33[41], ch__34[
- 44], ch__35[5], ch__36[7], ch__37[24], ch__38[22], ch__39[96];
+ ch__29[11], ch__30[6], ch__31[76], ch__32[40], ch__33[69], ch__34[
+ 41], ch__35[44], ch__36[5], ch__37[7], ch__38[24], ch__39[22],
+ ch__40[96];
cilist ci__1;
icilist ici__1;
olist o__1;
@@ -30067,7 +48564,9 @@ L1:
f_clos(cllist *), f_rew(alist *);
/* Local variables */
- static integer islnow, iplnow, lvoltxt, nbarss;
+ extern /* Subroutine */ int clefsym_(integer *, char *, integer *,
+ integer *, ftnlen), wsclef_(integer *, integer *, integer *);
+ static integer nvalue, islnow, iplnow, lvoltxt, nbarss;
static real elsktot;
static integer ndigbn, indsym;
extern /* Subroutine */ int wgmeter_(integer *, integer *);
@@ -30096,7 +48595,7 @@ L1:
static char basenameq[44], pathnameq[40];
extern /* Subroutine */ int midievent_(char *, integer *, integer *,
ftnlen);
- static real xintstaff[40];
+ static real xintstaff[75];
static integer ia, ig, il, ip, it, kv, ip2, ibc, icc, ipa, ipi;
static real esk;
static char nmq[40];
@@ -30140,20 +48639,17 @@ L1:
static logical onvolt;
static real tstart[80];
static logical putmbr;
- static real etatop, etabot;
+ static real etatop;
+ static logical istype0;
+ static real etabot;
static integer inhnoh;
extern /* Subroutine */ int getset_(integer *, integer *, integer *,
integer *, integer *, integer *, real *, integer *, integer *,
integer *, real *, logical *, char *, char *, char *, char *,
integer *, integer *, ftnlen, ftnlen, ftnlen, ftnlen);
- static logical istype0;
- static integer noinst, npages, ibcoff, ibmrep, nhstot, jprntb, nhssys,
- lenbeat;
- extern /* Subroutine */ int addmidi_(integer *, integer *, integer *,
- integer *, real *, logical *, logical *), outbar_(integer *,
- integer *);
+ static integer noinst, npages, ibcoff, ibmrep, lenbeat, nhstot, jprntb;
static logical newclef;
- static real ptsndb;
+ static integer nhssys;
extern /* Subroutine */ int topfile_(char *, integer *, integer *, char *,
integer *, integer *, real *, integer *, integer *, logical *,
real *, logical *, ftnlen, ftnlen);
@@ -30162,132 +48658,133 @@ L1:
static real xntrial;
extern integer ifnodur_(integer *, char *, ftnlen);
static integer isystpg;
- extern /* Subroutine */ int getnote_(logical *);
- static real ptsndv, ptsdflt;
- extern /* Subroutine */ int clefsym_(integer *, char *, integer *,
- integer *, ftnlen), wsclef_(integer *, integer *, integer *);
- static real xnsttop[40];
- static integer nvalue;
+ extern /* Subroutine */ int getnote_(logical *), addmidi_(integer *,
+ integer *, integer *, integer *, real *, logical *, logical *),
+ outbar_(integer *, integer *);
+ static real ptsndb, ptsndv, xnsttop[75], ptsdflt;
/* Fortran I/O blocks */
- static cilist io___1262 = { 0, 6, 0, 0, 0 };
- static cilist io___1263 = { 0, 6, 0, 0, 0 };
- static cilist io___1264 = { 0, 6, 0, 0, 0 };
- static cilist io___1265 = { 0, 15, 0, "(a)", 0 };
- static cilist io___1269 = { 0, 12, 0, "(a)", 0 };
- static cilist io___1271 = { 0, 12, 0, 0, 0 };
- static cilist io___1273 = { 0, 12, 0, 0, 0 };
- static cilist io___1289 = { 0, 6, 0, 0, 0 };
- static cilist io___1290 = { 0, 12, 0, 0, 0 };
- static cilist io___1296 = { 0, 13, 0, 0, 0 };
- static cilist io___1298 = { 0, 14, 0, "(a)", 0 };
- static cilist io___1301 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1302 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1303 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1306 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1316 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1318 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
- static cilist io___1319 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
- static cilist io___1323 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1324 = { 0, 11, 0, "(a14,f4.1,a)", 0 };
- static cilist io___1333 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1342 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1343 = { 0, 11, 0, "(a20,i1,a)", 0 };
- static cilist io___1344 = { 0, 11, 0, "(a20,i2,a)", 0 };
- static cilist io___1345 = { 0, 11, 0, "(a20)", 0 };
+ static cilist io___1307 = { 0, 6, 0, 0, 0 };
+ static cilist io___1308 = { 0, 6, 0, 0, 0 };
+ static cilist io___1309 = { 0, 6, 0, 0, 0 };
+ static cilist io___1310 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___1314 = { 0, 12, 0, "(a)", 0 };
+ static cilist io___1316 = { 0, 12, 0, 0, 0 };
+ static cilist io___1318 = { 0, 12, 0, 0, 0 };
+ static cilist io___1334 = { 0, 6, 0, 0, 0 };
+ static cilist io___1335 = { 0, 12, 0, 0, 0 };
+ static cilist io___1341 = { 0, 13, 0, 0, 0 };
+ static cilist io___1343 = { 0, 14, 0, "(a)", 0 };
static cilist io___1346 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1348 = { 0, 11, 0, "(a11,i2,a2)", 0 };
- static cilist io___1349 = { 0, 11, 0, "(a11,i1,a2)", 0 };
- static cilist io___1350 = { 0, 12, 0, 0, 0 };
- static cilist io___1353 = { 0, 6, 0, 0, 0 };
- static cilist io___1354 = { 0, 6, 0, 0, 0 };
- static cilist io___1357 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1358 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1359 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1360 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1347 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1348 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1351 = { 0, 11, 0, "(a)", 0 };
static cilist io___1361 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1362 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1365 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1366 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1363 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 };
+ static cilist io___1364 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 };
static cilist io___1368 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1369 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1369 = { 0, 11, 0, "(a14,f4.1,a)", 0 };
static cilist io___1378 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1379 = { 0, 12, 0, 0, 0 };
- static cilist io___1381 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 };
- static cilist io___1384 = { 0, 11, 0, fmtq, 0 };
- static cilist io___1386 = { 0, 6, 0, 0, 0 };
- static cilist io___1387 = { 0, 6, 0, 0, 0 };
- static cilist io___1388 = { 0, 11, 0, "(a)", 0 };
- static icilist io___1391 = { 0, nmq+12, 0, "(2i1)", 2, 1 };
- static icilist io___1392 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 };
- static cilist io___1393 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1394 = { 0, 11, 0, "(a18,i1,a2)", 0 };
- static cilist io___1395 = { 0, 11, 0, "(a18,i2,a2)", 0 };
- static cilist io___1397 = { 0, 11, 0, "(a11,i1,a2)", 0 };
- static cilist io___1398 = { 0, 11, 0, "(a11,i2,a2)", 0 };
- static cilist io___1399 = { 0, 11, 0, "(a11,i3,a2)", 0 };
- static cilist io___1401 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1387 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1388 = { 0, 11, 0, "(a20,i1,a)", 0 };
+ static cilist io___1389 = { 0, 11, 0, "(a20,i2,a)", 0 };
+ static cilist io___1390 = { 0, 11, 0, "(a20)", 0 };
+ static cilist io___1391 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1393 = { 0, 11, 0, "(a11,i2,a2)", 0 };
+ static cilist io___1394 = { 0, 11, 0, "(a11,i1,a2)", 0 };
+ static cilist io___1395 = { 0, 12, 0, 0, 0 };
+ static cilist io___1398 = { 0, 6, 0, 0, 0 };
+ static cilist io___1399 = { 0, 6, 0, 0, 0 };
static cilist io___1402 = { 0, 11, 0, "(a)", 0 };
static cilist io___1403 = { 0, 11, 0, "(a)", 0 };
static cilist io___1404 = { 0, 11, 0, "(a)", 0 };
static cilist io___1405 = { 0, 11, 0, "(a)", 0 };
static cilist io___1406 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1408 = { 0, 11, 0, fmtq, 0 };
- static cilist io___1409 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1410 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1407 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1410 = { 0, 11, 0, "(a)", 0 };
static cilist io___1411 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1412 = { 0, 11, 0, "(a)", 0 };
static cilist io___1413 = { 0, 11, 0, "(a)", 0 };
static cilist io___1414 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1415 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1416 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1417 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1418 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1419 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1420 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1421 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1422 = { 0, 11, 0, "(a)", 0 };
static cilist io___1423 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1424 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1425 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1426 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1427 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1428 = { 0, 11, 0, "(a16,i1,a14)", 0 };
- static cilist io___1429 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1430 = { 0, 12, 1, 0, 0 };
+ static cilist io___1424 = { 0, 12, 0, 0, 0 };
+ static cilist io___1426 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 };
+ static cilist io___1429 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1431 = { 0, 6, 0, 0, 0 };
+ static cilist io___1432 = { 0, 6, 0, 0, 0 };
static cilist io___1433 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1434 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1435 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1437 = { 0, 11, 0, "(a)", 0 };
+ static icilist io___1436 = { 0, nmq+12, 0, "(2i1)", 2, 1 };
+ static icilist io___1437 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 };
static cilist io___1438 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1439 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1440 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1441 = { 0, 11, 0, "(a,2i1,a)", 0 };
- static cilist io___1442 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1443 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1439 = { 0, 11, 0, "(a18,i1,a2)", 0 };
+ static cilist io___1440 = { 0, 11, 0, "(a18,i2,a2)", 0 };
+ static cilist io___1442 = { 0, 11, 0, "(a11,i1,a2)", 0 };
+ static cilist io___1443 = { 0, 11, 0, "(a11,i2,a2)", 0 };
+ static cilist io___1444 = { 0, 11, 0, "(a11,i3,a2)", 0 };
+ static cilist io___1446 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1447 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1448 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1449 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1450 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1451 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1452 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1454 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1455 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1456 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1457 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1458 = { 0, 11, 0, "(a)", 0 };
static cilist io___1459 = { 0, 11, 0, "(a)", 0 };
static cilist io___1460 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1468 = { 0, 11, 0, "(a11,f5.1,a4)", 0 };
+ static cilist io___1461 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1462 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1463 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1464 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1465 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1466 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1467 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1468 = { 0, 11, 0, "(a)", 0 };
static cilist io___1469 = { 0, 11, 0, "(a)", 0 };
static cilist io___1470 = { 0, 11, 0, "(a)", 0 };
static cilist io___1471 = { 0, 11, 0, "(a)", 0 };
static cilist io___1472 = { 0, 11, 0, "(a)", 0 };
static cilist io___1473 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1474 = { 0, 6, 0, 0, 0 };
- static cilist io___1475 = { 0, 6, 0, 0, 0 };
- static cilist io___1476 = { 0, 15, 0, 0, 0 };
- static cilist io___1477 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1478 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1479 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1474 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1475 = { 0, 11, 0, "(a16,i1,a14)", 0 };
+ static cilist io___1476 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1477 = { 0, 12, 1, 0, 0 };
static cilist io___1480 = { 0, 11, 0, "(a)", 0 };
static cilist io___1481 = { 0, 11, 0, "(a)", 0 };
static cilist io___1482 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1483 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 };
- static cilist io___1484 = { 0, 6, 0, 0, 0 };
- static cilist io___1485 = { 0, 6, 0, 0, 0 };
- static cilist io___1486 = { 0, 6, 0, 0, 0 };
- static cilist io___1487 = { 0, 15, 0, "(/,a)", 0 };
- static cilist io___1488 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___1484 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1485 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1486 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1487 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1488 = { 0, 11, 0, "(a,2i1,a)", 0 };
+ static cilist io___1489 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1490 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1506 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1507 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1515 = { 0, 11, 0, "(a11,f5.1,a4)", 0 };
+ static cilist io___1516 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1517 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1518 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1519 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1520 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1521 = { 0, 6, 0, 0, 0 };
+ static cilist io___1522 = { 0, 6, 0, 0, 0 };
+ static cilist io___1523 = { 0, 15, 0, 0, 0 };
+ static cilist io___1524 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1525 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1526 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1527 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1528 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1529 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1530 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1531 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 };
+ static cilist io___1532 = { 0, 6, 0, 0, 0 };
+ static cilist io___1533 = { 0, 6, 0, 0, 0 };
+ static cilist io___1534 = { 0, 6, 0, 0, 0 };
+ static cilist io___1535 = { 0, 15, 0, "(/,a)", 0 };
+ static cilist io___1536 = { 0, 15, 0, "(a)", 0 };
/* ccccccccccccccccccccccccc */
@@ -30433,20 +48930,19 @@ L1:
/* cccccccccccc */
/* c ipl cc */
/* cccccccccccc */
-/* c 0-7 Location in list [0,200] */
-/* c 0-7 Unused */
/* 0 blank barline (must be iv=1) (would have used islur but no room) */
/* 1 look left for K rests, moved here from iornq(30) */
/* 2 treblelowoct */
-/* c 2-7 Unused */
-/* 3-7 unused */
+/* 3 Open notehead in forced beam xtup */
+/* 4 Set if single stem tremolo */
+/* 5-6 termulo multiplicity - 1 */
+/* 7 unused */
/* 8 left offset main note one headwidth */
/* 9 right offset main note one headwidth */
/* 10 chord present? */
/* 11-16 Forced beam height adjustment (-30 to +30) */
/* 17-22 Forced beam slope adjustment (-30 to +30) */
/* 23-26 Slur index for Way-after grace. Inserted when slur is started. */
-/* c 27 Unused? */
/* 27 5th bit for slur index for Way-after grace (100712) */
/* 28 key change: only in voice 1 */
/* 29 Grace after main note. (Type A) */
@@ -30484,8 +48980,9 @@ L1:
/* cccccccccccc */
/* 0 rest=1, no rest = 0 */
/* 1 There will be a vertical shift for number of this xtup */
-/* Moved hgt shft to mult 16-22, so could span -64,64. */
-/* c 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n' */
+/* 2 Set if 2-note tremolo starts here */
+/* 3-4 nsolid, # of solid beams in 2-note tremolo */
+/* 5-6 nindent, # of indented beams in 2-note tremolo */
/* 7 There is a horizontal shift for xtup number */
/* 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 */
/* 14 Flip up/down-ness of xtup number */
@@ -30611,63 +49108,122 @@ L1:
/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
/* ccccccccccccccccccccccccccccccc */
+#line 20733 ""
/* Parameter adjustments */
+#line 20733 ""
--poevec;
+#line 20733 ""
+#line 20733 ""
/* Function Body */
+#line 20733 ""
+ combottop_1.bottopgap = FALSE_;
+#line 20734 ""
+ comlyr_1.inputmlyr = FALSE_;
+#line 20735 ""
+ comhair_2.idhairuse = 0;
+#line 20736 ""
if (! (*optimize)) {
- s_wsle(&io___1262);
+#line 20737 ""
+ s_wsle(&io___1307);
+#line 20737 ""
e_wsle();
- s_wsle(&io___1263);
+#line 20738 ""
+ s_wsle(&io___1308);
+#line 20738 ""
do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24);
+#line 20738 ""
e_wsle();
- s_wsle(&io___1264);
+#line 20739 ""
+ s_wsle(&io___1309);
+#line 20739 ""
e_wsle();
- s_wsfe(&io___1265);
+#line 20740 ""
+ s_wsfe(&io___1310);
+#line 20740 ""
do_fio(&c__1, "Starting second PMX pass", (ftnlen)24);
+#line 20740 ""
e_wsfe();
+#line 20741 ""
}
+#line 20742 ""
newclef = FALSE_;
+#line 20743 ""
comclefrests_1.centrests = FALSE_;
+#line 20744 ""
++(*ncalls);
+#line 20745 ""
comlast_1.islast = *inlast;
+#line 20746 ""
commac_1.macuse = 0;
+#line 20747 ""
isyscnt = 0;
+#line 20748 ""
all_1.stemmax = 8.2f;
+#line 20749 ""
all_1.stemmin = 3.9f;
+#line 20750 ""
all_1.stemlen = 6.f;
+#line 20751 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 20751 ""
*(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0];
+#line 20752 ""
comignorenats_1.ignorenats = FALSE_;
+#line 20753 ""
combc_1.bcspec = TRUE_;
+#line 20754 ""
comas3_1.topmods = FALSE_;
+#line 20755 ""
ismbr = FALSE_;
- s_rsfe(&io___1269);
+#line 20756 ""
+ s_rsfe(&io___1314);
+#line 20756 ""
do_fio(&c__1, basenameq, (ftnlen)44);
+#line 20756 ""
e_rsfe();
- s_rsle(&io___1271);
+#line 20757 ""
+ s_rsle(&io___1316);
+#line 20757 ""
do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer));
+#line 20757 ""
e_rsle();
- s_rsle(&io___1273);
+#line 20758 ""
+ s_rsle(&io___1318);
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real));
+#line 20758 ""
do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer))
;
+#line 20758 ""
do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer));
+#line 20758 ""
do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
+#line 20758 ""
e_rsle();
+#line 20760 ""
inbuff_1.ilbuf = 1;
+#line 20761 ""
inbuff_1.ipbuf = 0;
+#line 20762 ""
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 20765 ""
if (commidi_1.ismidi) {
/* Initial key signature and meter for pickup bar */
@@ -30680,113 +49236,199 @@ L1:
/* Above is probably cosmetic */
/* call midievent('k',midisig,0) */
+#line 20777 ""
if (xmtrnum0 > comtol_1.tol) {
/* We have a pickup. Some tricky stuff to get a meter: */
+#line 20781 ""
xntrial = xmtrnum0;
+#line 20782 ""
for (ip2 = 0; ip2 <= 5; ++ip2) {
- if ((r__1 = r_mod(&xntrial, &c_b819), dabs(r__1)) <
+#line 20783 ""
+ if ((r__1 = r_mod(&xntrial, &c_b1054), dabs(r__1)) <
comtol_1.tol) {
+#line 20783 ""
goto L6;
+#line 20783 ""
}
+#line 20784 ""
xntrial *= 2;
+#line 20785 ""
/* L5: */
+#line 20785 ""
}
- s_wsle(&io___1289);
+#line 20786 ""
+ s_wsle(&io___1334);
+#line 20786 ""
do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", (
ftnlen)36);
+#line 20786 ""
e_wsle();
+#line 20787 ""
xntrial = 1.f;
+#line 20788 ""
ip2 = 0;
+#line 20789 ""
L6:
+#line 20790 ""
i__1 = i_nint(&xntrial);
+#line 20790 ""
i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl;
+#line 20790 ""
midievent_("m", &i__1, &i__2, (ftnlen)1);
+#line 20791 ""
} else {
/* No pickup, enter the starting meter */
+#line 20795 ""
midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
+#line 20796 ""
}
+#line 20797 ""
}
/* Set musicsize from value passed in common, due to possible reset by S[n]m16 */
+#line 20801 ""
all_1.musicsize = commus_1.musize;
- s_rsle(&io___1290);
+#line 20802 ""
+ s_rsle(&io___1335);
+#line 20802 ""
do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real));
+#line 20802 ""
do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer));
+#line 20802 ""
i__1 = npages;
+#line 20802 ""
for (ipa = 1; ipa <= i__1; ++ipa) {
+#line 20802 ""
do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen)
sizeof(integer));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real));
+#line 20802 ""
do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real)
);
+#line 20802 ""
}
+#line 20802 ""
do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer));
+#line 20802 ""
e_rsle();
/* If default width ever changes, must adjust this stmt. */
+#line 20807 ""
slfac1 = 2.98156f / comtop_1.widthpt;
+#line 20808 ""
all_1.figbass = FALSE_;
- s_rsle(&io___1296);
+#line 20809 ""
+ s_rsle(&io___1341);
+#line 20809 ""
do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer));
+#line 20809 ""
e_rsle();
+#line 20810 ""
if (ifig == 1) {
+#line 20811 ""
all_1.figbass = TRUE_;
+#line 20812 ""
o__1.oerr = 0;
+#line 20812 ""
o__1.ounit = 14;
+#line 20812 ""
o__1.ofnm = 0;
+#line 20812 ""
o__1.orl = 0;
+#line 20812 ""
o__1.osta = "SCRATCH";
+#line 20812 ""
o__1.oacc = 0;
+#line 20812 ""
o__1.ofm = 0;
+#line 20812 ""
o__1.oblnk = 0;
+#line 20812 ""
f_open(&o__1);
- s_wsfe(&io___1298);
+#line 20813 ""
+ s_wsfe(&io___1343);
/* Writing concatenation */
+#line 20813 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 20813 ""
i__3[1] = 3, a__1[1] = "def";
+#line 20813 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 20813 ""
i__3[3] = 8, a__1[3] = "fixdrop{";
+#line 20813 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 20813 ""
i__3[5] = 7, a__1[5] = "advance";
+#line 20813 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 20813 ""
i__3[7] = 10, a__1[7] = "sysno by 1";
+#line 20813 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 20813 ""
i__3[9] = 6, a__1[9] = "ifcase";
+#line 20813 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 20813 ""
i__3[11] = 6, a__1[11] = "sysno%";
+#line 20813 ""
s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46);
+#line 20813 ""
do_fio(&c__1, ch__2, (ftnlen)46);
+#line 20813 ""
e_wsfe();
+#line 20815 ""
}
+#line 20816 ""
comget_1.lastchar = FALSE_;
+#line 20817 ""
ibcoff = 0;
+#line 20818 ""
if (xmtrnum0 > 0.f) {
+#line 20818 ""
ibcoff = -1;
+#line 20818 ""
}
+#line 20819 ""
o__1.oerr = 0;
+#line 20819 ""
o__1.ounit = 11;
+#line 20819 ""
o__1.ofnm = 0;
+#line 20819 ""
o__1.orl = 0;
+#line 20819 ""
o__1.osta = "SCRATCH";
+#line 20819 ""
o__1.oacc = 0;
+#line 20819 ""
o__1.ofm = 0;
+#line 20819 ""
o__1.oblnk = 0;
+#line 20819 ""
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 20825 ""
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)
@@ -30794,224 +49436,394 @@ L6:
/* ninow is working value of # of instruments. noinst is max #, and # at start. */
+#line 20830 ""
comnotes_1.ninow = noinst;
/* Save original printed meter in case movement breaks */
+#line 20834 ""
comget_1.movnmp = all_1.mtrnmp;
+#line 20835 ""
comget_1.movdnp = all_1.mtrdnp;
+#line 20837 ""
if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) {
- s_wsfe(&io___1301);
+#line 20837 ""
+ s_wsfe(&io___1346);
/* Writing concatenation */
+#line 20837 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 20837 ""
i__4[1] = 3, a__2[1] = "def";
+#line 20837 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 20837 ""
i__4[3] = 8, a__2[3] = "figfont{";
+#line 20837 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 20837 ""
i__4[5] = 9, a__2[5] = "eightrm}%";
+#line 20837 ""
s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23);
+#line 20837 ""
do_fio(&c__1, ch__3, (ftnlen)23);
+#line 20837 ""
e_wsfe();
+#line 20837 ""
}
+#line 20840 ""
if (comlast_1.islast && comligfont_1.isligfont) {
+#line 20841 ""
if (all_1.musicsize == 16) {
- s_wsfe(&io___1302);
+#line 20842 ""
+ s_wsfe(&io___1347);
/* Writing concatenation */
+#line 20842 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 20842 ""
i__5[1] = 4, a__3[1] = "font";
+#line 20842 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 20842 ""
i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%";
+#line 20842 ""
s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26);
+#line 20842 ""
do_fio(&c__1, ch__4, (ftnlen)26);
+#line 20842 ""
e_wsfe();
+#line 20843 ""
} else {
- s_wsfe(&io___1303);
+#line 20844 ""
+ s_wsfe(&io___1348);
/* Writing concatenation */
+#line 20844 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 20844 ""
i__5[1] = 4, a__3[1] = "font";
+#line 20844 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 20844 ""
i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%";
+#line 20844 ""
s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
+#line 20844 ""
do_fio(&c__1, ch__5, (ftnlen)27);
+#line 20844 ""
e_wsfe();
+#line 20845 ""
}
+#line 20846 ""
}
+#line 20847 ""
lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
+#line 20848 ""
if (all_1.mtrdenl == 2) {
+#line 20848 ""
lenbeat = 16;
+#line 20848 ""
}
+#line 20849 ""
all_1.lenb1 = all_1.mtrnuml * lenbeat;
+#line 20850 ""
if (all_1.mtrdenl == 2) {
+#line 20850 ""
all_1.lenb1 <<= 1;
+#line 20850 ""
}
+#line 20851 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep);
+#line 20852 ""
r__1 = xmtrnum0 * lenbeat;
+#line 20852 ""
all_1.lenb0 = i_nint(&r__1);
+#line 20853 ""
if (all_1.mtrdenl == 2) {
+#line 20853 ""
all_1.lenb0 <<= 1;
+#line 20853 ""
}
+#line 20854 ""
if (all_1.lenb0 != 0) {
+#line 20855 ""
if (comlast_1.islast) {
- s_wsfe(&io___1306);
+#line 20855 ""
+ s_wsfe(&io___1351);
/* Writing concatenation */
+#line 20855 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 20855 ""
i__5[1] = 7, a__3[1] = "advance";
+#line 20855 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 20855 ""
i__5[3] = 11, a__3[3] = "barno by -1";
+#line 20855 ""
s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20);
+#line 20855 ""
do_fio(&c__1, ch__6, (ftnlen)20);
+#line 20855 ""
e_wsfe();
+#line 20855 ""
}
+#line 20856 ""
all_1.lenbar = all_1.lenb0;
+#line 20857 ""
} else {
+#line 20858 ""
all_1.lenbar = all_1.lenb1;
+#line 20859 ""
}
/* Initialize full-program variables */
+#line 20863 ""
comask_1.fixednew = 0.f;
+#line 20864 ""
comask_1.scaldold = 0.f;
+#line 20865 ""
comget_1.fintstf = -1.f;
+#line 20866 ""
comget_1.gintstf = 1.f;
+#line 20867 ""
comas2_1.nasksys = 0;
+#line 20868 ""
combibarcnt_1.ibarcnt = 0;
+#line 20869 ""
all_1.iline = 0;
+#line 20870 ""
comget_1.movbrk = 0;
+#line 20871 ""
isystpg = 0;
+#line 20872 ""
comnotes_1.ipage = 1;
+#line 20873 ""
all_1.iccount = 128;
+#line 20874 ""
comas3_1.iask = 0;
+#line 20875 ""
nhstot = 0;
+#line 20876 ""
comnsp_2.nb = 1;
+#line 20877 ""
if (! (*optimize)) {
+#line 20877 ""
jprntb = 81;
+#line 20877 ""
}
+#line 20878 ""
comtop_1.idsig = 0;
/* Next 5 are raise-barno parameters. irzbnd is integer part of default level. */
+#line 20882 ""
comsln_1.irzbnd = 3;
+#line 20883 ""
if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv -
1] == 't') {
+#line 20883 ""
comsln_1.irzbnd = 4;
+#line 20883 ""
}
+#line 20884 ""
comsln_1.is1n1 = 0;
+#line 20885 ""
comsln_1.isnx = 0;
+#line 20886 ""
comslur_1.slurcurve = 0.f;
/* 111109 Made global rather than per gulp */
+#line 20890 ""
comdyn_1.ndyn = 0;
+#line 20891 ""
compoi_1.ispoi = FALSE_;
+#line 20892 ""
slint = FALSE_;
+#line 20893 ""
lrptpend = FALSE_;
+#line 20894 ""
comget_1.rptnd1 = FALSE_;
+#line 20895 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
+#line 20896 ""
comget_1.rptprev = FALSE_;
+#line 20897 ""
onvolt = FALSE_;
+#line 20898 ""
comnsp_2.flgndb = FALSE_;
+#line 20899 ""
comget_1.fbon = FALSE_;
+#line 20900 ""
comnotes_1.shifton = FALSE_;
+#line 20901 ""
comget_1.ornrpt = FALSE_;
+#line 20902 ""
comnotes_1.setis = FALSE_;
+#line 20903 ""
comarp_1.lowdot = FALSE_;
+#line 20904 ""
comnvi_1.rename = FALSE_;
+#line 20905 ""
comnotes_1.nobar1 = FALSE_;
+#line 20906 ""
comget_1.equalize = FALSE_;
+#line 20907 ""
comlast_1.usevshrink = TRUE_;
+#line 20908 ""
comslur_1.wrotepsslurdefaults = FALSE_;
+#line 20909 ""
comnotes_1.optlinebreakties = FALSE_;
+#line 20910 ""
comnotes_1.headerspecial = FALSE_;
/* vshrink is initialized in topfile */
+#line 20914 ""
comget_1.stickys = FALSE_;
/* ixrest = 1 or 2 if xtup has started with a rest */
+#line 20918 ""
for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) {
+#line 20919 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
+#line 20920 ""
comfig_1.fullsize[commvl_1.ivx - 1] = 1.f;
/* Set legacy note level to middle c as default */
+#line 20924 ""
comnotes_1.ndlev[commvl_1.ivx - 1] = 29;
+#line 20925 ""
comnotes_1.ndlev[commvl_1.ivx + 23] = 29;
+#line 20926 ""
/* L1: */
+#line 20926 ""
}
+#line 20927 ""
comnotes_1.npreslur = 0;
+#line 20928 ""
nhssys = 0;
+#line 20929 ""
comslur_1.listslur = 0;
+#line 20930 ""
for (i__ = 1; i__ <= 202; ++i__) {
+#line 20931 ""
all_1.isdat1[i__ - 1] = 0;
+#line 20932 ""
all_1.isdat2[i__ - 1] = 0;
+#line 20933 ""
/* L31: */
+#line 20933 ""
}
+#line 20934 ""
all_1.nsdat = 0;
/* Initialize flag for figures in any other voice than 1 */
+#line 20938 ""
comfig_1.ivxfig2 = 0;
/* Initialize for loop over gulps */
+#line 20942 ""
all_1.firstgulp = TRUE_;
/* Start a gulp */
+#line 20946 ""
L30:
+#line 20946 ""
loop = TRUE_;
+#line 20947 ""
comnotes_1.notcrd = TRUE_;
+#line 20948 ""
combjmp_1.isbjmp = FALSE_;
+#line 20949 ""
combjmp_1.isbj2 = FALSE_;
+#line 20950 ""
comfb_1.autofbon = FALSE_;
+#line 20951 ""
comfb_1.tautofb = 0.f;
+#line 20952 ""
all_1.nbars = 0;
+#line 20953 ""
comfig_1.nfigs[0] = 0;
+#line 20954 ""
comfig_1.nfigs[1] = 0;
+#line 20955 ""
comgrace_1.ngrace = 0;
+#line 20956 ""
comtrill_1.ntrill = 0;
+#line 20957 ""
comtrill_1.ncrd = 0;
+#line 20958 ""
comtrill_1.nudorn = 0;
+#line 20959 ""
comgrace_1.nlit = 0;
+#line 20960 ""
comgrace_1.nvolt = 0;
+#line 20961 ""
comgrace_1.ibarmbr = 0;
+#line 20962 ""
comudsp_1.nudsp = 0;
/* ndyn = 0 ! 111109 */
+#line 20964 ""
comdyn_1.ntxtdyn = 0;
+#line 20965 ""
comcb_1.nbc = 0;
+#line 20966 ""
comarpshift_1.numarpshift = 0;
+#line 20967 ""
for (i__ = 1; i__ <= 37; ++i__) {
+#line 20968 ""
comgrace_1.graspace[i__ - 1] = 0.f;
+#line 20969 ""
/* L3: */
+#line 20969 ""
}
/* 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 20974 ""
i__1 = all_1.nv;
+#line 20974 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 20975 ""
newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, (
ftnlen)1);
+#line 20976 ""
/* L4: */
+#line 20976 ""
}
/* Check if endsymbol was set earlier */
+#line 20980 ""
if (comget_1.rptnd1) {
+#line 20981 ""
comget_1.rptnd1 = FALSE_;
+#line 20982 ""
*(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1;
+#line 20983 ""
} else {
/* Only use if movbrk>0, to signal default ('RD') */
+#line 20987 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
+#line 20988 ""
}
+#line 20989 ""
all_1.iv = 1;
+#line 20990 ""
commvl_1.ivx = 1;
+#line 20991 ""
L2:
+#line 20991 ""
if (loop) {
/* Within this loop, nv voices are filled up for the duration of the block. */
@@ -31021,119 +49833,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 21000 ""
getnote_(&loop);
+#line 21001 ""
if (comget_1.lastchar) {
+#line 21001 ""
goto L40;
+#line 21001 ""
}
+#line 21002 ""
goto L2;
+#line 21003 ""
}
/* Finished an input block (gulp). */
+#line 21007 ""
if (commidi_1.ismidi) {
/* Put rests into midi array for 2nd lines that were not used in this gulp. */
+#line 21011 ""
i__1 = all_1.nv;
+#line 21011 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 21012 ""
if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1]
== 1) {
+#line 21013 ""
if (all_1.firstgulp && all_1.lenb0 != 0) {
+#line 21014 ""
r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0;
+#line 21014 ""
addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
&c__0, &r__1, &c_true, &c_false);
+#line 21016 ""
} else {
+#line 21017 ""
r__1 = all_1.nbars * 1.f * all_1.lenbar;
+#line 21017 ""
addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
&c__0, &r__1, &c_true, &c_false);
+#line 21019 ""
}
+#line 21020 ""
}
+#line 21021 ""
/* L60: */
+#line 21021 ""
}
+#line 21022 ""
}
+#line 21023 ""
comgrace_1.nvolt = 0;
+#line 21024 ""
for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) {
+#line 21025 ""
comudsp_1.nudoff[all_1.iv - 1] = 0;
+#line 21026 ""
+ comcc_1.maxdotmv[all_1.iv - 1] = comcc_1.ndotmv[all_1.iv - 1];
+#line 21027 ""
comcc_1.ndotmv[all_1.iv - 1] = 0;
+#line 21028 ""
/* L28: */
+#line 21028 ""
}
/* Put stuff at top of p.1. Must wait until now to have read title info. */
+#line 21032 ""
if (combibarcnt_1.ibarcnt == 0) {
+#line 21033 ""
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 21035 ""
if (comnotes_1.headerspecial) {
- s_wsfe(&io___1316);
+#line 21035 ""
+ s_wsfe(&io___1361);
/* Writing concatenation */
+#line 21035 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 21035 ""
i__6[0] = 1, a__4[0] = ch__1;
+#line 21035 ""
i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%";
+#line 21035 ""
s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
+#line 21035 ""
do_fio(&c__1, ch__7, (ftnlen)29);
+#line 21035 ""
e_wsfe();
+#line 21035 ""
}
/* Write special header for first page */
+#line 21040 ""
}
+#line 21041 ""
i__1 = all_1.nbars;
+#line 21041 ""
for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) {
+#line 21042 ""
++combibarcnt_1.ibarcnt;
+#line 21043 ""
comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto;
/* Computing MAX */
+#line 21044 ""
r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff;
+#line 21044 ""
i__2 = 0, i__7 = (integer) r_lg10(&r__1);
+#line 21044 ""
ndig = max(i__2,i__7);
+#line 21045 ""
if (comlast_1.islast) {
+#line 21045 ""
ci__1.cierr = 0;
+#line 21045 ""
ci__1.ciunit = 11;
/* Writing concatenation */
+#line 21045 ""
i__8[0] = 6, a__5[0] = "(a11,i";
+#line 21045 ""
i__2 = ndig + 50;
+#line 21045 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 21045 ""
i__8[1] = 1, a__5[1] = ch__1;
+#line 21045 ""
i__8[2] = 1, a__5[2] = ")";
+#line 21045 ""
ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8);
+#line 21045 ""
s_wsfe(&ci__1);
+#line 21045 ""
do_fio(&c__1, "% Bar count", (ftnlen)11);
+#line 21045 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff;
+#line 21045 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
+#line 21045 ""
e_wsfe();
+#line 21045 ""
}
+#line 21048 ""
if (all_1.ibar != comgrace_1.ibarmbr) {
+#line 21049 ""
if (! (*optimize)) {
+#line 21049 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
+#line 21049 ""
outbar_(&i__2, &jprntb);
+#line 21049 ""
}
+#line 21050 ""
} else {
+#line 21051 ""
if (! (*optimize)) {
- s_wsfe(&io___1318);
+#line 21052 ""
+ s_wsfe(&io___1363);
+#line 21052 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
+#line 21052 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
+#line 21052 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 21052 ""
do_fio(&c__1, "-", (ftnlen)1);
+#line 21052 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
+#line 21052 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
+#line 21052 ""
e_wsfe();
- s_wsfe(&io___1319);
+#line 21054 ""
+ s_wsfe(&io___1364);
+#line 21054 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
+#line 21054 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
+#line 21054 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 21054 ""
do_fio(&c__1, "-", (ftnlen)1);
+#line 21054 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
+#line 21054 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
+#line 21054 ""
e_wsfe();
+#line 21056 ""
jprntb = 0;
+#line 21057 ""
}
+#line 21058 ""
ibcoff = ibcoff + comgrace_1.mbrest - 1;
/* if (ibar.eq.1 .and. firstgulp .and. */
/* * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize */
+#line 21061 ""
if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[
0],5)) {
+#line 21061 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
+#line 21061 ""
}
+#line 21063 ""
}
/* Move the read to after end-of-bar hardspace checks, so we get right poenom */
@@ -31150,82 +50055,137 @@ L2:
/* compute additional pts and store them in hpttot(1...nhstot). Finally in */
/* subroutine askfig, write true pts where placeholders are. */
+#line 21079 ""
ioff = 0;
+#line 21080 ""
if (all_1.ibar > 1) {
+#line 21080 ""
ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24];
+#line 21080 ""
}
+#line 21081 ""
clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15);
+#line 21082 ""
putmbr = FALSE_;
+#line 21083 ""
if (ismbr) {
+#line 21084 ""
if (clchb) {
/* cc */
/* cc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */
/* cc */
- s_wsfe(&io___1323);
+#line 21088 ""
+ s_wsfe(&io___1368);
/* Writing concatenation */
+#line 21088 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 21088 ""
i__9[1] = 3, a__6[1] = "let";
+#line 21088 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 21088 ""
i__9[3] = 4, a__6[3] = "mbrt";
+#line 21088 ""
i__9[4] = 1, a__6[4] = all_1.sq;
+#line 21088 ""
i__9[5] = 6, a__6[5] = "mbrest";
+#line 21088 ""
i__9[6] = 1, a__6[6] = all_1.sq;
+#line 21088 ""
i__9[7] = 3, a__6[7] = "def";
+#line 21088 ""
i__9[8] = 1, a__6[8] = all_1.sq;
+#line 21088 ""
i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%";
+#line 21088 ""
s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35);
+#line 21088 ""
do_fio(&c__1, ch__9, (ftnlen)35);
+#line 21088 ""
e_wsfe();
- s_wsfe(&io___1324);
+#line 21090 ""
+ s_wsfe(&io___1369);
/* Writing concatenation */
+#line 21090 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21090 ""
i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{";
+#line 21090 ""
s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
+#line 21090 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21090 ""
r__1 = all_1.musicsize * .55f;
+#line 21090 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
/* Writing concatenation */
+#line 21090 ""
i__10[0] = 1, a__7[0] = "}";
+#line 21090 ""
i__10[1] = 1, a__7[1] = all_1.sq;
+#line 21090 ""
i__10[2] = 6, a__7[2] = "global";
+#line 21090 ""
i__10[3] = 1, a__7[3] = all_1.sq;
+#line 21090 ""
i__10[4] = 3, a__7[4] = "let";
+#line 21090 ""
i__10[5] = 1, a__7[5] = all_1.sq;
+#line 21090 ""
i__10[6] = 6, a__7[6] = "mbrest";
+#line 21090 ""
i__10[7] = 1, a__7[7] = all_1.sq;
+#line 21090 ""
i__10[8] = 6, a__7[8] = "mbrt}%";
+#line 21090 ""
s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26);
+#line 21090 ""
do_fio(&c__1, ch__4, (ftnlen)26);
+#line 21090 ""
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 21097 ""
}
+#line 21098 ""
ismbr = FALSE_;
+#line 21099 ""
putmbr = TRUE_;
+#line 21100 ""
}
+#line 21101 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
+#line 21101 ""
ismbr = TRUE_;
+#line 21101 ""
}
/* 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 21106 ""
if (! (clchb || comnsp_2.flgndb)) {
+#line 21106 ""
goto L23;
+#line 21106 ""
}
/* Must check available space */
+#line 21110 ""
ptsndb = 0.f;
/* Zero out block signal */
+#line 21114 ""
if (clchb) {
+#line 21114 ""
all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff +
1) * 24 - 24],15);
+#line 21114 ""
}
/* In this loop, we determine how much hardspace is needed (if any) */
@@ -31235,148 +50195,240 @@ L2:
/* one. */
/* 4/18/98 Apparently nmxsav was a solution to the above problem */
+#line 21123 ""
i__2 = all_1.nv;
+#line 21123 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 21124 ""
i__7 = comnsp_2.nvmxsav[all_1.iv - 1];
+#line 21124 ""
for (kv = 1; kv <= i__7; ++kv) {
+#line 21125 ""
commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25];
+#line 21126 ""
ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt;
+#line 21127 ""
ioff = 0;
+#line 21128 ""
if (all_1.ibar > 1) {
+#line 21129 ""
ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
25];
+#line 21130 ""
ip = ioff;
+#line 21131 ""
if (all_1.ibar > 2) {
+#line 21131 ""
ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2)
* 24 - 25];
+#line 21131 ""
}
/* prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */
+#line 21133 ""
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 21137 ""
}
/* Only allow clef changes when ivx <= nv */
+#line 21141 ""
if (commvl_1.ivx <= all_1.nv) {
+#line 21142 ""
clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[
all_1.iv + (ioff + 1) * 24 - 25],11);
+#line 21143 ""
if (clchv[all_1.iv - 1]) {
/* Clef change in this voice. Turn off signal. Get space avail. */
+#line 21147 ""
all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] =
bit_clear(all_1.islur[all_1.iv + (ioff + 1) *
24 - 25],11);
+#line 21148 ""
if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] -
comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) <
comtol_1.tol) {
+#line 21148 ""
ptsndv += combmh_1.clefend * comask_1.wheadpt;
+#line 21148 ""
}
+#line 21150 ""
}
+#line 21151 ""
}
/* Computing MAX */
+#line 21152 ""
r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt *
spfacs_1.xspfac;
+#line 21152 ""
ptsndb = dmax(r__1,r__2);
+#line 21153 ""
/* L16: */
+#line 21153 ""
}
+#line 21153 ""
}
/* ???? where is nb set??? nb probably in left over from makeabar */
+#line 21157 ""
r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1];
+#line 21157 ""
esk = feon_(&r__1);
+#line 21158 ""
ptsdflt = esk * comask_1.poenom - comask_1.wheadpt;
/* if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */
+#line 21160 ""
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 21165 ""
if (comlast_1.islast) {
- s_wsfe(&io___1333);
+#line 21165 ""
+ s_wsfe(&io___1378);
/* Writing concatenation */
+#line 21165 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21165 ""
i__6[1] = 18, a__4[1] = "xardspace{ pt}%";
+#line 21165 ""
s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
+#line 21165 ""
do_fio(&c__1, ch__11, (ftnlen)19);
+#line 21165 ""
e_wsfe();
+#line 21165 ""
}
+#line 21166 ""
++nhssys;
+#line 21167 ""
if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom *
comnsp_2.eskgnd) {
+#line 21168 ""
hesk[nhssys - 1] = esk;
+#line 21169 ""
hpts[nhssys - 1] = ptsndb + comask_1.wheadpt;
+#line 21170 ""
} else {
+#line 21171 ""
hesk[nhssys - 1] = comnsp_2.eskgnd;
+#line 21172 ""
hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt;
+#line 21173 ""
}
+#line 21174 ""
comask_1.fixednew += hpts[nhssys - 1];
+#line 21175 ""
comask_1.scaldold += hesk[nhssys - 1];
+#line 21176 ""
}
+#line 21177 ""
if (clchb) {
+#line 21178 ""
i__7 = all_1.nv;
+#line 21178 ""
for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
+#line 21179 ""
if (clchv[all_1.iv - 1]) {
/* Writing concatenation */
+#line 21180 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21180 ""
i__6[1] = 6, a__4[1] = "znotes";
+#line 21180 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21181 ""
lnote = 7;
+#line 21182 ""
i__2 = all_1.iv;
+#line 21182 ""
for (iiv = 2; iiv <= i__2; ++iiv) {
/* Writing concatenation */
+#line 21183 ""
i__6[0] = lnote, a__4[0] = notexq;
+#line 21183 ""
i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2);
+#line 21183 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21184 ""
++lnote;
+#line 21185 ""
/* L24: */
+#line 21185 ""
}
/* Recompute ioff since it will vary from voice to voice */
+#line 21189 ""
if (all_1.ibar == 1) {
+#line 21190 ""
ioff = 0;
+#line 21191 ""
} else {
+#line 21192 ""
ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 -
25];
+#line 21193 ""
}
/* Must call clefsym to get nclef, even if there is a movement break */
+#line 21197 ""
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 21201 ""
if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2)
) {
/* Writing concatenation */
+#line 21201 ""
i__8[0] = 8, a__5[0] = fmtq;
+#line 21201 ""
i__8[1] = 1, a__5[1] = "8";
+#line 21201 ""
i__8[2] = 1, a__5[2] = fmtq + 9;
+#line 21201 ""
s_cat(fmtq, a__5, i__8, &c__3, (ftnlen)24);
+#line 21201 ""
}
+#line 21203 ""
if (comget_1.movbrk == 0 && comlast_1.islast) {
- s_wsfe(&io___1342);
+#line 21203 ""
+ s_wsfe(&io___1387);
/* Writing concatenation */
+#line 21203 ""
i__5[0] = lnote, a__3[0] = notexq;
+#line 21203 ""
i__5[1] = lclef, a__3[1] = fmtq;
+#line 21203 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21203 ""
i__5[3] = 3, a__3[3] = "en%";
+#line 21203 ""
s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107);
+#line 21203 ""
do_fio(&c__1, ch__12, lnote + lclef + 4);
+#line 21203 ""
e_wsfe();
+#line 21203 ""
}
/* call wsclef(iv,ninow,clefq,nclef) */
+#line 21207 ""
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 21212 ""
newclef = TRUE_;
/* 151220 */
@@ -31386,329 +50438,576 @@ L2:
/* and if we change from TLO to normal clef, need to resetclefsymbols */
/* if (clefq(iv) .eq. '8') then */
+#line 21221 ""
if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2)
) {
+#line 21222 ""
if (all_1.iv <= 9) {
- s_wsfe(&io___1343);
+#line 21223 ""
+ s_wsfe(&io___1388);
/* Writing concatenation */
+#line 21223 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21223 ""
i__6[1] = 19, a__4[1] = "settrebleclefsymbol";
+#line 21223 ""
s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20);
+#line 21223 ""
do_fio(&c__1, ch__6, (ftnlen)20);
- do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof(
+#line 21223 ""
+ do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 21223 ""
i__11[0] = 1, a__8[0] = all_1.sq;
+#line 21223 ""
i__11[1] = 13, a__8[1] = "treblelowoct%";
+#line 21223 ""
s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14);
+#line 21223 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21223 ""
e_wsfe();
+#line 21225 ""
} else {
- s_wsfe(&io___1344);
+#line 21226 ""
+ s_wsfe(&io___1389);
/* Writing concatenation */
+#line 21226 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21226 ""
i__6[1] = 19, a__4[1] = "settrebleclefsymbol";
+#line 21226 ""
s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20);
+#line 21226 ""
do_fio(&c__1, ch__6, (ftnlen)20);
- do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof(
+#line 21226 ""
+ do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 21226 ""
i__11[0] = 1, a__8[0] = all_1.sq;
+#line 21226 ""
i__11[1] = 13, a__8[1] = "treblelowoct%";
+#line 21226 ""
s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14);
+#line 21226 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21226 ""
e_wsfe();
+#line 21228 ""
}
+#line 21229 ""
} else {
+#line 21230 ""
if (*(unsigned char *)&comclefq_1.clefq[all_1.iv - 1]
== '8') {
- s_wsfe(&io___1345);
+#line 21231 ""
+ s_wsfe(&io___1390);
/* Writing concatenation */
+#line 21231 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21231 ""
i__6[1] = 16, a__4[1] = "resetclefsymbols";
+#line 21231 ""
s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)17);
+#line 21231 ""
do_fio(&c__1, ch__13, (ftnlen)17);
+#line 21231 ""
e_wsfe();
+#line 21232 ""
}
+#line 21233 ""
}
+#line 21234 ""
}
+#line 21235 ""
/* L17: */
+#line 21235 ""
}
+#line 21236 ""
if (comlast_1.islast) {
- s_wsfe(&io___1346);
+#line 21236 ""
+ s_wsfe(&io___1391);
/* Writing concatenation */
+#line 21236 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21236 ""
i__6[1] = 11, a__4[1] = "pmxnewclefs";
+#line 21236 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21236 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21236 ""
e_wsfe();
+#line 21236 ""
}
+#line 21237 ""
}
+#line 21238 ""
L23:
/* Kluge \CenterBar for whole bar rests if necessary */
+#line 21242 ""
if (newclef && comclefrests_1.centrests) {
/* write(11,'(a)')sq//'def'//sq//'value{11}%' */
+#line 21244 ""
r__1 = all_1.musicsize * .55f;
+#line 21244 ""
nvalue = i_nint(&r__1);
+#line 21245 ""
if (nvalue > 10) {
- s_wsfe(&io___1348);
+#line 21246 ""
+ s_wsfe(&io___1393);
/* Writing concatenation */
+#line 21246 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21246 ""
i__5[1] = 3, a__3[1] = "def";
+#line 21246 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21246 ""
i__5[3] = 6, a__3[3] = "value{";
+#line 21246 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 21246 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21246 ""
do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer));
+#line 21246 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 21246 ""
e_wsfe();
+#line 21248 ""
} else {
- s_wsfe(&io___1349);
+#line 21249 ""
+ s_wsfe(&io___1394);
/* Writing concatenation */
+#line 21249 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21249 ""
i__5[1] = 3, a__3[1] = "def";
+#line 21249 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21249 ""
i__5[3] = 6, a__3[3] = "value{";
+#line 21249 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 21249 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21249 ""
do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer));
+#line 21249 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 21249 ""
e_wsfe();
+#line 21251 ""
}
+#line 21252 ""
}
+#line 21253 ""
newclef = FALSE_;
+#line 21254 ""
comclefrests_1.centrests = FALSE_;
/* End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */
+#line 21258 ""
if (comask_1.bar1syst) {
- s_rsle(&io___1350);
+#line 21259 ""
+ s_rsle(&io___1395);
+#line 21259 ""
do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof(
real));
+#line 21259 ""
e_rsle();
+#line 21260 ""
}
/* Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */
+#line 21264 ""
if (all_1.ibar == 1) {
+#line 21265 ""
islnow = all_1.islur[0];
/* iornqnow = iornq(1,1) */
+#line 21267 ""
iplnow = all_1.ipl[0];
+#line 21268 ""
} else {
+#line 21269 ""
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 21271 ""
iplnow = all_1.ipl[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) *
24 - 24];
+#line 21272 ""
}
/* Check for R-symbols set at end of prior input block */
+#line 21276 ""
if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E')
{
+#line 21277 ""
if (*(unsigned char *)comget_1.rptfq2 == 'D') {
+#line 21278 ""
islnow = bit_set(islnow,26);
+#line 21279 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'r') {
+#line 21280 ""
islnow = bit_set(islnow,6);
+#line 21281 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
+#line 21282 ""
islnow = bit_set(islnow,8);
+#line 21283 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
+#line 21284 ""
islnow = bit_set(islnow,25);
+#line 21285 ""
} else {
- s_wsle(&io___1353);
+#line 21286 ""
+ s_wsle(&io___1398);
+#line 21286 ""
e_wsle();
- s_wsle(&io___1354);
- do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"
+#line 21287 ""
+ s_wsle(&io___1399);
+#line 21287 ""
+ do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"\
"put block:", (ftnlen)46);
+#line 21287 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
+#line 21287 ""
e_wsle();
+#line 21289 ""
stop1_();
+#line 21290 ""
}
+#line 21291 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
+#line 21292 ""
}
+#line 21293 ""
if ((islnow & 352) != 0) {
/* Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */
+#line 21297 ""
lrpt = bit_test(islnow,5);
+#line 21298 ""
rrpt = bit_test(islnow,6);
+#line 21299 ""
lrptpend = lrpt && comask_1.bar1syst;
+#line 21300 ""
if (lrpt && ! lrptpend) {
+#line 21301 ""
if (rrpt) {
+#line 21302 ""
if (comlast_1.islast) {
- s_wsfe(&io___1357);
+#line 21302 ""
+ s_wsfe(&io___1402);
/* Writing concatenation */
+#line 21302 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21302 ""
i__6[1] = 18, a__4[1] = "setleftrightrepeat";
+#line 21302 ""
s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
+#line 21302 ""
do_fio(&c__1, ch__11, (ftnlen)19);
+#line 21302 ""
e_wsfe();
+#line 21302 ""
}
+#line 21303 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.lrrptfac - .4f;
+#line 21304 ""
} else {
+#line 21305 ""
if (comlast_1.islast) {
- s_wsfe(&io___1358);
+#line 21305 ""
+ s_wsfe(&io___1403);
/* Writing concatenation */
+#line 21305 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21305 ""
i__6[1] = 13, a__4[1] = "setleftrepeat";
+#line 21305 ""
s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
+#line 21305 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21305 ""
e_wsfe();
+#line 21305 ""
}
+#line 21306 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.rptfac - .4f;
+#line 21307 ""
}
+#line 21308 ""
} else if (rrpt) {
+#line 21309 ""
if (comlast_1.islast) {
- s_wsfe(&io___1359);
+#line 21309 ""
+ s_wsfe(&io___1404);
/* Writing concatenation */
+#line 21309 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21309 ""
i__6[1] = 14, a__4[1] = "setrightrepeat";
+#line 21309 ""
s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15);
+#line 21309 ""
do_fio(&c__1, ch__16, (ftnlen)15);
+#line 21309 ""
e_wsfe();
+#line 21309 ""
}
+#line 21310 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.rptfac - .4f;
+#line 21311 ""
} else if (bit_test(islnow,8)) {
+#line 21312 ""
if (comlast_1.islast) {
- s_wsfe(&io___1360);
+#line 21312 ""
+ s_wsfe(&io___1405);
/* Writing concatenation */
+#line 21312 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21312 ""
i__6[1] = 12, a__4[1] = "setdoublebar";
+#line 21312 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
+#line 21312 ""
do_fio(&c__1, ch__17, (ftnlen)13);
+#line 21312 ""
e_wsfe();
+#line 21312 ""
}
+#line 21313 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.dbarfac - .4f;
+#line 21314 ""
}
+#line 21315 ""
} else if (bit_test(islnow,26)) {
/* doubleBAR */
+#line 21319 ""
if (comlast_1.islast) {
- s_wsfe(&io___1361);
+#line 21319 ""
+ s_wsfe(&io___1406);
/* Writing concatenation */
+#line 21319 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21319 ""
i__6[1] = 12, a__4[1] = "setdoubleBAR";
+#line 21319 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
+#line 21319 ""
do_fio(&c__1, ch__17, (ftnlen)13);
+#line 21319 ""
e_wsfe();
+#line 21319 ""
}
+#line 21320 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.ddbarfac - .4f;
/* else if (btest(iornqnow,29)) then */
+#line 21322 ""
} else if (bit_test(iplnow,0)) {
/* no bar line */
/* -- if (islast) write(11,'(a)')sq//'setzalaligne' */
/* ++ */
+#line 21328 ""
if (comlast_1.islast) {
+#line 21329 ""
if (comget_1.movbrk == 0) {
- s_wsfe(&io___1362);
+#line 21330 ""
+ s_wsfe(&io___1407);
/* Writing concatenation */
+#line 21330 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21330 ""
i__6[1] = 12, a__4[1] = "setzalaligne";
+#line 21330 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
+#line 21330 ""
do_fio(&c__1, ch__17, (ftnlen)13);
+#line 21330 ""
e_wsfe();
+#line 21331 ""
} 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 21337 ""
*(unsigned char *)comget_1.rptfq2 = 'z';
+#line 21338 ""
}
+#line 21339 ""
}
/* ++ */
+#line 21341 ""
comask_1.fixednew += -.4f;
+#line 21342 ""
}
/* 1st and 2nd endings */
+#line 21346 ""
svolta = bit_test(islnow,7);
+#line 21347 ""
evolta = bit_test(islnow,9);
+#line 21348 ""
if (evolta) {
+#line 21349 ""
if (bit_test(islnow,10)) {
+#line 21350 ""
if (comlast_1.islast) {
- s_wsfe(&io___1365);
+#line 21350 ""
+ s_wsfe(&io___1410);
/* Writing concatenation */
+#line 21350 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21350 ""
i__6[1] = 11, a__4[1] = "endvoltabox";
+#line 21350 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21350 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21350 ""
e_wsfe();
+#line 21350 ""
}
+#line 21351 ""
} else {
+#line 21352 ""
if (comlast_1.islast) {
- s_wsfe(&io___1366);
+#line 21352 ""
+ s_wsfe(&io___1411);
/* Writing concatenation */
+#line 21352 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21352 ""
i__6[1] = 8, a__4[1] = "endvolta";
+#line 21352 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 21352 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21352 ""
e_wsfe();
+#line 21352 ""
}
+#line 21353 ""
}
+#line 21354 ""
onvolt = FALSE_;
+#line 21355 ""
}
+#line 21356 ""
if (svolta) {
+#line 21357 ""
++comgrace_1.nvolt;
+#line 21358 ""
lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20,
" ", (ftnlen)20, (ftnlen)1) - 1;
+#line 21359 ""
if (lvoltxt == 1) {
+#line 21360 ""
if (comlast_1.islast) {
- s_wsfe(&io___1368);
+#line 21360 ""
+ s_wsfe(&io___1413);
/* Writing concatenation */
+#line 21360 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21360 ""
i__5[1] = 8, a__3[1] = "Setvolta";
+#line 21360 ""
i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + (
comgrace_1.nvolt - 1) * 20;
+#line 21360 ""
i__5[3] = 1, a__3[3] = "%";
+#line 21360 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 21360 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21360 ""
e_wsfe();
+#line 21360 ""
}
+#line 21362 ""
} else {
+#line 21363 ""
if (comlast_1.islast) {
- s_wsfe(&io___1369);
+#line 21363 ""
+ s_wsfe(&io___1414);
/* Writing concatenation */
+#line 21363 ""
i__12[0] = 1, a__9[0] = all_1.sq;
+#line 21363 ""
i__12[1] = 8, a__9[1] = "Setvolta";
+#line 21363 ""
i__12[2] = 1, a__9[2] = "{";
+#line 21363 ""
i__12[3] = lvoltxt, a__9[3] = comgrace_1.voltxtq + (
comgrace_1.nvolt - 1) * 20;
+#line 21363 ""
i__12[4] = 2, a__9[4] = "}%";
+#line 21363 ""
s_cat(ch__19, a__9, i__12, &c__5, (ftnlen)32);
+#line 21363 ""
do_fio(&c__1, ch__19, lvoltxt + 12);
+#line 21363 ""
e_wsfe();
+#line 21363 ""
}
+#line 21365 ""
}
+#line 21366 ""
onvolt = TRUE_;
+#line 21367 ""
}
+#line 21368 ""
if (all_1.ibar > 1) {
+#line 21369 ""
ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1;
+#line 21370 ""
} else {
+#line 21371 ""
ipnow = 1;
+#line 21372 ""
}
+#line 21373 ""
iplnow = all_1.ipl[ipnow * 24 - 24];
+#line 21374 ""
if (comask_1.bar1syst) {
/* If listslur>0, then there is at least one slur or tie carried over the break */
+#line 21378 ""
ispstie = FALSE_;
+#line 21379 ""
if (comnotes_1.optlinebreakties && ! comslur_1.fontslur &&
comslur_1.listslur != 0 && comlast_1.islast) {
+#line 21379 ""
linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
ftnlen)1);
+#line 21379 ""
}
+#line 21383 ""
++all_1.iline;
/* End an old system, Start a new system */
@@ -31716,140 +51015,225 @@ L23:
/* Reduce space before mbrest at start of system */
/* Need this even if no accidentals in key signature */
+#line 21390 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
+#line 21390 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
+#line 21390 ""
}
+#line 21392 ""
if (all_1.iline != 1) {
/* Not first line. */
/* Get corrected poe = points/elemskip for *previous* system */
+#line 21397 ""
wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
+#line 21398 ""
poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f -
comask_1.fixednew) / (elsktot + comask_1.fbar *
nbarss - comask_1.scaldold);
+#line 21400 ""
++isyscnt;
+#line 21401 ""
poevec[isyscnt] = poe;
/* Transfer data for system into global arrays to hold until very end */
+#line 21405 ""
i__7 = comas2_1.nasksys;
+#line 21405 ""
for (ia = 1; ia <= i__7; ++ia) {
+#line 21406 ""
++comas3_1.iask;
+#line 21407 ""
comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1]
/ poe - (r__1 = comas2_1.elasksys[ia - 1], dabs(
r__1));
/* Only admit negative ask if it was user-defined space, signalled by elask<=0. */
+#line 21411 ""
if (comas2_1.elasksys[ia - 1] > 0.f) {
+#line 21411 ""
comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
- comas3_1.iask - 1], &c_b774);
+ comas3_1.iask - 1], &c_b1009);
+#line 21411 ""
}
+#line 21412 ""
/* L9: */
+#line 21412 ""
}
+#line 21413 ""
i__7 = nhssys;
+#line 21413 ""
for (ia = 1; ia <= i__7; ++ia) {
+#line 21414 ""
++nhstot;
/* Computing MAX */
+#line 21415 ""
r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
+#line 21415 ""
comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
+#line 21416 ""
/* L25: */
+#line 21416 ""
}
/* Reset counters for new system */
+#line 21420 ""
comask_1.scaldold = 0.f;
+#line 21421 ""
comask_1.fixednew = 0.f;
+#line 21422 ""
comas2_1.nasksys = 0;
+#line 21423 ""
nhssys = 0;
+#line 21424 ""
}
/* End of if block for first bar of non-first system. Still 1st bar, any system */
+#line 21428 ""
if (comlast_1.islast && all_1.figbass) {
- s_wsfe(&io___1378);
+#line 21428 ""
+ s_wsfe(&io___1423);
/* Writing concatenation */
+#line 21428 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21428 ""
i__6[1] = 8, a__4[1] = "fixdrop%";
+#line 21428 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 21428 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21428 ""
e_wsfe();
+#line 21428 ""
}
+#line 21429 ""
++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 */
- s_rsle(&io___1379);
+#line 21434 ""
+ s_rsle(&io___1424);
+#line 21434 ""
do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer));
+#line 21434 ""
do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real));
+#line 21434 ""
do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real));
+#line 21434 ""
do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real));
+#line 21434 ""
do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real))
;
+#line 21434 ""
do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)
);
+#line 21434 ""
e_rsle();
+#line 21435 ""
if (all_1.iline > 1) {
+#line 21435 ""
comtop_1.fracindent = frac;
+#line 21435 ""
}
+#line 21436 ""
if (all_1.figbass) {
+#line 21437 ""
all_1.ifigdr[(all_1.iline << 1) - 2] = 4;
+#line 21438 ""
all_1.ifigdr[(all_1.iline << 1) - 1] = 4;
+#line 21439 ""
}
+#line 21440 ""
all_1.slfac = slfac1 * all_1.musicsize * elsktot;
+#line 21441 ""
if (all_1.iline != 1) {
/* For the line just _finished_, put figdrop in separate file. */
+#line 21445 ""
if (all_1.figbass) {
- s_wsfe(&io___1381);
+#line 21445 ""
+ s_wsfe(&io___1426);
/* Writing concatenation */
+#line 21445 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21445 ""
i__6[1] = 8, a__4[1] = "figdrop=";
+#line 21445 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 21445 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21445 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
- 2], (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 21445 ""
i__8[0] = 1, a__5[0] = " ";
+#line 21445 ""
i__8[1] = 1, a__5[1] = all_1.sq;
+#line 21445 ""
i__8[2] = 8, a__5[2] = "figdtwo=";
+#line 21445 ""
s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10);
+#line 21445 ""
do_fio(&c__1, ch__20, (ftnlen)10);
+#line 21445 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
- 1], (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 21445 ""
i__11[0] = 1, a__8[0] = all_1.sq;
+#line 21445 ""
i__11[1] = 3, a__8[1] = "or%";
+#line 21445 ""
s_cat(ch__21, a__8, i__11, &c__2, (ftnlen)4);
+#line 21445 ""
do_fio(&c__1, ch__21, (ftnlen)4);
+#line 21445 ""
e_wsfe();
+#line 21445 ""
}
/* 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 21453 ""
r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f;
+#line 21453 ""
ndigbn = (integer) r_lg10(&r__1) + 1;
+#line 21454 ""
comsln_1.isnx = 0;
+#line 21455 ""
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 21461 ""
ioff = 0;
+#line 21462 ""
if (all_1.ibar > 1) {
+#line 21462 ""
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 21462 ""
}
+#line 21463 ""
i__7 = all_1.nsdat;
+#line 21463 ""
for (isdat = 1; isdat <= i__7; ++isdat) {
+#line 21464 ""
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(
@@ -31861,50 +51245,82 @@ L23:
/* is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */
/* Computing MAX */
+#line 21471 ""
i__2 = comsln_1.is1n1, i__13 = igetbits_(&
all_1.isdat2[isdat - 1], &c__7, &c__19);
+#line 21471 ""
comsln_1.is1n1 = max(i__2,i__13);
+#line 21472 ""
goto L51;
+#line 21473 ""
}
+#line 21474 ""
/* L50: */
+#line 21474 ""
}
/* If exiting loop normally, did not find end of slur. c'est la vie. */
+#line 21478 ""
L51:
+#line 21479 ""
i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd;
+#line 21479 ""
comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7);
+#line 21480 ""
if (comsln_1.isnx > 0) {
/* AHA! Slur likely to interfere with barno. */
/* Modified 090525 to use \bnrs */
+#line 21486 ""
slint = TRUE_;
+#line 21487 ""
s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12);
+#line 21488 ""
if (comsln_1.irzbnd + comsln_1.isnx > 9) {
+#line 21488 ""
s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen)
12);
+#line 21488 ""
}
+#line 21489 ""
if (comlast_1.islast) {
- s_wsfe(&io___1384);
+#line 21489 ""
+ s_wsfe(&io___1429);
/* Writing concatenation */
+#line 21489 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21489 ""
i__5[1] = 3, a__3[1] = "def";
+#line 21489 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21489 ""
i__5[3] = 11, a__3[3] = "raisebarno{";
+#line 21489 ""
s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16);
+#line 21489 ""
do_fio(&c__1, ch__22, (ftnlen)16);
+#line 21489 ""
i__7 = comsln_1.irzbnd + comsln_1.isnx;
+#line 21489 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(
integer));
/* Writing concatenation */
+#line 21489 ""
i__8[0] = 2, a__5[0] = ".5";
+#line 21489 ""
i__8[1] = 1, a__5[1] = all_1.sq;
+#line 21489 ""
i__8[2] = 11, a__5[2] = "internote}%";
+#line 21489 ""
s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
+#line 21489 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21489 ""
e_wsfe();
+#line 21489 ""
}
/* if (islast) then */
/* if (isnx .le. 9) then */
@@ -31914,8 +51330,11 @@ L51:
/* end if */
/* end if */
+#line 21499 ""
}
+#line 21500 ""
}
+#line 21501 ""
if (comget_1.movbrk > 0) {
/* movbrk = 0 */
@@ -31926,46 +51345,78 @@ L51:
/* indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */
/* This is passed to \newmovement. */
+#line 21511 ""
if (*(unsigned char *)comget_1.rptfq2 == 'E') {
+#line 21511 ""
*(unsigned char *)comget_1.rptfq2 = 'D';
+#line 21511 ""
}
+#line 21512 ""
indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, (
ftnlen)1) - 1;
+#line 21513 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
/* Also check for Rd or Rr set the normal way */
+#line 21517 ""
if (bit_test(islnow,8)) {
+#line 21518 ""
indsym = 1;
+#line 21519 ""
} else if (bit_test(islnow,6)) {
+#line 21520 ""
indsym = 2;
+#line 21521 ""
}
+#line 21522 ""
if (indsym < 0) {
- s_wsle(&io___1386);
+#line 21523 ""
+ s_wsle(&io___1431);
+#line 21523 ""
e_wsle();
- s_wsle(&io___1387);
+#line 21524 ""
+ s_wsle(&io___1432);
+#line 21524 ""
do_lio(&c__9, &c__1, "Illegal end symbol before \"/\""
, (ftnlen)29);
+#line 21524 ""
e_wsle();
+#line 21525 ""
stop1_();
+#line 21526 ""
}
/* Check for continuation (no bar number reset) */
+#line 21530 ""
if (comlast_1.islast && comnotes_1.nobar1) {
- s_wsfe(&io___1388);
+#line 21530 ""
+ s_wsfe(&io___1433);
/* Writing concatenation */
+#line 21530 ""
i__14[0] = 1, a__10[0] = all_1.sq;
+#line 21530 ""
i__14[1] = 7, a__10[1] = "advance";
+#line 21530 ""
i__14[2] = 1, a__10[2] = all_1.sq;
+#line 21530 ""
i__14[3] = 6, a__10[3] = "barno1";
+#line 21530 ""
i__14[4] = 1, a__10[4] = all_1.sq;
+#line 21530 ""
i__14[5] = 10, a__10[5] = "startbarno";
+#line 21530 ""
i__14[6] = 1, a__10[6] = all_1.sq;
+#line 21530 ""
i__14[7] = 6, a__10[7] = "barno%";
+#line 21530 ""
s_cat(ch__23, a__10, i__14, &c__8, (ftnlen)33);
+#line 21530 ""
do_fio(&c__1, ch__23, (ftnlen)33);
+#line 21530 ""
e_wsfe();
+#line 21530 ""
}
/* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */
@@ -31977,166 +51428,294 @@ L51:
/* if (islast) write(11,'(a13,i2,a1,i1,a1)') */
/* * sq//'newmovement{',movgap,'}',indsym,'%' */
/* end if */
+#line 21543 ""
if (comlast_1.islast) {
/* Writing concatenation */
+#line 21544 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21544 ""
i__6[1] = 11, a__4[1] = "newmovement";
+#line 21544 ""
s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40);
+#line 21545 ""
lnmq = 12;
+#line 21546 ""
if (comget_1.movgap < 10) {
+#line 21547 ""
lnmq = 14;
- s_wsfi(&io___1391);
+#line 21548 ""
+ s_wsfi(&io___1436);
+#line 21548 ""
do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
sizeof(integer));
+#line 21548 ""
do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
integer));
+#line 21548 ""
e_wsfi();
+#line 21549 ""
} else {
+#line 21550 ""
lnmq = 17;
- s_wsfi(&io___1392);
+#line 21551 ""
+ s_wsfi(&io___1437);
+#line 21551 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 21551 ""
do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
sizeof(integer));
+#line 21551 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 21551 ""
do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
integer));
+#line 21551 ""
e_wsfi();
+#line 21552 ""
}
+#line 21553 ""
if (comnotes_1.ninow < 10) {
+#line 21554 ""
++lnmq;
+#line 21555 ""
ici__1.icierr = 0;
+#line 21555 ""
ici__1.icirnum = 1;
+#line 21555 ""
ici__1.icirlen = 1;
+#line 21555 ""
ici__1.iciunit = nmq + (lnmq - 1);
+#line 21555 ""
ici__1.icifmt = "(i1)";
+#line 21555 ""
s_wsfi(&ici__1);
+#line 21555 ""
do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
sizeof(integer));
+#line 21555 ""
e_wsfi();
+#line 21556 ""
} else {
+#line 21557 ""
lnmq += 4;
+#line 21558 ""
i__7 = lnmq - 4;
+#line 21558 ""
ici__1.icierr = 0;
+#line 21558 ""
ici__1.icirnum = 1;
+#line 21558 ""
ici__1.icirlen = lnmq - i__7;
+#line 21558 ""
ici__1.iciunit = nmq + i__7;
+#line 21558 ""
ici__1.icifmt = "(a1,i2,a1)";
+#line 21558 ""
s_wsfi(&ici__1);
+#line 21558 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 21558 ""
do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
sizeof(integer));
+#line 21558 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 21558 ""
e_wsfi();
+#line 21559 ""
}
+#line 21560 ""
++lnmq;
+#line 21561 ""
ici__1.icierr = 0;
+#line 21561 ""
ici__1.icirnum = 1;
+#line 21561 ""
ici__1.icirlen = 1;
+#line 21561 ""
ici__1.iciunit = nmq + (lnmq - 1);
+#line 21561 ""
ici__1.icifmt = "(a1)";
+#line 21561 ""
s_wsfi(&ici__1);
+#line 21561 ""
do_fio(&c__1, "%", (ftnlen)1);
+#line 21561 ""
e_wsfi();
- s_wsfe(&io___1393);
+#line 21562 ""
+ s_wsfe(&io___1438);
+#line 21562 ""
do_fio(&c__1, nmq, lnmq);
+#line 21562 ""
e_wsfe();
+#line 21563 ""
}
/* Change generalmeter if necessary */
+#line 21567 ""
if (comlast_1.islast) {
+#line 21567 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21567 ""
}
/* (Moved all name-writing to getnote, right when 'M' is detected) */
+#line 21571 ""
if (bit_test(iplnow,28)) {
/* Key signature at movement break */
+#line 21575 ""
iplnow = bit_clear(iplnow,28);
+#line 21576 ""
if (comtop_1.isig > 0) {
+#line 21577 ""
if (comlast_1.islast) {
- s_wsfe(&io___1394);
+#line 21577 ""
+ s_wsfe(&io___1439);
/* Writing concatenation */
+#line 21577 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21577 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
+#line 21577 ""
s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18);
+#line 21577 ""
do_fio(&c__1, ch__24, (ftnlen)18);
+#line 21577 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
sizeof(integer));
+#line 21577 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 21577 ""
e_wsfe();
+#line 21577 ""
}
+#line 21579 ""
} else {
+#line 21580 ""
if (comlast_1.islast) {
- s_wsfe(&io___1395);
+#line 21580 ""
+ s_wsfe(&io___1440);
/* Writing concatenation */
+#line 21580 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21580 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
+#line 21580 ""
s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18);
+#line 21580 ""
do_fio(&c__1, ch__24, (ftnlen)18);
+#line 21580 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
sizeof(integer));
+#line 21580 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 21580 ""
e_wsfe();
+#line 21580 ""
}
+#line 21582 ""
}
+#line 21583 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
+#line 21584 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
+#line 21586 ""
}
+#line 21587 ""
}
+#line 21588 ""
if (comget_1.parmov >= -.1f) {
/* Resent paragraph indentation */
+#line 21592 ""
ipi = comget_1.parmov * comtop_1.widthpt + .1f;
+#line 21593 ""
if (ipi < 10) {
+#line 21594 ""
if (comlast_1.islast) {
- s_wsfe(&io___1397);
+#line 21594 ""
+ s_wsfe(&io___1442);
/* Writing concatenation */
+#line 21594 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21594 ""
i__6[1] = 10, a__4[1] = "parindent ";
+#line 21594 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 21594 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21594 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
+#line 21594 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 21594 ""
e_wsfe();
+#line 21594 ""
}
+#line 21596 ""
} else if (ipi < 100) {
+#line 21597 ""
if (comlast_1.islast) {
- s_wsfe(&io___1398);
+#line 21597 ""
+ s_wsfe(&io___1443);
/* Writing concatenation */
+#line 21597 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21597 ""
i__6[1] = 10, a__4[1] = "parindent ";
+#line 21597 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 21597 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21597 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
+#line 21597 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 21597 ""
e_wsfe();
+#line 21597 ""
}
+#line 21599 ""
} else {
+#line 21600 ""
if (comlast_1.islast) {
- s_wsfe(&io___1399);
+#line 21600 ""
+ s_wsfe(&io___1444);
/* Writing concatenation */
+#line 21600 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21600 ""
i__6[1] = 10, a__4[1] = "parindent ";
+#line 21600 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 21600 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21600 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
+#line 21600 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 21600 ""
e_wsfe();
+#line 21600 ""
}
+#line 21602 ""
}
+#line 21603 ""
}
+#line 21604 ""
}
+#line 21605 ""
if (isystpg == 1) {
/* First line on a page (not 1st page, still first bar). Tidy up old page */
@@ -32152,137 +51731,247 @@ L51:
/* Check for meter change at start of a new PAGE */
+#line 21620 ""
if (all_1.mtrnuml > 0) {
/* Meter change at start of a new page. Ugly repeated coding here. */
+#line 21624 ""
mtrnms = all_1.mtrnuml;
+#line 21625 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
+#line 21626 ""
all_1.mtrnuml = mtrnms;
+#line 21627 ""
if (comget_1.movbrk == 0 && comlast_1.islast) {
+#line 21627 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21627 ""
}
+#line 21629 ""
}
/* Key signature change? */
+#line 21633 ""
if (bit_test(iplnow,28) && comget_1.movbrk == 0) {
/* Writing concatenation */
+#line 21634 ""
i__14[0] = 1, a__10[0] = all_1.sq;
+#line 21634 ""
i__14[1] = 4, a__10[1] = "xbar";
+#line 21634 ""
i__14[2] = 1, a__10[2] = all_1.sq;
+#line 21634 ""
i__14[3] = 10, a__10[3] = "addspace{-";
+#line 21634 ""
i__14[4] = 1, a__10[4] = all_1.sq;
+#line 21634 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
+#line 21634 ""
i__14[6] = 1, a__10[6] = all_1.sq;
+#line 21634 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
+#line 21634 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
+#line 21636 ""
lnote = 49;
+#line 21637 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
+#line 21638 ""
i__6[0] = 49, a__4[0] = notexq;
+#line 21638 ""
i__6[1] = 1, a__4[1] = "-";
+#line 21638 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21639 ""
lnote = 50;
+#line 21640 ""
}
+#line 21641 ""
if (comlast_1.islast) {
- s_wsfe(&io___1401);
+#line 21641 ""
+ s_wsfe(&io___1446);
/* Writing concatenation */
+#line 21641 ""
i__8[0] = lnote, a__5[0] = notexq;
+#line 21641 ""
i__7 = abs(comtop_1.isig) + 48;
+#line 21641 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 21641 ""
i__8[1] = 1, a__5[1] = ch__1;
+#line 21641 ""
i__8[2] = 2, a__5[2] = "}%";
+#line 21641 ""
s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82);
+#line 21641 ""
do_fio(&c__1, ch__25, lnote + 3);
+#line 21641 ""
e_wsfe();
+#line 21641 ""
}
+#line 21643 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
+#line 21644 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
+#line 21646 ""
}
+#line 21647 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
- s_wsfe(&io___1402);
+#line 21647 ""
+ s_wsfe(&io___1447);
/* Writing concatenation */
+#line 21647 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21647 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21647 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21647 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21647 ""
e_wsfe();
+#line 21647 ""
}
+#line 21649 ""
if (comlast_1.islast) {
- s_wsfe(&io___1403);
+#line 21649 ""
+ s_wsfe(&io___1448);
/* Writing concatenation */
+#line 21649 ""
i__9[0] = 1, a__6[0] = all_1.sq;
+#line 21649 ""
i__9[1] = 14, a__6[1] = "zchangecontext";
+#line 21649 ""
i__9[2] = 1, a__6[2] = all_1.sq;
+#line 21649 ""
i__9[3] = 10, a__6[3] = "addspace{-";
+#line 21649 ""
i__9[4] = 1, a__6[4] = all_1.sq;
+#line 21649 ""
i__9[5] = 14, a__6[5] = "afterruleskip}";
+#line 21649 ""
i__9[6] = 1, a__6[6] = all_1.sq;
+#line 21649 ""
i__9[7] = 10, a__6[7] = "zstoppiece";
+#line 21649 ""
i__9[8] = 1, a__6[8] = all_1.sq;
+#line 21649 ""
i__9[9] = 13, a__6[9] = "PMXbarnotrue%";
+#line 21649 ""
s_cat(ch__26, a__6, i__9, &c__10, (ftnlen)66);
+#line 21649 ""
do_fio(&c__1, ch__26, (ftnlen)66);
+#line 21649 ""
e_wsfe();
+#line 21649 ""
}
+#line 21652 ""
} else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) {
/* Meter change but no signature change */
+#line 21656 ""
if (comlast_1.islast) {
- s_wsfe(&io___1404);
+#line 21656 ""
+ s_wsfe(&io___1449);
/* Writing concatenation */
+#line 21656 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 21656 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
+#line 21656 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 21656 ""
i__3[3] = 10, a__1[3] = "addspace{-";
+#line 21656 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 21656 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
+#line 21656 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 21656 ""
i__3[7] = 3, a__1[7] = "let";
+#line 21656 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 21656 ""
i__3[9] = 4, a__1[9] = "bnat";
+#line 21656 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 21656 ""
i__3[11] = 9, a__1[11] = "barnoadd%";
+#line 21656 ""
s_cat(ch__27, a__1, i__3, &c__12, (ftnlen)60);
+#line 21656 ""
do_fio(&c__1, ch__27, (ftnlen)60);
+#line 21656 ""
e_wsfe();
+#line 21656 ""
}
+#line 21660 ""
if (comlast_1.islast) {
- s_wsfe(&io___1405);
+#line 21660 ""
+ s_wsfe(&io___1450);
/* Writing concatenation */
+#line 21660 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 21660 ""
i__3[1] = 3, a__1[1] = "def";
+#line 21660 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 21660 ""
i__3[3] = 9, a__1[3] = "barnoadd{";
+#line 21660 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 21660 ""
i__3[5] = 3, a__1[5] = "let";
+#line 21660 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 21660 ""
i__3[7] = 8, a__1[7] = "barnoadd";
+#line 21660 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 21660 ""
i__3[9] = 5, a__1[9] = "bnat}";
+#line 21660 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 21660 ""
i__3[11] = 11, a__1[11] = "zstoppiece%";
+#line 21660 ""
s_cat(ch__28, a__1, i__3, &c__12, (ftnlen)45);
+#line 21660 ""
do_fio(&c__1, ch__28, (ftnlen)45);
+#line 21660 ""
e_wsfe();
+#line 21660 ""
}
+#line 21663 ""
} else {
+#line 21664 ""
if (comlast_1.islast) {
- s_wsfe(&io___1406);
+#line 21664 ""
+ s_wsfe(&io___1451);
/* Writing concatenation */
+#line 21664 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21664 ""
i__6[1] = 10, a__4[1] = "stoppiece%";
+#line 21664 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 21664 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21664 ""
e_wsfe();
+#line 21664 ""
}
+#line 21665 ""
}
/* This is the key spot when vshrink is used. Value of vshrink here comes from */
@@ -32296,310 +51985,665 @@ 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 21678 ""
if (! vshrink) {
+#line 21679 ""
+ if (comlast_1.islast && combottop_1.bottopgap) {
+#line 21680 ""
+ if (dabs(combottop_1.botamt) > 1e-6f) {
+#line 21681 ""
+ if (combottop_1.botamt > 9.95f) {
+#line 21682 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21683 ""
+ } else if (combottop_1.botamt > 0.f) {
+#line 21684 ""
+ s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21685 ""
+ } else if (combottop_1.botamt > -9.95f) {
+#line 21686 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21687 ""
+ } else {
+#line 21688 ""
+ s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21689 ""
+ }
+#line 21690 ""
+ s_wsfe(&io___1452);
+/* Writing concatenation */
+#line 21690 ""
+ i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21690 ""
+ i__5[1] = 4, a__3[1] = "null";
+#line 21690 ""
+ i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21690 ""
+ i__5[3] = 5, a__3[3] = "vskip";
+#line 21690 ""
+ s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 21690 ""
+ do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21690 ""
+ do_fio(&c__1, (char *)&combottop_1.botamt, (
+ ftnlen)sizeof(real));
+/* Writing concatenation */
+#line 21690 ""
+ i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21690 ""
+ i__6[1] = 10, a__4[1] = "Internote%";
+#line 21690 ""
+ s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11);
+#line 21690 ""
+ do_fio(&c__1, ch__29, (ftnlen)11);
+#line 21690 ""
+ e_wsfe();
+#line 21692 ""
+ }
+#line 21693 ""
+ }
+#line 21694 ""
xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot /
etatop;
+#line 21695 ""
if (xnstbot < 9.95f) {
+#line 21696 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10)
;
+#line 21697 ""
} else {
+#line 21698 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10)
;
+#line 21699 ""
}
+#line 21700 ""
if (comlast_1.islast) {
- s_wsfe(&io___1408);
+#line 21700 ""
+ s_wsfe(&io___1454);
/* Writing concatenation */
+#line 21700 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21700 ""
i__6[1] = 5, a__4[1] = "vskip";
- s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6);
- do_fio(&c__1, ch__29, (ftnlen)6);
+#line 21700 ""
+ s_cat(ch__30, a__4, i__6, &c__2, (ftnlen)6);
+#line 21700 ""
+ do_fio(&c__1, ch__30, (ftnlen)6);
+#line 21700 ""
do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(
real));
/* Writing concatenation */
+#line 21700 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21700 ""
i__5[1] = 10, a__3[1] = "Interligne";
+#line 21700 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21700 ""
i__5[3] = 6, a__3[3] = "eject%";
+#line 21700 ""
s_cat(ch__24, a__3, i__5, &c__4, (ftnlen)18);
+#line 21700 ""
do_fio(&c__1, ch__24, (ftnlen)18);
+#line 21700 ""
e_wsfe();
+#line 21700 ""
+ }
+#line 21702 ""
+ if (comlast_1.islast && combottop_1.bottopgap) {
+#line 21703 ""
+ if (dabs(combottop_1.topamt) > 1e-6f) {
+#line 21704 ""
+ if (combottop_1.topamt > 9.95f) {
+#line 21705 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21706 ""
+ } else if (combottop_1.topamt > 0.f) {
+#line 21707 ""
+ s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21708 ""
+ } else if (combottop_1.topamt > -9.95f) {
+#line 21709 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21710 ""
+ } else {
+#line 21711 ""
+ s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (
+ ftnlen)10);
+#line 21712 ""
+ }
+#line 21713 ""
+ s_wsfe(&io___1455);
+/* Writing concatenation */
+#line 21713 ""
+ i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21713 ""
+ i__5[1] = 4, a__3[1] = "null";
+#line 21713 ""
+ i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21713 ""
+ i__5[3] = 5, a__3[3] = "vskip";
+#line 21713 ""
+ s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 21713 ""
+ do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21713 ""
+ do_fio(&c__1, (char *)&combottop_1.topamt, (
+ ftnlen)sizeof(real));
+/* Writing concatenation */
+#line 21713 ""
+ i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21713 ""
+ i__6[1] = 10, a__4[1] = "Internote%";
+#line 21713 ""
+ s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11);
+#line 21713 ""
+ do_fio(&c__1, ch__29, (ftnlen)11);
+#line 21713 ""
+ e_wsfe();
+#line 21715 ""
+ }
+#line 21716 ""
+ combottop_1.bottopgap = FALSE_;
+#line 21717 ""
}
+#line 21718 ""
} else {
+#line 21719 ""
if (comlast_1.islast) {
- s_wsfe(&io___1409);
+#line 21719 ""
+ s_wsfe(&io___1456);
/* Writing concatenation */
+#line 21719 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21719 ""
i__5[1] = 5, a__3[1] = "vfill";
+#line 21719 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21719 ""
i__5[3] = 6, a__3[3] = "eject%";
+#line 21719 ""
s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)13);
+#line 21719 ""
do_fio(&c__1, ch__17, (ftnlen)13);
+#line 21719 ""
e_wsfe();
+#line 21719 ""
}
+#line 21720 ""
}
+#line 21721 ""
++comnotes_1.ipage;
/* Now that page is ejected, compute new vshrink */
+#line 21725 ""
vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f &&
comlast_1.usevshrink;
+#line 21726 ""
if (vshrink) {
+#line 21727 ""
comarp_1.xinsnow = 10.f;
+#line 21728 ""
} else {
+#line 21729 ""
comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1];
+#line 21730 ""
}
+#line 21731 ""
if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) {
+#line 21732 ""
comarp_1.xinsnow = comarp_1.xinsnow *
comget_1.fintstf / comget_1.gintstf;
+#line 21733 ""
comget_1.fintstf = -1.f;
+#line 21734 ""
}
+#line 21735 ""
if (comarp_1.xinsnow < 9.95f) {
+#line 21736 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
+#line 21737 ""
} else if (comarp_1.xinsnow < 99.95f) {
+#line 21738 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
+#line 21739 ""
} else {
+#line 21740 ""
s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10);
+#line 21741 ""
}
/* Vertical spacing parameters, then restart */
+#line 21745 ""
+ if (comis4bignv_1.is4bignv) {
+#line 21745 ""
+ comarp_1.xinsnow *= .95f;
+#line 21745 ""
+ }
+#line 21746 ""
if (comlast_1.islast) {
- s_wsfe(&io___1410);
+#line 21746 ""
+ s_wsfe(&io___1457);
/* Writing concatenation */
+#line 21746 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21746 ""
i__6[1] = 11, a__4[1] = "interstaff{";
+#line 21746 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21746 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21746 ""
do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen)
sizeof(real));
/* Writing concatenation */
+#line 21746 ""
i__8[0] = 1, a__5[0] = "}";
+#line 21746 ""
i__8[1] = 1, a__5[1] = all_1.sq;
+#line 21746 ""
i__8[2] = 9, a__5[2] = "contpiece";
+#line 21746 ""
s_cat(ch__15, a__5, i__8, &c__3, (ftnlen)11);
+#line 21746 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21746 ""
e_wsfe();
+#line 21746 ""
}
/* Check for meter change at start of a new PAGE */
+#line 21751 ""
if (all_1.mtrnuml > 0) {
/* Meter change at start of a new page */
+#line 21755 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
+#line 21756 ""
if (comget_1.movbrk == 0) {
+#line 21757 ""
if (comlast_1.islast) {
+#line 21757 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21757 ""
}
+#line 21758 ""
if (all_1.mtrdnp > 0) {
+#line 21759 ""
if (comlast_1.islast) {
- s_wsfe(&io___1411);
+#line 21759 ""
+ s_wsfe(&io___1458);
/* Writing concatenation */
+#line 21759 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21759 ""
i__6[1] = 10, a__4[1] = "newtimes2%";
+#line 21759 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)
11);
+#line 21759 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21759 ""
e_wsfe();
+#line 21759 ""
}
+#line 21760 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
+#line 21760 ""
comgrace_1.xb4mbr = all_1.musicsize *
-.2f;
+#line 21760 ""
}
+#line 21761 ""
}
+#line 21762 ""
}
+#line 21763 ""
}
/* 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 21768 ""
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 21770 ""
if (comnotes_1.headerspecial) {
- s_wsfe(&io___1412);
+#line 21770 ""
+ s_wsfe(&io___1459);
/* Writing concatenation */
+#line 21770 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 21770 ""
i__6[0] = 1, a__4[0] = ch__1;
+#line 21770 ""
i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"
;
+#line 21770 ""
s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
+#line 21770 ""
do_fio(&c__1, ch__7, (ftnlen)29);
+#line 21770 ""
e_wsfe();
+#line 21770 ""
}
/* Write special header for first page */
+#line 21775 ""
} else {
/* First bar of system, not a new page, force line break */
+#line 21779 ""
if (bit_test(iplnow,28)) {
/* Signature change */
/* Writing concatenation */
+#line 21783 ""
i__14[0] = 1, a__10[0] = all_1.sq;
+#line 21783 ""
i__14[1] = 4, a__10[1] = "xbar";
+#line 21783 ""
i__14[2] = 1, a__10[2] = all_1.sq;
+#line 21783 ""
i__14[3] = 10, a__10[3] = "addspace{-";
+#line 21783 ""
i__14[4] = 1, a__10[4] = all_1.sq;
+#line 21783 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
+#line 21783 ""
i__14[6] = 1, a__10[6] = all_1.sq;
+#line 21783 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
+#line 21783 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
+#line 21785 ""
lnote = 49;
+#line 21786 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
+#line 21787 ""
i__6[0] = 49, a__4[0] = notexq;
+#line 21787 ""
i__6[1] = 1, a__4[1] = "-";
+#line 21787 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21788 ""
lnote = 50;
+#line 21789 ""
}
+#line 21790 ""
if (comlast_1.islast) {
- s_wsfe(&io___1413);
+#line 21790 ""
+ s_wsfe(&io___1460);
/* Writing concatenation */
+#line 21790 ""
i__8[0] = lnote, a__5[0] = notexq;
+#line 21790 ""
i__7 = abs(comtop_1.isig) + 48;
+#line 21790 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 21790 ""
i__8[1] = 1, a__5[1] = ch__1;
+#line 21790 ""
i__8[2] = 2, a__5[2] = "}%";
+#line 21790 ""
s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82);
+#line 21790 ""
do_fio(&c__1, ch__25, lnote + 3);
+#line 21790 ""
e_wsfe();
+#line 21790 ""
}
+#line 21792 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
+#line 21793 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
+#line 21795 ""
}
+#line 21796 ""
if (comlast_1.islast) {
- s_wsfe(&io___1414);
+#line 21796 ""
+ s_wsfe(&io___1461);
/* Writing concatenation */
+#line 21796 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21796 ""
i__5[1] = 7, a__3[1] = "advance";
+#line 21796 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21796 ""
i__5[3] = 8, a__3[3] = "barno-1%";
+#line 21796 ""
s_cat(ch__13, a__3, i__5, &c__4, (ftnlen)17);
+#line 21796 ""
do_fio(&c__1, ch__13, (ftnlen)17);
+#line 21796 ""
e_wsfe();
+#line 21796 ""
}
+#line 21797 ""
if (all_1.mtrnuml != 0) {
/* Meter+sig change, new line, may need mods if movement break here. */
+#line 21801 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
+#line 21802 ""
if (comlast_1.islast) {
+#line 21803 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21804 ""
if (comignorenats_1.ignorenats) {
- s_wsfe(&io___1415);
+#line 21804 ""
+ s_wsfe(&io___1462);
/* Writing concatenation */
+#line 21804 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21804 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21804 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)
12);
+#line 21804 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21804 ""
e_wsfe();
+#line 21804 ""
}
- s_wsfe(&io___1416);
+#line 21805 ""
+ s_wsfe(&io___1463);
/* Writing concatenation */
+#line 21805 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 21805 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
+#line 21805 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 21805 ""
i__3[3] = 10, a__1[3] = "addspace{-";
+#line 21805 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 21805 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
+#line 21805 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 21805 ""
i__3[7] = 10, a__1[7] = "zstoppiece";
+#line 21805 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 21805 ""
i__3[9] = 12, a__1[9] = "PMXbarnotrue";
+#line 21805 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 21805 ""
i__3[11] = 10, a__1[11] = "contpiece%";
- s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76);
- do_fio(&c__1, ch__30, (ftnlen)76);
+#line 21805 ""
+ s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)76);
+#line 21805 ""
+ do_fio(&c__1, ch__31, (ftnlen)76);
+#line 21805 ""
e_wsfe();
/* * 'addspace{-'//sq//'afterruleskip}'//sq//'def' */
/* * //sq//'writezbarno{}'//sq//'zalaligne%' */
- s_wsfe(&io___1417);
+#line 21810 ""
+ s_wsfe(&io___1464);
/* Writing concatenation */
+#line 21810 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21810 ""
i__5[1] = 10, a__3[1] = "addspace{-";
+#line 21810 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21810 ""
i__5[3] = 15, a__3[3] = "afterruleskip}%";
+#line 21810 ""
s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
+#line 21810 ""
do_fio(&c__1, ch__5, (ftnlen)27);
+#line 21810 ""
e_wsfe();
+#line 21812 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21813 ""
if (comignorenats_1.ignorenats) {
- s_wsfe(&io___1418);
+#line 21813 ""
+ s_wsfe(&io___1465);
/* Writing concatenation */
+#line 21813 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21813 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21813 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)
12);
+#line 21813 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21813 ""
e_wsfe();
+#line 21813 ""
}
- s_wsfe(&io___1419);
+#line 21814 ""
+ s_wsfe(&io___1466);
/* Writing concatenation */
+#line 21814 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21814 ""
i__6[1] = 14, a__4[1] = "zchangecontext";
+#line 21814 ""
s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15);
+#line 21814 ""
do_fio(&c__1, ch__16, (ftnlen)15);
+#line 21814 ""
e_wsfe();
+#line 21815 ""
}
+#line 21816 ""
} else {
+#line 21817 ""
if (comlast_1.islast &&
comignorenats_1.ignorenats) {
- s_wsfe(&io___1420);
+#line 21817 ""
+ s_wsfe(&io___1467);
/* Writing concatenation */
+#line 21817 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21817 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21817 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21817 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21817 ""
e_wsfe();
+#line 21817 ""
}
+#line 21819 ""
if (comlast_1.islast) {
- s_wsfe(&io___1421);
+#line 21819 ""
+ s_wsfe(&io___1468);
/* Writing concatenation */
+#line 21819 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 21819 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
+#line 21819 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 21819 ""
i__3[3] = 10, a__1[3] = "addspace{-";
+#line 21819 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 21819 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
+#line 21819 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 21819 ""
i__3[7] = 10, a__1[7] = "zstoppiece";
+#line 21819 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 21819 ""
i__3[9] = 12, a__1[9] = "PMXbarnotrue";
+#line 21819 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 21819 ""
i__3[11] = 10, a__1[11] = "contpiece%";
- s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76);
- do_fio(&c__1, ch__30, (ftnlen)76);
+#line 21819 ""
+ s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)76);
+#line 21819 ""
+ do_fio(&c__1, ch__31, (ftnlen)76);
+#line 21819 ""
e_wsfe();
+#line 21819 ""
}
/* * 'addspace{-'//sq//'afterruleskip}'//sq//'def'// */
/* * sq//'writezbarno{}'//sq//'zalaligne%' */
+#line 21824 ""
}
+#line 21825 ""
} else if (all_1.mtrnuml == 0) {
/* No meter change */
+#line 21829 ""
if (comlast_1.islast) {
- s_wsfe(&io___1422);
+#line 21829 ""
+ s_wsfe(&io___1469);
/* Writing concatenation */
+#line 21829 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21829 ""
i__6[1] = 8, a__4[1] = "alaligne";
+#line 21829 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 21829 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21829 ""
e_wsfe();
+#line 21829 ""
}
+#line 21830 ""
} else {
/* New meter, no new sig, end of line, not new page. */
@@ -32609,356 +52653,620 @@ L51:
/* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */
/* \zchangecontext */
+#line 21839 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
+#line 21840 ""
if (comget_1.movbrk == 0) {
+#line 21841 ""
if (comlast_1.islast) {
+#line 21841 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21841 ""
}
+#line 21842 ""
if (all_1.mtrdnp > 0) {
+#line 21843 ""
if (comlast_1.islast) {
- s_wsfe(&io___1423);
+#line 21844 ""
+ s_wsfe(&io___1470);
/* Writing concatenation */
+#line 21844 ""
i__3[0] = 1, a__1[0] = all_1.sq;
+#line 21844 ""
i__3[1] = 3, a__1[1] = "let";
+#line 21844 ""
i__3[2] = 1, a__1[2] = all_1.sq;
+#line 21844 ""
i__3[3] = 4, a__1[3] = "bnat";
+#line 21844 ""
i__3[4] = 1, a__1[4] = all_1.sq;
+#line 21844 ""
i__3[5] = 8, a__1[5] = "barnoadd";
+#line 21844 ""
i__3[6] = 1, a__1[6] = all_1.sq;
+#line 21844 ""
i__3[7] = 3, a__1[7] = "def";
+#line 21844 ""
i__3[8] = 1, a__1[8] = all_1.sq;
+#line 21844 ""
i__3[9] = 9, a__1[9] = "barnoadd{";
+#line 21844 ""
i__3[10] = 1, a__1[10] = all_1.sq;
+#line 21844 ""
i__3[11] = 7, a__1[11] = "empty}%";
- s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)
+#line 21844 ""
+ s_cat(ch__32, a__1, i__3, &c__12, (ftnlen)
40);
- do_fio(&c__1, ch__31, (ftnlen)40);
+#line 21844 ""
+ do_fio(&c__1, ch__32, (ftnlen)40);
+#line 21844 ""
e_wsfe();
- s_wsfe(&io___1424);
+#line 21847 ""
+ s_wsfe(&io___1471);
/* Writing concatenation */
+#line 21847 ""
i__15[0] = 1, a__11[0] = all_1.sq;
+#line 21847 ""
i__15[1] = 14, a__11[1] = "xchangecontext"
;
+#line 21847 ""
i__15[2] = 1, a__11[2] = all_1.sq;
+#line 21847 ""
i__15[3] = 10, a__11[3] = "addspace{-";
+#line 21847 ""
i__15[4] = 1, a__11[4] = all_1.sq;
+#line 21847 ""
i__15[5] = 14, a__11[5] = "afterruleskip}"
;
+#line 21847 ""
i__15[6] = 1, a__11[6] = all_1.sq;
+#line 21847 ""
i__15[7] = 9, a__11[7] = "zalaligne";
+#line 21847 ""
i__15[8] = 1, a__11[8] = all_1.sq;
+#line 21847 ""
i__15[9] = 3, a__11[9] = "let";
+#line 21847 ""
i__15[10] = 1, a__11[10] = all_1.sq;
+#line 21847 ""
i__15[11] = 8, a__11[11] = "barnoadd";
+#line 21847 ""
i__15[12] = 1, a__11[12] = all_1.sq;
+#line 21847 ""
i__15[13] = 4, a__11[13] = "bnat";
- s_cat(ch__32, a__11, i__15, &c__14, (
+#line 21847 ""
+ s_cat(ch__33, a__11, i__15, &c__14, (
ftnlen)69);
- do_fio(&c__1, ch__32, (ftnlen)69);
+#line 21847 ""
+ do_fio(&c__1, ch__33, (ftnlen)69);
+#line 21847 ""
e_wsfe();
+#line 21850 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
- s_wsfe(&io___1425);
+#line 21851 ""
+ s_wsfe(&io___1472);
/* Writing concatenation */
+#line 21851 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 21851 ""
i__4[1] = 10, a__2[1] = "addspace{-";
+#line 21851 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 21851 ""
i__4[3] = 14, a__2[3] = "afterruleskip}";
+#line 21851 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 21851 ""
i__4[5] = 14, a__2[5] = "zchangecontext";
- s_cat(ch__33, a__2, i__4, &c__6, (ftnlen)
+#line 21851 ""
+ s_cat(ch__34, a__2, i__4, &c__6, (ftnlen)
41);
- do_fio(&c__1, ch__33, (ftnlen)41);
+#line 21851 ""
+ do_fio(&c__1, ch__34, (ftnlen)41);
+#line 21851 ""
e_wsfe();
+#line 21853 ""
}
+#line 21854 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
+#line 21854 ""
comgrace_1.xb4mbr = all_1.musicsize *
-.2f;
+#line 21854 ""
}
+#line 21855 ""
} else {
+#line 21856 ""
if (comlast_1.islast) {
- s_wsfe(&io___1426);
+#line 21856 ""
+ s_wsfe(&io___1473);
/* Writing concatenation */
+#line 21856 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21856 ""
i__6[1] = 8, a__4[1] = "alaligne";
+#line 21856 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)
9);
+#line 21856 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21856 ""
e_wsfe();
+#line 21856 ""
}
+#line 21857 ""
}
+#line 21858 ""
} else {
+#line 21859 ""
if (comlast_1.islast) {
- s_wsfe(&io___1427);
+#line 21859 ""
+ s_wsfe(&io___1474);
/* Writing concatenation */
+#line 21859 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21859 ""
i__6[1] = 8, a__4[1] = "alaligne";
+#line 21859 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 21859 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 21859 ""
e_wsfe();
+#line 21859 ""
}
+#line 21860 ""
}
+#line 21861 ""
}
+#line 21862 ""
}
/* Modified 090525 to use \bnrs */
+#line 21866 ""
if (slint) {
+#line 21867 ""
slint = FALSE_;
+#line 21868 ""
if (comlast_1.islast) {
- s_wsfe(&io___1428);
+#line 21868 ""
+ s_wsfe(&io___1475);
/* Writing concatenation */
+#line 21868 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 21868 ""
i__5[1] = 3, a__3[1] = "def";
+#line 21868 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 21868 ""
i__5[3] = 11, a__3[3] = "raisebarno{";
+#line 21868 ""
s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16);
+#line 21868 ""
do_fio(&c__1, ch__22, (ftnlen)16);
+#line 21868 ""
do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen)
sizeof(integer));
/* Writing concatenation */
+#line 21868 ""
i__8[0] = 2, a__5[0] = ".5";
+#line 21868 ""
i__8[1] = 1, a__5[1] = all_1.sq;
+#line 21868 ""
i__8[2] = 11, a__5[2] = "internote}%";
+#line 21868 ""
s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
+#line 21868 ""
do_fio(&c__1, ch__10, (ftnlen)14);
+#line 21868 ""
e_wsfe();
+#line 21868 ""
}
+#line 21870 ""
}
+#line 21871 ""
comget_1.movbrk = 0;
+#line 21872 ""
}
/* Clean up if we squelched bar number reset at movement break */
+#line 21876 ""
if (comnotes_1.nobar1) {
+#line 21877 ""
if (comlast_1.islast) {
- s_wsfe(&io___1429);
+#line 21877 ""
+ s_wsfe(&io___1476);
/* Writing concatenation */
+#line 21877 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21877 ""
i__6[1] = 11, a__4[1] = "startbarno1";
+#line 21877 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21877 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21877 ""
e_wsfe();
+#line 21877 ""
}
+#line 21878 ""
comnotes_1.nobar1 = FALSE_;
+#line 21879 ""
}
- i__7 = s_rsle(&io___1430);
+#line 21880 ""
+ i__7 = s_rsle(&io___1477);
+#line 21880 ""
if (i__7 != 0) {
+#line 21880 ""
goto L14;
+#line 21880 ""
}
+#line 21880 ""
i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(
integer));
+#line 21880 ""
if (i__7 != 0) {
+#line 21880 ""
goto L14;
+#line 21880 ""
}
+#line 21880 ""
i__7 = e_rsle();
+#line 21880 ""
if (i__7 != 0) {
+#line 21880 ""
goto L14;
+#line 21880 ""
}
+#line 21881 ""
L14:
/* We come thru here for the 1st bar of every system, so initialize is1n1 */
+#line 21885 ""
comsln_1.is1n1 = 0;
/* Brought down from above */
+#line 21889 ""
if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) {
+#line 21889 ""
isystpg = 0;
+#line 21889 ""
}
/* Check for linebreak ties */
+#line 21893 ""
if (ispstie) {
+#line 21893 ""
linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
ftnlen)1);
+#line 21893 ""
}
+#line 21896 ""
} else {
/* Not first bar of system */
+#line 21900 ""
if (bit_test(iplnow,28)) {
/* Signature change */
+#line 21904 ""
if (all_1.mtrnuml != 0) {
/* Meter+signature change mid line, assume no movement break */
+#line 21908 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
+#line 21909 ""
if (comlast_1.islast) {
+#line 21909 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21909 ""
}
/* Writing concatenation */
+#line 21910 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21910 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
+#line 21910 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21911 ""
lnote = 18;
+#line 21912 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
+#line 21913 ""
i__6[0] = 18, a__4[0] = notexq;
+#line 21913 ""
i__6[1] = 1, a__4[1] = "-";
+#line 21913 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21914 ""
lnote = 19;
+#line 21915 ""
}
+#line 21916 ""
if (comlast_1.islast) {
+#line 21917 ""
iptemp = abs(comtop_1.isig) + 48;
+#line 21918 ""
chax_(ch__1, (ftnlen)1, &iptemp);
+#line 21918 ""
*(unsigned char *)charq = *(unsigned char *)&ch__1[0];
/* Writing concatenation */
+#line 21919 ""
i__8[0] = lnote, a__5[0] = notexq;
+#line 21919 ""
i__8[1] = 1, a__5[1] = charq;
+#line 21919 ""
i__8[2] = 2, a__5[2] = "}%";
+#line 21919 ""
s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79);
+#line 21920 ""
lnote += 3;
- s_wsfe(&io___1433);
+#line 21921 ""
+ s_wsfe(&io___1480);
+#line 21921 ""
do_fio(&c__1, notexq, lnote);
+#line 21921 ""
e_wsfe();
+#line 21922 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
+#line 21923 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
+#line 21925 ""
}
+#line 21926 ""
if (comignorenats_1.ignorenats) {
- s_wsfe(&io___1434);
+#line 21926 ""
+ s_wsfe(&io___1481);
/* Writing concatenation */
+#line 21926 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21926 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21926 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21926 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21926 ""
e_wsfe();
+#line 21926 ""
}
- s_wsfe(&io___1435);
+#line 21927 ""
+ s_wsfe(&io___1482);
/* Writing concatenation */
+#line 21927 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21927 ""
i__6[1] = 15, a__4[1] = "xchangecontext%";
+#line 21927 ""
s_cat(ch__22, a__4, i__6, &c__2, (ftnlen)16);
+#line 21927 ""
do_fio(&c__1, ch__22, (ftnlen)16);
+#line 21927 ""
e_wsfe();
+#line 21928 ""
}
+#line 21929 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
/* Compute space for multibar rest */
+#line 21933 ""
if (comtop_1.lastisig * comtop_1.isig >= 0) {
/* Computing MAX */
+#line 21934 ""
i__7 = abs(comtop_1.lastisig), i__2 = abs(
comtop_1.isig);
+#line 21934 ""
naccs = max(i__7,i__2);
+#line 21935 ""
} else {
+#line 21936 ""
naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
abs(i__7));
+#line 21937 ""
}
/* xb4mbr = (facmtr+naccs*.24)*musicsize */
+#line 21939 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
+#line 21940 ""
}
+#line 21941 ""
} else {
/* Signature change only */
/* Writing concatenation */
+#line 21945 ""
i__14[0] = 1, a__10[0] = all_1.sq;
+#line 21945 ""
i__14[1] = 4, a__10[1] = "xbar";
+#line 21945 ""
i__14[2] = 1, a__10[2] = all_1.sq;
+#line 21945 ""
i__14[3] = 10, a__10[3] = "addspace{-";
+#line 21945 ""
i__14[4] = 1, a__10[4] = all_1.sq;
+#line 21945 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
+#line 21945 ""
i__14[6] = 1, a__10[6] = all_1.sq;
+#line 21945 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
+#line 21945 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
+#line 21947 ""
lnote = 49;
+#line 21948 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
+#line 21949 ""
i__6[0] = 49, a__4[0] = notexq;
+#line 21949 ""
i__6[1] = 1, a__4[1] = "-";
+#line 21949 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
+#line 21950 ""
lnote = 50;
+#line 21951 ""
}
+#line 21952 ""
if (comlast_1.islast) {
- s_wsfe(&io___1437);
+#line 21952 ""
+ s_wsfe(&io___1484);
/* Writing concatenation */
+#line 21952 ""
i__8[0] = lnote, a__5[0] = notexq;
+#line 21952 ""
i__7 = abs(comtop_1.isig) + 48;
+#line 21952 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 21952 ""
i__8[1] = 1, a__5[1] = ch__1;
+#line 21952 ""
i__8[2] = 2, a__5[2] = "}%";
+#line 21952 ""
s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82);
+#line 21952 ""
do_fio(&c__1, ch__25, lnote + 3);
+#line 21952 ""
e_wsfe();
+#line 21952 ""
}
+#line 21954 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans) {
+#line 21955 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
+#line 21957 ""
}
+#line 21958 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
- s_wsfe(&io___1438);
+#line 21958 ""
+ s_wsfe(&io___1485);
/* Writing concatenation */
+#line 21958 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21958 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
+#line 21958 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 21958 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 21958 ""
e_wsfe();
+#line 21958 ""
}
+#line 21960 ""
if (comlast_1.islast) {
- s_wsfe(&io___1439);
+#line 21960 ""
+ s_wsfe(&io___1486);
/* Writing concatenation */
+#line 21960 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 21960 ""
i__4[1] = 14, a__2[1] = "zchangecontext";
+#line 21960 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 21960 ""
i__4[3] = 12, a__2[3] = "addspace{-.5";
+#line 21960 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 21960 ""
i__4[5] = 15, a__2[5] = "afterruleskip}%";
- s_cat(ch__34, a__2, i__4, &c__6, (ftnlen)44);
- do_fio(&c__1, ch__34, (ftnlen)44);
+#line 21960 ""
+ s_cat(ch__35, a__2, i__4, &c__6, (ftnlen)44);
+#line 21960 ""
+ do_fio(&c__1, ch__35, (ftnlen)44);
+#line 21960 ""
e_wsfe();
+#line 21960 ""
}
+#line 21962 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
/* Compute space for multibar rest */
+#line 21966 ""
if (comtop_1.lastisig * comtop_1.isig >= 0) {
/* Computing MAX */
+#line 21967 ""
i__7 = abs(comtop_1.lastisig), i__2 = abs(
comtop_1.isig);
+#line 21967 ""
naccs = max(i__7,i__2);
+#line 21968 ""
} else {
+#line 21969 ""
naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
abs(i__7));
+#line 21970 ""
}
/* xb4mbr = naccs*.24*musicsize */
+#line 21972 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
+#line 21973 ""
}
+#line 21974 ""
}
+#line 21975 ""
} else if (all_1.mtrnuml == 0) {
/* No meter change */
+#line 21979 ""
if (comlast_1.islast) {
- s_wsfe(&io___1440);
+#line 21979 ""
+ s_wsfe(&io___1487);
/* Writing concatenation */
+#line 21979 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21979 ""
i__6[1] = 4, a__4[1] = "xbar";
- s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5);
- do_fio(&c__1, ch__35, (ftnlen)5);
+#line 21979 ""
+ s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)5);
+#line 21979 ""
+ do_fio(&c__1, ch__36, (ftnlen)5);
+#line 21979 ""
e_wsfe();
+#line 21979 ""
}
+#line 21980 ""
} else {
/* Change meter midline */
+#line 21984 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &
ibmrep);
+#line 21985 ""
if (comget_1.movbrk == 0) {
+#line 21986 ""
if (comlast_1.islast) {
+#line 21986 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
+#line 21986 ""
}
+#line 21987 ""
if (all_1.mtrdnp > 0) {
+#line 21988 ""
if (comlast_1.islast) {
/* if (mbrest .gt. 0) then */
/* c write(11,'(a)')sq//'addspace{-2'//sq// */
@@ -32966,670 +53274,1225 @@ L14:
/* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq// */
/* * 'advance'//sq//'barno-1%' */
/* end if */
- s_wsfe(&io___1441);
+#line 21995 ""
+ s_wsfe(&io___1488);
/* Writing concatenation */
+#line 21995 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 21995 ""
i__6[1] = 10, a__4[1] = "newtimes0%";
+#line 21995 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 21995 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 21995 ""
e_wsfe();
+#line 21996 ""
}
/* if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize */
+#line 21998 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
+#line 21998 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
+#line 21998 ""
}
+#line 21999 ""
} else {
+#line 22000 ""
if (comlast_1.islast) {
- s_wsfe(&io___1442);
+#line 22000 ""
+ s_wsfe(&io___1489);
/* Writing concatenation */
+#line 22000 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22000 ""
i__6[1] = 4, a__4[1] = "xbar";
- s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5);
- do_fio(&c__1, ch__35, (ftnlen)5);
+#line 22000 ""
+ s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)5);
+#line 22000 ""
+ do_fio(&c__1, ch__36, (ftnlen)5);
+#line 22000 ""
e_wsfe();
+#line 22000 ""
}
+#line 22001 ""
}
+#line 22002 ""
}
+#line 22003 ""
}
+#line 22004 ""
}
/* Now that xbar's are written, can put in left-repeats at line beginnings */
+#line 22008 ""
if (lrptpend) {
+#line 22009 ""
if (comlast_1.islast) {
- s_wsfe(&io___1443);
+#line 22009 ""
+ s_wsfe(&io___1490);
/* Writing concatenation */
+#line 22009 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 22009 ""
i__4[1] = 7, a__2[1] = "advance";
+#line 22009 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 22009 ""
i__4[3] = 7, a__2[3] = "barno-1";
+#line 22009 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 22009 ""
i__4[5] = 10, a__2[5] = "leftrepeat";
+#line 22009 ""
s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
+#line 22009 ""
do_fio(&c__1, ch__5, (ftnlen)27);
+#line 22009 ""
e_wsfe();
+#line 22009 ""
}
+#line 22011 ""
lrptpend = FALSE_;
+#line 22012 ""
}
+#line 22013 ""
if (all_1.ibar > 1) {
/* For bars after first, slide all stuff down to beginning of arrays */
+#line 22017 ""
i__7 = all_1.nv;
+#line 22017 ""
for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
+#line 22018 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 22018 ""
for (kv = 1; kv <= i__2; ++kv) {
+#line 22019 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 22020 ""
ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
25];
+#line 22021 ""
i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] -
ioff;
+#line 22021 ""
for (ip = 1; ip <= i__13; ++ip) {
+#line 22022 ""
all_1.nolev[commvl_1.ivx + ip * 24 - 25] =
all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 -
25];
+#line 22023 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] =
all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 -
25];
+#line 22024 ""
all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[
commvl_1.ivx + (ip + ioff) * 24 - 25];
+#line 22025 ""
all_1.irest[commvl_1.ivx + ip * 24 - 25] =
all_1.irest[commvl_1.ivx + (ip + ioff) * 24 -
25];
+#line 22026 ""
all_1.islur[commvl_1.ivx + ip * 24 - 25] =
all_1.islur[commvl_1.ivx + (ip + ioff) * 24 -
25];
+#line 22027 ""
all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[
commvl_1.ivx + (ip + ioff) * 24 - 25];
+#line 22028 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[
commvl_1.ivx + (ip + ioff) * 24 - 1];
+#line 22029 ""
all_1.mult[commvl_1.ivx + ip * 24 - 25] = all_1.mult[
commvl_1.ivx + (ip + ioff) * 24 - 25];
-/* if (ivx.le.2 .and. figbass) */
-/* * isfig(ivx,ip) = isfig(ivx,ip+ioff) */
+#line 22030 ""
if (all_1.figbass && commvl_1.ivx == 1 ||
commvl_1.ivx == comfig_1.ivxfig2) {
+#line 22031 ""
if (commvl_1.ivx == 1) {
+#line 22032 ""
all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip
+ ioff << 1) - 2];
+#line 22033 ""
} else {
+#line 22034 ""
all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip
+ ioff << 1) - 1];
+#line 22035 ""
}
+#line 22036 ""
}
+#line 22037 ""
/* L12: */
+#line 22037 ""
}
+#line 22038 ""
if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1]
> 1) {
+#line 22039 ""
islide = 0;
+#line 22040 ""
i__13 = comcc_1.ncc[all_1.iv - 1];
+#line 22040 ""
for (icc = 1; icc <= i__13; ++icc) {
+#line 22041 ""
if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= (
real) all_1.lenbar) {
/* This time will drop <=0 when slid. */
+#line 22045 ""
islide = icc - 1;
+#line 22046 ""
comcc_1.ncmidcc[all_1.iv - 1] =
comcc_1.ncmidcc[all_1.iv + icc * 24 -
25];
+#line 22047 ""
} else {
+#line 22048 ""
comcc_1.tcc[all_1.iv + (icc - islide) * 24 -
25] = comcc_1.tcc[all_1.iv + icc * 24
- 25] - all_1.lenbar;
+#line 22049 ""
comcc_1.ncmidcc[all_1.iv + (icc - islide) *
24 - 25] = comcc_1.ncmidcc[all_1.iv +
icc * 24 - 25];
+#line 22050 ""
}
+#line 22051 ""
/* L13: */
+#line 22051 ""
}
+#line 22052 ""
comcc_1.ncc[all_1.iv - 1] -= islide;
+#line 22053 ""
comcc_1.tcc[all_1.iv - 1] = 0.f;
+#line 22054 ""
}
+#line 22055 ""
/* L11: */
+#line 22055 ""
}
+#line 22055 ""
}
+#line 22056 ""
i__2 = comgrace_1.ngrace;
+#line 22056 ""
for (ig = 1; ig <= i__2; ++ig) {
+#line 22057 ""
comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + (
all_1.ibar - 1) * 24 - 25];
+#line 22058 ""
if (all_1.ibar > 2) {
+#line 22058 ""
comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1]
+ (all_1.ibar - 2) * 24 - 25];
+#line 22058 ""
}
+#line 22059 ""
/* L15: */
+#line 22059 ""
}
+#line 22060 ""
i__2 = comgrace_1.nlit;
+#line 22060 ""
for (il = 1; il <= i__2; ++il) {
+#line 22061 ""
comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1]
+ (all_1.ibar - 1) * 24 - 25];
+#line 22062 ""
if (all_1.ibar > 2) {
+#line 22062 ""
comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il
- 1] + (all_1.ibar - 2) * 24 - 25];
+#line 22062 ""
}
+#line 22063 ""
/* L21: */
+#line 22063 ""
}
+#line 22064 ""
i__2 = comtrill_1.ntrill;
+#line 22064 ""
for (it = 1; it <= i__2; ++it) {
+#line 22065 ""
comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it
- 1] + (all_1.ibar - 1) * 24 - 25];
+#line 22066 ""
if (all_1.ibar > 2) {
+#line 22066 ""
comtrill_1.iptrill[it - 1] += all_1.nib[
comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) *
24 - 25];
+#line 22066 ""
}
+#line 22068 ""
/* L22: */
+#line 22068 ""
}
+#line 22069 ""
i__2 = comtrill_1.ncrd;
+#line 22069 ""
for (icrd = 1; icrd <= i__2; ++icrd) {
-/* ivx = iand(15,ishft(icrdat(icrd),-8)) */
+#line 22070 ""
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 22072 ""
ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
+#line 22073 ""
if (all_1.ibar > 2) {
+#line 22073 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22073 ""
}
+#line 22074 ""
comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd -
1];
+#line 22075 ""
comtrill_1.icrdat[icrd - 1] = max(0,ipnew) |
comtrill_1.icrdat[icrd - 1];
+#line 22076 ""
/* L27: */
+#line 22076 ""
}
+#line 22077 ""
i__2 = comtrill_1.nudorn;
+#line 22077 ""
for (iudorn = 1; iudorn <= i__2; ++iudorn) {
-/* ivx = iand(15,ishft(kudorn(iudorn),-8)) */
+#line 22078 ""
commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1];
+#line 22079 ""
ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
+#line 22080 ""
if (all_1.ibar > 2) {
+#line 22080 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22080 ""
}
+#line 22081 ""
comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[
iudorn - 1];
+#line 22082 ""
comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) |
comtrill_1.kudorn[iudorn - 1];
+#line 22083 ""
/* L29: */
+#line 22083 ""
}
+#line 22084 ""
i__2 = comdyn_1.ndyn;
+#line 22084 ""
for (idyn = 1; idyn <= i__2; ++idyn) {
+#line 22085 ""
idynd = comdyn_1.idyndat[idyn - 1];
-/* ivx = iand(15,idynd) */
+#line 22086 ""
commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[
idyn - 1], &c__1, &c__10) << 4);
+#line 22087 ""
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 22091 ""
if (all_1.ibar > 2) {
+#line 22092 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22093 ""
}
+#line 22094 ""
ipnew = i_dim(&ipnew, &c__0);
+#line 22095 ""
setbits_(&idynd, &c__8, &c__4, &ipnew);
+#line 22096 ""
comdyn_1.idyndat[idyn - 1] = idynd;
+#line 22097 ""
/* L42: */
+#line 22097 ""
}
+#line 22098 ""
i__2 = comdyn_1.ntxtdyn;
+#line 22098 ""
for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) {
+#line 22099 ""
idynd = comdyn_1.ivxiptxt[itxtdyn - 1];
-/* ivx = iand(15,idynd) */
+#line 22100 ""
commvl_1.ivx = 31 & idynd;
-/* ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) */
+#line 22101 ""
ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
+#line 22102 ""
if (all_1.ibar > 2) {
+#line 22103 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22104 ""
}
+#line 22105 ""
ipnew = i_dim(&ipnew, &c__0);
/* call setbits(idynd,8,4,ipnew) */
+#line 22107 ""
setbits_(&idynd, &c__8, &c__5, &ipnew);
+#line 22108 ""
comdyn_1.ivxiptxt[itxtdyn - 1] = idynd;
+#line 22109 ""
/* L43: */
+#line 22109 ""
}
+#line 22110 ""
i__2 = all_1.nsdat;
+#line 22110 ""
for (isdat = 1; isdat <= i__2; ++isdat) {
+#line 22111 ""
isdata = all_1.isdat1[isdat - 1];
+#line 22112 ""
commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13)
+ (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25];
+#line 22113 ""
ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
+#line 22114 ""
if (all_1.ibar > 2) {
+#line 22115 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22116 ""
}
+#line 22117 ""
ipnew = i_dim(&ipnew, &c__0);
+#line 22118 ""
setbits_(&isdata, &c__8, &c__3, &ipnew);
+#line 22119 ""
all_1.isdat1[isdat - 1] = isdata;
+#line 22120 ""
/* L41: */
+#line 22120 ""
}
+#line 22121 ""
i__2 = comcb_1.nbc;
+#line 22121 ""
for (ibc = 1; ibc <= i__2; ++ibc) {
-/* ivx = iand(15,ibcdata(ibc)) */
+#line 22122 ""
commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&
comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4);
+#line 22123 ""
ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) -
all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
+#line 22124 ""
if (all_1.ibar > 2) {
+#line 22125 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
+#line 22126 ""
}
+#line 22127 ""
ipnew = i_dim(&ipnew, &c__0);
+#line 22128 ""
setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew);
+#line 22129 ""
/* L44: */
+#line 22129 ""
}
+#line 22130 ""
i__2 = comarpshift_1.numarpshift;
+#line 22130 ""
for (iarps = 1; iarps <= i__2; ++iarps) {
+#line 22131 ""
comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[
comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1)
* 24 - 25];
+#line 22133 ""
if (all_1.ibar > 2) {
+#line 22134 ""
comarpshift_1.iparpshift[iarps - 1] += all_1.nib[
comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar
- 2) * 24 - 25];
+#line 22136 ""
}
+#line 22137 ""
/* L45: */
+#line 22137 ""
}
/* 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 22143 ""
for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) {
+#line 22144 ""
if (all_1.figbass) {
+#line 22145 ""
islide = 0;
+#line 22146 ""
i__2 = comfig_1.nfigs[commvl_1.ivx - 1];
+#line 22146 ""
for (jfig = 1; jfig <= i__2; ++jfig) {
+#line 22147 ""
if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] <
all_1.lenbar) {
/* This figure was already used */
+#line 22151 ""
islide = jfig;
+#line 22152 ""
} else {
+#line 22153 ""
comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1)
- 3] = comfig_1.itfig[commvl_1.ivx + (
jfig << 1) - 3] - all_1.lenbar;
+#line 22154 ""
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 22155 ""
comgrace_1.itoff[commvl_1.ivx + (jfig - islide <<
1) - 3] = comgrace_1.itoff[commvl_1.ivx +
(jfig << 1) - 3];
+#line 22156 ""
comfig_1.ivupfig[commvl_1.ivx + (jfig - islide <<
1) - 3] = comfig_1.ivupfig[commvl_1.ivx +
(jfig << 1) - 3];
+#line 22157 ""
comfig_1.ivvfig[commvl_1.ivx + (jfig - islide <<
1) - 3] = comfig_1.ivvfig[commvl_1.ivx + (
jfig << 1) - 3];
+#line 22158 ""
}
+#line 22159 ""
/* L20: */
+#line 22159 ""
}
+#line 22160 ""
comfig_1.nfigs[commvl_1.ivx - 1] -= islide;
+#line 22161 ""
}
+#line 22162 ""
if (comfig_1.nfigs[1] == 0) {
+#line 22162 ""
goto L47;
+#line 22162 ""
}
+#line 22163 ""
/* L46: */
+#line 22163 ""
}
+#line 22164 ""
L47:
+#line 22165 ""
;
+#line 22165 ""
}
/* End of sliding down for bars after first in gulp. */
/* The following may not be needed by makeabar, but just in case... */
+#line 22171 ""
if (all_1.firstgulp && all_1.lenb0 != 0) {
+#line 22172 ""
if (all_1.ibar == 1) {
+#line 22173 ""
all_1.lenbar = all_1.lenb0;
+#line 22174 ""
} else {
+#line 22175 ""
all_1.lenbar = all_1.lenb1;
+#line 22176 ""
}
+#line 22177 ""
}
/* Equal line spacing stuff */
+#line 22181 ""
if (comget_1.equalize && comask_1.bar1syst) {
+#line 22182 ""
if (isystpg == 1) {
- s_wsfe(&io___1459);
+#line 22183 ""
+ s_wsfe(&io___1506);
/* Writing concatenation */
+#line 22183 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22183 ""
i__6[1] = 8, a__4[1] = "starteq%";
+#line 22183 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 22183 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 22183 ""
e_wsfe();
+#line 22184 ""
} else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1)
{
- s_wsfe(&io___1460);
+#line 22185 ""
+ s_wsfe(&io___1507);
/* Writing concatenation */
+#line 22185 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22185 ""
i__6[1] = 6, a__4[1] = "endeq%";
- s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)7);
- do_fio(&c__1, ch__36, (ftnlen)7);
+#line 22185 ""
+ s_cat(ch__37, a__4, i__6, &c__2, (ftnlen)7);
+#line 22185 ""
+ do_fio(&c__1, ch__37, (ftnlen)7);
+#line 22185 ""
e_wsfe();
+#line 22186 ""
}
+#line 22187 ""
}
+#line 22188 ""
make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms,
istart);
+#line 22190 ""
make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop,
numbms, istart, comclefq_1.clefq, (ftnlen)1);
/* Hardspace before barline? */
+#line 22195 ""
hardb4 = 0.f;
+#line 22196 ""
i__2 = all_1.nv;
+#line 22196 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 22197 ""
i__7 = commvl_1.nvmx[all_1.iv - 1];
+#line 22197 ""
for (kv = 1; kv <= i__7; ++kv) {
+#line 22198 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
+#line 22199 ""
if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx
- 1] * 24 - 25],18)) {
+#line 22200 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
/* Computing MAX */
+#line 22201 ""
r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx +
comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25];
+#line 22201 ""
hardb4 = dmax(r__1,r__2);
+#line 22202 ""
}
+#line 22203 ""
/* L35: */
+#line 22203 ""
}
+#line 22203 ""
}
+#line 22204 ""
if (hardb4 > 0.f) {
+#line 22205 ""
if (comlast_1.islast) {
- s_wsfe(&io___1468);
+#line 22205 ""
+ s_wsfe(&io___1515);
/* Writing concatenation */
+#line 22205 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22205 ""
i__6[1] = 10, a__4[1] = "hardspace{";
+#line 22205 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
+#line 22205 ""
do_fio(&c__1, ch__15, (ftnlen)11);
+#line 22205 ""
do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real));
+#line 22205 ""
do_fio(&c__1, "pt}%", (ftnlen)4);
+#line 22205 ""
e_wsfe();
+#line 22205 ""
}
/* 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 22211 ""
comask_1.fixednew -= hardb4;
+#line 22212 ""
}
+#line 22213 ""
/* L10: */
+#line 22213 ""
}
+#line 22214 ""
all_1.firstgulp = FALSE_;
+#line 22215 ""
all_1.lenb0 = 0;
+#line 22216 ""
goto L30;
+#line 22217 ""
L40:
+#line 22217 ""
cl__1.cerr = 0;
+#line 22217 ""
cl__1.cunit = 12;
+#line 22217 ""
cl__1.csta = 0;
+#line 22217 ""
f_clos(&cl__1);
+#line 22218 ""
cl__1.cerr = 0;
+#line 22218 ""
cl__1.cunit = 13;
+#line 22218 ""
cl__1.csta = 0;
+#line 22218 ""
f_clos(&cl__1);
+#line 22219 ""
inbuff_1.ilbuf = 1;
+#line 22220 ""
inbuff_1.ipbuf = 0;
+#line 22221 ""
wdpt = comtop_1.widthpt;
+#line 22222 ""
if (all_1.iline == 1) {
+#line 22222 ""
wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
+#line 22222 ""
}
+#line 22223 ""
poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew)
/ (elsktot + comask_1.fbar * nbarss - comask_1.scaldold);
+#line 22225 ""
poevec[nsyst] = poe;
+#line 22226 ""
if (! comlast_1.islast) {
+#line 22227 ""
cl__1.cerr = 0;
+#line 22227 ""
cl__1.cunit = 11;
+#line 22227 ""
cl__1.csta = 0;
+#line 22227 ""
f_clos(&cl__1);
+#line 22228 ""
cl__1.cerr = 0;
+#line 22228 ""
cl__1.cunit = 16;
+#line 22228 ""
cl__1.csta = 0;
+#line 22228 ""
f_clos(&cl__1);
+#line 22229 ""
if (all_1.figbass) {
+#line 22229 ""
cl__1.cerr = 0;
+#line 22229 ""
cl__1.cunit = 14;
+#line 22229 ""
cl__1.csta = 0;
+#line 22229 ""
f_clos(&cl__1);
+#line 22229 ""
}
+#line 22230 ""
return 0;
+#line 22231 ""
}
+#line 22232 ""
i__1 = comas2_1.nasksys;
+#line 22232 ""
for (ia = 1; ia <= i__1; ++ia) {
+#line 22233 ""
++comas3_1.iask;
+#line 22234 ""
comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1] / poe - (
r__1 = comas2_1.elasksys[ia - 1], dabs(r__1));
+#line 22235 ""
if (comas2_1.elasksys[ia - 1] > 0.f) {
+#line 22235 ""
comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
- comas3_1.iask - 1], &c_b774);
+ comas3_1.iask - 1], &c_b1009);
+#line 22235 ""
}
+#line 22236 ""
/* L19: */
+#line 22236 ""
}
+#line 22237 ""
i__1 = nhssys;
+#line 22237 ""
for (ia = 1; ia <= i__1; ++ia) {
+#line 22238 ""
++nhstot;
/* Computing MAX */
+#line 22239 ""
r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
+#line 22239 ""
comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
+#line 22240 ""
/* L26: */
+#line 22240 ""
}
+#line 22241 ""
if (comlast_1.islast && onvolt) {
- s_wsfe(&io___1469);
+#line 22241 ""
+ s_wsfe(&io___1516);
/* Writing concatenation */
+#line 22241 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22241 ""
i__6[1] = 11, a__4[1] = "endvoltabox";
+#line 22241 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
+#line 22241 ""
do_fio(&c__1, ch__14, (ftnlen)12);
+#line 22241 ""
e_wsfe();
+#line 22241 ""
}
+#line 22243 ""
if (*(unsigned char *)comget_1.rptfq2 != 'E') {
/* Terminal repeat. Right or double? */
+#line 22247 ""
if (*(unsigned char *)comget_1.rptfq2 == 'r') {
+#line 22248 ""
if (comlast_1.islast) {
- s_wsfe(&io___1470);
+#line 22248 ""
+ s_wsfe(&io___1517);
/* Writing concatenation */
+#line 22248 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 22248 ""
i__5[1] = 14, a__3[1] = "setrightrepeat";
+#line 22248 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 22248 ""
i__5[3] = 8, a__3[3] = "endpiece";
- s_cat(ch__37, a__3, i__5, &c__4, (ftnlen)24);
- do_fio(&c__1, ch__37, (ftnlen)24);
+#line 22248 ""
+ s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)24);
+#line 22248 ""
+ do_fio(&c__1, ch__38, (ftnlen)24);
+#line 22248 ""
e_wsfe();
+#line 22248 ""
}
+#line 22250 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
+#line 22251 ""
if (comlast_1.islast) {
- s_wsfe(&io___1471);
+#line 22251 ""
+ s_wsfe(&io___1518);
/* Writing concatenation */
+#line 22251 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 22251 ""
i__5[1] = 12, a__3[1] = "setdoublebar";
+#line 22251 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 22251 ""
i__5[3] = 8, a__3[3] = "endpiece";
- s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22);
- do_fio(&c__1, ch__38, (ftnlen)22);
+#line 22251 ""
+ s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)22);
+#line 22251 ""
+ do_fio(&c__1, ch__39, (ftnlen)22);
+#line 22251 ""
e_wsfe();
+#line 22251 ""
}
+#line 22252 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
+#line 22253 ""
if (comlast_1.islast) {
- s_wsfe(&io___1472);
+#line 22253 ""
+ s_wsfe(&io___1519);
/* Writing concatenation */
+#line 22253 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22253 ""
i__6[1] = 8, a__4[1] = "endpiece";
+#line 22253 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 22253 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 22253 ""
e_wsfe();
+#line 22253 ""
}
+#line 22254 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'z') {
+#line 22255 ""
if (comlast_1.islast) {
- s_wsfe(&io___1473);
+#line 22255 ""
+ s_wsfe(&io___1520);
/* Writing concatenation */
+#line 22255 ""
i__5[0] = 1, a__3[0] = all_1.sq;
+#line 22255 ""
i__5[1] = 12, a__3[1] = "setzalaligne";
+#line 22255 ""
i__5[2] = 1, a__3[2] = all_1.sq;
+#line 22255 ""
i__5[3] = 8, a__3[3] = "Endpiece";
- s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22);
- do_fio(&c__1, ch__38, (ftnlen)22);
+#line 22255 ""
+ s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)22);
+#line 22255 ""
+ do_fio(&c__1, ch__39, (ftnlen)22);
+#line 22255 ""
e_wsfe();
+#line 22255 ""
}
+#line 22256 ""
} else {
-/* else if (rptfq2 .ne. 'D') then */
- s_wsle(&io___1474);
+#line 22257 ""
+ s_wsle(&io___1521);
+#line 22257 ""
e_wsle();
- s_wsle(&io___1475);
- do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"
+#line 22258 ""
+ s_wsle(&io___1522);
+#line 22258 ""
+ do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\
"q2:", (ftnlen)37);
+#line 22258 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
+#line 22258 ""
e_wsle();
- s_wsle(&io___1476);
- do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"
+#line 22259 ""
+ s_wsle(&io___1523);
+#line 22259 ""
+ do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\
"q2:", (ftnlen)37);
+#line 22259 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
+#line 22259 ""
e_wsle();
+#line 22260 ""
if (comlast_1.islast) {
- s_wsfe(&io___1477);
+#line 22260 ""
+ s_wsfe(&io___1524);
/* Writing concatenation */
+#line 22260 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22260 ""
i__6[1] = 8, a__4[1] = "Endpiece";
+#line 22260 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 22260 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 22260 ""
e_wsfe();
+#line 22260 ""
}
+#line 22261 ""
}
+#line 22262 ""
} else {
+#line 22263 ""
if (comlast_1.islast) {
- s_wsfe(&io___1478);
+#line 22263 ""
+ s_wsfe(&io___1525);
/* Writing concatenation */
+#line 22263 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22263 ""
i__6[1] = 8, a__4[1] = "Endpiece";
+#line 22263 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 22263 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 22263 ""
e_wsfe();
+#line 22263 ""
}
+#line 22264 ""
}
+#line 22265 ""
if (! vshrink) {
+#line 22266 ""
+ if (comlast_1.islast && combottop_1.bottopgap) {
+#line 22267 ""
+ if (dabs(combottop_1.botamt) > 1e-6f) {
+#line 22268 ""
+ if (combottop_1.botamt > 9.95f) {
+#line 22269 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22270 ""
+ } else if (combottop_1.botamt > 0.f) {
+#line 22271 ""
+ s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22272 ""
+ } else if (combottop_1.botamt > -9.95f) {
+#line 22273 ""
+ s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22274 ""
+ } else {
+#line 22275 ""
+ s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22276 ""
+ }
+#line 22277 ""
+ s_wsfe(&io___1526);
+/* Writing concatenation */
+#line 22277 ""
+ i__5[0] = 1, a__3[0] = all_1.sq;
+#line 22277 ""
+ i__5[1] = 4, a__3[1] = "null";
+#line 22277 ""
+ i__5[2] = 1, a__3[2] = all_1.sq;
+#line 22277 ""
+ i__5[3] = 5, a__3[3] = "vskip";
+#line 22277 ""
+ s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
+#line 22277 ""
+ do_fio(&c__1, ch__15, (ftnlen)11);
+#line 22277 ""
+ do_fio(&c__1, (char *)&combottop_1.botamt, (ftnlen)sizeof(
+ real));
+/* Writing concatenation */
+#line 22277 ""
+ i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22277 ""
+ i__6[1] = 10, a__4[1] = "Internote%";
+#line 22277 ""
+ s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11);
+#line 22277 ""
+ do_fio(&c__1, ch__29, (ftnlen)11);
+#line 22277 ""
+ e_wsfe();
+#line 22279 ""
+ }
+#line 22280 ""
+ }
+#line 22281 ""
xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop;
+#line 22282 ""
if (xnstbot < 9.95f) {
+#line 22283 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22284 ""
} else {
+#line 22285 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
+#line 22286 ""
}
+#line 22287 ""
if (comlast_1.islast) {
- s_wsfe(&io___1479);
+#line 22287 ""
+ s_wsfe(&io___1527);
/* Writing concatenation */
+#line 22287 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22287 ""
i__6[1] = 5, a__4[1] = "vskip";
- s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6);
- do_fio(&c__1, ch__29, (ftnlen)6);
+#line 22287 ""
+ s_cat(ch__30, a__4, i__6, &c__2, (ftnlen)6);
+#line 22287 ""
+ do_fio(&c__1, ch__30, (ftnlen)6);
+#line 22287 ""
do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real));
/* Writing concatenation */
+#line 22287 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 22287 ""
i__4[1] = 10, a__2[1] = "Interligne";
+#line 22287 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 22287 ""
i__4[3] = 5, a__2[3] = "eject";
+#line 22287 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 22287 ""
i__4[5] = 9, a__2[5] = "endmuflex";
+#line 22287 ""
s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
+#line 22287 ""
do_fio(&c__1, ch__5, (ftnlen)27);
+#line 22287 ""
e_wsfe();
+#line 22287 ""
}
+#line 22289 ""
if (comlast_1.islast) {
- s_wsfe(&io___1480);
+#line 22289 ""
+ s_wsfe(&io___1528);
/* Writing concatenation */
+#line 22289 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22289 ""
i__6[1] = 3, a__4[1] = "bye";
+#line 22289 ""
s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4);
+#line 22289 ""
do_fio(&c__1, ch__21, (ftnlen)4);
+#line 22289 ""
e_wsfe();
+#line 22289 ""
}
+#line 22290 ""
} else {
+#line 22291 ""
if (comlast_1.islast) {
- s_wsfe(&io___1481);
+#line 22291 ""
+ s_wsfe(&io___1529);
/* Writing concatenation */
+#line 22291 ""
i__4[0] = 1, a__2[0] = all_1.sq;
+#line 22291 ""
i__4[1] = 5, a__2[1] = "vfill";
+#line 22291 ""
i__4[2] = 1, a__2[2] = all_1.sq;
+#line 22291 ""
i__4[3] = 5, a__2[3] = "eject";
+#line 22291 ""
i__4[4] = 1, a__2[4] = all_1.sq;
+#line 22291 ""
i__4[5] = 9, a__2[5] = "endmuflex";
- s_cat(ch__38, a__2, i__4, &c__6, (ftnlen)22);
- do_fio(&c__1, ch__38, (ftnlen)22);
+#line 22291 ""
+ s_cat(ch__39, a__2, i__4, &c__6, (ftnlen)22);
+#line 22291 ""
+ do_fio(&c__1, ch__39, (ftnlen)22);
+#line 22291 ""
e_wsfe();
+#line 22291 ""
}
+#line 22293 ""
if (comlast_1.islast) {
- s_wsfe(&io___1482);
+#line 22293 ""
+ s_wsfe(&io___1530);
/* Writing concatenation */
+#line 22293 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22293 ""
i__6[1] = 3, a__4[1] = "bye";
+#line 22293 ""
s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4);
+#line 22293 ""
do_fio(&c__1, ch__21, (ftnlen)4);
+#line 22293 ""
e_wsfe();
+#line 22293 ""
}
+#line 22294 ""
}
+#line 22295 ""
al__1.aerr = 0;
+#line 22295 ""
al__1.aunit = 11;
+#line 22295 ""
f_rew(&al__1);
+#line 22296 ""
if (all_1.figbass) {
- s_wsfe(&io___1483);
+#line 22297 ""
+ s_wsfe(&io___1531);
/* Writing concatenation */
+#line 22297 ""
i__6[0] = 1, a__4[0] = all_1.sq;
+#line 22297 ""
i__6[1] = 8, a__4[1] = "figdrop=";
+#line 22297 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
+#line 22297 ""
do_fio(&c__1, ch__18, (ftnlen)9);
+#line 22297 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen)
sizeof(integer));
/* Writing concatenation */
+#line 22297 ""
i__8[0] = 1, a__5[0] = " ";
+#line 22297 ""
i__8[1] = 1, a__5[1] = all_1.sq;
+#line 22297 ""
i__8[2] = 8, a__5[2] = "figdtwo=";
+#line 22297 ""
s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10);
+#line 22297 ""
do_fio(&c__1, ch__20, (ftnlen)10);
+#line 22297 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen)
sizeof(integer));
/* Writing concatenation */
+#line 22297 ""
i__11[0] = 1, a__8[0] = all_1.sq;
+#line 22297 ""
i__11[1] = 4, a__8[1] = "fi}%";
- s_cat(ch__35, a__8, i__11, &c__2, (ftnlen)5);
- do_fio(&c__1, ch__35, (ftnlen)5);
+#line 22297 ""
+ s_cat(ch__36, a__8, i__11, &c__2, (ftnlen)5);
+#line 22297 ""
+ do_fio(&c__1, ch__36, (ftnlen)5);
+#line 22297 ""
e_wsfe();
+#line 22300 ""
al__1.aerr = 0;
+#line 22300 ""
al__1.aunit = 14;
+#line 22300 ""
f_rew(&al__1);
+#line 22301 ""
}
+#line 22302 ""
askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, (
ftnlen)40, (ftnlen)44);
+#line 22303 ""
if (! (*optimize)) {
- s_wsle(&io___1484);
+#line 22304 ""
+ s_wsle(&io___1532);
+#line 22304 ""
e_wsle();
- s_wsle(&io___1485);
+#line 22305 ""
+ s_wsle(&io___1533);
/* Writing concatenation */
+#line 22305 ""
i__5[0] = 8, a__3[0] = "Writing ";
+#line 22305 ""
i__5[1] = lpath, a__3[1] = pathnameq;
+#line 22305 ""
i__5[2] = lbase, a__3[2] = basenameq;
+#line 22305 ""
i__5[3] = 4, a__3[3] = ".tex";
- s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96);
- do_lio(&c__9, &c__1, ch__39, lpath + 8 + lbase + 4);
+#line 22305 ""
+ s_cat(ch__40, a__3, i__5, &c__4, (ftnlen)96);
+#line 22305 ""
+ do_lio(&c__9, &c__1, ch__40, lpath + 8 + lbase + 4);
+#line 22305 ""
e_wsle();
- s_wsle(&io___1486);
+#line 22307 ""
+ s_wsle(&io___1534);
+#line 22307 ""
do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26);
+#line 22307 ""
e_wsle();
- s_wsfe(&io___1487);
+#line 22308 ""
+ s_wsfe(&io___1535);
/* Writing concatenation */
+#line 22308 ""
i__5[0] = 8, a__3[0] = "Writing ";
+#line 22308 ""
i__5[1] = lpath, a__3[1] = pathnameq;
+#line 22308 ""
i__5[2] = lbase, a__3[2] = basenameq;
+#line 22308 ""
i__5[3] = 4, a__3[3] = ".tex";
- s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96);
- do_fio(&c__1, ch__39, lpath + 8 + lbase + 4);
+#line 22308 ""
+ s_cat(ch__40, a__3, i__5, &c__4, (ftnlen)96);
+#line 22308 ""
+ do_fio(&c__1, ch__40, lpath + 8 + lbase + 4);
+#line 22308 ""
e_wsfe();
- s_wsfe(&io___1488);
+#line 22310 ""
+ s_wsfe(&io___1536);
+#line 22310 ""
do_fio(&c__1, " Done with second PMX pass. Now run TeX", (ftnlen)40);
+#line 22310 ""
e_wsfe();
+#line 22311 ""
}
+#line 22312 ""
return 0;
} /* pmxb_ */
@@ -33651,24 +54514,41 @@ L40:
/* Compute avg. & norm. std. dev. of poe. */
+#line 22320 ""
/* Parameter adjustments */
+#line 22320 ""
--poe;
+#line 22320 ""
+#line 22320 ""
/* Function Body */
+#line 22320 ""
sumx = 0.f;
+#line 22321 ""
sumxx = 0.f;
+#line 22322 ""
i__1 = *nsyst;
+#line 22322 ""
for (isyst = 1; isyst <= i__1; ++isyst) {
+#line 22323 ""
sumx += poe[isyst];
/* Computing 2nd power */
+#line 22324 ""
r__1 = poe[isyst];
+#line 22324 ""
sumxx += r__1 * r__1;
+#line 22325 ""
/* L1: */
+#line 22325 ""
}
/* Computing 2nd power */
+#line 22326 ""
r__1 = sumx;
+#line 22326 ""
*devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1);
+#line 22327 ""
*poebar = sumx / *nsyst;
+#line 22328 ""
return 0;
} /* poestats_ */
@@ -33697,10 +54577,10 @@ L40:
integer *);
/* Fortran I/O blocks */
- static cilist io___1496 = { 0, 6, 0, 0, 0 };
- static cilist io___1497 = { 0, 6, 0, 0, 0 };
- static cilist io___1508 = { 0, 6, 0, 0, 0 };
- static cilist io___1509 = { 0, 6, 0, 0, 0 };
+ static cilist io___1544 = { 0, 6, 0, 0, 0 };
+ static cilist io___1545 = { 0, 6, 0, 0, 0 };
+ static cilist io___1556 = { 0, 6, 0, 0, 0 };
+ static cilist io___1557 = { 0, 6, 0, 0, 0 };
@@ -33715,192 +54595,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 22350 ""
for (i__ = 1; i__ <= 88; ++i__) {
+#line 22351 ""
levtabl[i__ - 1] = 0;
+#line 22352 ""
/* L11: */
+#line 22352 ""
}
+#line 22353 ""
i__1 = comtrill_1.ncrd;
+#line 22353 ""
for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) {
+#line 22354 ""
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 22356 ""
ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1];
+#line 22357 ""
if (ip1 == *ip && ivx1 == *ivx) {
+#line 22357 ""
goto L2;
+#line 22357 ""
}
+#line 22358 ""
/* L1: */
+#line 22358 ""
}
- s_wsle(&io___1496);
+#line 22359 ""
+ s_wsle(&io___1544);
+#line 22359 ""
e_wsle();
- s_wsle(&io___1497);
- do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"
+#line 22360 ""
+ s_wsle(&io___1545);
+#line 22360 ""
+ do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"\
"e to Dr. Don!", (ftnlen)63);
+#line 22360 ""
e_wsle();
+#line 22362 ""
stop1_();
+#line 22363 ""
L2:
+#line 22364 ""
comtrill_1.maxlev = *nolevm;
+#line 22365 ""
comtrill_1.minlev = *nolevm;
+#line 22366 ""
levtabl[*nolevm - 1] = -1;
+#line 22367 ""
is2nd = FALSE_;
+#line 22368 ""
naccid = 0;
+#line 22369 ""
levmaxacc = -100;
+#line 22370 ""
levminacc = 1000;
/* Check 1st 3 bits of nacc for accid on main note of chord. */
+#line 22374 ""
if ((7 & *nacc) > 0) {
+#line 22375 ""
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 22380 ""
kicrd[0] = 0;
+#line 22381 ""
levmaxacc = *nolevm;
+#line 22382 ""
levminacc = *nolevm;
/* Start the level-ranking */
+#line 22386 ""
icrdot0 = 1;
+#line 22387 ""
}
+#line 22388 ""
i__1 = comtrill_1.ncrd;
+#line 22388 ""
for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1;
++comtrill_1.icrd2) {
+#line 22389 ""
nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, &
c__12);
+#line 22390 ""
levtabl[nolev - 1] = comtrill_1.icrd2;
+#line 22391 ""
comtrill_1.maxlev = max(comtrill_1.maxlev,nolev);
+#line 22392 ""
comtrill_1.minlev = min(comtrill_1.minlev,nolev);
/* Check for accidental */
+#line 22396 ""
if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) {
+#line 22397 ""
++naccid;
+#line 22398 ""
levmaxacc = max(levmaxacc,nolev);
+#line 22399 ""
levminacc = min(levminacc,nolev);
/* Add this icrd to list of values for notes with accid's. */
+#line 22403 ""
kicrd[naccid - 1] = comtrill_1.icrd2;
+#line 22404 ""
if (! bit_test(*nacc,28)) {
/* Order not forced, so get the level-ranking, top down */
+#line 22408 ""
iorder = 1;
+#line 22409 ""
i__2 = naccid - 1;
+#line 22409 ""
for (iaccid = 1; iaccid <= i__2; ++iaccid) {
+#line 22410 ""
if (kicrd[iaccid - 1] == 0) {
+#line 22411 ""
if (*nolevm > nolev) {
+#line 22412 ""
++iorder;
+#line 22413 ""
} else {
+#line 22414 ""
++icrdot0;
+#line 22415 ""
}
+#line 22416 ""
} else {
+#line 22417 ""
if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] -
1], &c__7, &c__12) > nolev) {
+#line 22419 ""
++iorder;
+#line 22420 ""
} else {
+#line 22421 ""
iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid
- 1] - 1], &c__3, &c__27);
+#line 22422 ""
i__3 = iold + 1;
+#line 22422 ""
setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1]
, &c__3, &c__27, &i__3);
+#line 22423 ""
}
+#line 22424 ""
}
+#line 22425 ""
/* L12: */
+#line 22425 ""
}
+#line 22426 ""
setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, &
c__27, &iorder);
+#line 22427 ""
}
+#line 22428 ""
}
/* Exit loop if last note in this chord */
+#line 22432 ""
if (comtrill_1.icrd2 == comtrill_1.ncrd) {
+#line 22432 ""
goto L4;
+#line 22432 ""
}
+#line 22433 ""
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 22433 ""
goto L4;
+#line 22433 ""
}
/* * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */
+#line 22437 ""
/* L3: */
+#line 22437 ""
}
- s_wsle(&io___1508);
+#line 22438 ""
+ s_wsle(&io___1556);
+#line 22438 ""
e_wsle();
- s_wsle(&io___1509);
- do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."
+#line 22439 ""
+ s_wsle(&io___1557);
+#line 22439 ""
+ do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."\
" Don!", (ftnlen)55);
+#line 22439 ""
e_wsle();
+#line 22440 ""
stop1_();
+#line 22441 ""
L4:
/* Now icrd1, icrd2 define range of icrd for this chord. */
/* Bypass autos-shifting if any manual shifts are present */
+#line 22447 ""
if (bit_test(*irest,20) || bit_test(*irest,27)) {
+#line 22447 ""
goto L10;
+#line 22447 ""
}
/* Check for 2nds */
+#line 22451 ""
for (ilev = 1; ilev <= 87; ++ilev) {
+#line 22452 ""
if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) {
/* There is at least one 2nd.. */
+#line 22456 ""
if (*(unsigned char *)udq == 'u') {
/* Upstem. Start with 2nd just found and go up, rt-shifting upper */
/* member of each pair */
+#line 22461 ""
ile = ilev;
/* Set main-note flag for ANY right-shift */
+#line 22465 ""
*irest = bit_set(*irest,20);
+#line 22466 ""
L7:
+#line 22467 ""
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 22473 ""
*nacc = bit_set(*nacc,30);
+#line 22474 ""
comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 1] - 1],24);
+#line 22475 ""
} else {
/* Upper member is chord note, must be rt-shifted */
+#line 22479 ""
comtrill_1.icrdat[levtabl[ile] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile] - 1],24);
+#line 22480 ""
}
+#line 22481 ""
++ile;
+#line 22482 ""
L8:
+#line 22483 ""
++ile;
+#line 22484 ""
if (ile < 87) {
+#line 22485 ""
if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) {
+#line 22486 ""
goto L7;
+#line 22487 ""
} else {
+#line 22488 ""
goto L8;
+#line 22489 ""
}
+#line 22490 ""
}
+#line 22491 ""
goto L10;
+#line 22492 ""
} 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 22497 ""
ile = 88;
/* Set main-note flag for ANY right-shift */
+#line 22501 ""
*irest = bit_set(*irest,27);
+#line 22502 ""
L9:
+#line 22503 ""
if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) {
+#line 22504 ""
if (levtabl[ile - 2] < 0) {
/* ipl = ibset(ipl,8) */
@@ -33908,36 +54904,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 22511 ""
*nacc = bit_set(*nacc,31);
+#line 22512 ""
comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 1] - 1],23);
+#line 22513 ""
} else {
/* Lower member is chord note, must be shifted */
+#line 22517 ""
comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 2] - 1],23);
+#line 22519 ""
}
+#line 22520 ""
--ile;
+#line 22521 ""
}
+#line 22522 ""
--ile;
+#line 22523 ""
if (ile >= ilev + 1) {
+#line 22523 ""
goto L9;
+#line 22523 ""
}
+#line 22524 ""
goto L10;
+#line 22525 ""
}
+#line 22526 ""
}
+#line 22527 ""
/* L5: */
+#line 22527 ""
}
+#line 22528 ""
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 22533 ""
if (naccid >= 1) {
+#line 22533 ""
crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, &
levminacc, &icrdot0, twooftwo, icashft);
+#line 22533 ""
}
+#line 22535 ""
return 0;
} /* precrd_ */
@@ -33949,19 +54966,26 @@ L10:
e_wsfe(void);
/* Fortran I/O blocks */
- static cilist io___1512 = { 0, 6, 0, 0, 0 };
- static cilist io___1513 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___1560 = { 0, 6, 0, 0, 0 };
+ static cilist io___1561 = { 0, 15, 0, "(a)", 0 };
/* Send string to console and to log file */
- s_wsle(&io___1512);
+#line 22542 ""
+ s_wsle(&io___1560);
+#line 22542 ""
do_lio(&c__9, &c__1, string, string_len);
+#line 22542 ""
e_wsle();
- s_wsfe(&io___1513);
+#line 22543 ""
+ s_wsfe(&io___1561);
+#line 22543 ""
do_fio(&c__1, string, string_len);
+#line 22543 ""
e_wsfe();
+#line 22544 ""
return 0;
} /* printl_ */
@@ -33999,9 +55023,9 @@ L10:
static integer iivivx1;
/* Fortran I/O blocks */
- static icilist io___1519 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 };
- static cilist io___1525 = { 0, 6, 0, 0, 0 };
- static cilist io___1526 = { 0, 6, 0, 0, 0 };
+ static icilist io___1567 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 };
+ static cilist io___1573 = { 0, 6, 0, 0, 0 };
+ static cilist io___1574 = { 0, 6, 0, 0, 0 };
@@ -34009,187 +55033,320 @@ L10:
/* Find which iarp, if any */
+#line 22565 ""
i__1 = comarp_1.narp;
+#line 22565 ""
for (iarp = 1; iarp <= i__1; ++iarp) {
+#line 22566 ""
if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) <
comtol_1.tol) {
+#line 22566 ""
goto L2;
+#line 22566 ""
}
+#line 22567 ""
/* L1: */
+#line 22567 ""
}
/* If here, this is the *first* call for this arp. */
+#line 22571 ""
++comarp_1.narp;
+#line 22572 ""
comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f;
+#line 22573 ""
comarp_1.ivar1[comarp_1.narp - 1] = *iv;
+#line 22574 ""
comarp_1.ipar1[comarp_1.narp - 1] = *ip;
+#line 22575 ""
comarp_1.levar1[comarp_1.narp - 1] = *nolev;
+#line 22576 ""
comarp_1.ncmar1[comarp_1.narp - 1] = *ncm;
+#line 22577 ""
return 0;
+#line 22578 ""
L2:
/* If here, this is *second* call at this time, narp points to values from 1st. */
/* Check for shift. Set IsArpShift and iarps */
+#line 22584 ""
i__1 = comarpshift_1.numarpshift;
+#line 22584 ""
for (iarps = 1; iarps <= i__1; ++iarps) {
+#line 22585 ""
if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] &&
comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp -
1]) {
+#line 22587 ""
isarpshift = TRUE_;
/* Writing concatenation */
+#line 22588 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22588 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 22588 ""
i__2[1] = 8, a__1[1] = "loffset{";
+#line 22588 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
- s_wsfi(&io___1519);
+#line 22589 ""
+ s_wsfi(&io___1567);
+#line 22589 ""
do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen)
sizeof(real));
+#line 22589 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 22589 ""
e_wsfi();
+#line 22590 ""
lnote = 14;
+#line 22591 ""
goto L4;
+#line 22592 ""
}
+#line 22593 ""
/* L3: */
+#line 22593 ""
}
+#line 22594 ""
isarpshift = FALSE_;
+#line 22595 ""
lnote = 0;
+#line 22596 ""
L4:
+#line 22597 ""
if (*iv == comarp_1.ivar1[iarp - 1]) {
/* Arp is in a single voice. */
/* Computing MIN */
+#line 22601 ""
i__1 = comarp_1.levar1[iarp - 1];
+#line 22601 ""
levbot = min(i__1,*nolev) - *ncm + 3;
+#line 22602 ""
invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1;
+#line 22603 ""
} 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 22609 ""
for (iiv = 1; iiv <= 24; ++iiv) {
+#line 22610 ""
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 22612 ""
iivivx1 = iiv;
+#line 22613 ""
goto L6;
+#line 22614 ""
}
+#line 22615 ""
/* L5: */
+#line 22615 ""
}
- s_wsle(&io___1525);
+#line 22616 ""
+ s_wsle(&io___1573);
+#line 22616 ""
do_lio(&c__9, &c__1, "Screwup#1 in putarp", (ftnlen)19);
+#line 22616 ""
e_wsle();
+#line 22617 ""
s_stop("", (ftnlen)0);
+#line 22618 ""
L6:
+#line 22619 ""
for (iiv = 1; iiv <= 24; ++iiv) {
+#line 22620 ""
if (commvl_1.ivmx[iiv - 1] == *iv || commvl_1.nvmx[iiv - 1] == 2
&& commvl_1.ivmx[iiv + 23] == *iv) {
+#line 22620 ""
goto L8;
+#line 22620 ""
}
/* Found iv for both voices (iivivx1, iiv), done looking */
+#line 22625 ""
/* L7: */
+#line 22625 ""
}
- s_wsle(&io___1526);
+#line 22626 ""
+ s_wsle(&io___1574);
+#line 22626 ""
do_lio(&c__9, &c__1, "Screwup#2 in putarp", (ftnlen)19);
+#line 22626 ""
e_wsle();
+#line 22627 ""
s_stop("", (ftnlen)0);
+#line 22628 ""
L8:
+#line 22629 ""
if (iivivx1 == iiv) {
+#line 22630 ""
nstaffshift = 0;
+#line 22631 ""
} else {
+#line 22632 ""
r__1 = comarp_1.xinsnow * 2;
+#line 22632 ""
nstaffshift = -i_nint(&r__1);
+#line 22633 ""
}
/* levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) */
+#line 22635 ""
levbot = nstaffshift + 3 + comarp_1.levar1[iarp - 1] -
comarp_1.ncmar1[iarp - 1];
+#line 22636 ""
invert = -levbot + 4 + *nolev - *ncm;
-/* print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' */
-/* write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), */
-/* *levbot,nolev,ncm */
+#line 22637 ""
}
/* isym will be (1,2) if invert is (even,odd). If even, raise .5\internote */
+#line 22641 ""
isym = invert % 2 + 1;
+#line 22642 ""
ilvert = (invert + 1) / 2;
+#line 22643 ""
if (levbot >= 0 && levbot <= 9) {
/* Single digit */
+#line 22647 ""
if (! isarpshift) {
/* Writing concatenation */
+#line 22648 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22648 ""
i__3[0] = 1, a__2[0] = ch__1;
+#line 22648 ""
i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
+#line 22648 ""
i__1 = levbot + 48;
+#line 22648 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 22648 ""
i__3[2] = 1, a__2[2] = ch__2;
+#line 22648 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 22649 ""
} else {
/* Writing concatenation */
+#line 22650 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 22650 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22650 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 22650 ""
i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
+#line 22650 ""
i__1 = levbot + 48;
+#line 22650 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 22650 ""
i__4[3] = 1, a__3[3] = ch__2;
+#line 22650 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 22652 ""
}
+#line 22653 ""
lnote += 10;
+#line 22654 ""
} else {
+#line 22655 ""
if (! isarpshift) {
/* Writing concatenation */
+#line 22656 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22656 ""
i__3[0] = 1, a__2[0] = ch__1;
+#line 22656 ""
i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
+#line 22656 ""
i__3[2] = 1, a__2[2] = "{";
+#line 22656 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
+#line 22657 ""
} else {
/* Writing concatenation */
+#line 22658 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 22658 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22658 ""
i__4[1] = 1, a__3[1] = ch__1;
+#line 22658 ""
i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
+#line 22658 ""
i__4[3] = 1, a__3[3] = "{";
+#line 22658 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
+#line 22659 ""
}
+#line 22660 ""
lnote += 10;
+#line 22661 ""
if (levbot >= -9) {
/* Need two spaces for number */
+#line 22665 ""
i__1 = lnote;
+#line 22665 ""
ici__1.icierr = 0;
+#line 22665 ""
ici__1.icirnum = 1;
+#line 22665 ""
ici__1.icirlen = lnote + 3 - i__1;
+#line 22665 ""
ici__1.iciunit = notexq + i__1;
+#line 22665 ""
ici__1.icifmt = "(i2,a1)";
+#line 22665 ""
s_wsfi(&ici__1);
+#line 22665 ""
do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
+#line 22665 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 22665 ""
e_wsfi();
+#line 22666 ""
lnote += 3;
+#line 22667 ""
} else {
+#line 22668 ""
i__1 = lnote;
+#line 22668 ""
ici__1.icierr = 0;
+#line 22668 ""
ici__1.icirnum = 1;
+#line 22668 ""
ici__1.icirlen = lnote + 4 - i__1;
+#line 22668 ""
ici__1.iciunit = notexq + i__1;
+#line 22668 ""
ici__1.icifmt = "(i3,a1)";
+#line 22668 ""
s_wsfi(&ici__1);
+#line 22668 ""
do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
+#line 22668 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 22668 ""
e_wsfi();
+#line 22669 ""
lnote += 4;
+#line 22670 ""
}
+#line 22671 ""
}
/* if (ilvert .le. 9) then */
/* call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */
@@ -34198,40 +55355,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 22680 ""
if (ilvert > 9) {
+#line 22681 ""
i__1 = lnote;
+#line 22681 ""
ici__1.icierr = 0;
+#line 22681 ""
ici__1.icirnum = 1;
+#line 22681 ""
ici__1.icirlen = lnote + 4 - i__1;
+#line 22681 ""
ici__1.iciunit = notexq + i__1;
+#line 22681 ""
ici__1.icifmt = "(a1,i2,a1)";
+#line 22681 ""
s_wsfi(&ici__1);
+#line 22681 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 22681 ""
do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer));
+#line 22681 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 22681 ""
e_wsfi();
+#line 22682 ""
lnote += 4;
+#line 22683 ""
} else {
/* Writing concatenation */
+#line 22684 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 22684 ""
i__1 = ilvert + 48;
+#line 22684 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 22684 ""
i__2[1] = 1, a__1[1] = ch__1;
+#line 22684 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22685 ""
++lnote;
+#line 22686 ""
}
+#line 22687 ""
if (isarpshift) {
/* Writing concatenation */
+#line 22688 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 22688 ""
i__2[1] = 1, a__1[1] = "}";
+#line 22688 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22689 ""
++lnote;
+#line 22690 ""
}
+#line 22691 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
/* cancel out the stored time, to permit two arps at same time! */
+#line 22695 ""
comarp_1.tar[iarp - 1] = -1.f;
+#line 22696 ""
return 0;
} /* putarp_ */
@@ -34254,25 +55441,42 @@ L8:
static char tag[129], fmtq[9];
/* Fortran I/O blocks */
- static icilist io___1532 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 };
+ static icilist io___1580 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 };
+#line 22701 ""
if (*elask >= 0.f) {
+#line 22702 ""
if (*elask < .995f) {
+#line 22703 ""
lp = 3;
+#line 22704 ""
} else if (*elask < 9.995f) {
+#line 22705 ""
lp = 4;
+#line 22706 ""
} else {
+#line 22707 ""
lp = 5;
+#line 22708 ""
}
- s_wsfi(&io___1532);
+#line 22709 ""
+ s_wsfi(&io___1580);
+#line 22709 ""
do_fio(&c__1, "(a2,f", (ftnlen)5);
+#line 22709 ""
do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer));
+#line 22709 ""
do_fio(&c__1, ".2)", (ftnlen)3);
+#line 22709 ""
e_wsfi();
+#line 22710 ""
} else {
+#line 22711 ""
lp = 5;
+#line 22712 ""
s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9);
+#line 22713 ""
}
/* Overwrite as follows: ...xyz*ask *lmnop... -> */
@@ -34280,23 +55484,40 @@ L8:
/* ...xyz*ast{n.nn}*lmnop... */
/* ...xyz*ast{nn.nn}*lmnop... */
/* or for negative, ...xyz*ast{-nn.n}*lmnop... */
+#line 22720 ""
i__1 = *indxask + 8;
+#line 22720 ""
s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1);
+#line 22721 ""
i__1 = *indxask + 2;
+#line 22721 ""
ici__1.icierr = 0;
+#line 22721 ""
ici__1.icirnum = 1;
+#line 22721 ""
ici__1.icirlen = 129 - i__1;
+#line 22721 ""
ici__1.iciunit = outq + i__1;
+#line 22721 ""
ici__1.icifmt = fmtq;
+#line 22721 ""
s_wsfi(&ici__1);
+#line 22721 ""
do_fio(&c__1, "t{", (ftnlen)2);
+#line 22721 ""
do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real));
+#line 22721 ""
e_wsfi();
/* Writing concatenation */
+#line 22722 ""
i__2[0] = *indxask + 4 + lp, a__1[0] = outq;
+#line 22722 ""
i__2[1] = 1, a__1[1] = "}";
+#line 22722 ""
i__2[2] = 129, a__1[2] = tag;
+#line 22722 ""
s_cat(outq, a__1, i__2, &c__3, (ftnlen)129);
+#line 22723 ""
return 0;
} /* putast_ */
@@ -34324,133 +55545,247 @@ L8:
extern /* Subroutine */ int printl_(char *, ftnlen);
/* ivxip = ivx+16*ip */
+#line 22730 ""
i__1 = comcb_1.nbc;
+#line 22730 ""
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 22734 ""
ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[
ibc - 1], &c__1, &c__28) << 4);
+#line 22735 ""
ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4);
+#line 22736 ""
if (*ivx == ivxbc && *ip == ipbc) {
+#line 22736 ""
goto L2;
+#line 22736 ""
}
+#line 22737 ""
/* L1: */
+#line 22737 ""
}
+#line 22738 ""
printl_("Error in putbc, Call Dr. Don", (ftnlen)28);
+#line 22739 ""
s_stop("", (ftnlen)0);
+#line 22740 ""
L2:
+#line 22741 ""
if (bit_test(comcb_1.ibcdata[ibc - 1],27)) {
+#line 22742 ""
*lnote = 8;
+#line 22743 ""
s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8);
+#line 22744 ""
} else {
+#line 22745 ""
*lnote = 9;
+#line 22746 ""
s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9);
+#line 22747 ""
}
+#line 22748 ""
ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13);
/* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */
+#line 22750 ""
if (ivshft > 0) {
+#line 22750 ""
ivshft += -32;
+#line 22750 ""
}
+#line 22751 ""
if (ivshft < 0 || ivshft > 9) {
/* Writing concatenation */
+#line 22752 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22752 ""
i__2[1] = 1, a__1[1] = "{";
+#line 22752 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22753 ""
++(*lnote);
+#line 22754 ""
if (ivshft < -9) {
+#line 22755 ""
i__1 = *lnote;
+#line 22755 ""
ici__1.icierr = 0;
+#line 22755 ""
ici__1.icirnum = 1;
+#line 22755 ""
ici__1.icirlen = *lnote + 3 - i__1;
+#line 22755 ""
ici__1.iciunit = notexq + i__1;
+#line 22755 ""
ici__1.icifmt = "(i3)";
+#line 22755 ""
s_wsfi(&ici__1);
+#line 22755 ""
do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
+#line 22755 ""
e_wsfi();
+#line 22756 ""
*lnote += 3;
+#line 22757 ""
} else {
+#line 22758 ""
i__1 = *lnote;
+#line 22758 ""
ici__1.icierr = 0;
+#line 22758 ""
ici__1.icirnum = 1;
+#line 22758 ""
ici__1.icirlen = *lnote + 2 - i__1;
+#line 22758 ""
ici__1.iciunit = notexq + i__1;
+#line 22758 ""
ici__1.icifmt = "(i2)";
+#line 22758 ""
s_wsfi(&ici__1);
+#line 22758 ""
do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
+#line 22758 ""
e_wsfi();
+#line 22759 ""
*lnote += 2;
+#line 22760 ""
}
/* Writing concatenation */
+#line 22761 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22761 ""
i__2[1] = 1, a__1[1] = "}";
+#line 22761 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22762 ""
++(*lnote);
+#line 22763 ""
} else {
/* Writing concatenation */
+#line 22764 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22764 ""
*(unsigned char *)&ch__1[0] = ivshft + 48;
+#line 22764 ""
i__2[1] = 1, a__1[1] = ch__1;
+#line 22764 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22765 ""
++(*lnote);
+#line 22766 ""
}
+#line 22767 ""
ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19);
+#line 22768 ""
if (ihshft == 0) {
/* Writing concatenation */
+#line 22769 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22769 ""
i__2[1] = 1, a__1[1] = "0";
+#line 22769 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22770 ""
++(*lnote);
+#line 22771 ""
} else {
+#line 22772 ""
hshft = (ihshft - 128) * .1f;
/* -12.8<hshft<12.8 */
/* Writing concatenation */
+#line 22776 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22776 ""
i__2[1] = 1, a__1[1] = "{";
+#line 22776 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22777 ""
++(*lnote);
+#line 22778 ""
if (hshft < -9.95f) {
+#line 22779 ""
i__1 = *lnote;
+#line 22779 ""
ici__1.icierr = 0;
+#line 22779 ""
ici__1.icirnum = 1;
+#line 22779 ""
ici__1.icirlen = *lnote + 5 - i__1;
+#line 22779 ""
ici__1.iciunit = notexq + i__1;
+#line 22779 ""
ici__1.icifmt = "(f5.1)";
+#line 22779 ""
s_wsfi(&ici__1);
+#line 22779 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
+#line 22779 ""
e_wsfi();
+#line 22780 ""
*lnote += 5;
+#line 22781 ""
} else if (hshft < -.05f || hshft > 9.95f) {
+#line 22782 ""
i__1 = *lnote;
+#line 22782 ""
ici__1.icierr = 0;
+#line 22782 ""
ici__1.icirnum = 1;
+#line 22782 ""
ici__1.icirlen = *lnote + 4 - i__1;
+#line 22782 ""
ici__1.iciunit = notexq + i__1;
+#line 22782 ""
ici__1.icifmt = "(f4.1)";
+#line 22782 ""
s_wsfi(&ici__1);
+#line 22782 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
+#line 22782 ""
e_wsfi();
+#line 22783 ""
*lnote += 4;
+#line 22784 ""
} else {
+#line 22785 ""
i__1 = *lnote;
+#line 22785 ""
ici__1.icierr = 0;
+#line 22785 ""
ici__1.icirnum = 1;
+#line 22785 ""
ici__1.icirlen = *lnote + 3 - i__1;
+#line 22785 ""
ici__1.iciunit = notexq + i__1;
+#line 22785 ""
ici__1.icifmt = "(f3.1)";
+#line 22785 ""
s_wsfi(&ici__1);
+#line 22785 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
+#line 22785 ""
e_wsfi();
+#line 22786 ""
*lnote += 3;
+#line 22787 ""
}
/* Writing concatenation */
+#line 22788 ""
i__2[0] = *lnote, a__1[0] = notexq;
+#line 22788 ""
i__2[1] = 1, a__1[1] = "}";
+#line 22788 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 22789 ""
++(*lnote);
+#line 22790 ""
}
+#line 22791 ""
return 0;
} /* putcb_ */
@@ -34490,112 +55825,188 @@ L2:
;
/* Fortran I/O blocks */
- static icilist io___1545 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
- static icilist io___1546 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
- static icilist io___1547 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
- static icilist io___1548 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
- static icilist io___1561 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
- static icilist io___1562 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
- static icilist io___1563 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
- static icilist io___1564 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
+ static icilist io___1593 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
+ static icilist io___1594 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
+ static icilist io___1595 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
+ static icilist io___1596 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
+ static icilist io___1609 = { 0, notexq+5, 0, "(f6.2)", 6, 1 };
+ static icilist io___1610 = { 0, notexq+5, 0, "(f5.2)", 5, 1 };
+ static icilist io___1611 = { 0, notexq+5, 0, "(f4.2)", 4, 1 };
+ static icilist io___1612 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
+#line 22803 ""
if (*ivx == 1) {
+#line 22804 ""
s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4);
+#line 22805 ""
s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4);
+#line 22806 ""
} else {
+#line 22807 ""
s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4);
+#line 22808 ""
s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4);
+#line 22809 ""
}
+#line 22810 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 22810 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 22811 ""
if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] != 0) {
/* Alter figdrop */
/* Writing concatenation */
+#line 22815 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22815 ""
i__1[1] = 6, a__1[1] = "global";
+#line 22815 ""
i__1[2] = 1, a__1[2] = sq;
+#line 22815 ""
i__1[3] = 7, a__1[3] = "advance";
+#line 22815 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22815 ""
i__1[5] = 7, a__1[5] = "figdrop";
+#line 22815 ""
s_cat(notexq, a__1, i__1, &c__6, (ftnlen)80);
+#line 22816 ""
lnote = 23;
+#line 22817 ""
if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] < 0) {
/* Writing concatenation */
+#line 22818 ""
i__2[0] = lnote, a__2[0] = notexq;
+#line 22818 ""
i__2[1] = 1, a__2[1] = "-";
+#line 22818 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
+#line 22819 ""
++lnote;
+#line 22820 ""
}
/* Writing concatenation */
+#line 22821 ""
i__2[0] = lnote, a__2[0] = notexq;
+#line 22821 ""
*(unsigned char *)&ch__1[0] = (i__3 = comfig_2.ivvfig[*ivx + (*ifig <<
1) - 3], abs(i__3)) + 48;
+#line 22821 ""
i__2[1] = 1, a__2[1] = ch__1;
+#line 22821 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
+#line 22822 ""
++lnote;
+#line 22823 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)80, (ftnlen)80);
+#line 22824 ""
}
+#line 22825 ""
if (dabs(*offnsk) > 1e-4f) {
/* Write offset for floating figure, to two decimal places */
/* Writing concatenation */
+#line 22829 ""
i__2[0] = 1, a__2[0] = sq;
+#line 22829 ""
i__2[1] = 4, a__2[1] = "off{";
+#line 22829 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
+#line 22830 ""
if (-(*offnsk) < -9.995f) {
- s_wsfi(&io___1545);
+#line 22831 ""
+ s_wsfi(&io___1593);
+#line 22831 ""
r__1 = -(*offnsk);
+#line 22831 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 22831 ""
e_wsfi();
+#line 22832 ""
lnote = 11;
+#line 22833 ""
} else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) {
- s_wsfi(&io___1546);
+#line 22834 ""
+ s_wsfi(&io___1594);
+#line 22834 ""
r__1 = -(*offnsk);
+#line 22834 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 22834 ""
e_wsfi();
+#line 22835 ""
lnote = 10;
+#line 22836 ""
} else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) {
- s_wsfi(&io___1547);
+#line 22837 ""
+ s_wsfi(&io___1595);
+#line 22837 ""
r__1 = -(*offnsk);
+#line 22837 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 22837 ""
e_wsfi();
+#line 22838 ""
lnote = 9;
+#line 22839 ""
} else {
- s_wsfi(&io___1548);
+#line 22840 ""
+ s_wsfi(&io___1596);
+#line 22840 ""
r__1 = -(*offnsk);
+#line 22840 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
+#line 22840 ""
e_wsfi();
+#line 22841 ""
lnote = 8;
+#line 22842 ""
}
/* Writing concatenation */
+#line 22843 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 22843 ""
i__4[1] = 1, a__3[1] = sq;
+#line 22843 ""
i__4[2] = 9, a__3[2] = "noteskip}";
+#line 22843 ""
s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80);
+#line 22844 ""
i__3 = lnote + 10;
+#line 22844 ""
addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
+#line 22845 ""
}
+#line 22846 ""
s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10,
(ftnlen)10);
+#line 22847 ""
ic = 1;
/* nof = 0 */
/* nofa = -1 */
+#line 22850 ""
nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3];
+#line 22851 ""
nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1;
/* Beginning of manual loop */
+#line 22855 ""
L1:
+#line 22855 ""
*(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1];
/* Exit when first blank is encountered */
+#line 22859 ""
if (*(unsigned char *)ch1q == ' ') {
+#line 22859 ""
goto L2;
+#line 22859 ""
}
/* Starting a level. Set up vertical offset. */
@@ -34616,217 +56027,387 @@ L1:
/* lnofa = 2 */
/* nofaq = '1'//chax(nofa+38) */
/* end if */
+#line 22879 ""
istring_(&nof, nofq, &lnof, (ftnlen)5);
+#line 22880 ""
istring_(&nofa, nofaq, &lnofa, (ftnlen)5);
+#line 22881 ""
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 22887 ""
icnum = ic + 1;
+#line 22888 ""
L3:
+#line 22889 ""
++ic;
+#line 22890 ""
if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0)
{
+#line 22890 ""
goto L3;
+#line 22890 ""
}
+#line 22891 ""
lnum = ic - icnum;
/* Writing concatenation */
+#line 22892 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22892 ""
i__1[1] = 4, a__1[1] = conttq;
+#line 22892 ""
i__1[2] = lnof, a__1[2] = nofq;
+#line 22892 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22892 ""
i__1[4] = ic - 1 - (icnum - 1), a__1[4] = figq + (icnum - 1);
+#line 22892 ""
i__1[5] = 1, a__1[5] = "}";
+#line 22892 ""
s_cat(ch__2, a__1, i__1, &c__6, (ftnlen)22);
+#line 22892 ""
i__3 = ic + 7 - icnum + lnof;
+#line 22892 ""
addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1))
+ 1, (ftnlen)80);
+#line 22894 ""
if (*(unsigned char *)&figq[ic - 1] != ':') {
+#line 22894 ""
--ic;
+#line 22894 ""
}
+#line 22895 ""
} else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-'
|| *(unsigned char *)ch1q == 'n') {
+#line 22896 ""
++ic;
+#line 22897 ""
*(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1];
+#line 22898 ""
if (*(unsigned char *)ch2q == ' ') {
/* Figure is a stand-alone accidental, so must be centered */
+#line 22902 ""
if (*(unsigned char *)ch1q == '#') {
/* Writing concatenation */
+#line 22903 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22903 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22903 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22903 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22903 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22903 ""
i__1[5] = 9, a__1[5] = "sharpfig}";
+#line 22903 ""
s_cat(ch__3, a__1, i__1, &c__6, (ftnlen)21);
+#line 22903 ""
i__3 = lnofa + 16;
+#line 22903 ""
addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80);
+#line 22905 ""
} else if (*(unsigned char *)ch1q == '-') {
/* Writing concatenation */
+#line 22906 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22906 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22906 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22906 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22906 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22906 ""
i__1[5] = 8, a__1[5] = "flatfig}";
+#line 22906 ""
s_cat(ch__4, a__1, i__1, &c__6, (ftnlen)20);
+#line 22906 ""
i__3 = lnofa + 15;
+#line 22906 ""
addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80);
+#line 22908 ""
} else if (*(unsigned char *)ch1q == 'n') {
/* Writing concatenation */
+#line 22909 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22909 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22909 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22909 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22909 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22909 ""
i__1[5] = 7, a__1[5] = "natfig}";
+#line 22909 ""
s_cat(ch__5, a__1, i__1, &c__6, (ftnlen)19);
+#line 22909 ""
i__3 = lnofa + 14;
+#line 22909 ""
addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80);
+#line 22911 ""
}
+#line 22912 ""
goto L2;
+#line 22913 ""
} else {
/* Figure is an accidental followed by a number */
/* First put the accidental (offset to the left) */
+#line 22918 ""
if (*(unsigned char *)ch1q == '#') {
/* Writing concatenation */
+#line 22919 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22919 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22919 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22919 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22919 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22919 ""
i__1[5] = 6, a__1[5] = "fsmsh}";
+#line 22919 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
+#line 22919 ""
i__3 = lnofa + 13;
+#line 22919 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
+#line 22922 ""
} else if (*(unsigned char *)ch1q == '-') {
/* Writing concatenation */
+#line 22923 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22923 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22923 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22923 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22923 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22923 ""
i__1[5] = 6, a__1[5] = "fsmfl}";
+#line 22923 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
+#line 22923 ""
i__3 = lnofa + 13;
+#line 22923 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
+#line 22926 ""
} else if (*(unsigned char *)ch1q == 'n') {
/* Writing concatenation */
+#line 22927 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22927 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22927 ""
i__1[2] = lnofa, a__1[2] = nofaq;
+#line 22927 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22927 ""
i__1[4] = 1, a__1[4] = sq;
+#line 22927 ""
i__1[5] = 6, a__1[5] = "fsmna}";
+#line 22927 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
+#line 22927 ""
i__3 = lnofa + 13;
+#line 22927 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
+#line 22930 ""
}
/* Now put the number */
/* Writing concatenation */
+#line 22934 ""
i__1[0] = 1, a__1[0] = sq;
+#line 22934 ""
i__1[1] = 4, a__1[1] = figutq;
+#line 22934 ""
i__1[2] = lnof, a__1[2] = nofq;
+#line 22934 ""
i__1[3] = 1, a__1[3] = "{";
+#line 22934 ""
i__1[4] = 1, a__1[4] = ch2q;
+#line 22934 ""
i__1[5] = 1, a__1[5] = "}";
+#line 22934 ""
s_cat(ch__7, a__1, i__1, &c__6, (ftnlen)13);
+#line 22934 ""
i__3 = lnof + 8;
+#line 22934 ""
addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80);
+#line 22936 ""
}
+#line 22937 ""
} else if (*(unsigned char *)ch1q == '_') {
/* Placeholder only (for lowering a figure). Don't do anything! */
+#line 22942 ""
} else {
/* Figure is a single number, maybe with s after */
/* Writing concatenation */
+#line 22946 ""
i__5[0] = 1, a__4[0] = sq;
+#line 22946 ""
i__5[1] = 4, a__4[1] = figutq;
+#line 22946 ""
i__5[2] = lnof, a__4[2] = nofq;
+#line 22946 ""
i__5[3] = 1, a__4[3] = "{";
+#line 22946 ""
s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11);
+#line 22946 ""
i__3 = lnof + 6;
+#line 22946 ""
addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80);
+#line 22948 ""
i__3 = ic;
+#line 22948 ""
s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3);
+#line 22949 ""
if (*(unsigned char *)ch2q == 's') {
/* Use a special character. Insert font call */
+#line 22953 ""
++ic;
/* Writing concatenation */
+#line 22954 ""
i__2[0] = 1, a__2[0] = sq;
+#line 22954 ""
i__2[1] = 7, a__2[1] = "ligfont";
+#line 22954 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
+#line 22954 ""
addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80);
+#line 22955 ""
}
/* Writing concatenation */
+#line 22956 ""
i__2[0] = 1, a__2[0] = ch1q;
+#line 22956 ""
i__2[1] = 1, a__2[1] = "}";
+#line 22956 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)2);
+#line 22956 ""
addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
/* call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */
/* * 8+lnof,soutq,lsout) */
+#line 22959 ""
}
+#line 22960 ""
if (ic >= 10) {
+#line 22960 ""
goto L2;
+#line 22960 ""
}
+#line 22961 ""
++ic;
+#line 22962 ""
nof += 4;
+#line 22963 ""
nofa += 4;
+#line 22964 ""
goto L1;
+#line 22965 ""
L2:
+#line 22966 ""
if (dabs(*offnsk) > 1e-4f) {
/* Writing concatenation */
+#line 22967 ""
i__2[0] = 1, a__2[0] = sq;
+#line 22967 ""
i__2[1] = 4, a__2[1] = "off{";
+#line 22967 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
+#line 22968 ""
if (*offnsk < -9.995f) {
- s_wsfi(&io___1561);
+#line 22969 ""
+ s_wsfi(&io___1609);
+#line 22969 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
+#line 22969 ""
e_wsfi();
+#line 22970 ""
lnote = 11;
+#line 22971 ""
} else if (*offnsk < -.995f || *offnsk > 9.995f) {
- s_wsfi(&io___1562);
+#line 22972 ""
+ s_wsfi(&io___1610);
+#line 22972 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
+#line 22972 ""
e_wsfi();
+#line 22973 ""
lnote = 10;
+#line 22974 ""
} else if (*offnsk < -1e-4f || *offnsk > .995f) {
- s_wsfi(&io___1563);
+#line 22975 ""
+ s_wsfi(&io___1611);
+#line 22975 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
+#line 22975 ""
e_wsfi();
+#line 22976 ""
lnote = 9;
+#line 22977 ""
} else {
- s_wsfi(&io___1564);
+#line 22978 ""
+ s_wsfi(&io___1612);
+#line 22978 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
+#line 22978 ""
e_wsfi();
+#line 22979 ""
lnote = 8;
+#line 22980 ""
}
/* Writing concatenation */
+#line 22981 ""
i__4[0] = lnote, a__3[0] = notexq;
+#line 22981 ""
i__4[1] = 1, a__3[1] = sq;
+#line 22981 ""
i__4[2] = 9, a__3[2] = "noteskip}";
+#line 22981 ""
s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80);
+#line 22982 ""
i__3 = lnote + 10;
+#line 22982 ""
addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
+#line 22983 ""
}
+#line 22984 ""
if (*ifig < comfig_2.nfigs[*ivx - 1]) {
+#line 22985 ""
++(*ifig);
+#line 22986 ""
} else {
+#line 22987 ""
comfig_2.nfigs[*ivx - 1] = 0;
+#line 22988 ""
*figcheck = FALSE_;
+#line 22989 ""
}
+#line 22990 ""
return 0;
} /* putfig_ */
@@ -34879,56 +56460,95 @@ L2:
/* notcrd = .true. if ornament is on main note. */
/* nolevm is level of main note (for chords) */
+#line 23010 ""
/* Parameter adjustments */
+#line 23010 ""
ihornb -= 25;
+#line 23010 ""
ulq -= 25;
+#line 23010 ""
--nornb;
+#line 23010 ""
+#line 23010 ""
/* Function Body */
+#line 23010 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 23010 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 23011 ""
*lout = 0;
+#line 23012 ""
usehornb = FALSE_;
+#line 23013 ""
if (*nodur < 64) {
+#line 23014 ""
stemlen = *stemlin;
+#line 23015 ""
} else {
+#line 23016 ""
stemlen = 0.f;
+#line 23017 ""
}
/* Get up-downness. ulpzq is opposite from stem direction for both beams and */
/* non beams. Can use in name of ornament [ . or _ ] */
+#line 23022 ""
if (*beamon) {
+#line 23023 ""
if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
+#line 23024 ""
*(unsigned char *)ulpzq = 'l';
+#line 23025 ""
} else {
+#line 23026 ""
*(unsigned char *)ulpzq = 'u';
+#line 23027 ""
}
+#line 23028 ""
} else {
+#line 23029 ""
udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv);
+#line 23029 ""
if (*(unsigned char *)&ch__1[0] == 'l') {
+#line 23030 ""
*(unsigned char *)ulpzq = 'u';
+#line 23031 ""
} else {
+#line 23032 ""
*(unsigned char *)ulpzq = 'l';
+#line 23033 ""
}
+#line 23034 ""
}
/* To enable >1 ornament on a note, next line is top of manual loop. */
+#line 23038 ""
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 23043 ""
if (bit_test(*iornq,29)) {
+#line 23044 ""
ibit = 29;
+#line 23045 ""
} else if (bit_test(*iornq,30)) {
+#line 23046 ""
ibit = 30;
+#line 23047 ""
} else {
+#line 23048 ""
i__1 = *iornq & 4194303;
+#line 23048 ""
ibit = log2_(&i__1);
/* ibit = log2(iand(iornq,33554431)) */
+#line 23050 ""
}
+#line 23051 ""
iornt = pow_ii(&c__2, &ibit);
/* Begin routine to set height. Bits 0-13: (stmgx+Tupf._) */
@@ -34938,334 +56558,568 @@ L2:
/* Do not use beam height for . or _ */
+#line 23060 ""
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 23065 ""
ihorn = ihornb[*ivx + nornb[*ivx] * 24];
+#line 23066 ""
if (*(unsigned char *)ulpzq == 'u') {
+#line 23066 ""
ihorn += -2;
+#line 23066 ""
}
/* Following flag tells whether to increment nornb when exiting the subroutine. */
+#line 23070 ""
usehornb = TRUE_;
+#line 23071 ""
} else if (ibit == 14) {
/* Down fermata. Don't worry about upper chord notes. */
+#line 23075 ""
if (*(unsigned char *)ulpzq == 'l') {
/* Computing MIN */
+#line 23076 ""
i__1 = *nolev, i__2 = *ncm - 3;
+#line 23076 ""
ihorn = min(i__1,i__2);
+#line 23077 ""
} else {
/* Computing MIN */
+#line 23078 ""
r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
+#line 23078 ""
ihorn = dmin(r__1,r__2);
+#line 23079 ""
}
+#line 23080 ""
} else if (bit_test(iornt,13) || bit_test(iornt,0)) {
/* ( or ) */
+#line 23084 ""
ihorn = *nolev;
+#line 23085 ""
} 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 23091 ""
if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *)
ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned
char *)ulpzq == 'u') {
+#line 23093 ""
ihorn = *nolev;
+#line 23094 ""
} else if (comtrill_1.maxlev == *nolev) {
+#line 23095 ""
*(unsigned char *)ulpzq = 'u';
/* Computing MAX */
+#line 23096 ""
r__1 = *nolev + stemlen, r__2 = *ncm + 3.f;
+#line 23096 ""
ihorn = dmax(r__1,r__2);
+#line 23097 ""
} else {
+#line 23098 ""
*(unsigned char *)ulpzq = 'l';
/* Computing MIN */
+#line 23099 ""
r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
+#line 23099 ""
ihorn = dmin(r__1,r__2);
+#line 23100 ""
}
+#line 23101 ""
} else if (*iscrd && *nolev == comtrill_1.minlev) {
+#line 23102 ""
if (*(unsigned char *)ulpzq == 'l') {
/* Computing MIN */
+#line 23103 ""
i__1 = *nolev - 3, i__2 = *ncm - 6;
+#line 23103 ""
ihorn = min(i__1,i__2);
+#line 23104 ""
} else {
/* Computing MIN */
+#line 23105 ""
i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6;
+#line 23105 ""
ihorn = min(i__1,i__2);
+#line 23106 ""
}
+#line 23107 ""
} else if (ibit == 10 && *nolev > 90) {
/* Special treatment for fermata on a shifted rest */
+#line 23111 ""
ihorn = *ncm + 5;
+#line 23112 ""
} else if (*(unsigned char *)ulpzq == 'l') {
/* (iscrd and nolev=maxlev) or (.not.iscrd) */
/* Computing MAX */
+#line 23116 ""
r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f;
+#line 23116 ""
ihorn = dmax(r__1,r__2);
+#line 23117 ""
} else if (ibit == 29 || ibit == 30) {
/* coda or new segno, no height tweak */
+#line 23121 ""
ihorn = *ncm + 5;
+#line 23122 ""
} else {
/* Computing MAX */
+#line 23123 ""
i__1 = *nolev + 2, i__2 = *ncm + 5;
+#line 23123 ""
ihorn = max(i__1,i__2);
+#line 23124 ""
}
+#line 23125 ""
ioff = 0;
+#line 23126 ""
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 23131 ""
if (bit_test(iornt,2)) {
/* Writing concatenation */
+#line 23132 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23132 ""
i__3[1] = 5, a__1[1] = "shake";
+#line 23132 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23133 ""
lnote = 6;
+#line 23134 ""
} else if (bit_test(iornt,3)) {
/* Writing concatenation */
+#line 23135 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23135 ""
i__3[1] = 7, a__1[1] = "mordent";
+#line 23135 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23136 ""
lnote = 8;
+#line 23137 ""
} else if (bit_test(iornt,1)) {
/* Writing concatenation */
+#line 23138 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23138 ""
i__3[1] = 3, a__1[1] = "mtr";
+#line 23138 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23139 ""
lnote = 4;
+#line 23140 ""
} else if (bit_test(iornt,5)) {
/* Writing concatenation */
+#line 23141 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23141 ""
i__3[1] = 3, a__1[1] = "xtr";
+#line 23141 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23142 ""
lnote = 4;
+#line 23143 ""
} else if (bit_test(iornt,6)) {
/* Writing concatenation */
+#line 23144 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23144 ""
i__3[1] = 3, a__1[1] = "ptr";
+#line 23144 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23145 ""
lnote = 4;
+#line 23146 ""
} else if (bit_test(iornt,13)) {
/* Writing concatenation */
+#line 23147 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23147 ""
i__3[1] = 3, a__1[1] = "rpn";
+#line 23147 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23148 ""
lnote = 4;
+#line 23149 ""
} else if (bit_test(iornt,0)) {
/* Writing concatenation */
+#line 23150 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23150 ""
i__3[1] = 3, a__1[1] = "lpn";
+#line 23150 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23151 ""
lnote = 4;
+#line 23152 ""
} else if (bit_test(iornt,12)) {
/* Writing concatenation */
+#line 23153 ""
i__4[0] = 1, a__2[0] = sq;
+#line 23153 ""
i__4[1] = 1, a__2[1] = ulpzq;
+#line 23153 ""
i__4[2] = 2, a__2[2] = "st";
+#line 23153 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
+#line 23154 ""
lnote = 4;
+#line 23155 ""
} else if (bit_test(iornt,11)) {
/* Writing concatenation */
+#line 23156 ""
i__4[0] = 1, a__2[0] = sq;
+#line 23156 ""
i__4[1] = 1, a__2[1] = ulpzq;
+#line 23156 ""
i__4[2] = 2, a__2[2] = "pz";
+#line 23156 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
+#line 23157 ""
lnote = 4;
+#line 23158 ""
} else if (bit_test(iornt,8)) {
/* Writing concatenation */
+#line 23159 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23159 ""
i__3[1] = 3, a__1[1] = "upz";
+#line 23159 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23160 ""
lnote = 4;
+#line 23161 ""
ioff = -2;
+#line 23162 ""
} else if (bit_test(iornt,9)) {
/* Writing concatenation */
+#line 23163 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23163 ""
i__3[1] = 4, a__1[1] = "uppz";
+#line 23163 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23164 ""
lnote = 5;
+#line 23165 ""
ioff = -2;
+#line 23166 ""
} else if (bit_test(iornt,10)) {
+#line 23167 ""
if (*nodur < 48) {
/* Writing concatenation */
+#line 23168 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23168 ""
i__3[1] = 9, a__1[1] = "fermataup";
+#line 23168 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23169 ""
} else {
/* Writing concatenation */
+#line 23170 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23170 ""
i__3[1] = 9, a__1[1] = "Fermataup";
+#line 23170 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23171 ""
}
+#line 23172 ""
lnote = 10;
+#line 23173 ""
ioff = -2;
+#line 23174 ""
} else if (bit_test(iornt,14)) {
+#line 23175 ""
if (*nodur < 48) {
/* Writing concatenation */
+#line 23176 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23176 ""
i__3[1] = 11, a__1[1] = "fermatadown";
+#line 23176 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23177 ""
} else {
/* Writing concatenation */
+#line 23178 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23178 ""
i__3[1] = 11, a__1[1] = "Fermatadown";
+#line 23178 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23179 ""
}
+#line 23180 ""
lnote = 12;
+#line 23181 ""
} else if (bit_test(iornt,21)) {
/* "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 */
+#line 23185 ""
if (bit_test(*iornq,16)) {
/* Writing concatenation */
+#line 23186 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23186 ""
i__3[1] = 6, a__1[1] = "qsharp";
+#line 23186 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23187 ""
lnote = 7;
+#line 23188 ""
ioff = 2;
+#line 23189 ""
*iornq = bit_clear(*iornq,16);
+#line 23190 ""
iclracc = 16;
+#line 23191 ""
} else if (bit_test(*iornq,17)) {
/* Writing concatenation */
+#line 23192 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23192 ""
i__3[1] = 5, a__1[1] = "qflat";
+#line 23192 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23193 ""
lnote = 6;
+#line 23194 ""
ioff = 1;
+#line 23195 ""
*iornq = bit_clear(*iornq,17);
+#line 23196 ""
iclracc = 17;
+#line 23197 ""
} else if (bit_test(*iornq,18)) {
/* Writing concatenation */
+#line 23198 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23198 ""
i__3[1] = 4, a__1[1] = "qnat";
+#line 23198 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23199 ""
lnote = 5;
+#line 23200 ""
ioff = 2;
+#line 23201 ""
*iornq = bit_clear(*iornq,18);
+#line 23202 ""
iclracc = 18;
+#line 23203 ""
} else {
/* Writing concatenation */
+#line 23204 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23204 ""
i__3[1] = 5, a__1[1] = "qedit";
+#line 23204 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23205 ""
lnote = 6;
+#line 23206 ""
ioff = 0;
+#line 23207 ""
}
+#line 23208 ""
} else if (bit_test(iornt,16)) {
/* Writing concatenation */
+#line 23209 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23209 ""
i__3[1] = 6, a__1[1] = "esharp";
+#line 23209 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23210 ""
lnote = 7;
+#line 23211 ""
ioff = 2;
+#line 23212 ""
} else if (bit_test(iornt,17)) {
/* Writing concatenation */
+#line 23213 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23213 ""
i__3[1] = 5, a__1[1] = "eflat";
+#line 23213 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23214 ""
lnote = 6;
+#line 23215 ""
ioff = 1;
+#line 23216 ""
} else if (bit_test(iornt,18)) {
/* Writing concatenation */
+#line 23217 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23217 ""
i__3[1] = 4, a__1[1] = "enat";
+#line 23217 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23218 ""
lnote = 5;
+#line 23219 ""
ioff = 2;
+#line 23220 ""
} else if (bit_test(iornt,19)) {
/* Writing concatenation */
+#line 23221 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23221 ""
i__3[1] = 3, a__1[1] = "usf";
+#line 23221 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23222 ""
lnote = 4;
+#line 23223 ""
ioff = -2;
+#line 23224 ""
} else if (bit_test(iornt,20)) {
/* Writing concatenation */
+#line 23225 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23225 ""
i__3[1] = 4, a__1[1] = "usfz";
+#line 23225 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23226 ""
lnote = 5;
+#line 23227 ""
ioff = -2;
+#line 23228 ""
} else if (bit_test(iornt,29)) {
/* Writing concatenation */
+#line 23229 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23229 ""
i__3[1] = 5, a__1[1] = "ccoda";
+#line 23229 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23230 ""
lnote = 6;
+#line 23231 ""
} else if (bit_test(iornt,30)) {
/* Writing concatenation */
+#line 23232 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23232 ""
i__3[1] = 6, a__1[1] = "ssegno";
+#line 23232 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23233 ""
lnote = 7;
+#line 23234 ""
}
+#line 23235 ""
iudorn = 0;
/* User-defined level shift of ornament from default? */
+#line 23239 ""
if (bit_test(*iornq,25)) {
/* Find which (if any) element of kudorn has the shift. */
+#line 23243 ""
i__1 = comtrill_1.nudorn;
+#line 23243 ""
for (iudorn = 1; iudorn <= i__1; ++iudorn) {
/* if (ibit .lt. 21) then */
/* if (ibit.lt.21 .or. ibit.eq.29) then */
+#line 23246 ""
if (ibit < 21 || ibit == 29 || ibit == 30) {
+#line 23247 ""
ibitt = ibit;
/* Could have oes, but not oe? or oes? */
+#line 23251 ""
} else if (iclracc > 0) {
/* Earlier cleared edit. accid, meaning it was oes? */
+#line 23255 ""
ibitt = iclracc + 6;
+#line 23256 ""
} else {
+#line 23257 ""
ibitt = 21;
+#line 23258 ""
}
+#line 23259 ""
ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19);
/* if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */
+#line 23261 ""
if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx ==
comivxudorn_1.ivxudorn[iudorn - 1]) {
+#line 23261 ""
goto L4;
+#line 23261 ""
}
+#line 23263 ""
/* L3: */
+#line 23263 ""
}
/* Nothing shifted on this note; exit this if block */
+#line 23267 ""
iudorn = 0;
+#line 23268 ""
goto L5;
+#line 23269 ""
L4:
+#line 23270 ""
ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25)
) - 32;
+#line 23271 ""
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 23276 ""
i__3[0] = 1, a__1[0] = sq;
+#line 23276 ""
i__3[1] = 3, a__1[1] = "lsf";
+#line 23276 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23277 ""
ioffinc += 6;
+#line 23278 ""
}
+#line 23279 ""
ioff += ioffinc;
+#line 23280 ""
}
+#line 23281 ""
L5:
/* Shift level to avoid slur. Conditions are */
@@ -35275,88 +57129,149 @@ L5:
/* 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */
/* 5. islhgt+3 >= height already computed. */
+#line 23290 ""
if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) {
+#line 23290 ""
i__1 = *islhgt + 3;
+#line 23290 ""
ioff += i_dim(&i__1, &ihorn);
+#line 23290 ""
}
+#line 23293 ""
i__1 = ihorn + ioff;
+#line 23293 ""
notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8);
+#line 23294 ""
if (lnoten == 1) {
+#line 23294 ""
addblank_(noteq, &lnoten, (ftnlen)8);
+#line 23294 ""
}
+#line 23295 ""
if ((iornt & 32896) > 0) {
/* T-trill or trill w/o "tr" */
+#line 23299 ""
dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, (
ftnlen)79);
+#line 23300 ""
} else {
/* Writing concatenation */
+#line 23301 ""
i__3[0] = lnote, a__1[0] = notexq;
+#line 23301 ""
i__3[1] = lnoten, a__1[1] = noteq;
+#line 23301 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23302 ""
lnote += lnoten;
+#line 23303 ""
}
+#line 23304 ""
if (iudorn > 0) {
+#line 23305 ""
if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) {
/* Horizontal shift */
+#line 23309 ""
lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]);
+#line 23310 ""
ici__1.icierr = 0;
+#line 23310 ""
ici__1.icirnum = 1;
+#line 23310 ""
ici__1.icirlen = lform;
+#line 23310 ""
ici__1.iciunit = noteq;
/* Writing concatenation */
+#line 23310 ""
i__4[0] = 2, a__2[0] = "(f";
+#line 23310 ""
i__1 = lform + 48;
+#line 23310 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 23310 ""
i__4[1] = 1, a__2[1] = ch__1;
+#line 23310 ""
i__4[2] = 3, a__2[2] = ".1)";
+#line 23310 ""
ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6),
ch__2);
+#line 23310 ""
s_wsfi(&ici__1);
+#line 23310 ""
do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen)
sizeof(real));
+#line 23310 ""
e_wsfi();
/* Writing concatenation */
+#line 23312 ""
i__5[0] = 1, a__3[0] = sq;
+#line 23312 ""
i__5[1] = 8, a__3[1] = "roffset{";
+#line 23312 ""
i__5[2] = lform, a__3[2] = noteq;
+#line 23312 ""
i__5[3] = 2, a__3[3] = "}{";
+#line 23312 ""
i__5[4] = lnote, a__3[4] = notexq;
+#line 23312 ""
i__5[5] = 1, a__3[5] = "}";
+#line 23312 ""
s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79);
+#line 23314 ""
lnote = lnote + lform + 12;
+#line 23315 ""
comtrill_1.ornhshft[iudorn - 1] = 0.f;
+#line 23316 ""
comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[
iudorn - 1],31);
+#line 23317 ""
}
+#line 23318 ""
}
/* Zero out the bit for ornament just dealt with. */
+#line 23322 ""
*iornq = bit_clear(*iornq,ibit);
+#line 23323 ""
if (*lout == 0) {
+#line 23324 ""
s_copy(outq, notexq, (ftnlen)79, lnote);
+#line 23325 ""
} else {
/* Writing concatenation */
+#line 23326 ""
i__3[0] = *lout, a__1[0] = outq;
+#line 23326 ""
i__3[1] = lnote, a__1[1] = notexq;
+#line 23326 ""
s_cat(outq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23327 ""
}
+#line 23328 ""
*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 23334 ""
if ((*iornq & 4194303) > 0) {
+#line 23334 ""
goto L2;
+#line 23334 ""
}
+#line 23335 ""
if (usehornb) {
+#line 23335 ""
++nornb[*ivx];
+#line 23335 ""
}
+#line 23336 ""
return 0;
} /* putorn_ */
@@ -35385,52 +57300,91 @@ L5:
ftnlen, ftnlen);
static char notexq[80];
+#line 23344 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 23344 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
/* Start user-defined offsets X(...): or X(...)S */
+#line 23348 ""
if (*onoff) {
+#line 23348 ""
++comudsp_1.nudoff[*ivx - 1];
+#line 23348 ""
}
/* Xoff is in pts. Round off to nearest .1. Will use at end of shift. */
+#line 23352 ""
xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25];
+#line 23353 ""
r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f;
+#line 23353 ""
xoff = r_sign(&r__1, &xoff);
+#line 23354 ""
if (! (*onoff)) {
+#line 23354 ""
xoff = -xoff;
+#line 23354 ""
}
+#line 23355 ""
if (xoff < -9.95f) {
+#line 23356 ""
ifmt = 5;
+#line 23357 ""
} else if (xoff < -.95f || xoff > 9.95f) {
+#line 23358 ""
ifmt = 4;
+#line 23359 ""
} else {
+#line 23360 ""
ifmt = 3;
+#line 23361 ""
}
+#line 23362 ""
ici__1.icierr = 0;
+#line 23362 ""
ici__1.icirnum = 1;
+#line 23362 ""
ici__1.icirlen = 80;
+#line 23362 ""
ici__1.iciunit = notexq;
/* Writing concatenation */
+#line 23362 ""
i__1[0] = 2, a__1[0] = "(f";
+#line 23362 ""
i__2 = ifmt + 48;
+#line 23362 ""
chax_(ch__1, (ftnlen)1, &i__2);
+#line 23362 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 23362 ""
i__1[2] = 3, a__1[2] = ".1)";
+#line 23362 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
+#line 23362 ""
s_wsfi(&ici__1);
+#line 23362 ""
do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real));
+#line 23362 ""
e_wsfi();
/* Writing concatenation */
+#line 23363 ""
i__3[0] = 1, a__2[0] = sq;
+#line 23363 ""
i__3[1] = 4, a__2[1] = "off{";
+#line 23363 ""
i__3[2] = ifmt, a__2[2] = notexq;
+#line 23363 ""
i__3[3] = 3, a__2[3] = "pt}";
+#line 23363 ""
s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88);
+#line 23363 ""
i__2 = ifmt + 8;
+#line 23363 ""
addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80);
+#line 23365 ""
return 0;
} /* putshft_ */
@@ -35463,9 +57417,9 @@ L5:
static integer lenline;
/* Fortran I/O blocks */
- static cilist io___1592 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1595 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1598 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1640 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1643 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1646 = { 0, 11, 0, "(a)", 0 };
@@ -35473,192 +57427,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 23384 ""
/* Parameter adjustments */
+#line 23384 ""
--sepsymq;
+#line 23384 ""
+#line 23384 ""
/* Function Body */
/* Writing concatenation */
+#line 23384 ""
i__1[0] = 1, a__1[0] = sq;
+#line 23384 ""
i__1[1] = 6, a__1[1] = "znotes";
+#line 23384 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23385 ""
lenline = 7;
+#line 23386 ""
i__2 = *nv - 1;
+#line 23386 ""
for (iv = 1; iv <= i__2; ++iv) {
/* Writing concatenation */
+#line 23387 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23387 ""
i__1[1] = 1, a__1[1] = sepsymq + iv;
+#line 23387 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23388 ""
++lenline;
+#line 23389 ""
/* L22: */
+#line 23389 ""
}
/* Writing concatenation */
+#line 23390 ""
i__3[0] = lenline, a__2[0] = notexq;
+#line 23390 ""
i__3[1] = 1, a__2[1] = sq;
+#line 23390 ""
i__3[2] = 10, a__2[2] = "zcharnote{";
+#line 23390 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
+#line 23391 ""
lenline += 11;
+#line 23392 ""
if (! comtitl_1.headlog) {
+#line 23393 ""
comtitl_1.inhead = *inhnoh;
+#line 23394 ""
}
+#line 23395 ""
if (*vshrink && comlast_1.usevshrink) {
+#line 23396 ""
comtitl_1.inhead = 16;
+#line 23397 ""
}
+#line 23398 ""
r__1 = comtitl_1.inhead + .01f;
+#line 23398 ""
ndig = (integer) r_lg10(&r__1) + 1;
+#line 23399 ""
i__2 = lenline;
+#line 23399 ""
ici__1.icierr = 0;
+#line 23399 ""
ici__1.icirnum = 1;
+#line 23399 ""
ici__1.icirlen = lenline + ndig + 10 - i__2;
+#line 23399 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
+#line 23399 ""
i__3[0] = 2, a__2[0] = "(i";
+#line 23399 ""
i__4 = ndig + 48;
+#line 23399 ""
chax_(ch__2, (ftnlen)1, &i__4);
+#line 23399 ""
i__3[1] = 1, a__2[1] = ch__2;
+#line 23399 ""
i__3[2] = 5, a__2[2] = ",a10)";
+#line 23399 ""
ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1);
+#line 23399 ""
s_wsfi(&ici__1);
+#line 23399 ""
do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 23399 ""
i__5[0] = 2, a__3[0] = "}{";
+#line 23399 ""
i__5[1] = 1, a__3[1] = sq;
+#line 23399 ""
i__5[2] = 7, a__3[2] = "titles{";
+#line 23399 ""
s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10);
+#line 23399 ""
do_fio(&c__1, ch__3, (ftnlen)10);
+#line 23399 ""
e_wsfi();
+#line 23401 ""
lenline = lenline + ndig + 10;
/* Vertical skip at top of page (\Il) = etatop*glueil. Needed whether */
/* headers are present or not. */
+#line 23406 ""
glueil = *xnsttop / *etatop;
+#line 23407 ""
vskil = *etatop * glueil;
+#line 23408 ""
if (*vshrink && comlast_1.usevshrink) {
+#line 23408 ""
vskil = 2.f;
+#line 23408 ""
}
+#line 23409 ""
writflot_(&vskil, notexq, &lenline, (ftnlen)127);
+#line 23410 ""
if (! comtitl_1.headlog) {
+#line 23411 ""
if (comlast_1.islast) {
- s_wsfe(&io___1592);
+#line 23411 ""
+ s_wsfe(&io___1640);
/* Writing concatenation */
+#line 23411 ""
i__6[0] = lenline, a__4[0] = notexq;
+#line 23411 ""
i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}";
+#line 23411 ""
i__6[2] = 1, a__4[2] = sq;
+#line 23411 ""
i__6[3] = 3, a__4[3] = "en%";
+#line 23411 ""
s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148);
+#line 23411 ""
do_fio(&c__1, ch__4, lenline + 21);
+#line 23411 ""
e_wsfe();
+#line 23411 ""
}
+#line 23413 ""
} else {
/* Writing concatenation */
+#line 23414 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23414 ""
i__1[1] = 2, a__1[1] = "}{";
+#line 23414 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23415 ""
lenline += 2;
+#line 23416 ""
lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120);
+#line 23417 ""
if (lcq > 0) {
+#line 23418 ""
xitil = *etait * glueil;
+#line 23419 ""
if (*vshrink && comlast_1.usevshrink) {
+#line 23419 ""
xitil = 2.f;
+#line 23419 ""
}
/* Writing concatenation */
+#line 23420 ""
i__3[0] = lenline, a__2[0] = notexq;
+#line 23420 ""
i__3[1] = lcq, a__2[1] = comtitl_1.instrq;
+#line 23420 ""
i__3[2] = 2, a__2[2] = "}{";
+#line 23420 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
/* Null out instrument once used */
+#line 23424 ""
s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1);
+#line 23425 ""
lenline = lenline + lcq + 2;
+#line 23426 ""
writflot_(&xitil, notexq, &lenline, (ftnlen)127);
+#line 23427 ""
} else {
/* Writing concatenation */
+#line 23428 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23428 ""
i__1[1] = 3, a__1[1] = "}{0";
+#line 23428 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23429 ""
lenline += 3;
+#line 23430 ""
}
+#line 23431 ""
if (comlast_1.islast) {
- s_wsfe(&io___1595);
+#line 23431 ""
+ s_wsfe(&io___1643);
/* Writing concatenation */
+#line 23431 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23431 ""
i__1[1] = 2, a__1[1] = "}%";
+#line 23431 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129);
+#line 23431 ""
do_fio(&c__1, ch__5, lenline + 2);
+#line 23431 ""
e_wsfe();
+#line 23431 ""
}
+#line 23432 ""
s_copy(notexq, "{", (ftnlen)127, (ftnlen)1);
+#line 23433 ""
lenline = 1;
+#line 23434 ""
lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120);
+#line 23435 ""
if (lcq > 0) {
/* Writing concatenation */
+#line 23436 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23436 ""
i__1[1] = lcq, a__1[1] = comtitl_1.titleq;
+#line 23436 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23437 ""
lenline += lcq;
+#line 23438 ""
} else {
+#line 23439 ""
printl_(" ", (ftnlen)1);
+#line 23440 ""
printl_("WARNING", (ftnlen)7);
+#line 23441 ""
printl_(" In a title block, you have specified instrument and/or"
, (ftnlen)56);
+#line 23443 ""
printl_(" composer but no title for the piece.", (ftnlen)38);
+#line 23445 ""
}
/* Writing concatenation */
+#line 23446 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23446 ""
i__1[1] = 2, a__1[1] = "}{";
+#line 23446 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23447 ""
lenline += 2;
+#line 23448 ""
xtcil = *etatc * glueil;
+#line 23449 ""
lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120);
+#line 23450 ""
if (lcq == 0) {
+#line 23450 ""
xtcil *= 2;
+#line 23450 ""
}
+#line 23451 ""
if (*vshrink && comlast_1.usevshrink) {
+#line 23451 ""
xtcil = 2.f;
+#line 23451 ""
}
+#line 23452 ""
writflot_(&xtcil, notexq, &lenline, (ftnlen)127);
/* Writing concatenation */
+#line 23453 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23453 ""
i__1[1] = 2, a__1[1] = "}{";
+#line 23453 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23454 ""
lenline += 2;
+#line 23455 ""
if (lcq > 0) {
/* Writing concatenation */
+#line 23456 ""
i__3[0] = lenline, a__2[0] = notexq;
+#line 23456 ""
i__3[1] = lcq, a__2[1] = comtitl_1.compoq;
+#line 23456 ""
i__3[2] = 2, a__2[2] = "}{";
+#line 23456 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
+#line 23457 ""
lenline = lenline + 2 + lcq;
/* Null out compoq so it does not get written later */
+#line 23461 ""
s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1);
+#line 23462 ""
xcsil = *etacs1 * glueil;
+#line 23463 ""
if (*vshrink && comlast_1.usevshrink) {
+#line 23463 ""
xcsil = 2.f;
+#line 23463 ""
}
+#line 23464 ""
writflot_(&xcsil, notexq, &lenline, (ftnlen)127);
+#line 23465 ""
} else {
/* Writing concatenation */
+#line 23466 ""
i__1[0] = lenline, a__1[0] = notexq;
+#line 23466 ""
i__1[1] = 3, a__1[1] = "}{0";
+#line 23466 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
+#line 23467 ""
lenline += 3;
+#line 23468 ""
}
+#line 23469 ""
if (comlast_1.islast) {
- s_wsfe(&io___1598);
+#line 23469 ""
+ s_wsfe(&io___1646);
/* Writing concatenation */
+#line 23469 ""
i__6[0] = lenline, a__4[0] = notexq;
+#line 23469 ""
i__6[1] = 2, a__4[1] = "}}";
+#line 23469 ""
i__6[2] = 1, a__4[2] = sq;
+#line 23469 ""
i__6[3] = 3, a__4[3] = "en%";
+#line 23469 ""
s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133);
+#line 23469 ""
do_fio(&c__1, ch__6, lenline + 6);
+#line 23469 ""
e_wsfe();
+#line 23469 ""
}
+#line 23470 ""
comtitl_1.headlog = FALSE_;
+#line 23471 ""
}
+#line 23472 ""
return 0;
} /* puttitle_ */
@@ -35694,120 +57808,218 @@ L5:
/* Places digit for xtuplet. */
+#line 23485 ""
if (*iflop != 0 && *multb > 0) {
/* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */
+#line 23489 ""
*eloff -= *iud * .5f * *wheadpt / *poenom;
/* Number goes on beam side, must use beam parameters to set pos'n */
+#line 23493 ""
*nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8);
+#line 23494 ""
if (*multb >= 2) {
+#line 23494 ""
*nlnum += *iup;
+#line 23494 ""
}
+#line 23495 ""
} else {
+#line 23496 ""
r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11;
+#line 23496 ""
*nlnum = i_nint(&r__1);
+#line 23497 ""
}
+#line 23498 ""
if (! bit_test(*islur,31)) {
/* Only print number when wanted. First check vert, horiz offset */
-/* if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 */
+#line 23502 ""
if (bit_test(*irest,1)) {
+#line 23502 ""
*nlnum = *nlnum + igetbits_(mult, &c__8, &c__16) - 64;
+#line 23502 ""
}
+#line 23503 ""
if (bit_test(*irest,7)) {
+#line 23503 ""
*eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * *
wheadpt / *poenom;
+#line 23503 ""
}
+#line 23505 ""
if (! (*usexnumt)) {
/* Writing concatenation */
+#line 23506 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 23506 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 23506 ""
i__1[1] = 5, a__1[1] = "xnum{";
+#line 23506 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 23507 ""
*lnote = 10;
+#line 23508 ""
istrtn = 7;
+#line 23509 ""
} else {
/* Writing concatenation */
+#line 23510 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 23510 ""
i__1[0] = 1, a__1[0] = ch__1;
+#line 23510 ""
i__1[1] = 6, a__1[1] = "xnumt{";
+#line 23510 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 23511 ""
*lnote = 11;
+#line 23512 ""
istrtn = 8;
+#line 23513 ""
}
+#line 23514 ""
if (*eloff < .995f) {
+#line 23515 ""
ici__1.icierr = 0;
+#line 23515 ""
ici__1.icirnum = 1;
+#line 23515 ""
ici__1.icirlen = 4;
+#line 23515 ""
ici__1.iciunit = notexq + (istrtn - 1);
+#line 23515 ""
ici__1.icifmt = "(i1,f3.2)";
+#line 23515 ""
s_wsfi(&ici__1);
+#line 23515 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 23515 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
+#line 23515 ""
e_wsfi();
+#line 23516 ""
} else if (*eloff < 9.995f) {
+#line 23517 ""
ici__1.icierr = 0;
+#line 23517 ""
ici__1.icirnum = 1;
+#line 23517 ""
ici__1.icirlen = 4;
+#line 23517 ""
ici__1.iciunit = notexq + (istrtn - 1);
+#line 23517 ""
ici__1.icifmt = "(f4.2)";
+#line 23517 ""
s_wsfi(&ici__1);
+#line 23517 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
+#line 23517 ""
e_wsfi();
+#line 23518 ""
} else {
+#line 23519 ""
ici__1.icierr = 0;
+#line 23519 ""
ici__1.icirnum = 1;
+#line 23519 ""
ici__1.icirlen = 5;
+#line 23519 ""
ici__1.iciunit = notexq + (istrtn - 1);
+#line 23519 ""
ici__1.icifmt = "(f5.2)";
+#line 23519 ""
s_wsfi(&ici__1);
+#line 23519 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
+#line 23519 ""
e_wsfi();
+#line 23520 ""
++(*lnote);
+#line 23521 ""
}
+#line 23522 ""
notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8);
/* Writing concatenation */
+#line 23523 ""
i__2[0] = *lnote, a__2[0] = notexq;
+#line 23523 ""
i__2[1] = 1, a__2[1] = "}";
+#line 23523 ""
i__2[2] = lnoten, a__2[2] = noteq;
+#line 23523 ""
s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
+#line 23524 ""
*lnote = *lnote + 1 + lnoten;
+#line 23525 ""
if (*ntupv < 10) {
+#line 23526 ""
i__3 = *lnote;
+#line 23526 ""
ici__1.icierr = 0;
+#line 23526 ""
ici__1.icirnum = 1;
+#line 23526 ""
ici__1.icirlen = *lnote + 1 - i__3;
+#line 23526 ""
ici__1.iciunit = notexq + i__3;
+#line 23526 ""
ici__1.icifmt = "(i1)";
+#line 23526 ""
s_wsfi(&ici__1);
+#line 23526 ""
do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
+#line 23526 ""
e_wsfi();
+#line 23527 ""
++(*lnote);
+#line 23528 ""
} else {
/* Writing concatenation */
+#line 23529 ""
i__1[0] = *lnote, a__1[0] = notexq;
+#line 23529 ""
i__1[1] = 1, a__1[1] = "{";
+#line 23529 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 23530 ""
i__3 = *lnote + 1;
+#line 23530 ""
ici__1.icierr = 0;
+#line 23530 ""
ici__1.icirnum = 1;
+#line 23530 ""
ici__1.icirlen = *lnote + 3 - i__3;
+#line 23530 ""
ici__1.iciunit = notexq + i__3;
+#line 23530 ""
ici__1.icifmt = "(i2)";
+#line 23530 ""
s_wsfi(&ici__1);
+#line 23530 ""
do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
+#line 23530 ""
e_wsfi();
/* Writing concatenation */
+#line 23531 ""
i__1[0] = *lnote + 3, a__1[0] = notexq;
+#line 23531 ""
i__1[1] = 1, a__1[1] = "}";
+#line 23531 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
+#line 23532 ""
*lnote += 4;
+#line 23533 ""
}
+#line 23534 ""
}
+#line 23535 ""
return 0;
} /* putxtn_ */
@@ -35821,62 +58033,97 @@ L5:
static integer ip1, ip2;
extern /* Subroutine */ int getbuf_(char *, ftnlen);
+#line 23549 ""
if (! commac_1.mplay) {
+#line 23550 ""
if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
+#line 23550 ""
goto L999;
+#line 23550 ""
}
+#line 23551 ""
getbuf_(string, string_len);
+#line 23552 ""
return 0;
+#line 23553 ""
L999:
+#line 23553 ""
*lastchar = TRUE_;
+#line 23554 ""
return 0;
+#line 23555 ""
} else {
/* Play a macro. Set pointer to first character needed in buffer */
+#line 23559 ""
if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) {
/* Getting first line of macro */
+#line 23563 ""
ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1];
+#line 23564 ""
c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1];
+#line 23565 ""
} else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) {
/* Beyond first line of macro. Advance line-start pointer. */
+#line 23569 ""
c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2];
+#line 23570 ""
ip1 = c1ommac_1.iplmac + 1;
+#line 23571 ""
} else {
/* Beyond last line of macro. Terminate it! */
+#line 23575 ""
commac_1.mplay = FALSE_;
+#line 23576 ""
commac_1.endmac = TRUE_;
+#line 23577 ""
return 0;
+#line 23578 ""
}
+#line 23579 ""
if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) {
/* Getting last line of macro. */
+#line 23583 ""
ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1];
+#line 23584 ""
} else {
/* Getting line before last line of macro. */
+#line 23588 ""
ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1];
+#line 23589 ""
}
+#line 23590 ""
if (ip2 >= ip1) {
+#line 23591 ""
s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1
- 1));
+#line 23592 ""
} else {
/* Kluge for when macro start is on a line by itself */
+#line 23596 ""
s_copy(string, " ", string_len, (ftnlen)1);
+#line 23597 ""
}
+#line 23598 ""
++c1ommac_1.ilmac;
+#line 23599 ""
return 0;
+#line 23600 ""
}
+#line 23601 ""
return 0;
} /* read10_ */
@@ -35905,7 +58152,7 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen
getchar_(char *, integer *, char *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1607 = { 0, 6, 0, 0, 0 };
+ static cilist io___1655 = { 0, 6, 0, 0, 0 };
@@ -35913,71 +58160,123 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen
/* file 10 (jobname.pmx) and increments nline if needed, passes over */
/* comment lines */
+#line 23610 ""
L4:
+#line 23610 ""
if (*iccount == 128) {
+#line 23611 ""
L1:
+#line 23611 ""
getbuf_(lineq, (ftnlen)128);
+#line 23612 ""
++(*nline);
+#line 23613 ""
if (*(unsigned char *)lineq == '%') {
+#line 23613 ""
goto L1;
+#line 23613 ""
}
+#line 23614 ""
*iccount = 0;
+#line 23615 ""
}
+#line 23616 ""
++(*iccount);
/* Find next non-blank or end of line */
+#line 23620 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
+#line 23621 ""
if (*(unsigned char *)&lineq[*iccount - 1] != ' ') {
+#line 23621 ""
goto L3;
+#line 23621 ""
}
+#line 23622 ""
/* L2: */
+#line 23622 ""
}
/* If here, need to get a new line */
+#line 23626 ""
*iccount = 128;
+#line 23627 ""
goto L4;
+#line 23628 ""
L3:
/* iccount now points to start of number to read */
+#line 23632 ""
i1 = *iccount;
+#line 23633 ""
L5:
+#line 23633 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar increments iccount, then reads a character. */
+#line 23637 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
+#line 23637 ""
goto L5;
+#line 23637 ""
}
+#line 23638 ""
i2 = *iccount - 1;
+#line 23639 ""
if (i2 < i1) {
- s_wsle(&io___1607);
+#line 23640 ""
+ s_wsle(&io___1655);
/* Writing concatenation */
+#line 23640 ""
i__1[0] = 7, a__1[0] = "Found \"";
+#line 23640 ""
i__1[1] = 1, a__1[1] = durq;
+#line 23640 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
+#line 23640 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
+#line 23640 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
+#line 23640 ""
e_wsle();
+#line 23641 ""
stop1_();
+#line 23642 ""
}
+#line 23643 ""
icf = i2 - i1 + 49;
+#line 23644 ""
ici__1.icierr = 0;
+#line 23644 ""
ici__1.iciend = 0;
+#line 23644 ""
ici__1.icirnum = 1;
+#line 23644 ""
ici__1.icirlen = i2 - (i1 - 1);
+#line 23644 ""
ici__1.iciunit = lineq + (i1 - 1);
/* Writing concatenation */
+#line 23644 ""
i__1[0] = 2, a__1[0] = "(f";
+#line 23644 ""
chax_(ch__3, (ftnlen)1, &icf);
+#line 23644 ""
i__1[1] = 1, a__1[1] = ch__3;
+#line 23644 ""
i__1[2] = 3, a__1[2] = ".0)";
+#line 23644 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
+#line 23644 ""
s_rsfi(&ici__1);
+#line 23644 ""
do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
+#line 23644 ""
e_rsfi();
+#line 23645 ""
return ret_val;
} /* readin_ */
@@ -36003,96 +58302,160 @@ L5:
extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
ftnlen);
+#line 23650 ""
i__1 = *iccount;
+#line 23650 ""
if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) {
/* No slashes, so use old method */
+#line 23654 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23655 ""
if (*(unsigned char *)durq == '-') {
/* Negative numerator is used only to printed; signals vertical slash */
+#line 23659 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23660 ""
*mtrnum = -(*(unsigned char *)durq - 48);
+#line 23661 ""
} else if (*(unsigned char *)durq == 'o') {
/* Numerator is EXACTLY 1 */
+#line 23665 ""
*mtrnum = 1;
+#line 23666 ""
} else {
+#line 23667 ""
*mtrnum = *(unsigned char *)durq - 48;
+#line 23668 ""
if (*mtrnum == 1) {
/* Numerator is >9 */
+#line 23672 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23673 ""
*mtrnum = *(unsigned char *)durq - 38;
+#line 23674 ""
}
+#line 23675 ""
}
+#line 23676 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23677 ""
if (*(unsigned char *)durq == 'o') {
+#line 23678 ""
*mtrden = 1;
+#line 23679 ""
} else {
+#line 23680 ""
*mtrden = *(unsigned char *)durq - 48;
+#line 23681 ""
if (*mtrden == 1) {
+#line 23682 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23683 ""
*mtrden = *(unsigned char *)durq - 38;
+#line 23684 ""
}
+#line 23685 ""
}
+#line 23686 ""
} else {
/* Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */
+#line 23690 ""
++(*iccount);
+#line 23691 ""
ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), (
ftnlen)1);
+#line 23692 ""
ici__1.icierr = 0;
+#line 23692 ""
ici__1.iciend = 0;
+#line 23692 ""
ici__1.icirnum = 1;
+#line 23692 ""
ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
+#line 23692 ""
ici__1.iciunit = lineq + (*iccount - 1);
/* Writing concatenation */
+#line 23692 ""
i__2[0] = 2, a__1[0] = "(i";
+#line 23692 ""
i__1 = ns + 47;
+#line 23692 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 23692 ""
i__2[1] = 1, a__1[1] = ch__2;
+#line 23692 ""
i__2[2] = 1, a__1[2] = ")";
+#line 23692 ""
ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
+#line 23692 ""
s_rsfi(&ici__1);
+#line 23692 ""
do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer));
+#line 23692 ""
e_rsfi();
/* Reset iccount to start of second integer */
+#line 23696 ""
*iccount += ns;
/* There must be either a slash or a blank at pos'n 2 or 3 */
+#line 23700 ""
ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1);
+#line 23701 ""
if (ns == 0) {
+#line 23701 ""
ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1);
+#line 23701 ""
}
+#line 23702 ""
ici__1.icierr = 0;
+#line 23702 ""
ici__1.iciend = 0;
+#line 23702 ""
ici__1.icirnum = 1;
+#line 23702 ""
ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
+#line 23702 ""
ici__1.iciunit = lineq + (*iccount - 1);
/* Writing concatenation */
+#line 23702 ""
i__2[0] = 2, a__1[0] = "(i";
+#line 23702 ""
i__1 = ns + 47;
+#line 23702 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 23702 ""
i__2[1] = 1, a__1[1] = ch__2;
+#line 23702 ""
i__2[2] = 1, a__1[2] = ")";
+#line 23702 ""
ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
+#line 23702 ""
s_rsfi(&ici__1);
+#line 23702 ""
do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer));
+#line 23702 ""
e_rsfi();
/* Set iccount to last character used */
+#line 23706 ""
*iccount = *iccount + ns - 1;
+#line 23707 ""
}
+#line 23708 ""
return 0;
} /* readmeter_ */
@@ -36119,7 +58482,7 @@ L5:
char *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1613 = { 0, 6, 0, 0, 0 };
+ static cilist io___1661 = { 0, 6, 0, 0, 0 };
@@ -36128,43 +58491,78 @@ L5:
/* call this routine *after* detecting a number or decimal. */
/* On exit, durq is next character after end of number. */
+#line 23719 ""
i1 = *iccount;
+#line 23720 ""
L1:
+#line 23720 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23721 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
+#line 23721 ""
goto L1;
+#line 23721 ""
}
+#line 23722 ""
i2 = *iccount - 1;
+#line 23723 ""
if (i2 < i1) {
- s_wsle(&io___1613);
+#line 23724 ""
+ s_wsle(&io___1661);
/* Writing concatenation */
+#line 23724 ""
i__1[0] = 7, a__1[0] = "Found \"";
+#line 23724 ""
i__1[1] = 1, a__1[1] = durq;
+#line 23724 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
+#line 23724 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
+#line 23724 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
+#line 23724 ""
e_wsle();
+#line 23725 ""
stop1_();
+#line 23726 ""
} else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)&
lineq[i2 - 1] == '.') {
+#line 23727 ""
--i2;
+#line 23728 ""
--(*iccount);
+#line 23729 ""
}
+#line 23730 ""
icf = i2 - i1 + 49;
+#line 23731 ""
ici__1.icierr = 0;
+#line 23731 ""
ici__1.iciend = 0;
+#line 23731 ""
ici__1.icirnum = 1;
+#line 23731 ""
ici__1.icirlen = i2 - (i1 - 1);
+#line 23731 ""
ici__1.iciunit = lineq + (i1 - 1);
/* Writing concatenation */
+#line 23731 ""
i__1[0] = 2, a__1[0] = "(f";
+#line 23731 ""
chax_(ch__3, (ftnlen)1, &icf);
+#line 23731 ""
i__1[1] = 1, a__1[1] = ch__3;
+#line 23731 ""
i__1[2] = 3, a__1[2] = ".0)";
+#line 23731 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
+#line 23731 ""
s_rsfi(&ici__1);
+#line 23731 ""
do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real));
+#line 23731 ""
e_rsfi();
+#line 23732 ""
return 0;
} /* readnum_ */
@@ -36172,37 +58570,21 @@ L1:
ishift, integer *ivalue)
{
/* Builtin functions */
- integer pow_ii(integer *, integer *), s_wsle(cilist *), e_wsle(void),
- do_lio(integer *, integer *, char *, ftnlen), s_wsfe(cilist *),
- do_fio(integer *, char *, ftnlen), e_wsfe(void), lbit_shift(
- integer, integer);
+ integer pow_ii(integer *, integer *), lbit_shift(integer, integer);
/* Local variables */
static integer ibase;
- /* Fortran I/O blocks */
- static cilist io___1616 = { 0, 6, 0, 0, 0 };
- static cilist io___1617 = { 0, 6, 0, 0, 0 };
- static cilist io___1618 = { 0, 15, 0, "(/,a)", 0 };
-
-
/* Sets iwidbits of isdata, shifted by ishift, to ivalue */
+#line 23738 ""
ibase = pow_ii(&c__2, iwidbit) - 1;
- if (*ivalue > ibase) {
- s_wsle(&io___1616);
- e_wsle();
- s_wsle(&io___1617);
- do_lio(&c__9, &c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34)
- ;
- e_wsle();
- s_wsfe(&io___1618);
- do_fio(&c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34);
- e_wsfe();
- }
+#line 23739 ""
*isdata = ~ lbit_shift(ibase, *ishift) & *isdata;
+#line 23740 ""
*isdata |= lbit_shift(*ivalue, *ishift);
+#line 23741 ""
return 0;
} /* setbits_ */
@@ -36224,54 +58606,97 @@ L1:
/* The MEAN SQUARE slope algorithm */
+#line 23763 ""
/* Parameter adjustments */
+#line 23763 ""
--ipb;
+#line 23763 ""
--xelsk;
+#line 23763 ""
+#line 23763 ""
/* Function Body */
+#line 23763 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
+#line 23764 ""
sumxx = 0.f;
+#line 23765 ""
sumxy = 0.f;
+#line 23766 ""
i__1 = *nnb;
+#line 23766 ""
for (inb = 1; inb <= i__1; ++inb) {
/* Computing 2nd power */
+#line 23767 ""
r__1 = xelsk[inb];
+#line 23767 ""
sumxx += r__1 * r__1;
+#line 23768 ""
sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
+#line 23769 ""
/* L2: */
+#line 23769 ""
}
+#line 23770 ""
delta = *nnb * sumxx - *sumx * *sumx;
+#line 23771 ""
em = (*nnb * sumxy - *sumx * *sumy) / delta;
+#line 23772 ""
r__1 = em * .5f * all_1.slfac;
+#line 23772 ""
*islope = i_nint(&r__1);
+#line 23773 ""
if (abs(*islope) > 9) {
+#line 23773 ""
*islope = i_sign(&c__9, islope);
+#line 23773 ""
}
+#line 23774 ""
beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb;
+#line 23775 ""
*nolev1 = i_nint(&beta);
/* Check if any stems are too short */
+#line 23779 ""
smin = 100.f;
+#line 23780 ""
iul = -1;
+#line 23781 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
+#line 23781 ""
iul = 1;
+#line 23781 ""
}
+#line 23782 ""
i__1 = *nnb;
+#line 23782 ""
for (inb = 1; inb <= i__1; ++inb) {
+#line 23783 ""
ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] /
all_1.slfac;
+#line 23784 ""
ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
/* Computing MIN */
+#line 23785 ""
r__1 = smin, r__2 = iul * (ybeam - ynote);
+#line 23785 ""
smin = dmin(r__1,r__2);
+#line 23786 ""
/* L4: */
+#line 23786 ""
}
+#line 23787 ""
if (smin < all_1.stemmin) {
+#line 23788 ""
deficit = all_1.stemmin - smin;
+#line 23789 ""
r__1 = *nolev1 + iul * deficit;
+#line 23789 ""
*nolev1 = i_nint(&r__1);
+#line 23790 ""
}
+#line 23791 ""
return 0;
} /* setbm2_ */
@@ -36299,102 +58724,165 @@ L1:
ftnlen), g1etchar_(char *, integer *, char *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1631 = { 0, 6, 0, 0, 0 };
- static cilist io___1632 = { 0, 6, 0, 0, 0 };
- static cilist io___1633 = { 0, 6, 0, 0, 0 };
+ static cilist io___1676 = { 0, 6, 0, 0, 0 };
+ static cilist io___1677 = { 0, 6, 0, 0, 0 };
+ static cilist io___1678 = { 0, 6, 0, 0, 0 };
/* Macro action */
+#line 23804 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 23805 ""
if (*(unsigned char *)charq == 'S' && *ivx != 1) {
- s_wsle(&io___1631);
+#line 23806 ""
+ s_wsle(&io___1676);
+#line 23806 ""
e_wsle();
- s_wsle(&io___1632);
+#line 23807 ""
+ s_wsle(&io___1677);
+#line 23807 ""
e_wsle();
- s_wsle(&io___1633);
+#line 23808 ""
+ s_wsle(&io___1678);
+#line 23808 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25);
+#line 23808 ""
e_wsle();
+#line 23809 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"
+#line 23809 ""
+ errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"\
"prt if in voice #1!", (ftnlen)128, (ftnlen)53);
+#line 23811 ""
}
+#line 23812 ""
if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 23813 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"
+#line 23813 ""
+ errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"\
")!", (ftnlen)128, (ftnlen)36);
+#line 23815 ""
stop1_();
+#line 23816 ""
} else if (*(unsigned char *)charq != ' ') {
/* Record or playback a macro. Get the number of the macro. */
+#line 23820 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 23821 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
+#line 23822 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""
+#line 23822 ""
+ errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""\
",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43);
+#line 23824 ""
stop1_();
+#line 23825 ""
}
+#line 23826 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 23827 ""
commac_1.macnum = i_nint(&fnum);
+#line 23828 ""
if (*(unsigned char *)durq != ' ') {
+#line 23829 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"
+#line 23829 ""
+ errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"\
" a blank!", (ftnlen)128, (ftnlen)41);
+#line 23831 ""
stop1_();
+#line 23832 ""
}
+#line 23833 ""
if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Record or save a macro */
+#line 23837 ""
if (commac_1.macnum < 1 || commac_1.macnum > 20) {
+#line 23838 ""
i__1 = *iccount - 1;
+#line 23838 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
+#line 23838 ""
errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!"
, (ftnlen)128, (ftnlen)31);
+#line 23840 ""
stop1_();
-/* else if (btest(macuse,macnum)) then */
-/* print* */
-/* print*,'WARNING: Redefining macro # ',macnum */
+#line 23841 ""
}
+#line 23842 ""
commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
+#line 23843 ""
if (*(unsigned char *)charq == 'R') {
+#line 23844 ""
m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
ftnlen)128);
+#line 23845 ""
} else if (*(unsigned char *)charq == 'S') {
/* Save (Record but don't activate) */
+#line 23849 ""
L1:
+#line 23849 ""
m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
ftnlen)128);
+#line 23850 ""
if (commac_1.mrecord) {
+#line 23851 ""
getbuf_(lineq, (ftnlen)128);
+#line 23852 ""
++(*nline);
+#line 23853 ""
*iccount = 0;
+#line 23854 ""
goto L1;
+#line 23855 ""
}
+#line 23856 ""
*iccount = *iccount + ndxm + 1;
+#line 23857 ""
}
+#line 23858 ""
} else {
/* Playback the macro */
+#line 23862 ""
if (! bit_test(commac_1.macuse,commac_1.macnum)) {
+#line 23863 ""
i__1 = *iccount - 1;
+#line 23863 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
- errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"
+#line 23863 ""
+ errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"\
"ot been recorded!", (ftnlen)128, (ftnlen)47);
+#line 23865 ""
stop1_();
+#line 23866 ""
}
+#line 23867 ""
commac_1.icchold = *iccount;
+#line 23868 ""
s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
+#line 23869 ""
*iccount = 128;
+#line 23870 ""
commac_1.mplay = TRUE_;
+#line 23871 ""
c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
+#line 23872 ""
}
+#line 23873 ""
}
+#line 23874 ""
return 0;
} /* setmac_ */
@@ -36409,36 +58897,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 23885 ""
if (*mtrdenl == 4) {
+#line 23886 ""
if (*mtrnuml % 3 == 0) {
+#line 23887 ""
*ibmtyp = 2;
+#line 23888 ""
*ibmrep = *mtrnuml / 3;
+#line 23889 ""
} else {
+#line 23890 ""
*ibmtyp = 1;
+#line 23891 ""
*ibmrep = *mtrnuml / 2;
+#line 23892 ""
}
+#line 23893 ""
} else if (*mtrdenl == 2) {
+#line 23894 ""
*ibmtyp = 1;
+#line 23895 ""
if (*mtrnuml == 3) {
+#line 23896 ""
*ibmrep = 3;
+#line 23897 ""
} else {
+#line 23898 ""
*ibmrep = (*mtrnuml << 1) / *mtrdenl;
+#line 23899 ""
}
+#line 23900 ""
+ } else if (*mtrdenl == 8 && (*mtrnuml == 8 || *mtrnuml == 4)) {
+
+/* Added 170726 */
+
+#line 23904 ""
+ *ibmtyp = 1;
+#line 23905 ""
+ *ibmrep = *mtrnuml / 4;
+#line 23906 ""
} else {
/* Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */
+#line 23910 ""
*ibmtyp = 3;
+#line 23911 ""
*ibmrep = *mtrnuml / 3;
+#line 23912 ""
}
/* Reset so we don't keep writing new meters */
+#line 23916 ""
*mtrnuml = 0;
/* Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter */
+#line 23920 ""
*ibmrep = max(*ibmrep,1);
+#line 23921 ""
return 0;
} /* setmeter_ */
@@ -36483,54 +59002,86 @@ L1:
/* The outer combo algorithm */
+#line 23955 ""
/* Parameter adjustments */
+#line 23955 ""
--ipb;
+#line 23955 ""
--xelsk;
+#line 23955 ""
+#line 23955 ""
/* Function Body */
+#line 23955 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
+#line 23956 ""
comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
+#line 23957 ""
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 23962 ""
comxtup_2.nssb[commvl_1.ivx - 1] = 0;
+#line 23963 ""
comxtup_2.issb[commvl_1.ivx - 1] = 0;
/* Set flag for xtup beam starting with rest (no others can start with rest) */
+#line 23967 ""
if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) {
+#line 23967 ""
*ixrest = 1;
+#line 23967 ""
}
/* Figure how many elemskips to each note. Use the list, counting only non-rests. */
+#line 23971 ""
eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]
* 24 - 25];
+#line 23972 ""
*nnb = 0;
+#line 23973 ""
*sumx = 0.f;
+#line 23974 ""
*sumy = 0.f;
+#line 23975 ""
ipxt1 = 0;
+#line 23976 ""
iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
+#line 23977 ""
i__1 = iplast;
+#line 23977 ""
for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) {
+#line 23978 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
+#line 23979 ""
++(*nnb);
+#line 23980 ""
ipb[*nnb] = ip;
+#line 23981 ""
xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0;
+#line 23982 ""
*sumx += xelsk[*nnb];
+#line 23983 ""
*sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25];
+#line 23984 ""
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 23989 ""
++comxtup_2.nssb[commvl_1.ivx - 1];
+#line 23990 ""
comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx
- 1] * 24 - 25] = *nnb;
+#line 23991 ""
}
+#line 23992 ""
}
/* New xtup stuff here. Final object is to get distance from start of xtup */
@@ -36538,137 +59089,220 @@ 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 23999 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
+#line 23999 ""
++ndoub;
+#line 23999 ""
}
+#line 24000 ""
if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
/* Xtup is starting here */
+#line 24004 ""
++comxtup_2.nxtinbm[commvl_1.ivx - 1];
+#line 24005 ""
ipxt1 = ip;
+#line 24006 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
+#line 24007 ""
ndoub = 1;
+#line 24008 ""
} else {
+#line 24009 ""
ndoub = 0;
+#line 24010 ""
}
+#line 24011 ""
} 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 24015 ""
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 24019 ""
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 24023 ""
ipxtmid = (ip + ipxt1) / 2;
+#line 24024 ""
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 24025 ""
if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx
- 1] * 24 - 25] % 2 == 0) {
+#line 24025 ""
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 24025 ""
}
+#line 24028 ""
ipxt1 = 0;
+#line 24029 ""
}
+#line 24030 ""
/* L2: */
+#line 24030 ""
}
/* Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */
+#line 24034 ""
comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
+#line 24035 ""
*smed = 0.f;
- if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) {
+/* if (.not.btest(islur(ivx,ipb(1)),2)) then */
+#line 24037 ""
+ if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *nnb >
+ 1) {
/* No forced 0 slope */
- if (*nnb == 1) {
- goto L6;
- }
+/* if (nnb .eq. 1) go to 6 */
+#line 24042 ""
nsc = 0;
+#line 24043 ""
i__1 = *nnb - 1;
+#line 24043 ""
for (inb = 1; inb <= i__1; ++inb) {
+#line 24044 ""
i__2 = *nnb;
+#line 24044 ""
for (jnb = inb + 1; jnb <= i__2; ++jnb) {
+#line 24045 ""
++nsc;
+#line 24046 ""
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 24048 ""
if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) {
+#line 24049 ""
++nsc;
+#line 24050 ""
slope[nsc - 1] = slope[nsc - 2];
+#line 24051 ""
++nsc;
+#line 24052 ""
slope[nsc - 1] = slope[nsc - 2];
+#line 24053 ""
}
+#line 24054 ""
/* L5: */
+#line 24054 ""
}
+#line 24054 ""
}
+#line 24055 ""
if (nsc == 1) {
+#line 24056 ""
*smed = slope[0];
+#line 24057 ""
goto L6;
+#line 24058 ""
}
+#line 24059 ""
nscmid = nsc / 2 + 1;
+#line 24060 ""
i__2 = nscmid;
+#line 24060 ""
for (i__ = 1; i__ <= i__2; ++i__) {
+#line 24061 ""
i__1 = nsc;
+#line 24061 ""
for (j = i__ + 1; j <= i__1; ++j) {
+#line 24062 ""
if (slope[j - 1] < slope[i__ - 1]) {
+#line 24063 ""
t = slope[j - 1];
+#line 24064 ""
slope[j - 1] = slope[i__ - 1];
+#line 24065 ""
slope[i__ - 1] = t;
+#line 24066 ""
}
+#line 24067 ""
/* L7: */
+#line 24067 ""
}
+#line 24067 ""
}
+#line 24068 ""
*smed = slope[nscmid - 1];
+#line 24069 ""
if (nsc == nsc / 2 << 1) {
/* Even number of slopes in the list, so median is ambiguous */
+#line 24073 ""
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 24077 ""
*smed = slope[nscmid - 2];
+#line 24078 ""
} 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 24082 ""
sum = 0.f;
+#line 24083 ""
i__1 = nsc;
+#line 24083 ""
for (i__ = 1; i__ <= i__1; ++i__) {
+#line 24084 ""
sum += slope[i__ - 1];
+#line 24085 ""
/* L1: */
+#line 24085 ""
}
+#line 24086 ""
*smed = r_sign(smed, &sum);
+#line 24087 ""
}
+#line 24088 ""
}
+#line 24089 ""
L6:
+#line 24090 ""
r__1 = *smed * .5f * all_1.slfac;
+#line 24090 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
+#line 24091 ""
if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) {
+#line 24091 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
comxtup_2.islope[commvl_1.ivx - 1]);
+#line 24091 ""
}
+#line 24093 ""
} else {
/* Forced horizontal beam */
+#line 24097 ""
comxtup_2.islope[commvl_1.ivx - 1] = 0;
+#line 24098 ""
}
+#line 24099 ""
beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx)
/ *nnb;
@@ -36676,111 +59310,177 @@ L6:
/* as is for placing xtup number and/or bracket, then reset it for start of */
/* actual beam */
+#line 24105 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta);
/* Check if any stems are too short */
+#line 24109 ""
smin = 100.f;
+#line 24110 ""
iul = -1;
+#line 24111 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
+#line 24111 ""
iul = 1;
+#line 24111 ""
}
+#line 24112 ""
ssq = 0.f;
+#line 24113 ""
syb = 0.f;
-/* yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) */
+#line 24114 ""
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 24116 ""
i__1 = *nnb;
+#line 24116 ""
for (inb = 1; inb <= i__1; ++inb) {
+#line 24117 ""
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);
-/* * -iul*bmhgt*(mult(ivx,ipb(inb))-1) */
+#line 24119 ""
syb += ybeam;
+#line 24120 ""
ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
+#line 24121 ""
off = ybeam - ynote;
+#line 24122 ""
if (inb == 1) {
+#line 24123 ""
off1 = off;
+#line 24124 ""
} else if (inb == *nnb) {
+#line 24125 ""
off2 = off;
+#line 24126 ""
}
+#line 24127 ""
ssq += off * off;
/* Computing MIN */
+#line 24128 ""
r__1 = smin, r__2 = iul * off;
+#line 24128 ""
smin = dmin(r__1,r__2);
+#line 24129 ""
/* L4: */
+#line 24129 ""
}
+#line 24130 ""
dnolev = 0.f;
+#line 24131 ""
if (smin < all_1.stemmin) {
+#line 24132 ""
deficit = all_1.stemmin - smin;
+#line 24133 ""
nolevo = comxtup_2.nolev1[commvl_1.ivx - 1];
+#line 24134 ""
r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit;
+#line 24134 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
+#line 24135 ""
dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo);
+#line 24136 ""
off1 += dnolev;
+#line 24137 ""
off2 += dnolev;
+#line 24138 ""
}
/* Computing 2nd power */
+#line 24139 ""
r__1 = dnolev;
+#line 24139 ""
ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1;
+#line 24140 ""
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] *
- 24 - 25],2)) {
+ 24 - 25],2) && *nnb != 1) {
+/* * .and. .not.btest(islur(ivx,ipb(1)),2)) then */
/* The first check is to save trouble of putting xtup's in setbm2. */
/* 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 24150 ""
setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[
commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]);
+#line 24151 ""
}
/* Check if beam starts or ends too high or low. */
-/* xboff = bmhgt*(mult(ivx,ipb(1))-1) */
+#line 24155 ""
xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 -
25]) - 9);
+#line 24156 ""
l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[
1])) + xboff + 7 < 0.f;
+#line 24157 ""
xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[
commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb];
+#line 24158 ""
l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f;
+#line 24159 ""
if (l1ng || l2ng) {
/* Need to correct start or stop, also slope */
+#line 24163 ""
if (l1ng) {
+#line 24164 ""
r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul;
+#line 24164 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
+#line 24165 ""
}
+#line 24166 ""
if (l2ng) {
+#line 24167 ""
r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul;
+#line 24167 ""
xnolev2 = (real) i_nint(&r__1);
+#line 24168 ""
}
/* Since one or the other end has changed, need to change slope */
- if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) {
+/* if (.not.btest(islur(ivx,ipb(1)),2)) */
+#line 24173 ""
+ if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *
+ nnb != 1) {
+#line 24173 ""
r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1]
) / xelsk[*nnb];
+#line 24173 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
+#line 24173 ""
}
+#line 24175 ""
}
+#line 24176 ""
if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) {
/* This is a single-slope beam group. Store start heights for later segs. */
+#line 24180 ""
i__1 = comxtup_2.nssb[commvl_1.ivx - 1];
+#line 24180 ""
for (issbs = 1; issbs <= i__1; ++issbs) {
+#line 24181 ""
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 24183 ""
/* L3: */
+#line 24183 ""
}
+#line 24184 ""
}
+#line 24185 ""
return 0;
} /* setupb_ */
@@ -36795,36 +59495,60 @@ L6:
/* Initialize ipoe: */
+#line 24194 ""
/* Parameter adjustments */
+#line 24194 ""
--ipoe;
+#line 24194 ""
--poe;
+#line 24194 ""
+#line 24194 ""
/* Function Body */
+#line 24194 ""
i__1 = *nsyst;
+#line 24194 ""
for (iord = 1; iord <= i__1; ++iord) {
+#line 24195 ""
ipoe[iord] = iord;
+#line 24196 ""
/* L3: */
+#line 24196 ""
}
/* 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 24201 ""
i__1 = *nsyst - 1;
+#line 24201 ""
for (io1 = 1; io1 <= i__1; ++io1) {
+#line 24202 ""
i__2 = *nsyst;
+#line 24202 ""
for (io2 = io1 + 1; io2 <= i__2; ++io2) {
+#line 24203 ""
if (poe[ipoe[io1]] > poe[ipoe[io2]]) {
/* Interchange the indices */
+#line 24207 ""
itemp = ipoe[io1];
+#line 24208 ""
ipoe[io1] = ipoe[io2];
+#line 24209 ""
ipoe[io2] = itemp;
+#line 24210 ""
}
+#line 24211 ""
/* L5: */
+#line 24211 ""
}
+#line 24212 ""
/* L4: */
+#line 24212 ""
}
+#line 24213 ""
return 0;
} /* sortpoe_ */
@@ -36861,287 +59585,488 @@ L6:
/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */
+#line 24238 ""
/* Parameter adjustments */
+#line 24238 ""
--isdat4;
+#line 24238 ""
--isdat3;
+#line 24238 ""
--isdat2;
+#line 24238 ""
--isdat1;
+#line 24238 ""
+#line 24238 ""
/* Function Body */
+#line 24238 ""
numint = 0;
+#line 24239 ""
ivoff = 0;
+#line 24240 ""
ihoff = 0;
+#line 24241 ""
++(*nsdat);
+#line 24242 ""
if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
{
+#line 24242 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
+#line 24242 ""
}
+#line 24244 ""
setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
+#line 24245 ""
i__1 = *kv - 1;
+#line 24245 ""
setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
+#line 24246 ""
setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
+#line 24247 ""
isdat3[*nsdat] = 0;
+#line 24248 ""
isdat4[*nsdat] = 0;
+#line 24249 ""
ilb12 = 0;
/* Get ID code */
/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */
+#line 24253 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* if (index('uldtb+-hfnHps ',durq) .gt. 0) then */
+#line 24255 ""
if (i_indx("uldtb+-hfnHpsv ", durq, (ftnlen)15, (ftnlen)1) > 0) {
/* Null id. Note for ps slurs, 'H' cannot be an ID */
+#line 24259 ""
--(*iccount);
+#line 24260 ""
if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
+#line 24261 ""
idcode = 1;
+#line 24262 ""
} else {
+#line 24263 ""
idcode = 32;
+#line 24264 ""
}
+#line 24265 ""
} else {
/* Set explicit idcode */
+#line 24269 ""
idcode = *(unsigned char *)durq;
+#line 24270 ""
i__1 = *iccount - 2;
+#line 24270 ""
if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) {
/* Make t[ID] look like s[ID]t */
+#line 24274 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
+#line 24275 ""
+ }
+#line 24276 ""
+ i__1 = *iccount;
+#line 24276 ""
+ if (s_cmp(lineq + i__1, "x", *iccount + 1 - i__1, (ftnlen)1) == 0) {
+
+/* Flag for 2-voice, indexed slurs */
+
+#line 24280 ""
+ ++(*iccount);
+#line 24281 ""
+ setbits_(&isdat1[*nsdat], &c__1, &c__1, &c__1);
+#line 24282 ""
}
+#line 24283 ""
}
+#line 24284 ""
setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
/* Set start/stop: look thru list from end for same idcode,iv,kv */
+#line 24288 ""
for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
+#line 24289 ""
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)) {
+ igetbits_(&isdat1[isdat], &c__5, &c__13) && (*kv - 1 ==
+ igetbits_(&isdat1[isdat], &c__1, &c__12) || bit_test(isdat1[
+ isdat],1))) {
+/* * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then */
/* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */
+#line 24297 ""
if (bit_test(isdat1[isdat],11)) {
+#line 24297 ""
goto L3;
+#line 24297 ""
}
/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */
+#line 24301 ""
goto L4;
+#line 24302 ""
}
+#line 24303 ""
/* L2: */
+#line 24303 ""
}
/* If here, this is turnon. */
+#line 24307 ""
L4:
+#line 24308 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
+#line 24309 ""
L3:
/* Now done with initial turnon- or turnoff-specifics. */
+#line 24313 ""
if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) {
/* There's a default curvature tweak */
+#line 24317 ""
icurv1 = i_nint(&comslur_1.slurcurve) + 3;
+#line 24318 ""
if (icurv1 == 2) {
+#line 24318 ""
icurv1 = 1;
+#line 24318 ""
}
+#line 24319 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
+#line 24320 ""
i__1 = icurv1 + 32;
+#line 24320 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
+#line 24321 ""
}
/* Loop for rest of input */
+#line 24325 ""
L1:
+#line 24325 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 24326 ""
if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Force direction */
+#line 24330 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
+#line 24331 ""
if (*(unsigned char *)durq == 'u') {
+#line 24331 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
+#line 24331 ""
}
+#line 24332 ""
goto L1;
+#line 24333 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 24334 ""
++numint;
+#line 24335 ""
if (numint == 1) {
/* Vertical offset */
+#line 24339 ""
++(*iccount);
+#line 24340 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24341 ""
--(*iccount);
+#line 24342 ""
ivoff = i_nint(&fnum);
+#line 24343 ""
if (*(unsigned char *)durq == '-') {
+#line 24343 ""
ivoff = -ivoff;
+#line 24343 ""
}
+#line 24344 ""
} else if (numint == 2) {
/* Horizontal offset */
+#line 24348 ""
++(*iccount);
+#line 24349 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24350 ""
--(*iccount);
/* fnum is abs(hshift), must be 0 to 6.3 */
+#line 24354 ""
ihoff = fnum * 10 + .5f;
+#line 24355 ""
if (*(unsigned char *)durq == '-') {
+#line 24355 ""
ihoff = -ihoff;
+#line 24355 ""
}
/* Later will set bits to 1...127 to represent -6.3,...+6.3 */
+#line 24359 ""
} else {
/* Must be the 3rd signed integer, so it's a curve specification */
+#line 24363 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
+#line 24364 ""
++(*iccount);
+#line 24365 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24366 ""
icurv1 = i_nint(&fnum);
+#line 24367 ""
if (*(unsigned char *)durq == '-') {
+#line 24367 ""
icurv1 = -icurv1;
+#line 24367 ""
}
+#line 24368 ""
i__1 = icurv1 + 32;
+#line 24368 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
+#line 24369 ""
if (*(unsigned char *)dumq != ':') {
/* Back up the pointer and loop for more input */
+#line 24373 ""
--(*iccount);
+#line 24374 ""
} else {
/* Expect two single digits as parameters for curve */
+#line 24378 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
+#line 24379 ""
i__1 = *iccount;
+#line 24379 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
+#line 24379 ""
setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
+#line 24381 ""
i__1 = *iccount + 1;
+#line 24381 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
+#line 24381 ""
setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
+#line 24383 ""
*iccount += 2;
+#line 24384 ""
}
+#line 24385 ""
}
+#line 24386 ""
goto L1;
+#line 24387 ""
} else if (*(unsigned char *)durq == 't') {
+#line 24388 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
+#line 24389 ""
goto L1;
+#line 24390 ""
} else if (*(unsigned char *)durq == 'b') {
+#line 24391 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
+#line 24392 ""
goto L1;
+#line 24393 ""
} else if (*(unsigned char *)durq == 's') {
/* Endpoint tweaks for linebreak slurs. */
+#line 24397 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Next is vertical offset */
/* Must be +|- */
+#line 24401 ""
++(*iccount);
+#line 24402 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24403 ""
if (*(unsigned char *)durq == '-') {
+#line 24403 ""
fnum = -fnum;
+#line 24403 ""
}
+#line 24404 ""
i__1 = ilb12 << 4;
+#line 24404 ""
i__2 = i_nint(&fnum) + 32;
+#line 24404 ""
setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2);
+#line 24405 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Also a horizontal offset */
+#line 24409 ""
++(*iccount);
+#line 24410 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24411 ""
if (*(unsigned char *)dumq == '-') {
+#line 24411 ""
fnum = -fnum;
+#line 24411 ""
}
+#line 24412 ""
i__1 = (ilb12 << 4) + 6;
+#line 24412 ""
r__1 = fnum * 10;
+#line 24412 ""
i__2 = i_nint(&r__1) + 64;
+#line 24412 ""
setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2);
+#line 24413 ""
}
+#line 24414 ""
--(*iccount);
+#line 24415 ""
ilb12 = 1;
+#line 24416 ""
goto L1;
+#line 24417 ""
} 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 24422 ""
icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1);
+#line 24423 ""
if (icurv1 == 5) {
/* check for 2nd H */
+#line 24427 ""
i__1 = *iccount;
+#line 24427 ""
if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
{
+#line 24428 ""
++(*iccount);
+#line 24429 ""
icurv1 = 6;
+#line 24430 ""
}
+#line 24431 ""
}
+#line 24432 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
+#line 24433 ""
i__1 = icurv1 + 32;
+#line 24433 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
+#line 24434 ""
goto L1;
+#line 24435 ""
} else if (*(unsigned char *)durq == 'p') {
/* Local adjustment */
+#line 24436 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* +|- */
+#line 24437 ""
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 24442 ""
if (*(unsigned char *)durq == '+') {
+#line 24443 ""
if (*(unsigned char *)dumq == 's') {
+#line 24444 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],26);
+#line 24445 ""
} else {
+#line 24446 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],28);
+#line 24447 ""
}
+#line 24448 ""
} else {
+#line 24449 ""
if (*(unsigned char *)dumq == 's') {
+#line 24450 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],27);
+#line 24451 ""
} else {
+#line 24452 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],29);
+#line 24453 ""
}
+#line 24454 ""
}
+#line 24455 ""
goto L1;
+#line 24456 ""
} else if (*(unsigned char *)durq == 'v') {
/* Stem slur */
+#line 24457 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],2);
+#line 24458 ""
goto L1;
+#line 24459 ""
}
/* Record shifts */
+#line 24463 ""
i__1 = ivoff + 32;
+#line 24463 ""
setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
+#line 24464 ""
i__1 = ihoff + 64;
+#line 24464 ""
setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
/* Record chord flag, note level, notehead shift */
+#line 24468 ""
if (*notcrd) {
+#line 24469 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
+#line 24470 ""
} else {
+#line 24471 ""
nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
c__12);
+#line 24472 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
+#line 24473 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
+#line 24474 ""
i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
c__23);
+#line 24474 ""
setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
+#line 24475 ""
}
+#line 24476 ""
return 0;
} /* spsslur_ */
@@ -37176,215 +60101,346 @@ L1:
/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */
+#line 24501 ""
/* Parameter adjustments */
+#line 24501 ""
--isdat3;
+#line 24501 ""
--isdat2;
+#line 24501 ""
--isdat1;
+#line 24501 ""
+#line 24501 ""
/* Function Body */
+#line 24501 ""
numint = 0;
+#line 24502 ""
ivoff = 0;
+#line 24503 ""
ihoff = 0;
+#line 24504 ""
++(*nsdat);
+#line 24505 ""
if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
{
+#line 24505 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
+#line 24505 ""
}
+#line 24507 ""
setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
+#line 24508 ""
i__1 = *kv - 1;
+#line 24508 ""
setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
+#line 24509 ""
setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
+#line 24510 ""
isdat3[*nsdat] = 0;
/* Get id letter */
+#line 24514 ""
if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
/* Old-style t-slur. Use special idcode = 1 */
+#line 24518 ""
idcode = 1;
+#line 24519 ""
} else {
+#line 24520 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 24521 ""
if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) {
/* Null id */
+#line 24525 ""
idcode = 32;
+#line 24526 ""
--(*iccount);
+#line 24527 ""
} else if (*(unsigned char *)durq == 'H') {
/* Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */
+#line 24531 ""
idcode = 32;
+#line 24532 ""
--(*iccount);
/* There may be another "H", but no need to deal with it yet */
+#line 24536 ""
} else {
/* Set explicit idcode */
+#line 24540 ""
idcode = *(unsigned char *)durq;
+#line 24541 ""
}
+#line 24542 ""
}
+#line 24543 ""
setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
/* Set start/stop: look thru list from end for same idcode,iv,kv */
+#line 24547 ""
for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
+#line 24548 ""
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 24554 ""
if (bit_test(isdat1[isdat],11)) {
+#line 24554 ""
goto L3;
+#line 24554 ""
}
/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */
+#line 24558 ""
goto L4;
+#line 24559 ""
}
+#line 24560 ""
/* L2: */
+#line 24560 ""
}
/* If here, this is turnon. */
+#line 24564 ""
L4:
+#line 24565 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
+#line 24566 ""
L3:
/* Now done with initial turnon- or turnoff-specifics. Loop for rest of input */
+#line 24570 ""
L1:
+#line 24570 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 24571 ""
if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Force direction */
+#line 24575 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
+#line 24576 ""
if (*(unsigned char *)durq == 'u') {
+#line 24576 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
+#line 24576 ""
}
+#line 24577 ""
goto L1;
+#line 24578 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 24579 ""
++numint;
+#line 24580 ""
if (numint == 1) {
/* Vertical offset */
+#line 24584 ""
++(*iccount);
+#line 24585 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24586 ""
--(*iccount);
+#line 24587 ""
ivoff = i_nint(&fnum);
+#line 24588 ""
if (*(unsigned char *)durq == '-') {
+#line 24588 ""
ivoff = -ivoff;
+#line 24588 ""
}
+#line 24589 ""
} else if (numint == 2) {
/* Horizontal offset */
+#line 24593 ""
++(*iccount);
+#line 24594 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24595 ""
--(*iccount);
/* fnum is abs(hshift), must be 0 to 6.3 */
+#line 24599 ""
ihoff = fnum * 10 + .5f;
+#line 24600 ""
if (*(unsigned char *)durq == '-') {
+#line 24600 ""
ihoff = -ihoff;
+#line 24600 ""
}
/* Later will set bits to 1...127 to represent -6.3,...+6.3 */
+#line 24604 ""
} else {
/* Must be the 3rd signed integer, so it's a curve specification */
+#line 24608 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
+#line 24609 ""
++(*iccount);
+#line 24610 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
+#line 24611 ""
icurv1 = i_nint(&fnum);
+#line 24612 ""
if (*(unsigned char *)durq == '-') {
+#line 24612 ""
icurv1 = -icurv1;
+#line 24612 ""
}
+#line 24613 ""
i__1 = icurv1 + 32;
+#line 24613 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
+#line 24614 ""
if (*(unsigned char *)dumq != ':') {
/* Back up the pointer and loop for more input */
+#line 24618 ""
--(*iccount);
+#line 24619 ""
} else {
/* Expect two single digits as parameters for curve */
+#line 24623 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
+#line 24624 ""
i__1 = *iccount;
+#line 24624 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
+#line 24624 ""
setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
+#line 24626 ""
i__1 = *iccount + 1;
+#line 24626 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
+#line 24626 ""
setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
+#line 24628 ""
*iccount += 2;
+#line 24629 ""
}
+#line 24630 ""
}
+#line 24631 ""
goto L1;
+#line 24632 ""
} else if (*(unsigned char *)durq == 't') {
+#line 24633 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
+#line 24634 ""
goto L1;
+#line 24635 ""
} else if (*(unsigned char *)durq == 'b') {
+#line 24636 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
+#line 24637 ""
goto L1;
+#line 24638 ""
} 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 24642 ""
icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2;
+#line 24643 ""
if (icurv1 == 3) {
+#line 24644 ""
icurv1 = 1;
+#line 24645 ""
} else if (icurv1 == 5) {
/* check for 2nd H */
+#line 24649 ""
i__1 = *iccount;
+#line 24649 ""
if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
{
+#line 24650 ""
++(*iccount);
+#line 24651 ""
icurv1 = 6;
+#line 24652 ""
}
+#line 24653 ""
}
+#line 24654 ""
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 24659 ""
i__1 = icurv1 + 32;
+#line 24659 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
+#line 24660 ""
goto L1;
+#line 24661 ""
}
/* Record shifts */
+#line 24665 ""
i__1 = ivoff + 32;
+#line 24665 ""
setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
+#line 24666 ""
i__1 = ihoff + 64;
+#line 24666 ""
setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
/* Record chord flag, note level, notehead shift */
+#line 24670 ""
if (*notcrd) {
+#line 24671 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
+#line 24672 ""
} else {
+#line 24673 ""
nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
c__12);
+#line 24674 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
+#line 24675 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
+#line 24676 ""
i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
c__23);
+#line 24676 ""
setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
+#line 24677 ""
}
+#line 24678 ""
return 0;
} /* sslur_ */
@@ -37392,7 +60448,9 @@ L1:
{
extern /* Subroutine */ int exit_(integer *);
+#line 24681 ""
exit_(&c__1);
+#line 24682 ""
return 0;
} /* stop1_ */
@@ -37431,6 +60489,7 @@ L1:
static char fmtq[24];
extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *,
logical *);
+ static real facis;
static char fbarq[5];
static integer lname, lfmtq, iinst;
static char clefqiv[1];
@@ -37439,188 +60498,299 @@ L1:
static integer nstaves;
/* Fortran I/O blocks */
- static cilist io___1698 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1699 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1700 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1701 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1702 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1703 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1704 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1705 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1706 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1707 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1708 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1709 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1710 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1711 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1712 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1714 = { 0, 11, 0, "(a8,i1,a)", 0 };
- static cilist io___1715 = { 0, 11, 0, "(a9,i2,a)", 0 };
- static cilist io___1716 = { 0, 11, 0, "(a8,i1,a)", 0 };
- static cilist io___1717 = { 0, 11, 0, "(a9,i2,a)", 0 };
- static icilist io___1719 = { 0, fbarq, 0, "(f5.3)", 5, 1 };
- static cilist io___1720 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1721 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1722 = { 0, 11, 0, "(a7,i3,a2)", 0 };
- static cilist io___1723 = { 0, 11, 0, "(a8,i3,a2)", 0 };
- static cilist io___1724 = { 0, 11, 0, "(a8,i2,a2)", 0 };
- static cilist io___1725 = { 0, 11, 0, "(a8,i1,a2)", 0 };
- static cilist io___1726 = { 0, 11, 0, "(a8,i2,a2)", 0 };
- static cilist io___1727 = { 0, 11, 0, "(a8,i3,a2)", 0 };
- static cilist io___1728 = { 0, 11, 0, "(a8,i2,a2)", 0 };
- static cilist io___1729 = { 0, 11, 0, "(a8,i1,a2)", 0 };
- static cilist io___1730 = { 0, 11, 0, "(a8,i2,a2)", 0 };
- static cilist io___1731 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1732 = { 0, 11, 0, "(a19,i1,a1)", 0 };
- static cilist io___1733 = { 0, 11, 0, "(a19,i2,a1)", 0 };
- static cilist io___1736 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1737 = { 0, 11, 0, "(a11,i2,a)", 0 };
- static cilist io___1742 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1743 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___1743 = { 0, 11, 0, "(a)", 0 };
static cilist io___1744 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1745 = { 0, 11, 0, "(a21,i2,a)", 0 };
- static cilist io___1747 = { 0, 11, 0, "(a8,i1,a)", 0 };
- static cilist io___1748 = { 0, 11, 0, "(a9,i2,a)", 0 };
- static cilist io___1749 = { 0, 11, 0, "(a18,i2,a2)", 0 };
- static cilist io___1751 = { 0, 11, 0, "(a11,i1,a2)", 0 };
- static cilist io___1752 = { 0, 11, 0, "(a11,i2,a2)", 0 };
- static cilist io___1753 = { 0, 11, 0, "(a11,i3,a2)", 0 };
+ static cilist io___1745 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1746 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1747 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1748 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1749 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1750 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1751 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1752 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1753 = { 0, 11, 0, "(a)", 0 };
static cilist io___1754 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1755 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1755 = { 0, 11, 0, "(a)", 0 };
static cilist io___1756 = { 0, 11, 0, "(a)", 0 };
static cilist io___1757 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1758 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1759 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1760 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1761 = { 0, 11, 0, "(a)", 0 };
-
-
+ static cilist io___1759 = { 0, 11, 0, "(a8,i1,a)", 0 };
+ static cilist io___1760 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___1761 = { 0, 11, 0, "(a8,i1,a)", 0 };
+ static cilist io___1762 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static icilist io___1764 = { 0, fbarq, 0, "(f5.3)", 5, 1 };
+ static cilist io___1765 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1766 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1767 = { 0, 11, 0, "(a7,i3,a2)", 0 };
+ static cilist io___1768 = { 0, 11, 0, "(a8,i3,a2)", 0 };
+ static cilist io___1769 = { 0, 11, 0, "(a8,i2,a2)", 0 };
+ static cilist io___1770 = { 0, 11, 0, "(a8,i1,a2)", 0 };
+ static cilist io___1771 = { 0, 11, 0, "(a8,i2,a2)", 0 };
+ static cilist io___1772 = { 0, 11, 0, "(a8,i3,a2)", 0 };
+ static cilist io___1773 = { 0, 11, 0, "(a8,i2,a2)", 0 };
+ static cilist io___1774 = { 0, 11, 0, "(a8,i1,a2)", 0 };
+ static cilist io___1775 = { 0, 11, 0, "(a8,i2,a2)", 0 };
+ static cilist io___1776 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1777 = { 0, 11, 0, "(a19,i1,a1)", 0 };
+ static cilist io___1778 = { 0, 11, 0, "(a19,i2,a1)", 0 };
+ static cilist io___1781 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1782 = { 0, 11, 0, "(a11,i2,a)", 0 };
+ static cilist io___1787 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1788 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___1789 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1790 = { 0, 11, 0, "(a21,i2,a)", 0 };
+ static cilist io___1792 = { 0, 11, 0, "(a8,i1,a)", 0 };
+ static cilist io___1793 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___1794 = { 0, 11, 0, "(a18,i2,a2)", 0 };
+ static cilist io___1796 = { 0, 11, 0, "(a11,i1,a2)", 0 };
+ static cilist io___1797 = { 0, 11, 0, "(a11,i2,a2)", 0 };
+ static cilist io___1798 = { 0, 11, 0, "(a11,i3,a2)", 0 };
+ static cilist io___1799 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1801 = { 0, 11, 0, fmtq, 0 };
+ static cilist io___1802 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1803 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1804 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1805 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1806 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1807 = { 0, 11, 0, "(a)", 0 };
+
+
+#line 24709 ""
/* Parameter adjustments */
+#line 24709 ""
--clefq;
+#line 24709 ""
+#line 24709 ""
/* Function Body */
+#line 24709 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 24709 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 24710 ""
*vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop;
+#line 24711 ""
if (*vshrink) {
+#line 24712 ""
comarp_1.xinsnow = 10.f;
+#line 24713 ""
} else {
+#line 24714 ""
comarp_1.xinsnow = *xinstf1;
+#line 24715 ""
}
+#line 24716 ""
if (! comlast_1.islast) {
+#line 24716 ""
return 0;
+#line 24716 ""
}
- s_wsfe(&io___1698);
+#line 24717 ""
+ s_wsfe(&io___1743);
+#line 24717 ""
do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17);
+#line 24717 ""
e_wsfe();
- s_wsfe(&io___1699);
+#line 24718 ""
+ s_wsfe(&io___1744);
+#line 24718 ""
do_fio(&c__1, "%", (ftnlen)1);
+#line 24718 ""
e_wsfe();
- s_wsfe(&io___1700);
+#line 24719 ""
+ s_wsfe(&io___1745);
/* Writing concatenation */
+#line 24719 ""
i__1[0] = 2, a__1[0] = "% ";
+#line 24719 ""
i__1[1] = *lbase, a__1[1] = basenameq;
+#line 24719 ""
i__1[2] = 4, a__1[2] = ".tex";
+#line 24719 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50);
+#line 24719 ""
do_fio(&c__1, ch__2, *lbase + 6);
+#line 24719 ""
e_wsfe();
- s_wsfe(&io___1701);
+#line 24720 ""
+ s_wsfe(&io___1746);
+#line 24720 ""
do_fio(&c__1, "%", (ftnlen)1);
+#line 24720 ""
e_wsfe();
- s_wsfe(&io___1702);
+#line 24721 ""
+ s_wsfe(&io___1747);
+#line 24721 ""
do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16);
+#line 24721 ""
e_wsfe();
- s_wsfe(&io___1703);
+#line 24722 ""
+ s_wsfe(&io___1748);
/* Writing concatenation */
+#line 24722 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24722 ""
i__2[1] = 14, a__2[1] = "input musixtex";
+#line 24722 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
+#line 24722 ""
do_fio(&c__1, ch__3, (ftnlen)15);
+#line 24722 ""
e_wsfe();
- s_wsfe(&io___1704);
+#line 24723 ""
+ s_wsfe(&io___1749);
/* Writing concatenation */
+#line 24723 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24723 ""
i__2[1] = 9, a__2[1] = "input pmx";
+#line 24723 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10);
+#line 24723 ""
do_fio(&c__1, ch__4, (ftnlen)10);
+#line 24723 ""
e_wsfe();
/* write(11,'(a)')sq//'input musixmad' */
/* write(11,'(a)')sq//'input musixxad' */
- s_wsfe(&io___1705);
+#line 24726 ""
+ s_wsfe(&io___1750);
/* Writing concatenation */
+#line 24726 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24726 ""
i__3[1] = 15, a__3[1] = "setmaxslurs{24}";
+#line 24726 ""
i__3[2] = 1, a__3[2] = sq;
+#line 24726 ""
i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%";
+#line 24726 ""
s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39);
+#line 24726 ""
do_fio(&c__1, ch__5, (ftnlen)39);
+#line 24726 ""
e_wsfe();
+#line 24728 ""
if (! (*fontslur)) {
- s_wsfe(&io___1706);
+#line 24728 ""
+ s_wsfe(&io___1751);
/* Writing concatenation */
+#line 24728 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24728 ""
i__2[1] = 13, a__2[1] = "input musixps";
+#line 24728 ""
s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
+#line 24728 ""
do_fio(&c__1, ch__6, (ftnlen)14);
+#line 24728 ""
e_wsfe();
+#line 24728 ""
}
/* Need to input musixmad to permit more slurs. */
+#line 24732 ""
if (*musicsize == 20) {
- s_wsfe(&io___1707);
+#line 24733 ""
+ s_wsfe(&io___1752);
/* Writing concatenation */
+#line 24733 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24733 ""
i__2[1] = 16, a__2[1] = "normalmusicsize%";
+#line 24733 ""
s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17);
+#line 24733 ""
do_fio(&c__1, ch__7, (ftnlen)17);
+#line 24733 ""
e_wsfe();
+#line 24734 ""
} else if (*musicsize == 16) {
- s_wsfe(&io___1708);
+#line 24735 ""
+ s_wsfe(&io___1753);
/* Writing concatenation */
+#line 24735 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24735 ""
i__2[1] = 15, a__2[1] = "smallmusicsize%";
+#line 24735 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
+#line 24735 ""
do_fio(&c__1, ch__8, (ftnlen)16);
+#line 24735 ""
e_wsfe();
+#line 24736 ""
} else if (*musicsize == 24) {
- s_wsfe(&io___1709);
+#line 24737 ""
+ s_wsfe(&io___1754);
/* Writing concatenation */
+#line 24737 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24737 ""
i__2[1] = 15, a__2[1] = "largemusicsize%";
+#line 24737 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
+#line 24737 ""
do_fio(&c__1, ch__8, (ftnlen)16);
+#line 24737 ""
e_wsfe();
- s_wsfe(&io___1710);
+#line 24738 ""
+ s_wsfe(&io___1755);
/* Writing concatenation */
+#line 24738 ""
i__4[0] = 1, a__4[0] = sq;
+#line 24738 ""
i__4[1] = 3, a__4[1] = "def";
+#line 24738 ""
i__4[2] = 1, a__4[2] = sq;
+#line 24738 ""
i__4[3] = 10, a__4[3] = "meterfont{";
+#line 24738 ""
i__4[4] = 1, a__4[4] = sq;
+#line 24738 ""
i__4[5] = 16, a__4[5] = "meterlargefont}%";
+#line 24738 ""
s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32);
+#line 24738 ""
do_fio(&c__1, ch__9, (ftnlen)32);
+#line 24738 ""
e_wsfe();
+#line 24740 ""
} else if (*musicsize == 29) {
- s_wsfe(&io___1711);
+#line 24741 ""
+ s_wsfe(&io___1756);
/* Writing concatenation */
+#line 24741 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24741 ""
i__2[1] = 15, a__2[1] = "Largemusicsize%";
+#line 24741 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
+#line 24741 ""
do_fio(&c__1, ch__8, (ftnlen)16);
+#line 24741 ""
e_wsfe();
- s_wsfe(&io___1712);
+#line 24742 ""
+ s_wsfe(&io___1757);
/* Writing concatenation */
+#line 24742 ""
i__4[0] = 1, a__4[0] = sq;
+#line 24742 ""
i__4[1] = 3, a__4[1] = "def";
+#line 24742 ""
i__4[2] = 1, a__4[2] = sq;
+#line 24742 ""
i__4[3] = 10, a__4[3] = "meterfont{";
+#line 24742 ""
i__4[4] = 1, a__4[4] = sq;
+#line 24742 ""
i__4[5] = 16, a__4[5] = "meterLargefont}%";
+#line 24742 ""
s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32);
+#line 24742 ""
do_fio(&c__1, ch__9, (ftnlen)32);
+#line 24742 ""
e_wsfe();
+#line 24744 ""
}
/* Set sizes. Have sizes per staff in isize(.) and noinst per staff in */
@@ -37628,611 +60798,1165 @@ L1:
/* 130324 */
/* iiv = 1 */
+#line 24751 ""
i__5 = *noinst;
+#line 24751 ""
for (iinst = 1; iinst <= i__5; ++iinst) {
/* if (isize(iiv) .eq. 1) then */
+#line 24753 ""
if (comsize_1.isize[iinst - 1] == 1) {
+#line 24754 ""
if (iinst <= 9) {
- s_wsfe(&io___1714);
+#line 24755 ""
+ s_wsfe(&io___1759);
/* Writing concatenation */
+#line 24755 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24755 ""
i__2[1] = 7, a__2[1] = "setsize";
+#line 24755 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24755 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24755 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24755 ""
i__6[0] = 1, a__5[0] = sq;
+#line 24755 ""
i__6[1] = 11, a__5[1] = "smallvalue%";
+#line 24755 ""
s_cat(ch__11, a__5, i__6, &c__2, (ftnlen)12);
+#line 24755 ""
do_fio(&c__1, ch__11, (ftnlen)12);
+#line 24755 ""
e_wsfe();
+#line 24757 ""
} else {
- s_wsfe(&io___1715);
+#line 24758 ""
+ s_wsfe(&io___1760);
/* Writing concatenation */
+#line 24758 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24758 ""
i__2[1] = 8, a__2[1] = "setsize{";
+#line 24758 ""
s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
+#line 24758 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 24758 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24758 ""
i__1[0] = 1, a__1[0] = "}";
+#line 24758 ""
i__1[1] = 1, a__1[1] = sq;
+#line 24758 ""
i__1[2] = 11, a__1[2] = "smallvalue%";
+#line 24758 ""
s_cat(ch__13, a__1, i__1, &c__3, (ftnlen)13);
+#line 24758 ""
do_fio(&c__1, ch__13, (ftnlen)13);
+#line 24758 ""
e_wsfe();
+#line 24760 ""
}
/* else if (isize(iiv) .eq. 2) then */
+#line 24762 ""
} else if (comsize_1.isize[iinst - 1] == 2) {
+#line 24763 ""
if (iinst <= 9) {
- s_wsfe(&io___1716);
+#line 24764 ""
+ s_wsfe(&io___1761);
/* Writing concatenation */
+#line 24764 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24764 ""
i__2[1] = 7, a__2[1] = "setsize";
+#line 24764 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24764 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24764 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24764 ""
i__6[0] = 1, a__5[0] = sq;
+#line 24764 ""
i__6[1] = 10, a__5[1] = "tinyvalue%";
+#line 24764 ""
s_cat(ch__14, a__5, i__6, &c__2, (ftnlen)11);
+#line 24764 ""
do_fio(&c__1, ch__14, (ftnlen)11);
+#line 24764 ""
e_wsfe();
+#line 24766 ""
} else {
- s_wsfe(&io___1717);
+#line 24767 ""
+ s_wsfe(&io___1762);
/* Writing concatenation */
+#line 24767 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24767 ""
i__2[1] = 8, a__2[1] = "setsize{";
+#line 24767 ""
s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
+#line 24767 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 24767 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24767 ""
i__1[0] = 1, a__1[0] = "}";
+#line 24767 ""
i__1[1] = 1, a__1[1] = sq;
+#line 24767 ""
i__1[2] = 10, a__1[2] = "tinyvalue%";
+#line 24767 ""
s_cat(ch__11, a__1, i__1, &c__3, (ftnlen)12);
+#line 24767 ""
do_fio(&c__1, ch__11, (ftnlen)12);
+#line 24767 ""
e_wsfe();
+#line 24769 ""
}
+#line 24770 ""
}
/* iiv = iiv+nsperi(iinst) */
+#line 24772 ""
/* L5: */
+#line 24772 ""
}
- s_wsfi(&io___1719);
+#line 24773 ""
+ s_wsfi(&io___1764);
+#line 24773 ""
do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real));
+#line 24773 ""
e_wsfi();
- s_wsfe(&io___1720);
+#line 24774 ""
+ s_wsfe(&io___1765);
/* Writing concatenation */
+#line 24774 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24774 ""
i__2[1] = 13, a__2[1] = "nopagenumbers";
+#line 24774 ""
s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
+#line 24774 ""
do_fio(&c__1, ch__6, (ftnlen)14);
+#line 24774 ""
e_wsfe();
- s_wsfe(&io___1721);
+#line 24775 ""
+ s_wsfe(&io___1766);
/* Writing concatenation */
+#line 24775 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24775 ""
i__3[1] = 14, a__3[1] = "tracingstats=2";
+#line 24775 ""
i__3[2] = 1, a__3[2] = sq;
+#line 24775 ""
i__3[3] = 5, a__3[3] = "relax";
+#line 24775 ""
s_cat(ch__15, a__3, i__3, &c__4, (ftnlen)21);
+#line 24775 ""
do_fio(&c__1, ch__15, (ftnlen)21);
+#line 24775 ""
e_wsfe();
- s_wsfe(&io___1722);
+#line 24776 ""
+ s_wsfe(&io___1767);
/* Writing concatenation */
+#line 24776 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24776 ""
i__2[1] = 6, a__2[1] = "hsize=";
+#line 24776 ""
s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)7);
+#line 24776 ""
do_fio(&c__1, ch__16, (ftnlen)7);
+#line 24776 ""
i__5 = i_nint(&comtop_1.widthpt);
+#line 24776 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24776 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24776 ""
e_wsfe();
+#line 24777 ""
ci__1.cierr = 0;
+#line 24777 ""
ci__1.ciunit = 11;
/* Writing concatenation */
+#line 24777 ""
i__1[0] = 5, a__1[0] = "(a6,i";
+#line 24777 ""
r__1 = comtop_1.height + .1f;
+#line 24777 ""
i__5 = (integer) r_lg10(&r__1) + 49;
+#line 24777 ""
chax_(ch__1, (ftnlen)1, &i__5);
+#line 24777 ""
i__1[1] = 1, a__1[1] = ch__1;
+#line 24777 ""
i__1[2] = 4, a__1[2] = ",a2)";
+#line 24777 ""
ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4);
+#line 24777 ""
s_wsfe(&ci__1);
/* Writing concatenation */
+#line 24777 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24777 ""
i__2[1] = 5, a__2[1] = "vsize";
+#line 24777 ""
s_cat(ch__17, a__2, i__2, &c__2, (ftnlen)6);
+#line 24777 ""
do_fio(&c__1, ch__17, (ftnlen)6);
+#line 24777 ""
i__7 = (integer) (comtop_1.height + .1f);
+#line 24777 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
+#line 24777 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24777 ""
e_wsfe();
+#line 24779 ""
if (dabs(comtop_1.hoffpt) > .1f) {
+#line 24780 ""
if (comtop_1.hoffpt <= -10.f) {
- s_wsfe(&io___1723);
+#line 24781 ""
+ s_wsfe(&io___1768);
/* Writing concatenation */
+#line 24781 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24781 ""
i__2[1] = 7, a__2[1] = "hoffset";
+#line 24781 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24781 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24781 ""
i__5 = i_nint(&comtop_1.hoffpt);
+#line 24781 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24781 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24781 ""
e_wsfe();
+#line 24782 ""
} else if (comtop_1.hoffpt < 0.f) {
- s_wsfe(&io___1724);
+#line 24783 ""
+ s_wsfe(&io___1769);
/* Writing concatenation */
+#line 24783 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24783 ""
i__2[1] = 7, a__2[1] = "hoffset";
+#line 24783 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24783 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24783 ""
i__5 = i_nint(&comtop_1.hoffpt);
+#line 24783 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24783 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24783 ""
e_wsfe();
+#line 24784 ""
} else if (comtop_1.hoffpt < 10.f) {
- s_wsfe(&io___1725);
+#line 24785 ""
+ s_wsfe(&io___1770);
/* Writing concatenation */
+#line 24785 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24785 ""
i__2[1] = 7, a__2[1] = "hoffset";
+#line 24785 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24785 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24785 ""
i__5 = i_nint(&comtop_1.hoffpt);
+#line 24785 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24785 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24785 ""
e_wsfe();
+#line 24786 ""
} else {
- s_wsfe(&io___1726);
+#line 24787 ""
+ s_wsfe(&io___1771);
/* Writing concatenation */
+#line 24787 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24787 ""
i__2[1] = 7, a__2[1] = "hoffset";
+#line 24787 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24787 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24787 ""
i__5 = i_nint(&comtop_1.hoffpt);
+#line 24787 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24787 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24787 ""
e_wsfe();
+#line 24788 ""
}
+#line 24789 ""
}
+#line 24790 ""
if (dabs(comtop_1.voffpt) > .1f) {
+#line 24791 ""
if (comtop_1.voffpt <= -10.f) {
- s_wsfe(&io___1727);
+#line 24792 ""
+ s_wsfe(&io___1772);
/* Writing concatenation */
+#line 24792 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24792 ""
i__2[1] = 7, a__2[1] = "voffset";
+#line 24792 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24792 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24792 ""
i__5 = i_nint(&comtop_1.voffpt);
+#line 24792 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24792 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24792 ""
e_wsfe();
+#line 24793 ""
} else if (comtop_1.voffpt < 0.f) {
- s_wsfe(&io___1728);
+#line 24794 ""
+ s_wsfe(&io___1773);
/* Writing concatenation */
+#line 24794 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24794 ""
i__2[1] = 7, a__2[1] = "voffset";
+#line 24794 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24794 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24794 ""
i__5 = i_nint(&comtop_1.voffpt);
+#line 24794 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24794 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24794 ""
e_wsfe();
+#line 24795 ""
} else if (comtop_1.voffpt < 10.f) {
- s_wsfe(&io___1729);
+#line 24796 ""
+ s_wsfe(&io___1774);
/* Writing concatenation */
+#line 24796 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24796 ""
i__2[1] = 7, a__2[1] = "voffset";
+#line 24796 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24796 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24796 ""
i__5 = i_nint(&comtop_1.voffpt);
+#line 24796 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24796 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24796 ""
e_wsfe();
+#line 24797 ""
} else {
- s_wsfe(&io___1730);
+#line 24798 ""
+ s_wsfe(&io___1775);
/* Writing concatenation */
+#line 24798 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24798 ""
i__2[1] = 7, a__2[1] = "voffset";
+#line 24798 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24798 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24798 ""
i__5 = i_nint(&comtop_1.voffpt);
+#line 24798 ""
do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer));
+#line 24798 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24798 ""
e_wsfe();
+#line 24799 ""
}
+#line 24800 ""
}
/* 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 24805 ""
if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') {
- s_wsfe(&io___1731);
+#line 24805 ""
+ s_wsfe(&io___1776);
/* Writing concatenation */
+#line 24805 ""
i__4[0] = 1, a__4[0] = sq;
+#line 24805 ""
i__4[1] = 3, a__4[1] = "def";
+#line 24805 ""
i__4[2] = 1, a__4[2] = sq;
+#line 24805 ""
i__4[3] = 14, a__4[3] = "raisebarno{4.5";
+#line 24805 ""
i__4[4] = 1, a__4[4] = sq;
+#line 24805 ""
i__4[5] = 10, a__4[5] = "internote}";
+#line 24805 ""
s_cat(ch__18, a__4, i__4, &c__6, (ftnlen)30);
+#line 24805 ""
do_fio(&c__1, ch__18, (ftnlen)30);
+#line 24805 ""
e_wsfe();
+#line 24805 ""
}
+#line 24807 ""
if (*noinst < 10) {
- s_wsfe(&io___1732);
+#line 24808 ""
+ s_wsfe(&io___1777);
/* Writing concatenation */
+#line 24808 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24808 ""
i__3[1] = 3, a__3[1] = "def";
+#line 24808 ""
i__3[2] = 1, a__3[2] = sq;
+#line 24808 ""
i__3[3] = 14, a__3[3] = "nbinstruments{";
+#line 24808 ""
s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19);
+#line 24808 ""
do_fio(&c__1, ch__19, (ftnlen)19);
+#line 24808 ""
do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
+#line 24808 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 24808 ""
e_wsfe();
+#line 24810 ""
} else {
- s_wsfe(&io___1733);
+#line 24811 ""
+ s_wsfe(&io___1778);
/* Writing concatenation */
+#line 24811 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24811 ""
i__3[1] = 3, a__3[1] = "def";
+#line 24811 ""
i__3[2] = 1, a__3[2] = sq;
+#line 24811 ""
i__3[3] = 14, a__3[3] = "nbinstruments{";
+#line 24811 ""
s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19);
+#line 24811 ""
do_fio(&c__1, ch__19, (ftnlen)19);
+#line 24811 ""
do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
+#line 24811 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 24811 ""
e_wsfe();
+#line 24813 ""
}
+#line 24814 ""
iv = 0;
+#line 24815 ""
i__5 = *noinst;
+#line 24815 ""
for (iinst = 1; iinst <= i__5; ++iinst) {
+#line 24816 ""
nstaves = comnvi_1.nsperi[iinst - 1];
+#line 24817 ""
if (iinst < 10) {
- s_wsfe(&io___1736);
+#line 24818 ""
+ s_wsfe(&io___1781);
/* Writing concatenation */
+#line 24818 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24818 ""
i__3[1] = 9, a__3[1] = "setstaffs";
+#line 24818 ""
i__7 = iinst + 48;
+#line 24818 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24818 ""
i__3[2] = 1, a__3[2] = ch__1;
+#line 24818 ""
i__8 = nstaves + 48;
+#line 24818 ""
chax_(ch__20, (ftnlen)1, &i__8);
+#line 24818 ""
i__3[3] = 1, a__3[3] = ch__20;
+#line 24818 ""
s_cat(ch__11, a__3, i__3, &c__4, (ftnlen)12);
+#line 24818 ""
do_fio(&c__1, ch__11, (ftnlen)12);
+#line 24818 ""
e_wsfe();
+#line 24820 ""
} else {
- s_wsfe(&io___1737);
+#line 24821 ""
+ s_wsfe(&io___1782);
/* Writing concatenation */
+#line 24821 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24821 ""
i__2[1] = 10, a__2[1] = "setstaffs{";
+#line 24821 ""
s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
+#line 24821 ""
do_fio(&c__1, ch__14, (ftnlen)11);
+#line 24821 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24821 ""
i__6[0] = 1, a__5[0] = "}";
+#line 24821 ""
i__7 = nstaves + 48;
+#line 24821 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24821 ""
i__6[1] = 1, a__5[1] = ch__1;
+#line 24821 ""
s_cat(ch__21, a__5, i__6, &c__2, (ftnlen)2);
+#line 24821 ""
do_fio(&c__1, ch__21, (ftnlen)2);
+#line 24821 ""
e_wsfe();
+#line 24823 ""
}
+#line 24824 ""
++iv;
+#line 24825 ""
*(unsigned char *)clefqiv = *(unsigned char *)&clefq[iv];
+#line 24826 ""
if (*(unsigned char *)clefqiv == '8') {
+#line 24827 ""
*(unsigned char *)clefqiv = 't';
- cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] = 7;
+#line 24828 ""
+ cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] += 7;
+#line 24829 ""
}
+#line 24830 ""
if (nstaves == 1) {
+#line 24831 ""
i__7 = numclef_(clefq + iv, (ftnlen)1) + 48;
+#line 24831 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24831 ""
s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1);
+#line 24832 ""
lfmtq = 1;
+#line 24833 ""
} else {
/* Writing concatenation */
+#line 24834 ""
i__2[0] = 1, a__2[0] = "{";
+#line 24834 ""
i__7 = numclef_(clefq + iv, (ftnlen)1) + 48;
+#line 24834 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24834 ""
i__2[1] = 1, a__2[1] = ch__1;
+#line 24834 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
+#line 24835 ""
lfmtq = 2;
+#line 24836 ""
i__7 = nstaves;
+#line 24836 ""
for (k = 2; k <= i__7; ++k) {
+#line 24837 ""
++iv;
/* Writing concatenation */
+#line 24838 ""
i__2[0] = lfmtq, a__2[0] = fmtq;
+#line 24838 ""
i__8 = numclef_(clefq + iv, (ftnlen)1) + 48;
+#line 24838 ""
chax_(ch__1, (ftnlen)1, &i__8);
+#line 24838 ""
i__2[1] = 1, a__2[1] = ch__1;
+#line 24838 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
+#line 24839 ""
++lfmtq;
+#line 24840 ""
/* L2: */
+#line 24840 ""
}
/* Writing concatenation */
+#line 24841 ""
i__2[0] = lfmtq, a__2[0] = fmtq;
+#line 24841 ""
i__2[1] = 1, a__2[1] = "}";
+#line 24841 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
+#line 24842 ""
++lfmtq;
+#line 24843 ""
}
+#line 24844 ""
if (iinst < 10) {
- s_wsfe(&io___1742);
+#line 24845 ""
+ s_wsfe(&io___1787);
/* Writing concatenation */
+#line 24845 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24845 ""
i__3[1] = 7, a__3[1] = "setclef";
+#line 24845 ""
i__7 = iinst + 48;
+#line 24845 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24845 ""
i__3[2] = 1, a__3[2] = ch__1;
+#line 24845 ""
i__3[3] = lfmtq, a__3[3] = fmtq;
+#line 24845 ""
s_cat(ch__22, a__3, i__3, &c__4, (ftnlen)33);
+#line 24845 ""
do_fio(&c__1, ch__22, lfmtq + 9);
+#line 24845 ""
e_wsfe();
+#line 24846 ""
} else {
- s_wsfe(&io___1743);
+#line 24847 ""
+ s_wsfe(&io___1788);
/* Writing concatenation */
+#line 24847 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24847 ""
i__2[1] = 8, a__2[1] = "setclef{";
+#line 24847 ""
s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
+#line 24847 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 24847 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24847 ""
i__6[0] = 1, a__5[0] = "}";
+#line 24847 ""
i__6[1] = lfmtq, a__5[1] = fmtq;
+#line 24847 ""
s_cat(ch__23, a__5, i__6, &c__2, (ftnlen)25);
+#line 24847 ""
do_fio(&c__1, ch__23, lfmtq + 1);
+#line 24847 ""
e_wsfe();
+#line 24848 ""
}
+#line 24849 ""
if (*(unsigned char *)&clefq[iv] == '8') {
+#line 24850 ""
if (iinst < 10) {
- s_wsfe(&io___1744);
+#line 24851 ""
+ s_wsfe(&io___1789);
/* Writing concatenation */
+#line 24851 ""
i__9[0] = 1, a__6[0] = sq;
+#line 24851 ""
i__9[1] = 19, a__6[1] = "settrebleclefsymbol";
+#line 24851 ""
i__7 = iinst + 48;
+#line 24851 ""
chax_(ch__1, (ftnlen)1, &i__7);
+#line 24851 ""
i__9[2] = 1, a__6[2] = ch__1;
+#line 24851 ""
i__9[3] = 1, a__6[3] = sq;
+#line 24851 ""
i__9[4] = 13, a__6[4] = "treblelowoct%";
+#line 24851 ""
s_cat(ch__24, a__6, i__9, &c__5, (ftnlen)35);
+#line 24851 ""
do_fio(&c__1, ch__24, (ftnlen)35);
+#line 24851 ""
e_wsfe();
+#line 24853 ""
} else {
- s_wsfe(&io___1745);
+#line 24854 ""
+ s_wsfe(&io___1790);
/* Writing concatenation */
+#line 24854 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24854 ""
i__2[1] = 20, a__2[1] = "settrebleclefsymbol{";
+#line 24854 ""
s_cat(ch__15, a__2, i__2, &c__2, (ftnlen)21);
+#line 24854 ""
do_fio(&c__1, ch__15, (ftnlen)21);
+#line 24854 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24854 ""
i__1[0] = 1, a__1[0] = "}";
+#line 24854 ""
i__1[1] = 1, a__1[1] = sq;
+#line 24854 ""
i__1[2] = 13, a__1[2] = "treblelowoct%";
+#line 24854 ""
s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)15);
+#line 24854 ""
do_fio(&c__1, ch__3, (ftnlen)15);
+#line 24854 ""
e_wsfe();
+#line 24856 ""
}
+#line 24857 ""
}
+#line 24858 ""
for (lname = 79; lname >= 2; --lname) {
+#line 24859 ""
if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname
- 1)] != ' ') {
+#line 24859 ""
goto L4;
+#line 24859 ""
}
+#line 24860 ""
/* L3: */
+#line 24860 ""
}
+#line 24861 ""
L4:
+#line 24862 ""
comtop_1.lnam[iinst - 1] = lname;
+#line 24863 ""
if (iinst < 10) {
- s_wsfe(&io___1747);
+#line 24864 ""
+ s_wsfe(&io___1792);
/* Writing concatenation */
+#line 24864 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24864 ""
i__2[1] = 7, a__2[1] = "setname";
+#line 24864 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8);
+#line 24864 ""
do_fio(&c__1, ch__10, (ftnlen)8);
+#line 24864 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24864 ""
i__1[0] = 1, a__1[0] = "{";
+#line 24864 ""
i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
+#line 24864 ""
i__1[2] = 1, a__1[2] = "}";
+#line 24864 ""
s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)81);
+#line 24864 ""
do_fio(&c__1, ch__25, lname + 2);
+#line 24864 ""
e_wsfe();
+#line 24866 ""
} else {
- s_wsfe(&io___1748);
+#line 24867 ""
+ s_wsfe(&io___1793);
/* Writing concatenation */
+#line 24867 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24867 ""
i__2[1] = 8, a__2[1] = "setname{";
+#line 24867 ""
s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9);
+#line 24867 ""
do_fio(&c__1, ch__12, (ftnlen)9);
+#line 24867 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
+#line 24867 ""
i__1[0] = 2, a__1[0] = "}{";
+#line 24867 ""
i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
+#line 24867 ""
i__1[2] = 1, a__1[2] = "}";
+#line 24867 ""
s_cat(ch__26, a__1, i__1, &c__3, (ftnlen)82);
+#line 24867 ""
do_fio(&c__1, ch__26, lname + 3);
+#line 24867 ""
e_wsfe();
+#line 24869 ""
}
+#line 24870 ""
/* L1: */
+#line 24870 ""
}
- s_wsfe(&io___1749);
+#line 24871 ""
+ s_wsfe(&io___1794);
/* Writing concatenation */
+#line 24871 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24871 ""
i__2[1] = 17, a__2[1] = "generalsignature{";
+#line 24871 ""
s_cat(ch__27, a__2, i__2, &c__2, (ftnlen)18);
+#line 24871 ""
do_fio(&c__1, ch__27, (ftnlen)18);
+#line 24871 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
+#line 24871 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 24871 ""
e_wsfe();
+#line 24872 ""
if (cominsttrans_1.earlytranson) {
+#line 24872 ""
writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &cominsttrans_1.earlytranson);
+#line 24872 ""
}
+#line 24874 ""
wgmeter_(mtrnmp, mtrdnp);
+#line 24875 ""
r__1 = comtop_1.fracindent * comtop_1.widthpt;
+#line 24875 ""
ipi = i_nint(&r__1);
+#line 24876 ""
if (ipi < 10) {
- s_wsfe(&io___1751);
+#line 24877 ""
+ s_wsfe(&io___1796);
/* Writing concatenation */
+#line 24877 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24877 ""
i__2[1] = 10, a__2[1] = "parindent ";
+#line 24877 ""
s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
+#line 24877 ""
do_fio(&c__1, ch__14, (ftnlen)11);
+#line 24877 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
+#line 24877 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24877 ""
e_wsfe();
+#line 24878 ""
} else if (ipi < 100) {
- s_wsfe(&io___1752);
+#line 24879 ""
+ s_wsfe(&io___1797);
/* Writing concatenation */
+#line 24879 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24879 ""
i__2[1] = 10, a__2[1] = "parindent ";
+#line 24879 ""
s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
+#line 24879 ""
do_fio(&c__1, ch__14, (ftnlen)11);
+#line 24879 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
+#line 24879 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24879 ""
e_wsfe();
+#line 24880 ""
} else {
- s_wsfe(&io___1753);
+#line 24881 ""
+ s_wsfe(&io___1798);
/* Writing concatenation */
+#line 24881 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24881 ""
i__2[1] = 10, a__2[1] = "parindent ";
+#line 24881 ""
s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11);
+#line 24881 ""
do_fio(&c__1, ch__14, (ftnlen)11);
+#line 24881 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
+#line 24881 ""
do_fio(&c__1, "pt", (ftnlen)2);
+#line 24881 ""
e_wsfe();
+#line 24882 ""
}
- s_wsfe(&io___1754);
+#line 24883 ""
+ s_wsfe(&io___1799);
/* Writing concatenation */
+#line 24883 ""
i__10[0] = 1, a__7[0] = sq;
+#line 24883 ""
i__10[1] = 11, a__7[1] = "elemskip1pt";
+#line 24883 ""
i__10[2] = 1, a__7[2] = sq;
+#line 24883 ""
i__10[3] = 13, a__7[3] = "afterruleskip";
+#line 24883 ""
i__10[4] = 5, a__7[4] = fbarq;
+#line 24883 ""
i__10[5] = 2, a__7[5] = "pt";
+#line 24883 ""
i__10[6] = 1, a__7[6] = sq;
+#line 24883 ""
i__10[7] = 17, a__7[7] = "beforeruleskip0pt";
+#line 24883 ""
i__10[8] = 1, a__7[8] = sq;
+#line 24883 ""
i__10[9] = 5, a__7[9] = "relax";
+#line 24883 ""
s_cat(ch__28, a__7, i__10, &c__10, (ftnlen)57);
+#line 24883 ""
do_fio(&c__1, ch__28, (ftnlen)57);
+#line 24883 ""
e_wsfe();
+#line 24885 ""
if (! (*vshrink)) {
+#line 24886 ""
if (*xinstf1 < 9.95f) {
+#line 24887 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
+#line 24888 ""
} else {
+#line 24889 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
+#line 24890 ""
}
- s_wsfe(&io___1755);
+#line 24891 ""
+ facis = 1.f;
+#line 24892 ""
+ if (comis4bignv_1.is4bignv) {
+#line 24892 ""
+ facis = .95f;
+#line 24892 ""
+ }
+#line 24893 ""
+ s_wsfe(&io___1801);
/* Writing concatenation */
+#line 24893 ""
i__4[0] = 1, a__4[0] = sq;
+#line 24893 ""
i__4[1] = 15, a__4[1] = "stafftopmarg0pt";
+#line 24893 ""
i__4[2] = 1, a__4[2] = sq;
+#line 24893 ""
i__4[3] = 15, a__4[3] = "staffbotmarg0pt";
+#line 24893 ""
i__4[4] = 1, a__4[4] = sq;
+#line 24893 ""
i__4[5] = 11, a__4[5] = "interstaff{";
+#line 24893 ""
s_cat(ch__29, a__4, i__4, &c__6, (ftnlen)44);
+#line 24893 ""
do_fio(&c__1, ch__29, (ftnlen)44);
- do_fio(&c__1, (char *)&(*xinstf1), (ftnlen)sizeof(real));
+#line 24893 ""
+ r__1 = *xinstf1 * facis;
+#line 24893 ""
+ do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
/* Writing concatenation */
+#line 24893 ""
i__1[0] = 1, a__1[0] = "}";
+#line 24893 ""
i__1[1] = 1, a__1[1] = sq;
+#line 24893 ""
i__1[2] = 5, a__1[2] = "relax";
+#line 24893 ""
s_cat(ch__16, a__1, i__1, &c__3, (ftnlen)7);
+#line 24893 ""
do_fio(&c__1, ch__16, (ftnlen)7);
+#line 24893 ""
e_wsfe();
+#line 24895 ""
} else {
- s_wsfe(&io___1756);
+#line 24896 ""
+ s_wsfe(&io___1802);
/* Writing concatenation */
+#line 24896 ""
i__10[0] = 1, a__7[0] = sq;
+#line 24896 ""
i__10[1] = 15, a__7[1] = "stafftopmarg0pt";
+#line 24896 ""
i__10[2] = 1, a__7[2] = sq;
+#line 24896 ""
i__10[3] = 13, a__7[3] = "staffbotmarg5";
+#line 24896 ""
i__10[4] = 1, a__7[4] = sq;
+#line 24896 ""
i__10[5] = 10, a__7[5] = "Interligne";
+#line 24896 ""
i__10[6] = 1, a__7[6] = sq;
+#line 24896 ""
i__10[7] = 14, a__7[7] = "interstaff{10}";
+#line 24896 ""
i__10[8] = 1, a__7[8] = sq;
+#line 24896 ""
i__10[9] = 5, a__7[9] = "relax";
+#line 24896 ""
s_cat(ch__30, a__7, i__10, &c__10, (ftnlen)62);
+#line 24896 ""
do_fio(&c__1, ch__30, (ftnlen)62);
+#line 24896 ""
e_wsfe();
+#line 24899 ""
}
+#line 24900 ""
if (*nv == 1) {
- s_wsfe(&io___1757);
+#line 24900 ""
+ s_wsfe(&io___1803);
/* Writing concatenation */
+#line 24900 ""
i__2[0] = 1, a__2[0] = sq;
+#line 24900 ""
i__2[1] = 11, a__2[1] = "nostartrule";
+#line 24900 ""
s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)12);
+#line 24900 ""
do_fio(&c__1, ch__11, (ftnlen)12);
+#line 24900 ""
e_wsfe();
+#line 24900 ""
}
- s_wsfe(&io___1758);
+#line 24901 ""
+ s_wsfe(&io___1804);
/* Writing concatenation */
+#line 24901 ""
i__3[0] = 1, a__3[0] = sq;
+#line 24901 ""
i__3[1] = 8, a__3[1] = "readmod{";
+#line 24901 ""
i__3[2] = *lbase, a__3[2] = basenameq;
+#line 24901 ""
i__3[3] = 1, a__3[3] = "}";
+#line 24901 ""
s_cat(ch__31, a__3, i__3, &c__4, (ftnlen)54);
+#line 24901 ""
do_fio(&c__1, ch__31, *lbase + 10);
+#line 24901 ""
e_wsfe();
+#line 24902 ""
if (comnvst_1.cstuplet) {
- s_wsfe(&io___1759);
+#line 24903 ""
+ s_wsfe(&io___1805);
/* Writing concatenation */
+#line 24903 ""
i__11[0] = 1, a__8[0] = sq;
+#line 24903 ""
i__11[1] = 12, a__8[1] = "input tuplet";
+#line 24903 ""
i__11[2] = 1, a__8[2] = sq;
+#line 24903 ""
i__11[3] = 3, a__8[3] = "def";
+#line 24903 ""
i__11[4] = 1, a__8[4] = sq;
+#line 24903 ""
i__11[5] = 12, a__8[5] = "xnumt#1#2#3{";
+#line 24903 ""
i__11[6] = 1, a__8[6] = sq;
+#line 24903 ""
i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}";
+#line 24903 ""
i__11[8] = 1, a__8[8] = sq;
+#line 24903 ""
i__11[9] = 3, a__8[9] = "def";
+#line 24903 ""
i__11[10] = 1, a__8[10] = sq;
+#line 24903 ""
i__11[11] = 10, a__8[11] = "tuplettxt{";
+#line 24903 ""
i__11[12] = 1, a__8[12] = sq;
+#line 24903 ""
i__11[13] = 9, a__8[13] = "smalltype";
+#line 24903 ""
i__11[14] = 1, a__8[14] = sq;
+#line 24903 ""
i__11[15] = 6, a__8[15] = "it{#3}";
+#line 24903 ""
i__11[16] = 1, a__8[16] = sq;
+#line 24903 ""
i__11[17] = 1, a__8[17] = "/";
+#line 24903 ""
i__11[18] = 1, a__8[18] = sq;
+#line 24903 ""
i__11[19] = 4, a__8[19] = "/}}%";
+#line 24903 ""
s_cat(ch__32, a__8, i__11, &c__20, (ftnlen)86);
+#line 24903 ""
do_fio(&c__1, ch__32, (ftnlen)86);
+#line 24903 ""
e_wsfe();
- s_wsfe(&io___1760);
+#line 24907 ""
+ s_wsfe(&io___1806);
/* Writing concatenation */
+#line 24907 ""
i__12[0] = 1, a__9[0] = sq;
+#line 24907 ""
i__12[1] = 3, a__9[1] = "let";
+#line 24907 ""
i__12[2] = 1, a__9[2] = sq;
+#line 24907 ""
i__12[3] = 5, a__9[3] = "ovbkt";
+#line 24907 ""
i__12[4] = 1, a__9[4] = sq;
+#line 24907 ""
i__12[5] = 8, a__9[5] = "uptuplet";
+#line 24907 ""
i__12[6] = 1, a__9[6] = sq;
+#line 24907 ""
i__12[7] = 3, a__9[7] = "let";
+#line 24907 ""
i__12[8] = 1, a__9[8] = sq;
+#line 24907 ""
i__12[9] = 5, a__9[9] = "unbkt";
+#line 24907 ""
i__12[10] = 1, a__9[10] = sq;
+#line 24907 ""
i__12[11] = 11, a__9[11] = "downtuplet%";
+#line 24907 ""
s_cat(ch__33, a__9, i__12, &c__12, (ftnlen)41);
+#line 24907 ""
do_fio(&c__1, ch__33, (ftnlen)41);
+#line 24907 ""
e_wsfe();
+#line 24909 ""
}
- s_wsfe(&io___1761);
+#line 24910 ""
+ s_wsfe(&io___1807);
/* Writing concatenation */
+#line 24910 ""
i__13[0] = 1, a__10[0] = sq;
+#line 24910 ""
i__13[1] = 11, a__10[1] = "startmuflex";
+#line 24910 ""
i__13[2] = 1, a__10[2] = sq;
+#line 24910 ""
i__13[3] = 10, a__10[3] = "startpiece";
+#line 24910 ""
i__13[4] = 1, a__10[4] = sq;
+#line 24910 ""
i__13[5] = 8, a__10[5] = "addspace";
+#line 24910 ""
i__13[6] = 1, a__10[6] = sq;
+#line 24910 ""
i__13[7] = 14, a__10[7] = "afterruleskip%";
+#line 24910 ""
s_cat(ch__34, a__10, i__13, &c__8, (ftnlen)47);
+#line 24910 ""
do_fio(&c__1, ch__34, (ftnlen)47);
+#line 24910 ""
e_wsfe();
+#line 24912 ""
return 0;
} /* topfile_ */
@@ -38244,12 +61968,19 @@ L4:
/* Slur directions */
+#line 24920 ""
ntest = *nolev - *ncm;
+#line 24921 ""
if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) {
+#line 24923 ""
*(unsigned char *)ret_val = 'd';
+#line 24924 ""
} else {
+#line 24925 ""
*(unsigned char *)ret_val = 'u';
+#line 24926 ""
}
+#line 24927 ""
return ;
} /* udfq_ */
@@ -38267,33 +61998,52 @@ L4:
/* Stem direction for single notes */
+#line 24936 ""
if (bit_test(*isl,30)) {
/* Absolute override */
+#line 24940 ""
if (bit_test(*isl,17)) {
+#line 24941 ""
*(unsigned char *)udqqq = 'u';
+#line 24942 ""
} else {
+#line 24943 ""
*(unsigned char *)udqqq = 'l';
+#line 24944 ""
}
+#line 24945 ""
} else if (*nvmx == 1) {
/* Single voice per staff, default */
+#line 24949 ""
r__1 = *nole * 1.f;
+#line 24949 ""
ulfq_(ch__2, (ftnlen)1, &r__1, ncm);
+#line 24949 ""
*(unsigned char *)udqqq = *(unsigned char *)&ch__2[0];
+#line 24950 ""
} else {
/* Multi-voice per staff, 1st is lower, 2nd upper */
+#line 24954 ""
if (*ivx <= *nv) {
+#line 24955 ""
*(unsigned char *)udqqq = 'l';
+#line 24956 ""
} else {
+#line 24957 ""
*(unsigned char *)udqqq = 'u';
+#line 24958 ""
}
+#line 24959 ""
}
+#line 24960 ""
*(unsigned char *)ret_val = *(unsigned char *)udqqq;
+#line 24961 ""
return ;
} /* udqq_ */
@@ -38305,12 +62055,19 @@ L4:
/* Stem directions */
+#line 24969 ""
test = *xnolev - *ncm;
+#line 24970 ""
if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) {
+#line 24972 ""
*(unsigned char *)ret_val = 'u';
+#line 24973 ""
} else {
+#line 24974 ""
*(unsigned char *)ret_val = 'l';
+#line 24975 ""
}
+#line 24976 ""
return ;
} /* ulfq_ */
@@ -38332,25 +62089,40 @@ L4:
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
/* Fortran I/O blocks */
- static cilist io___1765 = { 0, 6, 0, 0, 0 };
+ static cilist io___1811 = { 0, 6, 0, 0, 0 };
+#line 24980 ""
if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) {
+#line 24981 ""
i__1 = *(unsigned char *)chq - 32;
+#line 24981 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 24981 ""
*(unsigned char *)ret_val = *(unsigned char *)&ch__2[0];
+#line 24982 ""
} else {
+#line 24983 ""
*(unsigned char *)ret_val = *(unsigned char *)chq;
- s_wsle(&io___1765);
+#line 24984 ""
+ s_wsle(&io___1811);
/* Writing concatenation */
- i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"
+#line 24984 ""
+ i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"\
"rgument: ";
+#line 24984 ""
i__2[1] = 1, a__1[1] = chq;
+#line 24984 ""
s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53);
+#line 24984 ""
do_lio(&c__9, &c__1, ch__3, (ftnlen)53);
+#line 24984 ""
e_wsle();
+#line 24986 ""
s_stop("", (ftnlen)0);
+#line 24987 ""
}
+#line 24988 ""
return ;
} /* upcaseq_ */
@@ -38371,143 +62143,258 @@ L4:
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
/* Fortran I/O blocks */
- static cilist io___1767 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 };
- static cilist io___1768 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 };
- static cilist io___1769 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 };
- static cilist io___1770 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 };
- static cilist io___1771 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 };
- static cilist io___1772 = { 0, 11, 0, "(a21,i1,a2)", 0 };
- static cilist io___1773 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1774 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1775 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1813 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 };
+ static cilist io___1814 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 };
+ static cilist io___1815 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 };
+ static cilist io___1816 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 };
+ static cilist io___1817 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 };
+ static cilist io___1818 = { 0, 11, 0, "(a21,i1,a2)", 0 };
+ static cilist io___1819 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1820 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1821 = { 0, 11, 0, "(a)", 0 };
/* Writes meter stuff to file 11, so only called if islast=.true. */
+#line 24995 ""
if (*mtrdnp == 0) {
+#line 24995 ""
return 0;
+#line 24995 ""
}
+#line 24996 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 24996 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
+#line 24997 ""
if (*mtrnmp > 0 && *mtrnmp <= 9) {
+#line 24998 ""
if (*mtrdnp < 10) {
- s_wsfe(&io___1767);
+#line 24999 ""
+ s_wsfe(&io___1813);
/* Writing concatenation */
+#line 24999 ""
i__1[0] = 1, a__1[0] = sq;
+#line 24999 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 24999 ""
i__1[2] = 1, a__1[2] = sq;
+#line 24999 ""
i__1[3] = 10, a__1[3] = "meterfrac{";
+#line 24999 ""
s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
+#line 24999 ""
do_fio(&c__1, ch__2, (ftnlen)25);
+#line 24999 ""
do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
+#line 24999 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 24999 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 24999 ""
do_fio(&c__1, "}}%", (ftnlen)3);
+#line 24999 ""
e_wsfe();
+#line 25002 ""
} else {
- s_wsfe(&io___1768);
+#line 25003 ""
+ s_wsfe(&io___1814);
/* Writing concatenation */
+#line 25003 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25003 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25003 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25003 ""
i__1[3] = 10, a__1[3] = "meterfrac{";
+#line 25003 ""
s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
+#line 25003 ""
do_fio(&c__1, ch__2, (ftnlen)25);
+#line 25003 ""
do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
+#line 25003 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 25003 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25003 ""
do_fio(&c__1, "}}%", (ftnlen)3);
+#line 25003 ""
e_wsfe();
+#line 25006 ""
}
+#line 25007 ""
} else if (*mtrnmp >= 10) {
+#line 25008 ""
if (*mtrdnp < 10) {
- s_wsfe(&io___1769);
+#line 25009 ""
+ s_wsfe(&io___1815);
/* Writing concatenation */
+#line 25009 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25009 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25009 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25009 ""
i__1[3] = 10, a__1[3] = "meterfrac{";
+#line 25009 ""
s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
+#line 25009 ""
do_fio(&c__1, ch__2, (ftnlen)25);
+#line 25009 ""
do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
+#line 25009 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 25009 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25009 ""
do_fio(&c__1, "}}%", (ftnlen)3);
+#line 25009 ""
e_wsfe();
+#line 25012 ""
} else {
- s_wsfe(&io___1770);
+#line 25013 ""
+ s_wsfe(&io___1816);
/* Writing concatenation */
+#line 25013 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25013 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25013 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25013 ""
i__1[3] = 10, a__1[3] = "meterfrac{";
+#line 25013 ""
s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
+#line 25013 ""
do_fio(&c__1, ch__2, (ftnlen)25);
+#line 25013 ""
do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
+#line 25013 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 25013 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25013 ""
do_fio(&c__1, "}}%", (ftnlen)3);
+#line 25013 ""
e_wsfe();
+#line 25016 ""
}
+#line 25017 ""
} else if (*mtrnmp < 0) {
- s_wsfe(&io___1771);
+#line 25018 ""
+ s_wsfe(&io___1817);
/* Writing concatenation */
+#line 25018 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25018 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25018 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25018 ""
i__1[3] = 11, a__1[3] = "meterfracS{";
+#line 25018 ""
s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26);
+#line 25018 ""
do_fio(&c__1, ch__3, (ftnlen)26);
+#line 25018 ""
i__2 = -(*mtrnmp);
+#line 25018 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 25018 ""
do_fio(&c__1, "}{", (ftnlen)2);
+#line 25018 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25018 ""
do_fio(&c__1, "}}%", (ftnlen)3);
+#line 25018 ""
e_wsfe();
+#line 25021 ""
} else if (*mtrdnp <= 4) {
- s_wsfe(&io___1772);
+#line 25022 ""
+ s_wsfe(&io___1818);
/* Writing concatenation */
+#line 25022 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25022 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25022 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25022 ""
i__1[3] = 6, a__1[3] = "meterN";
+#line 25022 ""
s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
+#line 25022 ""
do_fio(&c__1, ch__4, (ftnlen)21);
+#line 25022 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25022 ""
do_fio(&c__1, "}%", (ftnlen)2);
+#line 25022 ""
e_wsfe();
+#line 25024 ""
} else if (*mtrdnp == 5) {
- s_wsfe(&io___1773);
+#line 25025 ""
+ s_wsfe(&io___1819);
/* Writing concatenation */
+#line 25025 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25025 ""
i__1[1] = 12, a__1[1] = "generalmeter";
+#line 25025 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25025 ""
i__1[3] = 10, a__1[3] = "allabreve%";
+#line 25025 ""
s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
+#line 25025 ""
do_fio(&c__1, ch__5, (ftnlen)24);
+#line 25025 ""
e_wsfe();
+#line 25026 ""
} else if (*mtrdnp == 6) {
- s_wsfe(&io___1774);
+#line 25027 ""
+ s_wsfe(&io___1820);
/* Writing concatenation */
+#line 25027 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25027 ""
i__1[1] = 12, a__1[1] = "generalmeter";
+#line 25027 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25027 ""
i__1[3] = 7, a__1[3] = "meterC%";
+#line 25027 ""
s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
+#line 25027 ""
do_fio(&c__1, ch__4, (ftnlen)21);
+#line 25027 ""
e_wsfe();
+#line 25028 ""
} else if (*mtrdnp == 7) {
- s_wsfe(&io___1775);
+#line 25029 ""
+ s_wsfe(&io___1821);
/* Writing concatenation */
+#line 25029 ""
i__1[0] = 1, a__1[0] = sq;
+#line 25029 ""
i__1[1] = 12, a__1[1] = "generalmeter";
+#line 25029 ""
i__1[2] = 1, a__1[2] = sq;
+#line 25029 ""
i__1[3] = 10, a__1[3] = "meterIIIS%";
+#line 25029 ""
s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
+#line 25029 ""
do_fio(&c__1, ch__5, (ftnlen)24);
+#line 25029 ""
e_wsfe();
+#line 25030 ""
}
+#line 25031 ""
return 0;
} /* wgmeter_ */
@@ -38542,32 +62429,32 @@ L4:
extern /* Subroutine */ int printl_(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1777 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1778 = { 0, 52, 0, "(a6,10Z4)", 0 };
- static cilist io___1783 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1784 = { 0, 52, 0, "(a6,8z4)", 0 };
- static cilist io___1785 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1786 = { 0, 52, 0, "(a)", 0 };
- static cilist io___1787 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1788 = { 0, 52, 0, "(a)", 0 };
- static cilist io___1791 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1792 = { 0, 52, 0, "(z4)", 0 };
- static cilist io___1793 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1794 = { 0, 52, 0, "(4z4)", 0 };
- static cilist io___1799 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1800 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 };
- static cilist io___1801 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1802 = { 0, 52, 0, "(4z4)", 0 };
- static cilist io___1803 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1804 = { 0, 52, 0, "(a)", 0 };
- static icilist io___1806 = { 0, tempoq, 0, "(i2)", 10, 1 };
- static icilist io___1808 = { 0, instq, 0, "(i3)", 10, 1 };
- static cilist io___1809 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1810 = { 0, 52, 0, "(z4)", 0 };
- static cilist io___1811 = { 0, 51, 0, "(a,$)", 0 };
- static cilist io___1812 = { 0, 52, 0, "(4z4)", 0 };
- static cilist io___1813 = { 0, 6, 0, "(1x,a12,(10i6))", 0 };
- static cilist io___1814 = { 0, 15, 0, "(1x,a12,(10i6))", 0 };
+ static cilist io___1823 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1824 = { 0, 52, 0, "(a6,10Z4)", 0 };
+ static cilist io___1829 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1830 = { 0, 52, 0, "(a6,8z4)", 0 };
+ static cilist io___1831 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1832 = { 0, 52, 0, "(a)", 0 };
+ static cilist io___1833 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1834 = { 0, 52, 0, "(a)", 0 };
+ static cilist io___1837 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1838 = { 0, 52, 0, "(z4)", 0 };
+ static cilist io___1839 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1840 = { 0, 52, 0, "(4z4)", 0 };
+ static cilist io___1845 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1846 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 };
+ static cilist io___1847 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1848 = { 0, 52, 0, "(4z4)", 0 };
+ static cilist io___1849 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1850 = { 0, 52, 0, "(a)", 0 };
+ static icilist io___1852 = { 0, tempoq, 0, "(i2)", 10, 1 };
+ static icilist io___1854 = { 0, instq, 0, "(i3)", 10, 1 };
+ static cilist io___1855 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1856 = { 0, 52, 0, "(z4)", 0 };
+ static cilist io___1857 = { 0, 51, 0, "(a,$)", 0 };
+ static cilist io___1858 = { 0, 52, 0, "(4z4)", 0 };
+ static cilist io___1859 = { 0, 6, 0, "(1x,a12,(10i6))", 0 };
+ static cilist io___1860 = { 0, 15, 0, "(1x,a12,(10i6))", 0 };
@@ -38579,418 +62466,707 @@ L4:
/* Write Header */
- s_wsfe(&io___1777);
+#line 25084 ""
+ s_wsfe(&io___1823);
/* Writing concatenation */
+#line 25084 ""
i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000";
+#line 25084 ""
*(unsigned char *)&ch__2[0] = commidi_1.numchan + 1;
+#line 25084 ""
i__1[1] = 1, a__1[1] = ch__2;
+#line 25084 ""
i__1[2] = 1, a__1[2] = "\000";
+#line 25084 ""
i__1[3] = 1, a__1[3] = "\360";
+#line 25084 ""
s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14);
+#line 25084 ""
do_fio(&c__1, ch__1, (ftnlen)14);
+#line 25084 ""
e_wsfe();
+#line 25086 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1778);
+#line 25086 ""
+ s_wsfe(&io___1824);
+#line 25086 ""
do_fio(&c__1, "\"MThd\"", (ftnlen)6);
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
i__2 = commidi_1.numchan + 1;
+#line 25086 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25086 ""
do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer));
+#line 25086 ""
e_wsfe();
+#line 25086 ""
}
/* Write the "conductor" track, for keys, meter, and tempos */
/* Get the number of bytes in the conductor event stream */
+#line 25093 ""
ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[
commidi_1.numchan + commmac_1.nmidsec * 25 - 25];
+#line 25094 ""
i__2 = commmac_1.nmidsec - 1;
+#line 25094 ""
for (isec = 1; isec <= i__2; ++isec) {
+#line 25095 ""
ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 -
25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
+#line 25096 ""
/* L15: */
+#line 25096 ""
}
/* ib1 = (4+ljob+26+ndata+4)/256 */
/* ib0 = 4+ljob+26+ndata+4-256*ib1 */
+#line 25099 ""
ib1 = (*ljob + 31 + ndata + 4) / 256;
+#line 25100 ""
ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8);
- s_wsfe(&io___1783);
+#line 25101 ""
+ s_wsfe(&io___1829);
/* Writing concatenation */
+#line 25101 ""
i__3[0] = 6, a__2[0] = "MTrk\000\000";
+#line 25101 ""
*(unsigned char *)&ch__2[0] = ib1;
+#line 25101 ""
i__3[1] = 1, a__2[1] = ch__2;
+#line 25101 ""
*(unsigned char *)&ch__4[0] = ib0;
+#line 25101 ""
i__3[2] = 1, a__2[2] = ch__4;
+#line 25101 ""
i__3[3] = 1, a__2[3] = "\000";
+#line 25101 ""
i__3[4] = 1, a__2[4] = "\377";
+#line 25101 ""
i__3[5] = 1, a__2[5] = "\001";
+#line 25101 ""
*(unsigned char *)&ch__5[0] = *ljob + 27;
+#line 25101 ""
i__3[6] = 1, a__2[6] = ch__5;
+#line 25101 ""
s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12);
+#line 25101 ""
do_fio(&c__1, ch__3, (ftnlen)12);
+#line 25101 ""
e_wsfe();
/* Text header */
/* * //char(0)//char(255)//char(1)//char(ljob+26) */
+#line 25107 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1784);
+#line 25107 ""
+ s_wsfe(&io___1830);
+#line 25107 ""
do_fio(&c__1, "\"MTrk\"", (ftnlen)6);
+#line 25107 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
+#line 25107 ""
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
+#line 25107 ""
i__2 = *ljob + 27;
+#line 25107 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 25107 ""
e_wsfe();
+#line 25107 ""
}
- s_wsfe(&io___1785);
+#line 25110 ""
+ s_wsfe(&io___1831);
+#line 25110 ""
do_fio(&c__1, jobname, (*ljob));
+#line 25110 ""
e_wsfe();
+#line 25111 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1786);
+#line 25111 ""
+ s_wsfe(&io___1832);
/* Writing concatenation */
+#line 25111 ""
i__4[0] = 1, a__3[0] = "\"";
+#line 25111 ""
i__4[1] = *ljob, a__3[1] = jobname;
+#line 25111 ""
i__4[2] = 1, a__3[2] = "\"";
+#line 25111 ""
s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46);
+#line 25111 ""
do_fio(&c__1, ch__6, *ljob + 2);
+#line 25111 ""
e_wsfe();
+#line 25111 ""
}
/* (separate writes are needed to defeat compiler BUG!!!) */
/* write(51,'(a,$)')'.mid, produced by PMX 2.30' */
- s_wsfe(&io___1787);
+#line 25116 ""
+ s_wsfe(&io___1833);
/* Writing concatenation */
+#line 25116 ""
i__5[0] = 22, a__4[0] = ".mid, produced by PMX ";
+#line 25116 ""
i__5[1] = 5, a__4[1] = comver_1.versionc;
+#line 25116 ""
s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27);
+#line 25116 ""
do_fio(&c__1, ch__7, (ftnlen)27);
+#line 25116 ""
e_wsfe();
+#line 25117 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1788);
+#line 25117 ""
+ s_wsfe(&io___1834);
/* Writing concatenation */
+#line 25117 ""
i__4[0] = 23, a__3[0] = "\".mid, produced by PMX ";
+#line 25117 ""
i__4[1] = 5, a__3[1] = comver_1.versionc;
+#line 25117 ""
i__4[2] = 1, a__3[2] = "\"";
+#line 25117 ""
s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29);
+#line 25117 ""
do_fio(&c__1, ch__8, (ftnlen)29);
+#line 25117 ""
e_wsfe();
+#line 25117 ""
}
/* Conductor event data: Loop over sections. */
+#line 25122 ""
i__2 = commmac_1.nmidsec;
+#line 25122 ""
for (isec = 1; isec <= i__2; ++isec) {
+#line 25123 ""
if (isec < commmac_1.nmidsec) {
+#line 25124 ""
mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25];
+#line 25125 ""
} else {
+#line 25126 ""
mend = commidi_1.imidi[commidi_1.numchan];
+#line 25127 ""
}
+#line 25128 ""
i__6 = mend;
+#line 25128 ""
for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
i__ <= i__6; ++i__) {
- s_wsfe(&io___1791);
+#line 25129 ""
+ s_wsfe(&io___1837);
+#line 25129 ""
*(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[
commidi_1.numchan + i__ * 25 - 25];
+#line 25129 ""
do_fio(&c__1, ch__2, (ftnlen)1);
+#line 25129 ""
e_wsfe();
+#line 25130 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1792);
+#line 25130 ""
+ s_wsfe(&io___1838);
+#line 25130 ""
do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan +
i__ * 25 - 25], (ftnlen)sizeof(shortint));
+#line 25130 ""
e_wsfe();
+#line 25130 ""
}
+#line 25131 ""
/* L17: */
+#line 25131 ""
}
+#line 25132 ""
/* L16: */
+#line 25132 ""
}
/* And close out the time sig / tempo track. */
- s_wsfe(&io___1793);
+#line 25136 ""
+ s_wsfe(&io___1839);
+#line 25136 ""
do_fio(&c__1, "\000\377/\000", (ftnlen)4);
+#line 25136 ""
e_wsfe();
+#line 25137 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1794);
+#line 25137 ""
+ s_wsfe(&io___1840);
+#line 25137 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25137 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
+#line 25137 ""
do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
+#line 25137 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25137 ""
e_wsfe();
+#line 25137 ""
}
/* Loop over track for each voice: The following sets up iv. */
+#line 25141 ""
all_1.iv = all_1.nv;
+#line 25142 ""
if (commidi_1.twoline[all_1.nv - 1]) {
+#line 25143 ""
kv = 2;
+#line 25144 ""
} else {
+#line 25145 ""
kv = 1;
+#line 25146 ""
}
-/* Moved to pmxab to allow midivel, bal, tran as functions of instrument */
-/* rather than staff (iv) */
-/* c */
-/* c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */
-/* c */
-/* nstaves = 0 */
-/* ivt = 0 */
-/* do 12 iinst = 1 , nm */
-/* nstaves = nstaves+nsperi(iinst) */
-/* do 13 ivtt = 1 , nsperi(iinst) */
-/* ivt = ivt+1 */
-/* iinsiv(ivt) = iinst */
-/* 13 continue */
-/* if (nstaves .eq. nv) go to 14 */
-/* 12 continue */
-/* print*,'Screwup!' */
-/* call stop1() */
-/* 14 continue */
-
+#line 25148 ""
i__2 = commidi_1.numchan - 1;
+#line 25148 ""
for (icm = 0; icm <= i__2; ++icm) {
/* Get the number of bytes in the data stream */
+#line 25152 ""
ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm +
commmac_1.nmidsec * 25 - 25];
+#line 25153 ""
i__6 = commmac_1.nmidsec - 1;
+#line 25153 ""
for (isec = 1; isec <= i__6; ++isec) {
+#line 25154 ""
ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] -
commmac_1.msecstrt[icm + isec * 25 - 25];
+#line 25155 ""
/* L11: */
+#line 25155 ""
}
-/* c Add 3 (for instrum) plus 4 (for closing) to byte count, */
/* Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, */
-/* ndata = ndata+7 */
+#line 25159 ""
ndata += 11;
/* Add 4+lnam(iinsiv(iv)) if lnam>0 , */
+#line 25163 ""
if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
+#line 25163 ""
ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1]
- 1];
+#line 25163 ""
}
/* Separate total byte counts into 4 bytes */
+#line 25167 ""
for (ibyte = 1; ibyte <= 4; ++ibyte) {
+#line 25168 ""
if (ndata > 0) {
+#line 25169 ""
*(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256);
+#line 25170 ""
ndata = lbit_shift(ndata, (ftnlen)-8);
+#line 25171 ""
} else {
+#line 25172 ""
*(unsigned char *)&byteq[ibyte - 1] = '\0';
+#line 25173 ""
}
+#line 25174 ""
/* L2: */
+#line 25174 ""
}
/* Now write front stuff for this track */
- s_wsfe(&io___1799);
+#line 25178 ""
+ s_wsfe(&io___1845);
/* Writing concatenation */
+#line 25178 ""
i__7[0] = 4, a__5[0] = "MTrk";
+#line 25178 ""
i__7[1] = 1, a__5[1] = byteq + 3;
+#line 25178 ""
i__7[2] = 1, a__5[2] = byteq + 2;
+#line 25178 ""
i__7[3] = 1, a__5[3] = byteq + 1;
+#line 25178 ""
i__7[4] = 1, a__5[4] = byteq;
+#line 25178 ""
i__7[5] = 1, a__5[5] = "\000";
+#line 25178 ""
*(unsigned char *)&ch__2[0] = icmm[icm] + 192;
+#line 25178 ""
i__7[6] = 1, a__5[6] = ch__2;
+#line 25178 ""
*(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[
all_1.iv - 1] - 1];
+#line 25178 ""
i__7[7] = 1, a__5[7] = ch__4;
+#line 25178 ""
i__7[8] = 1, a__5[8] = "\000";
+#line 25178 ""
*(unsigned char *)&ch__5[0] = icmm[icm] + 176;
+#line 25178 ""
i__7[9] = 1, a__5[9] = ch__5;
+#line 25178 ""
i__7[10] = 1, a__5[10] = "\n";
+#line 25178 ""
*(unsigned char *)&ch__10[0] = commvel_1.midbc[icm];
+#line 25178 ""
i__7[11] = 1, a__5[11] = ch__10;
+#line 25178 ""
s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15);
+#line 25178 ""
do_fio(&c__1, ch__9, (ftnlen)15);
+#line 25178 ""
e_wsfe();
/* * //char(0)//char(12*16+icmm(icm))//char(midinst(iv)) */
+#line 25182 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1800);
+#line 25182 ""
+ s_wsfe(&io___1846);
+#line 25182 ""
do_fio(&c__1, "icm=", (ftnlen)4);
+#line 25182 ""
do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, " \"MTrk\"", (ftnlen)7);
+#line 25182 ""
i__6 = *(unsigned char *)&byteq[3];
+#line 25182 ""
do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer));
+#line 25182 ""
i__8 = *(unsigned char *)&byteq[2];
+#line 25182 ""
do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer));
+#line 25182 ""
i__9 = *(unsigned char *)&byteq[1];
+#line 25182 ""
do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer));
+#line 25182 ""
i__10 = *(unsigned char *)&byteq[0];
+#line 25182 ""
do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25182 ""
i__11 = icmm[icm] + 192;
+#line 25182 ""
do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[
all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25182 ""
i__12 = icmm[icm] + 176;
+#line 25182 ""
do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer));
+#line 25182 ""
do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof(
integer));
+#line 25182 ""
e_wsfe();
+#line 25182 ""
}
/* * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iv), */
+#line 25187 ""
if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
/* Add instrument name as sequence name */
- s_wsfe(&io___1801);
+#line 25191 ""
+ s_wsfe(&io___1847);
/* Writing concatenation */
+#line 25191 ""
i__5[0] = 3, a__4[0] = "\000\377\003";
+#line 25191 ""
*(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[
all_1.iv - 1] - 1];
+#line 25191 ""
i__5[1] = 1, a__4[1] = ch__2;
+#line 25191 ""
s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4);
+#line 25191 ""
do_fio(&c__1, ch__11, (ftnlen)4);
+#line 25191 ""
e_wsfe();
+#line 25193 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1802);
+#line 25193 ""
+ s_wsfe(&io___1848);
+#line 25193 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25193 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
+#line 25193 ""
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
+#line 25193 ""
do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[
all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
+#line 25193 ""
e_wsfe();
+#line 25193 ""
}
- s_wsfe(&io___1803);
+#line 25194 ""
+ s_wsfe(&io___1849);
+#line 25194 ""
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 25194 ""
e_wsfe();
+#line 25196 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1804);
+#line 25196 ""
+ s_wsfe(&io___1850);
/* Writing concatenation */
+#line 25196 ""
i__4[0] = 1, a__3[0] = "\"";
+#line 25196 ""
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 25196 ""
i__4[2] = 1, a__3[2] = "\"";
+#line 25196 ""
s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81);
+#line 25196 ""
do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv
- 1] - 1] + 2);
+#line 25196 ""
e_wsfe();
+#line 25196 ""
}
+#line 25198 ""
}
- s_wsfi(&io___1806);
+#line 25199 ""
+ s_wsfi(&io___1852);
+#line 25199 ""
do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
+#line 25199 ""
e_wsfi();
- s_wsfi(&io___1808);
+#line 25200 ""
+ s_wsfi(&io___1854);
+#line 25200 ""
do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv -
1] - 1], (ftnlen)sizeof(integer));
+#line 25200 ""
e_wsfi();
/* Writing concatenation */
+#line 25201 ""
i__1[0] = 16, a__1[0] = "MIDI instrument ";
+#line 25201 ""
i__1[1] = 2, a__1[1] = tempoq;
+#line 25201 ""
i__1[2] = 4, a__1[2] = " is ";
+#line 25201 ""
i__1[3] = 3, a__1[3] = instq;
+#line 25201 ""
s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25);
+#line 25201 ""
printl_(ch__13, (ftnlen)25);
/* Notes: Loop over sections. */
+#line 25205 ""
i__6 = commmac_1.nmidsec;
+#line 25205 ""
for (isec = 1; isec <= i__6; ++isec) {
+#line 25206 ""
if (isec < commmac_1.nmidsec) {
+#line 25207 ""
mend = commmac_1.msecend[icm + isec * 25 - 25];
+#line 25208 ""
} else {
+#line 25209 ""
mend = commidi_1.imidi[icm];
+#line 25210 ""
}
+#line 25211 ""
i__8 = mend;
+#line 25211 ""
for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8;
++i__) {
- s_wsfe(&io___1809);
+#line 25212 ""
+ s_wsfe(&io___1855);
+#line 25212 ""
*(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm +
i__ * 25 - 25];
+#line 25212 ""
do_fio(&c__1, ch__2, (ftnlen)1);
+#line 25212 ""
e_wsfe();
+#line 25213 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1810);
+#line 25213 ""
+ s_wsfe(&io___1856);
+#line 25213 ""
do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 -
25], (ftnlen)sizeof(shortint));
+#line 25213 ""
e_wsfe();
+#line 25213 ""
}
+#line 25214 ""
/* L10: */
+#line 25214 ""
}
+#line 25215 ""
/* L9: */
+#line 25215 ""
}
/* Closing 4 bytes */
- s_wsfe(&io___1811);
+#line 25219 ""
+ s_wsfe(&io___1857);
/* Writing concatenation */
+#line 25219 ""
chax_(ch__2, (ftnlen)1, &c__0);
+#line 25219 ""
i__1[0] = 1, a__1[0] = ch__2;
+#line 25219 ""
i__1[1] = 1, a__1[1] = "\377";
+#line 25219 ""
i__1[2] = 1, a__1[2] = "/";
+#line 25219 ""
i__1[3] = 1, a__1[3] = "\000";
+#line 25219 ""
s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4);
+#line 25219 ""
do_fio(&c__1, ch__11, (ftnlen)4);
+#line 25219 ""
e_wsfe();
+#line 25220 ""
if (commidi_1.debugmidi) {
- s_wsfe(&io___1812);
+#line 25220 ""
+ s_wsfe(&io___1858);
+#line 25220 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25220 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
+#line 25220 ""
do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
+#line 25220 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
+#line 25220 ""
e_wsfe();
+#line 25220 ""
}
+#line 25221 ""
if (kv == 2) {
+#line 25222 ""
kv = 1;
+#line 25223 ""
} else if (all_1.iv == 1) {
+#line 25224 ""
goto L5;
+#line 25225 ""
} else {
+#line 25226 ""
--all_1.iv;
+#line 25227 ""
if (commidi_1.twoline[all_1.iv - 1]) {
+#line 25227 ""
kv = 2;
+#line 25227 ""
}
+#line 25228 ""
}
+#line 25229 ""
L5:
+#line 25229 ""
;
+#line 25229 ""
}
- s_wsfe(&io___1813);
+#line 25230 ""
+ s_wsfe(&io___1859);
+#line 25230 ""
do_fio(&c__1, "Bytes used:", (ftnlen)11);
+#line 25230 ""
i__2 = commidi_1.numchan;
+#line 25230 ""
for (icm = 0; icm <= i__2; ++icm) {
+#line 25230 ""
do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
+#line 25230 ""
}
+#line 25230 ""
e_wsfe();
- s_wsfe(&io___1814);
+#line 25231 ""
+ s_wsfe(&io___1860);
+#line 25231 ""
do_fio(&c__1, "Bytes used:", (ftnlen)11);
+#line 25231 ""
i__2 = commidi_1.numchan;
+#line 25231 ""
for (icm = 0; icm <= i__2; ++icm) {
+#line 25231 ""
do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
+#line 25231 ""
}
+#line 25231 ""
e_wsfe();
+#line 25233 ""
cl__1.cerr = 0;
+#line 25233 ""
cl__1.cunit = 51;
+#line 25233 ""
cl__1.csta = 0;
+#line 25233 ""
f_clos(&cl__1);
+#line 25234 ""
if (commidi_1.debugmidi) {
+#line 25234 ""
cl__1.cerr = 0;
+#line 25234 ""
cl__1.cunit = 52;
+#line 25234 ""
cl__1.csta = 0;
+#line 25234 ""
f_clos(&cl__1);
+#line 25234 ""
}
+#line 25235 ""
return 0;
} /* writemidi_ */
@@ -39015,79 +63191,143 @@ L5:
static char notexq[79];
/* Fortran I/O blocks */
- static cilist io___1818 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1864 = { 0, 11, 0, "(a)", 0 };
/* Assumes notexq is blank */
+#line 25246 ""
/* Parameter adjustments */
+#line 25246 ""
--itranskey;
+#line 25246 ""
--iinsttrans;
+#line 25246 ""
+#line 25246 ""
/* Function Body */
+#line 25246 ""
i__1 = *ninsttrans;
+#line 25246 ""
for (i__ = 1; i__ <= i__1; ++i__) {
/* Writing concatenation */
+#line 25247 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 25247 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 25247 ""
i__2[1] = 7, a__1[1] = "setsign";
+#line 25247 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 25248 ""
lnote = 8;
+#line 25249 ""
if (iinsttrans[i__] < 10) {
/* Writing concatenation */
+#line 25250 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 25250 ""
i__3 = iinsttrans[i__] + 48;
+#line 25250 ""
chax_(ch__1, (ftnlen)1, &i__3);
+#line 25250 ""
i__2[1] = 1, a__1[1] = ch__1;
+#line 25250 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 25251 ""
++lnote;
+#line 25252 ""
} else {
+#line 25253 ""
i__3 = lnote;
+#line 25253 ""
ici__1.icierr = 0;
+#line 25253 ""
ici__1.icirnum = 1;
+#line 25253 ""
ici__1.icirlen = lnote + 4 - i__3;
+#line 25253 ""
ici__1.iciunit = notexq + i__3;
+#line 25253 ""
ici__1.icifmt = "(a1,i2,a1)";
+#line 25253 ""
s_wsfi(&ici__1);
+#line 25253 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 25253 ""
do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer));
+#line 25253 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 25253 ""
e_wsfi();
+#line 25255 ""
lnote += 4;
+#line 25256 ""
}
+#line 25257 ""
if (itranskey[i__] < 0) {
+#line 25258 ""
i__3 = lnote;
+#line 25258 ""
ici__1.icierr = 0;
+#line 25258 ""
ici__1.icirnum = 1;
+#line 25258 ""
ici__1.icirlen = lnote + 4 - i__3;
+#line 25258 ""
ici__1.iciunit = notexq + i__3;
+#line 25258 ""
ici__1.icifmt = "(a1,i2,a1)";
+#line 25258 ""
s_wsfi(&ici__1);
+#line 25258 ""
do_fio(&c__1, "{", (ftnlen)1);
+#line 25258 ""
do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer));
+#line 25258 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 25258 ""
e_wsfi();
+#line 25260 ""
lnote += 4;
+#line 25261 ""
} else {
/* Writing concatenation */
+#line 25262 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 25262 ""
i__3 = itranskey[i__] + 48;
+#line 25262 ""
chax_(ch__1, (ftnlen)1, &i__3);
+#line 25262 ""
i__2[1] = 1, a__1[1] = ch__1;
+#line 25262 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
+#line 25263 ""
++lnote;
+#line 25264 ""
}
- s_wsfe(&io___1818);
+#line 25265 ""
+ s_wsfe(&io___1864);
/* Writing concatenation */
+#line 25265 ""
i__2[0] = lnote, a__1[0] = notexq;
+#line 25265 ""
i__2[1] = 1, a__1[1] = "%";
+#line 25265 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80);
+#line 25265 ""
do_fio(&c__1, ch__2, lnote + 1);
+#line 25265 ""
e_wsfe();
+#line 25266 ""
/* L1: */
+#line 25266 ""
}
+#line 25267 ""
*flag__ = FALSE_;
+#line 25268 ""
return 0;
} /* writesetsign_ */
@@ -39102,40 +63342,75 @@ L5:
integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
;
+#line 25272 ""
if (*x < .95f) {
+#line 25273 ""
i__1 = *lenline;
+#line 25273 ""
ici__1.icierr = 0;
+#line 25273 ""
ici__1.icirnum = 1;
+#line 25273 ""
ici__1.icirlen = *lenline + 2 - i__1;
+#line 25273 ""
ici__1.iciunit = notexq + i__1;
+#line 25273 ""
ici__1.icifmt = "(f2.1)";
+#line 25273 ""
s_wsfi(&ici__1);
+#line 25273 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
+#line 25273 ""
e_wsfi();
+#line 25274 ""
*lenline += 2;
+#line 25275 ""
} else if (*x < 9.95f) {
+#line 25276 ""
i__1 = *lenline;
+#line 25276 ""
ici__1.icierr = 0;
+#line 25276 ""
ici__1.icirnum = 1;
+#line 25276 ""
ici__1.icirlen = *lenline + 3 - i__1;
+#line 25276 ""
ici__1.iciunit = notexq + i__1;
+#line 25276 ""
ici__1.icifmt = "(f3.1)";
+#line 25276 ""
s_wsfi(&ici__1);
+#line 25276 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
+#line 25276 ""
e_wsfi();
+#line 25277 ""
*lenline += 3;
+#line 25278 ""
} else {
+#line 25279 ""
i__1 = *lenline;
+#line 25279 ""
ici__1.icierr = 0;
+#line 25279 ""
ici__1.icirnum = 1;
+#line 25279 ""
ici__1.icirlen = *lenline + 4 - i__1;
+#line 25279 ""
ici__1.iciunit = notexq + i__1;
+#line 25279 ""
ici__1.icifmt = "(f4.1)";
+#line 25279 ""
s_wsfi(&ici__1);
+#line 25279 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
+#line 25279 ""
e_wsfi();
+#line 25280 ""
*lenline += 4;
+#line 25281 ""
}
+#line 25282 ""
return 0;
} /* writflot_ */
@@ -39163,11 +63438,11 @@ L5:
extern integer numclef_(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1821 = { 0, 6, 0, 0, 0 };
- static cilist io___1822 = { 0, 6, 0, 0, 0 };
- static icilist io___1826 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 };
- static cilist io___1827 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1829 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1867 = { 0, 6, 0, 0, 0 };
+ static cilist io___1868 = { 0, 6, 0, 0, 0 };
+ static icilist io___1872 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 };
+ static cilist io___1873 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1875 = { 0, 11, 0, "(a)", 0 };
/* subroutine wsclef(iv,ninow,clefq,nclef) */
@@ -39178,100 +63453,179 @@ L5:
/* In pmx271, had removed clefq, so with 2 or more staves in */
/* an instrument, had problems. So replace in 272 */
+#line 25301 ""
if (*nclef < 7) {
+#line 25302 ""
i__1 = *nclef + 48;
+#line 25302 ""
chax_(ch__1, (ftnlen)1, &i__1);
+#line 25302 ""
*(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)&
ch__1[0];
+#line 25303 ""
} else {
+#line 25304 ""
*(unsigned char *)&comclefq_1.clefq[*iv - 1] = '9';
+#line 25305 ""
}
+#line 25306 ""
if (! comlast_1.islast) {
+#line 25306 ""
return 0;
+#line 25306 ""
}
+#line 25307 ""
iv1 = 1;
+#line 25308 ""
i__1 = *ninow;
+#line 25308 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
+#line 25309 ""
if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) {
+#line 25309 ""
goto L2;
+#line 25309 ""
}
+#line 25310 ""
iv1 += comnvi_1.nspern[iinst - 1];
+#line 25311 ""
/* L1: */
+#line 25311 ""
}
- s_wsle(&io___1821);
+#line 25312 ""
+ s_wsle(&io___1867);
+#line 25312 ""
e_wsle();
- s_wsle(&io___1822);
+#line 25313 ""
+ s_wsle(&io___1868);
+#line 25313 ""
do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29);
+#line 25313 ""
e_wsle();
+#line 25314 ""
stop1_();
+#line 25315 ""
L2:
/* Here, iinst is the instrument number with staff of clef change */
+#line 25319 ""
iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1;
+#line 25320 ""
if (iinst < 10) {
/* Writing concatenation */
+#line 25321 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 25321 ""
i__2[0] = 1, a__1[0] = ch__1;
+#line 25321 ""
i__2[1] = 7, a__1[1] = "setclef";
+#line 25321 ""
i__1 = iinst + 48;
+#line 25321 ""
chax_(ch__2, (ftnlen)1, &i__1);
+#line 25321 ""
i__2[2] = 1, a__1[2] = ch__2;
+#line 25321 ""
s_cat(temq, a__1, i__2, &c__3, (ftnlen)20);
+#line 25322 ""
ltem = 9;
+#line 25323 ""
} else {
- s_wsfi(&io___1826);
+#line 25324 ""
+ s_wsfi(&io___1872);
/* Writing concatenation */
+#line 25324 ""
chax_(ch__1, (ftnlen)1, &c__92);
+#line 25324 ""
i__3[0] = 1, a__2[0] = ch__1;
+#line 25324 ""
i__3[1] = 8, a__2[1] = "setclef{";
+#line 25324 ""
s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9);
+#line 25324 ""
do_fio(&c__1, ch__3, (ftnlen)9);
+#line 25324 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
+#line 25324 ""
do_fio(&c__1, "}", (ftnlen)1);
+#line 25324 ""
e_wsfi();
+#line 25325 ""
ltem = 12;
+#line 25326 ""
}
+#line 25327 ""
if (iv1 == iv2) {
/* Only one staff (iv) in instrument with clef change */
- s_wsfe(&io___1827);
+#line 25331 ""
+ s_wsfe(&io___1873);
/* Writing concatenation */
+#line 25331 ""
i__2[0] = ltem, a__1[0] = temq;
+#line 25331 ""
i__2[1] = 1, a__1[1] = comclefq_1.clefq + (*iv - 1);
+#line 25331 ""
i__2[2] = 1, a__1[2] = "%";
+#line 25331 ""
s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)22);
+#line 25331 ""
do_fio(&c__1, ch__4, ltem + 2);
+#line 25331 ""
e_wsfe();
+#line 25332 ""
} else {
/* Writing concatenation */
+#line 25333 ""
i__3[0] = ltem, a__2[0] = temq;
+#line 25333 ""
i__3[1] = 1, a__2[1] = "{";
+#line 25333 ""
s_cat(temq, a__2, i__3, &c__2, (ftnlen)20);
+#line 25334 ""
++ltem;
/* Loop over staves, but clefq has only changed for one of them */
+#line 25338 ""
i__1 = iv2;
+#line 25338 ""
for (iiv = iv1; iiv <= i__1; ++iiv) {
/* Writing concatenation */
+#line 25339 ""
i__3[0] = ltem, a__2[0] = temq;
+#line 25339 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (ftnlen)1) + 48;
+#line 25339 ""
chax_(ch__1, (ftnlen)1, &i__4);
+#line 25339 ""
i__3[1] = 1, a__2[1] = ch__1;
+#line 25339 ""
s_cat(temq, a__2, i__3, &c__2, (ftnlen)20);
+#line 25340 ""
++ltem;
+#line 25341 ""
/* L3: */
+#line 25341 ""
}
- s_wsfe(&io___1829);
+#line 25342 ""
+ s_wsfe(&io___1875);
/* Writing concatenation */
+#line 25342 ""
i__3[0] = ltem, a__2[0] = temq;
+#line 25342 ""
i__3[1] = 2, a__2[1] = "}%";
+#line 25342 ""
s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)22);
+#line 25342 ""
do_fio(&c__1, ch__4, ltem + 2);
+#line 25342 ""
e_wsfe();
+#line 25343 ""
}
+#line 25344 ""
return 0;
} /* wsclef_ */
@@ -39290,65 +63644,95 @@ L2:
extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
ftnlen);
+#line 25349 ""
*lyrerr = 0;
/* On entry, last char was " */
+#line 25353 ""
L18:
+#line 25353 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 25354 ""
if (*iccount == 121) {
+#line 25355 ""
*lyrerr = 2;
+#line 25356 ""
return 0;
/* else if (charq.eq.'"') then */
+#line 25358 ""
} else /* if(complicated condition) */ {
+#line 25358 ""
i__1 = *iccount - 2;
+#line 25358 ""
if (*(unsigned char *)charq == '"' && ! (s_cmp(lineq + i__1, "\\", *
iccount - 1 - i__1, (ftnlen)1) == 0)) {
+#line 25360 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
/* Check for raise/lower command */
+#line 25364 ""
if (*(unsigned char *)charq == '@') {
/* @ positions lyrics vertically for current voice */
/* [a,b] above or below of the staff */
/* +/- i offset, \internotes */
+#line 25370 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 25371 ""
if (i_indx("ab", charq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 25372 ""
*lyrerr = 3;
+#line 25373 ""
return 0;
+#line 25374 ""
}
+#line 25375 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 25376 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 25377 ""
*lyrerr = 4;
+#line 25378 ""
return 0;
+#line 25379 ""
}
+#line 25380 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
+#line 25381 ""
if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) == 0) {
+#line 25382 ""
*lyrerr = 5;
+#line 25383 ""
return 0;
+#line 25384 ""
}
+#line 25385 ""
} else if (*(unsigned char *)charq != ' ') {
/* 2nd " must be followed by ' ' */
+#line 25389 ""
*lyrerr = 1;
+#line 25390 ""
return 0;
+#line 25391 ""
}
+#line 25392 ""
return 0;
+#line 25393 ""
}
+#line 25393 ""
}
+#line 25394 ""
goto L18;
} /* chkpmxlyr_ */
/* Subroutine */ int dopmxlyr_(char *lineq, integer *iccount, ftnlen
lineq_len)
{
- /* Initialized data */
-
- static char sq[1] = "\\";
-
/* System generated locals */
address a__1[4], a__2[6], a__3[7];
integer i__1, i__2[4], i__3[6], i__4, i__5[7];
@@ -39361,6 +63745,7 @@ L18:
s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
+ static char sq[1];
static integer i2nd, iend;
extern /* Subroutine */ int stop1_(void);
static integer itilde;
@@ -39369,7 +63754,7 @@ L18:
extern integer lenstr_(char *, integer *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1836 = { 0, 6, 0, 0, 0 };
+ static cilist io___1882 = { 0, 6, 0, 0, 0 };
@@ -39377,92 +63762,169 @@ L18:
/* with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', */
/* (unless preceded with '\'), check length */
+#line 25404 ""
+ *(unsigned char *)sq = '\\';
+#line 25405 ""
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 25410 ""
i__1 = *iccount;
+#line 25410 ""
i2nd = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
+#line 25411 ""
L2:
+#line 25412 ""
i__1 = i2nd - 2;
+#line 25412 ""
if (s_cmp(lineq + i__1, "\\", i2nd - 1 - i__1, (ftnlen)1) == 0) {
+#line 25413 ""
i__1 = i2nd;
+#line 25413 ""
i2nd += i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
+#line 25414 ""
goto L2;
+#line 25415 ""
}
+#line 25416 ""
istart = *iccount;
+#line 25417 ""
L1:
+#line 25417 ""
i__1 = istart;
+#line 25417 ""
itilde = istart + i_indx(lineq + i__1, "~", i2nd - 1 - i__1, (ftnlen)1);
+#line 25418 ""
if (itilde > istart && itilde < i2nd) {
/* Replace tilde if not preceded by \ */
+#line 25422 ""
if (iend >= 117) {
- s_wsle(&io___1836);
+#line 25423 ""
+ s_wsle(&io___1882);
+#line 25423 ""
do_lio(&c__9, &c__1, "Sorry, lyric string is too long, stopping",
(ftnlen)41);
+#line 25423 ""
e_wsle();
+#line 25424 ""
stop1_();
+#line 25425 ""
} else /* if(complicated condition) */ {
+#line 25425 ""
i__1 = itilde - 2;
+#line 25425 ""
if (s_cmp(lineq + i__1, sq, itilde - 1 - i__1, (ftnlen)1) == 0) {
+#line 25426 ""
istart = itilde;
+#line 25427 ""
goto L1;
+#line 25428 ""
}
+#line 25428 ""
}
+#line 25429 ""
i__1 = itilde;
/* Writing concatenation */
+#line 25429 ""
i__2[0] = itilde - 1, a__1[0] = lineq;
+#line 25429 ""
i__2[1] = 1, a__1[1] = sq;
+#line 25429 ""
i__2[2] = 3, a__1[2] = "lk ";
+#line 25429 ""
i__2[3] = iend - i__1, a__1[3] = lineq + i__1;
+#line 25429 ""
s_cat(lineqt, a__1, i__2, &c__4, (ftnlen)128);
+#line 25431 ""
iend = lenstr_(lineqt, &c__128, (ftnlen)128);
+#line 25432 ""
i2nd += 3;
+#line 25433 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
+#line 25434 ""
goto L1;
+#line 25435 ""
}
+#line 25436 ""
if (*iccount == 1) {
+#line 25437 ""
i__1 = i2nd;
/* Writing concatenation */
+#line 25437 ""
i__3[0] = 1, a__2[0] = sq;
+#line 25437 ""
i__3[1] = 7, a__2[1] = "pmxlyr{";
+#line 25437 ""
i__3[2] = i2nd - 2, a__2[2] = lineq + 1;
+#line 25437 ""
i__3[3] = 1, a__2[3] = "}";
+#line 25437 ""
i__3[4] = 1, a__2[4] = sq;
+#line 25437 ""
i__3[5] = 128 - i__1, a__2[5] = lineq + i__1;
+#line 25437 ""
s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128);
+#line 25439 ""
} else {
+#line 25440 ""
i__1 = *iccount;
+#line 25440 ""
i__4 = i2nd;
/* Writing concatenation */
+#line 25440 ""
i__5[0] = *iccount - 1, a__3[0] = lineq;
+#line 25440 ""
i__5[1] = 1, a__3[1] = sq;
+#line 25440 ""
i__5[2] = 7, a__3[2] = "pmxlyr{";
+#line 25440 ""
i__5[3] = i2nd - 1 - i__1, a__3[3] = lineq + i__1;
+#line 25440 ""
i__5[4] = 1, a__3[4] = "}";
+#line 25440 ""
i__5[5] = 1, a__3[5] = sq;
+#line 25440 ""
i__5[6] = 128 - i__4, a__3[6] = lineq + i__4;
+#line 25440 ""
s_cat(lineqt, a__3, i__5, &c__7, (ftnlen)128);
+#line 25443 ""
}
+#line 25444 ""
i2nd += 8;
+#line 25445 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
+#line 25446 ""
i__1 = i2nd;
+#line 25446 ""
if (s_cmp(lineq + i__1, "@", i2nd + 1 - i__1, (ftnlen)1) == 0) {
+#line 25447 ""
i__1 = i2nd + 1;
+#line 25447 ""
i__4 = i2nd + 4;
/* Writing concatenation */
+#line 25447 ""
i__3[0] = i2nd, a__2[0] = lineq;
+#line 25447 ""
i__3[1] = 3, a__2[1] = "at{";
+#line 25447 ""
i__3[2] = i2nd + 4 - i__1, a__2[2] = lineq + i__1;
+#line 25447 ""
i__3[3] = 1, a__2[3] = "}";
+#line 25447 ""
i__3[4] = 1, a__2[4] = sq;
+#line 25447 ""
i__3[5] = 128 - i__4, a__2[5] = lineq + i__4;
+#line 25447 ""
s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128);
+#line 25449 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
+#line 25450 ""
}
+#line 25451 ""
return 0;
} /* dopmxlyr_ */
diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.mid b/Build/source/utils/pmx/pmx-src/tests/barsant.mid
index cd8b9c33ee8..81ed8ffbd26 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 36a0b59989c..86c10b3ca4b 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.76 , 24 Nov 16
+This is PMX, Version 2.84 , 10 Feb 18
Opening barsant.pmx
Starting first PMX pass
diff --git a/Build/source/utils/pmx/pmx-src/version.ac b/Build/source/utils/pmx/pmx-src/version.ac
index 5ec24b2cc5d..922c5f9c51e 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.7.6])
+m4_define([pmx_version], [2.8.4])
diff --git a/Build/source/utils/pmx/pmxab.1 b/Build/source/utils/pmx/pmxab.1
index 381324e5641..348517f4aee 100644
--- a/Build/source/utils/pmx/pmxab.1
+++ b/Build/source/utils/pmx/pmxab.1
@@ -1,4 +1,4 @@
-.TH pmxab 1 "2 Feb 2016" "Version 2.7.3" "PMX Manual Page"
+.TH pmxab 1 "12 Feb 2018" "Version 2.8.4" "PMX Manual Page"
.SH NAME
pmxab \- a MusiXTeX preprocessor
.SH SYNOPSIS
diff --git a/Build/source/utils/pmx/version.ac b/Build/source/utils/pmx/version.ac
index dc2fa993f6d..dc5334bd99d 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.7.6])
+m4_define([pmx_version], [2.8.4])