From c65f64773377dd048b7caf1109018f922736db93 Mon Sep 17 00:00:00 2001 From: Akira Kakuto Date: Mon, 7 Mar 2022 21:25:07 +0000 Subject: pmx-2.9.8a git-svn-id: svn://tug.org/texlive/trunk@62494 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/utils/README | 2 +- Build/source/utils/pmx/ChangeLog | 4 + Build/source/utils/pmx/TLpatches/ChangeLog | 4 + Build/source/utils/pmx/TLpatches/TL-Changes | 6 +- Build/source/utils/pmx/configure | 20 +- Build/source/utils/pmx/pmx-src/ChangeLog | 8 + Build/source/utils/pmx/pmx-src/Makefile.am | 6 +- Build/source/utils/pmx/pmx-src/Makefile.f2c | 4 +- Build/source/utils/pmx/pmx-src/pmx.test | 13 +- Build/source/utils/pmx/pmx-src/pmx294.for | 26085 ---------- Build/source/utils/pmx/pmx-src/pmx298.for | 26079 ++++++++++ Build/source/utils/pmx/pmx-src/pmxab.c | 53843 +++++++++++---------- Build/source/utils/pmx/pmx-src/scor2prt.c | 3080 +- Build/source/utils/pmx/pmx-src/scor2prt.for | 3263 +- Build/source/utils/pmx/pmx-src/tests/barsant.mid | Bin 3071 -> 3071 bytes Build/source/utils/pmx/pmx-src/tests/barsant.pml | 3 +- Build/source/utils/pmx/pmx-src/version.ac | 2 +- Build/source/utils/pmx/version.ac | 2 +- 18 files changed, 56368 insertions(+), 56056 deletions(-) delete mode 100644 Build/source/utils/pmx/pmx-src/pmx294.for create mode 100644 Build/source/utils/pmx/pmx-src/pmx298.for (limited to 'Build') diff --git a/Build/source/utils/README b/Build/source/utils/README index 0709aa39b6b..eb426bbb75e 100644 --- a/Build/source/utils/README +++ b/Build/source/utils/README @@ -23,7 +23,7 @@ lacheck - maintained here, by us m-tx 0.63a - checked 29apr18 https://ctan.org/pkg/m-tx/ -pmx 2.9.4a - checked 30jan21 +pmx 2.9.8a - checked 08mar22 https://ctan.org/pkg/pmx/ ps2eps 1.70 - checked 03jul21 diff --git a/Build/source/utils/pmx/ChangeLog b/Build/source/utils/pmx/ChangeLog index 56c1eb40559..03ac406bb11 100644 --- a/Build/source/utils/pmx/ChangeLog +++ b/Build/source/utils/pmx/ChangeLog @@ -1,3 +1,7 @@ +2022-03-08 Akira Kakuto + + * Import pmx 2.9.8a. + 2021-01-30 Akira Kakuto * Import pmx 2.9.4a. diff --git a/Build/source/utils/pmx/TLpatches/ChangeLog b/Build/source/utils/pmx/TLpatches/ChangeLog index 6fa8be3a67b..72e3b9cfbaa 100644 --- a/Build/source/utils/pmx/TLpatches/ChangeLog +++ b/Build/source/utils/pmx/TLpatches/ChangeLog @@ -1,3 +1,7 @@ +2022-03-08 Akira Kakuto + + * import pmx-2.9.8a. + 2021-01-30 Akira Kakuto * import pmx-2.9.4a. diff --git a/Build/source/utils/pmx/TLpatches/TL-Changes b/Build/source/utils/pmx/TLpatches/TL-Changes index 713f61b08c5..f2b919d0748 100644 --- a/Build/source/utils/pmx/TLpatches/TL-Changes +++ b/Build/source/utils/pmx/TLpatches/TL-Changes @@ -1,6 +1,6 @@ -Changes applied to the pmx-2.9.4a tree as obtained from: +Changes applied to the pmx-2.9.8a tree as obtained from: http://www.ctan.org/tex-archive/support/pmx/ Remove: - Makefile.in aclocal.m4 arith.h configure depcomp install-sh - missing test-driver + Makefile.in aclocal.m4 arith.h compile configure depcomp + install-sh missing test-driver diff --git a/Build/source/utils/pmx/configure b/Build/source/utils/pmx/configure index 14f8c50dd38..c6d553bd836 100755 --- a/Build/source/utils/pmx/configure +++ b/Build/source/utils/pmx/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for pmx (TeX Live) 2.9.4a. +# Generated by GNU Autoconf 2.71 for pmx (TeX Live) 2.9.8a. # # Report bugs to . # @@ -611,8 +611,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='pmx (TeX Live)' PACKAGE_TARNAME='pmx--tex-live-' -PACKAGE_VERSION='2.9.4a' -PACKAGE_STRING='pmx (TeX Live) 2.9.4a' +PACKAGE_VERSION='2.9.8a' +PACKAGE_STRING='pmx (TeX Live) 2.9.8a' PACKAGE_BUGREPORT='tex-k@tug.org' PACKAGE_URL='' @@ -1313,7 +1313,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures pmx (TeX Live) 2.9.4a to adapt to many kinds of systems. +\`configure' configures pmx (TeX Live) 2.9.8a to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1380,7 +1380,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of pmx (TeX Live) 2.9.4a:";; + short | recursive ) echo "Configuration of pmx (TeX Live) 2.9.8a:";; esac cat <<\_ACEOF @@ -1477,7 +1477,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -pmx (TeX Live) configure 2.9.4a +pmx (TeX Live) configure 2.9.8a generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -1865,7 +1865,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by pmx (TeX Live) $as_me 2.9.4a, which was +It was created by pmx (TeX Live) $as_me 2.9.8a, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -4408,7 +4408,7 @@ fi # Define the identity of the package. PACKAGE='pmx--tex-live-' - VERSION='2.9.4a' + VERSION='2.9.8a' printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h @@ -6464,7 +6464,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by pmx (TeX Live) $as_me 2.9.4a, which was +This file was extended by pmx (TeX Live) $as_me 2.9.8a, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6523,7 +6523,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -pmx (TeX Live) config.status 2.9.4a +pmx (TeX Live) config.status 2.9.8a configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/Build/source/utils/pmx/pmx-src/ChangeLog b/Build/source/utils/pmx/pmx-src/ChangeLog index 3453c44fc50..e5389c77f5c 100644 --- a/Build/source/utils/pmx/pmx-src/ChangeLog +++ b/Build/source/utils/pmx/pmx-src/ChangeLog @@ -1,3 +1,11 @@ +2.98 + Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...) +2.97 + Fix problem with beaming after new movement command +2.96 and 2.95 + replace and '\','/'. and '"' with chax(); + eliminate do loops with shared last line + delete superfluous comments in source 2.94 Allow moving dots on main and chord note in 2-note termolos Add definitions of \hbp and \hbpp to pmx.tex diff --git a/Build/source/utils/pmx/pmx-src/Makefile.am b/Build/source/utils/pmx/pmx-src/Makefile.am index 8d03490b750..b9e781a1b93 100644 --- a/Build/source/utils/pmx/pmx-src/Makefile.am +++ b/Build/source/utils/pmx/pmx-src/Makefile.am @@ -2,7 +2,9 @@ ## You may freely use, modify and/or distribute this file. ## -INCLUDES = -I$(srcdir)/libf2c +AUTOMAKE_OPTIONS = subdir-objects + +AM_CPPFLAGS = -I$(srcdir)/libf2c bin_PROGRAMS = pmxab scor2prt @@ -236,7 +238,7 @@ PATCHES = libf2c/patch-01-binary libf2c/patch-03-DOS-line-endings \ ## pmx.test EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \ tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx -EXTRA_DIST += scor2prt.for pmx294.for +EXTRA_DIST += scor2prt.for pmx298.for EXTRA_DIST += $(PATCHES) EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c EXTRA_DIST += pmx.tex diff --git a/Build/source/utils/pmx/pmx-src/Makefile.f2c b/Build/source/utils/pmx/pmx-src/Makefile.f2c index 3020abf71a4..f90a009171e 100644 --- a/Build/source/utils/pmx/pmx-src/Makefile.f2c +++ b/Build/source/utils/pmx/pmx-src/Makefile.f2c @@ -1,7 +1,7 @@ all: pmxab.c scor2prt.c -pmxab.c: pmx294.for - f2c -g -\!bs < pmx294.for > pmxab.c +pmxab.c: pmx298.for + f2c -g -\!bs < pmx298.for > pmxab.c scor2prt.c: scor2prt.for f2c -g -\!bs < scor2prt.for > scor2prt.c diff --git a/Build/source/utils/pmx/pmx-src/pmx.test b/Build/source/utils/pmx/pmx-src/pmx.test index 4055a6e47ed..adba6cfab89 100755 --- a/Build/source/utils/pmx/pmx-src/pmx.test +++ b/Build/source/utils/pmx/pmx-src/pmx.test @@ -1,11 +1,20 @@ #! /bin/sh -# Copyright (C) 2012 Peter Breitenlohner +# Copyright (C) 2021 Bob Tennent # You may freely use, modify and/or distribute this file. rm -f barsant* pmxaerr.dat +if test -r "$srcdir/tests/barsant.pmx"; then + : # standalone pmx +elif test -r "$srcdir/pmx-src/tests/barsant.pmx"; then + srcdir=$srcdir/pmx-src # in TL +else + echo "$0: cannot find tests/barsant.pmx" >&2 + exit 1 +fi -cp $test_src/barsant.pmx . + +cp "$test_src/barsant.pmx" . || exit 1 failed= diff --git a/Build/source/utils/pmx/pmx-src/pmx294.for b/Build/source/utils/pmx/pmx-src/pmx294.for deleted file mode 100644 index 73537dcc8a9..00000000000 --- a/Build/source/utils/pmx/pmx-src/pmx294.for +++ /dev/null @@ -1,26085 +0,0 @@ - program pmxab -c -c This program, PMX, developed by Don Simons -c (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with -c MusiXTeX and TeX, its purpose is to allow the user to create high-quality -c typeset musical scores by including a sequence of PMX commands in an ASCII -c input file. -c -c This program is free software: you can redistribute it and/or modify -c it under the terms of the GNU General Public License as published by -c the Free Software Foundation, either version 3 of the License, or -c (at your option) any later version. -c -c This program is distributed in the hope that it will be useful, -c but WITHOUT ANY WARRANTY; without even the implied warranty of -c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -c GNU General Public License for more details. -c -c You should have received a copy of the GNU General Public License -c along with this program. If not, see . -c -c - character*9 date - character*5 version,versionc - common /comver/ versionc -c -c To compile with gfortran: -c 1. Merge all files using copy *.for epmx[nnnn].for -c 2. Search and replace all character*65536 with character*131072 -c 3. Comment/uncomment getarg lines -c 4. gfortran -O pmx[nnnn].for -o pmxab.exe -c -c To do -c Correct Rainer's email address in manual -c Linesplit (\\) in h -c Tt at start of a movement. -c Toggle midi on or off; allow midi only. -c Page number printed on 1st page even if 1 system. -c Still need inserted space for chordal accidentals -c Voicewise transposition. -c better segno -c coda -c duevolte -c Fix xtup bracket direction in 2-line staves?? (maybe leave as is) -c Sticky ornaments with shifts. -c Deal with Werner's vertical spacing thing associated with title. -c Multiple ties in midi -c Werner's missing c in MIDI due to start/stop ties on same note. -c Beams with single 64ths -c 128ths and/or dotted 64ths -c Close out MIDI with integral # of beats? -c Increase ast dimensions or redo logic. -c Does slur direction get set for user-defined single-note stem dir'ns? -c Transpose by sections. -c Optimization loop over sections only -c Command-line option to read nbarss in. Write out nbarss when optimizing. -c (or just read from .plg?) -c Beams over bar lines. -c 2-digit figures -c A real coule (slanted line between notes in a chord) -c Dotted slurs for grace notes. -c Undotted chord notes with dotted main note. -c Forced line break without line number -c Fix dot moving when 2nds in chord get flipped -c To do: increase length on notexq in dodyn -c 2.94 -c Allow moving dots on main and chord note in 2-note termolos -c Add definitions of \hbp and \hbpp to pmx.tex -c 2.91 -c Tweak: insert \stdstemfalse before every user-shortened or lengthened stem. -c This cancels defaul extensions to middle line and also (with 'L') allows -c stems that are longer than 4.66 but still don't reach middle line. -c Allow alteration of number height in multibar rest, option n. -c Fix bug introduced in 2.89 so that the "o" in "mo800" is now OK. -c 2.90 -c Many tweaks to allow gaps at end or middle of a system using -c L[n]S[x] and LC[y]. New pmx.tex. -c 2.88 -c Comment out print*,"Changed pathname to..." since it was going -c iteration when optimizing linebreaks with the undocumented option Ao. -c Add nv back in as argument for getmidi, so loop transferring data -c from midivel to midvelc can be executed. This corrects bug and -c allows per-instrument change in midi velocities at the start -c of any block -c Add subroutine inst2chan to transfer midi data as noted above. Works with -c Iv but buggy when used with IT and Ib -c 2.87 -c Allow changes to and from octave treble clef. Instrument with it -c must only have one staff. -c Some fixes for beam multiplicity changes at staff jumps. Must still -c use inline for mult. increase at downward staff jump. See sjb.pmx. -c 2.84 -c Bug fix: dots in chordal seconds -c Bug fix: Initialize ihornb for non-beamed, down xtup -c Bug fix: When using "AT" with 2-note x3c rD. -c 2.83 -c Fix problems when changing to or from octave treble clef. -c Fix beaming (or not) and number location for xtups with -c multiple rests. Still some problems with number height but -c can be band-aided with number height tweak option. -c Tweak error messages for options on "R" command. -c Allow forced beam height and slope tweaks with 2-note tremolos -c Allow chordal note with 2-note tremolos, adding dots as needed. -c Fix call to ncmid in beamstrt when setting start height for beam of -c 2-note trem, by changing arg from ivx to iv -c 2.82 -c bugfix: beams with rests, not confused with xtups. -c x option after slur index to allow slurs to go from one voice to another. -c x option also for ties -c 2.81 -c Allow string of rests to end xtup -c in chordal half-note 2-note tremolo, make chord notes open. -c 2.80 -c Add 2-note tremolos -c 2.78 -c Expand bufq to 131072 bytes -c Expand maxblks tp 9600 -c Allow up to 75 pages -c Index postscript hairpins from 1 up instead of by voice #. -c Add option 'o' to forced beam for open notehead (\hb); set ipl(3) -c Add option T[n], n=1,2,3 for single stem tremolo -c 2.77 -c Enable AV+/-x+/-y to add vskip bigh before or after \eject -c 2.76 -c 2.75 -c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and -c 2 or 3 flags on shortened note. -c 2.74 -c Bugfix: allow "0" as argument of @ command on lyrics string. -c Check for and allow "\ in centered page headings with P command. -c Check for and allow "\ in text dynamics with D command. -c For lyrics string starting in xtuplet, insert check for inputting musixlyr. -c For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam -c starts with a blank rest, put '\sk' into the TeX. -c To enable high-to-both beamed etup staff-crossing chord, for blank -c rest at start of forced beam, shift \sk's from before to after \ib..; -c so \ib is at start and note in upper voice has a beam to connect to. -c Expand range of vertical xtup number shift, now stored in mult(16-22) -c Check for and allow \" within lyrics strings, for umlauts. -c 2.73 (160121) -c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as -c inline TeX. Replace all '~' inside "..." and not preceded with '\', by -c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ -c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", -c add (as type 2 string) '\\input musixlyr \' -c After inputting pathname, change any '\' to '/', for Linux compatibility. -c 2.72 (160110) -c Really finalize \mbrest...go back to 3 args to deal with clef changes. -c Fine tune centered whole bar rests to deal with clef changes -c Fix bug in wsclef when >1 staff per instrument, since \setclef -c needs to know instrument and specify clefs on all staves for that -c instrument. Ones that were not changed by user will not be printed, -c and will be kept the same as before. -c Fix bug with arpegii from one voice to another in same staff. -c 2.71 (151226) -c Finalize mbrest mods -c 2.705 -c Fix error message -c 2.704 (140614) -c Octave treble clef -c Make horizontal ornament shift (ornhshft) floating -c 2.703 (140323) -c Option v[-]n at end of any figure will alter figdrop for rest of system -c 2.702 -c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" -c 2.701 -c oC = coda (\code{10}) -c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) -c oG = new seqno -c To do: fix grace note spacing problem (partially done) -c 2.622 -c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes -c Kn[+/-...] \ignorenats at signature changes -c Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs -c before checking and setting pitch levels levson() and levsoff() -c Define midisig separately from isig. Put in common commidisig. -c Use for explicit midi signature and for accid corrections to midi piches -c in addmidi. -c 2.621 -c Make keyboard rest option work in xtuplets. Created subroutine -c chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd. -c 2.620 -c Allow user-defined rest height tweaks at start of beam. -c 2.619 -c At movement break, change \nbinstruments in \newmovement macro; add -c 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for -c to remove call to newnoi and change call to \newmovement -c 2.618 -c Add option Ac[l,4] to set vert and horiz size and offsets to properly -c center page for letter or a4 paper. -c 2.617 -c In g1etnote, change if-check for note to use index(...) instead -c of ichar(charq) since it was messing up gfortran optimizer -c After pmxa, search for and remove penultimate line / -c because it was screwing up linux-compiled versions -c Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...) -c 2.616 (111110) -c Allow hairpins to span multiple notes groups (gulps). -c 2.615+ (110810) -c Fix midi when some instruments are transposed, by subtracting -c iTransAmt(instno(iv)) from pitch values sent to via addmidi in -c make2bar.for (for main notes) and docrd (for chord notes) -c 2.615 (110725) -c Fig bug with size-setting (in topfile) when instrument has >1 staves -c 2.615 (110724) -c Make AS[0|-|s|t]... really set sizes -c 2.614 -c Mod notex.for to fix Terry's bug with raised dotted rests (caused -c by double-hboxing). -c 2.613 -c Bugfix: In pmxa, change "do while" limit to keep from overwriting instno. -c 2.612 -c Enhance AS to allow s or t for smallsize or tinysize -c 2.611 -c Error trap for "D" before any notes in a block. -c 2.610 -c Instrument-wise key changes and transposition (incomplete) -c 2.603 -c 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors -c following reading in an include file. -c 101121 Added some error messages in g1etset.for setup data -c 2.602 -c Correct slur indexing in linebreakslurs. -c Account for comment lines in line count for error messages -c 2.601 -c Bug fix: allow 24 slurs with graces -c 2.60 Changes made make it really big -c increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o -c major reprogramming, and 16 may also be a problem (icmm) -c nm=24 (voices) done -c 24 slurs done -c 24 simultaneous beams (Replace index 24 by 0, so get 0-23) -c bufq*131072 (gfortran only) -c getarg syntax (gfortran only) -c 2.523+ -c Fix voice numbering for normal dynamics and text dynamics -c 2.523 -c Version of bigpmx first posted to Hiroaki's web site. -c 2.522 -c 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it. -c With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices. -c 5/13/10 Fix log2 function -c 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. -c 2.521+ -c 091025 Enable dotting 2nd part of linebreak slur or tie. -c To adjust barno height due to linebreak slur, use \bnrs instead of -c explicitly redefining \raisebarno (pmxb) -c 2.521 -c Bugfix -c 2.520 -c 090519 Enable ligfonts (special figured bass characters) -c 2.519 -c Fix another bug which kept \sk from being output so misaligned some notes. -c 2.518 -c Fix bugs: referencing fig data, char declaration for member of -c common/comfig/ -c 2.517 -c Allow figures in voice 1 + any one other. -c 2.516 -c Allow figures in voice #2 -c 2.515+ to do: Change manual and activate rule against clef change in voice #2. -c 2.515 -c 071222 Changes in getnote to allow auto forced beams to start anywhere. -c 071206 In make2bar, shift fermataup7 to left over centered pause. -c 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line -c staff (it was screwing up vertical justification). -c n34 for tweaks to midi durations of quarter note septuplets. -c To do: In ref250.tex, the tables where 's,t,)' is explained, the line -c [+,- i] ... Vertical adjustment of the start of second segment -c should it be replaced by -c [s +,- i] ... Vertical adjustment of the start of second segment -c 2.514 -c Changes in make2bar to get horizontal spacing right when normal grace -c follows after grace -c Changes in dograce to get octaves right for any material entered inside -c \gaft, which shields transpose register changes from the outside world. -c 2.513 -c In make1bar, near end, for forced beams starting with a rest, copy hgt and -c slope tweaks to ALL notes after first, not just the second one, so if -c there's more than one rest at start the tweaks are still observed. -c In beamid and beamend, add stand-alone triply-flagged notes for xtups. -c 2.512 -c Near end of pmxb, fix error trap to allow redundant 'RD' -c Enable multiplicity down-up '][' within xtup. -c 2.511 -c Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by -c adjusteskz as in bar 7 of barsant. -c 2.510a -c Test: remove restriction on tempo changes in MIDI macros -c Send to CM for beta testing. -c 2.509+ -c To do: Correct manual on AS. "-" is for smaller staves. -c 2.510 -c Forgot to declare litq, voltxtq as character in subroutine getgrace -c 2.509 -c Corrected small bug in arpeggio shifting (ivx <= iv in call putarp) -c 2.508 -c Allow graces in xtups. New subroutine getgrace. -c 2.507 -c To do: Raise/lower figures. -c To do: Add 24, 29 to list of musicsizes in manual -c New sub adjusteskz to account for ask's when computing lengths of -c brackets for unbeamed xtups, slopes and horizontal posn's of number -c Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags -c Add look-left option for keyboard rests, "L" in rest command, set iornq(30) -c 2.506 -c Fix bug with AK, when simultaneous rests have same duration, use defaults. -c 2.505 -c Keyboard rests AK -c 2.504 -c Space after normal grace: option X[n] -c Fixed og when nv .ne. noinst, by using sepsymq instead of '&' -c (To do) length of xtup bracket when there is added non-collision space. -c Trap musicsize if .ne. 16,20,24,29. -c 2.503 -c Enable arpeggio left shift with ?-x -c To do: In manual, arpeggio over 2 staves. -c Allow musicsize of 24 and 29. Had to define meter font size explicitly, -c also change font size for text dynamics, but not much else so far. -c Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn -c was called, causing error in printing replacement number. -c 2.502 -c Incorporate Dirk Laurie's patch to use { , } , for ties. -c Figure height adjustment: append +[n] -c Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?) -c 2.501 -c Readjust horizontal offset back to .8 in LineBreakTies -c Fix zero-subscript (iudorn) in putorn -c 2.50 -c Increase number of text-dynamics (dimension of txtdynq) per block -c from 12 to 41. -c Slur option n to override altered default curvature. -c Allow default ps slur curvature tweaks with Ap+/-c -c 2.416 -c Increase length of textdynq from 24 to 128 -c (Todo) Add comment in manual about blank lines at end. -c Configuration file: Define subroutine getpmxmod, check path in environment -c variable pmxmoddir, check existence, read lines into bufq after setup. -c Increase dimension on idynn in dodyn from 4 to 10 for max number -c of marks in a bar -c Increase allowable # of lines from 2000 to 4000. -c (To do) Replace definition of \liftpausc per Olivier. -c (To do) Fix extraneous error message if RD is placed at very end. -c 2.415 -c Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt -c instead of redefining \xnum. Change font used to \smallfont (as for -c normal xtups, -c Allow slur to start on rest. -c 2.414 -c Correct bug in crdacc when adding accidental to boundary causes number of -c segments to decrease -c Special rule for 3-accidental chords: If no 2nds, place them in order -c top, bottom, middle. -c 2.413 -c Correct bugs in chordal accidentals, related to left-shifted noteheads -c (a) Special problems with downstem when main note needs shifting -c (b) Assign 0 rank to boundary segs due to left-shifted noteheads -c 2.412 -c Change default horiz shift of start of seg 2 of linebreak slurs: -c -.7 for slurs, -1.2 for ties, -c Use height of start of seg 1 slur itself for end of 1 and start of 2. -c 2.411 -c "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2. -c "s" option in start of slur/tie as precursor to vert/horiz tweaks for end -c of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2. -c With "Apl", curvature adjustments on starting slur command apply to seg 1, -c those on ending command to seg 2. -c 2.410 -c "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine -c \xnum, \unbkt, \ovbkt. -c "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is -c flag, mult(5-9) is tweak value+16 -c 2.409 -c Bugfix in docrd for MIDI: Use original pitch in case main/chord were -c switched due to 2nds. -c Remove "o" from error message for "A" command. -c New syntax: optional instrument number separator ":" in movement -c break command to precede a 2-digit instrument. -c Conditional output formats for \setname at movement break to allow -c instrument numbers >9. -c Bugfix in coding to raise barno due to slur over line break (pmxb) -c Move date/version data statement in pmxab to a better place. -c 2.408 -c Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar). -c Bug fix in \liftPAusep in notex.for and in pmx.tex -c Character variables for version and date -c For up-stem single graces slurred to down-stem, shift slur start left by -c 0.8 so slur doesn't get too short. -c Initialize and slide mult, same as other full-program variables in /all/. -c 2.407 -c Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n, -c 2.406 -c Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing -c equalization). -c Put dimensions of double sharps and flats in crdacc (for chords). -c Bugfix: Use sepsymq in LineBreakTies(..) instead of '&' -c Use only first 4 bits of mult for multiplicity+8, so rest can be used -c for other stuff. -c Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict. -c 2.405: Not published but saved for safety. -c Option Aph to write \special{header=psslurs.pro} top of each page, so -c dviselec will work OK. -c 2.404 -c Allow slur to end on rest, but not start on a rest. Efaults height -c of ending is default height of start (before any automatic or user- -c defined djustments). User may adjust height as normal from default. -c 2.403 -c Bugfix: turn off repeated beaming patterns.at end of non-last voice. -c 2.402 -c Automatic repeated forced beams. Start with "[:" End with next explicit -c forced beam or end of input block. -c Increase # of forced beams per line of music per input block from 20 to 40 -c 2.401 -c Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies. -c Makes 1st part normal shape, and starts 2nd part a little further left. -c Enable arpeggios in xtuplets. Had to make time itar(narp) a real. -c 2.40 -c Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap. -c Fix non-ps-slur input to \midslur (third signed integer). Do not reverse -c sign for down-slurs. -c 2.359 -c Add error exit subroutine stop1 to make exit status g77-compatible.. -c Absolute octave on xtup chord note was 2 octave too high, fixed in getnote -c Fermata on vertically shifted rest: special trap in putorn() to set height. -c Correct multiple grace note spacing for small staves (in dograce, -c define wheadpt1 depending on staff size) -c 2.358 -c Allow curvature corrections at start of postscript slur, in dopsslur() -c Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust -c Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h] -c Make t[ID] act like s[ID]t, most mods in spsslur(). -c Add spsslur() to read in data for ps slurs, call from getnote. -c In beamstrt, save args for SetupB in common comipb to save them for -c 2nd call when xtup starts with rest -c Add spacing for ornament ")" as if it were accidental, in make2bar(). -c Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur() -c Horiz. shift start of ps grace slur, 2 places in dograce(). -c Horiz shift end of grace slur in endslur() -c Make st slurs into postscript ties. Separate subroutine dopsslur(), -c Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.) -c Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn. -c 2.357a -c Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote -c 2.357 -c Increase dimension for # of lit TeX strings from 52 to 83. -c Allow blank rest in middle of xtuplet. Only mods in g*etnote(). -c 2.356 -c Increased some dimensions from 30 to 40 to allow up to 40 pages. -c In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt(). -c Fix parsing of "f,h,H,HH" in sslur. -c Fix bug with cdot, note-level for slur termination (in getnote) -c 2.355 -c Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], -c n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues -c Make midi recognize ps ties in doslur. -c Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote -c to get octave right. -c 2.354 -c With postscript slurs, make t-slurs real ties by inserting replacement -c macros \tieforisu, etc, defined in pmx.tex -c Check for open cresc or decresc at end of input block, using list[de]cresc -c Hairpin syntax conditional on postscript slurs. Backup to fill in start -c level, using new backfill(...). Separate height tweaks for -c start and finish. -c 2.353 -c K-0+n to transpose by half step (rather than just change key) -c Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of -c \mbrest's -c Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end -c of input block before movement break, and at start of block after -c movement break, using \newmovement rather than \setzalaligne, since -c former already redefines \stoppiece. In second case, set rptfg2='z'. -c Make clefq(nm) common between pmxb and getnote; change references in -c getnote at 'M' to array elements, setting all new clefs as you go. -c 2.352 -c Remove \parskip redefinition from pmx.tex; write it into TeX file when -c "Ae" is invoked. -c Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine -c \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH', -c translate them thru mapping to (1,4,5,6) as \midslur params, then let -c \psforts translate them back to ps slur macors. -c 2.351 -c Number slurs from 0 up instead of 11 down, anticipating postscript slurs. -c Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size. -c Increase length of basenameq to 44 characters everywhere. -c Increase dimension of mcpitch (midi-chord-pitch) to 20. -c Set default systems per page to 1 if nv>7 -c In pmxb, move place where isystpg is reset to 0, so that \eject gets -c written when there is just one system per page. -c 2.35 -c Cautionary accidentals with 'c' anywhere in note symbol. -c NEW pmx.tex with \resetsize to set size to normal or small depending on -c current \internote. Used with new coding in dograce() to get right -c new size in case user has \setsize'ed some lines to \smallvalue. For -c \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. -c Affects pmx.tex. -c Continuation figure with fractional length. May now mix with other figures. -c If another figure follow Cont-fig, separate with colon. -c 2.342 -c Bugfix in getnote to recognize relative octave shift in grace at start of -c input block. -c In make2bar, initialize islhgt=0 earlier than before (possible solution -c to Suse g77 compile problem that I could not reproduce).. -c Bugfix in beamstrt & beamn1 for r2x6 c4D d d d -c 2.341 -c Syntax check: Forced page break page number must be > than previous. -c Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb. -c 2.34 -c New pmx.tex with redefined liftpausc -c Bug fix with dotted, non-beamed xtups. -c 2.332 -c Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads. -c Allow arbitrary pos. input to W in g1etnote and getnote. -c 2.331 -c Bug-fix in dodyn(..): typo on length of arg of txtdyn -c 2.33 -c Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata() -c 2.321 -c Rescale accidental shifts. Still use 7 bits but now map (0,127) -c onto (-1.,5.35) -c Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups -c 2.32 (Noticed after posting) -c Prohibit "/" as figure. -c 2.32 (Posted) -c Tidied up accidentals in chords, do spacing. -c Still to do: -c check for "(" on chord notes in spacing algo -c small accids -c double accids -c autoshift slurs -c 2.310 -c Extra call to precrd ahead of spacing chk, and single-note crd/acc -c shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time. -c 2.309 -c Alternate algo for accid shifts in chords. -c 2.308 -c Auto horiz. notehead shifting added to precrd. -c 2.307 -c Auto shifting of multiple accidentals in chords. -c "Ao" in main chord note to keep accidentals in order. Set nacc(28). -c If there are any manual main or chord note shifts, then -c If any manual shift is preceded by "A" then -c 1. Auto-shifting proceeds -c 2. "A"-shifts add to autoshifts -c 3. non-"A" shifts are ignored! -c Else (>0 man shifts, none has "A") -c No auto-ordering, No autoshifts, -c End if -c End if -c 2.306 -c Initialize legacy note level to middle C in case user forgets to set -c octave. -c Shift xtup note? -c Shift in elemskips rather than noteheads? -c 2.305 -c Stop pmxb from multiple endvolta's at start of new page. -c 2.304 -c "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on -c for multiple notes in the voice, "S:" last shortened note. -c 2.303 -c vshrink stuff all OK? Description is in pmxb. -c 2.302 -c Toggle vshrink with "Av". vshrink normally kicks in when \interstaff -c hits 20. This still needs work. -c Add " /" to last line if last char is not % or /. -c 2.301 -c Check in beamn1 for single note before multiplicity down-up. -c allow '.PMX' as well as '.pmx' -c 2.299 -c Correct typo in pmxb involving PMXbarnotrue. -c Replacement printed number for xtup: Unsigned integer after 'n' after 'x' -c Minor upgrade parsing xtuplet options 'x...' -c Correct dimension of nxtinbm in make2bar. -c 2.298 -c Account for doubled xtup notes in subroutine getx (user-defined spaces), -c by adding ndoub as an argument.. -c 2.297 -c Created and solved compiler problem. Put drawbm(NM) in its own common. -c Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar -c when \centerbar is used. -c Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX -c use right 2nd and 3rd args for \mbrest when key, meter, or clef changes. -c 2.296 -c Correct printed numbers for forced beams with multiple xtups. For each beam -c make list in setupb by voice of eloff (h-offset) and mtupv (printed #) -c Increase lengths of jobname and infileq by 20 characters -c Enable whole notes and breves as 1st or last note of xtup in beamn1 and -c beamend, and wholes in beamid. -c 2.295 -c Midi balance Ib[n1]:[n2]:...[nn] -c Single-slope beam groups [...]-[...] -c Trap "i" unless after accidental (main notes, xtups, chord notes) -c 2.294 -c Unequal xtups with "D" to double a note in an xtup. -c As above, "F" will (a) increase multiplicity by 1 for marked note and next -c one and (b) add a dot to the first one. -c Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on -c when "." is encountered, then correcting beam start time.(end of getnote) -c MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]... -c 2.293 -c Check for single notes spanning bar lines. -c Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup -c must be set in make2bar since beamstrt is not called, fixing problem with -c dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix -c problem when >2 staves. -c Add nodur to args of dodyn, so can check if stemless and avoid height tweak -c Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak -c 2.292a -c Undo syntax check for Type 2 or 3 TeX string starting in column 1. -c Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! -c 2.292 -c Allow comments in xtuplets -c Enable multiple octave jumps in grace notes. -c Allow dynamics in xtuplets. -c Fix bug in getdyn searching for end of text string (correct length of lineq -c to 128) -c Fix bug in dodyn, must ignore horiz. interaction tweak for -c user-text (idno = 0) -c Syntax check for Type 2 or 3 TeX string starting in column 1 -c (NOTE: later undone!) -c Syntax check for page number > npages at forced line break. -c 2.291 -c Fix error in AS command (accid spacing for small systems), making only -c one spec per staff, nv total. -c Stop using MIDI channel 10 -c 2.29 -c Fix error in console output format for # of bytes used in MIDI file. -c Fix bug in dograce so no space is added between grace and main note when -c there is a MIDI-only accidental. -c Fix bug so oes?+4 works. It was too ugly to explain. -c ...Different ways of storing accidental specs on input and output. -c No longer zap \writezbarno in special situations. -c Fix bug in dyntxt level on rest -c Line spacing equalization. Add macros \starteq, \endeq, \spread, etc. -c Activate with Ae. (Maybe later could input alternate values for -c \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1 -c in the page, and \endeq on 1st note of next-to-last line in page. -c 2.28 -c Flip direction of forced beam "[f..." -c Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) -c Fix bug in sliding ip's for txtdyn's -c In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99) -c 2.27 -c Comment out lines in dodyn checking number of dynamic marks found. Voice -c order may not be monotonic if two lines on a staff. -c Literal dynamic: D"[text]" -c 2.26 -c Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn, -c increasing dimension of idynn to 4 to allow 4 symbols on same note. -c Increase voltxtq length from 10 to 20. -c AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough -c accounting for ast's is done by defining effective headwidth -c whead1 in makebar2 to be 0.8*whead. -c 2.25 -c Fix logic bug with sepsym's when # of instruments changes. -c Slight increases in default offsets for hairpin starts after "p" -c 2.24 -c Hairpins D< or D> as toggle. -c Many automatic position tweaks for letter-group dynamics and hairpins. -c 2.23 -c Continued rhythmic shortcuts: space followed by "." or "," -c 2.22 -c In call to doslur, change tno(...) to tnote(...). This was only -c used when checking to slurs per stem directions, and should have been -c the note duration all along. -c MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. -c Use "i" anywhere in note symbol. -c 2.21 -c Increase from 20 to 30 dimensions for movement breaks and midi sections. -c Fix out-of-order declarations per mutex comments -c Add "Bad error" and "Kluging" messages to log file. -c 2.197 -c add /comips/ to save tie-check midi variables -c For spacing of clef changes at start of input block, changed integer time -c lastnodur to prevtn, so it works with xtups. Possible incompatibility! -c 2.196 -c Fix Ickbug with time check in ncmid() -c Interchange \fermataup7 and \pausec to get proper alignment -c Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX. -c Add defn's of \hsp, \hspp to pmx.tex -c Fix pre-slurs on xtup chord notes. -c Fixed raised PAuse, define \liftPAuse -c Replace \zbreve\sk with \breve. -c Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what -c about "o" and 1 as shorthand for 16???? Search for "Kluge" -c Added "vo" (voice) as MIDI instrument 55 -c Allow 3-digit page numbers (search for "toppageno") -c Fix bug caused by prior fix (cancelling accid after bar line was ignored). -c Fix double accids in chords -c 2.194 -c Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if -c block. -c Add meter to MIDI file with every pause -c Purify FORTRAN? -c 2.193 -c Increased # of in-line TeX strings from 36 to 52. -c Fix entry of # of bytes in header of tempo/meter/key track to allow >255. -c 2.191 -c Event track: Tempos, meters, keys all together. Data in comevent -c 2.15 -c Pretty good midi capability. Still no attention to slurs on chord notes. -c 2.11 -c 11 Dec 99 c rm1 -c 11 Dec 99 "oes?", "oe?" -c 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes -c 11 Dec 99 Error message for shifted, repeated ornaments. -c 2.10 (Version 2.1) -c Fix bug with lowdot and xtuplets -c 2.09 -c Fix bug with multiple ornament heights over beams, when one is . or _ -c Error message from pmxa if rest on last note of xtup. -c Enable 12 slurs. -c Reinstate multiple rests at start of xtup. -c 2.07 -c Combine consecutive type-1 TeX strings. -c \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's. -c Fixed breve chord notes in docrd -c Check irest(28) as well as vxtup when setting nodur for chord notes, since -c vxtup isn't set until 1st *main* note in xtup -c Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing. -c 2.06+ -c Make deterministic the beam slope calculation when there are an even # of -c slopes in list and middle two are equal magnitude but opposite sign. -c pmxa Trap for "o:" before 1st note in block -c Partial bug fix for 64th notes in xtuplets. -c Make ixrest a vector, since with new time scheme may not finish xtup in -c same notes block. -c Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb) -c 2.06 -c Account for changes in nv when computing \interstaff. Add a counter -c nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever -c setting isysflb(iflb). Note nv can only change at a forced line break. -c Note also, iflb starts at 0! -c 2.05 -c Automatic start of new notes group with part 2 of staff-jump beam -c In make1bar, set irest bit 29 of lowest-voice note at same time, -c use as flag when making notes groups. -c For now, remove dummy blank line at end...it zaps terminal repeats. -c 2.02 -c Fixed slur-counting bug for multiple, slurred, aftergraces. -c 2.01 -c Increase to ask(1400) -c Increase max forced page breaks to 18 -c Define pausc for centered pause -c 2.0a -c Insert dummy blank line at very end to handle input files w/o terminal CR-LF -c pmx03r -c Option m[n] in S symbol to change musicsize (for parts) -c Double dotted rests now work. -c Write file name to log file -c Check existence of input file -c Allow 24-char jobname, may end with ".pmx" -c Comment out time stuff -c Replace 3-argument getarg with 2-argument + iargc -c Fix bug with negative noinst due to nint<=int replacement -c move lovation of iv in isdat1 to allow iv>7. -c Set nm=12 -c pmx03q -c replace int(x+.001) with nint(x) -c Write TeX file name to screen and to pml. -c Replace char(...) with chax(...) to sovle msdev bug. -c Bug fix: macro terminations when M is on a line by itself. -c Bug fix: don't accumulate space for XS in pmxa. -c Streamline Macros: use pointers to bufq instead of scratch files -c pmx03p -c Store input file in single character array bufq. -c lbuf(i)*2 is length of line i -c ipbuf is position just before next line to be read. -c pmx03 -c Optimize read/writes -c pmx02 -c Fix line count (for errors) when there are saved macros -c pmx01 -c In optimize mode, open/close macros (Watch out for residual zz files!) -c Command line input -c Option Ao to optimize, otherwise normal processing -c -ccccccc - parameter (nks=125,nm=24,mv=24576,maxblks=9600) - character*128 lnholdq - character*131072 bufq - integer*2 lbuf(maxblks) - common /comevent/ miditime,lasttime - logical slmon,dbltie - common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), - * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, - * slmon(0:nm),dbltie - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - integer*2 iinsiv - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - common /commus/ musize,whead20 - integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks) - real*4 poe0(nks),poe(nks) - logical isfirst,optimize - logical*4 fexist - character*44 jobname - character*47 infileq - common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), - * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, - * idum,itsofar(nm),nib(nm,15),nn(nm), - * rest(nm,200),lenbr0,lenbr1,firstline,newmeter - logical rest,firstline,newmeter - common /comdiag/ n69(0:nm),n34(0:nm) - logical mmacrec,gottempo - common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, - * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), - * mmacrec,gottempo - common /truelinecount/ linewcom(20000) -c -c Added 130302 only to get nsperi from g1etnote, for use in midi setup -c - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - logical lastchar,fbon,issegno,isheadr,isvolt -c -c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing -c nmidsec section starts and stops based on PLAYING macros (not recording). -c -ccccccccccccccccccccccccc -c - data date /'17 Mar 20'/ - data version /'2.94'/ -c -ccccccccccccccccccccccccc - data maxit,ncalls /200,0/ - data isfirst /.true./ -c itstart = mytime() - versionc = version -c -c Initialize midi parameters -c - gottempo = .false. - ismidi = .false. - debugmidi = .false. - relacc = .false. - mmacrec = .false. - nmidsec = 1 - mgap = 10 - miditime = 0 - lasttime = 0 - nmidcrd = 0 - nusebl = 0 - notmain = .false. - do 3 ivx = 1 , nm - twoline(ivx) = .false. - midinst(ivx) = 6 - midivel(ivx) = 127 - midibal(ivx) = 64 - miditran(ivx) = 0 -3 continue - do 12 icm = 0 , nm - imidi(icm) = 0 - restpend(icm) = .false. - trest(icm) = 0. - levson(icm) = 0 - levsoff(icm) = 0 - slmon(icm) = .false. - naccbl(icm) = 0 - n69(icm) = 0 - n34(icm) = 0 - msecstrt(icm,1) = 1 -12 continue -c -c End of midi parameter initialization -c - musize = 0 - optimize = .false. - numargs = iargc() - if (numargs .eq. 0) then - print*,'You could have entered a jobname on the command line,' - print*,' but you may enter one now:' - read(*,'(a)')jobname - numargs = 1 - else -c call getarg(1,jobname,idum) ! May need to replace this w/ next line - call getarg(1,jobname) - end if -10 ljob = lenstr(jobname,44) - if (ljob .gt. 44) then - print*,'Jobname is too long. Try again.' - call stop1() - else if (ljob .eq. 0) then - print*,'No was jobname entered. Try again.' - call stop1() - else if (numargs .eq. 2) then - if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then - optimize = .true. -c call getarg(2,jobname,idum) ! May need to replace this w/ next line - call getarg(2,jobname) - numargs = 1 - go to 10 - else - print*,'Illegal option on command line' - call stop1() - end if - end if -c -c Strip ".pmx" if necessary -c - ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX')) - if (ndxpmx .gt. 0) then - jobname = jobname(1:ndxpmx-1) - ljob = ljob-4 - end if -c -c Check for existence of input file -c - infileq = jobname(1:ljob)//'.pmx' - inquire(file=infileq,EXIST=fexist) - if (.not.fexist) then - inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist) - if (.not.fexist) then - print*,'Cannot find file '//infileq - call stop1() - else - infileq = jobname(1:ljob)//'.PMX' - end if - end if -c -c Open a log file -c - open(15,file=jobname(1:ljob)//'.pml') - call printl('This is PMX, Version '//version//', '//date) - ljob4 = ljob - call printl('Opening '//infileq) - open(18,file=infileq) -c -c Copy input file into common buffer -c - ipbuf = 0 - linewcom(1) = 1 - do 8 ilbuf = 1 , maxblks - ncomments = 0 -14 read(18,'(a)',end=9)lnholdq - lbuf(ilbuf) = lenstr(lnholdq,128) - if (lbuf(ilbuf) .eq. 0) then -c -c Blank line. Make it a single blank with length 1 -c - lbuf(ilbuf) = 1 - lnholdq = ' ' - end if -c -c Now line has at least one non blank character. Check for comment -c As of Version 260, do not copy comments into bufq -c But need to count %'s for error messaging -c if (lnholdq(1:1).eq.'%') go to 14 - if (lnholdq(1:1).eq.'%') then - ncomments = ncomments+1 - go to 14 - end if -c -c When here, have counted all preceding comments and have a real line -c - if (ilbuf .gt. 1) then - linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments - else - linewcom(1) = 1+ncomments - end if - if (ipbuf+lbuf(ilbuf).gt.131072) then - print*,'Too many characters in file, stopping' - call stop1() - end if - bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq - ipbuf = ipbuf+lbuf(ilbuf) -8 continue - call printl('Too many lines in input file') - call stop1() -9 continue -c -c Insert dummy line to handle input files w/o CR-LF at end. -c - nlbuf = ilbuf-1 -c nlbuf = ilbuf -c bufq(ipbuf+1:ipbuf+3) = ' / ' -c lbuf(nlbuf) = 3 - close(18) - do 6 numit = 1 , maxit - if (optimize) call printl('Starting an iteration') -c -c When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. -c Otherwise, nbars0 is the input -c When islast=.false., pmxb only returns poe's, otherwise does whole job -c - call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize) - if (.not.optimize) then - if (ismidi) then -c -c This was moved here from writemidi 130302 to allow midivel,bal,tran, to be -c set up here as functions of instrument rather than iv (staff). -c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) -c - nstaves = 0 - ivt = 0 - do 16 iinst = 1 , nm - nstaves = nstaves+nsperi(iinst) - do 17 ivtt = 1 , nsperi(iinst) - ivt = ivt+1 - iinsiv(ivt) = iinst -17 continue - if (nstaves .eq. nv) go to 18 -16 continue - print*,'Screwup!' - call stop1() -18 continue -c -c Set up channel numbers for midi. -c - numchan = 0 - do 11 iv = nv , 1 , -1 - if (twoline(iv)) then - midchan(iv,2) = numchan - numchan = numchan+1 - end if - midchan(iv,1) = numchan - numchan = numchan+1 -11 continue -c -c numchan will now be the number of channels, but max channel # is numchan-1 -c -c Set up velocities, balances, and midi-transpositions -c - do 13 iv = nv , 1 , -1 - if (twoline(iv)) then -c 130302 Make these functions of instrument rather than staff (iv) -c midvelc(midchan(iv,2)) = midivel(iv) -c midbc(midchan(iv,2)) = midibal(iv) -c midtc(midchan(iv,2)) = miditran(iv) - midvelc(midchan(iv,2)) = midivel(iinsiv(iv)) - midbc(midchan(iv,2)) = midibal(iinsiv(iv)) - midtc(midchan(iv,2)) = miditran(iinsiv(iv)) - end if -c midvelc(midchan(iv,1)) = midivel(iv) -c midbc(midchan(iv,1)) = midibal(iv) -c midtc(midchan(iv,1)) = miditran(iv) - midvelc(midchan(iv,1)) = midivel(iinsiv(iv)) - midbc(midchan(iv,1)) = midibal(iinsiv(iv)) - midtc(midchan(iv,1)) = miditran(iinsiv(iv)) -13 continue - end if -c -c TEMPORARY!!! -c - write(15,*)'nlbuf: ',nlbuf - ip1 = 1 - do 10000 ilb = 1 , nlbuf -c write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), -c * bufq(ip1:ip1+lbuf(ilb)-1), -c * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), -c * k=min(3,lbuf(ilb)),1,-1) - ip1 = ip1+lbuf(ilb) -10000 continue - iplast = ip1-1 -c -c Check to see if (1) last line is "/" and (2) next to last -c line is "/" -c - if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then - if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then - print*,'Removing last line of "/"' - write(15,*)'Removing last line of "/"' - nlbuf = nlbuf-1 - end if - end if -c - call pmxb(.true.,poe0,ncalls,optimize) - if (ismidi) then -c -c Write midi file -c - open(51,file=jobname(1:ljob)//'.mid') - if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm') - call printl(' ') - call printl('Writing '//jobname(1:ljob)//'.mid') - call writemidi(jobname,ljob) - end if - close(15) - stop - end if - write(15,*)'nlbuf: ',nlbuf - ip1 = 1 - call pmxb(.false.,poe0,ncalls,optimize) - call poestats(nsyst,poe0,poebar0,devnorm0) -c -c Save initial deviation and line breaks for later comparison -c - if (numit .eq. 1) then - devpmx = devnorm0 - do 20 isys = 1 , nsyst - nbari(isys) = nbars0(isys) -20 continue - end if - call sortpoe(nsyst,poe0,ipoe) - do 1 iupord = nsyst , 1 , -1 - isysu = ipoe(iupord) - print*,'isysu=',isysu - write(15,*)'isysu=',isysu -c -c Skip if system isysu has poe0 < avg or isysd has poe0 > avg -c - if (poe0(isysu).lt.poebar0) go to 1 - do 5 idnord = 1 , nsyst - isysd = ipoe(idnord) - if (isysu.eq.isysd .or. nbars0(isysd).eq.1 - * .or. poe0(isysd).gt.poebar0) go to 5 - do 2 isyst = 1 , nsyst - nbars(isyst) = nbars0(isyst) - if (isyst .eq. isysu) then - nbars(isyst) = nbars(isyst)+1 - else if (isyst .eq. isysd) then - nbars(isyst) = nbars(isyst)-1 - end if -2 continue - call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize) - call pmxb(.false.,poe,ncalls,optimize) - call poestats(nsyst,poe,poebar,devnorm) - if (devnorm .lt. devnorm0) then - devnorm0 = devnorm - poebar0 = poebar - do 4 isys = 1 , nsyst - nbars0(isys) = nbars(isys) - poe0(isys) = poe(isys) -4 continue - print*,'Improved with iup,idown,devnorm:', - * isysu,isysd,devnorm0 - write(15,*)'Improved with iup,idown,devnorm:', - * isysu,isysd,devnorm0 - write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) - write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) - call sortpoe(nsyst,poe0,ipoe) - go to 6 - end if -5 continue -1 continue -c -c If we get here, must have gone thru all switches and found nothing better, -c so done! -c - go to 7 -6 continue -7 continue - print*,'Optimum located, numit:',numit,', ncalls:',ncalls - write(15,*)'Optimum located, numit:',numit,', ncalls:',ncalls - print*,'Final error:',devnorm0,', initial error:',devpmx - write(15,*)'Final error:',devnorm0,', initial error:',devpmx - print*,'Percentage improvement:',100.*(1-devnorm0/devpmx) - write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx) - call printl('Initial bars/system:') - write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst) - write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst) - call printl('Final bars/system:') - write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) - write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) - call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize) - call pmxb(.true.,poe0,ncalls,optimize) - close(15) - end - subroutine accsym(nacc,acsymq,lacc) - character*3 acsymq - iacc = iand(nacc,7) - if (iacc .eq. 1) then - acsymq = 'fl' - lacc = 2 - else if (iacc .eq. 2) then - acsymq = 'sh' - lacc = 2 - else if (iacc .eq. 3) then - acsymq = 'na' - lacc = 2 - else if (iacc .eq. 5) then - acsymq = 'dfl' - lacc = 3 - else if (iacc .eq. 6) then - acsymq = 'dsh' - lacc = 3 - else - print*,'bad accidental: ',iacc - end if - return - end - subroutine addask(taskn,waskn,elaskn, - * fixednew,scaldold,tglp1,scfac,isudsp) - parameter (nm=24) - logical isudsp - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - common /comtol/ tol - scoarg = scaldold*scfac - if (isudsp) then -c -c Find which udsp we're dealing with -c - do 1 iudsp = 1 , nudsp - if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2 -1 continue - print*,'You should note BEEE here in addask!' - call stop1() -2 continue -c -c Fixednew and scaldold must not be changed, since udsp's are already included -c in fsyst from pmxa, and udsp don't involve scaled space.. -c - if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then -c -c Must add user-defined space to what's there already. -c - wask(naskb) = wask(naskb)+udsp(iudsp) - else -c -c This place has no other space. -c - naskb = naskb+1 - task(naskb) = taskn - wask(naskb) = udsp(iudsp) - elask(naskb) = 0. - end if - else -c 130330 start - oldwask = 0. - oldelask = 0. -c 130330 end -c -c This is a normal space, no effect if smaller than existing space -c - if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then -c -c We already put in some space at this time -c Check if new one needs more space than old one at same time -c - if (waskn .gt. wask(naskb)) then -c -c 130330 We were double counting the larger space when it came 2nd -c Need to fix but don't see how yet. Assume times came in order and -c that last naskb defined spaces that need updating -c - oldwask = wask(naskb) - oldelask = elask(naskb) -c End of 130330 insertions - naskb = naskb-1 - else - return - end if - end if - naskb = naskb+1 - task(naskb) = taskn - wask(naskb) = waskn - elask(naskb) = elaskn -c 130330 start -c fixednew = fixednew+waskn -c scaldold = scaldold+elaskn - fixednew = fixednew+waskn-oldwask - scaldold = scoarg+elaskn-oldelask -c 130330 end - end if - return - end - subroutine addblank(noteq,lnoten) - character*8 noteq - character*1 tchar - tchar = noteq(1:1) - noteq = ' '//tchar - lnoten = 2 - return - end - subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd) - parameter (nm=24) - integer nfb(nm) - common /comtol/ tol - real*4 t1fb(nm,20),t2fb(nm,20) - character*1 ulfbq(nm,20) - ifbadd = 1 - nfb(iv) = nfb(iv)+1 - do 1 ifb = nfb(iv)-1 , 1 , -1 - if (tnew .lt. t1fb(iv,ifb)-tol) then - t1fb(iv,ifb+1) = t1fb(iv,ifb) - t2fb(iv,ifb+1) = t2fb(iv,ifb) - ulfbq(iv,ifb+1) = ulfbq(iv,ifb) - else - ifbadd = ifb+1 - go to 2 - end if -1 continue -2 continue - t1fb(iv,ifbadd) = tnew - ulfbq(iv,ifbadd) = 'x' - return - end - subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest) -c subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest) - parameter(nm=24,mv=24576) - integer*2 mmidi,itk(25) - integer*4 itiesav(5,100) - character*1 notenumq - logical endrest,eximacc,it1found - logical rest - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - integer*2 iinsiv - logical slmon,dbltie - common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), - * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, - * slmon(0:nm),dbltie - common /comevent/ miditime,lasttime - common /comdiag/ n69(0:nm),n34(0:nm) -c common /commidisig/ midisig(nm) -c -c Following variables are local but must be saved. I hope they are. -c (3/18/00) With g77 they are not, so add a common block here. -c -c integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12) - integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15) - common /comips/ ipslon,lusebl,jusebl -c data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/ - data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/ -c -c Cancel out barline accidentals if there's a rest. -c - if (rest) naccbl(icm) = 0 -c -c Special path to insert dummy rest at end of a section -c - if (endrest) go to 20 -c - do 7 ion = 0 , nmidcrd -c -c check if this is only to get pitch of a chord note -c - if (notmain) go to 6 -c -c check for rest -c - if (rest) then -c -c Will not put in a note, but must update timing -c - if (.not.restpend(icm)) then -c -c First rest in sequence, save the time -c - restpend(icm) = .true. - trest(icm) = time - else - trest(icm) = trest(icm)+time - end if -c -c Note: code checkers don't like the above due to calling addmidi(trest(icm)) -c but this only happens if rest at end of section (endrest=.true.) (called -c from getmidi(), in which case these above lines are bypassed. -c - call chkimidi(icm) - return - end if -c -c time tics -c - if (imidi(icm).gt.0 .and. ion.eq.0) then - idur = mgap - else - idur = 0 - end if - if (restpend(icm)) then - restpend(icm) = .false. - idur = idur+nint(15*trest(icm)) - end if -c -c time to start of note -c - idurvar = isetvarlen(idur,nby2on) - if (nby2on .gt. 4) then - print*,'You got >4 bytes, something is bogus.' - call stop1() - end if - imidi(icm) = imidi(icm)+1 - do 2 i = 1 , nby2on -c -c imidi points to cell before highest (leftmost) byte. Start with lowest byte -c at far right, fill in backwards -c - mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256) - if (nby2on .gt. 1) idurvar = idurvar/256 -2 continue - imidi(icm) = imidi(icm)+nby2on-1 -c -c Note-on signal -c - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = 9*16+icmm(icm) -c -c Entry point for chord note pitch determination -c -6 continue -c -c Get midi pitch. On chord iteration, only do this first time (main note), -c since pitch was already computed for nonmain chord notes. -c - if (ion .eq. 0) then - ipsav = nolev*12./7+11 - ipsav0 = ipsav - if (midisig .ne. 0) then -c -c Adjust for signature -c - notenumq = char(48+mod(nolev,7)) - if (midisig.ge.index('4152630',notenumq)) then - ipsav = ipsav+1 - else if (-midisig.ge.index('0362514',notenumq)) then - ipsav = ipsav-1 - end if - end if -c -c Deal with accidentals. -c -c iacc 0 1 2 3 4 5 6 7 -c effect X fl sh na X dfl dsh X -c iashft X -1 1 0 X -2 2 X -c - jacc = 0 - eximacc = .false. - if (iacc .gt. 0) then -c -c Adjust key-sig-adjusted pitch for explicit accidental (and exit) -c - jacc = iashft(iacc) - eximacc = .true. - if (.not.relacc) jacc = jacc+ipsav0-ipsav -c -c (Above) Shift applies to diatonic pitch but will be added to adjusted one -c - else if (naccim(icm) .gt. 0) then -c -c Possible implicit accidental from earlier in the bar -c Check for prior accid in this bar at this note level -c - do 3 kacc = 1 , naccim(icm) - if (laccim(icm,kacc) .eq. nolev) then - jacc = jaccim(icm,kacc) - eximacc = .true. - if (.not.relacc) jacc = jacc+ipsav0-ipsav - go to 4 - end if -3 continue -4 continue - end if -c -c Must split off the following if block from those above because chord -c notes can cause naccim>0, forcing us to miss other chord note's -c accross-bar-line accidental -c - if (naccbl(icm).gt.0 .and. .not.eximacc) then -c -c Possible carryover accid from prior bar (or prior same-pitch note). -c - do 21 kacc = 1 , naccbl(icm) - if (laccbl(icm,kacc) .eq. nolev) then - jacc = jaccbl(icm,kacc) -c -c Since we are *using* the bar-line accid, must flag it to be saved for next. -c - nusebl = nusebl+1 - jusebl(nusebl) = jacc - lusebl(nusebl) = nolev - if (.not.relacc) jacc = jacc+ipsav0-ipsav - go to 22 - end if -21 continue -22 continue - end if - ipsav = ipsav+jacc - end if - if (notmain) then - mcpitch(nmidcrd) = ipsav -c -c Save pitch for tie checks -c - if (levson(icm).eq.nolev.and..not.slmon(icm)) - * ipslon(icm) = ipsav - else - imidi(icm) = imidi(icm)+1 - if (ion.eq.0) then - mmidi(icm,imidi(icm)) = ipsav - if (levson(icm).eq.nolev.and..not.slmon(icm)) - * ipslon(icm) = ipsav - else - mmidi(icm,imidi(icm)) = mcpitch(ion) - end if - end if - if (ion .eq. 0) then -c -c Only record accids for non-chords, main chord note during chord iteration -c and chordnotes on first call but not during iteration -c - if (iacc.gt.0) then -c -c Set marker for accidental for possible continuations later this bar -c but first check and clear earlier ones on same note. -c - do 23 kacc = 1 , naccim(icm) - if (laccim(icm,kacc) .eq. nolev) then - do 24 macc = kacc , naccim(icm)-1 - laccim(icm,macc) = laccim(icm,macc+1) - jaccim(icm,macc) = jaccim(icm,macc+1) -24 continue - go to 25 - end if -23 continue - go to 26 -25 continue - naccim(icm) = naccim(icm)-1 -26 continue -c -c Flag new accidental -c - naccim(icm) = naccim(icm)+1 - laccim(icm,naccim(icm)) = nolev - jaccim(icm,naccim(icm)) = iashft(iacc) - end if -c -c Bail if this is a chord note on the first call (from docrd) -c - if (notmain) then - call chkimidi(icm) - return - end if - end if -c -c Vel -c - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = midvelc(icm) - call chkimidi(icm) -7 continue -c -c For tie checks -c - if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm) -c -c Entry point for special rests at section ends (endrest=T) -c -20 continue -c -c Now insert all the ends -c - do 8 ioff = 0 , nmidcrd - if (ioff .eq. 0) then -c -c time to end -c - idur1 = nint(15*time) - if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then - idur = idur1-mgap - else - idur = idur1 - end if -c -c Deal with roundoff problems with 7-tuplets on half or quarters -c - if (idur1 .eq. 69) then - n69(icm) = n69(icm)+1 -c if (mod(n69(icm)+6,7) .gt. 3) idur = 58 - if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1 - else if (idur1 .eq. 34) then - n34(icm) = n34(icm)+1 - if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1 - end if - idurvar = isetvarlen(idur,nby2off) - if (nby2off .gt. 4) then - print*,'You got >4 bytes, something is bogus.' - call stop1() - end if - imidi(icm) = imidi(icm)+1 - call chkimidi(icm) - do 1 i = 1 , nby2off - mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256) - if (nby2off .gt. 1) idurvar = idurvar/256 -1 continue - imidi(icm) = imidi(icm)+nby2off-1 - else -c -c Inserting end of chord note, delta time is 0 -c - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = 0 - end if -c -c Note off -c - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = 8*16+icmm(icm) -c -c Pitch -c - imidi(icm) = imidi(icm)+1 - if (ioff .eq. 0) then - mmidi(icm,imidi(icm)) = ipsav - else - mmidi(icm,imidi(icm)) = mcpitch(ioff) - end if -c -c Vel -c - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = 0 - call chkimidi(icm) - if (endrest) then - return - end if -8 continue - naccbl(icm) = nusebl - if (nusebl .gt. 0) then -c -c Fix tables of "bar-line" accids that are saved due to consecutive notes. -c - do 30 kacc = 1 , nusebl - laccbl(icm,kacc) = lusebl(kacc) - jaccbl(icm,kacc) = jusebl(kacc) -30 continue - nusebl = 0 - end if -c -c Begin tie checks -c - if (slmon(icm)) then -c -c Prior note had a slur start -c - if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then -c -c We have a tie! (Assumed there would be no accidental on tie-ending note) -c Make a list of times of all events back to the one starting at imidso+1, -c which is at or before where the tie started. Ident tie start and stop by -c comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) -c Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial -c time. - nsav4tie = 0 - imidt = imidso(icm) -10 nsav4tie = nsav4tie+1 - itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes) - imidt = imidt+nbytes - do 11 j = 1 , 3 - itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j) -11 continue - imidt = imidt+3 - if (nsav4tie .eq. 1) then - itiesav(5,1) = itiesav(1,1) - else - itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+ - * itiesav(5,nsav4tie-1) - end if - if (imidt .ne. imidi(icm)) go to 10 -c -c Find which two pitches agree with saved slur pitch. -c - it1found = .false. - do 12 it2 = 1 , nsav4tie - if (itiesav(3,it2) .eq. ipslon(icm)) then - if (it1found) go to 13 - it1 = it2 - it1found = .true. - end if -12 continue - call printl( - * 'Program error, tied notes, send source to Dr. Don') - it1 = nsav4tie+1 - it2 = nsav4tie+1 -13 continue -c -c List the positions we want to keep -c - jsav = 0 - do 14 isav = 1 , nsav4tie - if (isav.eq.it1 .or. isav.eq.it2) go to 14 - jsav = jsav+1 - itk(jsav) = isav -14 continue - nsav4tie = nsav4tie-2 -c -c Now dump events it1 & it2, recompute times, restack mmidi. -c - imidi(icm) = imidso(icm) - do 15 isav = 1 ,nsav4tie - if (isav .eq. 1) then - idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes) - else - idurvar = isetvarlen(itiesav(5,itk(isav))- - * itiesav(5,itk(isav-1)),nbytes) - end if - imidi(icm) = imidi(icm)+1 - do 16 i = 1 , nbytes - mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256) - if (nbytes .gt. 1) idurvar = idurvar/256 -16 continue - imidi(icm) = imidi(icm)+nbytes-1 - do 17 i = 2 , 4 - imidi(icm) = imidi(icm)+1 - mmidi(icm,imidi(icm)) = itiesav(i,itk(isav)) -17 continue -15 continue - end if - slmon(icm) = .false. - levsoff(icm) = 0 - if (.not.dbltie) levson(icm) = 0 - end if - if (levson(icm).gt.0) slmon(icm) = .true. - if (nmidcrd .gt. 0) nmidcrd = 0 - call chkimidi(icm) - return - end - subroutine addstr(notexq,lnote,soutq,lsout) - common /comlast/ islast,usevshrink - logical islast,usevshrink - character*(*) notexq - character*80 soutq - if (lsout+lnote .gt. 72) then - if (islast) write(11,'(a)')soutq(1:lsout)//'%' - lsout = 0 - end if - if (lsout .gt. 0) then - soutq = soutq(1:lsout)//notexq(1:lnote) - else - soutq = notexq(1:lnote) - end if - lsout = lsout+lnote - return - end - subroutine adjusteskz(ib,istart,poenom) -c -c For block ib, this adds accidental spaces to eskz, for use in getting -c length of xtup bracket and slopes of brackets and beams. -c - parameter (nm=24) - common /comas1/ naskb,task(40),wask(40),elask(40) - integer*4 istart(80) - common /comnsp/ space(80),nb,prevtn(nm), - * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,isfig - common /comeskz2/ eskz2(nm,200) - common /comtol/ tol - common /comntot/ ntot - inmin = istart(ib)+1 - do 10 iaskb = 1 , naskb - if (task(iaskb) .lt. to(istart(ib))-tol) go to 10 - eskadd = wask(iaskb)/poenom-elask(iaskb) - do 11 in = inmin , ntot - if (to(in) .gt. task(iaskb)-tol) then - eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd - if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1 - else - inmin = inmin+1 - end if -11 continue -10 continue - return - end - subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0) - logical figbass,ispoi,topmods,istype0,done,isbbm - common /comhsp/ hpttot(176) - common /compoi/ ispoi - common /combbm/ isbbm - common /comas3/ ask(2500),iask,topmods - character*40 pathnameq - character*44 basenameq - character*1 sq,chax - character*129 outq - sq = chax(92) - open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex') -c -c Transfer first 5 lines of main internal TeX file -c - do 11 il = 1 , 5 - call moveln(11,12,done) -11 continue - if (istype0) then -c -c Transfer literal TeX stuff from special scratch file -c - rewind(17) -10 call moveln(17,12,done) - if (.not.done) go to 10 - close(17) - end if -c -c Transfer next 2 lines from main scratch file -c - do 3 il = 1 , 2 - call moveln(11,12,done) -3 continue - if (ispoi) write(12,'(a)')sq//'input musixpoi' - if (isbbm) write(12,'(a)')sq//'input musixbbm' - if (figbass) then -c -c Transfer .fig data from scratch (unit 14) into external .tex (unit 12) -c -4 call moveln(14,12,done) - if (.not.done) go to 4 - close(14) - end if - iask = 0 - ihs = 0 -1 read(11,'(a129)',end=999)outq -c -c Hardspaces. -c - if (outq(1:5) .eq. sq//'xard') then - ihs = ihs+1 - outq(2:2) = 'h' - write(outq(12:15),'(f4.1)')hpttot(ihs) - lenout = 19 - go to 9 - end if -c -c This part hard-wires ask's into new .tex file as ast's -c -2 indxask = index(outq,sq//'ask') - if (indxask .ne. 0) then - iask = iask+1 - call putast(ask(iask),indxask,outq) - go to 2 - end if - lenout = llen(outq,129) -9 continue - write(12,'(a)')outq(1:lenout) -c -c If this is the line with "readmod", check for topmods. -c - if (topmods .and. outq(2:8).eq.'readmod') then - topmods = .false. - rewind(16) - do 7 il = 1 , 1000 - read(16,'(a129)',end=8)outq - lenout = llen(outq,129) -c -c We inserted the '%' in subroutine littex, to guarantee including blank. -c - write(12,'(a)')outq(1:lenout) -7 continue -8 continue - close(16) - end if - go to 1 -999 close(11) - close(12) - return - end - subroutine backfill(iunit,oldq,lenold,newq,lennew) -c -c In iunit, looks backward for oldq, overwrites newq -c Safest if both are same length! -c - character*128 lineq(200),nowq - character*(*) oldq,newq - linesback = 0 -1 continue - backspace(iunit) - read(iunit,'(a)')nowq - ndx = index(nowq,oldq(1:lenold)) -c -c Save the line just read -c - linesback = linesback+1 - lineq(linesback) = nowq - if (ndx .eq. 0) then - backspace(iunit) - go to 1 - end if -c -c If here, it's replacement time. -c - lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew) - * //nowq(ndx+lenold:128) - backspace(iunit) - do 2 line = linesback , 1 , -1 - write(iunit,'(a128)')lineq(line) -2 continue - return - end - subroutine beamend(notexq,lnote) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq,ulqq,chax - logical beamon,firstgulp,figbass,figchk,flipend,btest, - * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comoct/ noctup - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /strtmid/ ihnum3,flipend(nm),ixrest(nm) - character*4 tempq - character*8 noteq - character*79 notexq - ip = ipo(jn) - multip = iand(mult(ivx,ip),15)-8 - lnote = 0 - if (ixrest(ivx) .eq. 4) then -c -c This is the LAST note in the xtup (i.e., all rests before). Make single. -c - nodur(ivx,ip) = 2**(4-multip) - call notex(notexq,lnote) - ixrest(ivx) = 0 - return - end if - nole = nolev(ivx,ip) -c -c Check for special situations with 2nds (see precrd) -c - if (btest(nacc(ivx,ip),30)) then - nole = nole - 1 - else if (btest(nacc(ivx,ip),31)) then - nole = nole + 1 - end if -c -c Terminate indented beams for 2-note tremolo if needed -c - if (btest(irest(ivx,ip-1),2) .and. - * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then - nindent = igetbits(irest(ivx,ip-1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - addoff = -1-.5*nindent - else - addoff = 1+.5*nindent - endif -c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) - addoff = addoff+.0822*islope(ivx) - if (addoff .lt. -.05) then - write(tempq,'(f4.1)')addoff - else - write(tempq,'(f4.2)')addoff - end if - notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{' - * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// - * '0}}' - lnote = 46 - end if - if (.not.drawbm(ivx)) then -c -c Xtuplet with no beam, just put in the right kind of note -c - if (btest(irest(ivx,ip),0)) then -c -c Rest at end of unbeamed xtup -c - lnote = 3 - if (btest(islur(ivx,ip),29)) then - notexq = sq//'sk' -c -c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for -c a blank rest ending xtup, but hopefully returning from here will handle it. -c - return - else if (multip .eq. 0) then - notexq = sq//'qp' - else if (multip .eq. -1) then - notexq = sq//'hp' - else if (multip .eq. 1) then - notexq = sq//'ds' - else if (multip .eq. 2) then - notexq = sq//'qs' - else - notexq = sq//'hs' - end if -c -c 180106 Deal with possible level tweak -c - nole = mod(nolev(ivx,ip)+50,100)-50 - if (nole .ne. 0) then - if (abs(nole) .lt. 10) then - noteq = chax(48+abs(nole)) - lnoten = 1 - else - write(noteq(1:2),'(i2)')abs(nole) - lnoten = 2 - end if - if (nole .gt. 0) then - notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' - * //notexq(1:lnote) - else - notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' - * //notexq(1:lnote) - end if - lnote = 16+lnoten+lnote - end if - return - end if - if (btest(islur(ivx,ip),30)) then -c -c Forced stem direction -c - ndsav = nodur(ivx,ip) - nodur(ivx,ip) = 2**(4-multip) - if (btest(nacc(ivx,ip-1),27)) - * nodur(ivx,ip)=nodur(ivx,ip)/2 - call notex(notexq,lnote) - nodur(ivx,ip) = ndsav - else - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - if (lnoten .eq. 1) call addblank(noteq,lnoten) -c -c To reduce confusion due to this early update of lnote, do it -c below, separately in each case/ -c lnote = lnoten+3 - if (.not.btest(nacc(ivx,ip-1),27)) then -c -c Prior note is not regular-dotted -c - if (btest(irest(ivx,ip-1),2) .and. - * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then -c -c Unbeamed tremolo with indented beams. Put termination in right here -c - nindent = igetbits(irest(ivx,ip-1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - addoff = -1-.5*nindent - else - addoff = 1+.5*nindent - endif -c -c Is there an islope here, for unbeamed? -c - if (addoff .lt. -.05) then - write(tempq,'(f4.1)')addoff - else - write(tempq,'(f4.2)')addoff - end if - notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq// - * 'hbox{' - * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// - * '0}}' - lnote = 46 - end if - if (multip .eq. 0) then - if (btest(irest(ivx,ip-1),2) .and. - * nodur(ivx,ip).gt.24) then -c -c 2nd note of unbeamed half-note trem; make open -c But it's not clear if unbeamed half-note tremolo is Kosher, -c so don't worry about stem lengths here now. -c - if (lnote .eq. 0) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq - else - notexq = notexq(1:46)// - * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = 46 - end if - else - if (btest(irest(ivx,ip-1),2) .and. - * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then -c -c Need a dot. -c - lnote = 46 - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if -c -c Insert stemlength stuff here for unbeamed dotted tremolo. -c May later combine with below to avoid repeat. But need to -c return to normal stem length after note is set. -c - nindent = igetbits(irest(ivx,ip-1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - slen = (4.5+nindent+nolev1(ivx)-nole - * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) - * *islope(ivx)/slfac)*.6667 - else - slen = (4.5+nindent-nolev1(ivx)+nole - * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) - * *islope(ivx)/slfac)*.6667 - end if - write(tempq,'(f4.1)')slen - notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote) - lnote = lnote+10 - end if -c -c Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem -c (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot) -c - if (btest(irest(ivx,ip-1),2)) then - if (lnote .eq. 0) then -c notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//'p' - * //noteq(1:lnoten) - else - notexq = notexq(1:lnote)//sq//'q' -c * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - * //ulq(ivx,ibmcnt(ivx))//'p'//noteq(1:lnoten) - end if -c lnote = lnote+3+lnoten - lnote = lnote+4+lnoten - else - if (lnote .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) - * //noteq(1:lnoten) - else - notexq = notexq(1:lnote)//sq//'q' - * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - end if - lnote = lnote+3+lnoten - end if - if (btest(irest(ivx,ip-1),2) .and. - * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then - notexq = notexq(1:lnote)//sq//'slz' - lnote=lnote+4 - end if - end if - else if (btest(irest(ivx,ip-1),2)) then -c -c 2nd note of unbeamed quarter or 8th trem; make quarter note -c Get stemlength change -c - lnote = 46 - nindent = igetbits(irest(ivx,ip-1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - slen = (4.5+nindent+nolev1(ivx)-nole - * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) - * *islope(ivx)/slfac)*.6667 - else - slen = (4.5+nindent-nolev1(ivx)+nole - * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) - * *islope(ivx)/slfac)*.6667 - end if - write(tempq,'(f4.1)')slen - notexq = notexq(1:46)//sq//'slx{'//tempq//'}' - lnote = lnote+10 -c if (lnote .eq. 0) then -c notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq -c else -c notexq = notexq(1:46)// -c * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq -c end if -c -c -c Check for dotted unbeamed tremolo -c - if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then -c -c Need a dot -c - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if - if (lnote .eq. 0) then - notexq = sq//'pt'//noteq(1:lnoten) - else - notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) - end if - lnote = lnote+3+lnoten - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if - end if - notexq = notexq(1:lnote)// - * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) -c * //sq//'stemcut' - * //sq//'slz' -c lnote=lnote+3+lnoten+8 - lnote=lnote+3+lnoten+4 - else if (multip .eq. -1) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - lnote = lnoten+3 - else if (multip .eq. 1) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - lnote = lnoten+3 - else if (multip .eq. 2) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - lnote = lnoten+4 - else if (multip .eq. 3) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) - lnote = lnoten+5 - else if (multip .eq. -2) then - notexq = sq//'wh'//noteq(1:lnoten) - lnote = lnoten+3 - else if (multip .eq. -3) then - notexq = sq//'breve'//noteq(1:lnoten) - lnote = lnoten+6 - else - print* - print*,'(Error in beamend, send source to Dr. Don)' - call stop1() - end if - else -c -c Prior note is regular-dotted so this one is halved -c - lnote = lnoten+3 - if (multip .eq. 0) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq - else if (multip .eq. -1) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq - else if (multip .eq. -2) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq - else if (multip .eq. 1) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnoten+4 - else if (multip .eq. 2) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnoten+5 - end if - end if - end if - return - end if -c -c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just -c skipping the call in that case. -c - if (.not.btest(irest(ivx,ip),0)) then - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - end if -c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) -c lnote = 0 -c -c New way, with flipend, which was computed in beamstrt. -c - if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then - ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) - flipend(ivx) = .false. - end if - if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then -c -c This is not a one-noter from beam-jump. Check if multiplicity has increased -c - if (btest(irest(ivx,ip-1),0)) then -c -c Prior note is a rest, check one before that -c - mp = iand(mult(ivx,ip-2),15)-8 - else - mp = iand(mult(ivx,ip-1),15)-8 - end if - if (multip .gt. mp) then -c -c Assume 1-3, 2-3, or 1-2 -c - do 2 imp = multip , mp+1 , -1 - call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) -2 continue - else if (btest(nacc(ivx,ip-1),27)) then -c -c 2nd member of dotted xtup -c - call ntrbbb(multip+1,'t', - * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) - end if - end if -c -c Beam termination and direction analysis -c - if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then -c -c This is the end of the first segment in a jump-beam. ivbj1=ivx will be number -c of the jump-beam. ivbj2 will be tested along with isbjmp to see if in the -c voice of the 2nd part of jumped beam. (May need special treatment for -c multi-segment jump-beams -c - isbjmp = .true. - ivbj1 = ivx - multbj1 = iand(15,mult(ivx,ip)-8) - ivbj2 = 0 - end if - if (.not.btest(irest(ivx,ip),23)) then -c -c This is either a normal beamend or end of a sequence of jump-beam segments, -c (170409) or rest at end of xtup -c so some sort of termination is required -c - ulqq = ulq(ivx,ibmcnt(ivx)) - if (.not.isbjmp .or. ivx.ne.ivbj2) then - if (btest(irest(ivx,ip),0)) then -c -c Xtup ends with rest -c - if (multip .eq. 1) then - notexq = sq//'ds' - lnote = 3 - else if (multip .eq. 2) then - notexq = sq//'qs' - lnote = 3 - else if (multip .eq. 3) then - notexq = sq//'hs' - lnote = 3 - end if -c -c 170801 Borrowed from main rest entry way down below to get level adjustment: -c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? -c "... Now raise if necc." -c - if (btest(islur(ivx,ip),29)) then -c -c Blank rest -c - notexq = sq//'sk' - lnote = 3 - else if (nole .ne. 0) then -c -c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with -c nolev=-4 but expected 100+/-. Try to fix. -c - if (abs(nole).lt.30) nole = 100+nole -c - if (abs(nole-100) .lt. 10) then - noteq = chax(48+abs(nole-100)) - lnoten = 1 - else - write(noteq(1:2),'(i2)')abs(nole-100) - lnoten = 2 - end if -c ??? if (nole .gt. 0) then - if (nole .gt. 100) then - notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' - * //notexq(1:lnote) - else - notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' - * //notexq(1:lnote) - end if - lnote = 16+lnoten+lnote - end if - return - else -c -c Normal termination -c - call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) - end if - else -c -c Terminate a sequence of jump-beam segments. -c - ulqq = chax(225-ichar(ulqq)) - call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote) - end if - end if -c -c Check for end of 2nd seg of staff-jump xtup chord blank rest -c -c if (isbjmp.and.ivx.eq.ivbj2 - if (isbjmp - * .and.btest(islur(ivx,ip),29)) then - notexq = notexq(1:lnote)//sq//'sk' - return - end if -c -c And now the note, checking for open-head beamed tremolo -c - if (btest(irest(ivx,ip-1),2)) then -c -c Check for dotted tremolo -c - if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then -c -c Need a dot -c - if (nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then -c -c Solid notehead -c - notexq = notexq(1:lnote)//sq//'qbp' - else -c -c Assuming open notehead and nodur = 48 -c - notexq = notexq(1:lnote)//sq//'hbp' - end if - lnote = lnote+4 - else - if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'hb' - else - notexq = sq//'hb' - end if - else - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' - end if - end if - lnote = lnote+3 - end if - else -c -c No tremolo -c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' - end if - lnote = lnote+3 - end if - isdotm = .false. - if (.not.vxtup(ivx)) then - if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then - if (.not.btest(iornq(ivx,ip),13)) then - notexq = notexq(1:lnote)//'p' - else - notexq = notexq(1:lnote)//'m' - isdotm = .true. - end if - lnote = lnote+1 - end if - end if -c -c 5/25/08 Allow >12 -c 5/9/10 Up to 24; replace 24 with 0 -c - if (.not.(isbjmp.and.ivx.eq.ivbj2)) then - call istring(mod(ivx,24),tempq,len) - else - call istring(mod(ivbj1,24),tempq,len) - end if - if (isbjmp .and. ivx.eq.ivbj2 - * .and..not.btest(irest(ivx,ip),23)) isbjmp=.false. - notexq = notexq(1:lnote)//tempq(1:len) - lnote = lnote+len - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - if (isdotm) then - if (lnoten .eq. 1) then - notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}' - lnote = lnote+3 - else - notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) - lnote = lnote+1 - end if - end if - return - end - subroutine beamid(notexq,lnote) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq,ulqq,chax - logical beamon,firstgulp,figbass,figchk,flipend,btest, - * isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm - character*79 notexq - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comoct/ noctup - common /strtmid/ ihnum3,flipend(nm),ixrest(nm) - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - character*8 noteq - character*4 tempq - lnote = 0 - ip = ipo(jn) - nole = nolev(ivx,ip) -c -c Check for special situations with 2nds (see precrd) -c - if (btest(nacc(ivx,ip),30)) then - nole = nole - 1 - else if (btest(nacc(ivx,ip),31)) then - nole = nole + 1 - end if - if (.not.btest(irest(ivx,ip),0)) then - multip = iand(mult(ivx,ip),15)-8 -c if (btest(islur(ivx,ip-1),3)) multip = multip+1 -c -c (Above test OK since must have ip>1). Double dotted note preceding -c -c Move the following, because can't ask for note until after checking for -c embedded xtup with number, due to ordering/octave feature. -c -c call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) - end if - if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true. - if (vxtup(ivx)) then -c -c In an xtup -c - if (btest(irest(ivx,ip),0)) then -c -c Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK -c - nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8)) - call notex(notexq,lnote) -c -c Re-zero so next note does not get confused -c - nodur(ivx,ip) = 0 - return - end if - if (.not.drawbm(ivx)) then -c -c Xtuplet with no beam, just put in the right kind of note -c - if (btest(islur(ivx,ip),30)) then -c -c Forced stem direction -c - ndsav = nodur(ivx,ip) - nodur(ivx,ip) = 2**(4-multip) - if (btest(nacc(ivx,ip),19) .or. - * btest(nacc(ivx,ip),27)) then - nodur(ivx,ip)=3*nodur(ivx,ip)/2 - else if (btest(nacc(ivx,ip-1),27)) then - nodur(ivx,ip)=nodur(ivx,ip)/2 - end if - call notex(notexq,lnote) - nodur(ivx,ip) = ndsav - else -c -c Use ulq for stem direction -c - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - if (lnoten .eq. 1) call addblank(noteq,lnoten) - lnote = 3 - if (.not.btest(nacc(ivx,ip-1),27)) then -c -c Prior note of xtup is not regular-dotted -c - if (multip .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. -1) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. 1) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. 2) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) - lnote = 4 - else if (multip .eq. 3) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) - lnote = 5 - else if (multip .eq. -2) then - notexq = sq//'wh' - end if - if (btest(nacc(ivx,ip),27)) then -c -c This xtup note is regular dotted non-beamed xtup -c -c notexq = notexq(1:3)//'p' -c lnote = 4 - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if - else -c -c Prior note of xtup is regular-dotted so this one is halved -c - if (multip .eq. 2) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) - lnote = 5 - else if (multip .eq. 1) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) - lnote = 4 - else if (multip .eq. 0) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. -1) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. -2) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) - end if - end if - notexq = notexq(1:lnote)//noteq - lnote = lnote+lnoten - end if - return - else if (nodur(ivx,ip).eq.0) then -c -c In the beamed xtup but not the last note -c - if (nodur(ivx,ip-1).gt.0) then -c -c Embedded Xtup, mult>0, starts here. Put in number if needed -c - nxtinbm(ivx) = nxtinbm(ivx)+1 - iud = 1 - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1 -c -c Get ip#, notelevel of middle note (or gap) in xtup -c - ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2 - xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud, - * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8) - if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+ - * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud, - * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2 - iflop = 0 - if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud - iup = iud+2*iflop - if (btest(irest(ivx,ip),14)) then - iup = -iup - iflop = 0 - if (iud*iup .lt. 0) iflop = iup - end if -c -c Place number if needed -c - if (.not.btest(islur(ivx,ip),31)) then - mprint = igetbits(nacc(ivx,ip),5,22) - if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) - call putxtn(mprint,iflop,multip,iud,wheadpt,poenom, - * nolev1(ivx),islope(ivx),slfac, - * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum, - * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip), - * mult(ivx,ip),.false.) - end if - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - else -c -c Intermediate note of xtup -c - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - end if - else -c -c Last note of xtup (but not last note of beam!) -c - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - end if - else if (btest(irest(ivx,ip),0)) then - call notex(notexq,lnote) - return - else - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - end if -c -c Check for string of rests up to and including last note in xtup. -c -c Replace next 2 lines to keep from doing this block -c when in second part of staff-jumping chordal xtup. This fix could -c break some unaccounted non-chordal staff-jum xtup situations. -c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. -c * .not.btest(irest(ivx,ip),0)) then - if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. - * .not.btest(irest(ivx,ip),0) .and. - * .not.(isbjmp.and.ivx.eq.ivbj2)) then -c -c This note is not a rest but next is a rest. Do rests continue to -c end of xtup, where nodur>0 -c - do 3 ipnow = ip+1 , ip+24 - if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup - if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest -c -c If I don't go to 5, know next note IS a rest! -c -3 continue -4 continue - call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) - notexq = notexq(1:lnote)//sq//'qb' - lnote = lnote+3 - call istring(ivx,tempq,len) - notexq = notexq(1:lnote)//tempq(1:len) - lnote = lnote+len - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - return -5 continue -c -c Check if multiplicity changes in a way requiring action, -c unless (160211) it's blank rest on start of 2nd seg of joined beam -c - else if(.not.btest(irest(ivx,ip-1),24) - * .or..not.btest(islur(ivx,ip-1),29)) then - ipleft = ip-1 - if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1 - if (.not.btest(islur(ivx,ipleft),20)) then - multl = iand(15,mult(ivx,ipleft))-8 - else - multl = 1 - end if - mub = multip - multl - ipright = ip+1 - if (btest(irest(ivx,ipright),0)) ipright = ipright+1 - if (.not.btest(islur(ivx,ip),20)) then - multr = iand(15,mult(ivx,ipright))-8 - else - multr = 1 - end if - mua = multr-multip - if (mub.gt.0 .or. mua .lt. 0) then -c -c Multiplicity has increased from left or will decrease to right. Need action. -c - if (isbjmp .and. ivx.eq.ivbj2) then - ivb = ivbj1 - ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) - else - ivb = ivx - ulqq = ulq(ivx,ibmcnt(ivx)) - end if - if (mua .ge. 0) then - call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote) -c -c Test for next note being blank rest, assuming staff-crossing -c xtup chord -c - else if (multl .ge. multr .and. - * .not.btest(islur(ivx,ip+1),29)) then - do 1 im = multip , 1+multr, -1 - call ntrbbb(im,'t',ulqq,ivb,notexq,lnote) -1 continue -c else -c Test for next note being blank rest, assuming staff-crossing -c xtup chord -c - else if (.not.btest(islur(ivx,ip+1),29)) then - do 2 im = 1+multr, multip - call ntrbbb(im,'r',ulqq,ivb,notexq,lnote) -2 continue - call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote) - end if - else if (ip .gt. 1) then -c -c Check for 2nd member of dotted xtup -c - if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', - * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) - end if - end if -c -c Now put in the note -c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' - end if - lnote = lnote+3 - isdotm = .false. - if (isdotted(nodur,ivx,ip)) then -c -c rule out ')' -c - if (.not.btest(iornq(ivx,ip),13)) then - if (.not.btest(islur(ivx,ip),3)) then - notexq = notexq(1:lnote)//'p' - else -c -c Double dot -c - notexq = notexq(1:lnote)//'pp' - lnote = lnote+1 - end if - else - notexq = notexq(1:lnote)//'m' - isdotm = .true. - end if - lnote = lnote+1 - else if (btest(nacc(ivx,ip),19) - * .or. btest(nacc(ivx,ip),27)) then -c -c Special dotted notation for 2:1 xtup, or normal dot in xtup -c - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if -c -c 5/25/08 Allow >12 -c - if (.not.(isbjmp.and.ivx.eq.ivbj2)) then -c call istring(mod(ivx,12),tempq,len) - call istring(mod(ivx,24),tempq,len) - else -c call istring(mod(ivbj1,12),tempq,len) - call istring(mod(ivbj1,24),tempq,len) - end if - notexq = notexq(1:lnote)//tempq(1:len) - lnote = lnote+len - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - if (isdotm) then - if (lnoten .eq. 2) then - notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}' - lnote = lnote+3 - else - notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) - lnote = lnote+1 - end if - end if - return - end - subroutine beamn1(notexq,lnote) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,btest, - * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm - logical gotnote - common /comoct/ noctup - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*8 noteq,tempq,numq - character*79 notexq - gotnote = .false. - lnoten = 0 - ip1 = ipo(jn) - multip = iand(15,mult(ivx,ip1))-8 - if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then - lnote = 0 -c -c The rest was already written in beamstrt, so just get out of here -c - return - end if - nole = nolev(ivx,ipo(jn)) -c -c Check for special situations with 2nds (see precrd) -c - if (btest(nacc(ivx,ipo(jn)),30)) then - nole = nole - 1 - else if (btest(nacc(ivx,ipo(jn)),31)) then - nole = nole + 1 - end if - if (vxtup(ivx) .and. .not.drawbm(ivx)) then -c -c Xtuplet with no beam, just put in the right kind of note -c - if (btest(islur(ivx,ip1),30)) then -c -c Forced stem direction -c - ndsav = nodur(ivx,ip1) - nodur(ivx,ip1) = 2**(4-multip) - if (btest(nacc(ivx,ip1),19) .or. - * btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2 - call notex(notexq,lnote) - nodur(ivx,ip1) = ndsav - else - call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) - gotnote = .true. - if (lnoten .eq. 1) call addblank(noteq,lnoten) - lnote = 3 - if (multip .le. 0) then - if ((btest(irest(ivx,ip1),2) .and. - * nodur(ivx,ip1+1).ge.32) - * .or. multip .eq. -1) then -c -c 1st note of unbeamed half-note trem; make open -c - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. -2) then - notexq = sq//'wh' - else - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) - end if -c -c Check for dot -c - if (btest(irest(ivx,ip1),2) .and. - * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then -c -c Need a dot. already called addblank for noteq -c - if (lnote .eq. 0) then - notexq = sq//'pt'//noteq(1:lnoten) - lnote = 3+lnoten - else - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if - end if -c -c Insert the stemlength calcs here for dotted, unbeamed. -c Later may combine with below to avoid repeat. -c - if (btest(irest(ivx,ip1),2)) then - nindent = igetbits(irest(ivx,ip1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - slen = (4.5+nindent+nolev1(ivx)-nole - * -.4*islope(ivx)/slfac)*.6667 - else - slen = (4.5+nindent-nolev1(ivx)+nole - * +.4*islope(ivx)/slfac)*.6667 - end if - write(tempq,'(f4.1)')slen - notexq = sq//'slx{'//tempq(1:4)//'}'// - * notexq(1:lnote) - lnote = lnote+10 - end if - else if (btest(irest(ivx,ip1),2)) then -c -c 1st note of unbeamed quarter or 8th trem, make a quarter note -c -c Stem length calcs here. The .2 factor is empirical, but -c slfac accounts for musicsize. -c - nindent = igetbits(irest(ivx,ip1),2,5) - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - slen = (4.5+nindent+nolev1(ivx)-nole - * -.4*islope(ivx)/slfac)*.6667 - else - slen = (4.5+nindent-nolev1(ivx)+nole - * +.4*islope(ivx)/slfac)*.6667 - end if - write(tempq,'(f4.1)')slen - notexq = sq//'slx{'//tempq(1:4)//'}'// - * sq//'q'//ulq(ivx,ibmcnt(ivx)) - lnote = 13 -c -c Check for dotted 2-note trem; prepend dot to notexq if needed -c - if (nodur(ivx,ip1+1).eq.12 .or. - * nodur(ivx,ip1+1).eq.24) then - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if - notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) - lnote = lnote+3+lnoten - call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) - gotnote = .true. - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if - end if - else if (multip .eq. -1) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. 1) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) - else if (multip .eq. 2) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) - lnote = 4 - else if (multip .eq. 3) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) - lnote = 5 - else if (multip .eq. -2) then - notexq = sq//'wh' - else if (multip .eq. -3) then - notexq = sq//'breve' - lnote = 6 - else - print* - print*,'(Error in beamn1, send source to Dr. Don)' - call stop1() - end if - if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then -c notexq = notexq(1:3)//'p' -c lnote = 4 - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if - notexq = notexq(1:lnote)//noteq - lnote = lnote+lnoten - end if - return - end if -c -c Check if mult. decreases from 1st note to 2nd -c - if (ibm2(ivx,ibmcnt(ivx)).gt.ip1 - * .or. btest(islur(ivx,ip1),20)) then -c -c More than one note or single-note before a multiplicity-down-up "][" -c - if (btest(islur(ivx,ip1),20)) then - multr = 1 - else if (.not.btest(irest(ivx,ip1+1),0)) then - multr = iand(15,mult(ivx,ip1+1))-8 - else - multr = iand(15,mult(ivx,ip1+2))-8 - end if - lnote = 0 -c -c Check if staff-jumper -c - if (isbjmp .and. ivbj2.gt.0) then - ivxp = ivbj1 - else - ivxp = ivx - end if - if (multr .lt. multip) then - do 1 im = multip , multr+1 , -1 -c -c Right-shifted 'termination' -c - if (isbjmp .and. ivbj2.gt.0) then -c -c Jump beam -c - call ntrbbb(im,'t',ulq(ivxp,ibmcnt(ivx)), - * ivxp,notexq,lnote) - else -c -c Same staff -c - call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivxp,notexq,lnote) - end if -1 continue - end if - end if -c -c Check for beamed, dotted 2-note tremolo -c - if (btest(irest(ivx,ip1),2) .and. - * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - gotnote = .true. - if (lnoten .eq. 1) then - noteq = ' '//noteq(1:1) - lnoten = 2 - end if - end if -c -c Put in the note, but check first for open-head beamed tremolo. -c - if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then -c -c 2-note open head tremolo -c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'hb' - else - notexq = sq//'hb' - end if - else - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' - end if - end if - lnote = lnote+3 - if (btest(irest(ivx,ip1),2) .and. - * (nodur(ivx,ip1+1).eq.24.or.nodur(ivx,ip1+1).eq.12 - * .or.nodur(ivx,ip1+1).eq.48)) then -c -c 2-note trem on dotted note -c - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if -c -c Check for dot -c - isdotm = .false. - if (.not.vxtup(ivx)) then - nd = nodur(ivx,ipo(jn)) - if (nd.ne.0) then - if (2**log2(nd).ne.nd) then - if (.not.btest(iornq(ivx,ip1),13)) then - if (.not.btest(islur(ivx,ip1),3)) then - notexq = notexq(1:lnote)//'p' - else -c -c Double dot -c - notexq = notexq(1:lnote)//'pp' - lnote = lnote+1 - end if - else - notexq = notexq(1:lnote)//'m' - isdotm = .true. - end if - lnote = lnote+1 - end if - end if - else if (btest(nacc(ivx,ip1),19) .or. - * btest(nacc(ivx,ip1),27)) then -c -c In an xtup with special 2:1 notation with a dot on 1st note, or normal dot -c - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if -c -c Do the number; 0 if 12 -c 5/25/08 allow >12 -c - if (.not.btest(irest(ivx,ip1),24)) then - call istring(mod(ivx,24),numq,len) - else -c -c 1st note of staff-jumping beam -c - call istring(mod(ivbj1,24),numq,len) - end if - notexq = notexq(1:lnote)//numq(1:len) - lnote = lnote+len - if (.not.gotnote) then - call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) - end if - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - if (isdotm) then - if (lnoten .eq. 1) then - notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}' - lnote = lnote+3 - else - notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) - lnote = lnote+1 - end if - end if - return - end - subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq - character*40 restq - character*79 inameq - logical beamon,firstgulp,figbass,figchk,btest, - * isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm - common /comeskz2/ eskz2(nm,200) - common /comoct/ noctup - common /strtmid/ ihnum3,flipend(nm),ixrest(nm) - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 -c -c The following is just to save the outputs from SetupB for the case of -c xtups starting with a rest, where beamstrt is called twice. -c - common /comipb/ nnb,sumx,sumy,ipb(24),smed - character*1 chax - character*8 noteq - character*79 notexq,tempq - integer nornb(nm),ihornb(nm,24) - real*4 space(80),squez(80) - logical novshrinktop,cstuplet,usexnumt,writebrests - common /comnvst/ novshrinktop,cstuplet - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - character*10 figq - common /xjbeambrests/ nbrests - writebrests = .true. - ibc = ibmcnt(ivx) - ipb1 = ibm1(ivx,ibc) - multb = iand(15,mult(ivx,ipb1))-8 - ip = ipo(jn) - lnote = 0 - nvtrem = 0 ! Vertical adjustment beams for tremolo -c -c Compute slopes and note offsets from start of beam. Inside SetupB, for each -c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also -c gets islope(ivx), transferred in common. -c - if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) - * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx)) -c -c Will always come past here after entering beamstrt for 2-note tremolo, and -c slope will have been computed, even for unbeamed. So start the indented -c beams here. The indented tremolo bars will be added to the notexq output -c string, under the tacet assumption that there is no horizontal shift -c enacted by the action just before and after the call to beamstrt. -c - if (btest(irest(ivx,ipb1),2) .and. - * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then - nindent = igetbits(irest(ivx,ipb1),2,5) - tempq = sq//'roffset{.7}{'//sq//'ib' - ltemp = 16 - if (nindent .eq. 2) then - tempq = tempq(1:16)//'b' - ltemp = 17 - else if (nindent .eq. 3) then - tempq = tempq(1:16)//'bb' - ltemp = 18 - end if -c -c Use beam # 0 for indented beams -c - tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0' - ltemp = ltemp+2 -c -c Get adjustment to nolev1 for main beam based on nindent -c - if (ulq(ivx,ibc) .eq. 'u') then - nvtrem = nindent-1 - else - nvtrem = 1-nindent - end if -c -c Get numerical position of initiation for main beam. Will adjust height at -c closing to account for nindent -c - numinit = nolev1(ivx)-ncmid(iv,ipb1)+4 -c -c Get forced beam height tweak, apply here for indented beams -c - iadj = igetbits(ipl(ivx,ipb1),6,11)-30 - if (iadj .ne. -30) numinit = numinit+iadj - if (numinit.ge.0 .and. numinit.le.9) then - write(noteq,'(i1)') numinit - lnoten = 1 - else - write(noteq,'(a1,i2,a1)')'{',numinit,'}' - lnoten = 4 - end if - tempq = tempq(1:ltemp)//noteq(1:lnoten) - ltemp = ltemp+lnoten -c -c Now do the slope. -c 170408 Baseline is in islope(ivx). Apply slope tweak if present. -c - numinit = islope(ivx) - iadj = igetbits(ipl(ivx,ipb1),6,17)-30 - if (iadj .ne. -30) numinit = numinit+iadj - if (numinit.ge.0 .and. numinit.le.9) then - write(noteq,'(i1,a1)') numinit,'}' - lnoten = 2 - else - write(noteq,'(a1,i2,a2)')'{',numinit,'}}' - lnoten = 5 - end if - tempq = tempq(1:ltemp)//noteq(1:lnoten) - ltemp = ltemp+lnoten - notexq = tempq - lnote = ltemp - end if - if (btest(nacc(ivx,ip),21)) then -c -c This is start of later segment of single-slope beam group so use slope and -c height from prior beam. Slope is already OK. -c - issb(ivx) = issb(ivx)+1 - nolev1(ivx) = lev1ssb(ivx,issb(ivx)) - end if -c -c Move this up to before indented beams for tremolo -c lnote = 0 - drawbm(ivx) = .true. - if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then - vxtup(ivx) = .true. - nxtinbm(ivx) = nxtinbm(ivx)+1 -c -c irest(28)=>Xtup starts on this note. Set up for xtuplet. -c Number goes on notehead side at middle note (or gap) of xtup, unless that -c puts it in staff, then it flops to stem (or beam) side. -c __ __ -c | | | O | | -c O | | O -c |___| O |__| | -c -c iud -1 -1 1 1 ...stem direction -c iflop 0 1 -1 0 ...direction of flop -c iup -1 1 -1 1 ...direction of number and bracket -c - iud = 1 - if (ulq(ivx,ibc) .eq. 'u') iud = -1 -c -c Get ip#, note level of middle note (or gap) in xtup -c - ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2 -c -c 130129 If middle note is a rest, go to next note. Note last note cannot -c be a rest -c -14 continue - if (btest(irest(ivx,ipmid),0)) then - ipmid = ipmid+1 - go to 14 - end if - xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud, - * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8) - if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+ - * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud, - * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2 - iflop = 0 - if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud - iup = iud+2*iflop - if (btest(irest(ivx,ipb1),14)) then -c -c Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) -c - iup = -iup - iflop = 0 - if (iud*iup .lt. 0) iflop = iup - end if -c -c Determine if a beam is to be drawn. -c Had problem w/ half-note 2-note xtups always F, so add a test -c - if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then - drawbm(ivx) = .true. - go to 6 - end if - do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc) - if (iand(15,mult(ivx,ipp))-8 .le. 0) then - drawbm(ivx) = .false. - go to 6 - end if -5 continue - drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18) -6 continue -c -c Are we using tuplet.tex? -c - usexnumt = cstuplet .and. .not.drawbm(ivx) -c -c Check for single note xtup 171217 -c - if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then - drawbm(ivx) = .false. - end if -c -c Place xtup number if needed -c - if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then - mprint = igetbits(nacc(ivx,ip),5,22) - if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) -c Stab in the dark! Note: tried setting unbeam flag islur18 but no go. - if (nnb .eq. 1) then - xnlmid = nolev1(ivx) - islope(ivx) = 0 -c -c Move up, outside number check block, so all 1-note xtups ar unbeamed -c drawbm(ivx) = .false. -c - end if - call putxtn(mprint,iflop,multb,iud,wheadpt, - * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1), - * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)), - * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt) - end if - if (.not.drawbm(ivx)) then -c -c Xtuplet with no beam -c - if (.not.btest(islur(ivx,ipb1),31)) then -c -c Number printing has not been suppressed, so put in the bracket. -c scale = stretch factor for bracket if there are asx's -c xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) -c - xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1) - * -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib)) - if (iup .eq. 1) then - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'ovbkt' - else - notexq = sq//'ovbkt' - end if - else - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'unbkt' - else -c -c Introduced 12/5/98, req'd due to possible presence of in-line TeX -c - notexq = sq//'unbkt' - end if - end if - lnote = lnote+6 - if (iline.eq.1) then - smed = smed/(1.-fracindent) - end if - xslope = 1.8*smed*slfac - islope(ivx) = nint(xslope) - nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1)) - if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1 - if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4 - levbracket = nolev1(ivx) - if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1 - call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1)) - if (lnoten .eq. 1) call addblank(noteq,lnoten) - notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' - lnote = lnote+lnoten+1 - if (xnsk .lt. 0.995) then - write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk - lnote = lnote+4 - else if (xnsk .lt. 9.995) then - write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk - lnote = lnote+4 - else - write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk - lnote = lnote+5 - end if - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - if (btest(mult(ivx,ipb1),4)) then -c -c Tweak slope of bracket -c - islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16 - end if - if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - if (islope(ivx) .lt. -9) then - write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx) - lnote = lnote+3 - else - write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx) - lnote = lnote+2 - end if - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - else - write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx) - lnote = lnote+1 - end if -c -c Done with bracket -c - end if - if (ixrest(ivx) .eq. 1) then -c -c Put in the rest. Possible problem: Rest is a spacing char, but between -c beamstrt and beamn1 some non-spacing chars. are inserted. -c -c 130126 Deal with vertical shifts of rest starting xtuplet -c - lrest = 3 - if (btest(islur(ivx,ip),29)) then - restq = sq//'sk' -c if (multb .eq. 0) then - else if (multb .eq. 0) then - restq = sq//'qp' - else if (.not.drawbm(ivx).and.multb.eq.1) then - restq = sq//'ds' - else if (.not.drawbm(ivx).and.multb.eq.2) then - restq = sq//'qs' - else if (.not.drawbm(ivx).and.multb.eq.3) then - restq = sq//'hs' - else - restq = sq//'hpause' - lrest = 7 - end if - if (btest(nacc(ivx,ipb1),18) .and. - * btest(nacc(ivx,ipb1),19)) then -c -c VERY special case of rest at start of F-tuplet, needs dot -c - restq = sq//'pt4'//restq(1:lrest) - lrest = lrest+4 - end if - - nole = mod(nolev(ivx,ip)+20,100)-20 -c if (nole .eq. 0) then - if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then -c -c Rest blank or is not raised -c - notexq = notexq(1:lnote)//restq - lnote = lnote+lrest - else - if (abs(nole) .lt. 10) then - tempq = chax(48+abs(nole)) - ltemp = 1 - else - write(tempq(1:2),'(i2)')abs(nole) - ltemp = 2 - end if - if (nole .gt. 0) then - tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote' - else - tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote' - end if - ltemp = 16+ltemp - notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest) - lnote = lnote+ltemp+lrest - end if -c -c No need to come back through this subroutine (as would if rest starts bar -c & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. -c - ixrest(ivx) = 0 - end if - return - end if -c -c End if block for non-beamed xtup start...note we returned -c - if (ixrest(ivx) .eq. 1) then -c -c Insert rest at start of beamed xtup. See above note for possible problem. -c But first check if blank rest and if in forced beam (assuming xtuplet), -c and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*' -c - if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then - nbrests = nbrests+1 - writebrests = .false. - else - nodur(ivx,ipb1) = 2**(4-multb) - call notex(tempq,ltemp) - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//tempq(1:ltemp) - else - notexq = tempq(1:ltemp) - end if - lnote = lnote+ltemp - end if -c -c Re-zero just in case! -c - nodur(ivx,ipb1) = 0 - ibm1(ivx,ibc) = ibm1(ivx,ibc)+1 -c -c See if next note is a non-rest -c - if (.not.btest(irest(ivx,ipb1+1),0)) then - ixrest(ivx) = 2 - else -c -c Suppress reprinting xtup number next time through beamstrt -c - islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31) -c -c Set new xtup start flag -c - irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28) - end if - return - end if - end if -c -c Just ended if block for xtups -c - if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then -c -c Move actual note writing to beamend -c - ixrest(ivx) = 4 - return - end if - if (issb(ivx) .eq. 0) then -c -c 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed -c - iadj = igetbits(ipl(ivx,ipb1),6,11)-30 - if (iadj .ne. -30) then - nolev1(ivx) = nolev1(ivx)+iadj - do 2 isssb = 1 , nssb(ivx) - lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj -2 continue - end if - iadj = igetbits(ipl(ivx,ipb1),6,17)-30 - if (iadj .ne. -30) then - islope(ivx) = islope(ivx)+iadj - if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx)) - if (nssb(ivx) .gt. 0) then -c -c Cycle thru non-rest notes in SSBG, looking for bmstrts. -c - isssb = 0 - do 4 inb = 2, nnb - if (btest(nacc(ivx,ipb(inb)),21)) then -c -c Beam segment start. New start level - isssb = isssb+1 - lev1ssb(ivx,isssb) = - * lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac - end if -4 continue - end if - end if - end if - iadj = igetbits(islur(ivx,ipb1),2,27) - addbrack = .false. - if (btest(ipl(ivx,ipb1),30)) then -c -c Check for altered starting polarity. Only in forced beams. Nominal start -c level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). -c - if (ulq(ivx,ibc).eq.'u' .and. - * nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then - if (lnote .eq. 0) then - notexq = sq//'loff{' - else - notexq = notexq(1:lnote)//sq//'loff{' - end if - lnote = lnote+6 - addbrack = .true. - else if (ulq(ivx,ibc).eq.'l' .and. - * nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then - if (lnote .eq. 0) then - notexq = sq//'roff{' - else - notexq = notexq(1:lnote)//sq//'roff{' - end if - lnote = lnote+6 - addbrack = .true. - end if -c -c Check end level for possible flipping in forced beam. Have to do it -c here since with multiple voices, xelsk will not be preserved. -c - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then - bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac - flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc)) - else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then - bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac - flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc)) - end if - end if - multbb = multb+iadj -c -c Tremolo starting? -c - if (btest(irest(ivx,ipb1),2)) multbb = - * igetbits(irest(ivx,ipb1),2,3) - call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote) -c -c Put in name of start level and slope, after correcting nolev1 if xtup -c started with a rest. -c - if (ixrest(ivx).eq.2) nolev1(ivx) = - * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac) -c -c Add adjustment nvtrem to main beam to account for tremolo indented beams -c - call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1)) - if (islope(ivx) .lt. 0) then - notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' - lnote = lnote+4+lnoten - write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}' - else - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+1+lnoten - write(notexq(lnote:lnote),'(i1)')islope(ivx) - end if -c -c Check for beam-thk fine-tuning -c - if (iadj .gt. 0) then - do 1 imp = multb+iadj , multb+1 , -1 - call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote) -1 continue - end if -c -c If we shifted, must close with right bracket -c - if (addbrack) then - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if -c -c Add in \sk's for very special case of staff-crossing xtup chords -c Assumes we are in lower (first) voice of up-to-both beamed xtup -c that starts with blank rests (notes in upper voice here). -c - if (nbrests.gt.0 .and. writebrests) then - do 7 isk = 1 , nbrests - notexq = notexq(1:lnote)//chax(92)//'sk' - lnote = lnote+3 -7 continue - nbrests = 0 - end if -c -c Get 'floor' zmin for figures -c Note: Will not come thru here on 1st note of unbeamed xtup, so figure height -c won't be adjusted. If anyone ever needs that, need to duplicate this -c functionality up above, before exiting. -c - if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then - if (ivx .eq. 1) then - ivf = 1 - else - ivf = ivxfig2 - end if - zmult = 1.2*(multb-1) - ymin = 100. - do 3 inb = 1, nnb - if (isfig(ivf,ipb(inb))) then - if (ulq(iv,ibc) .eq. 'u') then - ybot = nolev(iv,ipb(inb)) - else - ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx) - * -stemlen-zmult - end if - ymin = min(ymin,ybot) - end if -3 continue - maxdrop = ncmid(iv,ipb1)-4-ymin+5.01 - ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop) - end if -c -c Compute ornament levels if needed -c - NomOrnLev = ncmid(iv,ipb1)+5 - iorn = 0 - do 8 inb = 1 , nnb - ip = ipb(inb) - if (.not.btest(iornq(ivx,ip),23)) go to 8 - if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then -c -c letter-dynamic or hairpin ending under down-beamed -c - iorn = iorn+1 - ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1 - * -1.2*(multb-1) - ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10) - else if (.not.btest(ipl(ivx,ip),10)) then -c -c Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F -c 15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD -c -c Non-chord. There IS an ornament. Need ihornb only if upbeam, and if -c ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) -c - if (ulq(ivx,ibc).eq.'u' .and. - * iand(iornq(ivx,ipb(inb)),4163566).gt.0) then - iorn = iorn+1 - iornq(ivx,ip) = ibset(iornq(ivx,ip),22) - ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1 - * +1.2*(multb-1) - ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev) - end if - else -c -c In a chord. Orn may be on main note or non-main or both. Set ihornb if -c upbeam and highest note has orn, or down beam and lowest. Find 1st chord note -c - do 10 icrd1 = 1 , ncrd - if (iand(255,icrdat(icrd1)) .eq. ip .and. - * iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11 -10 continue -11 continue -c -c Find outermost note, min or max depending on beam direction ulq. xto is true -c if there's an ornament on that note. Expand orn list to include ._, since if -c on extreme chord note in beam, will move. -c So ornaments are all except 0,4,13 (,g,) -c - levx = nolev(ivx,ip) - xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0 - icrdx = 0 - do 12 icrd = icrd1 , ncrd - if (iand(255,icrdat(icrd)) .ne. ip .or. - * iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13 - levc = iand(127,ishft(icrdat(icrd),-12)) - if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or. - * (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then - levx = levc - icrdx = icrd - xto = iand(icrdorn(icrd),4186094).gt.0 - end if -12 continue -13 continue -c -c If there's orn on extreme note, do stuff -c - if (xto) then - iorn = iorn+1 - if (ulq(ivx,ibc) .eq. 'u') then - ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1 - * +1.2*(multb-1) - ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev) - else - ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1 - * -1.2*(multb-1) - ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10) - end if - if (icrdx .eq. 0) then -c -c Affected ornament is on main note -c - iornq(ivx,ip) = ibset(iornq(ivx,ip),22) - else - icrdorn(icrdx) = ibset(icrdorn(icrdx),22) - end if - end if - end if -8 continue -c -c Henceforth nornb will be a counter. -c - if (iorn .gt. 0) nornb(ivx)=1 - if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0 - return - end - block data - parameter (nm=24) - common /comtol/ tol - common /comtrans/ cheadq - common /compage/ widthpt,ptheight,hoffpt,voffpt, - * nsyst,nflb,ibarflb(0:40), - * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), - * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), - * nistaff(0:40) - common /cblock/ - * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, - * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh - common /cominbot/ inbothd - logical usefig - common /comstart/ facmtr - character*60 cheadq - character*120 instrq,titleq,compoq - logical headlog - common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, - * inhead - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac - common /combmh/ bmhgt,clefend - common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), - * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), - * idynda2(99),levhssav(nm),listcresc,listdecresc - character*128 txtdynq - logical kbdrests - common /comkbdrests/ levbotr(8),levtopr(8),kbdrests - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /comsize/ isize(nm) -c - data tol /.001/ - data cheadq - * /' '/ - data gslfac /9./ - data instrq,titleq,compoq,headlog /3*' ',.false./ -c -c meter space (pts) = xb4mbr = musicsize*facmtr -c - data facmtr /0.55/ - data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt - * / 1.3333,.4 , .7 , .3 , 0.2 , 2.0 , 1.0 , - * .7,.7 ,.9 ,.5 ,2.3 ,1.1 / - data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac - * / 1.32 , 2.25 , 0.47 , 0.83 , 0.17 , 0.5 , 1.7 / - data rtshfac / 1.0 / - data isize /nm*0/ -c -c From other -c - data ptheight,widthpt,hoffpt,voffpt, - * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, - * xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh - * / 740. , 524. , 0., 0., - * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12., - * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 / - data fracsys /30*0./ - data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, -c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, - * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, - * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3, - * -0.3,0.3 / - data kbdrests /.false./, - * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/ - data EarlyTransOn, LaterInstTrans /2*.false./ - data iInstTrans /nm*0/ - data iTransAmt /nm*0/ - end - subroutine catspace(space,squez,nnsk) - parameter (nkb=3999,maxblks=9600) - common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), - * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, -c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) - * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) - common /comtol/ tol -c logical gotclef - do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1 - if (abs(space-durb(iptr)) .lt. tol) then - if (abs(squez-sqzb(iptr)) .lt. tol) then -c -c Increment pre-existing entry -c - nnpd(iptr) = nnpd(iptr)+nnsk - return - end if - end if -16 continue -c -c Didn't find current duration & squez, so add a new entry. -c No particular reason to keep in order, so add at the end. -c - nnpd(nptr(ibarcnt+1)) = nnsk - durb(nptr(ibarcnt+1)) = space - sqzb(nptr(ibarcnt+1)) = squez - nptr(ibarcnt+1) = nptr(ibarcnt+1)+1 - return - end - character*1 function chax(n) -c -c The only reason for this seemingly do-nothing function is to get around an -c apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! -c - chax = char(n) - return - end - subroutine checkdyn(lineq,iccount,ibar) - character*128 lineq - character*1 durq,chax - character*4 dynsymq - logical txtdyn - txtdyn = .false. -c -c On entry, iccount is on "D" -c - if (lineq(iccount+1:iccount+1) .eq. '"') then -c -c Dynamic text -c - - istart = iccount+2 ! 1 past 1st quote -3 continue - iend = index(lineq(istart:128),'"') - if (lineq(istart+iend-2:istart+iend-2) .eq. '\') then - istart = iccount+iend+2 - go to 3 - end if - if (iend .eq. 0) then - call errmsg(lineq,iccount+1,ibar, - * 'Dynamic text must be terminated with double quote!') - call stop1() - end if -c -c Set iccount to character after 2nd ", and set ipm -c -c iccount = iccount+iend+2 - iccount = istart+iend - ipm = index('- +',lineq(iccount:iccount)) - if (ipm .eq. 0) then - call errmsg(lineq,iccount,ibar, - * 'Expected "-", "+", or blank here!') - call stop1() - end if - else -c -c Expect ordinary dynamic -c - do 1 iend = iccount+2 , 128 - ipm = index('- +',lineq(iend:iend)) - if (ipm .gt. 0) go to 2 -1 continue -2 continue - if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then - call errmsg(lineq,iend-1,ibar, - * 'Wrong length for dynamic mark!') - call stop1() - end if - read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')') - * dynsymq - idno = (index( - * 'ppppppp pp p mp mf f fp sfz ff fff ffff< > ', - * dynsymq)+3)/4 - if (idno .eq. 0) then - call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!') - call stop1() - end if - iccount = iend - end if - if (ipm .ne. 2) then -c -c There is a vertical shift, have "+" or "-" -c - iccount = iccount+1 - if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then - call errmsg(lineq,iccount,ibar, - * 'Expected integer here for vertical offset!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - idno = nint(fnum) - if (idno .gt. 63) then - call errmsg(lineq,iccount-1,ibar, - * 'Vertical offset for dynamic mark must be (-63,63)!') - call stop1() - end if - ipm = index('- +',durq) - if (ipm .eq. 0) then - call errmsg(lineq,iccount,ibar, - * 'Expected "+", "-", or blank here!') - call stop1() - end if - if (ipm .ne. 2) then -c -c There is a horizontal shift -c - iccount = iccount+1 - if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then - call errmsg(lineq,iccount,ibar, - * 'Expected number here for horizontal offset!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - idno = nint(10*fnum) - if (idno .gt. 255) then - call errmsg(lineq,iccount-1,ibar, - * 'Horizontal offset for dynamic mark must be (-25.5,25.5)!') - call stop1() - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibar, - * 'There should be a blank here!') - call stop1() - end if - end if -c -c iccount should be on the blank at the end of the entire symbol -c - end if - return - end - subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp) -c subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, -c * icashft) - logical found1,iscacc,isarp,btest - integer icrdat(193) - found1 = .false. -c -c icashft will be max left shift of accid's in chord notes. -c Used only for spacing checks. -c Will include left shift of chord note itself. -c Rezero after use. -c - do 18 icrd = 1 , ncrd -c -c This if block cycles thru all chord notes on ivx,ip; then returns. -c - if (iand(255,icrdat(icrd)) .eq. ip .and. - * iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then - found1 = .true. - iscacc = iscacc .or. - * (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) -c -c Accid on this chord note, and it's not midi-only. -c -c irshft = igetbits(icrdot(icrd),7,20) -cc -cc Include increment for notehead shift -cc -c if (btest(icrdat(icrd),23)) then -c if (irshft .eq. 0) then -c irshft = 44 -c else -c irshft=irshft-20 -c end if -c end if -c if (irshft .ne. 0) then -cc -cc Accid on chord note is shifted. Include only left shift, in 20ths. -cc -c if (irshft .lt. 64) icashft = max(icashft,64-irshft) -c end if -c end if - isarp = isarp .or. btest(icrdat(icrd),25) - else if (found1) then - return - end if -18 continue - return - end - subroutine chkimidi(icm) - parameter (nm=24,mv=24576) - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - if (imidi(icm) .ge. mv) then - print* - print*,'Midi file is too long! It will be corrupted or worse' - write(*,'(a6,2x,4i8)') - * 'imidi:',imidi(0),imidi(1),imidi(2),imidi(3) - end if - return - end - subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx, -c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) - * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl) - parameter (nm=24) - integer*4 nn(nm),islur(nm,200),irest(nm,200), - * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8), - * ivmx(nm,2),mult(nm,200),ipl(nm,200) -c -c On 130127 put this code, formerly in make2bar right before calling notex for -c a single note/rest, into this subroutine, so the same logic could also be -c with the calls to beamstrt/mid/end to adjust height of rests in xtups if the -c keyboard rest option is selected -c -c mode=1 if called as before, 2 if for an xtup. Only affects check for -c quarter rests, which will fix later. -c -c Get reference level: next following note if no intervening blank rests, -c otherwise next prior note. Relative to bottom line. -c -c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then - if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then -c -c Not the last note and not "look-left" for level -c - do 8 kkp = ip+1 , nn(ivx) - if (btest(islur(ivx,kkp),29)) go to 4 - if (.not.btest(irest(ivx,kkp),0)) then - levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line - go to 9 - end if -8 continue - end if -4 continue -c -c If here, there were no following notes or came to a blank rest, or -c "look-left" option set. So look before -c -c if (ip .eq. 1) go to 2 ! Get out if this is the first note. - if (ip .eq. 1) return ! Get out if this is the first note. - do 3 kkp = ip-1, 1, -1 - if (.not.btest(irest(ivx,kkp),0)) then - levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line - go to 9 - end if -3 continue -c go to 2 ! Pretty odd, should never be here, but get out if so. - return ! Pretty odd, should never be here, but get out if so. -9 continue -c -c Find note in other voice at same time -c - iupdown = sign(1,ivx-nv-1) - ivother = ivmx(iv,(3-iupdown)/2) - tother = 0. - do 5 kkp = 1 , nib(ivother,ibar) - if (abs(tother-tnow) .lt. tol) go to 6 - tother = tother+nodur(ivother,kkp) -5 continue -c -c If here, then no note starts in other voice at same time, so set default -c - levother = -iupdown*50 - go to 7 -6 continue -c -c If here, have just identified a simultaneous note or rest in other voice -c - if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it - levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 - else - if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then -c -c Rest in other voice has same duration, get out (so defualt spacing is used) -c -c go to 2 - return - end if - levother = -iupdown*50 - end if -7 continue - if (mode.eq.1) then - indxr = log2(nodur(ivx,ip))+1 - else -c nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) - indxr = 4-(iand(mult(ivx,ip),15)-8)+1 - end if - if (iupdown .lt. 0) then - levtop = levtopr(indxr) - iraise1 = levother-levtop-3 ! Based on other note - iraise2 = levnext-levtop ! Based on following note - if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 - iraise = min(iraise1,iraise2) - if (mod(iraise+50,2).eq.1 .and. - * iraise+levtop.gt.-1) iraise = iraise-1 - else - levbot = levbotr(indxr) - iraise1 = levother-levbot+3 - iraise2 = levnext-levbot - if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 - iraise = max(iraise1,iraise2) - if (mod(iraise+50,2).eq.1 .and. - * iraise+levbot.le.9) iraise = iraise-1 - end if - nolev(ivx,ip) = 100+iraise - return - end - subroutine chklit(lineq,iccount,literr) - character*128 lineq - character*1 charq,chax - literr = 0 - itype = 1 -17 call g1etchar(lineq,iccount,charq) - if (charq .eq. chax(92)) then - itype = itype+1 - if (itype .gt. 3) then - literr = 1 - return - end if - go to 17 - end if - lenlit = itype -18 call g1etchar(lineq,iccount,charq) - if (charq.eq.chax(92)) then - call g1etchar(lineq,iccount,charq) - if (charq .ne. ' ') then -c -c Starting a new tex command withing the string -c - lenlit = lenlit+2 - if (lenlit .gt. 128) then - literr = 2 - return - end if - go to 18 - end if - else - lenlit = lenlit+1 - if (lenlit .gt. 128) then - literr = 2 - return - end if - go to 18 - end if - return - end - subroutine chkpm4ac(lineq,iccount,nacc,moved) -c -c Called after getting +/-/ in a note (not rest). iccount is on the +-<>. -c Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits -c 10-16) if < or >, horiz and vert (bits 4-9) if two consecutive signed -c numbers. If moved=.true., iccount on exit is on end of last number. -c If moved=.false., iccount still on +/- -c - logical moved,ishorz - character*128 lineq - character*1 durq - if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and. - * index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then -c -c Prior char was accid & next is #; this may be start of accidental shift. -c Must test for "." above in case we get "<" or ">" -c - ipm = index('- +< >',lineq(iccount:iccount))-2 - if (lineq(iccount+1:iccount+1).eq.'.' .and. - * index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then -c -c Rare case of [accid][+/-].[letter]. Bail out -c - moved = .false. - return - end if - ishorz = ipm .gt. 1 -c -c Save iccount in case it's not accid shift and we have to reset. -c - icsav = iccount - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (ishorz .or. index('+-',durq).gt.0) then -c -c This has to be accidental shift. Set vert. shift. -c - if (.not.ishorz) then -c -c +/- syntax, both shifts set, vertical first -c - call setbits(nacc,6,4,int(ipm*fnum+32.5)) - ipm = index('- +',durq)-2 - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - else -c -c syntax, only horiz set -c - ipm = ipm-3 - end if -c -c Set horiz. shift -c - call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35))) - iccount = iccount-1 - moved = .true. - else -c -c False alarm. Reset everything and flow onward -c - moved = .false. - iccount = icsav - end if - else -c -c Either prior char was not 'sfn' or next was not digit, so take no action -c - moved = .false. - end if - return - end - subroutine clefsym(isl,notexq,lnote,nclef) -c -c Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. -c - character*(*) notexq - character*1 chax - nclef = iand(ishft(isl,-12),7) - if (nclef .eq. 0) then -c -c treble -c - nlev = 2 - else if (nclef .gt. 6) then -c -c French violin -c - nlev = 0 - else if (nclef .lt. 5) then -c -c C-clef -c - nlev = 2*nclef-2 - else -c -c F-clef -c - nlev = 2*nclef-6 - end if - notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7)) - * //chax(48+nlev) - lnote = 10 - return - end - subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime, - * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) -c -c nacc = accidental bitmap for main note -c naccid = # of accid's in chord -c micrd = array with icrd #'s for notes w/ acc's, 0=>main note -c nolevm = level of main note -c segrb(1|2,.) x|y-coord of right-bdry segment -c ksegrb(.) internal use; tells what defined this segment -c -2: Left-shifted notehead -c -1: Original right boundary -c 0: Main note accidental -c icrd: Chord-note accidental -c isetshft(i),i=1,naccid: what set shift for this accid, same codes -c icrdot0 = top-down level-rank of main note among accid-notes -c icrdot(icrd)(27-29) = level rank of chord-note among accid-notes -c twooftwo will be true 2nd time thru; signal to store shifts w/ notes -c - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50) - integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50), - * isetshft(10),ksegrb0(50) - logical lasttime,mainnote,twooftwo - data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 / - data segar / -c -c Fancy sharp boundary. fl,sh,na,dfl,dsh -c - * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2, -c * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. , -c meas value for y, natural is 1.6 - * -0.75,-0.20,-0.80,-.75, 0. , .96,-1.04,1.48, .96, 1.2, - * 0.00,-0.38, 0.00, 0. , 0. ,3.15, 1.64,3.0, 3.15, 0. , - * 0. , 0.00, 0. , 0. , 0. , 0. , 2.90, 0. , 0. , 0. , - * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , - * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / - data segal / -c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , -cc (meas. value is 3.08) ^^^^ -cc Raise top of flat so it interferes with bottom of sharp - * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2, - * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2, - * 0. ,-1.02, 0.00, 0. , 0. , 0. , 1.04, 3.0, 0. , 0. , - * 0. , 0.00, 0. , 0. , 0. , 0. , 2.9 , 0. , 0. , 0. , - * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , - * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / -c -c iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6) -c - data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 / -c -c Set up barrier segrb(iseg,ipoint) to define coords of corner points -c on stem+notes -c - do 11 iseg = 1 , nsegrb0 - segrb(1,iseg) = segrb0(1,iseg) - segrb(2,iseg) = segrb0(2,iseg) - ksegrb(iseg) = ksegrb0(iseg) -11 continue - nsegrb = nsegrb0 - rmsshift = 0. - shiftmin = 1000. - do 1 iwa = 1 , naccid -c -c Initialize shift for this note -c - shift = 0. - mainnote = micrd(iwa).eq.0 - isetshft(iwa) = -1 -c -c Get note level and accidental type -c - if (mainnote) then - nolev = nolevm - iacctype = iacctbl(igetbits(nacc,3,0)) - else - nolev = igetbits(icrdat(micrd(iwa)),7,12) - iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20)) - end if -c -c Cycle thru segments on right edge of this accidental -c - do 2 isega = 1 , nsegar(iacctype)-1 - ybotaseg = nolev+segar(iacctype,2,isega) - ytopaseg = nolev+segar(iacctype,2,isega+1) -c -c Cycle thru segments of right-hand barrier -c - do 3 isegrb = 1 , nsegrb-1 -c -c Must find all barrier segments that start below ytopseg & end above ybotseg -c - if (segrb(2,isegrb) .lt. ytopaseg) then -c -c Barrier seg starts below top of accid -c Check if barrier seg ends above bottom of accid -c - if (segrb(2,isegrb+1) .gt. ybotaseg) then - if (shift .gt. - * segrb(1,isegrb)-segar(iacctype,1,isega)) then - shift = segrb(1,isegrb)-segar(iacctype,1,isega) -c -c Record the cause of the shift -c - isetshft(iwa) = ksegrb(isegrb) - end if - end if -c -c Does barrier segment end above top of accid seg? -c - if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4 - end if -3 continue -4 continue -2 continue - if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001 - * .and. .not.lasttime) then -c if (nolev .eq. levmaxacc) then - if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then - rmsshift = 1000. - return - end if -c -c Does the following properly account for left-shifted noteheads? -c -c Top-down rank of this note we just shifted -c - if (mainnote) then - irank = icrdot0 - else - irank = igetbits(icrdot(micrd(iwa)),3,27) - end if -c -c Compare level-rank of this note vs. that of note that caused the shift. -c This has effect of checking for basic interferences from top down. -c -c ksegrb(.) internal use; tells what defined this segment -c -2: Left-shifted notehead -c -1: Original right boundary -c 0: Main note accidental -c icrd: Chord-note accidental -c isetshft(i),i=1,naccid: what set shift for this accid, same codes -c - if (isetshft(iwa) .lt. 0) then - iranksetter = 0 - else if (isetshft(iwa) .eq. 0) then - iranksetter = icrdot0 - else - iranksetter = igetbits(icrdot(isetshft(iwa)),3,27) - end if - if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then - rmsshift = 1000. - return - end if - end if - rmsshift = rmsshift+shift**2 - if (lasttime .and. abs(shift).gt..0001) then - if (mainnote) then - if (.not.btest(nacc,29)) go to 10 - else - if (.not.btest(icrdat(micrd(iwa)),29)) go to 10 - end if -c -c If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there -c was a manual shift but auto-shift was zero, will not come thru here, but shift value -c will be left intact. -c - if (mainnote) then - shift = shift+.05*(igetbits(nacc,7,10)-107) - else - shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107) - end if -10 continue - if (twooftwo) then -c -c Record the shift for this accidental -c - if (shift .lt. -5.35) then - call printl(' ') - call printl('WARNING: auto-generated accidental '// - * 'shift too big for PMX, ignoring') - else - ishift = nint(20*(shift+5.35)) - if (mainnote) then - call setbits(nacc,7,10,ishift) - else - call setbits(icrdot(micrd(iwa)),7,20,ishift) - end if - end if - else -c -c This is the earlier call to precrd, so need minimum shift -c - shiftmin = min(shiftmin,shift) - end if - end if -c -c Bail out if this is the last accidental to check -c - if (iwa .eq. naccid) go to 1 -c -c Add this accidental to the right barrier! Count down from highest barrier segment, -c find 1st one starting below top of accid, and first one starting below bot. -c - do 5 ibelowtop = nsegrb , 1 , -1 - if (segrb(2,ibelowtop) .lt. - * nolev+segal(iacctype,2,nsegal(iacctype))) then - do 9 ibelowbot = ibelowtop , 1 , -1 - if (segrb(2,ibelowbot) .lt. - * nolev+segal(iacctype,2,1)) go to 6 -9 continue - print*,'Oops2!' - call stop1() - end if -5 continue - print*,'Ugh0! in crdaccs' - call stop1() -6 continue - netgain = nsegal(iacctype)-ibelowtop+ibelowbot -c -c Shift high segments up -c - if (netgain .ge. 0) then - do 7 isegrb = nsegrb , ibelowtop+1 , -1 - segrb(1,isegrb+netgain) = segrb(1,isegrb) - segrb(2,isegrb+netgain) = segrb(2,isegrb) - ksegrb(isegrb+netgain) = ksegrb(isegrb) -7 continue -c -c Set up 1st segment above accid -c - segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop) - segrb(2,ibelowtop+netgain) = - * nolev+segal(iacctype,2,nsegal(iacctype)) - ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop) - else -c -c netgain<0, must remove segments. Use same coding but reverse order, -c work from bottom up -c - segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop) - segrb(2,ibelowtop+netgain) = - * nolev+segal(iacctype,2,nsegal(iacctype)) - ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop) - do 12 isegrb = ibelowtop+1 , nsegrb - segrb(1,isegrb+netgain) = segrb(1,isegrb) - segrb(2,isegrb+netgain) = segrb(2,isegrb) - ksegrb(isegrb+netgain) = ksegrb(isegrb) -12 continue - end if -c -c Insert new segments -c - do 8 isega = 1 , nsegal(iacctype)-1 - segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega) - segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega) - if (mainnote) then - ksegrb(ibelowbot+isega) = 0 - else - ksegrb(ibelowbot+isega) = micrd(iwa) - end if -8 continue -c -c Update number of barrier segments -c - nsegrb = nsegrb+netgain -cc -cc Temporary printout for boundary segments as built up -cc -c write(15,'()') -c write(15,'(a/(2f8.2,i5))')' y x kseg', -c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) -c write(15,'(a/(2i5))')' micrd isetshft', -c * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) -cc -1 continue ! next accidental - if (lasttime .and. .not.twooftwo) then -c -c This is the final call on the pre-ask pass, so compute left-shift rqmt. -c - icashft = nint(-20*shiftmin) - end if -cc -cc Temporary printout for boundary segments -cc -c if (twooftwo) then -c write(15,'()') -c write(15,'(a/(2f8.2,i5))')' y x kseg', -c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) -c write(15,'(a/(2i5))')' micrd isetshft', -c * (micrd(iwa),isetshft(iwa),iwa=1,naccid) -c end if -cc - return - end - subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm, - * levmaxacc,levminacc,icrdot0,twooftwo,icashft) -c -c nacc = accidental bitmap for main note -c naccid = # of accid's in chord -c kicrd = array with icrd #'s for notes w/ acc's, 0=>main note -c nolevm = level of main note -c -c This is called once per multi-accidental chord. In here, loop over all -c permutations of the order of accidental as stored in kicrd. Each time thru -c loop, call crdacc once, get rms shift. Only save permutation and rms value -c if it is less than old value. -c - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 -c -c Make consistent? 120106 -c integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) - integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) - real*4 segrb0(2,50) - logical btest,tagged,manual,lshift,twooftwo -cc -cc Temporary printout of level-rankings -cc -c write(15,'()') -c do 98 iacc = 1 , naccid -c if (kicrd(iacc) .eq. 0) then -c write(15,'(3i5)')nolevm,icrdot0 -c else -c write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12), -c * igetbits(icrdot(kicrd(iacc)),3,27) -c end if -c98 continue -cc -c -c Initialize right-barrier -c - segrb0(1,1) = 0. - segrb0(2,1) = -1000. - segrb0(1,2) = 0. - segrb0(2,2) = 1000. - nsegrb0 = 2 - ksegrb0(1) = -1 - ksegrb0(2) = -1 -c -c Search for left-shifted notes, Make up the initial right-barrier, which -c will be good for all permutations. -c irest()(27) is set if any notes are left-shifted -c Must use ALL chord notes, not just ones w/ accid's. -c - if (btest(irest,27)) then - do 15 icrd = icrd1-1, icrd2 - if (icrd .eq. icrd1-1) then -c -c Main note -c -c lshift = btest(ipl,8) - lshift = btest(ipl,8) .or. btest(nacc,31) - if (lshift) nolev = nolevm - else -c -c Chord note -c - lshift = btest(icrdat(icrd),23) -c if (lshift) nolev = igetbits(icrdat(icrd),7,12) - if (lshift) then - nolev = igetbits(icrdat(icrd),7,12) - if (btest(nacc,31) .and. nolev.eq.nolevm+1) then -c -c This note is not really shifted, It is the upper of a 2nd with the main -c note on an upstem, and Main note must be shifted. -c nacc(31) signals the real truth. -c - lshift = .false. - end if - end if - end if - if (lshift) then - do 16 isegrb = 1 , nsegrb0-1 - if (segrb0(2,isegrb+1) .gt. nolev-1) then -c -c Add this notehead to the right boundary here. Move all higher segs up 2. -c - do 17 iiseg = nsegrb0 , isegrb+1 , -1 - segrb0(1,iiseg+2) = segrb0(1,iiseg) - segrb0(2,iiseg+2) = segrb0(2,iiseg) - ksegrb0(iiseg+2) = ksegrb0(iiseg) -17 continue - go to 18 - end if -16 continue -18 continue -c -c Insert notehead into list. Set kseg=-2 to signal notehead shift. -c - iiseg = isegrb+1 - segrb0(1,iiseg) = -1.2 - segrb0(2,iiseg) = nolev-1. - ksegrb0(iiseg) = -2 - segrb0(1,iiseg+1) = 0. - segrb0(2,iiseg+1) = nolev+1. - ksegrb0(iiseg+1) = -1 - nsegrb0 = nsegrb0+2 - end if -15 continue - end if -c -c Done setting right barrier for left-shifted noteheads -c - tagged = .false. - manual = .false. -c -c Preprocess to check for manual shifts. -c If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then -c If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then -c 1. Auto-shifting proceeds -c 2. "A"-shifts add to autoshifts -c 3. non-"A" shifts are ignored! -c Else (>0 man shifts, none has "A") -c No auto-ordering, No autoshifts, Observe all manual shifts. -c End if -c End if -c - maxmanshft = 0 - do 13 i = 1 , naccid - if (kicrd(i) .eq. 0) then -c -c Main note -c - manshft = igetbits(nacc,7,10) - if (manshft .ne. 0) then - manual = .true. - if (btest(nacc,29)) then - tagged = .true. - else -c maxmanshft = max(maxmanshft,64-manshft) - maxmanshft = max(maxmanshft,107-manshft) - end if - end if - else -c -c Chord note -c - manshft = igetbits(icrdot(kicrd(i)),7,20) - if (manshft .ne. 0) then - manual = .true. - if (btest(icrdat(kicrd(i)),29)) then - tagged = .true. - else -c maxmanshft = max(maxmanshft,64-manshft) - maxmanshft = max(maxmanshft,107-manshft) - end if - end if - end if -13 continue - if (manual) then - if (tagged) then -c -c zero out all untagged shifts -c - do 14 i = 1 , naccid - if (kicrd(i) .eq. 0) then - if (.not.btest(nacc,29)) call setbits (nacc,7,10,0) - else - if (.not.btest(icrdat(kicrd(i)),29)) - * call setbits (icrdot(kicrd(i)),7,20,0) - end if -14 continue - else -c -c There are manual shifts but none tagged. Only proceed if "Ao" was entered -c - if (.not.btest(nacc,28)) then - icashft = maxmanshft - return - end if - end if - end if - if (btest(nacc,28)) then -c -c Take the accidentals in order as originally input, then exit. -c - call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true., - * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) - return -c end if - else if (naccid .eq. 3) then -c -c Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd -c then place in order top, bottom, middle. -c - do 20 i = 1 , 3 - if (kicrd(i) .eq. 0) then - irank = icrdot0 - nolev = nolevm - else - irank = igetbits(icrdot(kicrd(i)),3,27) - nolev = igetbits(icrdat(kicrd(i)),7,12) - end if - if (irank .eq. 1 ) then - micrd(1) = kicrd(i) - else - micrd(5-irank) = kicrd(i) - end if - if (irank .eq. 2) then - levmidacc = nolev - end if -20 continue - if (levmaxacc.ne.levmidacc+1 .and. - * levmidacc.ne.levminacc+1) then - call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true., - * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) - return - end if - end if - rmsmin = 100000. -c -c Initialize permutation array -c - do 7 i = 1 , naccid - iperm(i) = i -7 continue -c -c Start looping over permutations -c - do 8 ip = 1 , 5041 - if (ip .ne. 1) then -c -c Work the magic algorithm to get the next permutation -c - do 1 k = naccid-1 , 1 , -1 - if (iperm(k) .le. iperm(k+1)) go to 2 -1 continue -c -c If here, we just got the last permutation, so exit the loop over permutations -c - go to 10 -2 continue - do 3 j = naccid , 1 , -1 - if (iperm(k) .le. iperm(j)) go to 4 -3 continue -4 continue - it = iperm(j) - iperm(j) = iperm(k) - iperm(k) = it - is = k+1 - do 5 ir = naccid , 1 , -1 - if (ir .le. is) go to 6 - it = iperm(ir) - iperm(ir) = iperm(is) - iperm(is) = it - is = is+1 -5 continue -6 continue - end if -c -c New we have a permutation. Take icrd values out of kicrd and put them into -c micrd in the order of the permutation -c - do 9 i = 1 , naccid - micrd(i) = kicrd(iperm(i)) -9 continue -cc -cc Temporary printout -cc -c write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) -cc - call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false., - * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) -cc -cc Temporary printout -cc -c write(15,*)'perm done, rmsshift:',rmsshift -cc - if (rmsshift .lt. rmsmin) then -c -c Save this permutation, reset minrms -c - do 11 i = 1 , naccid - ipermsav(i) = iperm(i) - rmsmin = rmsshift -11 continue - end if -8 continue - print*,'Should not BEEEEEE here!' - call stop1() -10 continue -c -c Done looping, get info for the final choice -c - do 12 i = 1 , naccid - micrd(i) = kicrd(ipermsav(i)) -12 continue -cc -cc Temporary printout -cc -c write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) -cc - call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true., - * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) - return - end - subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut) - character*1 sq,chax - character*3 acsymq - character*8 noteq - character*79 notexq - logical btest,caut - sq = chax(92) - if (ihshft .eq. -107) ihshft=0 -cc -cc If main note shifted left, so shift accid. Terminate below, when acc. is done. -cc - if (ihshft .ne. 0) then -c -c Accid must be shifted horizontally -c - if (ihshft .lt. 0) then - notexq = sq//'loffset{' - ihshft = -ihshft - else - notexq = sq//'roffset{' - end if - hshft = .05*ihshft - if (hshft .lt. 1.) then - write(notexq(10:12),'(f3.2)')hshft - lnote = 12 - else - write(notexq(10:13),'(f4.2)')hshft - lnote = 13 - end if - notexq = notexq(1:lnote)//'}{'//sq - lnote = lnote+3 - else - notexq = sq - lnote = 1 - end if - if (btest(nacc,3)) then - notexq = notexq(1:lnote)//'big' - lnote = lnote+3 - end if - if (caut) then -c -c Cautionary accidental. Need to define bigcna,... in pmx.tex -c - notexq = notexq(1:lnote)//'c' - lnote = lnote+1 - end if - call accsym(nacc,acsymq,lacc) - notexq = notexq(1:lnote)//acsymq(1:lacc) - lnote = lnote+lacc - noleva = nolev - if (ivshft .ne. 0) noleva = noleva+ivshft-32 - call notefq(noteq,lnoten,noleva,ncm) - if (lnoten .eq. 1) call addblank(noteq,lnoten) - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - if (ihshft .ne. 0) then -c -c Terminate horizontal shift -c - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - return - end - subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt, - * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen, - * dotxtup,nacc,irest) - parameter (nm=24,mv=24576) - integer*4 irest(nm,24) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac - integer*2 mmidi,iinsiv - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - logical lowdot,dotxtup - integer*4 ihornb(nm,24),nornb(nm) - character*1 ulq(nm,9),chax - character*7 nosymq - character*8 noteq - character*79 notexq,outq - character*80 soutq - logical btest,isleft,isright,beamon - character*79 inameq - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /commidisig/ midisig - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) -c -c This subr. once produced notexq for entire chord. 10/18/97 altered to write -c chord notes as we go. 10/22/97 find range of icrd first. -c 2/25/98 moved rangefinding to precrd so done before slurs, so now -c on entry, icrd1, icrd2 define range of icrd for this chord. -c -c Set counter (for this note) for chord notes present. Set notmain=T. -c Will test for notmain=.true. in addmidi to tell whether to save pitch. -c - nmidcrd = 0 - notmain = .true. - crdacc = .false. - do 5 icrd = icrd1 , icrd2 - lnote = 0 - nolev = igetbits(icrdat(icrd),7,12) -c -c 3/8/03 save original pitch to use in midi, in case 2nds alter things. -c - nolevo = nolev -c -c Check for special situations with 2nds (see precrd). -c - if (btest(nacc,30) .and. nolev.eq.nolevm-1) then -c -c Upstem, 2nd with upper as main, interchange pitches, -c rt-shift upper (now chord note). Lower (orig chord, now main) -c if dotted, probably had shifted dot, dot parameters must be moved -c from chord to main -c - nolev = nolevm - if (btest(icrdat(icrd),26)) then -c -c Orig. chord note dot shift, must transfer to main. -c - icrdotsav = icrdot(icrd) - icrdatsav = icrdat(icrd) - if (btest(irest(ivx,ip),19)) then -c -c Main note (upper) had a dot shift, must move it to chord -c - call setbits(icrdat(icrd),1,26,1) - call setbits(icrdot(icrd),7,0, - * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) - call setbits(icrdot(icrd),7,7, - * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) -c -c May need to worry about other chord params (accid shefts etc) later -c - else - icrdat(icrd) = ibclr(icrdat(icrd),26) - end if -c -c We are adding a main note dot shift, so push any later ones back -c - - if (.not.btest(irest(ivx,ip),19)) then - maxdotmv(ivx) = maxdotmv(ivx)+1 - do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1 - updot(ivx,indm) = updot(ivx,indm-1) - rtdot(ivx,indm) = rtdot(ivx,indm-1) -1 continue - end if - irest(ivx,ip) = ibset(irest(ivx,ip),19) - updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) - rtdot(ivx,ndotmv(ivx)+1) = - * 0.1*(iand(127,ishft(icrdotsav,-7))-64) - end if - else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then -c -c Downstem, 2nd with lower as main, interchange pitches, -c left-shift lower (now chord note). Lower (orig main, now chord) -c probably had shifted dot, dot parameters must be moved from -c main to chord -c - nolev = nolevm - if (btest(irest(ivx,ip),19)) then - icrdotsav = icrdot(icrd) - icrdatsav = icrdat(icrd) - icrdat(icrd) = ibset(icrdat(icrd),26) -c bits in icrdot -c 0-6 10*abs(vertical dot shift in \internote) + 64 -c 7-13 10*abs(horizontal dot shift in \internote) + 64 -c Assuming >0 for now! - call setbits(icrdot(icrd),7,0, - * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) - call setbits(icrdot(icrd),7,7, - * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) -c -c Must also set dot shift for (now) main note (orig. chord note). -c - if (btest(icrdatsav,26)) then - updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) - rtdot(ivx,ndotmv(ivx)+1) = - * 0.1*(iand(127,ishft(icrdotsav,-7))-64) - else -c -c No dot move on original chord (now main) note, -c - updot(ivx,ndotmv(ivx)+1) = 0. - rtdot(ivx,ndotmv(ivx)+1) = 0. - end if - end if - end if -c -c Lower dot for lower-voice notes?. Conditions are: -c 1. Dotted time value -c 2. Lower voice of two -c 3. Note is on a line -c 4. Not a rest (cannot be a rest in a chord!) -c. 5. Flag (lowdot) is set to true -c - if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then - if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then - if (btest(icrdat(icrd),26)) then -c -c Note already in movdot list. Drop by 2. -c - call setbits(icrdot(icrd),7,0, - * igetbits(icrdot(icrd),7,0)-20) - else -c -c Not in list so just move it right now -c - call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) - end if - end if - end if - if (btest(icrdat(icrd),26)) then -c -c Move the dot. Basic call for chord notes, not main note. -c - updotc = 0.1*(iand(127,icrdot(icrd))-64) - rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) - call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) - end if - isleft = btest(icrdat(icrd),23) - isright = btest(icrdat(icrd),24) -c -c Check for ornament in chord. -c - if (icrdorn(icrd) .gt. 0) then - call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, - * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, - * ip,0,beamon,.true.) - call addstr(outq,lout,soutq,lsout) - end if -c -c Chord-note symbol. First check for breve -c - if (nodu .eq. 128) then - nosymq = chax(92)//'zbreve' - lsym = 7 - else -c -c Not a breve chord. Get first letters in chord-note symbol -c - if (isleft) then - nosymq = chax(92)//'l' - else if (isright) then - nosymq = chax(92)//'r' - else - nosymq = chax(92)//'z' - end if - if (nodu .ge. 64) then - nosymq = nosymq(1:2)//'w' - else if (nodu .ge. 32) then - nosymq = nosymq(1:2)//'h' - else - nosymq = nosymq(1:2)//'q' - end if - if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then - lsym = 3 - else if (.not.btest(islur,3) .or. dotxtup) then -c -c Single dot -c - nosymq = nosymq(1:3)//'p' - lsym = 4 - else -c -c Double dot -c - nosymq = nosymq(1:3)//'pp' - lsym = 5 - end if - end if - if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then -c -c Accidental and not MIDI-only. Build up bits 0-3 of nacc -c - nactmp = igetbits(icrdat(icrd),3,20) -c -c Kluge for bigness. Only means 'As' has not been issued -c - if (bacfac .ne. 1.e6) nactmp = nactmp+8 - call doacc(igetbits(icrdot(icrd),7,20)-107, - * igetbits(icrdot(icrd),6,14), -c * notexq,lnote,nactmp,nolev,ncmid(iv,ip)) -c Get original nolev, not altered to deal with 2nds - * notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12), -c * ncmid(iv,ip)) - * ncmid(iv,ip),btest(icrdat(icrd),31)) - notexq = notexq(1:lnote)//nosymq - crdacc = .true. - else - notexq = nosymq - end if - lnote = lnote+lsym -c -c Get note name (again if accid, due to possible octave jump) -c - call notefq(noteq,lnoten,nolev,ncm) - if (lnoten.eq.1) call addblank(noteq,lnoten) -c -c Put in note name -c - notexq = notexq(1:lnote)//noteq - lnote = lnote+lnoten - if (btest(icrdat(icrd),25)) then -c -c Arpeggio signal -c - call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout) - end if - call addstr(notexq,lnote,soutq,lsout) - if (ismidi) then -c -c Here is where we collect MIDI pitch info for the chord note. By checking -c notmain, addmidi(...) knows to just compute the -c pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() -c for MAIN note, will put in note codes for all chord notes + main note. -c - kv = 1 - if (ivx .gt. iv) kv=2 - nmidcrd = nmidcrd+1 - if (nmidcrd .gt. 20) then - print* - print*,'21 chord notes is too many for midi processor' - call stop1() - end if -c -c Use original saved pitch level, unaltered by 2nds logic. -c - call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)), - * igetbits(icrdat(icrd),3,20),midisig,1., - * .false.,.false.) - end if -5 continue - notmain = .false. - return - end - subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv, - * beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout) - parameter (nm=24) -c -c Inputs are array *elements* except ihornb,nornb,ulq -c - common /commus/ musize,whead20 - common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), - * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), - * idynda2(99),levhssav(nm),listcresc,listdecresc - character*128 txtdynq - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - logical btest,beamon,upstem,nostem - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - logical fontslur,upslur,WrotePsslurDefaults - character*1 udqq,chax,ulq(nm,9) - character*4 dynstrq - character*5 numpq - character*48 dyntablq,tempq - character*79 notexq - character*80 soutq - integer*4 ihornb(nm,24),nornb(nm),idynn(10) - common /comhair/ ihairuse,idhair(nm) - data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/ - numdyn = 0 -c -c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values -c in idynn(1...4) -c - do 1 idyn = 1 , ndyn - ivxtent = iand(idyndat(idyn),15) - * +16*igetbits(idynda2(idyn),1,10) - if (ivxtent .eq. ivx) then - iptent = igetbits(idyndat(idyn),8,4) - if (iptent .eq. ip) then - numdyn = numdyn+1 - idynn(numdyn) = idyn - else if (iptent .gt. ip) then -c -c I don't think there are any more possible for this ivx,ip, so exit loop -c - go to 2 - end if - end if -1 continue -2 continue -c -c At this point there is a list of idyn's in idynn(1...numdyn) -c Compute level, and stem-dir'n-based horizontal tweaks -c - hoffsd = 0. -c -c Set upstem to false as default -c - upstem = .false. - if (btest(irest,0)) then -c -c It's a rest. Assume it doesn't go below the staff -c - lbot = ncm-4 - else if (.not.beamon) then - if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then - upstem = .true. - if (.not.btest(ipl,10)) then - lbot = min(nolev-1,ncm-4) - else - lbot = min(minlev-1,ncm-4) - end if - else - hoffsd = -.5 - if (.not.btest(ipl,10)) then - lbot = min(nolev-7,ncm-4) - else - lbot = min(minlev-7,ncm-4) - end if - end if - else - if (ulq(ivx,ibmcnt) .eq. 'u') then - upstem = .true. - if (.not.btest(ipl,10)) then - lbot = min(nolev-1,ncm-4) - else - lbot = min(minlev-1,ncm-4) - end if - else - hoffsd = -.5 -c -c 171230 Desperation -c lbot = ihornb(ivx,nornb(ivx))+1 - if (nornb(ivx).eq.0) then - lbot = 1 - else - lbot = ihornb(ivx,nornb(ivx))+1 - end if - if (lbot .eq. 1) then -c -c Kluge for non-beamed, down xtup, for which ihorb was never set. -c Assumes stem is shortened. -c - lbot = nolev-5 - end if - nornb(ivx) = nornb(ivx)+1 - end if - end if - lbot = lbot-5 - jtxtdyn1 = 1 -c -c Now ready to loop over current dyn's -c - do 3 icntdyn = 1 , numdyn - idynd = idyndat(idynn(icntdyn)) - idynd2 = idynda2(idynn(icntdyn)) - idno = igetbits(idynd,4,12) -c ivx = iand(15,idynd) - ivx = iand(15,idynd)+16*igetbits(idynd2,1,10) -c -c Build the command into notex in stages. Insert name & rq'd args in order: -c -c Command name -c hpstrt, hpcend, hpdend, pmxdyn -c ivx -c X X X -c level -c X X X -c hoff -c X X X X -c d-mark -c X -c - if (idno .eq. 0) then -c -c Text-dynamic -c - notexq = chax(92)//'txtdyn' - lnote = 7 - else if (idno .le. 12) then -c -c Letter-group -c - notexq = chax(92)//'pmxdyn' - lnote = 7 - else if (fontslur) then - lnote = 7 - if (idno .eq. 13) then -c -c Start a font-based hairpin -c - notexq = chax(92)//'hpstrt' - else if (idno .eq. 14) then -c -c End crescendo -c - notexq = chax(92)//'hpcend' - else -c -c End decrescendo -c - notexq = chax(92)//'hpdend' - end if -c -c Put in voice number as ID for font-based hairpin -c - if (ivx .le. 9) then - notexq = notexq(1:lnote)//char(48+ivx) - lnote = lnote+1 - else if (ivx .le. 19) then - notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' - lnote = lnote+4 - end if - else -c -c Postscript hairpins -c - lnote = 7 - if (idno .eq. 13) then - notexq = chax(92)//'Icresc' - else if (idno .eq.14) then - notexq = chax(92)//'Idecresc' - lnote = 9 - else - notexq = chax(92)//'Tcresc' - end if - if (idno .le. 14) then -c -c Get and record ID no for start of ps hairpin -c Find first unused ID -c - do 8 idh = 1 , 24 - if (.not.btest(ihairuse,idh)) go to 9 -8 continue - call printl('Bad place in putdyn, call Dr. Don') - call stop1() -9 continue - ihairuse = ibset(ihairuse,idh) - idhair(ivx) = idh - else -c -c Unrecord ID no for end of ps hairpin -c - call setbits(ihairuse,1,idhair(ivx),0) - end if -c -c Write ID # for start or end of ps hairpin -c - idh = idhair(ivx) - if (idh .le. 9) then - notexq = notexq(1:lnote)//char(48+idh) - lnote = lnote+1 - else if (idh .le. 19) then - notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}' - lnote = lnote+4 - end if - end if -c -c Begin setting level -c - lbot1 = lbot - if (idno.gt.0 .and. idno.le.5) then -c -c All letters are short so raise a bit. -c - lbot1 = lbot1+1 - else if (idno .ge. 13) then - lbot1 = lbot1+2 - end if -c -c Convert so reference is bottom line -c - lbot1 = lbot1-ncm+4 - if ((fontslur.and.idno.eq.13) .or. - * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then -c -c Hairpin start. Save level and user-tweak before applying user tweak. -c - levdsav(ivx) = lbot1 - levhssav(ivx) = 0 - if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17) - else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then -c -c Hairpin end; Compare level with saved start level before user-tweaks -c - lbot1 = min(lbot1,levdsav(ivx)) -c -c Save pre-tweak level -c - lpretweak = lbot1 - end if -c -c Check for user-defined vertical tweak -c - if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17) -c -c Now horizontal stuff -c - hoff = hoffsd -c -c Some special horizontal tweaks -c - if (upstem .and. idno.gt.0 .and. - * (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4 -c -c User-defined tweaks -c - if (btest(idynd2,0)) - * hoff = hoff+(igetbits(idynd2,9,1)-256)*.1 - if (numdyn .gt. 1) then -c -c Horizontal-interaction-based tweaks. -c -c Cases: -c numdyn type1 type2 type3 data used -c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12) -c 2 hrpnend wrd-grp - ivowg,hoh2 -c 2 hrpnend hrpnstrt - hoh2h1(1...2) -c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 -c - if (idno.gt.0 .and. idno.le.12) then -c -c Word-group, may need vertical tweak to line up. -c - lbot1 = lbot1+ivowg(idno) -c -c Protecting against hp start-stop on same note -c - else if (((fontslur.and.idno.ge.14).or.idno.eq.15) - * .and. icntdyn.lt.numdyn) then -c -c Hairpin ending, check next type -c - if ((fontslur .and. - * igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) - * .or. (.not.fontslur .and. - * ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) - * .or. - * (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14)))) - * then -c -c Hairpin end then hairpin start, no words, (remember dealing with end now) -c - hoff = hoff+hoh2h1(1) - else -c -c Hairpin end then word-group, need idno for w-g to set hp offset -c - hoff = hoff + - * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12)) - end if -c -c Protecting against hp start-stop on same note -c - else if (icntdyn.gt.1 .and. idno.gt.0 .and. - * ((fontslur.and.idno.lt.14).or. - * (.not.fontslur.and.idno.lt.15))) then -c -c Hairpin start, check prior type -c - if ((fontslur.and. - * igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14) - * .or. - * (.not.fontslur.and. - * igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15)) - * then -c -c Hairpin end then hairpin start, (remember dealing with start now) -c - hoff = hoff+hoh2h1(2) - else -c -c Hairpin start after word-group, need idno for w-g to set hp offset -c - hoff = hoff+ - * hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12)) - end if - end if - end if -c -c End of if-block for 2- or 3-way interactions. -c - if ((.not.fontslur) .and. idno.ge.13) -c -c Slur font and hairpin. Add hoff, and change from \interneote to \qn@width -c - * hoff = (hoff+.5)*6./2.5 -c -c Position corrections all done now. Put in the level. -c - if ((fontslur.and.idno.eq.13) .or. - * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then -c -c Hairpin start. -c - if (.not.fontslur) then -c -c Postscript hairpin start...inset placeholder for start level. - - notexq = notexq(1:lnote)//'{ }' - lnote = lnote+5 - end if - else -c -c Insert actual level in all cases except hairpin start -c Create string with level in it -c - if (lbot1 .gt. 9) then - numpq = '{' - write(numpq(2:3),'(i2)')lbot1 - numpq = numpq(1:3)//'}' - lnumpq = 4 - else if (lbot1 .gt. -1) then - numpq = char(48+lbot1) - lnumpq = 1 - else if (lbot1 .gt. -10) then - numpq = '{' - write(numpq(2:3),'(i2)')lbot1 - numpq = numpq(1:3)//'}' - lnumpq = 4 - else - numpq = '{' - write(numpq(2:4),'(i3)')lbot1 - numpq = numpq(1:4)//'}' - lnumpq = 5 - end if -c -c Level has now been computed and stored in numpq -c Append the level -c - notexq = notexq(1:lnote)//numpq(1:lnumpq) - lnote = lnote+lnumpq - end if - if (abs(hoff) .lt. .001) then -c -c No horiz offset -c - notexq = notexq(1:lnote)//'0' - lnote = lnote+1 - else -c -c Horizontal tweak -c - lform = lfmt1(hoff) - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - write(notexq(lnote+1:lnote+lform), - * '(f'//chax(48+lform)//'.1)')hoff - lnote = lnote+lform - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - if (idno .eq. 0) then -c -c text-dynamic. Find the string and append it -c - do 4 jtxtdyn = jtxtdyn1 , ntxtdyn -c ivxip = ivx+16*ip - ivxip = ivx+32*ip - if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5 -4 continue - call printl('Abnormal stop in putdyn') - call stop1() -5 continue - ltxtdyn = lenstr(txtdynq(jtxtdyn),128) -c -c Font size based on musicsize -c -c if (musize .eq. 20) then -c notexq = notexq(1:lnote)//'{'//char(92)//'medtype' -c * //char(92)//'it ' -c lnote = lnote+13 -c else if (musize .eq. 16) then -c notexq = notexq(1:lnote)//'{'//char(92)//'normtype' -c * //char(92)//'it ' -c lnote = lnote+14 -c else if (musize .eq. 24) then -c notexq = notexq(1:lnote)//'{'//char(92)//'bigtype' -c * //char(92)//'it ' -c lnote = lnote+13 -c else if (musize .eq. 29) then -c notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype' -c * //char(92)//'it ' -c lnote = lnote+13 -c end if -c -c Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) -c - call addstr(notexq(1:lnote),lnote,soutq,lsout) - if (musize .eq. 20) then - notexq = '{'//char(92)//'medtype'//char(92)//'it ' - lnote = 13 - else if (musize .eq. 16) then - notexq = '{'//char(92)//'normtype'//char(92)//'it ' - lnote = 14 - else if (musize .eq. 24) then - notexq = '{'//char(92)//'bigtype'//char(92)//'it ' - lnote = 13 - else if (musize .eq. 29) then - notexq = '{'//char(92)//'Bigtype'//char(92)//'it ' - lnote = 13 - end if -c - notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)//'}' - lnote = lnote+ltxtdyn+1 -c -c Reset jtxtdyn1 just in case >1 txtdyn on same note. -c - jtxtdyn1 = jtxtdyn+1 - else if (idno .le. 12) then -c -c Letter-group dynamic. Append the letter-group command -c - id = 4*idno - dynstrq = dyntablq(id-3:id) - id = lenstr(dynstrq,4) - notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id) - lnote = lnote+1+id - end if - call addstr(notexq(1:lnote),lnote,soutq,lsout) - if ((.not.fontslur).and.idno.eq.15) then -c -c PS slurs on, hairpin is ending. Go back and set height at beginning. -c Add user-defined tweak to default level -c - lbot1 = lpretweak+levhssav(ivx) - if (lbot1 .gt. 9) then - numpq = '{' - write(numpq(2:3),'(i2)')lbot1 - numpq = numpq(1:3)//'}' - lnumpq = 4 - else if (lbot1 .gt. -1) then - numpq = char(48+lbot1) - lnumpq = 1 - else if (lbot1 .gt. -10) then - numpq = '{' - write(numpq(2:3),'(i2)')lbot1 - numpq = numpq(1:3)//'}' - lnumpq = 4 - else - numpq = '{' - write(numpq(2:4),'(i3)')lbot1 - numpq = numpq(1:4)//'}' - lnumpq = 5 - end if -c -c Construct string to search backwards for placeholder -c - if (idh .le. 9) then - tempq = 'cresc'//char(48+idh)//'{ }' - ltemp = 11 - else if (idh .le. 19) then - tempq = 'cresc'//'{1'//char(38+idh)//'}{ }' - ltemp = 14 - else - tempq = 'cresc'//'{2'//char(28+idh)//'}{ }' - ltemp = 14 - end if - write(11,'(a)')soutq(1:lsout)//'%' - lsout = 0 - call backfill(11,tempq,ltemp, - * tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq) - end if -3 continue -c -c Shrink arrays, decrease ndyn 111109 -c - do 6 icntdyn = numdyn, 1 , -1 - do 7 jdyn = idynn(icntdyn) , ndyn-1 - idyndat(jdyn) = idyndat(jdyn+1) - idynda2(jdyn) = idynda2(jdyn+1) -7 continue - ndyn = ndyn-1 -6 continue - end - subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl, - * farend, - * beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno) -c -c ip will be one LESS than current note, for way-after's before bar-end, -c It is only used to find ig. -c ig is returned to makeabar in case there's a slur that needs to be ended -c - parameter (nm=24) - logical beamon,stemup - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /comoct/ noctup - logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft, - * normsp,farend,fontslur,WrotePsslurDefaults - real*4 ptgr(37) - character*80 soutq - character*128 litq - character*79 notexq - character*20 voltxtq - character*10 figq - character*8 noteq,noteqGA - character*3 acsymq - character*1 sq,chax,udqq,ulq(nm,9) - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - sq = chax(92) - isgaft = btest(ipl,29) - iswaft = btest(ipl,31) - normsp = .not. isgaft -c -c Find ig. -c - do 120 ig = 1 , ngrace - if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121 -120 continue - print*,'Problem finding grace index in dograce' - stop -121 continue - ngs = ngstrt(ig) - mg = multg(ig) -c wheadpt1 = wheadpt*fullsize(ivx) - wheadpt1 = wheadpt*fullsize(instno) -c -c For way-after-graces at end of bar, must set the octave. -c - if (farend) then - noctup = 0 - if (ncm .eq.23) noctup = -2 - end if - if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then - if (listslur .eq. 16777215) then - print* - print*,'You defined the twentyfifth slur, one too many!' - write(15,'(/,a)') - * 'You defined the twentyfifth slur, one too many!' - call stop1() - end if -c -c Slur on fore-grace. Get index of next slur not in use, from 23 down. -c - ndxslur = log2(16777215-listslur) - - end if - if (nng(ig) .eq. 1) then -c -c Single grace. -c - if (normsp) then -c -c Anything but GA -c - call addstr(sq//'shlft',6,soutq,lsout) - niptgr = nint(ptgr(ig)) -c -c Empirical tweak for postscript. -c -C if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) -c++ - if (niptgr .lt. 10) then - call addstr(chax(48+niptgr)//'{',2,soutq,lsout) - else if (niptgr .lt. 100) then - write(notexq(1:2),'(i2)')niptgr - call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout) - else - print*, - * 'Call Dr. Don if you really want grace note group > 99 pt' - stop - end if - else - call addstr(sq//'gaft{1.5}{',11,soutq,lsout) -c -c GA. Compute aftshft, for later use. -c - aftshft = grafac - if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac - aftshft = aftshft*wheadpt - end if - if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then -c -c Start slur on pre-grace. No accounting needed since will be ended very soon. -c - call notefq(noteq,lnoten,nolevg(ngs),ncm) - if (fontslur) then - if (upg(ig)) then - call addstr(sq//'islurd',7,soutq,lsout) - else - call addstr(sq//'isluru',7,soutq,lsout) - end if - else -c -c Start Postscript slur. -c - if (upg(ig)) then - call addstr(sq//'isd',4,soutq,lsout) - else - call addstr(sq//'isu',4,soutq,lsout) - end if - end if -c -c Print slur number, 23-ndxslur -c - lnote = 0 - if (23-ndxslur .lt. 10) then -c notexq = notexq(1:lnote)//chax(59-ndxslur) - notexq = chax(71-ndxslur) - lnote = 1 - else if (23-ndxslur .lt. 20) then -c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' - notexq = '{1'//chax(61-ndxslur)//'}' - lnote = 4 - else - notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' - lnote = 4 - end if - call addstr(notexq(1:lnote)//noteq(1:lnoten), - * lnote+lnoten,soutq,lsout) - if (.not.fontslur) then -c -c Horizontal tweaks for postscript slur on single grace -c - stemup = .true. - if (upg(ig)) then -c -c Check for up-grace + down stem. Get stem direction -c - if (.not.beamon) then -c -c Separate note. Get stem direction. -c - stemup = udqq(nolev,ncmidx, - * islur,nvmx,ivx,nv) .eq. 'u' - else -c -c In a beam -c - stemup = ulq(ivx,ibmcnt) .eq. 'u' - end if -c -c Stop the shift if whole note -c - stemup = stemup .or. tnote.gt.63 - end if - if (stemup) then - call addstr('{-.3}',5,soutq,lsout) - else - call addstr('{-.8}',5,soutq,lsout) - end if - end if - end if - if (naccg(ngs) .gt. 0) then - call notefq(noteq,lnoten,nolevg(ngs),ncm) -c -c Save for checking octave shifts in GA -c - if (isgaft) then - lnotenGA = lnoten - noteqGA = noteq - end if -c - if (lnoten .eq. 1) call addblank(noteq,lnoten) - call accsym(naccg(ngs),acsymq,lacc) - call addstr(sq//'big'//acsymq(1:lacc)// - * noteq(1:lnoten),4+lacc+lnoten,soutq,lsout) - end if - if (slashg(ig)) then - notexq = sq//'grc' - lnote = 4 - else if (mg .eq. 0) then - notexq = sq//'zq' - lnote = 3 - else - notexq = sq//'zc' - do 61 i = 2 , mg - notexq = notexq(1:i+1)//'c' -61 continue - lnote = mg+2 - end if - if (upg(ig)) then - notexq = notexq(1:lnote)//'u' - else - notexq = notexq(1:lnote)//'l' - end if - call addstr(notexq,lnote+1,soutq,lsout) - call notefq(noteq,lnoten,nolevg(ngs),ncm) -c - if (isgaft .and. naccg(ngs).eq.0) then - lnotenGA = lnoten - noteqGA = noteq - end if -c - if (lnoten .eq. 1) call addblank(noteq,lnoten) - call addstr(noteq,lnoten,soutq,lsout) - if (slashg(ig)) call addstr(sq//'off{-'//sq// - * 'noteskip}',16,soutq,lsout) -c -c Above code needed since slashg causes spacing -c - if (slurg(ig) .and. (iswaft.or.isgaft)) then -c -c Terminate slur on single after-grace -c - ndxslur = igetbits(ipl,5,23) - call notefq(noteq,lnoten,nolevg(ngs),ncm) - call addstr(sq//'tslur',6,soutq,lsout) -c -c Print 24-ndxslur -c -c if (11-ndxslur .lt. 10) then - if (23-ndxslur .lt. 10) then -c call addstr(chax(59-ndxslur)//noteq(1:lnoten), - call addstr(chax(71-ndxslur)//noteq(1:lnoten), - * 1+lnoten,soutq,lsout) - else if (23-ndxslur .lt. 20) then - call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten), - * 4+lnoten,soutq,lsout) - else -c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), - call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten), - * 4+lnoten,soutq,lsout) - end if - slurg(ig) = .false. - listslur = ibclr(listslur,ndxslur) - end if - call addstr('}',1,soutq,lsout) -c -c+++ Try to fix loss of octave with single gaft -c - if (isgaft) then - itrans = 0 - do 1 i = 1 , lnotenGA - if (noteqGA(i:i) .eq. chax(39)) then - itrans = itrans+7 - else if (noteqGA(i:i) .eq. chax(96)) then - itrans = itrans-7 - end if -1 continue - if (itrans. eq. -14) then - call addstr(sq//'advance'//sq//'transpose-14',21, - * soutq,lsout) - else if (itrans .eq. -7) then - call addstr(sq//'advance'//sq//'transpose-7',20, - * soutq,lsout) - else if (itrans .eq. 7) then - call addstr(sq//'advance'//sq//'transpose7',19, - * soutq,lsout) - else if (itrans .eq. 14) then - call addstr(sq//'advance'//sq//'transpose14',20, - * soutq,lsout) - end if - end if - else -c -c Multiple grace. Put in literally. Compute beam stuff -c - sumx = 0. - sumy = 0. - sumxy = 0. - sumxx = 0. - sumyy = 0. - x = 0. - do 118 ing = ngs , ngs+nng(ig)-1 - if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac - y = nolevg(ing) - sumx = sumx + x - sumy = sumy + y - sumxy = sumxy + x*y - sumxx = sumxx + x*x - sumyy = sumyy + y*y - x = x+emgfac -118 continue - delta = nng(ig)*sumxx-sumx*sumx - em = (nng(ig)*sumxy-sumx*sumy)/delta - islope = nint(0.5*em*gslfac) - if (iabs(islope) .gt. 9) islope = isign(9,islope) - beta = (sumy-islope/gslfac*sumx)/nng(ig) - nolev1 = nint(beta) -c -c Back up -c - notexq = sq//'settiny'//sq//'off{' - if (normsp) then - write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig) - call addstr(notexq(1:18)//'pt}',21,soutq,lsout) - finalshift = ptgr(ig) - else - aftshft = wheadpt*1.33 - if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5 - write(notexq(14:17),'(f4.1)')aftshft - call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout) - end if -c -c Start the beam -c - notexq = sq//'ib' - do 119 ing = 2 , mg - notexq = notexq(1:ing+1)//'b' -119 continue - if (upg(ig)) then - notexq = notexq(1:mg+2)//'u' - else - notexq = notexq(1:mg+2)//'l' - end if - notexq = notexq(1:mg+3)//'0' -c -c Get starting note for beam -c - call notefq(noteq,lnoten,nolev1,ncm) - call addstr(notexq(1:mg+4)//noteq(1:lnoten), - * mg+4+lnoten,soutq,lsout) -c -c Put in the slope -c - if (islope .ge. 0) then - call addstr(chax(48+islope),1,soutq,lsout) - else - call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout) - end if -c -c Start a slur on multiple fore-grace -c - if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then - call notefq(noteq,lnoten,nolevg(ngs),ncm) - if (fontslur) then - if (upg(ig)) then - call addstr(sq//'islurd',7,soutq,lsout) - else - call addstr(sq//'isluru',7,soutq,lsout) - end if - else -c -c Need a tweak for postscript slur -c - if (upg(ig)) then - call addstr(sq//'isd',4,soutq,lsout) - else - call addstr(sq//'isu',4,soutq,lsout) - end if - end if -c -c Print 23-ndxslur -c - if (23-ndxslur .lt. 10) then - call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten, - * soutq,lsout) - else if (23-ndxslur .lt. 2) then - call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten), - * 4+lnoten,soutq,lsout) - else - call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten), - * 4+lnoten,soutq,lsout) - end if -c -c Put in tweak for postscript slur -c - if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout) - end if -c -c Put in first note. Call notefq again in case octave changed -c - call notefq(noteq,lnoten,nolevg(ngs),ncm) - if (naccg(ngs) .eq. 0) then - notexq = sq//'zqb0'//noteq(1:lnoten) - lnote = 5+lnoten - else - if (lnoten .eq. 1) call addblank(noteq,lnoten) - call accsym(naccg(ngs),acsymq,lacc) - notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten) - lnote = 4+lacc+lnoten - call notefq(noteq,lnoten,nolevg(ngs),ncm) - notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten) - lnote = lnote+5+lnoten - end if - call addstr(notexq,lnote,soutq,lsout) - do 127 ing = ngs+1 , ngs+nng(ig)-1 -c -c Skip -c - ptoff = wheadpt1*emgfac - if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac - if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff - notexq = sq//'off{' - write(notexq(6:8),'(f3.1)')ptoff - if (normsp) finalshift = finalshift-ptoff - call addstr(notexq(1:8)//'pt}',11,soutq,lsout) - if (ing .eq. ngs+nng(ig)-1) then -c -c Terminate beam if needed -c - if (upg(ig)) then - call addstr(sq//'tbu0',5,soutq,lsout) - else - call addstr(sq//'tbl0',5,soutq,lsout) - end if -c -c Terminate after slur if needed -c - if ((isgaft.or.iswaft) .and. slurg(ig)) then -c if (iswaft) ndxslur = igetbits(ipl,4,23) - if (iswaft) ndxslur = igetbits(ipl,5,23) - call notefq(noteq,lnoten,nolevg(ing),ncm) - call addstr(sq//'tslur',6,soutq,lsout) -c -c Print 11-ndxslur -cc Print 23-ndxslur -c - if (23-ndxslur .lt. 10) then - call addstr(chax(71-ndxslur)//noteq(1:lnoten), - * 1+lnoten,soutq,lsout) - else if (23-ndxslur .lt. 20) then - call addstr('{2'//chax(61-ndxslur)//'}' - * //noteq(1:lnoten),4+lnoten,soutq,lsout) - else - call addstr('{1'//chax(51-ndxslur)//'}' - * //noteq(1:lnoten),4+lnoten,soutq,lsout) - end if -c -c Stop slur terminator after exit from this subroutine -c - listslur = ibclr(listslur,ndxslur) - slurg(ig) = .false. - end if - end if -c -c Accidental if needed -c - if (naccg(ing).gt.0) then - call notefq(noteq,lnoten,nolevg(ing),ncm) - if (lnoten .eq. 1) call addblank(noteq,lnoten) - call accsym(naccg(ing),acsymq,lacc) - call addstr(sq//'big'//acsymq(1:lacc) - * //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout) - end if -c -c Put in the (beamed) grace note -c - call notefq(noteq,lnoten,nolevg(ing),ncm) - call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten, - * soutq,lsout) -127 continue -c -c Terminate the grace -c -c notexq = sq//'normalnotesize'//sq//'off{' -c lnote = 20 -c notexq = '}'//sq//'off{' -c lnote = 6 - notexq = sq//'off{' - lnote = 5 - ptoff = wheadpt*emgfac - if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17)) - * ptoff = ptoff+wheadpt*accfac - if (isgaft .and. .not.iswaft) then - notexq = notexq(1:5)//'-' - lnote = 6 - ptoff = aftshft - end if - if (normsp) ptoff = finalshift - if (ptoff .lt. 9.95) then - write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff - lnote = lnote+3 - else if (ptoff .lt. 99.95) then - write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff - lnote = lnote+4 - else - write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff - lnote = lnote+5 - end if - call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout) - if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout) - call addstr(sq//'resetsize',10,soutq,lsout) - end if - return - end - subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip, - * iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur, - * ipl,iornq,islhgt,tno,nacc) -c -c Called once per main note. -c 12 May 2002 Create this subroutine to isolate postscript slurs/ties. -c Always set \Nosluradjust\Notieadjust -c - parameter (nm=24,mv=24576) - integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /comsln/ is1n1,is2n1,irzbnd,isnx - character*1 ulq,slurudq,udfq,udqq,chax - character*79 notexq - character*8 noteq - character*80 soutq - logical upslur,beamon,btest,stemup,iscrd, - * settie,fontslur,pstie,WrotePsslurDefaults - logical slmon,dbltie - common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), - * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, - * slmon(0:nm),dbltie - integer*2 mmidi,iinsiv - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans -c 130316 - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c -c Bits in isdat1: -c 13-17 iv -c 3-10 ip -c 11 start/stop switch -c 12 kv-1 -c 19-25 ichar(code$) -c 26 force direction? - -c 27 forced dir'n = up if on, set in sslur; also -c final direction, set in doslur when beam is started, used on term. -c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. -c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. -c 2 stem slur flag -c 1 flag for "x" slur (voice-independent) -c -c Bits in isdat2 -c 0 Chord switch. Not set on main note. -c 1-2 left/right notehead shift. Set only for chord note. -c 3 tie positioning -c 4 dotted flag -c 6-11 voff1 1-63 => -31...+31 -c 12-18 hoff1 1-127 => -6.3...+6.3 -c 19-25 nolev -c 26 \sluradjust (p+s) -c 27 \nosluradjust (p-s) -c 28 \tieadjust (p+t) -c 29 \notieadjust (p-t) -c -c Bits in isdat3: Only used for slur endings -c 0 set if midslur (at least one argument) -c 1 set if curve (2 more args) -c 2-7 32+first arg (height correction) (1st arg may be negative) -c 8-10 second arg (initial slope) -c 11-13 third arg (closing slope) -c 14-21 tie level for use in LineBreakTies -c 22-29 ncm for use in LineBreakTies -c -c Bits in isdat4 Only used for linebreak slurs -c 0-5 Linebreak seg 1 voff 1-63 => -31...+31 -c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 -c 16-21 Linebreak seg 2 voff 1-63 => -31...+31 -c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 -c -c In listslur bit ib is on if slur index ib is in use, ib=0-13. -c ndxslur = slur index -c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, -c s-slur is blank (idcode=32), t-slur is idcode=1. -c ivoff is user-defined shift or shift due to . or _ , or chord adjustment. -c Ivoff will be set for ./_ only if no user-defined shift is specified. -c If highest note has upslur, save slur height in islhgt in case -c ornament must be moved. -c - islhgt = 0 - if (beamon) then - stemup = ulq .eq. 'u' - else if (nvmx(iv) .eq. 2) then - if (.not.btest(islur,30)) then -c -c Single note, 2 lines of music, stem direction not forced -c - stemup = ivx .gt. nv - else - stemup = btest(islur,17) - end if - else - stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u' - end if - iscrd = btest(ipl,10) - if (ismidi) then - settie = .false. - dbltie = .false. - end if - do 1 isdat = 1 , nsdat - isdata = isdat1(isdat) - if (iv .eq. igetbits(isdata,5,13) .and. - * ip .eq. igetbits(isdata,8,3) .and. -c * kv .eq. igetbits(isdata,1,12)+1) then - * (kv .eq. igetbits(isdata,1,12)+1 .or. - * btest(isdata,1))) then -c -c Since iv and kv match, ivx will be correct -c - idcode = igetbits(isdata,7,19) - ivoff = igetbits(isdat2(isdat),6,6)-32 - ihoff = igetbits(isdat2(isdat),7,12)-64 - iupdn = 0 - slurudq = 'd' - nolevs = igetbits(isdat2(isdat),7,19) - pstie = btest(isdat2(isdat),3) .or. idcode.eq.1 - if (btest(isdata,11)) then -c -c Turnon -c Get slur direction -c - if (btest(isdata,26)) then -c -c Force slur direction -c - if (btest(isdata,27)) slurudq = 'u' - else if (nvmx(iv) .eq. 1) then -c -c Only one voice per line -c - if (.not.beamon) then -c -c Separate note. -c - slurudq = udfq(nolev,ncm) - else -c -c In a beam -c - if (ulq .ne. 'u') slurudq = 'u' - end if - if (iscrd) then - if (nolevs .gt. ncm) then - slurudq = 'u' - else - slurudq = 'd' - end if - end if - else -c -c Two voices per line. Get default -c - if (ivx .gt. nv) slurudq = 'u' -c -c Upper voice of the two, so up slur -c - end if - if (btest(isdata,2)) then -c -c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. -c - if (stemup) then - slurudq = 'u' - ivoff = ivoff+4 - else - slurudq = 'd' - ivoff = ivoff-4 - end if - end if -c -c Set level for slur starting on rest -c - if (nolevs.eq.0 .or. nolevs.gt.60) then - if (slurudq .eq. 'u') then - nolevs = ncm+2 - else - nolevs = ncm-2 - end if - end if -c -c Save up/down-ness for use at termination -c - if (slurudq .eq. 'u') isdata = ibset(isdata,27) -c -c End of section for setting slur direction, still in "Turnon" if-block. -c - if (btest(iornq,11).or.btest(iornq,12)) then -c -c Raise or lower slur by one unit provided . or _ is on same side as slur -c - ivoffinc = 0 - if ((stemup .and. slurudq.eq.'d') .or. - * (.not.stemup .and. slurudq.eq.'u')) then -c -c Must move the slur for _ or . -c - if (stemup) then - ivoffinc = -1 - else - ivoffinc = 1 - end if - if (((stemup .and. nolev.ge.ncm-2) .or. - * (.not.stemup .and. nolev.le.ncm+2)) .and. - * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc - ivoff = ivoff+ivoffinc - end if - end if - if (listslur .eq. 16777215) then - print* - print*,'You1 defined the twentyfifth slur, one too many!' - write(15,'(/,a)') - * 'You defined the twentyfifth slur, one too many!' - call stop1() - end if -c -c Get index of next slur not in use, starting from 12 down -c - ndxslur = log2(16777215-listslur) -c -c Record slur index -c - listslur = ibset(listslur,ndxslur) -c -c Save for use on termination -c -c call setbits(isdata,4,28,ndxslur) -c 080531 Allow >16 slurs - call setbits(isdata,4,28,mod(ndxslur,16)) - call setbits(isdata,1,18,ndxslur/16) -c -c Shift for stem? -c - if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then - if (.not.pstie) then - ihoff = ihoff+8 - else - ihoff = ihoff+2 - end if - end if - if (iscrd) then -c -c Additional horiz shifts for h-shifted noteheads? -c - if (btest(isdat2(isdat),1)) then -c -c Slur start on left-shifted chord notehead. ASSUME downstem. -c - if (nolevs.eq.minlev .and. slurudq.eq.'d') then - ihoff = ihoff-2 - else - ihoff = ihoff-10 - end if - else if (btest(isdat2(isdat),2)) then -c -c Right shifted chord notehead. ASSUME upstem. -c - if (nolevs.eq.maxlev .and. slurudq.eq.'u') then - ihoff = ihoff+2 - else - ihoff = ihoff+10 - end if - end if - end if - notexq = chax(92) - lnote = 1 -c -c Check for local adjustment default changes -c - if (btest(isdat2(isdat),26)) then - notexq = chax(92)//'sluradjust'//chax(92) - lnote = 12 - else if (btest(isdat2(isdat),27)) then - notexq = chax(92)//'nosluradjust'//chax(92) - lnote = 14 - else if (btest(isdat2(isdat),28)) then - notexq = chax(92)//'tieadjust'//chax(92) - lnote = 11 - else if (btest(isdat2(isdat),29)) then - notexq = chax(92)//'notieadjust'//chax(92) - lnote = 13 - end if - if (ihoff .eq. 0) then -c -c Write stuff for non-shifted start -c - notexq = notexq(1:lnote)//'islur'//slurudq - lnote = lnote+6 - else - notexq = notexq(1:lnote)//'is'//slurudq - lnote = lnote+3 - end if -c -c Prepend postscript tie switch -c - if (pstie) then - notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote) - lnote = lnote+10 - end if - if (btest(isdat2(isdat),4)) then -c -c Dotted slur -c -c noteq = notexq -c notexq = chax(92)//'dotted'//noteq - notexq = chax(92)//'dotted'//notexq(1:lnote) - lnote = lnote+7 - end if -c -c Add slur index to string -c Print 23-ndxslur -c - if (23-ndxslur .lt. 10) then -c -c 5/25/08 Allow 24 slurs -c - notexq = notexq(1:lnote)//chax(71-ndxslur) - lnote = lnote+1 - else if (23-ndxslur .lt. 20) then - notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' - lnote = lnote+4 - end if -c -c Add note name to string -c - islhgt = nolevs+iupdn+ivoff - call notefq(noteq,lnoten,islhgt,ncm) - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten -c -c Store height and staff mid level for use with LineBreakTies -c - call setbits(isdat3(isdat),8,14,islhgt) - call setbits(isdat3(isdat),8,22,ncm) -c -c Save height (for ornament and barnobox interference) if topmost slur is up -c - if (slurudq.eq.'u' .and. - * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then - islhgt = nolevs+iupdn+ivoff -c -c Save height & idcode if top voice and slur start -c - if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then - is1n1 = islhgt - is2n1 = idcode - end if - end if - if (ihoff .ne. 0.) then - shift = ihoff*0.1 - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - lform = lfmt1(shift) - write(notexq(lnote+1:lnote+lform),'(f'// - * chax(48+lform)//'.1)') shift - lnote = lnote+lform - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - call addstr(notexq,lnote,soutq,lsout) -c -c Zero out ip1 to avoid problems if slur goes to next input blk. -c - call setbits(isdata,8,3,0) -c -c Set slur-on data for midi. Only treat null-index slurs and ps ties for now. -c - if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then -c levson(midchan(iv,kv)) = nolevs -c 130316 - levson(midchan(iv,kv)) = nolevs+miditran(instno(iv)) - if (settie) dbltie = .true. -c -c Only way settie=T is if we just set a tie ending. So there's also a slur -c start here, so set a flag telling addmidi not to zero out levson -c - end if - else -c -c Slur is ending. Back thru list to find starting slur -c - do 3 j = isdat-1 , 1 , -1 - if (iv.eq.igetbits(isdat1(j),5,13) .and. -c * kv.eq.igetbits(isdat1(j),1,12)+1) then - * (kv.eq.igetbits(isdat1(j),1,12)+1 - * .or. btest(isdat1(j),1))) then - if (idcode .eq. igetbits(isdat1(j),7,19)) then - ndxslur = igetbits(isdat1(j),4,28) -c -c 080531 Allow >16 slurs -c - * +16*igetbits(isdat1(j),1,18) - if (btest(isdat1(j),27)) slurudq = 'u' - go to 4 - end if - end if -3 continue - print*,'Bad place in doslur' - call stop1() -4 continue -c -c Bugfix 070901 for slur ending on rest in 2-voice staff -c - if (nolevs.le.2 .or. nolevs.gt.60) then -c -c Ending is on a rest, reset nolevs to default starting height -c - nolevs = igetbits(isdat2(j),7,19) - end if - if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then -c -c Deal with \curve or \midslur. isdat is ending, j is start. -c - if (btest(isdat3(isdat),0)) then - imid = igetbits(isdat3(isdat),6,2)-32 - else - imid = igetbits(isdat3(j),6,2)-32 - end if -c -c Postscript slurs, and \midslur adjustment is needed. Invoke macro -c (from pmx.tex) that redefines \tslur as r'qd. Tentative mapping: -c Abs(imid) Postscript slur type -c 1 f -c 2-3 default -c 4 h -c 5 H -c 6+ HH -c - call addstr(chax(92)//'psforts'// - * chax(48+min(abs(imid),6)),9,soutq,lsout) - end if - if (btest(isdata,2)) then -c -c ADjust for stem slur. -c - if (stemup) then - slurudq = 'u' - ivoff = ivoff+4 - else - slurudq = 'd' - ivoff = ivoff-4 - end if - end if -c -c Shift slur ending for stem on any note? -c - if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then - if (.not.pstie) then - ihoff = ihoff-8 - else - ihoff = ihoff-3 - end if - end if - if (iscrd) then -c -c Shift termination for shifted notehead? -c - if (btest(isdat2(isdat),1)) then -c -c Left-shifted chord notehead. ASSUME downstem. -c - if (nolevs.eq.minlev .and. slurudq.eq.'d') then - ihoff = ihoff-2 - else - ihoff = ihoff-10 - end if - else if (btest(isdat2(isdat),2)) then -c -c Right shifted chord notehead. ASSUME upstem. -c - if (nolevs.eq.maxlev .and. slurudq.eq.'u') then - ihoff = ihoff+2 - else - ihoff = ihoff+10 - end if - end if - end if - if (ihoff .eq. 0) then - notexq = chax(92)//'tslur' - lnote = 6 - else -c -c Shift needed -c - notexq = chax(92)//'ts' - lnote = 3 - end if -c -c Switch to postscript tie -c - if (pstie) then - notexq = chax(92)//'tieforts'//notexq(1:lnote) - lnote = lnote+9 - end if -c -c Print 13-ndxslur -c 5/25/08 Allow 14 slurs -c - if (23-ndxslur .lt. 10) then - notexq = notexq(1:lnote)//chax(71-ndxslur) - lnote = lnote+1 - else if (23-ndxslur .lt. 20) then - notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' - lnote = lnote+4 - end if - if (btest(iornq,11).or.btest(iornq,12)) then -c -c Raise or lower slur by one unit provided . or _ is on same side as slur -c - ivoffinc = 0 - if ((stemup .and. slurudq.eq.'d') .or. - * (.not.stemup .and. slurudq.eq.'u')) then - if (stemup) then - ivoffinc = -1 - else - ivoffinc = 1 - end if - if (((stemup .and. nolev.ge.ncm-2) .or. - * (.not.stemup .and. nolev.le.ncm+2)) .and. - * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc - end if - ivoff = ivoff+ivoffinc - end if - call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) - if (slurudq.eq.'u' .and. - * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then - islhgt = nolevs+iupdn+ivoff -c -c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. -c - if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then - if (idcode .eq. is2n1) is1n1=0 - end if - end if - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - if (ihoff .ne. 0) then - shift = ihoff*0.1 - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - lform = lfmt1(shift) - write(notexq(lnote+1:lnote+lform), - * '(f'//chax(48+lform)//'.1)')shift - lnote = lnote+lform - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - call addstr(notexq,lnote,soutq,lsout) -c -c Clear the bit from list of slurs in use -c - listslur = ibclr(listslur,ndxslur) -c -c Zero out the entire strings for start and stop -c - isdata = 0 - isdat2(isdat) = 0 - isdat3(isdat) = 0 - isdat4(isdat) = 0 - isdat1(j) = 0 - isdat2(j) = 0 - isdat3(j) = 0 - isdat4(j) = 0 -c -c Set midi info for slur ending -c - if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then - icm = midchan(iv,kv) - if (slmon(icm)) then - if (nolevs+miditran(instno(iv)).eq.levson(icm) .and. - * iand(7,nacc).eq.0) then -c -c There is a tie here. NB!!! assumed no accidental on 2nd member of tie. -c - levsoff(icm) = nolevs+miditran(instno(iv)) - settie = .true. - else - levsoff(icm) = 0 - levson(icm) = 0 - slmon(icm) = .false. - end if - end if - end if - end if - isdat1(isdat) = isdata - end if -1 continue -c -c Clear and collapse the slur data list -c - numdrop = 0 - do 2 isdat = 1 , nsdat - if (isdat1(isdat) .eq. 0) then - numdrop = numdrop+1 - else if (numdrop .gt. 0) then - isdat1(isdat-numdrop) = isdat1(isdat) - isdat2(isdat-numdrop) = isdat2(isdat) - isdat3(isdat-numdrop) = isdat3(isdat) - isdat4(isdat-numdrop) = isdat4(isdat) - isdat1(isdat) = 0 - isdat2(isdat) = 0 - isdat3(isdat) = 0 - isdat4(isdat) = 0 - end if -2 continue - nsdat = nsdat-numdrop -c call report(nsdat,isdat1,isdat2) - return - end - subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv, - * beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc) -c -c Called once per main note. (5/26/02) for non-ps slurs only -c - parameter (nm=24,mv=24576) - integer*4 isdat1(202),isdat2(202),isdat3(202) - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /comsln/ is1n1,is2n1,irzbnd,isnx - character*1 ulq,slurudq,udfq,udqq,chax - character*79 notexq - character*8 noteq - character*80 soutq - logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove, - * settie,fontslur,WrotePsslurDefaults - logical slmon,dbltie - common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), - * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, - * slmon(0:nm),dbltie - integer*2 mmidi,iinsiv - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans -c 130316 - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c -c Bits in isdat1: -c 13-17 iv -c 3-10 ip -c 11 start/stop switch -c 12 kv-1 -c 19-25 ichar(code$) -c 26 force direction? -c 27 forced dir'n = up if on, set in sslur; also -c final direction, set in doslur when beam is started, used on term. -c 28-31 ndxslur, set in doslur when beam is started, used on term. -c -c Bits in isdat2 -c 0 Chord switch. Not set on main note. -c 1-2 left/right notehead shift. Set only for chord note. -c 3 tie positioning -c 4 dotted flag -c 6-11 voff1 1-63 => -31...+31 -c 12-18 hoff1 1-127 => -6.3...+6.3 -c 19-25 nolev -c -c Bits in isdat3: Only used for slur endings -c 0 set if midslur (at least one argument) -c 1 set if curve (2 more args) -c 2-7 32+first arg (height correction) (1st arg may be negative) -c 8-10 second arg (initial slope) -c 11-13 third arg (closing slope) -c -c In listslur bit ib is on if slur index ib is in use, ib=0-23. -c ndxslur = slur index -c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, -c s-slur is blank (idcode=32), t-slur is idcode=1. -c ivoff is user-defined shift or shift due to . or _ , or chord adjustment. -c Ivoff will be set for ./_ only if no user-defined shift is specified. -c If highest note has upslur, save slur height in islhgt in case -c ornament must be moved. -c - islhgt = 0 - if (beamon) then - stemup = ulq .eq. 'u' - else if (nvmx(iv) .eq. 2) then - if (.not.btest(islur,30)) then -c -c Single note, 2 lines of music, stem direction not forced -c - stemup = ivx .gt. nv - else - stemup = btest(islur,17) - end if - else - stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u' - end if - iscrd = btest(ipl,10) - if (btest(islur,1)) then -c -c 't'-slur (idcode=1) somewhere on this note. Find it, check height against -c 's'-slur (idcode=32) -c - sfound = .false. - tfound = .false. - tmove = .false. - do 5 isdat = 1 , nsdat - if (iv .eq. igetbits(isdat1(isdat),5,13) .and. - * ip .eq. igetbits(isdat1(isdat),8,3) .and. - * kv .eq. igetbits(isdat1(isdat),1,12)+1) then - if (.not.tfound) then - tfound = igetbits(isdat1(isdat),7,19).eq.1 - if (tfound) then - nolevt = igetbits(isdat2(isdat),7,19) - isdatt = isdat - if (sfound) go to 6 - end if - end if - if (.not.sfound) then - sfound = igetbits(isdat1(isdat),7,19).eq.32 - if (sfound) then - nolevs = igetbits(isdat2(isdat),7,19) - isdats = isdat - if (tfound) go to 6 - end if - end if - end if -5 continue -c -c Will come thru here if there is a t with no s, so comment out the following -c print*,'Did not find s+t-slurs in doslur' -c -6 continue - if (sfound .and. tfound) - * tmove = nolevs.eq.nolevt .and. -c -c Check if 2 starts or two stops -c - * ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or. - * (.not.btest(isdat1(isdats),11).and. - * .not.btest(isdat1(isdatt),11)) ) -c -c This is a flag for later changing slur level, after we know slur dir'n. -c - end if - if (ismidi) then - settie = .false. - dbltie = .false. - end if - do 1 isdat = 1 , nsdat - isdata = isdat1(isdat) - if (iv .eq. igetbits(isdata,5,13) .and. - * ip .eq. igetbits(isdata,8,3) .and. - * kv .eq. igetbits(isdata,1,12)+1) then -c -c Since iv and kv match, ivx will be correct -c - idcode = igetbits(isdata,7,19) - ivoff = igetbits(isdat2(isdat),6,6)-32 - ihoff = igetbits(isdat2(isdat),7,12)-64 - iupdn = 0 - slurudq = 'd' - nolevs = igetbits(isdat2(isdat),7,19) - if (btest(isdata,11)) then -c -c Turnon, -c - if (nolevs.eq.0 .or. nolevs.gt.60) then -c -c Note was a rest, cannot start slur on rest. -c - print* - call printl('Cannot start slur on a rest') - call stop1() - end if -c -c Get slur direction -c - if (btest(isdata,26)) then -c -c Force slur direction -c - if (btest(isdata,27)) slurudq = 'u' - else if (nvmx(iv) .eq. 1) then -c -c Only one voice per line -c - if (.not.beamon) then -c -c Separate note. -c - slurudq = udfq(nolev,ncm) - else -c -c In a beam -c - if (ulq .ne. 'u') slurudq = 'u' - end if - if (iscrd) then - if (nolevs .gt. ncm) then - slurudq = 'u' - else - slurudq = 'd' - end if - end if - else -c -c Two voices per line. Get default -c - if (ivx .gt. nv) slurudq = 'u' -c -c Upper voice of the two, so up slur -c - end if -c -c Save up/down-ness for use at termination -c - if (slurudq .eq. 'u') isdata = ibset(isdata,27) -c -c End of section for setting slur direction, still in "Turnon" if-block. -c - if (idcode.eq.1 .and. tmove) then - iupdn = 1 - if (slurudq .eq. 'd') iupdn = -1 - end if - if (btest(iornq,11).or.btest(iornq,12)) then -c -c Raise or lower slur by one unit provided . or _ is on same side as slur -c - ivoffinc = 0 - if ((stemup .and. slurudq.eq.'d') .or. - * (.not.stemup .and. slurudq.eq.'u')) then -c -c Must move the slur for _ or . -c - if (stemup) then - ivoffinc = -1 - else - ivoffinc = 1 - end if - if (((stemup .and. nolev.ge.ncm-2) .or. - * (.not.stemup .and. nolev.le.ncm+2)) .and. - * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc - ivoff = ivoff+ivoffinc - end if - end if - if (listslur .eq. 16777215) then - print* - print*,'You1 defined the twenty-fifth slur, one too many!' - write(15,'(/,a)') - * 'You2 defined the twenty-fifth slur, one too many!' - call stop1() - end if -c -c Get index of next slur not in use, starting from ? down -c - ndxslur = log2(16777215-listslur) -c -c Record slur index -c - listslur = ibset(listslur,ndxslur) -c -c Save for use on termination -c -c call setbits(isdata,4,28,ndxslur) -c 080531 Allow >16 slurs - call setbits(isdata,4,28,mod(ndxslur,16)) - call setbits(isdata,1,18,ndxslur/16) -c -c Shift for stem? -c - if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) - * ihoff = ihoff+8 - if (btest(isdat2(isdat),3)) then -c -c Tie spacing, (slur start) -c - if (slurudq.eq.'d') then - ivoff = ivoff+1 - ihoff = ihoff+8 - else if (slurudq.eq.'u') then - ivoff = ivoff-1 - if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8 -c -c (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') -c - end if - end if - if (iscrd) then -c -c Additional horiz shifts for h-shifted noteheads? -c - if (btest(isdat2(isdat),1)) then -c -c Slur start on left-shifted chord notehead. ASSUME downstem. -c - if (nolevs.eq.minlev .and. slurudq.eq.'d') then - ihoff = ihoff-2 - else - ihoff = ihoff-10 - end if - else if (btest(isdat2(isdat),2)) then -c -c Right shifted chord notehead. ASSUME upstem. -c - if (nolevs.eq.maxlev .and. slurudq.eq.'u') then - ihoff = ihoff+2 - else - ihoff = ihoff+10 - end if - end if - end if - if (ihoff .eq. 0) then -c -c Write stuff for non-shifted start -c - notexq = chax(92)//'islur'//slurudq - lnote = 7 - else - notexq = chax(92)//'is'//slurudq - lnote = 4 - end if - if (btest(isdat2(isdat),4)) then -c -c Dotted slur -c - noteq(1:8) = notexq - notexq = chax(92)//'dotted'//noteq - lnote = lnote+7 - end if -c -c Add slur index to string -cc Print 11-ndxslur -c Print 23-ndxslur -c -c if (11-ndxslur .lt. 10) then - if (23-ndxslur .lt. 10) then -c -c 5/25/08 Allow 24 slurs -c -c notexq = notexq(1:lnote)//chax(59-ndxslur) - notexq = notexq(1:lnote)//chax(71-ndxslur) - lnote = lnote+1 - else if (23-ndxslur .lt. 20) then -c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' - notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' - lnote = lnote+4 - end if -c -c Add note name to string -c - call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten -c -c Save height (for ornament and barnobox interference) if topmost slur is up -c - if (slurudq.eq.'u' .and. - * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then - islhgt = nolevs+iupdn+ivoff -c -c Save height & idcode if top voice and slur start -c - if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then - is1n1 = islhgt - is2n1 = idcode - end if - end if - if (ihoff .ne. 0.) then - shift = ihoff*0.1 - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - lform = lfmt1(shift) - write(notexq(lnote+1:lnote+lform),'(f'// - * chax(48+lform)//'.1)') shift - lnote = lnote+lform - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - call addstr(notexq,lnote,soutq,lsout) -c -c Zero out ip1 to avoid problems if slur goes to next input blk. -c - call setbits(isdata,8,3,0) -c -c Set slur-on data for midi. Only treat null-index slurs and ps ties for now. -c - if (ismidi .and. idcode.eq.32) then - levson(midchan(iv,kv)) = nolevs+miditran(instno(iv)) - if (settie) dbltie = .true. -c -c Only way settie=T is if we just set a tie ending. So there's also a slur -c start here, so set a flag telling addmidi not to zero out levson -c - end if - else -c -c Slur is ending. Back thru list to find starting slur -c - do 3 j = isdat-1 , 1 , -1 - if (iv.eq.igetbits(isdat1(j),5,13) .and. - * kv.eq.igetbits(isdat1(j),1,12)+1) then - if (idcode .eq. igetbits(isdat1(j),7,19)) then - ndxslur = igetbits(isdat1(j),4,28) -c -c 080531 Allow >16 slurs -c - * +16*igetbits(isdat1(j),1,18) - if (btest(isdat1(j),27)) slurudq = 'u' - go to 4 - end if - end if -3 continue - print*,'Bad place in doslur' - call stop1() -4 continue - if (nolevs.eq.0 .or. nolevs.gt.60) then -c -c Ending is on a rest, reset nolevs to default starting height -c - nolevs = igetbits(isdat2(j),7,19) - end if - if (btest(isdat3(isdat),0)) then -c -c Deal with \curve or \midslur -c - imid = igetbits(isdat3(isdat),6,2)-32 -c -c Remember, only dealing with non-ps slurs -c -c Who knows where the following line came from. Removed it 6/30/02 to -c restore behavior of non-ps slurs to old way -c if (slurudq .eq. 'd') imid = -imid -c 3/8/03 added the following -c - if (slurudq .eq. 'd') imid = -abs(imid) -c - if (btest(isdat3(isdat),1)) then - notexq = chax(92)//'curve' - lnote = 6 - else - notexq = chax(92)//'midslur' - lnote = 8 - end if - if (imid.lt.0 .or. imid.gt.9) then -c -c Need brackets -c - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - if (imid .lt. -9) then - write(notexq(lnote+1:lnote+3),'(i3)')imid - lnote = lnote+3 - else if (imid.lt.0 .or. imid.gt.9) then - write(notexq(lnote+1:lnote+2),'(i2)')imid - lnote = lnote+2 - else - write(notexq(lnote+1:lnote+1),'(i1)')imid - lnote = lnote+1 - end if - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - else -c -c 1= 0 . -c Xtups are irrelevant here since they are already all in forced beams. -c Will update itnow by nodur at the END of this loop -c - ip = ip+1 - go to 11 - end if - nreal = nreal+1 - nodue(nreal) = nodur(ivx,ip) - short(nreal) = nodue(nreal).lt.16 .and. - * .not.btest(irest(ivx,ip),0) -c -c Rule out notes that have 'alone'-flag set -c - * .and..not.btest(islur(ivx,ip),18) - ipr(nreal) = ip - itr(nreal) = itnow - if (nodue(nreal) .eq. 1) then -c -c 64th gap -c - if (mod(itnow,2) .eq. 0) then -c -c Start of 32nd gap, lump with following note -c - ip = ip+1 - nodue(nreal) = 1+nodur(ivx,ip) - itnow = itnow+nodue(nreal) - else -c -c End of 32nd gap, lump with preceeding note -c - nreal = nreal-1 - nodue(nreal) = 1+nodue(nreal) - itnow = itnow+1 - end if - else - itnow = itnow+nodur(ivx,ip) - end if - go to 1 -9 continue - ir1 = 1 - itseg = lenbar/ibmrep - do 13 irep = 1 , ibmrep -c -c Set bitmaps for all shorts neighbored by a short. Each bit represents a -c span of 32nd note. maps, mapm, mape record start, full duration, and end -c of consecutive span of beamable (<1/4) notes. -c - maps = 0 - mapm = 0 - mape = 0 - itend = itseg*irep - itoff = itend-itseg - do 2 ir = ir1 , nreal - it2 = itr(ir)+nodue(ir)-2 - if (it2 .ge. itend) then - ir1 = ir - go to 14 - end if -c if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal - if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or. - * (ir.lt.nreal.and.short(ir+1)))) then - ib1 = (itr(ir)-itoff)/2 - ib2 = (it2-itoff)/2 - if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or. - * min(ib1,ib2).lt.0) return -c -c Must have an odd number obe beats in a long bar. Auto-beam won't work -c - nip1(ib1) = ipr(ir) - nip2(ib2) = ipr(ir) -c -c nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip -c - maps = ibset(maps,ib1) - mape = ibset(mape,ib2) - do 3 ib = ib1 , ib2 - mapm = ibset(mapm,ib) -3 continue - end if -2 continue -14 continue - if (mapm .eq. 0) go to 13 -c -c Zero out bits from forced beams -c - maps = iand(maps,not(mapfb(irep))) - mapm = iand(mapm,not(mapfb(irep))) - mape = iand(mape,not(mapfb(irep))) -c -c Compare map with template. -c - do 4 it = 1 , nummask(ibmtyp) - masknow = mask(it,ibmtyp) - if (iand(masknow,mapm) .eq. masknow) then -c -c Find least significant bit in the mask to check start time -c - mtemp = masknow - maskm = masknow - do 5 is1 = 0 , 47 - if (iand(1,mtemp) .eq. 1) go to 6 - mtemp = ishft(mtemp,-1) -5 continue -6 continue - if (iand(ishft(1,is1),maps) .eq. 0) go to 4 -c -c is1 is the bit where the beam starts. Continue shifting to -c find most significant bit in the mask to check ending time -c - do 7 is2 = is1 , 47 - mtemp = ishft(mtemp,-1) - if (iand(1,not(mtemp)) .eq. 1) go to 8 -7 continue -8 continue -c -c is2 is now the bit on which the beam ends. -c - if (iand(ishft(1,is2),mape) .eq. 0) go to 4 -c -c Did we pick out a single note from the middle of a longer sequence? -c - if (nip1(is1) .eq. nip2(is2)) go to 4 -c -c We almost have a beam. Check equality of notes if needed. -c - if (eqonly(it,ibmtyp)) then - do 10 ip = nip1(is1) , nip2(is2) - if (nodur(ivx,ip) .ne. 8) then -c -c There is a non-1/8th note in this beam. Exit if not 2 quarters -c - if (is2-is1 .ne. 15) go to 4 -c -c Beam is 2 quarters long. Check if can split in half. -c - ithalf = 0 - do 20 iip = nip1(is1) , nip2(is2) - ithalf = ithalf+nodur(ivx,iip) - if (ithalf .gt. 16) go to 4 - if (ithalf .eq. 16) go to 21 -20 continue - print*,'Problem in findbeam, please call Dr. Don' - go to 4 -21 continue -c -c Otherwise, split in half by keeping only the first half. Other half will -c be picked up later, assuming masks are listed longest first. -c - is2 = is1+7 -c -c Reset maskm (since only used part of mask), used later to zero out -c bits that contain beams -c - maskm = 0 - do 15 is = is1 , is2 - maskm = ibset(maskm,is) -15 continue - go to 16 - end if -10 continue - end if -16 continue -c -c This is a beam. If last "effective" ends on odd 64th, add 1 more -c -c if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) -c * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then - if (abs(amod(to(ipl2(ivx,nip2(is2))) - * +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then - nip2(is2) = nip2(is2)+1 - end if - numbms(ivx) = numbms(ivx)+1 - numnew = numbms(ivx) - call logbeam(numnew,nip1(is1),nip2(is2)) -c -c Zero out the appropriate bits so these notes don't get used again -c - mapm = iand(mapm,not(maskm)) - if (mapm.eq.0) go to 13 - maps = iand(maps,not(maskm)) - mape = iand(mape,not(maskm)) - end if -4 continue -13 continue - return - end - subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0) - parameter (nkb=3999,maxblks=9600) -c -c Compute an exponent eonk for use in the "flattened" formula for elemskips -c vs time. We must solve the eqution f = 0. Initial quess is eonk0. -c -c logical gotclef - common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), - * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, -c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) - * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) - common /comtol/ tol - common /comeon/ eonk,ewmxk - eonk = eonk0 - niter = 0 -1 continue - ewmxk = f1eon(dtmax)**eonk - niter = niter+1 - esum = 0. - desum = 0. - do 2 iptr = nptr1 , nptr2 - targ = durb(iptr)/sqzb(iptr) - esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ) - detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ) - desum = desum+nnpd(iptr)*sqzb(iptr)*detarg -2 continue - f = wovera*feon(dtmin)-xelsk-esum - fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin) - * -desum - if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then - call printl( - * 'Error in findeonk. Please send source to Dr. Don') - eonk = 0. - ewmxk = 1. - return - end if - dsoln = -f/fp - if (abs(dsoln) .lt. .1*tol) return -c -c Not converged yet, try again -c - eonk = eonk+dsoln - go to 1 - end - function fnote(nodur,ivx,ip,nacc) -c -c This return the real duration of a note -c - parameter (nm=24) - integer*4 nodur(nm,200),nacc(nm,200) - logical btest - ipback = ip - if (nodur(ivx,ip) .gt. 0) then - if (ip .gt. 1) then -c -c Check if this is last note of xtup -c - if (nodur(ivx,ip-1).eq.0) then - ipback = ip-1 - go to 2 - end if - end if - fnote = nodur(ivx,ip) - return - end if -2 continue -c -c Count back to prior non zero note. Start at ip to avoid neg index if ip=1. -c Count how many doubled xtups notes there are from ip-1 to first note. -c - ndoub = 0 - do 1 ip1m1 = ipback , 1 , -1 - if (nodur(ivx,ip1m1) .gt. 0) go to 4 - if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1 -1 continue -4 continue -c -c count forward to next non-0 nodur. Start at ip in case last note of xtup. -c - do 3 iip = ip , 200 -c -c Count doubled xtup notes from ip to end. -c - if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1 - if (nodur(ivx,iip) .gt. 0) then -c fnote = nodur(ivx,iip)/float(iip-ip1m1) - fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub) - if (btest(nacc(ivx,ip),18)) then - fnote = 2*fnote - else if (btest(nacc(ivx,ip),27)) then - fnote = 1.5*fnote - else if (ip .gt. 1) then - if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote - end if - return - end if -3 continue - print*,' ' - call printl - * ('Probable misplaced barline or incorrect meter, stopping') - print*,'ivx,ip:',ivx,ip - call stop1() - end - subroutine g1etchar(lineq,iccount,charq) - parameter(nm=24) - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - logical lastchar,issegno,isheadr,isvolt,fbon - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - logical mrecord,mplay,endmac - character*1 charq - character*128 lineq,lnholdq -c -c Gets the next character out of lineq*128. If pointer iccount=128 on entry, -c then reads in a new line. Resets iccount. Ends program if no more input. -c - if (iccount .eq. 128) then - call read10(lineq,lastchar) - if (lastchar) return - if (.not.endmac) then - iccount = 0 - if (.not.mplay) nline = nline+1 - else - endmac = .false. - iccount = icchold - lineq = lnholdq - end if - if (mrecord) then - call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) - end if - end if - iccount = iccount+1 - charq = lineq(iccount:iccount) - return - end - subroutine g1etnote(loop,ifig,optimize,fulltrans) - parameter (nm=24,nkb=3999,mv=24576,maxblks=9600) - character*1 chax - logical twotrem - common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), - * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, - * nbars,itsofar(nm),nib(nm,15),nn(nm), - * rest(nm,200),lenbr0,lenbr1,firstline,newmeter - common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), - * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, -c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) - * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - common /compage/ widthpt,ptheight,hoffpt,voffpt, - * nsyst,nflb,ibarflb(0:40), - * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), - * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), - * nistaff(0:40) - common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) - common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1, - * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS - logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend, - * isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt, - * stickyS - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - common /commus/ musize,whead20 - logical mrecord,mplay,endmac,shifton,gotclef,optimize - character*128 lineq,lnholdq - character*1 charq,dotq,dumq,durq,charlq - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - logical novshrinktop,upslur,fontslur,ztrans, - * WrotePsslurDefaults,cstuplet - common /comnvst/ novshrinktop,cstuplet - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - character*51 literq(3),lyrerq(5) - common /comligfont/ isligfont - logical isligfont - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - logical fulltrans - common /comsize/ isize(nm) - common /commidisig/ midisig - common /comis4bignv/ is4bignv,AIset - logical is4bignv,AIset - common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, - * poefa - real*4 poefa(125) - logical nocodabn - data literq - * /'Literal TeX string cannot start with 4 backslashes!', - * 'TeX string must have <129 char, end with backslash!', - * 'Type 2 or 3 TeX string can only start in column 1!'/ - data lyrerq - * /'pmxlyr string must end with " followed by blank!', - * 'pmxlyr string cannot extend past position 120!', - * 'There must be "a" or "b" here!', - * 'There must be "+" or "-" here!', - * 'There must be an integer here!'/ - cdot = .false. - twotrem = .false. -1 call g1etchar(lineq,iccount,charq) - if (charq .ne. ' ') charlq = charq - if (lastchar) then - if (index('/%',charlq) .eq. 0) then - print* - print*,'WARNING:' - print*,'Last non-blank character is "',charlq,'", not "/,%"' - print*,'ASCII code:',ichar(charlq) - write(15,'(/a)')'Last non-blank character is "'//charlq// - * '", not "/,%"' - write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq) -c -c Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. -c - ilbuf = ilbuf-1 - lbuf(ilbuf) = lbuf(ilbuf)+2 - bufq = bufq(1:ipbuf)//' /' - write(15,*)'appending /' - print*,'appending /' - lineq = lineq(1:iccount)//' /' - lastchar = .false. - go to 1 - end if - return - end if - if (charq .eq. ' ') then - go to 1 - else if (charq.eq.'%' .and. iccount.eq.1) then - iccount = 128 - go to 1 -c -c Replacement 1/22/12 since gfortran 4.7 with -O was choking here! -c -c else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. - else if (index('abcdefg',charq).gt.0 .or. - * charq.eq.'r') then -c -c This is a note/rest. gotclef is only used for checking for clef before "/" -c - if (cdot) go to 28 -c if (gotclef) gotclef=.false. - idotform = 0 - numnum = 0 - plusmin = .false. -28 nnl(ivx) = nnl(ivx)+1 - if (nnl(ivx) .gt. 200) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '>200 notes in line of music. Use smaller blocks!') - call stop1() - end if - dotq = 'x' -c -c Check if this is 'r ' and previous note was full-bar-pause -c - fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' ' - * .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and. - * nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar -2 call g1etchar(lineq,iccount,durq) - ic = ichar(durq) - if (ic.le.57 .and. ic.ge.48) then -c -c Digit -c - if (numnum .eq. 0) then - nnodur = ic-48 - numnum = 1 - go to 2 - else if (numnum .eq. 1) then - if (charq .eq. 'r') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only one digit allowed after rest symbol "r"!') - call stop1() - end if - numnum = 2 - if (plusmin) then - print* - print*,'*********WARNING*********' - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Before version 1.2, +/- was ignored if octave was!') - print*, - * 'explicitly specified. May need to edit old editions' - end if - go to 2 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '>2 digits in note symbol!') - call stop1() - end if - else if (durq.eq.'d') then - dotq = durq - if (lineq(iccount+1:iccount+1) .eq. 'd') then - iddot = 1 - iccount = iccount+1 -c -c Since we flow out, double dots won't work with other dot options -c - end if - if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then -c -c move a dot, provided a number follows. -c - call g1etchar(lineq,iccount,durq) - call g1etchar(lineq,iccount,durq) - if (index('0123456789-.',durq) .eq. 0) then -c -c Backup, exit the loop normally -c - iccount = iccount-2 - go to 2 - end if - call readnum(lineq,iccount,dumq,fnum) - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift also -c - call g1etchar(lineq,iccount,durq) - if (index('0123456789-.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected number after 2nd +/- (shift dot)!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - end if - iccount = iccount-1 - end if - go to 2 - else if (index('<>',durq) .gt. 0) then -c -c Accidental shift -c -c if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then - if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, -c * 'Expected "f", "s", or "n" before "<" or ">"!') - * 'Expected "f", "s", "n" or "A" before "<" or ">"!') - call stop1() - end if - ipm = 1 - if (durq .eq. '<') ipm=-1 - call g1etchar(lineq,iccount,durq) - if (index('123456789.0',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected number after (accidental shift)!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - fnum = ipm*fnum - if (fnum.lt.-5.35 .or. fnum.gt.1.0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Horizontal accidental shift must be >-5.35 and <1.0!') - call stop1() - end if - iccount = iccount-1 - go to 2 - else if (index('+-',durq) .gt. 0) then - if (charq .ne. 'r') then - if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then - ipm = 1 - if (durq .eq. '-') ipm=-1 - if (index('0123456789',lineq(iccount+1:iccount+1)) - * .gt.0) then -c -c This may be start of accidental shift, but may be octave jump; then duration -c - icsav = iccount - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (index('+-',durq) .gt. 0) then -c -c This is an accid shift since there's a 2nd consecutive signed number. -c Check size of 1st number. -c - if (fnum .gt. 30.5) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Vertical accidental shift must be less than 31!') - call stop1() - end if - ipm = 1 - if (durq .eq. '-') ipm = -1 - call g1etchar(lineq,iccount,durq) - if (index('1234567890.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected 2nd number of accidental shift)!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - fnum = ipm*fnum - if (fnum.lt.-5.35 .or. fnum.gt.1.0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Horiz. accidental shift must be >-5.35 and <1.0!') - call stop1() - end if - iccount = iccount-1 - go to 2 - else -c -c Not accid shift, reset, then flow out -c - iccount = icsav - end if - end if - end if - plusmin = .true. - if (numnum .eq. 2) then - print* - print*,'*********WARNING*********' - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Before version 1.2, +/- was ignored if octave was!') - print*, - * 'explicitly specified. May need to edit old editions' - end if - go to 2 -c -c It's a rest containing +|- . Must refer to a vertical shift. Read past. -c - else - call g1etchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,dum) - if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1 - iccount = iccount-1 - go to 2 - end if -c else if (index('ulare',durq) .gt. 0) then - else if (index('ularec',durq) .gt. 0) then - go to 2 - else if (index('LS',durq) .gt. 0) then -c -c Stemlength change -c - call g1etchar(lineq,iccount,durq) - if (index('.0123456789:',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be a number or colon here!') - call stop1() - end if - if (durq .eq. ':') then - if (.not.stickyS) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Turned off sticky stemlegth changes without turning on!') - call stop1() - end if - stickyS = .false. - go to 2 - end if - call readnum(lineq,iccount,durq,dum) -c if (dum.lt..5 .or. dum.gt.4.) then - if ((durq.eq.'L'.and.dum.gt.20.).or. - * (durq.eq.'S'.and.dum.gt.4.)) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Stemlength change amount too big!') - call stop1() - end if - if (durq .ne. ':') then - iccount = iccount-1 - else - if (stickyS) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Turned on sticky stemshrinks when already on!') - call stop1() - end if - stickyS = .true. - end if - go to 2 - else if (index('fsn',durq) .gt. 0) then -c -c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so -c MUST come right after "f,s,n" -c - if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 - go to 2 - else if (durq .eq. 'p') then - fulbrp = charq.eq.'r' - if (.not. fulbrp) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'The option "p" only works with "r" (rest)!') - call stop1() - end if - go to 2 - else if (durq .eq. 'b') then - if (charq .ne. 'r') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'You entered "b"; I expected "rb"!') - call stop1() - else if (numnum .eq. 2) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'You entered "r" & "b" with two numbers!') - end if - go to 2 - else if (durq .eq. 'x') then -c -c Xtuplet. Count number of doubled notes (for unequal xtups) -c - if (btest(nacc(ivx,nnl(ivx)),18)) then - ndoub = 1 - else - ndoub = 0 - end if -c -c Will set all durations to 0 except last one. -c - call g1etchar(lineq,iccount,durq) - if (index('123456789T',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'First char after "x" in xtuplet must be "1"-"9" or "T"!') - call stop1() - end if - if (durq .eq. 'T') then -c -c Set a flag for checking 2nd note inputs if dot is moved -c - twotrem = .true. -c -c Check all x-tremolo inputs here; set fnum=2 -c - fnum = 2 - call getchar(lineq,iccount,durq) - if (index('0123 ',durq).eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'First char after "T" in xtuplet must be "0"-"3" or blank!') - call stop1() - else if (durq .ne. ' ') then - call getchar(lineq,iccount,durq) - if (index('0123 ',durq).eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This char must be "0"-"3" or blank!') - call stop1() - else if (durq .ne. ' ') then - call getchar(lineq,iccount,durq) -c -c Probably blank unles other options entered -c - end if - end if - else -c -c durq is digit, normal xtup -c - call readnum(lineq,iccount,durq,fnum) -c -c Leaves durq at next char after number -c - if (fnum .gt. 99) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Xtuplet cannot have more than 99 notes!') - call stop1() - else if (index(' DFnd',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only legal characters here are " ","D","F","n"!') - call stop1() - end if - end if -c -c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. -c - if (index('DF',durq) .gt. 0) then -c -c Double xtup note to make an un= xtup. Here, number already set, but may also -c have used this before number was set. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - ndoub = 1 - call g1etchar(lineq,iccount,durq) - else if (durq .eq. 'd') then - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) - call g1etchar(lineq,iccount,durq) - end if - if (durq .eq. 'n') then -c -c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. -c - numshft = 0 -30 call g1etchar(lineq,iccount,durq) - if (durq .eq. 'f') then - go to 30 - else if (index('+-',durq) .gt. 0) then - numshft = numshft+1 - if (numshft .eq. 3) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only 2 shifts are allowed after "n" in xtup!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This character should be a digit or "."!') - call stop1() - end if - call readnum(lineq,iccount,durq,snum) - iccount = iccount-1 -c if ((numshft.eq.1 .and. snum.gt.15.1) .or. - if ((numshft.eq.1 .and. snum.gt.64.) .or. - * (numshft.eq.2 .and. snum.gt.1.51)) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Shift number after "n" in xtup is out of range!') - call stop1() - end if - go to 30 - else if (durq .eq. 's') then -c -c Slope alteration for bracket -c - call getchar(lineq,iccount,durq) - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'For slope adjustment, this character must be "+" or "-"!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This character should be a digit!') - call stop1() - end if - call readnum(lineq,iccount,durq,snum) - iccount = iccount-1 - if (nint(snum) .gt. 15) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slope adjustment cannot exceed 15!') - call stop1() - end if - go to 30 - else if (index('123456789',durq) .gt. 0) then -c -c Unsigned integer => alternate printed number -c - call readnum(lineq,iccount,durq,snum) - if (snum .gt. 15.1) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Alternate xtup number after "n" must be <16!') - call stop1() - end if - iccount = iccount-1 - go to 30 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "n" in xtup!') - call stop1() - end if - end if - ntup = nint(fnum) - do 6 itup = 2 , ntup - nodur(ivx,nnl(ivx)) = 0 - nnl(ivx) = nnl(ivx)+1 -110 call g1etchar(lineq,iccount,durq) - if (durq.eq.' ') then - go to 110 - else if (durq .eq. 'o') then -c -c Ornament in xtup. "o" symbol must come AFTER the affected note -c - call g1etchar(lineq,iccount,dumq) - if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then - if (index('fg',dumq) .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Fermata or segno not allowed in xtuplet!') - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal ornament!') - end if - call stop1() - end if - if (dumq .eq. 'T') then -c -c Trill. may be followed by 't' and/or number. read 'til blank -c -29 call g1etchar(lineq,iccount,dumq) - if (dumq .ne. ' ') go to 29 - else if (dumq .eq. 'e') then - call g1etchar(lineq,iccount,dumq) - if (index('sfn?',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "e" in edit. accid. symbol!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq) - else if (dumq .eq. ':') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '":" must be followed by blank in "o: "!') - call stop1() - else if (.not.ornrpt) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Turned off repeated ornaments before they were on!') - call stop1() - end if - ornrpt = .false. - else - call g1etchar(lineq,iccount,dumq) - end if - if (index('+- :',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in ornament symbol!') - call stop1() - end if - if (dumq .eq. ':') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '":" must be followed by blank in "o: "!') - call stop1() - else if (ornrpt) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Turned on repeated ornaments but already on!') - call stop1() - end if - ornrpt = .true. - end if - if (index('+-',dumq) .gt. 0) then - if (index('0123456789',lineq(iccount+1:iccount+1)) - * .eq. 0) then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'There should be an integer here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (durq .eq. ':') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot shift AND repeat an ornament!') - call stop1() - end if -c -c 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. -c - if (index('+-',durq) .gt. 0) then - if (index('.0123456789',lineq(iccount+1:iccount+1)) - * .eq. 0) then - call errmsg(lineq,iccount+1, - * ibarcnt-ibaroff+nbars+1, - * 'There should be a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - end if - end if - go to 110 - else if (index('st(){}',durq) .gt. 0) then -c -c Slur in xtup -c - iposn = 0 - numint = 0 -15 call g1etchar(lineq,iccount,dumq) - iposn = iposn+1 - if (index('udlbfnhtv',dumq) .gt. 0) then - if (dumq.eq.'t' .and. durq.eq.'t') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot use "t" as an option on a tie!') - call stop1() - end if - go to 15 - else if (index('+-',dumq) .gt. 0) then - numint = numint+1 - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (numint .eq. 1) then - if (nint(fnum) .gt. 30) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Magnitude of slur height adjustment cannot exceed 30!') - call stop1() - end if - else if (numint .eq. 2) then - if (abs(fnum).gt.6.3) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur horiz shift must be in the range (-6.3,6.3)!') - call stop1() - end if - else -c -c Third signed integer, must be a midslur or curve spec. -c - if (abs(fnum).gt.31) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur midheight must be in the range (-31,31)!') - call stop1() - end if - if (durq .eq. ':') then -c -c Expecting curve parameters. Get two numbers -c - do 40 i = 1 , 2 - iccount = iccount+1 - fnum = ichar(lineq(iccount:iccount))-48 - if (abs(fnum-3.5) .gt. 3.6) then - call errmsg(lineq,iccount, - * ibarcnt-ibaroff+nbars+1, - * 'Slur curve parameter must be in range (0,7)!') - call stop1() - end if -40 continue - iccount = iccount+1 - end if - end if - iccount = iccount-1 - go to 15 - - else if (dumq .eq. 's') then -c -c What follows should be one or two signed numbers for adjustment of line break -c slur, end of 1st segment or start of second. -c - if (fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'May not use linebreak slur options with font-based slurs!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('+-',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This character must be "+" or "-"!') - call stop1() - end if - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (nint(fnum) .gt. 30) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Magnitude of slur height adjustment cannot exceed 30!') - call stop1() - end if - if (index('+-',dumq) .gt. 0) then - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (abs(fnum) .gt. 6.3) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur horiz shift must be in range (-6.3,6.3)!') - call stop1() - end if - end if - iccount = iccount-1 - go to 15 - else if (dumq .eq. 'H' .and. iposn.gt.1) then - if (lineq(iccount+1:iccount+1) .eq. 'H') - * iccount=iccount+1 - go to 15 - else if (dumq .eq. 'p') then -c -c local change in postscript slur/tie adjustment default -c - if (fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must use postscript slurs ("Ap") to use this option!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('+-',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected "+" or "-" here!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('st',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected "s" or "t" here!') - call stop1() - end if - go to 15 - else if (dumq .ne. ' ') then - ic = ichar(dumq) - if ((ic.ge.48.and.ic.le.57) .or. - * (ic.ge.65.and.ic.le.90)) then - if (iposn .eq. 1) then - if (durq.eq.'t' .and. fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slur ID not allowed on non-postscript tie!') - call stop1() - end if - if (lineq(iccount+1:iccount+1).eq.'x') - * iccount = iccount+1 - go to 15 - end if - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slur ID must be 2nd character in slur symbol!') - call stop1() - end if - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in slur symbol!') - call stop1() - end if - go to 110 - else if (index('0123456789#-nx_',durq) .gt. 0) then -c -c We have a figure. Only allow on 1st note of xtup -c - if (itup .ne. 2) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Figure in xtup only allowed on 1st note!') - call stop1() - else if (durq.eq.'x') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'No floating figures in xtuplets!') - call stop1() - end if - if (usefig .and. ivx.eq.1) ifig = 1 -26 call g1etchar(lineq,iccount,durq) -c if (index('0123456789#-n_.:',durq) .gt. 0) then - if (index('0123456789#-n_.:v',durq) .gt. 0) then - go to 26 - else if (durq .eq. 's') then - isligfont = .true. - go to 26 - else if (durq .eq. '+') then -c -c vertical offset, must be integer then blank -c - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .ne. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Integer for vertical offset expected here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Vertical offset must terminate figure!') - call stop1() - end if - iccount = iccount-1 - go to 26 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in figure in xtuplet!') - call stop1() - end if - go to 110 - else if (durq .eq. 'G') then - ngr = 1 -79 call g1etchar(lineq,iccount,charq) - if (index('123456789',charq) .gt. 0) then - call readnum(lineq,iccount,durq,fnum) - ngr = nint(fnum) - iccount = iccount-1 - go to 79 - else if (index('AWulxs',charq) .gt. 0) then - go to 79 - else if (charq .eq. 'm') then - call g1etchar(lineq,iccount,charq) - if (index('01234',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A digit less than 5 must follow "m" in a grace note!') - call stop1() - end if - go to 79 - else if (charq .eq. 'X') then -c -c Space before main note -c - call g1etchar(lineq,iccount,charq) - if (index('0123456789.',charq) .gt. 0) then - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 79 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A number must follow "X" in a grace note!') - call stop1() - end if - end if -c -c At this point, charq is first note name in rest (grace?) -c - do 71 igr = 1 , ngr - numnum = 0 - if (igr .gt. 1) then -75 call g1etchar(lineq,iccount,charq) - if (charq .eq. ' ') go to 75 - end if - if (index('abcdefg',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'In grace, expected "a"-"g"!') - call stop1() - end if -78 call g1etchar(lineq,iccount,charq) - if (charq .ne. ' ') then - if (index('1234567',charq) .gt. 0) then - if (numnum .eq. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only one of "+-1234567" allowed here in grace!') - call stop1() - end if - numnum = 1 - go to 78 - else if (index('+-nfs',charq) .gt. 0) then - go to 78 - end if -c -c Digits are possible octave numbers -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after note name in grace!') - call stop1() - end if -71 continue - go to 110 - else if (durq .eq. chax(92)) then - call chklit(lineq,iccount,literr) - if (literr .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * literq(literr)) - call stop1() - end if - go to 110 - else if (durq .eq. '"') then -c -c pmx lyric -c - call chkpmxlyr(lineq,iccount,lyrerr) - if (lyrerr .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * lyrerq(lyrerr)) - call stop1() - end if - go to 110 - else if (durq .eq. 'M') then -c -c Temporary trap until I get around putting this in pmxb -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Macros not yet allowed in xtuplets!') - call stop1() - else if (durq .eq. 'X') then - call g1etx(lineq,iccount,shifton, - * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt) - go to 110 - else if (durq .eq. 'z') then -c -c Chord note in xtup. Read past for now. -c -33 call g1etchar(lineq,iccount,durq) - if (durq .ne. ' ') go to 33 - go to 110 - else if (durq .eq. 'D') then -c -c Dynamic mark -c - call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1) - go to 110 - else if (durq .eq. '%') then - if (iccount .ne. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Comment must have "%" in column 1!') - call stop1() - end if - iccount = 128 - go to 110 - else if (durq .eq. '?') then - call getchar(lineq,iccount,durq) - if (durq .eq. ' ') then - iccount = iccount-1 - go to 110 - end if - if (durq .ne. '-') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expecting "-"') - call stop1() - end if - call getchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expecting number') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 110 -c -c 140215 Allow clef change inside xtup -c - else if (durq .eq. 'C') then - call g1etchar(lineq,iccount,durq) - if (.not.(index('tsmanrbf',durq).gt.0 .or. -c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then - * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') - call stop1() - end if -c gotclef = .true. - go to 110 -c+++ - else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'[' - * .and. lineq(iccount+2:iccount+2).eq.' ') then - iccount = iccount+2 - go to 110 -c+++ -c -c Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo -c - end if -c -c End of xtup options. At this point symbol can only be note or rest -c - if (index('abcdefgr',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'In xtup, this character is not allowed!') - call stop1() - end if -7 call g1etchar(lineq,iccount,durq) - if (index('12345678ulcb',durq) .gt. 0) then - go to 7 - else if (index('sfn',durq) .gt. 0) then -c -c Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. -c - if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 - go to 7 - else if (index('+-<>',durq) .gt. 0) then -c -c May have either octave jump or shifted accid. on main xtup note -c - if (index('+-',durq).gt.0 .and. - * index('01234567890',lineq(iccount+1:iccount+1)).eq.0) - * go to 7 - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 7 - else if (index('DF',durq) .gt. 0) then -c -c Double an xtup note to make an unequal xtup -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - ndoub = ndoub+1 - go to 7 - else if (durq .eq. 'd') then - if (twotrem) then -c -c 2-note trem, get shift -c - call g1etchar(lineq,iccount,durq) - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected +/- for shifted dot on end of 2-note trem!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected number here!') - call stop1() - end if - call readnum(lineq,iccount,dumq,fnum) - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift also -c - call g1etchar(lineq,iccount,durq) - if (index('0123456789-.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected number after 2nd +/- (shift dot)!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - end if - iccount = iccount-1 - go to 7 - else - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) - end if - go to 7 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal option on xtuplet note!') - call stop1() - end if - if (itup .eq. ntup-ndoub) go to 3 -6 continue -3 continue -c -c 6==End of loop for xtuplet input -c - else if (durq .eq. 'm') then -c -c Multi-bar rest: next 1 or two digits are # of bars. -c - if (mod(itsofar(iv),lenbar) .ne. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Multibar rest must start at beginning of bar!') - call stop1() - else if (iv.eq.1.and.ibarmbr.gt.0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Multibar rest only OK at one time per block!') - call stop1() - end if -c -c For some purposes, pretend its one bar only -c - nodur(iv,nnl(iv)) = lenbar - ibarmbr = nbars+1 - mbrest = 0 -c20 call g1etchar(lineq,iccount,durq) - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected an integer after "rm"!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - mbrest = nint(fnum) -c iccount = iccount-1 - if (nv .gt. 1) then - if (iv .eq. 1) then - mbrestsav = mbrest - else - if (mbrest .ne. mbrestsav) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must enter same multi-bar rest in every voice!') - call stop1() - end if - end if -c -c Zero out mbrestsav so can check at end of input block whether -c all voices have one -c - if (iv .eq. nv) mbrestsav=0 - end if - if (durq .eq. 'n') then -c -c Get new height -c - call g1etchar(lineq,iccount,durq) - if (index('+-123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected an integer after "rm[x]n"!') - call stop1() - end if - if (index('+-',durq).ne.0) iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - end if - if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "rm"!') - call stop1() - end if - else if (durq .eq. '.') then -c -c Dotted pattern. Close out note. Mult time by 3/4. -c Set time for next note to 1/4. Start the note. -c - idotform = 1 - else if (durq .eq. ',') then - idotform = 3 -c -c Now flow to duration setting, as if durq=' ' -c - else if (index('oL',durq) .gt. 0) then -c -c Suppress full bar rest, or look left for height -c - if (charq .ne. 'r') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"o","L" options only legal for rest, not note!') - call stop1() - end if - go to 2 - else if (index('DF',durq) .gt. 0) then -c -c Double note for xtup. Must check here in case "D" or "F" came before "x" or on -c last note of xtup. Need to flag it in pmxa since affects horiz. spacing. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - go to 2 - else if (durq .eq. 'A') then -c -c Main note accidental option -c - call getchar(lineq,iccount,durq) - if (index('o+-<>',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"o",+","-","<",">" are the only legal options here!') - call stop1() - end if -c -c Need more stuff here -c - if (durq .ne. "o") then -c -c Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will -c proceed to number input checking -c - iccount = iccount-1 - end if - go to 2 - else if (durq .eq. 'T') then -c -c Single stem tremolo. Only option (optional) is 1,2,3, or 4. -c - call getchar(lineq,iccount,durq) - if (index('1234',durq) .eq. 0) iccount = iccount-1 - go to 2 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character!') - print*,'ASCII code:',ichar(durq) - call stop1() - end if -c -c End of block for note options. -c -c Set the duration -c - if (idotform .gt. 0) then - if (idotform .eq. 1) then - nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2 - else if (idotform .eq. 2) then - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3 - else if (idotform .eq. 3) then - nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq) - else if (idotform .eq. 4) then - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2 - end if - else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then - nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq) -c -c Check for double dot -c - if (iddot .eq. 1) then - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6 - iddot = 0 - end if - else if (fulbrp) then - nodur(ivx,nnl(ivx)) = lenbar -c -c Use a one-line function to set nnodur. It gives inverse of ifnodur. -c - nnodur = index('62514x0x37', - * chax(48+int(log(.1+lenbar)/.69315)))-1 - fulbrp = .false. - end if - rest(ivx,nnl(ivx)) = charq.eq.'r' -c -c If inside forced beam, check if note is beamable -c - if (fbon) then - if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120 - if (nnl(ivx) .gt. 1) then - if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120 - end if - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Unbeamable thing in forced beam!') - call stop1() - end if -120 continue -c -c Get number of prior bars for later check on whether note spans bar line -c - nbb4 = itsofar(ivx)/lenbar - itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) - if (mod(itsofar(ivx),lenbar) .eq. 0) then - nbars = nbars+1 - if (shifton) barend = .true. -c -c Will check barend when 1st note of next bar is entered. -c - if (nbars .gt. 15) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot have more than 15 bars in an input block!') - call stop1() - end if - nib(ivx,nbars) = nnl(ivx) - if (firstline .and. lenbar.ne.lenbr1) then -c -c Just finished the pickup bar for this voice. -c - if (itsofar(ivx) .ne. lenbr0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Pickup bar length disagrees with mtrnum0!') - call stop1() - end if - lenbar = lenbr1 - itsofar(ivx) = 0 - end if - else if (barend) then - if (shifton) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Bar ended with user-defined shift still on!') - call stop1() - end if - barend = .false. - else if (itsofar(ivx)/lenbar .gt. nbb4) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'This note spans a bar line!') - call stop1() - end if - if (idotform.eq.1 .or. idotform.eq.3) then - call g1etchar(lineq,iccount,charq) - if (index('abcedfgr',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected note name or "r" here!') - call stop1() - end if - idotform = idotform+1 - numnum = 1 - go to 28 - end if -c -c End of sub block for note-rest -c - else if (charq .eq. 'z') then - call g1etchar(lineq,iccount,charq) - if (index('abcdefg',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected chord note name here!') - call stop1() - end if -25 call g1etchar(lineq,iccount,durq) -c if (index('dre12345678',durq) .gt. 0) then - if (index('dre12345678c',durq) .gt. 0) then - go to 25 - else if (index('fsn',durq) .gt. 0) then -c -c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so -c MUST come right after "f,s,n" -c - if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 - go to 25 - else if (durq .eq. 'A') then - if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Must have "f,s,n" before "A" in chord note!') - call stop1() - end if - go to 25 - else if (index('<>',durq) .gt. 0) then - if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then -c if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Must have "f,s,n,A" before "<" or ">"!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('1234567890.',durq) .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Expected a number to start here for accidental shift!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 25 - else if (index('+-',durq) .gt. 0) then - if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0) - * go to 25 -c -c Number or '.' (durq) follows +/- . Get it. -c - call g1etchar(lineq,iccount,durq) - if (durq .eq. '.' .and. index('1234567890', - * lineq(iccount+1:iccount+1)) .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * '"." here must be followed by a digit!') - call stop1() - else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Number after +/- must follow "d,s,f,n,A"!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (index('+-',durq) .eq. 0) then - iccount = iccount-1 - go to 25 - end if -c -c 2nd +/- -c - call g1etchar(lineq,iccount,durq) - if (durq .eq. '.') call g1etchar(lineq,iccount,durq) - if (index('1234567890',durq) .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Expected a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 25 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in chord note!') - call stop1() - end if - else if (charq .eq. 'G') then - ngr = 1 -9 call g1etchar(lineq,iccount,charq) - if (index('123456789',charq) .gt. 0) then - call readnum(lineq,iccount,durq,fnum) - ngr = nint(fnum) - iccount = iccount-1 - go to 9 - else if (index('AWulxs',charq) .gt. 0) then - go to 9 - else if (charq .eq. 'm') then - call g1etchar(lineq,iccount,charq) - if (index('01234',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A digit less than 5 must follow "m" in a grace note!') - call stop1() - end if - go to 9 - else if (charq .eq. 'X') then -c -c Space before main note -c - call g1etchar(lineq,iccount,charq) - if (index('0123456789.',charq) .gt. 0) then - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 9 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A number must follow "X" in a grace note!') - call stop1() - end if - end if -c -c At this point, charq is first note name in rest (grace?) -c - do 19 igr = 1 , ngr - numnum = 0 - if (igr .gt. 1) then -55 call g1etchar(lineq,iccount,charq) - if (charq .eq. ' ') go to 55 - end if - if (index('abcdefg',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'In grace, expected "a"-"g"!') - call stop1() - end if -18 call g1etchar(lineq,iccount,charq) - if (charq .ne. ' ') then - if (index('1234567',charq) .gt. 0) then - if (numnum .eq. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only one of "+-1234567" allowed here in grace!') - call stop1() - end if - numnum = 1 - go to 18 -c else if (index('nfs',charq) .gt. 0) then - else if (index('+-nfs',charq) .gt. 0) then - go to 18 - end if -c -c Digits are possible octave numbers -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after note name in grace!') - call stop1() - end if -19 continue - else if (charq .eq. chax(92)) then - call chklit(lineq,iccount,literr) - if (literr .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * literq(literr)) - call stop1() - end if - else if (charq .eq. '"') then -c -c pmx lyric -c - call chkpmxlyr(lineq,iccount,lyrerr) - if (lyrerr .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * lyrerq(lyrerr)) - call stop1() - end if - else if (charq .eq. 'o') then -c -c Ornament on non-xtup note. "o" symbol must come AFTER the affected note -c - if (nnl(ivx) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"o" must be in same input block, after affected note!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) -c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then - if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal ornament!') - call stop1() - end if - if (dumq .eq. ':') then - call g1etchar(lineq,iccount,dumq) - if (dumq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected blank after "o:"!') - call stop1() - else if (.not.ornrpt) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Turned off repeated ornaments before they were on!') - call stop1() - end if - ornrpt = .false. - else if (dumq .eq. 'g') then - if (issegno) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Sorry, only one "segno" per input block!') - call stop1() - else if (ivx .ne. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'segno can only be in voice 1!') - call stop1() - end if - issegno = .true. -12 call g1etchar(lineq,iccount,dumq) - if (dumq.eq.'-' .or. - * (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12 - if (dumq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in segno ornament symbol!') - call stop1() - end if - else if (dumq .eq. 'T') then -c -c Trill. may be followed by 't' and/or number. read 'til blank -c -22 call g1etchar(lineq,iccount,dumq) - if (dumq .eq. ':') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected blank after ":"!') - call stop1() - end if - go to 32 - else if (dumq .ne. ' ') then - go to 22 - end if - else if (dumq .eq. 'f') then - call g1etchar(lineq,iccount,dumq) - if (index(' d+-:',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "f" in fermata ornament symbol!') - call stop1() - end if - if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq) - if (dumq .eq. ':') go to 32 - else if (dumq .eq. 'e') then - call g1etchar(lineq,iccount,dumq) - if (index('sfn?',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "e" in edit. accid. symbol!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq) - else - call g1etchar(lineq,iccount,dumq) - end if - if (index('+- :',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in ornament symbol!') - call stop1() - end if - if (index('+-',dumq) .gt. 0) then - if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'There should be an integer here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (durq .eq. ':') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot shift AND repeat an ornament!') - call stop1() - end if -c -c 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. -c - if (index('+-',durq) .gt. 0) then - if (index('.0123456789',lineq(iccount+1:iccount+1)) - * .eq. 0) then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'There should be a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - end if - end if -32 continue - if (dumq .eq. ':') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '":" must be followed by blank in "o: "!') - call stop1() - else if (ornrpt) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Turned on repeated ornaments but already on!') - call stop1() - end if - ornrpt = .true. - end if - else if (index('st(){}',charq) .gt. 0) then - numint = 0 - iposn = 0 -8 call g1etchar(lineq,iccount,dumq) - iposn = iposn+1 - if (charq.eq.'t' .and. dumq.eq.'t') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot use "t" as an option on a tie!') - call stop1() - end if - if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then -c -c Check for explicit ID code. -c - ic = ichar(dumq) - if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or. - * ic.gt.90) then -c -c Not 0-9 or A-Z, so exit -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in slur symbol!') - call stop1() - else -c -c It is a possible ID code. Right place? -c - if (iposn .ne. 1) then -c -c Slur ID is not 2nd! -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slur ID must be second character in slur symbol!') - call stop1() - else if (charq.eq.'t' .and. fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slur ID not allowed on non-postscript tie!') - call stop1() - else if (lineq(iccount+1:iccount+1).eq.'x') then - iccount = iccount+1 - end if - end if -c -c Slur ID is OK. Note it cannot be "H" at this point.. -c - go to 8 - else if (dumq .eq. 'H') then - if (iposn .eq. 1) go to 8 -c -c "H" is NOT an ID code. -c - if (.not.fontslur .and. charq.eq.'t') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot reshape postscript ties this way!') - call stop1() - end if - if (lineq(iccount+1:iccount+1) .eq. 'H') then - iccount=iccount+1 - iposn = iposn+1 - end if - go to 8 - else if (index('fh',dumq).gt.0 .and. .not.fontslur - * .and. charq.eq.'t') then -c -c 3/9/03 Can't reshape postscript tie. -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot reshape postscript ties this way!') - call stop1() - else if (dumq .eq. 'p') then -c -c local change in postscript slur/tie adjustment default -c - if (fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must use postscript slurs ("Ap") to use this option!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('+-',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected "+" or "-" here!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('st',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected "s" or "t" here!') - call stop1() - end if - iposn = iposn+2 - go to 8 - end if - if (index('udltbfnh',dumq) .gt. 0) then - go to 8 - else if (index('+-',dumq) .gt. 0) then - numint = numint+1 - if (fontslur .and. charq.eq.'t') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"+|-" for slur height only allowed in "s"-slurs!') - call stop1() - end if - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (numint .eq. 1) then - if (nint(fnum) .gt. 30) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Magnitude of slur height adjustment cannot exceed 30!') - call stop1() - end if - else if (numint .eq. 2) then - if (abs(fnum) .gt. 6.3) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur horiz shift must be in range (-6.3,6.3)!') - call stop1() - end if - else -c -c Third signed integer, must be a midslur or curve spec. -c - if (abs(fnum).gt.31) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur midheight must be in the range (-31,31)!') - call stop1() - end if - if (durq .eq. ':') then -c -c Expecting curve parameters. Get two numbers -c - do 41 i = 1 , 2 - iccount = iccount+1 - fnum = ichar(lineq(iccount:iccount))-48 - if (abs(fnum-3.5) .gt. 3.6) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Slur curve parameter must be in range (0,7)!') - call stop1() - end if -41 continue - iccount = iccount+1 - end if - end if - iccount = iccount-1 - go to 8 - else if (dumq .eq. 's') then -c -c What follows should be one or two signed numbers for adjustment of line break -c slur, end of 1st segment or start of second. -c - if (fontslur) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'May not use linebreak slur options with font-based slurs!') - call stop1() - end if - call g1etchar(lineq,iccount,dumq) - if (index('+-',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This character must be "+" or "-"!') - call stop1() - end if - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (nint(fnum) .gt. 30) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Magnitude of slur height adjustment cannot exceed 30!') - call stop1() - end if - if (index('+-',dumq) .gt. 0) then - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (abs(fnum) .gt. 6.3) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Slur horiz shift must be in range (-6.3,6.3)!') - call stop1() - end if - end if - iccount = iccount-1 - go to 8 - else if (dumq .eq. 'H' .and. iposn.gt.1) then - if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1 - go to 8 - end if - else if (charq .eq. '?') then - call getchar(lineq,iccount,durq) - if (durq .eq. ' ') then - iccount = iccount-1 - else - if (durq .ne. '-') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expecting "-"!') - call stop1() - end if - call getchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expecting number!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - end if - else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or. - * index('#-nx_',charq) .gt. 0) then -c -c We have a figure. Must come AFTER the note it goes under -c - if (itsofar(ivx).eq.0 .and. - * (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then -c -c Figure before first note in block -c - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot put figure before first note in block!') - call stop1() - end if - if (charq.eq.'x') then - indxb = index(lineq(iccount:128),' ') - if (indxb .lt. 5) then - call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1, - * 'Cannot have a blank here in floating figure!') - call stop1() - end if - end if - if (usefig) ifig = 1 -5 call g1etchar(lineq,iccount,charq) - if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in figure!') - call stop1() - else if (charq .eq. '+') then -c -c vertical offset, must be integer, then blank -c - call g1etchar(lineq,iccount,charq) - if (index('123456789',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Integer for vertical offset expected here!') - call stop1() - end if - call readnum(lineq,iccount,charq,fnum) - if (charq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Vertical offset must terminate figure!') - call stop1() - end if - iccount = iccount-1 - go to 5 - else if (charq .eq. 's') then - isligfont = .true. - end if - if (charq .ne. ' ') go to 5 - else if (charq .eq. '[') then - if (fbon) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Started forced beam while another was open!') - call stop1() - end if - fbon = .true. -17 call g1etchar(lineq,iccount,charq) - if (index('uljhf:',charq) .gt. 0) then - go to 17 - else if (index('+-',charq) .gt. 0) then - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 17 - else if (charq .eq. 'm') then -c -c Forced multiplicity, next char should be 1-4 -c - call g1etchar(lineq,iccount,charq) - if (index('1234',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Forced multiplicity for a beam must be 1, 2, 3, or 4!') - call stop1() - end if - go to 17 - else if (charq .ne. ' ') then - if (index('0123456789',charq) .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'After "[", digits must now be preceeded by "+" or "-"!') - print*,'You will have to edit older sources to meet this rqmt,' - print*,'but it was needed to allow 2-digit height adjustments.' - print*,'Sorry for the inconvenience. --The Management' - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after [!') - end if - call stop1() - end if - else if (charq .eq. ']') then - if (.not.fbon) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Forced beam stop with no corresponding start!') - call stop1() - end if - call g1etchar(lineq,iccount,charq) - if (charq .eq. '-') then - if (lineq(iccount+1:iccount+2) .ne. '[ ') then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'Only sequence allowed here is "[ "!') - call stop1() - else - iccount = iccount+2 - end if - else if (charq .eq. '[') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'This character must be a blank!') - call stop1() - end if - else -c -c Forced beam is really ending -c - fbon = .false. - if (charq .eq. 'j') then - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'This character must be a blank!') - call stop1() - end if - else if (charq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"]" must be followed by blank, "j", "-", or "["!') - call stop1() - end if - end if - else if (charq .eq. 'D') then -c -c Dynamic mark -c - if (nnl(ivx) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"D" must not come before any notes have been entered!') - call stop1() - end if - call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1) - else if (index('lhw',charq) .gt. 0) then -c -c Save position for later check -c - icclhw = iccount - call g1etchar(lineq,iccount,durq) - if (index('0123456789.+- ',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "l", "w", or "h"!') - call stop1() - end if - isheadr = isheadr .or. charq .eq. 'h' - if (index(' +-',durq) .gt. 0) then -c -c There is a header (or lower string?) -c - if (index('+-',durq) .gt. 0) then -c -c User-defined vert offset (\internote). -c - if (charq .ne. 'h') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"+" or "-" not permitted here!') - call stop1() - end if -c -c Have "h" followed by +/- . Check for digit. -c Can blow durq since not using fnum for now, but... -c - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be a digit here!') - call stop1() - end if -c -c Have "h" followed by +/- followed by a digit. No need to get the number. -c -c call readnum(lineq,iccount,durq,fnum) - end if - if (charq .ne. 'w') then -c -c Header or lower string. -c - if (icclhw .ne. 1) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * '"h" or "l" must be first character in line!') - call stop1() - end if -c -c Read past the next line, which has the string. -c - call read10(charq,lastchar) - nline = nline+1 - iccount = 128 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Symbol "w" (width) must be followed by a digit!') - call stop1() - end if - else -c -c Height or width change spec. Check if at start of piece. -c - if (ibarcnt .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Symbol must go at top of first input block!') - call stop1() - end if - call readnum(lineq,iccount,durq,dimen) -c -c Check units. Convert to points -c - if (durq .eq. ' ' .or. durq .eq. 'p') then - dimen = dimen+.5 - else if (durq .eq. 'i') then - dimen = dimen*72+.5 - else if (durq .eq. 'm') then - dimen = dimen/25.4*72+.5 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal unit; must be "p","i",or"m"!') - call stop1() - end if -c -c 151211 fix. May have extra character. -c - if (index('pim',durq) .gt. 0) then -c -c Get another character, see if it's blank -c - if (lineq(iccount+1:iccount+1) .ne. ' ') then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'This character should be a blank!') - call stop1() - end if - end if - if (charq .eq. 'h') then - ptheight = int(dimen) - else - widthpt = int(dimen) - end if - end if - else if (charq .eq. 'm') then -c -c Time signature change. Only allow at beginning of block. -c mtrnuml, mtrdenl (logical) and p (printable) will be input. -c mtrnuml=0 initially. (In common) -c -c Check whether at beginning of a block -c - if (ivx.ne.1 .or. nnl(1).ne.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Meter change only OK in voice 1, at start of block!') - print*,'voice number is',ivx - call stop1() - end if - newmeter = .true. - if (index('o0123456789',lineq(iccount+1:iccount+1)).eq.0) then - call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in "m" command for meter change!') - call stop1() - end if - call readmeter(lineq,iccount,mtrnuml,mtrdenl) - if (mtrnuml .eq. 0) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Digit 0 not allowed here!') - call stop1() - end if - call readmeter(lineq,iccount,mtrnmp,mtrdnp) -c -c Read past printed time signature; not used in pmxa. -c - lenbeat = i1fnodur(mtrdenl,'x') - lenmult = 1 - if (mtrdenl .eq. 2) then - lenbeat = 16 - lenmult = 2 - end if - lenbar = lenmult*mtrnuml*lenbeat - mtrnuml = 0 - else if (charq .eq. 'C') then - call g1etchar(lineq,iccount,durq) - if (.not.(index('tsmanrbf',durq).gt.0 .or. - * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') - call stop1() - end if - else if (charq .eq. 'R') then - if (ivx .ne. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Repeats can only go in voice 1!') - call stop1() - end if -c10 call g1etchar(lineq,iccount,durq) -c if (index('lrdDbz',durq) .gt. 0) go to 10 -c if (durq .ne. ' ') then -c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'Illegal character after "R" (repeat/double bar)!') -c call stop1() -c end if - call g1etchar(lineq,iccount,durq) - call g1etchar(lineq,iccount,dumq) - if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "R*" (repeat/double bar)!') - call stop1() - end if - if (dumq .ne. ' ') then - call g1etchar(lineq,iccount,durq) - if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have blank after "R**" (repeat/double bar)!') - call stop1() - end if - end if - else if (charq .eq. 'V') then -c -c Ending -c - if (iv .ne. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Voltas are only allowed in voice #1!') - call stop1() - else if (isvolt) then - print* - print*,'*******WARNING********' - write(15,'(/,a)')'*******WARNING********' - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There is more than one volta in this input block.!') - print*,'This may work in a score, but WILL NOT work in parts.' - print*, - *'Safest to have only 1 volta per block, at the start of the block' - write(15,'(a)') - * 'This may work in a score, but WILL NOT work in parts.' - write(15,'(a)') - *'Safest to have only 1 volta per block, at the start of the block' - end if - isvolt = .true. - lvoltxt = 0 -11 call g1etchar(lineq,iccount,durq) - if (durq .ne.' ') then - go to 11 - end if - else if (charq .eq. 'B') then - continue - else if (charq .eq. 'P') then - if (ivx.ne.1 .or. nnl(1).ne.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only allowed at beginning of block!') - call stop1() - end if -16 call g1etchar(lineq,iccount,durq) - if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and. - * ichar(durq).le.57)) go to 16 - if (durq .eq. 'c') then -c -c Expect a centered name, and it has to be last option -c - call g1etchar(lineq,iccount,durq) - if (durq .eq. '"') then -c -c Quoted name, go to next quote mark -c - do 35 iccount = iccount+1 , 127 - if (lineq(iccount:iccount).eq.'"' .and. - * lineq(iccount-1:iccount-1).ne.'\') go to 36 -35 continue - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Missing close quote after page number command (P)!') - call stop1() -36 continue - else if (durq .ne. ' ') then -c -c Space-delimited name, look for next blank -c - do 37 iccount = iccount+1 , 127 - if (lineq(iccount:iccount) .eq. ' ') go to 38 -37 continue -38 continue - end if - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only "l","r","c" or digit allowed after "P"!') - call stop1() - end if - else if (charq .eq. 'W') then - call g1etchar(lineq,iccount,durq) - if (index('.0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a number to start here!') - call stop1() - end if - call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1)) - else if (charq .eq. 'T') then -c -c Titles -c - call g1etchar(lineq,iccount,durq) - if (index('itc',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must put "i", "t", or "c" after "T"!') - call stop1() - end if - ihead = ihead+2**(index('itc',durq)-1) -c -c Maybe a number after 'Tt', but ignore here. Read past string on next line. -c - call read10(charq,lastchar) - nline = nline+1 - iccount = 128 - else if (charq .eq. 'A') then -27 call g1etchar(lineq,iccount,durq) -c if (index('rbsdeK',durq) .gt. 0) then - if (index('rbsdK',durq) .gt. 0) then - go to 27 - else if (durq .eq. 'e') then -c -c Check for is4bignv. Must do here to catch first \internote, written in topfile -c before ever calling getnote. Initialize as .false. in pmxa. Make it true only -c if nv>7, AI not set, Ai not set. -c - is4bignv = nv.gt.7 .and. .not.AIset - go to 27 - else if (durq .eq. 'v') then - if (ibarcnt .eq. 0) novshrinktop = .true. - go to 27 - else if (durq .eq. 'a') then - call g1etchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'After "Aa", need decimal number!') - call stop1() - end if - call readnum(lineq,iccount,durq,fbar) - iccount = iccount-1 - go to 27 - else if (durq .eq. 'i') then - is4bignv = .false. - AIset = .true. - call g1etchar(lineq,iccount,durq) -c -c Local interstaff correction. Set to -1. if not specifiec, or after use, -c or anytime except at top, since pmxb handles all times except at top. -c - call readnum(lineq,iccount,durq,tintstf) - if (ibarcnt .eq. 0) fintstf = tintstf - iccount = iccount-1 - go to 27 - else if (durq .eq. 'I') then -c -c Global interstaff correction. Use in place of fintstf if fintstf<0 -c - is4bignv = .false. - AIset = .true. - call g1etchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,gintstf) - iccount = iccount-1 - go to 27 - else if (durq .eq. 'o') then - optimize = .true. - go to 27 - else if (durq .eq. 'S') then - do 50 iiv = 1 , noinst - call g1etchar(lineq,iccount,durq) - if (index('-0st',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'After "AS", need nv instances of "s,t,-,0"!') - call stop1() - end if - if (durq.eq.'-'.or.durq.eq.'s') then - isize(iiv) = 1 - else if (durq.eq.'t') then - isize(iiv) = 2 - end if -50 continue - go to 27 - else if (durq .eq. 'p') then - fontslur = .false. -42 continue - call g1etchar(lineq,iccount,durq) - if (index('+-',durq) .gt. 0) then -c -c Characters to change defaults for ps slurs -c - call g1etchar(lineq,iccount,durq) - if (index('shtc',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only letters allowed here are "s","h","t","c"!') - call stop1() - end if -c -c Now check for another default modifier -c - go to 42 - else if (index('lh',durq) .gt. 0) then -c -c Flags for optional linebreak ties or header specials -c - go to 42 - else - iccount = iccount-1 - end if - go to 27 - else if (durq .eq. 'N') then -c -c Override default name for a part file. Must have part number, then -c partname in quotes. Must be on line by itself, and start in column 1. -c Will only be passed thru to scor2prt. -c - if (iccount .ne. 2) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"AN" must start in column 1!') - call stop1() - end if - ndxquote = index(lineq,'"') - if (ndxquote.lt.4 .or. ndxquote.gt.5 .or. - * index('123456789',lineq(3:3)).eq.0 .or. - * (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"AN" must be followed by inst. #, then quote!') - call stop1() - end if - ndxquote = index(lineq(ndxquote+1:128),'"') - if (ndxquote .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'In "AN", file name must be in quotes!') - call stop1() - end if - iccount = 128 - else if (durq .eq. 'T') then - cstuplet = .true. - else if (durq .eq. 'R') then -c -c Get full name of normal include file; must occupy remainder of line -c - call getpmxmod(.false.,lineq(iccount+1:128)) - iccount = 128 - else if (durq .eq. 'c') then - call g1etchar(lineq,iccount,durq) - if (index('l4',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only "l" or "4" is allowed here!') - call stop1() - end if - if (durq .eq. 'l' ) then - hoffpt = -25 - voffpt = -45 - else if (durq .eq. '4') then - ptheight = 745 - widthpt = 499 - hoffpt = -24 - voffpt = -24 - end if - go to 27 - else if (durq .eq. 'V') then - call g1etchar(lineq,iccount,durq) - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only "+" or "-" is allowed here!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A number for vert shift before \eject must start here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only "+" or "-" is allowed here!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A number for vert shift after \eject must start here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - go to 27 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'After "A" must follow one of the letters abcdeiINprRsST!') - * 'After "A" must follow one of abcdeiILNprRsSTvV!') - print*,'For AS, since ver. 2.7, must only have noinst args.' - write(15,'(a)') - * 'For AS, since ver. 2.7, must only have noinst args.' - call stop1() - end if - else if (charq .eq. 'K') then -c -c Rules and function of K command -c -c Only 1 K +/-n +/-m allowed per block if n.ne.0 (transposition). isig1 is -c initial sig, and must be passed to pmxb because it is needed when topfile -c is called, which is before the K+n+m command is read in pmxb. Also, we -c compute and save ibrkch and newkey for each syst, accounting for key changes, -c then adjust fbar to make poenom much more accurate. -c Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. -c -77 continue - call g1etchar(lineq,iccount,durq) -c if (index('+-i',durq) .eq. 0) then - if (index('+-in',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"K" (transpose or key change) must be followed by "+,-,i,n"!') - call stop1() - end if - if (durq .eq. 'n') go to 77 - if (durq .ne. 'i') then -c -c Normal key change and/or transposition) -c -c iccount = iccount+1 - num1 = 44-ichar(durq) -c -c num1= +1 or -1 -c - ztrans = num1.eq.-1 - call g1etchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '1st +/- must be followed by a number!') - call stop1() - end if -c iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - num1 = nint(fnum)*num1 - ztrans = ztrans .and. num1.eq.0 - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '1st number after "K" must be followed by "+,-"!') - call stop1() - end if - iccount = iccount+1 - num2 = 44-ichar(durq) - call readnum(lineq,iccount,durq,fnum) - num2 = num2*int(fnum+.1) - if (num1.eq.0 .and. .not.ztrans) then -c -c Key change, only one per block allowed -c - if (iskchb) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only one key change allowed per input block!') - call stop1() - end if - iskchb = .true. - nkeys = nkeys+1 - kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0 -c -c Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. -c - ibrkch(nkeys) = ibarcnt+nbars - if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1 - newkey(nkeys) = num2+idsig -c 130316 -c do 43 iinst = 1 , noinst - midisig = newkey(nkeys) -c43 continue - else -c -c Transposition -c - fulltrans = .true. - if (ibarcnt .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Transposition must be at top of first input block!') - call stop1() - end if - isig1 = num2 - idsig = isig1-newkey(1) -c -c idsig is the difference between sig after transposition, and sig in setup. -c It may alter # of accid's in key changes if there is transposition. -c - end if - else ! durq='i' -c -c 110522/110529 -c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] -c and repeat i[...] for multiple instruments. Store info here if ibarcnt=0 -c so can pass to topfile (via comInstTrans), which is called before getnote. -c Otherwise, will store info from getnote. Initialize EarlyTransOn and -c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; -c LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really -c only needed for instrument-signatures, not transpositions. iTransAmt is -c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for -c each staff. -c - call GetiTransInfo(.true.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst) - end if - else if (charq .eq. '|') then -c -c Optional bar symbol -c - if (mod(itsofar(ivx),lenbar).ne.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Bar line marker out of place!') - call stop1() - else if (shifton) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Bar ended with user-defined shift still on!') - call stop1() - end if - else if (charq .eq. '/') then - if (ornrpt) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'WARNING: Block ended with repeated ornament still on!') - ornrpt = .false. - end if - if (stickyS) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'WARNING: Block ended with sticky stemshrink still on!') - stickyS = .false. - end if - if (fbon) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Block ended with forced beam open!') - call stop1() - else if (shifton) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Bar ended with user-defined shift still on!') - call stop1() -c -c 140215 Temporary to allow clef change in stup -c -c else if (gotclef) then -c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'May not enter clef at end of input block!') -c call stop1() - end if - barend = .false. -c -c Perform time checks -c - if (mod(itsofar(ivx),lenbar).ne.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Block duration not divisible by lenbar!') - print*,'lenbar, timesofar are ',lenbar,itsofar(ivx) - call stop1() - else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then - print* - print*,'No of bars in voice 1, current voice:', - * itsofar(1)/lenbar,itsofar(ivx)/lenbar - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Block duration not equal to voice 1!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (durq .eq. ' ' .and. iv.eq.nv) then -c -c End of input block -c - loop = .false. - else -c -c Start a new voice -c - if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0 - nbars = 0 - if (durq .eq. ' ') then -c -c New voice is on next staff -c - iv = iv+1 - ivx = iv - else -c -c New voice is on same staff. Set up for it -c - ivx = nv+1 - do 23 iiv = 1 , nv - if (nvmx(iiv) .eq. 2) ivx = ivx+1 -23 continue - if (ivx .gt. nm) then - write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm, - * ' lines of music at once' - call stop1() - end if - nvmx(iv) = 2 - ivmx(iv,2) = ivx - itsofar(ivx) = 0 - nnl(ivx) = 0 - do 24 j = 1 , 200 - rest(ivx,j) = .false. - nacc(ivx,j) = 0 -24 continue -c -c For midi stuff, record that there is a 2nd line of music in this voice -c - if (ismidi) twoline(iv) = .true. - end if - end if - iccount = 128 - else if (charq .eq. 'S') then -c -c New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. -c - if (ibarcnt .gt. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"S" can only be in first input block!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - if (index('123456789 ',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'A digit must follow "S"!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnsyst) - nsyst = nint(fnsyst) -14 continue - if (durq .eq. 'P') then -c -c New npages for parts. -c - call g1etchar(lineq,iccount,durq) - if (index('123456789 ',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnsyst) - npages = nint(fnsyst) - go to 14 - else if (durq .eq. 'm') then -c -c Reset musize (musicsize). -c - call g1etchar(lineq,iccount,durq) - if (index('123456789 ',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnsyst) - musize = nint(fnsyst) - wheadpt = whead20*musize - go to 14 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in "S" symbol!') - call stop1() - end if - else if (charq .eq. 'L') then -c -c Force line break -c - call g1etchar(lineq,iccount,durq) - if (durq .eq. 'C') then -c -c Coda, no real line break, just get coda length -c - if (ishort .ne. 1) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot use "LC" without first using "L[n]S"!') - call stop1() - end if - ishort = 0 - call g1etchar(lineq,iccount,durq) - if (index('1234567890.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need number to define coda length!') - call stop1() - end if - call readnum(lineq,iccount,durq,codafrac) - poefa(isysflb(nflb)) = poefa(isysflb(nflb))+codafrac - if (index(' n',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need blank or "n" here!') - call stop1() - end if - return - end if - nflb = nflb+1 - ibarflb(nflb) = ibarcnt+nbars+1 - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need integer to define forced line break!') - call stop1() - end if - call readnum(lineq,iccount,durq,sysflb) - isysflb(nflb) = nint(sysflb) - if (isysflb(nflb) .eq. 1) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'For now, "L1" not allowed!') - call stop1() - end if - if (nflb .gt. 1) then -c -c Check if new number is > prior one -c - if (isysflb(nflb) .le. isysflb(nflb-1)) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'You already forced a line break at a later line!') - call stop1() - end if - end if - if (npages .eq. 0) then - print* - print*,'WARNING! You forced a line break at line ', - * isysflb(nflb),' but npage = 0. Continue?' - read(*,'(a)') charq - if (index('yY',charq) .eq. 0) call stop1() - else if (isysflb(nflb) .gt. nsyst) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Forced line break at line num > nsyst!') - call stop1() - else if (index(' PMS',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have " ", "P", "M", or "S" here!') - call stop1() - end if -49 continue ! Transfer up from below to allow S after M - if (durq .eq. 'S') then -c -c Shortened line, get shortening fraction -c - ishort = 1 - call g1etchar(lineq,iccount,durq) - if (index('1234567890.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need number to define line shortening fraction!') - call stop1() - end if - call readnum(lineq,iccount,durq,shortfrac) - poefa(isysflb(nflb)) = shortfrac - if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need blank here!') - end if - end if - if (durq .eq. 'P') then -c -c Forced page break here, get page number. -c - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Need integer to define forced page break!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - nfpb = nfpb+1 - ipagfpb(nfpb) = nint(fnum) - isysfpb(nfpb) = isysflb(nflb) - if (ipagfpb(nfpb) .gt. npages) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Forced page break at page num > npages!') - call stop1() - else if (nfpb .gt. 1) then - if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Forced page break numbers must increase!') - call stop1() - end if - end if - end if - if (index(' M',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in linebreak symbol!') - call stop1() - else if (durq .eq. 'M') then - nmovbrk = nmovbrk+1 - isysmb(nmovbrk) = isysflb(nflb) - call g1etchar(lineq,iccount,durq) -31 if (durq .eq. '+') then -c -c Vertical spacing, read past number. -c - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Integer required here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - go to 31 - else if (durq .eq. 'i') then -c -c Change indentation, -c - call g1etchar(lineq,iccount,durq) - if (index('.123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Decimal number required here!') - call stop1() - end if -c -c fracsys was initialized in block data to all 0.'s -c - call readnum(lineq,iccount,durq,fracsys(nmovbrk)) - go to 31 - else if (durq .eq. 'c') then - call g1etchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'r') then - call g1etchar(lineq,iccount,durq) - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have "+" or "-" after "r" as movement break option!') - call stop1() - end if - call g1etchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'n') then -c -c Change # of voices. Input ninow, iorig(1...ninow). Will use names, -c staves per inst. and clefs corr. to iorig in original list of instruments. -c - nv = 0 - call g1etchar(lineq,iccount,durq) - if (durq .eq. ':') then -c -c Signals a 2-digit number, get next two characters -c - call g1etchar(lineq,iccount,durq) - call g1etchar(lineq,iccount,dumq) - if (index('12',durq).eq.0 - * .or.index('0123456789',dumq).eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal new number of instruments '//durq//dumq// - * ' at movement break!') - call stop1() - end if - read(lineq(iccount-1:iccount),'(i2)')ninow - else -c -c durq is a single digit number for noinow -c - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal new number of instruments '//durq// - * ' at movement break!') - call stop1() - end if - ninow = ichar(durq)-48 - end if - if (ninow.gt.noinst) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'New number of instruments must be <= original!') - call stop1() - end if - do 63 iinow = 1 , ninow - call g1etchar(lineq,iccount,durq) - if (durq .eq. ':') then -c -c Signals a 2-digit number -c - call g1etchar(lineq,iccount,durq) - call g1etchar(lineq,iccount,dumq) - if (index('12',durq).eq.0 - * .or.index('0123456789',dumq).eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal 2-digit instrument number '//durq//dumq// - * ' at movement break!') - call stop1() - end if - read(lineq(iccount-1:iccount),'(i2)')iorig - else -c -c durq is a single digit number for iorig -c - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal instrument number '//durq// - * ' at movement break!') - call stop1() - end if - iorig = ichar(durq)-48 - end if - if (iorig .gt. noinst) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'New instrument number must be <= original noinst!') - call stop1() - end if - nv = nv+nsperi(iorig) -63 continue - do 61 iiv = 1 , nv -c -c Get clef names -c - call g1etchar(lineq,iccount,durq) - if (.not.(index('tsmanrbf',durq).gt.0 .or. -c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then - * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!') - call stop1() - end if -c -c Initialize new voices -c - nvmx(iiv) = 1 - ivmx(iiv,1) = iiv - itsofar(iiv) = 0 - nnl(iiv) = 0 - do 62 j = 1 , 200 - rest(iiv,j) = .false. -62 continue -61 continue -c -c Loop back up, this might not be last option in M -c - call g1etchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'S') then - go to 49 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after Movement break symbol!') - call stop1() - end if - if (fracsys(nmovbrk) .lt. 0.001) then -c -c Since fracsys was not explicitly set, set it to prior value. -c - if (nmovbrk .eq. 1) then - fracsys(nmovbrk) = fracindent - else - fracsys(nmovbrk) = fracsys(nmovbrk-1) - end if - end if - end if -c -c Just before exiting if-block for forced line breaks, set counter to use when -c dealing with vertical space calcs -c - nistaff(nflb) = nv-1 - else if (charq .eq. 'F') then - usefig = .false. - else if (charq .eq. 'X') then - call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1, - * udsp(ibarcnt+nbars+1),wheadpt) - else if (charq .eq. 'I') then -c -c MIDI settings. -c - if (ivx.ne.1 .or. nnl(1).ne.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'MIDI stuff only allowed at start of block!') - call stop1() - end if - if (nv .gt. 15) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Sorry but MIDI does not work with more than 15 voices!') - call stop1() - end if - ismidi = .true. - call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, - * mtrdenl,nv,.true.) - else if (charq .eq. 'M') then - call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx, - * nline) - else if (index(',.',charq) .gt. 0) then -c -c Continued rhythmic shortcut -c - idotform = index('. ,',charq) - if (idotform .eq. 1) then -c -c Change duration of prior note -c - itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 - itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) - end if - idotform = idotform+1 - numnum = 1 - cdot = .true. - go to 1 - else - print*,'ASCII code:',ichar(charq) - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'This character is not allowed here!') - print*,'ASCII code:',ichar(charq) - call stop1() - end if - return - end - subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, - * xmtrnum0,newkey,npages,nsyst,musize,bottreb) - parameter(nm=24,maxblks=9600) - character*131072 bufq - character*1 chax - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - character*128 lineq - logical lastchar,issegno,isheadr,isvolt,fbon,bottreb, - * newway - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - common /commidisig/ midisig -c -c Get the first line -c - iccount = 0 - nline = 1 -9 call getbuf(lineq) - if (lineq(1:1) .eq. '%') then - nline = nline+1 - go to 9 - end if - if (lineq(1:3) .eq. '---') then -c -c Have TeX input until next line that starts with '---' -c -3 nline = nline+1 - call getbuf(lineq) - if (ilbuf .gt. nlbuf) go to 1 - go to 2 -1 print*,'You did not terminate type 0 TeX input with "---"' - call stop1() -2 continue - if (lineq(1:3) .ne. '---') go to 3 -c -c Force a new line read on first call to readin -c - iccount = 128 - end if -c -c Here, lineq and nline are first non-TeX lines. -c - nv = nint(readin(lineq,iccount,nline)) - if (nv .gt. nm) then - write(*,'(1x,a46,i3)') - * 'In setup data, number of voices cannot exceed',nm - call stop1() - end if - noinst = nint(readin(lineq,iccount,nline)) - if (noinst .gt. nv) then - write(*,'(a)') - * 'In setup data, cannot have more instruments than staves' - call stop1() - end if - newway = noinst.le.0 - if (newway) noinst = -noinst - do 10 iinst = 1 , noinst -c -c Seve # of staves per inst in case later drop some inst's. -c - if (newway) then - nsperi(iinst) = nint(readin(lineq,iccount,nline)) - else if (iinst .gt. 1 ) then - nsperi(iinst) = 1 - else - nsperi(iinst) = nv-noinst+1 - end if -10 continue - mtrnuml = nint(readin(lineq,iccount,nline)) - mtrdenl = nint(readin(lineq,iccount,nline)) -cc -cc Kluge!!! -cc -c if (mtrdenl .eq. 1) then -c mtrdenl = 2 -c mtrnuml = mtrnuml*2 -c end if - mtrnmp = nint(readin(lineq,iccount,nline)) - mtrdnp = nint(readin(lineq,iccount,nline)) - if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then - write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8' - call stop1() - end if - xmtrnum0 = readin(lineq,iccount,nline) - newkey = nint(readin(lineq,iccount,nline)) -c 130316 -c do 11 iinst = 1 , noinst - midisig = newkey -c11 continue - npages = nint(readin(lineq,iccount,nline)) - nsyst = nint(readin(lineq,iccount,nline)) - musize = nint(readin(lineq,iccount,nline)) - fracindent = readin(lineq,iccount,nline) - if (fracindent .ge. 1.) then - write(*,'(a)')'In setup data, fracindent must be <1' - call stop1() - end if - if (npages .gt. nsyst) then - print*,'Error in input file: npages > nsyst' - call stop1() - else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then - call printl('Musicsize must be 16, 20, 24, or 29') - call stop1() - end if -c -c Next noinst non-comment lines are names of instruments. -c - do 4 i = 1 , abs(noinst) -5 call getbuf(lineq) - nline = nline+1 - if (lineq(1:1) .eq. '%') go to 5 -4 continue -c -c Mext non-comment line has nv clef names -c -6 call getbuf(lineq) - nline = nline+1 - if (lineq(1:1) .eq. '%') go to 6 - do 7 iv = 1 , nv -c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then - if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then - call errmsg(lineq,iv,0, - * 'There should be a clef symbol here!') - call stop1() - end if -7 continue - if (lineq(nv+1:nv+1) .ne. ' ') then - call errmsg(lineq,nv+1,0, - * 'There should be a blank here!') - call stop1() - end if -c -c Set flag if voice 1 is treble, since it affects vertical spacing -c -c bottreb = lineq(1:1).eq.'t' - bottreb = index('t08',lineq(1:1)).gt.0 -c -c Next non-comment line has path name -c -8 call getbuf(lineq) - nline = nline+1 - if (lineq(1:1) .eq. '%') go to 8 - lpath = index(lineq,' ')-1 - if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then - call errmsg(lineq,lpath,0, - * 'Last character of pathname is not "/",":", or "' - * //chax(92)//'"!') - call stop1() - end if - return - end - subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt) -c -c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. -c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. -c - logical shifton,number,btest - character*128 lineq - character*1 charq,dumq - number = .false. - nPBSc = 0 -1 call g1etchar(lineq,iccount,charq) - if (index('PBS:',charq) .gt. 0) then -c -c Continue checking here even if "P". -c - ipbsc = index('PBS:',charq) - if (btest(nPBSc,ipbsc)) then - call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!') - call stop1() - end if - nPBSc = ibset(nPBSc,ipbsc) - go to 1 - else if (index('+-.0123456789',charq) .gt. 0) then - number = .true. - if (index('+-',charq) .gt. 0) then - call g1etchar(lineq,iccount,dumq) - if (index('.0123456789',dumq) .eq. 0) then - call errmsg(lineq,iccount,ibar,'Expected a number here!') - call stop1() - end if - end if - call readnum(lineq,iccount,dumq,fnum) - if (charq.eq.'-') fnum = -fnum - if (dumq .ne. 'p') then - iccount = iccount-1 - fnum = fnum*wheadpt - end if - go to 1 - else if (charq .ne. ' ') then - call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!') - call stop1() - end if -c -c Done with parsing. Other checks -c - if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then - call errmsg(lineq,iccount-1,ibar, - * 'Cannot have both "P" and "B" or "S" and ":"!') - call stop1() - end if - if (btest(nPBSc,4)) then - if (number) then - if (shifton) then - call errmsg(lineq,iccount-1,ibar, - * 'Started a group shift without stopping prior one!') - call stop1() - else - shifton = .true. - end if - else - if (.not. shifton) then - call errmsg(lineq,iccount-1,ibar, - * 'Ended a group shift without starting one!') - call stop1() - else - shifton = .false. - end if - end if - end if -c -c P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) -c - if (iand(nPBSc,26).eq.0) udsp = udsp+fnum - if (.not.number .and. .not.btest(nPBSc,4)) then - call errmsg(lineq,iccount-1,ibar, - * 'Must have either a number or a colon in "X" symbol!') - call stop1() - end if - return - end -c integer*4 function mytime() -c CHARACTER(10) tq -c CALL DATE_AND_TIME(TIME=tq) -c read(tq,'(2i2,f6.3)')ih,im,ts -c mytime = 1000*(ts+60*(im+60*ih)) -c return -c end - subroutine getbuf(lineq) - parameter (maxblks=9600) - character*(*) lineq - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) - ipbuf = ipbuf+lbuf(ilbuf) - ilbuf = ilbuf+1 - return - end - subroutine getchar(lineq,iccount,charq) - parameter (nm=24) -c -c Gets the next character out of lineq*128. If pointer iccount=128 on entry, -c then reads in a new line. Resets iccount. Ends program if no more input. -c - common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, - * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, - * rptprev,equalize,rptfq1,rptfq2 - logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - logical mrecord,mplay,endmac,equalize,stickyS - character*1 charq,rptfq1,rptfq2 - character*128 lineq,lnholdq - if (iccount .eq. 128) then - call read10(lineq,lastchar) - if (lastchar) return - if (.not. endmac) then - iccount = 0 - else - endmac = .false. - iccount = icchold - lineq = lnholdq - end if - if (mrecord) then - call mrec1(lineq,iccount,ndxm) - end if - end if - iccount = iccount+1 - charq = lineq(iccount:iccount) - return - end - subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount) - parameter (nm=24) - common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), - * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), - * idynda2(99),levhssav(nm),listcresc,listdecresc - character*128 txtdynq - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - logical fontslur,upslur,WrotePsslurDefaults - character*1 durq,chax - character*4 dynsymq - character*128 lineq -c -c Get info for dynamic mark. Enter after getting "D", iccount sits on "D" -c Bits in idyndat are as follows -c 00-03 ivx -c 04-11 ip -c 12-15 code for type of mark -c 0 => arbitrary text -c 1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff -c If (.not. fontslur) -c 13 => hairpin start, 14,15 => <,> (ending) -c else -c 13 < start, 14 > start, 15 ending -c end if -c 16 flag for vertical offset -c 17-23 vertical offset + 64 , \internote -c 31 Hairpin start (0), stop (1) -c -c idynda2 -c -c 00 flag for horizontal offset -c 01-09 (horizontal offset)/10 + 25.6 notehead widths -c 10 5th bit for ivx (5/15/10) -c - irest = ibset(irest,26) - ndyn = ndyn+1 - idyn = ivx - idynda2(ndyn) = 0 - if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1) - call setbits(idyn,8,4,ip) - if (lineq(iccount+1:iccount+1) .eq. '"') then -c -c text-dynamic -c - ntxtdyn = ntxtdyn+1 - iccountt = iccount -3 continue - iend = iccountt+index(lineq(iccountt+2:128),'"')+2 - if (lineq(iend-2:iend-2) .eq. '\') then - iccountt = iend-2 - go to 3 - end if - txtdynq(ntxtdyn) = lineq(iccount+2:iend-2) -c -c Store ivx, ip in bits 0-12 -c - ivxiptxt(ntxtdyn) = ivx+32*ip - ipm = index('- +',lineq(iend:iend)) - idno = 0 - else -c -c Word-group or hairpin -c - do 1 iend = iccount+2 , 128 - ipm = index('- +',lineq(iend:iend)) -c -c Exit the loop at first blank, "+", or "-" -c - if (ipm .gt. 0) go to 2 -1 continue -2 continue - read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')') - * dynsymq - idno = (index( - * 'ppppppp pp p mp mf f fp sfz ff fff ffff < > ', - * dynsymq)+3)/4 -c -c Save for later down -c - idno1 = idno - end if -c -c Set flag to check level later if in beam -c - iornq = ibset(iornq,23) - if (idno.ge.14) then -c -c Hairpin here. Check if opposite type from one that's already on -c - if (idno.eq.14.and.btest(listdecresc,ivx) .or. - * idno.eq.15.and.btest(listcresc,ivx)) then - call printl(' ') - call printl('Started one kind of hairpin while other is on') - call stop1() - end if -c -c Start or stop? -c - if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then -c -c Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. -c - if (.not.fontslur) idno = 15 - else if (fontslur) then -c -c Start of font slur -c - idno = 13 - else -c -c Start of postscript slur -c - idno = idno-1 - end if - end if -c -c Now that we used list[de]cresc, update -c - if (idno .ge.13) then - if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then -c -c Something's ending -c - if (btest(listcresc,ivx)) then -c -c It's a cresc! -c - listcresc = ibclr(listcresc,ivx) - else - listdecresc = ibclr(listdecresc,ivx) - end if - else -c -c Something's starting -c - if (idno1 .eq. 14) then -c -c It's a cresc! -c - listcresc = ibset(listcresc,ivx) - else - listdecresc = ibset(listdecresc,ivx) - end if - end if - end if - call setbits(idyn,4,12,idno) - iccount = iend - if (ipm .ne. 2) then -c -c There is a vertical shift -c - idyn = ibset(idyn,16) - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - idno = nint(fnum) - call setbits(idyn,7,17,(ipm-2)*idno+64) - ipm = index('- +',durq) - if (ipm .ne. 2) then -c -c There is a horizontal shift -c -c idynda2(ndyn) = ibset(idyn,23) - idynda2(ndyn) = ibset(idynda2(ndyn),0) - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - idno = nint(10*fnum) - call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256) - end if -c -c iccount should be on the blank at the end of the entire symbol -c - end if - idyndat(ndyn) = idyn - return - end - subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig, -c * itsofar,nodur,figq,ivupfig,nfigs) - * itsofar,nodur,figq,ivupfig,ivvfig,nfigs) - logical isfig - character*1 charq - character*10 figq - character*128 lineq - nfigs = nfigs+1 - ivupfig = 0 - ivvfig = 0 - itoff = 0 - if (charq .eq. 'x') then -c -c Floating figure. -c - call getchar(lineq,iccount,charq) - read(charq,'(i1)')noff - call getchar(lineq,iccount,charq) - read(charq,'(i1)')loff - itoff = noff*ifnodur(loff,'x') - call getchar(lineq,iccount,charq) - else -c -c Figure on a note -c - isfig = .true. - end if - itfig = itsofar+itoff-nodur - lfig = 1 - figq = charq -5 call getchar(lineq,iccount,charq) -c if (index(' +',charq) .eq. 0) then - if (index(' +v',charq) .eq. 0) then - figq = figq(1:lfig)//charq - lfig = lfig+1 - go to 5 - else if (charq .eq. '+') then -c -c Get vertical offset for figure. Next character after number has to be blank. -c - iccount = iccount+1 - call readnum(lineq,iccount,charq,fnum) - ivupfig = nint(fnum) - else if (charq .eq. 'v') then -c -c Get vertical change in figdrop. Must be last item in figure word. -c - isign = 1 - call getchar(lineq,iccount,charq) - if (charq .eq. '-') then - isign=-1 - call getchar(lineq,iccount,charq) - end if - ivvfig = isign*(ichar(charq)-48) - end if - return - end - subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, - * lastlev,iv,nv) - parameter (nm=24) - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg - character*1 charq,durq - character*20 voltxtq - character*128 lineq,litq - integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm), - * ndlev(nm,2) - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans -c -c Grace, comes *before* main note: -c UNLESS there's an 'A' or 'W' after the 'G' -c ngrace = # of grace note groups so far in block -c ivg(ngrace), ipg(ngrace) -c nng(ngrace) = # of notes in this group: default = 1 -c ngstrt(ngrace) = starting position in nolevg of levels for this grace -c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' -c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' -c slurg(ngrace) = logical for slur; default F, input 's' -c slashg(ngrace) = T if slash; default is F, input 'x' -c These data MUST precede note name of first note -c nolevg, naccg: lists of levels and accid's, indexed as described above. -c - ngrace = ngrace+1 - ivg(ngrace) = ivx - ipg(ngrace) = nnl(ivx)+1 - if (ngrace .eq. 1) then - ngstrt(ngrace) = 1 - else - ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) - end if - islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) - nng(ngrace) = 1 - multg(ngrace) = 1 - upg(ngrace) = .true. - slurg(ngrace) = .false. - slashg(ngrace) = .false. -18 call getchar(lineq,iccount,charq) - if (index('WA',charq) .gt. 0) then -c -c Grace is on note that was already done, so shift flags forward one note. -c This puts flag on actual note with grace; later for W will go ahead one more. -c - ipg(ngrace) = nnl(ivx) - islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) - if (slurg(ngrace)) - * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) - if (charq .eq. 'A') then -c -c close After, clear way-after bit, to ensure priority of most recent A/W -c - ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) - else -c -c Way after; later assign to following note, and position like normal grace. -c - ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) - end if - else if (charq .eq. 'm') then - call getchar(lineq,iccount,charq) - multg(ngrace) = ichar(charq)-48 - else if (index('123456789',charq) .gt. 0) then - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - nng(ngrace) = nint(fnum) - else if (charq .eq. 'l') then - upg(ngrace) = .false. - else if (charq .eq. 's') then - slurg(ngrace) = .true. - if (nnl(ivx) .gt. 0) then -c -c If A- or W-grace, set signal to start slur on main note. -c - if(btest(ipl(ivx,nnl(ivx)),31) .or. - * btest(ipl(ivx,nnl(ivx)),29)) - * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) - end if - else if (charq .eq. 'x') then - slashg(ngrace) = .true. - else if (charq .eq. 'u') then - else if (charq .eq. 'X') then -c -c Space before main note of grace. Number will come next. -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,graspace(ngrace)) - iccount = iccount-1 - end if - if (index('abcdefg',charq) .eq. 0) go to 18 -c -c At this point, charq is first note name in grace -c - do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 - naccg(ing) = 0 - ioct = 0 - if (ing .gt. ngstrt(ngrace)) then -55 call getchar(lineq,iccount,charq) - if (charq .eq. ' ') go to 55 - endif - iclastlev = 0 -9 call getchar(lineq,iccount,durq) - if (durq .ne. ' ') then - if (durq.eq.'+') then - lastlev = lastlev+7 - iclastlev = iclastlev+7 - else if (durq.eq.'-') then - lastlev = lastlev-7 - iclastlev = iclastlev-7 - else if (index('fsn',durq) .gt. 0) then - if (naccg(ing) .eq. 0) then - naccg(ing) = index('fsn',durq) - else -c -c Double accidental -c - naccg(ing) = ibset(naccg(ing),2) - end if - else - ioct = ichar(durq)-48 - end if - go to 9 - end if - if (ioct .gt. 0) then - lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) - else - if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then - if (ivx .le. nv) then - kv = 1 - else - kv = 2 - end if - lastlev = ndlev(iv,kv)+iclastlev - end if - lastlev = lastlev-3 - * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) - end if - nolevg(ing) = lastlev -19 continue -c -c Grace could come before first note of block, so reset end level. -c - if (nnl(ivx).eq.0) then - if (ivx .le. nv) then - kv = 1 - else - kv = 2 - end if - ndlev(iv,kv) = lastlev - end if - return - end - subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst) -cccccccccccccccccccccccc -cc -cc GetiTransInfo.for -cc -cccccccccccccccccccccccc -c -c Called from both g1etnote and getnote, after first 'i' in Ki[...] -c On entry, iccount points to last char retrieved, which is 'i' -c -c From1: locgical, true if called from g1etnote -c ibarcnt: tells whether to set EarlyTransOn to true. -c EarlyTransOn set false in blkdata, true here, back to false in topfile. -c -c 110522/110529 -c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] -c and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0 -c so can pass to topfile (via comInstTrans), which is called before getnote. -c Otherwise, will store info from getnote. Initialize EarlyTransOn and -c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; -c LaterInstTrans from getnote. Zero both out after use. nInstTrans really -c only needed for instrument-signatures, not transpositions. iTransAmt is -c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for -c each staff. -c -c iTransAmt stored as fn of instrument #, not like iTransKey which is -c fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This -c simplifies use of iTransAmt for all calls to ifnolev. -c - parameter (nm=24) - logical From1 - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans,store - character*128 lineq - character*1 durq - durq = 'x' ! Can't initialize in declaration stmt, only works once. - if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0 - store = (EarlyTransOn.and.ibarcnt.eq.0) .or. - * (ibarcnt.gt.0.and..not.From1) - LaterInstTrans = .not.From1 .and. ibarcnt.gt.0 - if (store) nInstTrans = 0 -1 continue - if (durq .eq. ' ') return - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be an instrument number here!') - call stop1() - end if - if (store) nInstTrans = nInstTrans+1 - call readnum(lineq,iccount,durq,fnum) - instn = nint(fnum) - if (instn.gt.noinst) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Instrument number out of range!') - call stop1() - end if - if (store) iInstTrans(nInstTrans) = instn -c -c durq is +/- following inst # (for iTransAmt), iccount is on it. -c - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '1st character after instrument number must be "+,-"!') - call stop1() - end if - itramt = 44-ichar(durq) ! +1/-1 for itramt - call g1etchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be a transposition amount here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (store) iTransAmt(instn) = nint(fnum)*itramt -c -c durq is +/- following iTransAmt (for iTransKey), iccount is on it. -c - if (index('+-',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '1st character after transposition amount must be "+,-"!') - call stop1() - end if - ikey = 44-ichar(durq) ! +1/-1 - call g1etchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be a key indicator here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - if (store) iTransKey(nInstTrans) = nint(fnum)*ikey -c -c durq is now 1st character after iTransKey, should be either 'i' or ' ' -c - if (durq.ne.'i'.and.durq.ne.' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'There must be blank or "i" here!') - call stop1() - end if - go to 1 - end - subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars, - * lenbar,mtrdenl,nv,first) -c -c Use this from both pmxa and pmxb to input and check midi data. "first" tells -c whether pmxa or pmxb. If .not.first, then tempo and pause commands cause -c things to be written immediately into the midi storage buffers. -c - parameter (nm=24,mv=24576) - common /comevent/ miditime,lasttime - logical mmacrec,gottempo - common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, - * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), - * mmacrec,gottempo -c -c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing -c nmidsec section starts and stops based on PLAYING macros (not recording). -c - integer*2 mmidi,midinum(26) - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm) - integer*2 iinsiv - character*1 durq - character*2 instq - character*128 lineq - logical first - common /comdiag/ n69(0:nm),n34(0:nm) -c -c Instrument codes -c - data midinum - * / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67, -c XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX -c - * 68,69,71,72,74,75, 8,55 / -c bsXobXbaXclXflXreXctXvo -c -1 call getchar(lineq,iccount,durq) - if (durq .eq. 't') then -c -c Tempo in beats ber minute -c - call getchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected an integer here for the pause!') - call stop1() - end if - call readnum(lineq,iccount,durq,qpm) - iccount = iccount-1 - if (.not.first) then - call midievent('t',nint(qpm),0) - gottempo = .true. - end if - go to 1 - else if (durq .eq. 'p') then -c -c Insert a pause. pausemid = pause in 1/4's -c - call getchar(lineq,iccount,durq) - if (index('0123456789.',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a number here for the pause!') - call stop1() - end if - call readnum(lineq,iccount,durq,pausemid) - iccount = iccount-1 - if (.not.first) then -c -c Compute a meter for the pause. This is only to keep MidiNotate on track. -c Round pause to nearest 16th. Let denominator always be 16. -c - numb16 = nint(pausemid*4) - call midievent('m',numb16,16) -c -c Put in pausemid beats of rest -c - do 3 icm = 0 , numchan-1 - call addmidi(icm,0,0,0,4.*numb16,.true.,.false.) -3 continue - miditime = miditime+nint(240*pausemid) -c -c Restore meter -c - call midievent('m',mtrdenl*lenbar/64,mtrdenl) - end if - go to 1 - else if (durq .eq. 'i') then -c -c Instrument numbers or letters. Expect noinst of them. -c - do 2 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (ichar(durq) .gt. 96) then -c -c It's a lowercase letter. Get another, find corr. instrument #. -c - instq(1:1) = durq - call getchar(lineq,iccount,durq) - instq = instq(1:1)//durq - iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'// - * 'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3 - if (iname .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Unrecognized 2-letter midi instrument name!') - call stop1() - end if - midinst(ivx) = midinum(iname)-1 - else -c -c Expect a number, followed by ":" if that is followed by another number. -c I.e., if after call to readnum, durq is not ":", it must be either blank -c or next instrument letter. -c - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a midi instrument number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - midinst(ivx) = nint(fnum)-1 - if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Midi instrument number must be in range 1-128!') - call stop1() - end if - if (durq .ne. ':') iccount = iccount-1 - end if -2 continue - go to 1 - else if (durq .eq. 'v') then -c -c Get volumes for each instrument. Expect noinst of them. -c Follow same pattern as for insttrument numbers above. -c - do 7 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a midi velocity number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - midivel(ivx) = nint(fnum)-1 - if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Midi velocity must be in range 1-128!') - call stop1() - end if - if (durq .ne. ':') iccount = iccount-1 -7 continue - if (.not. first) then - call inst2chan(midvelc,midivel,midchan,nv,iinsiv,twoline) - end if - go to 1 - else if (durq .eq. 'b') then -c -c Get balance for each instrument. Expect noinst of them. -c Follow same pattern as for instrument numbers above. -c - do 8 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a balance number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - midibal(ivx) = nint(fnum)-1 - if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Midi balance must be in range 1-128!') - call stop1() - end if - if (durq .ne. ':') iccount = iccount-1 -8 continue - if (.not. first) then - call inst2chan(midbc,midibal,midchan,nv,iinsiv,twoline) - end if - go to 1 - else if (durq .eq. 'T') then -c -c Get transposition for each instrument. Expect noinst of them. -c Follow similar pattern as above, but separator is +|-. -c - do 9 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - ipm = index('-+',durq) - if (ipm .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected "+" or "-" for midi transposition here!') - call stop1() - end if - ipm = 2*ipm-3 - call getchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected a number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - miditran(ivx) = ipm*nint(fnum) -c if (mod(miditran(ivx),12).ne. 0) then -c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'Midi transposition limited to multiples of 12!') -c call stop1() -c end if - iccount = iccount-1 -9 continue - if (.not. first) then - call inst2chan(midtc,miditran,midchan,nv,iinsiv,twoline) - end if - go to 1 - else if (durq .eq. 'g') then - call getchar(lineq,iccount,durq) - if (index('0123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected an integer here for the midi gap!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - mgap = nint(fnum) - iccount = iccount-1 - go to 1 - else if (durq .eq. 'M') then -c -c MidiMacros -c - call getchar(lineq,iccount,durq) - if (durq .eq. 'R') then -c -c Start recording -c - if (mmacrec) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'You tried to record a MidiMacro while already recording!') - call stop1() - end if - mmacrec = .true. - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected MidiMacro ID number here!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - if (.not.first) then - immac = nint(fnum) - if (immac .gt. 20) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'MidiMacro ID cannot exceed 20!') - call stop1() - end if -c -c Save the start time -c - mmactime(immac) = miditime - do 4 icm = 0 , numchan - if (icm .lt. numchan) then - if (restpend(icm)) then -c -c Adjust if there's a rest at end of prior section. Insert dummy turnoff. -c (This causes two turn-offs in a row, which testmidi sees as an error). -c -c Before: section1 ------rest------- section2(to be recorded) -c After: section1 rest1 now rest2 section2(recorded) -c - call addmidi(icm,30,0,0,trest(icm),.false.,.true.) - trest(icm) = 0 - restpend(icm) = .false. - end if - else - if (miditime .gt. lasttime) then -c -c Insert a dummy turnoff in conductor track -c - call addmidi(icm,30,0,0,(miditime-lasttime)/15., - * .false.,.true.) - lasttime = miditime - end if - end if - mmacstrt(icm,immac) = imidi(icm)+1 -4 continue - end if - go to 1 - else if (index('123456789P',durq) .eq. 0) then -c -c End recording; close the open macro. Get immac from common. -c - if (.not.mmacrec) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'You tried to end a MidiMacro before starting one!') - call stop1() - end if - mmacrec = .false. - iccount = iccount-1 - if (.not.first) then -c -c Save the macro duration -c - mmactime(immac) = miditime-mmactime(immac) - do 5 icm = 0 , numchan - if (icm .lt. numchan) then - if (restpend(icm)) then - call addmidi(icm,30,0,0,trest(icm),.false.,.true.) - trest(icm) = 0 - restpend(icm) = .false. - end if - else - if (miditime .gt. lasttime) then -c -c Insert a dummy turnoff in conductor track if needed. -c - call addmidi(icm,30,0,0,(miditime-lasttime)/15., - * .false.,.true.) - lasttime = miditime - end if - end if - mmacend(icm,immac) = imidi(icm) -5 continue - end if - if (durq .ne. ' ')go to 1 - else if (durq .eq. 'P') then -c -c Play Back a Macro -c - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Expected MidiMacro ID number here!') - call stop1() - end if - if (mmacrec) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'You tried to play a MidiMacro before ending recording!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - if (.not.first) then - immac = nint(fnum) - if (mmactime(immac) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Cannot play a MIDI macro before recording it!') - call stop1() - end if - do 6 icm = 0 , numchan - if (icm .lt. numchan) then - if (restpend(icm)) then - call addmidi(icm,30,0,0,trest(icm),.false.,.true.) - trest(icm) = 0. - restpend(icm) = .false. - end if - else - if (miditime .gt. lasttime) then -c -c Insert a dummy turnoff in conductor track -c - call addmidi(icm,30,0,0,(miditime-lasttime)/15., - * .false.,.true.) - end if - end if - msecend(icm,nmidsec) = imidi(icm) - msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac) - msecend(icm,nmidsec+1) = mmacend(icm,immac) - msecstrt(icm,nmidsec+2) = imidi(icm)+1 -6 continue - nmidsec = nmidsec+2 -c -c Update running time -c - miditime = miditime+mmactime(immac) - lasttime = miditime - end if - go to 1 - else - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in MidiMacro sub-command!') - call stop1() - end if - else if (durq .eq. 'd') then - debugmidi = .true. - go to 1 - else if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character in MIDI input data!') - write(*,'(a)') - * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '// - * 'should be noinst, not nv' - write(15,'(a)') - * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '// - * 'should be noinst, not nv' - call stop1() - end if - if (.not.gottempo .and. .not.first) then -c -c If no tempo is set on first call on the pmxb pass, then set it -c - call midievent('t',96,0) - gottempo = .true. - end if - return - end - subroutine getnote(loop) - parameter (nm=24,mv=24576) - common /comlast/ islast,usevshrink - logical islast,usevshrink,ignorenats,newmbrhgt - common /comignorenats/ mbrhgt,newmbrhgt,ignorenats - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*10 figq - character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax - logical beamon,firstgulp,figbass,figchk,isfig - character*60 cheadq - character*120 instrq,titleq,compoq - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, - * inhead - common /cominbot/ inbothd - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, - * OptLineBreakTies,HeaderSpecial - common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, - * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, - * rptprev,equalize,rptfq1,rptfq2 - common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg,fbon,ornrpt,shifton,setis,notcrd,isbjmp, - * was2,nobar1,quoted,isbj2,stickyS, - * OptLineBreakTies,HeaderSpecial - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - character*128 litq - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - common /combc/ bcspec - common /comas3/ ask(2500),iask,topmods -c -c nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined -c ivx is current ivmx, and is the index for all notes, acc's etc. -c - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac - common /comtrans/ cheadq - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), - * ic1mac(20),ilmac,iplmac - common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), - * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), - * idynda2(99),levhssav(nm),listcresc,listdecresc - common /comclefq/ clefq(nm) - common /comtol/ tol - common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), - * ArpShift(20) - character*128 txtdynq - logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur, - * fontslur,WrotePsslurDefaults - character*128 lineq,lnholdq,lineqt - character*80 headrq, lowerq - character*79 inameq - character*59 hdlndq - character*20 voltxtq - character*1 charq,dotq,durq,ulfbq,dumq - logical loop,lastchar,lower,rptnd1,rptprev,bcspec,moved, - * topmods,headlog,btest,sluron,cdot,equalize - character*24 tempq - logical novshrinktop,cstuplet - common /comnvst/ novshrinktop,cstuplet - logical kbdrests - common /comkbdrests/ levbotr(8),levtopr(8),kbdrests - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idumm1,isig1, - * mbrestsav,kchmid(18),logdumm1,logdumm2,barend,noinst,logdumm3 - logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3 - common /combibarcnt/ ibarcnt - common /commidisig/ midisig - common /comlyr/ inputmlyr - logical inputmlyr - common /combottop/ botamt,topamt,bottopgap - logical bottopgap - logical inxtup - common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, - * poefa - real*4 poefa(125) - logical nocodabn - cdot = .false. - inxtup = .false. -1 call getchar(lineq,iccount,charq) - if (lastchar) return - if (charq .eq. ' ') go to 1 - if (charq .eq. '%') then -c -c Check for a bar number format: -c - if (iccount.eq.1 .and. lineq(2:2).eq.' ' .and. - * index('bB1234567890',lineq(3:3)).gt.0) then - if (islast) write(11,'(a)')lineq(1:lenstr(lineq,128)) - end if - iccount = 128 - go to 1 - end if -c -c Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' -c - if (rptprev) then - rptnd1 = charq .eq. '/' - rptprev = .false. - end if -c -c Repeat at end of a piece -c - if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. - * charq.eq.'r') then - if (cdot) go to 28 -c -c This is a note/rest. -c - idotform = 0 - numnum = 0 -c -c If start of line of music, set pitch from previous -c - if (ivx .le. nv) then - kv = 1 - else - kv = 2 - end if - if (nnl(ivx).eq.0) lastlev = ndlev(iv,kv) -c -c notcrd is used to tell if orn. goes on main note or chord note -c -c notcrd = .true. !Move dow. Was not observed if dotted shortcut. -c -c Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. -c -28 continue -c -c Moved this from just above, 2 Feb 02 -c - notcrd = .true. - nnl(ivx) = nnl(ivx)+1 - if (ornrpt) then -c -c Replicate ornament bits, also bit 23 for beam handling if chord. -c - iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),iornq(ivx,0)) - if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then -c -c This is a trill (bit 7 or 15) so must dup the parameters -c - ntrill = ntrill + 1 - ivtrill(ntrill) = ivx - iptrill(ntrill) = nnl(ivx) - xnsktr(ntrill) = xnsktr(ntrill-1) - end if - end if - if (stickyS) then -c -c Grab stemlength shortening parameters from prior note -c - mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27) -c call setbits (mult(ivx,nnl(ivx)),3,28, -c * igetbits(mult(ivx,nnl(ivx)-1),3,28)) - call setbits (mult(ivx,nnl(ivx)),6,10, - * igetbits(mult(ivx,nnl(ivx)-1),6,10)) - end if - if (autofbon .and. tautofb.gt.tol .and. .not.fbon) then -c -c Doing auto forced beams, and period has been set, so check if this note -c starts a period. -c -c if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then - if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then -c -c Start a forced beam here -c - nfb(ivx) = nfb(ivx)+1 - fbon = .true. - ulfbq(ivx,nfb(ivx)) = 'x' - t1fb(ivx,nfb(ivx)) = itsofar(ivx) - end if - end if - if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30) - dotq = 'x' - if (charq.eq.'r') - * irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0) - if (btest(irest(ivx,nnl(ivx)),0)) then -c -c Rest stuff. First check if previous note was full-bar-pause -c - if (lineq(iccount+1:iccount+1) .eq.' ' - * .and. nnl(ivx).gt.1) then - if (btest(islur(ivx,nnl(ivx)-1),19)) - * islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19) - end if -c -c Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 -c for voice a or b. Set a-types at 0 as encountered and adjust later -c after '//'. (Override heights will be set to 100+offset) -c - if (ivx .le. nv) then - nolev(ivx,nnl(ivx)) = 0 - else - nolev(ivx,nnl(ivx)) = 2 - end if - end if -2 call getchar(lineq,iccount,durq) - ic = ichar(durq) - if (ic.le.57 .and. ic.ge.48) then -c -c Digit -c - if (numnum .eq. 0) then - nnodur = ic-48 - numnum = 1 - go to 2 - else if (numnum .eq. 1) then - ioct = ic-48 - numnum = 2 - go to 2 - else - print*,'>2 digits in note sym., ivx,nn:',ivx,nnl(ivx) - call stop1() - end if - else if (durq .eq. 'd') then - dotq = durq - if (lineq(iccount+1:iccount+1) .eq. 'd') then -c -c Double dot. -c - iccount = iccount+1 - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),3) - end if - if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then -c -c move a dot, unless next char is not part of a number -c - if (index('0123456789.',lineq(iccount+2:iccount+2)) .eq. 0) - * go to 2 - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19) - call getchar(lineq,iccount,durq) - ndotmv(ivx) = ndotmv(ivx)+1 - iccount=iccount+1 - call readnum(lineq,iccount,dumq,updot(ivx,ndotmv(ivx))) - if (durq .eq. '-') - * updot(ivx,ndotmv(ivx)) = -updot(ivx,ndotmv(ivx)) - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift also -c - iccount=iccount+1 - call readnum(lineq,iccount,durq,rtdot(ivx,ndotmv(ivx))) - if (dumq .eq. '-') - * rtdot(ivx,ndotmv(ivx)) = -rtdot(ivx,ndotmv(ivx)) - else - rtdot(ivx,ndotmv(ivx)) = 0. - end if - iccount = iccount-1 - end if - go to 2 - else if (durq .eq. 'p') then -c -c Full-bar rest as pause -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19) - go to 2 - else if (durq .eq. 'b') then -c -c Blank rest -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29) - go to 2 - else if (index('fsn',durq) .gt. 0) then -c -c Accidental -c -c if (nacc(ivx,nnl(ivx)) .eq. 0) then -c 171209 May have set bit 18 earlier if D or F preceded accidental - if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then -c -c No accidental has been set yet -c -c nacc(ivx,nnl(ivx)) = index('fsn',durq) - nacc(ivx,nnl(ivx)) = - * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) - else -c -c Repeated accid, so must be double -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2) - end if - go to 2 - else if (durq .eq. 'i') then -c -c Set flag for MIDI-only accidental. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17) - go to 2 - else if (durq .eq. 'c') then -c -c Set flags for cautionary accidental -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31) - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) - go to 2 - else if (index('+-<>',durq) .gt. 0) then - ipm = index('- +',durq)-2 - if (.not.btest(irest(ivx,nnl(ivx)),0)) then -c -c A note, not a rest. -c - call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved) - if (moved) go to 2 -c -c Octave jump with a note -c - if (numnum .lt. 2) then - lastlev = lastlev+ipm*7 - else - ioct = ioct+ipm*1 - end if - go to 2 - else -c -c Override default height of a rest -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (lineq(iccount-1:iccount-1) .eq. '.') then -c -c Kluge in case there is a shortcut ".". It will have been sucked up by -c readnum. (Same doesn't hold for ",") -c - iccount = iccount-1 -c go to 2 - end if - nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) -c -c There may be more characters for this rest -c - iccount = iccount-1 - go to 2 - end if - else if (durq .eq. 'x') then -c -c Xtuplet. Count number of doubled notes (for unequal xtups) -c - if (btest(nacc(ivx,nnl(ivx)),18)) then - ndoub = 1 - else - ndoub = 0 - end if -c -c Initialize counter for # of non-rests, so can later unbeam if = 1. -c - inxtup = .true. - note1xtup = nnl(ivx) - nnb = 0 - if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1 -c -c Will set all durations to 0 except last one. Set flag on this note. -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28) -c -c Next input will be digit unless its a "T" -c - iccount = iccount+1 - if (lineq(iccount:iccount) .eq. 'T') then -c -c Set up tremolo -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2) - ntup = 2 -c -c Set default beaming, based on Wikipedia article -c May be a problem here is nnodur is inherited -c - if (nnodur .eq. 4) then - nsolid = 0 - nindent = 3 - else if (nnodur .eq. 2) then - nsolid = 3 - nindent = 0 - else if (nnodur .eq. 8) then - nsolid = 1 - nindent = 2 - end if - call getchar(lineq,iccount,durq) - if (index('0123456789',durq) .gt. 0) then - nsolid = index('0123456789',durq)-1 - if (nsolid.eq.0 .and. nnodur.eq.2) then - print*,'' - print*,'Unbeamed half-note 2-note tremolo forbidden.' - call stop1() - end if - call getchar(lineq,iccount,durq) - if (index('0123456789',durq) .gt. 0) then - nindent = index('0123456789',durq)-1 - end if - end if - call setbits(irest(ivx,nnl(ivx)),2,3,nsolid) - call setbits(irest(ivx,nnl(ivx)),2,5,nindent) - if (nsolid .eq. 0) then - islur(ivx,nnl(ivx)) = - * ibset(islur(ivx,nnl(ivx)),18) - end if - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) - islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) - call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid) -c -c Set some force-beam parameters for the tremolo -c -c Need to check if there's already a forced beam explicitly set here. -c If there was, shouldn't do any harm resetting parameters. -c - if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx)) - * nfb(ivx) = nfb(ivx)+1 - fbon = .true. - ulfbq(ivx,nfb(ivx)) = 'x' - t1fb(ivx,nfb(ivx)) = itsofar(ivx) - t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq) - nadj = 0 -c -c Set open beamed notehead flag for half-note tremolo -c Just gave 2 quarters with or without flag set. Need to fix -c - else - call readnum(lineq,iccount,durq,fnum) - ntup = nint(fnum) - end if - if (index('DF',durq) .gt. 0) then -c -c -c Double xtup note to make an un= xtup. Here xtup number already set but may also -c have this command before. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = - * ibset(nacc(ivx,nnl(ivx)),19) - ndoub = 1 - call getchar(lineq,iccount,durq) - else if (durq .eq. 'd') then - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) - call getchar(lineq,iccount,durq) - end if -c -c Only other possibilities here are ' ' or 'n' -c - if (durq .eq. 'n') then -c -c Alter xtup number -c - if (lineq(iccount+1:iccount+1) .eq. ' ') then -c -c If the only modifier is 'n', cancel the number -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) - else - numshft = 0 -30 call getchar(lineq,iccount,durq) - if (durq .eq. 'f') then -c -c Flip up-down-ness -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),14) - go to 30 - else if (index('+-',durq) .gt. 0) then -c -c Vertical or horiz shift -c - numshft = numshft+1 - iofforn = 1 - if (durq .eq. '-') iofforn = -1 - iccount = iccount+1 - call readnum(lineq,iccount,durq,xofforn) - iccount = iccount-1 - if (numshft .eq. 1) then -c -c Vertical shift -c 160214 Allow (-64,64) -c iofforn = iofforn*nint(xofforn) + 16 - iofforn = iofforn*nint(xofforn) + 64 -c -cc Turn on bit 1; set bits 2-6 to iofforn -c Turn on bit 1 of irest; set bits 16-22 of mult to iofforn -c -c irest(ivx,nnl(ivx)) = -c * ior(irest(ivx,nnl(ivx)),2+4*iofforn) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),1) - call setbits(mult(ivx,nnl(ivx)),8,16,iofforn) - else -c -c Horizontal shift -c - iofforn = iofforn*nint(xofforn*10)+16 - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),7) - call setbits(irest(ivx,nnl(ivx)),5,9,iofforn) - end if - go to 30 - else if (durq .eq. 's') then -c -c Slope adjustment for bracket -c - mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),4) - call getchar(lineq,iccount,durq) - iofforn = index('- +',durq)-2 - iccount = iccount+1 - call readnum(lineq,iccount,durq,xofforn) - iccount = iccount-1 - iofforn = nint(iofforn*xofforn+16) - call setbits(mult(ivx,nnl(ivx)),5,5,iofforn) - else if (index('123456789',durq) .gt. 0) then -c -c Replacement printed number -c - call readnum(lineq,iccount,durq,xofforn) - call setbits(nacc(ivx,nnl(ivx)),5,22,nint(xofforn)) - iccount = iccount-1 - go to 30 - end if - end if - end if -c -c Set note level of 1st note of xtup, provided not a rest -c - if (.not.btest(irest(ivx,nnl(ivx)),0)) then - if (numnum .eq. 2) then - lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) - nolev(ivx,nnl(ivx)) = lastlev - else - lastlev = lastlev-3 - * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) - nolev(ivx,nnl(ivx)) = lastlev - end if - end if - do 40 npreslur = npreslur , 1 , -1 -c -c Set note level for preslur on starting note of xtuplet -c - call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) -40 continue - numnum = 0 - nodur(ivx,nnl(ivx)) = 0 - do 6 itup = 2 , ntup - if (ornrpt) then - iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)), - * iand(iornq(ivx,nnl(ivx)-1),10026991)) - if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then -c -c This is a trill (bit 7 or 15) so must dup the parameters -c - ntrill = ntrill + 1 - ivtrill(ntrill) = ivx - iptrill(ntrill) = nnl(ivx) - xnsktr(ntrill) = xnsktr(ntrill-1) - end if - end if - nnl(ivx) = nnl(ivx)+1 - if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30) -7 call getchar(lineq,iccount,charq) - if (charq .eq. ' ') then - go to 7 - else if (charq .eq. '%') then - iccount = 128 - go to 7 - else if (charq .eq. 'o') then -c -c Ornament in xtuplet. "o" symbol must come AFTER the affected note -c - if (notcrd) then - nole = nolev(ivx,nnl(ivx)-1) - else - nole = iand(127,ishft(icrdat(ncrd),-12)) - end if - call getorn(lineq,iccount,iornq(ivx,nnl(ivx)-1), - * iornq(ivx,0),ornrpt,noffseg, - * nnl(ivx)-1,ivx,.false.,notcrd,nole) - go to 7 - else if (index('st(){}',charq) .gt. 0) then - nnlivx = nnl(ivx)-1 - if (charq.eq.'(' .or. charq.eq.'{') then -c -c Detected preslur in xtuplet loop, non-chord note -c - nnlivx = nnlivx+1 - npreslur = npreslur+1 - end if - islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0) - if (charq.eq.'t') islur(ivx,nnlivx) = - * ibset(islur(ivx,nnlivx),1) - if (ivx .le. nv) then - kv = 1 - else - kv = 2 - end if - if (fontslur) then - call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2, - * isdat3,nsdat,notcrd,nolev(ivx,nnlivx),charq) - else - call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2, - * isdat3,isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq) - end if - go to 7 - else if (charq .eq. 'G') then -c -c Kluge to get grace in xtup at right location -c - nnl(ivx) = nnl(ivx)-1 - call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, - * lastlev,iv,nv) - nnl(ivx) = nnl(ivx)+1 - go to 7 - else if (charq .eq. sq) then - call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) - go to 7 - else if (charq .eq. '"') then -c -c pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ -c - if (.not. inputmlyr) then - ictemp = 0 - lineqt = sq//sq//sq//'input musixlyr '//sq - call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) - inputmlyr = .true. - end if - call dopmxlyr(lineq,iccount) - charq = sq - call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) - go to 7 - else if (index('0123456789#-nx_',charq) .gt. 0) then -c -c Figure. Must come AFTER the first note of xtup -c - ivf = 1 - if (ivx .gt. 1) then - if (ivxfig2 .eq. 0) then - ivxfig2 = ivx - else if (ivx .ne. ivxfig2) then - print* - print*,'Figures not allowed in >1 voice above first' - stop - end if - ivf = 2 - end if - nfig1 = nfigs(ivf)+1 - call getfig(itoff(ivf,nfig1),charq,lineq,iccount, - * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx), -c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) - * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1), - * nfigs(ivf)) - go to 7 - else if (charq .eq. 'X') then - call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)), - * shifton,wheadpt,iornq(ivx,nnl(ivx)),ivx, - * irest(ivx,nnl(ivx)),itsofar(ivx),ntup,itup,nnodur, - * dotq,ndoub) - go to 7 - else if (charq .eq. 'z') then -c -c Chord note in xtup. Goes with *prior* note. -c - notcrd = .false. - ncrd = ncrd+1 - ipl(ivx,nnl(ivx)-1) = ibset(ipl(ivx,nnl(ivx)-1),10) - numnum = 0 -c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) - icrdat(ncrd) = nnl(ivx)-1 - call setbits(icrdat(ncrd),4,8,mod(ivx,16)) - if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) - icrdorn(ncrd) = 0 -c -c Get note name -c - call getchar(lineq,iccount,charq) -c -c Get optional inputs -c -34 call getchar(lineq,iccount,durq) -c -c When chord note is done, will get ' ', making ndx=0, so go past this block -c - ndx = index('fsn+-<>12345678reicd',durq) - if (ndx .gt. 0) then - if (ndx .le. 3) then - if (.not.btest(icrdat(ncrd),19)) then - icrdat(ncrd) = ibset(icrdat(ncrd),19) - icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20)) - else - icrdat(ncrd) = ibset(icrdat(ncrd),22) - end if - else if (durq .eq. 'd') then -c -c Get dot on chord note in xtup. Assume +n+n -c - icrdat(ncrd) = ibset(icrdat(ncrd),26) - call getchar(lineq,iccount,durq) - iccount=iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (durq .eq. '+') then - icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64) - else - icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64) - end if - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift specified also -c - iccount=iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (dumq .eq. '+') then - ifnum = nint(fnum*10)+64 - else - ifnum = -nint(fnum*10)+64 - end if - else - ifnum = 64 - end if - icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7)) - iccount = iccount-1 -c iccount = iccount+4 -c -c -c - else if (ndx .eq. 19) then -c -c Set flags for cautionary accidental -c - icrdat(ncrd) = ibset(icrdat(ncrd),31) - iornq(ivx,nnl(ivx)-1) = - * ibset(iornq(ivx,nnl(ivx)-1),31) - else if (ndx .le. 7) then -c -c +/-/ Check whether octave or accidental shift -c - nactmp = 0 - call chkpm4ac(lineq,iccount,nactmp,moved) - if (moved) then -c -c Transfer accidental shift values -c - call setbits(icrdot(ncrd),6,14, - * igetbits(nactmp,6,4)) - call setbits(icrdot(ncrd),7,20, - * igetbits(nactmp,7,10)) - else - if (durq .eq. '+') then - lastlev = lastlev+7 - else if (durq .eq. '-') then - lastlev = lastlev-7 - end if - end if - else if (durq .eq. 'e') then - icrdat(ncrd) = ibset(icrdat(ncrd),23) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) - else if (durq .eq. 'r') then - icrdat(ncrd) = ibset(icrdat(ncrd),24) - irest(ivx,nnl(ivx)-1) = - * ibset(irest(ivx,nnl(ivx)-1),20) - else if (durq .eq. 'i') then -c -c Midi-only accidental -c - icrdat(ncrd) = ibset(icrdat(ncrd),27) - else -c -c must be a number, save it in ioct -c - numnum = 1 - ioct = ndx-7 - end if - go to 34 - end if - if (numnum .eq. 1) then - lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) - else - lastlev = lastlev-3 - * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) - end if - icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12)) - do 41 npreslur = npreslur , 1 , -1 -c -c Set note level for preslur on chord note in xtup -c - call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) -c -c Following lines copied from loop for non-xtup, chord note, preslur -c Initially I assigned the slur(s) to next note, so fix. -c - islur(ivx,nnl(ivx)) = ibclr(islur(ivx,nnl(ivx)),0) - islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),0) - isdat2(nsdat-npreslur+1) = - * ibset(isdat2(nsdat-npreslur+1),0) - call setbits(isdat1(nsdat-npreslur+1),8,3, - * igetbits(isdat1(nsdat-npreslur+1),8,3)-1) -41 continue - go to 7 - else if (charq .eq. '?') then -c -c Arpeggio -c - if (btest(ipl(ivx,nnl(ivx)-1),10)) then -c -c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note -c of chord, will not set icrdat(25), but iornq(27) -c - icrdat(ncrd) = ibset(icrdat(ncrd),25) - else - iornq(ivx,nnl(ivx)-1) = ibset(iornq(ivx,nnl(ivx)-1),27) - end if -c -c Check for shift -c - call getchar(lineq,iccount,durq) - if (durq .eq. ' ') then - iccount = iccount-1 - else -c -c durq must be "-" -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 -c -c record the shift -c - NumArpShift = NumArpShift+1 - IvArpShift(NumArpShift) = ivx - IpArpShift(NumArpShift) = nnl(ivx)-1 - ArpShift(NumArpShift) = fnum - end if - go to 7 - else if (charq .eq. 'D') then - call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1), - * iornq(ivx,nnl(ivx)-1),lineq,iccount) - go to 7 -c -c 140215 Allow clef change inside xtuplet. With normal code, came out one -c note too late, so try making it come earlier. -c - else if (charq .eq. 'C') then -c -c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. -c - if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1 -c -c 140218 Need to get time differently inside xtup, since itsofar doesn't get -c updated until after xtup is done -c - nodurt = ifnodur(nnodur,dotq) - tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) - isl = ibset(islur(iv,nnl(iv)),11) - call getchar(lineq,iccount,durq) -c -c Store clef number, or 7 if clef number = 9 (French violin clef) -c - isl = ior(isl,ishft(min(numclef(durq),7),12)) - ncmidcc(iv,ncc(iv)) = ncmidf(durq) - if (durq .eq. '8') then - ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) - iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) - end if -c -c Set marker on note with lowest voice # starting at same time. -c - if (iv .eq. 1) then - isl = ibset(isl,15) - else - do 70 iiv = 1 , iv -c nnliiv = nnl(iiv) - nnliiv = nnl(iiv)-1 - if (iiv .eq. iv) nnliiv = nnliiv+1 - itother = 0 - do 71 iip = 1 , nnliiv - if (itother .lt. itsofar(iv)) then - itother = itother+nodur(iiv,iip) - go to 71 - else if (itother .eq. itsofar(iv)) then - islur(iiv,iip) = ibset(islur(iiv,iip),15) - go to 72 - end if -71 continue -70 continue -72 continue - end if -c -c Need 'or' since may have set bit 15 in the above loop -c -c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) - islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv))) - go to 7 -c+++ - else if (charq .eq. ']') then -c -c Multiplicity up-down, must have '][ ' -c - islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),20) - iccount = iccount+2 - go to 7 -cc+++ - end if -c -c End of loop for xtup options. If here, charq must be a (non-crd) note name. -c or rest -c - if (charq .eq. 'r') then -c -c Rest in xtup -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0) - if (index('+-b',lineq(iccount+1:iccount+1)) .gt. 0) then - call getchar(lineq,iccount,durq) - if (durq .eq. 'b') then -c -c Blank rest in middle of xtup -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29) - else -c -c Override height of embedded xtup rest -c - ipm = index('- +',durq)-2 - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) - iccount = iccount-1 - end if - else if (ivx .le. nv) then - nolev(ivx,nnl(ivx)) = 0 - else - nolev(ivx,nnl(ivx)) = 2 - end if - else -c -c Counter for non-rests -c - nnb = nnb+1 - end if - notcrd = .true. -8 call getchar(lineq,iccount,durq) - if (durq .ne. ' ') then - if (index('+-<>',durq) .gt. 0) then -c -c Accidental horizontal shift -c - call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved) - if (.not.moved) then - if (durq.eq.'+') then - lastlev = lastlev+7 - else if (durq.eq.'-') then - lastlev = lastlev-7 - end if - end if - else if (index('fsn',durq) .gt. 0) then -c -c if (nacc(ivx,nnl(ivx)) .eq. 0) then -c May have set other bits earlier - if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then -c -c No accid set yet -c -c nacc(ivx,nnl(ivx)) = index('fsn',durq) - nacc(ivx,nnl(ivx)) = - * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) - else -c -c Symbol must be repeated, so it's a double -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2) - end if - else if (durq .eq. 'i') then -c -c Set flag for midi-only accidental -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17) - - else if (durq .eq. 'c') then -c -c Set flags for cautionary accidental -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31) - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) - else if (index('ul',durq) .gt. 0) then -c -c Force stem direction for non-beamed xtup note -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30) - if (durq .eq. 'u') islur(ivx,nnl(ivx)) = - * ibset(islur(ivx,nnl(ivx)),17) - else if (durq .eq. 'e') then -c -c Left-shift main xtup note -c - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) - else if (durq .eq. 'r') then -c -c Right-shift main xtup note -c - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) - else if (index('DF',durq) .gt. 0) then -c -c Double an xtup note to make an unequal xtup -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = - * ibset(nacc(ivx,nnl(ivx)),19) - ndoub = ndoub+1 - else if (durq .eq. 'd') then -c -c Dotted xtup note -c -c if (btest(irest(ivx,nnl(ivx))-1,2)) then - if (btest(irest(ivx,nnl(ivx)-1),2)) then -c -c Move dot on 2nd note of 2-note tremolo -c - ndotmv(ivx) = ndotmv(ivx)+1 - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19) - call g1etchar(lineq,iccount,durq) ! Will be + or - - iccount = iccount+1 - call readnum(lineq,iccount,dumq, - * updot(ivx,ndotmv(ivx))) - if (durq .eq. '-') updot(ivx,ndotmv(ivx)) = - * -updot(ivx,ndotmv(ivx)) - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift also -c - call readnum(lineq,iccount,durq, - * rtdot(ivx,ndotmv(ivx))) - if (durq .eq. '-') rtdot(ivx,ndotmv(ivx)) - * = -rtdot(ivx,ndotmv(ivx)) - end if - iccount = iccount-1 - else -c -c Dot for 3:1 pair of xtup notes -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) - end if - else -c -c Must be an octave number -c - lastlev = ifnolev(charq,ichar(durq)-48 - * ,iTransAmt(instno(iv))) - end if - go to 8 - end if - if (itup .lt. ntup) then -c -c Last note is handled *after* flowing out of the xtup if block, but still -c within block for a note-rest. Set note level now (rest already done). -c Could have problem here if rests & doubled notes are combined in xtup, -c since might exit the loop at the wrong place. Worry about it later. -c - if (.not.btest(irest(ivx,nnl(ivx)),0)) then - lastlev = lastlev-3+mod(ifnolev(charq,10, - * iTransAmt(instno(iv)))-lastlev+3,7) - nolev(ivx,nnl(ivx)) = lastlev - end if - nodur(ivx,nnl(ivx)) = 0 - do 42 npreslur = npreslur , 1 , -1 -c -c Set note level for preslur on internal xtup note -c - call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) -42 continue - end if - if (itup .eq. ntup-ndoub) go to 12 -6 continue -12 continue - if (ornrpt) then - iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)), - * iand(iornq(ivx,nnl(ivx)-1),10026991)) - if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then -c -c This is a trill (bit 7 or 15) so must dup the parameters -c - ntrill = ntrill + 1 - ivtrill(ntrill) = ivx - iptrill(ntrill) = nnl(ivx) - xnsktr(ntrill) = xnsktr(ntrill-1) - end if - end if -c -c End of if-block for xtuplet input -c - else if (durq .eq. 'm') then -c -c Multi-bar rest: next 1 or two digits are # of bars. -c For some purposes, pretend its one bar only -c - nodur(ivx,nnl(ivx)) = lenbar - ibarmbr = nbars+1 - mbrest = 0 - xb4mbr = 0. -20 call getchar(lineq,iccount,durq) - if (ichar(durq).ge.48.and.ichar(durq).le.57) then - mbrest = 10*mbrest+ichar(durq)-48 - go to 20 - end if -c -c durq will either be blank or 'n' - if (durq .eq. 'n') then -c -c Get new height -c - iplmi = 1 - call g1etchar(lineq,iccount,durq) - if (durq .eq. '-') then - iplmi = -1 - iccount = iccount+1 - end if - call readnum(lineq,iccount,durq,hgt) - mbrhgt = nint(iplmi*hgt) - newmbrhgt = .true. - end if - else if (index('ul',durq) .gt. 0) then -c -c Set stem flipper -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30) - if (durq .eq. 'u') islur(ivx,nnl(ivx)) = - * ibset(islur(ivx,nnl(ivx)),17) - go to 2 - else if (durq .eq. 'a') then -c -c "Alone", i.e., prohibit beam -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),18) - go to 2 - else if (durq .eq. 'r') then -c -c Right offset by one notehead -c - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) - go to 2 - else if (durq .eq. 'e') then -c -c Left offset by one notehead -c - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) - go to 2 - else if (index('LS',durq) .gt. 0) then -c -c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 -c Set mult(27). Map value to 0 to 63, store in mult(10-15). Later convert to -c interbeams = internotes*2/3. -c -c - isign = 1 - if (durq .eq. 'S') isign = -1 - mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27) - call getchar(lineq,iccount,durq) - if (durq .eq. ':') then -c -c End stickyS. Grab data now from prior note, since we have to shut off stickyS. -c - call setbits (mult(ivx,nnl(ivx)),6,10, - * igetbits(mult(ivx,nnl(ivx)-1),6,10)) - stickyS = .false. - go to 2 - end if -c -c If durq .ne. ':' then iccount is now on the start of the number -c - call readnum(lineq,iccount,durq,dum) - dum = isign*dum - call setbits (mult(ivx,nnl(ivx)),6,10,nint((dum+4.)*2)) - if (durq .eq. ':') then - stickyS = .true. - else - iccount = iccount-1 - end if - go to 2 - else if (durq .eq. ',') then -c -c 2:1 pattern -c - idotform = 3 -c -c Now flow to duration setting, as if durq=' ' -c - else if (durq .eq. '.') then -c -c Dotted pattern. Close out note. Mult time by 3/4. -c Set time for next note to 1/4. Start the note. -c - idotform = 1 - else if (durq .eq. 'o') then -c -c Suppress rest centering -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),25) - go to 2 - else if (durq .eq.'L') then -c -c With keyboard rest option, look left -c -c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1) - go to 2 - else if (index('DF',durq) .gt. 0) then -c -c Double note for xtup. Must check here in case "D" came before "x" or on -c last note of xtup. Need to flag it in pmxa since affects horiz. spacing. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) - if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = - * ibset(nacc(ivx,nnl(ivx)),19) - go to 2 - else if (durq .eq. 'A') then -c -c Accidental option -c - call getchar(lineq,iccount,durq) -c - if (durq .eq. 'o') then -c -c Ordered accidentals in a chord. Mark the main note. -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),28) - else -c -c Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),29) - iccount = iccount-1 - end if - go to 2 - else if (durq .eq. 'T') then - call getchar(lineq,iccount,durq) - multtrem = index('1234',durq) - if (multtrem .eq. 0) then - iccount = iccount-1 - multtrem = 1 - end if - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4) - call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1) - go to 2 - else if (durq .ne. ' ') then - print*,'Illegal character in note: ',durq,', ivx,nn:', - * ivx,nnl(ivx) - call stop1() - end if -c -c Done with note/rest options. Set level and duration. -c - if (.not.btest(irest(ivx,nnl(ivx)),0)) then - if (numnum .eq. 2) then - lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) - nolev(ivx,nnl(ivx)) = lastlev - else - lastlev = lastlev-3 - * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) - nolev(ivx,nnl(ivx)) = lastlev - end if - do 43 npreslur = npreslur , 1 , -1 -c -c Set level for preslur on normal note, non-chord -c - call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) -43 continue -c -c Only matters if last note, non-rest of xtuplet -c - nnb = nnb+1 - end if -c -c Set flag for unbeamed xtup if it just has 1 note -c - if (inxtup .and. nnb.eq.1) then - islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18) - end if - if (idotform .gt. 0) then - if (idotform .eq. 1) then - nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)*3/2 - else if (idotform .eq. 2) then - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3 - else if (idotform .eq. 3) then - nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq) - else if (idotform .eq. 4) then - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2 - end if - else if (btest(islur(ivx,nnl(ivx)),19)) then -c -c Set duration of full-bar rest as pause -c - nodur(ivx,nnl(ivx)) = lenbar -c -c Use a one-line function to set nnodur. It gives inverse of ifnodur. -c - nnodur = index('62514x0x37', - * chax(48+int(log(.1+lenbar)/.69315)))-1 - else if (ibarmbr.ne.nbars+1) then - nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq) - if (btest(islur(ivx,nnl(ivx)),3)) - * nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6 - end if - if (shifton .and. .not.btest(irest(ivx,nnl(ivx)),16)) then -c -c Shift is on, and this is not first shifted note. Check for duration change -c - if (nodur(ivx,nnl(ivx)) .ne. nodur(ivx,nnl(ivx)-1)) then -c -c Must stop and restart the offset. -c - irest(ivx,nnl(ivx)-1) = ibset(irest(ivx,nnl(ivx)-1),17) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),16) - nudoff(ivx) = nudoff(ivx)+1 - udoff(ivx,nudoff(ivx)) = udoff(ivx,nudoff(ivx)-1) - end if - end if - itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) - if (autofbon .and. tautofb.gt.tol .and. fbon) then -c -c Check to see if need to terminate auto forced beam -c - if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then -c -c Terminate autofb -c - t2fb(ivx,nfb(ivx)) = itsofar(ivx) - fbon = .false. - end if - end if - if (mod(itsofar(ivx)-lenb0,lenbar) .eq. 0) then -c -c Finished a bar -c - nbars = nbars+1 - nib(ivx,nbars) = nnl(ivx) - if (firstgulp.and.lenb0.ne.0.and.nbars.eq.1) then -c -c Just finished the pickup bar for this voice. -c - lenbar = lenb1 - end if - end if - if (idotform .eq. 1) then - call getchar(lineq,iccount,charq) - idotform = 2 - numnum = 1 - go to 28 - else if (idotform .eq. 3) then - call getchar(lineq,iccount,charq) - idotform = 4 - numnum = 1 - go to 28 - end if -c -c End of sub block for note-rest -c - else if (charq .eq. 'z') then -c -c Chord note. Must have note name, may have octave#,+,-,s,f,n,d -c Actually the 'd' is not used, since time value comes from -c basic note. Unless dot is to be shifted! -c Doesn't increase # of notes, so must handle separately -c ncrd: index of crd -c Set bit 10 of ipl on main note as flag -c Bits in icrdat: -c 0-7 ip within voice -c 8-11 ivx -c 12-18 note level -c 19 accidental? -c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) -c 23 shift left -c 24 shift right -c 25 arpeggio start or stop -c 26 flag for moved dot (here, not icrdot, since this is always reset!) -c 27 Midi-only accidental -c 29 Tag for accidental shift...means add to autoshifts. -c 31 Cautionary accidental -c -c Bits in icrdot: -c 0-6 10*abs(vertical dot shift in \internote) + 64 -c 7-13 10*abs(horizontal dot shift in \internote) + 64 -c 14-19 vert accidental shift-32 -c 20-26 20*(horiz accidental shift+3.2) -c 27-29 top-down level rank of chord note w/accid. Set in crdaccs. -c -c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. -c - ncrd = ncrd+1 - ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),10) - numnum = 0 -c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) - icrdat(ncrd) = nnl(ivx) - call setbits(icrdat(ncrd),4,8,mod(ivx,16)) - if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) - icrdot(ncrd) = 0 - icrdorn(ncrd) = 0 -c -c Get note name -c - call getchar(lineq,iccount,charq) -c -c Get optional inputs -c -25 call getchar(lineq,iccount,durq) -c ndx = index('fsn+-<>12345678rediA',durq) - ndx = index('fsn+-<>12345678rediAc',durq) - if (ndx .eq. 20) then -c -c Expect +|-|<|> , set tag, loop -c - icrdat(ncrd) = ibset(icrdat(ncrd),29) - go to 25 - else if (ndx .gt. 0) then - if (ndx .le. 3) then - if (.not.btest(icrdat(ncrd),19)) then - icrdat(ncrd) = ibset(icrdat(ncrd),19) - icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20)) - else - icrdat(ncrd) = ibset(icrdat(ncrd),22) - end if - else if (ndx .eq. 21) then -c -c Set flags for cautionary accidental -c - icrdat(ncrd) = ibset(icrdat(ncrd),31) - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) - else if (ndx .le. 7) then -c -c +/-/ Check whether octave or accidental shift -c - nactmp = 0 - call chkpm4ac(lineq,iccount,nactmp,moved) - if (moved) then -c -c Transfer accidental shift values -c - call setbits(icrdot(ncrd),6,14,igetbits(nactmp,6,4)) - call setbits(icrdot(ncrd),7,20,igetbits(nactmp,7,10)) - else - if (durq .eq. '+') then - lastlev = lastlev+7 - else if (durq .eq. '-') then - lastlev = lastlev-7 - end if - end if - else if (durq .eq. 'e') then - icrdat(ncrd) = ibset(icrdat(ncrd),23) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) - else if (durq .eq. 'r') then - icrdat(ncrd) = ibset(icrdat(ncrd),24) - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) - else if (durq .eq. 'i') then -c -c Midi-only accidental on chord note -c - icrdat(ncrd) = ibset(icrdat(ncrd),27) - else if (durq .eq. 'd') then -c -c Must keep 'd' optional (backward compatibility), unless it is moved! -c - if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then -c -c move a dot, unless next char is not part of a number -c - if (index('0123456789.',lineq(iccount+2:iccount+2)) - * .eq. 0) go to 25 - icrdat(ncrd) = ibset(icrdat(ncrd),26) - call getchar(lineq,iccount,durq) - iccount=iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (durq .eq. '+') then - icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64) - else - icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64) - end if - if (index('+-',dumq) .gt. 0) then -c -c Vertical shift specified also -c - iccount=iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (dumq .eq. '+') then - ifnum = nint(fnum*10)+64 - else - ifnum = -nint(fnum*10)+64 - end if - else - ifnum = 64 - end if - icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7)) - iccount = iccount-1 - end if - else -c -c must be a single digit, save it in ioct -c - numnum = 1 - ioct = ndx-7 - end if - go to 25 - end if - if (numnum .eq. 1) then - lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) - else - lastlev = lastlev-3 - * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) - end if - icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12)) - do 44 npreslur = npreslur , 1 , -1 - call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) -c -c Set level for chord note. -c Initially I assigned the slur(s) to next note, so fix. -c - islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),0) - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),0) - isdat2(nsdat-npreslur+1) = ibset(isdat2(nsdat-npreslur+1),0) - call setbits(isdat1(nsdat-npreslur+1),8,3, - * igetbits(isdat1(nsdat-npreslur+1),8,3)-1) -44 continue - if (notcrd) then -c -c This is the first chord note in this chord. -c - minlev = min(nolev(ivx,nnl(ivx)),lastlev) - maxlev = max(nolev(ivx,nnl(ivx)),lastlev) - else - minlev = min(minlev,lastlev) - maxlev = max(maxlev,lastlev) - end if - notcrd = .false. - else if (charq .eq. 'G') then - call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, - * lastlev,iv,nv) -c -c Grace, comes *before* main note: -c UNLESS there's an 'A' or 'W' after the 'G' -c ngrace = # of grace note groups so far in block -c ivg(ngrace), ipg(ngrace) -c nng(ngrace) = # of notes in this group: default = 1 -c ngstrt(ngrace) = starting position in nolevg of levels for this grace -c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' -c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' -c slurg(ngrace) = logical for slur; default F, input 's' -c slashg(ngrace) = T if slash; default is F, input 'x' -c These data MUST precede note name of first note -c nolevg, naccg: lists of levels and accid's, indexed as described above. -c - else if (charq .eq. sq) then -c -c Literal TeX string -c - call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) - else if (charq .eq. '"') then -c -c pmxlyr string. Expand "..." to \pmxlyr{...}\ -c - if (.not. inputmlyr) then - ictemp = 0 - lineqt = sq//sq//sq//'input musixlyr '//sq - call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) - inputmlyr = .true. - end if - call dopmxlyr(lineq,iccount) - charq = sq - call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) - else if (charq .eq. 'o') then -c -c Ornament on non-xtup note. Symbol must come AFTER the affected note -c - if (notcrd) then - nole = nolev(ivx,nnl(ivx)) - else - nole = iand(127,ishft(icrdat(ncrd),-12)) - end if - call getorn(lineq,iccount,iornq(ivx,nnl(ivx)), - * iornq(ivx,0),ornrpt,noffseg,nnl(ivx),ivx, - * .true.,notcrd,nole) - else if (index('st(){}',charq) .gt. 0) then - nnlivx = nnl(ivx) - if (charq.eq.'(' .or. charq.eq.'{') then -c -c Detect preslur on normal non-chord note -c - nnlivx = nnlivx+1 - npreslur = npreslur+1 - end if - islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0) - if (charq.eq.'t') - * islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),1) - if (ivx .le. nv) then - kv = 1 - else - kv = 2 - end if - if (fontslur) then - call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3, - * nsdat,notcrd,nolev(ivx,nnlivx),charq) - else - call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3, - * isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq) - end if - else if (charq .eq. '?') then -c -c Arpeggio -c - if (btest(ipl(ivx,nnl(ivx)),10)) then -c -c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note -c of chord, will not set icrdat(25), but iornq(27) -c - icrdat(ncrd) = ibset(icrdat(ncrd),25) - else - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),27) - end if -c -c Check for shift -c - call getchar(lineq,iccount,durq) - if (durq .eq. ' ') then - iccount = iccount-1 - else -c -c durq must be "-" -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 -c -c record the shift -c - NumArpShift = NumArpShift+1 - IvArpShift(NumArpShift) = ivx - IpArpShift(NumArpShift) = nnl(ivx) - ArpShift(NumArpShift) = fnum - end if - else if (index('0123456789#-nx_',charq) .gt. 0) then -c -c We have a figure. Must come AFTER the note it goes under -c - - ivf = 1 - if (ivx .gt. 1) then - if (ivxfig2 .eq. 0) then - ivxfig2 = ivx - else if (ivx .ne. ivxfig2) then - print* - print*,'Figures not allowed in >1 voice above first' - stop - end if - ivf = 2 - end if - nfig1 = nfigs(ivf)+1 - call getfig(itoff(ivf,nfig1),charq,lineq,iccount, - * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx), - * nodur(ivx,nnl(ivx)),figq(ivf,nfig1), -c * ivupfig(ivf,nfig1),nfigs(ivf)) - * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf)) - else if (charq .eq. '[') then -c -c Start forced beam. Record barno & time since start of inp. blk. Set signal -c - nfb(ivx) = nfb(ivx)+1 - fbon = .true. - ulfbq(ivx,nfb(ivx)) = 'x' - t1fb(ivx,nfb(ivx)) = itsofar(ivx) - nadj = 0 - if (autofbon) then - autofbon = .false. - end if -17 call getchar(lineq,iccount,charq) - if (index('ulf',charq) .gt. 0) then - ulfbq(ivx,nfb(ivx)) = charq - go to 17 - else if (charq .eq. 'j') then -c -c Continuing a jumped beam here -c - irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),24) -c -c Set flag to watch for END of this forced beam, so can set flag rest(30) on -c NEXT note as signal to start a new notes group there. -c - isbj2 = .true. - go to 17 - else if (charq .eq. 'h') then - islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),2) - go to 17 - else if (charq .eq. 'm') then -c -c Force multiplicity. Next input is digit -c - call getchar(lineq,iccount,charq) - islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) - call setbits(islur(ivx,nnl(ivx)+1),3,22,ichar(charq)-48) - go to 17 - else if (charq .eq. ':') then -c -c Start auto forced beam pattern -c - autofbon = .true. -c -c When forced later beam ends, check whether tautofv <=0; if so set it. -c - tautofb = -itsofar(ivx) - t1autofb = itsofar(ivx) - go to 17 - else if (charq .ne. ' ') then -c -c Must be '+/-' for height or slope shift -c - nadj = nadj+1 -c -c nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - iadj = nint(fnum) - if (charq .eq. '-') iadj = -iadj - if (nadj .eq. 1) then -c -c This is a level shift. Note if 0 was entered, iadj = 30 -c - call setbits(ipl(ivx,nnl(ivx)+1),6,11,iadj+30) - else if (nadj .eq. 2) then -c -c Must be a slope shift -c - call setbits(ipl(ivx,nnl(ivx)+1),6,17,iadj+30) - else -c -c Beam-thk fine tune -c - call setbits(islur(ivx,nnl(ivx)+1),2,27,iadj) - end if - go to 17 - end if - else if (charq .eq. ']') then - if (autofbon .and. tautofb.lt.tol) then - tautofb=itsofar(ivx)+tautofb - end if - call getchar(lineq,iccount,charq) - if (index('j ',charq) .gt. 0) then -c -c Since ']' comes AFTER note, itsofar has been updated. Set ending signal. -c - t2fb(ivx,nfb(ivx)) = itsofar(ivx) - fbon = .false. - if (charq .eq. 'j') then - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),23) - end if - if (isbj2) then -c -c This is the end of a fb segment of a jump beam. Set flag on NEXT note to -c force start of new notes group, provided this is not last note in bar. -c - if (mod(itsofar(ivx),lenbar) .ne. 0) - * irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),30) - isbj2 = .false. - end if - else if (charq .eq. '[') then -c -c Multiplicity down-up signal -c - islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),20) - else if (charq .eq. '-') then -c -c Set signals for gap in single-slope beam [...]-[...] -c - nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),20) - nacc(ivx,nnl(ivx)+1) = ibset(nacc(ivx,nnl(ivx)+1),21) -c -c Next two characters must be "[ ". Skip over them. -c - iccount = iccount+2 - end if - else if (charq .eq. 'D') then - call getdyn(ivx,nnl(ivx),irest(ivx,nnl(ivx)), - * iornq(ivx,nnl(ivx)),lineq,iccount) - else if (charq .eq. 'h') then -c -c Heading or height. For heading, only OK if at start of block -c Check whether at beginning of a block -c - if (iv.ne.1 .or. nnl(1).ne.0) then - print*,'You entered "h" not at beginning of block' - call stop1() - end if - call getchar(lineq,iccount,durq) - ihdvrt = 0 - if (index('+-',durq) .gt. 0) then -c -c Vertical offset -c - iccount = iccount+1 - call readnum(lineq,iccount,charq,fnum) - ihdvrt = fnum+.1 - if (durq .eq. '-') ihdvrt = -ihdvrt - durq = charq - end if - if (durq .ne. ' ') then -c -c Height symbol. Read past (until next blank) -c -3 call getchar(lineq,iccount,durq) - if (durq .ne. ' ') go to 3 - else -c -c Set flag for header & read it in -c - ihdht = 16 - call getbuf(headrq) - iccount = 128 - end if - else if (charq .eq. 'L') then -c -c Linebreak, already handled some in pmxa, but need to get data for -c shortened line or coda lengths -c - iccount = iccount+1 - if (lineq(iccount:iccount) .eq. 'C') then -c -c Coda, get length -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,codafrac) - ishort = 3 - if (durq .eq. 'n') nocodabn = .true. - return - end if -c -c Get line number -c - call readnum(lineq,iccount,durq,fmovbrk) -48 continue ! Allow transfer up from below if S follows M - if (durq .eq. 'S') then -c -c Shortened line, get shortening fraction -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,shortfrac) - ishort = 1 - codafrac = 0. - end if -c -c Begin check for movement break -c - if (durq .eq. 'P') then - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - end if - if (durq .eq. 'M') then - movbrk = nint(fmovbrk) - movgap = 0 - parmov = -1. - call getchar(lineq,iccount,durq) -31 if (durq .eq. '+') then -c -c Get vertical space (\internotes) -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - movgap = nint(fnum) - go to 31 - else if (durq .eq. 'i') then - iccount = iccount+1 - call readnum(lineq,iccount,durq,parmov) - go to 31 - else if (durq .eq. 'c') then - nobar1 = .true. - call getchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'r') then -c -c "rename" can be set on or off. -c - call getchar(lineq,iccount,durq) - rename = durq.eq.'+' - call getchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'n') then -c -c Change # of voices. Input ninow, iiorig(1...ninow). Will use names, -c staves per inst. and clefs corr. to iiorig in original list of instruments. -c - nvold = nv - nv = 0 - rename = .true. - call getchar(lineq,iccount,durq) - if (durq .eq. ':') then - iccount = iccount+2 - read(lineq(iccount-1:iccount),'(i2)')ninow - else - ninow = ichar(durq)-48 - end if - iiv = 0 - do 63 iinow = 1 , ninow - call getchar(lineq,iccount,durq) - if (durq .eq. ':') then - iccount = iccount+2 - read(lineq(iccount-1:iccount),'(i2)')iiorig(iinow) - else - iiorig(iinow) = ichar(durq)-48 - end if - nspern(iinow) = nsperi(iiorig(iinow)) - nv = nv+nspern(iinow) - sepsymq(iiv+nspern(iinow)) = '&' - if (nspern(iinow) .gt. 1) then - do 64 iis = 1 , nspern(iinow)-1 - sepsymq(iiv+iis) = '|' -64 continue - end if - iiv = iiv+nspern(iinow) -63 continue -c -c 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement -c -c if (islast) then -c if (ninow .lt. 10) then -c write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' -c else -c write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' -c end if -c end if - if (nv.eq.1 .and. nvold.gt.1) then - if (islast) write(11,'(a)')sq//'nostartrule' - else if (nv.gt.1 .and. nvold.eq.1) then - if (islast) write(11,'(a)')sq//'startrule' - end if - iiv = 0 - do 60 iinow = 1 , ninow - do 61 iis = 1 , nspern(iinow) - iiv = iiv+1 -c -c May not really need to re-enter clefs, but it's easier to program since -c clef names are not saved but are needed in newvoice to set ncmidcc. -c - call getchar(lineq,iccount,clefq(iiv)) - call newvoice(iiv,clefq(iiv),.true.) - if (nspern(iinow) .eq. 1) then - hdlndq = chax(48+numclef(clefq(iiv))) - lclf = 1 - else if (iis .eq. 1) then - hdlndq = '{'//chax(48+numclef(clefq(iiv))) - lclf = 2 - else if (iis .lt. nspern(iinow)) then - hdlndq = hdlndq(1:lclf)//chax(48+numclef(clefq(iiv))) - lclf = lclf+1 - else - hdlndq = - * hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))//'}' - lclf = lclf+2 - end if -61 continue -c -c setstaffs & setclef go by instrument, not voice -c - if (islast) then - if (iinow .lt. 10) then - write(11,'(a)')sq//'setstaffs' - * //chax(48+iinow)//chax(48+nspern(iinow))//'%' - write(11,'(a)')sq//'setclef'//chax(48+iinow) - * //hdlndq(1:lclf)//'%' - if (fullsize(iiorig(iinow)).gt.0.9) then - write(11,'(a)')sq//'setsize'//chax(48+iinow) - * //sq//'normalvalue%' -c -c 140526 Account for staff size specs when noinst changes. May be confusion -c here if more than one staff per instrument -c - else if (fullsize(iiorig(iinow)).gt..7) then - write(11,'(a)')sq//'setsize'//chax(48+iinow) - * //sq//'smallvalue%' - else - write(11,'(a)')sq//'setsize'//chax(48+iinow) - * //sq//'tinyvalue%' - end if - else - write(11,'(a11,i2,a)')sq//'setstaffs{',iinow, - * '}'//chax(48+nspern(iinow))//'%' - write(11,'(a9,i2,a)')sq//'setclef{',iinow, - * '}'//hdlndq(1:lclf)//'%' - end if - end if -60 continue -c -c Loop back up, this may not be last option in M. Note flow out if durq=' ' -c - call getchar(lineq,iccount,durq) - go to 31 - else if (durq .eq. 'S') then - go to 48 - end if -c -c Write instrument names -c - if (.not.rename) then - do 62 iinst = 1 , ninow - if (islast) then - if (iinst .lt. 10) then - write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%' - else - write(11,'(a9,i2,a4)')sq//'setname{',iinst,'}{}%' - end if - end if -62 continue - else - do 65 iinst = 1 , ninow - if (islast) then - if (iinst .lt. 10) then - write(11,'(a8,i1,a)')sq//'setname',iinst,'{'// - * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%' - else - write(11,'(a9,i2,a)')sq//'setname{',iinst,'}{'// - * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%' - end if - end if -65 continue - if (ishort.ne.4.and.ishort.ne.2) rename = .false. -c -c Reset later and rewrite setname{} in shortening case mcm, since if -c written here it will be inside {{...}} and will be ignored -c - end if - end if - else if (charq .eq.'|' ) then -c -c End of bar symbol. Check about end of bar hardspace. -c - if (btest(iornq(ivx,nnl(ivx)+1),26)) then -c -c There was a hardspace followed by a bar line. Remove it from the hardspace -c list, store with shifts instead, set special bit. Need to repeat this code -c at '/'. -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18) - nudoff(ivx) = nudoff(ivx)+1 - udoff(ivx,nudoff(ivx)) = udsp(nudsp) - nudsp = nudsp-1 - iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26) - end if - else if (index('wS',charq) .gt. 0) then -c -c Width symbol or new nsyst. Read past (until blank) -c -4 call getchar(lineq,iccount,durq) - if (durq .ne. ' ') go to 4 - else if (charq .eq. 'l') then -c -c Lower string. Only OK if at start of block -c Check whether at beginning of a block -c - if (iv.ne.1 .or. nnl(1).ne.0) then - print*,'You entered "l" not at beginning of block' - call stop1() - end if -c -c Set flag for lower string & read it in -c - lower = .true. - call getbuf(lowerq) - iccount = 128 - else if (charq .eq. 'm') then -c -c Meter change. Only allow at beginning of block. -c mtrnuml, mtrdenl (logical) and p (printable) will be input. -c mtrnuml=0 initially. (In common) -c -c Check whether at beginning of a block -c - if (iv.ne.1 .or. nnl(1).ne.0) then - print*,'You entered "m" not at beginning of block' - call stop1() - end if - call readmeter(lineq,iccount,mtrnuml,mtrdenl) - call readmeter(lineq,iccount,mtrnmp,mtrdnp) - lenbeat = ifnodur(mtrdenl,'x') - if (mtrdenl .eq. 2) lenbeat = 16 - lenbar = mtrnuml*lenbeat - if (mtrdenl .eq. 2) lenbar = lenbar*2 - lenb1 = lenbar - lenb0 = 0 - if (ismidi) call midievent('m',mtrnuml,mtrdenl) - else if (charq .eq. 'C') then -c -c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. -c - if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 - tcc(iv,ncc(iv)) = itsofar(iv) - isl = ibset(islur(iv,nnl(iv)+1),11) - call getchar(lineq,iccount,durq) -c -c Store clef number, or 7 if clef number = 9 (French violin clef) -c - isl = ior(isl,ishft(min(numclef(durq),7),12)) - ncmidcc(iv,ncc(iv)) = ncmidf(durq) - if (durq .eq. '8') then - ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) - iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) - lastlev = lastlev+7 - if (nnl(iv).eq.0) then - ndlev(iv,1) = ndlev(iv,1)+7 - ndlev(iv,2) = ndlev(iv,2)+7 - end if - else -c -c This won't work if you really had an octave transposition with some -c other clef. Need a check on whether prior clef was an octave clef. -c - if (iTransAmt(instno(iv)).eq.7) then - iTransAmt(instno(iv))=iTransAmt(instno(iv))-7 - lastlev = lastlev-7 - if (nnl(iv).eq.0) then - ndlev(iv,1) = ndlev(iv,1)-7 - ndlev(iv,2) = ndlev(iv,2)-7 - end if - end if - end if -c -c Set marker on note with lowest voice # starting at same time. -c - if (iv .eq. 1) then - isl = ibset(isl,15) - else - do 13 iiv = 1 , iv - nnliiv = nnl(iiv) - if (iiv .eq. iv) nnliiv = nnliiv+1 - itother = 0 - do 14 iip = 1 , nnliiv - if (itother .lt. itsofar(iv)) then - itother = itother+nodur(iiv,iip) - go to 14 - else if (itother .eq. itsofar(iv)) then - islur(iiv,iip) = ibset(islur(iiv,iip),15) - go to 15 - end if -14 continue -13 continue -15 continue - end if -c -c Need 'or' since may have set bit 15 in the above loop -c - islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) - else if (charq .eq. 'R') then -c -c Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) -c -10 call getchar(lineq,iccount,durq) -c -c Save designator in case it's a terminal Rr or Rd -c - if (durq .eq. 'l') then - islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),5) - go to 10 - else if (index('rdDbz',durq) .gt. 0) then - if (durq .eq. 'r') then - islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),6) - else if (durq .eq. 'd') then - islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),8) - else if (durq .eq. 'D') then - islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),26) - else if (durq .eq. 'b') then - islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25) - else if (durq .eq. 'z') then -c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) - ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0) - end if - rptprev = .true. - rptfq1 = durq - go to 10 - end if - else if (charq .eq. 'V') then -c -c Ending -c - nnnl = nnl(1)+1 - lvoltxt = 0 -11 call getchar(lineq,iccount,durq) - if (durq.eq.'b' .or. durq .eq.'x') then -c -c End Volta, set bit9, and bit10 on if 'b' (end w/ box) -c - islur(1,nnnl) = ibset(islur(1,nnnl),9) - if (durq .eq. 'b') islur(1,nnnl) = ibset(islur(1,nnnl),10) - go to 11 - else if (durq .ne. ' ') then -c -c Start volta; Get text -c - if (lvoltxt .eq. 0) then -c -c First character for text -c - lvoltxt = 1 - islur(1,nnnl) = ibset(islur(1,nnnl),7) - nvolt = nvolt+1 - voltxtq(nvolt) = durq - else - voltxtq(nvolt) = voltxtq(nvolt)(1:lvoltxt)//durq - lvoltxt = lvoltxt+1 - end if - go to 11 - end if - else if (charq .eq. 'B') then - bcspec = .not.bcspec - else if (charq .eq. 'P') then -c -c Page numbers. Print stuff right now. -c - npg1 = 0 -c -c Will use ltopnam to signal whether there's a centered heading -c - ltopnam = 0 - ipg1r = 0 -16 call getchar(lineq,iccount,durq) - if (ichar(durq).ge.48 .and. ichar(durq).le.57) then - npg1 = npg1*10+ichar(durq)-48 - go to 16 - else if (durq .eq. 'l') then - if (npg1.eq.0 .or. mod(npg1,2).eq.1) ipg1r = 1 - go to 16 - else if (durq .eq. 'r') then - if (npg1.gt.0 .and. mod(npg1,2).eq.0) ipg1r = 1 - go to 16 - else if (durq .eq. 'c') then -c -c Top-centered name. Assume this is last option. Read the name. -c May surround name in double quotes (to allow blanks). -c - call getchar(lineq,iccount,durq) - if (durq .eq. ' ') then - ltopnam = lenstr(cheadq,60) - else - namstrt = iccount - if (durq .eq. '"') then -c -c Using quote delimiters. -c - quoted = .true. - namstrt = namstrt+1 - else - quoted = .false. - end if - do 35 iccount = namstrt+1, 128 -c if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or. - if ((quoted .and. lineq(iccount:iccount).eq.'"' .and. - * lineq(iccount-1:iccount-1).ne.'\') .or. - * (.not.quoted .and. lineq(iccount:iccount) .eq. ' ')) - * go to 36 -c -c On exit, iccount is OK, and name is in (namstrt:iccount-1) -c -35 continue - print*,'Awww, cmon, should not be here.' - call stop1() -36 continue - ltopnam = iccount-namstrt - cheadq = lineq(namstrt:iccount-1) - end if - end if -c -c Done getting data, now assemble the command -c - if (npg1.eq.0) npg1=1 -c -c 2/23/03 Don't use \atnextline if on first page and only one system -c -c if (ipage.gt.1 .or. nsystp(1).gt.1) then - hdlndq = sq//'def'//sq//'atnextline{'//sq//'toppageno{' - lhead = 27 -c else -c hdlndq = sq//'toppageno{' -c lhead = 11 -c end if - if (npg1 .lt. 10) then -c -c Note we are overwriting the last "{" -c - write(hdlndq(lhead:lhead),'(i1)')npg1 - else if (npg1 .lt. 100) then - lhead = lhead+3 - write(hdlndq(lhead-2:lhead),'(i2,a1)')npg1,'}' - else - lhead = lhead+4 - write(hdlndq(lhead-3:lhead),'(i3,a1)')npg1,'}' - end if - hdlndq = hdlndq(1:lhead)//chax(ipg1r+48)//'{' - lhead = lhead+2 -c if (ipage.gt.1 .or. nsystp(1).gt.1) then - if (ltopnam .eq. 0) then - if (islast) write(11,'(a)')hdlndq(1:lhead)//'}}%' - else - if (islast) - * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}}%' - end if -c else -c if (ltopnam .eq. 0) then -c if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' -c else -c if (islast) -c * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' -c end if -c end if - else if (charq .eq. 'W') then -c -c Just eat the number that must follow, it was used in pmxa -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - else if (charq .eq. 'T') then - headlog = .true. - inhead = 0 - call getchar(lineq,iccount,durq) - if (durq .eq. 'i') then - call getbuf(instrq) -c -c A kluge for parts from separate score file for later movements. -c - if (instrq(1:1) .eq. ' ') headlog = .false. - cheadq = instrq(1:60) - else if (durq .eq. 't') then - call getchar(lineq,iccount,durq) -c -c Optionally can include extra vertical \internotes above inbothd -c - if (index('-+0123456789',durq) .gt. 0) then - ipm = 1 - if (index('+-',durq) .gt. 0) then -c -c Don't trust readnum to round this negative integer properly -c - iccount = iccount+1 - if (durq .eq. '-') ipm = -1 - end if - call readnum(lineq,iccount,durq,fnum) - inhead = ipm*nint(fnum) - end if - call getbuf(titleq) - else - call getbuf(compoq) - end if - inhead = inhead+inbothd - iccount = 128 - else if (charq .eq. 'A') then -c -c Accidental handling etc. -c -27 call getchar(lineq,iccount,durq) - if (durq .eq. 'r') then - if (islast) then - relacc = .true. - write(11,'(a)')sq//'relativeaccid%' - end if - else if (durq .eq. 's') then - bacfac = 1.e6 - else if (durq .eq. 'b') then - if (islast) write(11,'(a)')sq//'bigaccid%' - accfac = bacfac - else if (durq .eq. 'a') then - call getchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,fnum) - iccount = iccount-1 - else if (durq .eq. 'i') then - call getchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,tintstf) - if (.not.firstgulp) fintstf = tintstf -c -c Local corrections for first page were handled by pmxa -c - iccount = iccount-1 - else if (durq .eq. 'I') then - call getchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,gintstf) - iccount = iccount-1 - else if (durq .eq. 'd') then - lowdot = .true. - else if (durq .eq. 'o') then - continue - else if (durq .eq. 'S') then - do 50 iiv = 1 , noinst - call getchar(lineq,iccount,durq) - if (index('-s',durq) .gt. 0) then - fullsize(iiv) = 0.8 - else if (durq .eq. 't') then - fullsize(iiv) = 0.64 - else -c fullsize(ivx) = 1.0 - fullsize(iiv) = 1.0 - end if -50 continue - else if (durq .eq. 'e') then -c -c Line-spacing equalization -c - equalize = .true. -c -c The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. -c But it causes problems with some older scores and when excerpts are combined -c with LaTeX. So as of 2.352 we write it here. -c - write(11,'(a)')sq//'global'//sq//'parskip 0pt plus 12'//sq - * //'Interligne minus 99'//sq//'Interligne%' - tempq = sepsymq(1) - lentemp = 1 - do 51 iiv = 2 , nv-1 - tempq = tempq(1:lentemp)//sepsymq(iiv) - lentemp = lentemp+1 -51 continue - write(11,'(a)')sq//'def'//sq//'upstrut{'//sq//'znotes' - * //tempq(1:lentemp)//sq//'zcharnote{'//sq//'upamt}{~}' - * //sq//'en}%' - else if (durq .eq. 'v') then -c -c Toggle usevshrink -c - usevshrink = .not.usevshrink - else if (durq .eq.'p') then -c -c Postscript slurs. fontslur is already false (set in g1etnote) -c - if (.not.WrotePsslurDefaults) then -c -c Set postscrirpt slur adjustment defaults -c - write(11,'(a)')sq//'Nosluradjust'//sq//'Notieadjust' - * //sq//'nohalfties' - WrotePsslurDefaults = .true. - end if -52 continue - call g1etchar(lineq,iccount,durq) ! might be "+", "-", "h" or "l" - if (index('+-',durq) .gt. 0) then -c -c Characters to change defaults for ps slurs -c - call g1etchar(lineq,iccount,charq) ! charq will be "s,t,h,c" - if (durq .eq. '+') then - if (charq .eq. 's') then - write(11,'(a)')sq//'Sluradjust' - else if (charq .eq. 't') then - write(11,'(a)')sq//'Tieadjust' - else if (charq .eq. 'h') then - write(11,'(a)')sq//'halfties' - else - SlurCurve = SlurCurve + 1 - if (SlurCurve .gt. 3.1) then - call printl('WARNING!') - call printl - * ('Default slur curvature advanced past HH, resetting') - SlurCurve = 3 - end if - end if - else - if (charq .eq. 's') then - write(11,'(a)')sq//'Nosluradjust' - else if (charq .eq. 't') then - write(11,'(a)')sq//'Notieadjust' - else if (charq .eq. 'h') then - write(11,'(a)')sq//'nohalfties' - else - SlurCurve = SlurCurve - 1 - if (SlurCurve .lt. -1.1) then - call printl('WARNING!') - call printl( - * 'Default slur curvature decremented below f, resetting') - SlurCurve = -1 - end if - end if - end if - go to 52 ! Check for another set of default changes - else if (durq .eq. 'l') then -c -c Set optional linebreak ties -c - OptLineBreakTies = .true. - go to 52 - else if (durq .eq. 'h') then -c -c Set flag to write header special on every page -c - HeaderSpecial = .true. - go to 52 - else - iccount = iccount-1 - end if - else if (durq .eq. 'K') then -c -c Toggle keyboard rest placement flag -c - kbdrests = .not.kbdrests - else if (durq .eq. 'c') then - call g1etchar(lineq,iccount,durq) -c -c Just eat the input; it was used in pmxa -c - go to 27 - else if (durq .eq. 'V') then - bottopgap = .true. - topamt = 0. - call getchar(lineq,iccount,durq) - pmfac = index('- +',durq)-2 - call g1etchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,botamt) - botamt = botamt*pmfac - pmfac = index('- +',durq)-2 - call g1etchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,topamt) - topamt = topamt*pmfac - iccount = iccount-1 - go to 27 - end if - if (index('NR',durq) .gt. 0) then -c -c Override default part names for scor2prt, or normal include file. -c Just bypass rest of input line -c - iccount = 128 - else if (durq .ne. ' ') then - go to 27 - end if - else if (charq .eq. 'K') then -77 continue - call getchar(lineq,iccount,durq) - if (durq .eq. 'n') then - ignorenats = .true. - go to 77 - end if - if (durq .ne. 'i') then -c -c Normal, full-score key change and/or transposition -c - num1 = 44-ichar(durq) - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - num1 = num1*nint(fnum) -c -c On exit, durq='+','-'. But only need isig if after start, else done in pmxa -c - iccount = iccount+1 - call readnum(lineq,iccount,charq,fnum) - if (ismidi) then - midisig = nint(fnum) - if (durq.eq.'-') midisig = -midisig -c 130317 - midisig = midisig+idsig - call midievent('k',midisig,0) - - end if -c70 continue - if (num1 .eq. 0) then -c -c Key change, not transposition. -c - ipl(ivx,nnl(ivx)+1) = ibset(ipl(ivx,nnl(ivx)+1),28) - lastisig = isig - isig = nint(fnum) - if (durq .eq. '-') isig = -isig - isig = isig+idsig - if (ismidi) call midievent('k',isig,0) - else -c -c num1 .ne. 0, so transposition, so must be at beginning. isig came with K... -c but was passed to pmxb through pmxtex.dat. isig0 comes from setup data -c (signature before transposition). idsig must be added to future key changes. -c - jv = 0 - do while (jv .lt. nm) - jv = jv+1 - iTransAmt(jv) = num1 - end do - idsig = isig-isig0 - end if - else -c -c Instrument specific transposition. -c - call GetiTransInfo(.false.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst) -c -c The sig parameters will have been set 1st time but that's OK -c - end if - else if (charq .eq. '/') then - if (btest(iornq(ivx,nnl(ivx)+1),26)) then -c -c There was a hardspace followed by end of block. Remove it from the hardspace -c list, store with shifts instead, set special bit. This code also at '|' -c - irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18) - nudoff(ivx) = nudoff(ivx)+1 - udoff(ivx,nudoff(ivx)) = udsp(nudsp) - nudsp = nudsp-1 - iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26) - end if - call getchar(lineq,iccount,durq) -c -c Save ending note level: -c - if (ivx .le. nv) then -c -c This is the first line of music on this staff. If previous block had only 1 -c voice, save last pitch from line 1 of prev. block to line 2, in case a -c 2nd line is started just below -c - if (.not.was2(iv)) ndlev(iv,2) = ndlev(iv,1) - was2(iv) = .false. - ndlev(iv,1) = lastlev - else -c -c This is the 2nd line of music on this staff. -c - was2(iv) = .true. - ndlev(iv,2) = lastlev - end if - if (durq .eq. ' ' .and. iv.eq.nv) then -c -c End of input block -c - loop = .false. - else -c -c Start a new line of music -c - if (lenb0.ne.0 .and. firstgulp) lenbar = lenb0 - nbars = 0 - if (durq .eq. ' ') then -c -c New line of music is on next staff -c - iv = iv+1 - ivx = iv - else -c -c durq must be 2nd '/'. New line of music is on same staff. Set up for it -c - ivx = nv+1 - do 23 iiv = 1 , nv - if (nvmx(iiv) .eq. 2) ivx = ivx+1 -23 continue - nvmx(iv) = 2 - ivmx(iv,2) = ivx - itsofar(ivx) = 0 - nnl(ivx) = 0 - nfb(ivx) = 0 - nudoff(ivx) = 0 - ndotmv(ivx) = 0 - do 24 j = 1 , 200 - irest(ivx,j) = 0 - islur(ivx,j) = 0 - nacc(ivx,j) = 0 - iornq(ivx,j) = 0 - ipl(ivx,j) = 0 - mult(ivx,j) = 0 -24 continue -c -c Go back and lower the rests in voice "a" that don't have over-ridden heights -c - do 26 j = 1 , nnl(iv) - if (btest(irest(iv,j),0) .and. nolev(iv,j).eq.0) - * nolev(iv,j) = -4 -26 continue - end if - end if - iccount = 128 - else if (charq .eq. 'X') then -c -c 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, -c which only happens for normal X at block start, and we took special measures to -c keep group shifts for crossing block boundaries. -c - call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx))), - * shifton,wheadpt,iornq(ivx,nnl(ivx)+1),ivx, - * irest(ivx,nnl(ivx)+1),itsofar(ivx),0,0,0,' ',ndoub) - else if (charq .eq. 'I') then -c -c Midi controls. -c - call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, - * mtrdenl,nv,.false.) - else if (charq .eq. 'M') then -c -c Macro action -c - call getchar(lineq,iccount,charq) - if (index('RS',charq) .gt. 0) then -c -c Record or save a macro. Get the number of the macro. -c - call getchar(lineq,iccount,durq) - call readnum(lineq,iccount,durq,fnum) - macnum = nint(fnum) - macuse = ibset(macuse,macnum) - if (charq .eq. 'R') then - call mrec1(lineq,iccount,ndxm) - else -c -c Save (Record but don't activate) -c -5 call mrec1(lineq,iccount,ndxm) - if (mrecord) then - call getbuf(lineq) - iccount = 0 - go to 5 - end if - iccount = iccount+ndxm+1 - end if - else if (charq .eq. 'P') then -c -c Playback the macro -c - call getchar(lineq,iccount,charq) - call readnum(lineq,iccount,durq,fnum) - macnum = nint(fnum) - icchold = iccount - lnholdq = lineq - iccount = 128 - ilmac = il1mac(macnum) - mplay = .true. - end if - else if (index(',.',charq) .gt. 0) then -c -c Continued rhythmic shortcut -c - idotform = index('. ,',charq) - if (idotform .eq. 1) then -c -c Check for start of forced beam on 2nd member of dotform=1 shortcut -c - if (fbon) then - if (t1fb(ivx,nfb(ivx)).eq.itsofar(ivx)) - * t1fb(ivx,nfb(ivx)) = - * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2 - end if -c -c Change duration of prior note -c - itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) - nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 - itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) - end if - idotform = idotform+1 - numnum = 1 - cdot = .true. - go to 1 - end if - return - end - subroutine getorn(lineq,iccount,iornq,iornq0,ornrpt,noffseg, - * ip,ivx,noxtup,notcrd,nole) -c -c iornq: Main note. Do not alter if chord note, except turn on bit 23 -c iornq0: Store iorni + bit 23, in case of repeated ornaments -c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. -c noffseg: horiz. offset for segno -c nole: level of note w/ orn, used to ID the note/orn if there's a level shift. -c - - common /comivxudorn/ivxudorn(63) - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /comcb/ nbc,ibcdata(36) - character*1 charq,durq - character*128 lineq - logical ornrpt,negseg,noxtup,notcrd -c -c Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U -c 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. -c - call getchar(lineq,iccount,charq) - if (index('bc',charq) .gt. 0) then -c -c caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) -c ivx(0-3,28), ip(4-12), -c vshift (vshift+32 in bits 13-18), -c hshift (nint(10*vshift)+128 in bits 19-26) -c bit 27 = 0 if caesura, 1 if breath -c bit 28: 5th bit of ivx -c - iornq = ibset(iornq,28) - nbc = nbc+1 -c ibcdata(nbc) = ivx+16*ip - ibcdata(nbc) = mod(ivx,16)+16*ip - if (ivx.ge.16) ibcdata(nbc) = ibset(ibcdata(nbc),28) - if (charq .eq. 'b') ibcdata(nbc) = ibset(ibcdata(nbc),27) - call getchar(lineq,iccount,durq) - if (index('+-',durq) .gt. 0) then -c -c We have a vertical shift, get it -c - iccount = iccount+1 - call readnum(lineq,iccount,charq,fnum) - if (durq .eq. '-') fnum=-fnum - call setbits(ibcdata(nbc),6,13,nint(32+fnum)) - if (index('+-',charq) .gt. 0) then -c -c Horizontal shift, get it -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (charq .eq. '-') fnum=-fnum - call setbits(ibcdata(nbc),8,19,nint(10*fnum)+128) - end if - end if - return - end if -c -c Set signal on main note that some note at this time has ornament. ONLY used -c in beamstrt to activate further tests for whether ihornb is needed. -c - iornq = ibset(iornq,23) -c -c Isolate 21 bits defining exisiting ornaments -c - if (notcrd) then -c iorni = iand(4194303,iornq) -c iorni = iand(541065215,iornq) - iorni = iand(1614807039,iornq) - else - iorni = iand(4194303,icrdorn(ncrd)) - end if -c korn = index('stmgx+Tupf._)e:XXX>^',charq) - korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq) - if (korn .ne. 15) iorni = ibset(iorni,korn) -c -c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later -c as follows: korn=16-18 for sfn, and or 21 for bare ?. -c When this if-block is done, korn will = bit# of actual ornament (unless "?"). -c - if (korn .eq. 15) then -c -cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq -cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq -c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq -c -c iorni = ior(iorni,iand(iornq0,1638383)) -c iorni = ior(iorni,iand(iornq0,3735535)) -c iorni = ior(iorni,iand(iornq0,540606447)) - iorni = ior(iorni,iand(iornq0,1614348271)) - ornrpt = .false. - call getchar(lineq,iccount,durq) -c -c durq will be ' ' -c - else if (korn .eq. 14) then -c -c Editorial accidental -c - call getchar(lineq,iccount,durq) -c korn = 15+index('sfn',durq) - korn = 15+index('sfn?',durq) - if (korn .eq. 19) korn=21 - iorni = ibset(ibclr(iorni,14),korn) - call getchar(lineq,iccount,durq) - if (durq .eq. '?') then -c -c This is "oe[s|f|n]?". Set 21st bit also. -c - iorni = ibset(iorni,21) - korn = korn+6 - call getchar(lineq,iccount,durq) - end if -c iorni = ibset(ibclr(iorni,14),korn) - else if (korn.eq.4 .and. noxtup) then -c -c segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points -c - noffseg = 0 - negseg = .false. - call getchar(lineq,iccount,durq) - if (durq .ne. ' ') then -c -c Segno shift is specified -c - if (durq .eq. '-') then - negseg = .true. - call getchar(lineq,iccount,durq) - end if - call readnum(lineq,iccount,durq,fnum) - noffseg = int(fnum) - if (negseg) noffseg = -noffseg - end if - else if (korn .eq. 7) then -c -c Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" -c - ntrill = ntrill + 1 - ivtrill(ntrill) = ivx - iptrill(ntrill) = ip - xnsktr(ntrill) = 1. - call getchar(lineq,iccount,durq) - if (durq .eq. 't') then -c -c Convert to new internal symbol for non-'"tr" trill -c - korn = 15 - iorni = ibset(ibclr(iorni,7),15) - call getchar(lineq,iccount,durq) - end if - if (index('0123456789.',durq) .gt. 0) then -c -c We have a number for the length -c - call readnum(lineq,iccount,durq,xnsktr(ntrill)) - end if - else if (korn.eq.10 .and. noxtup) then -c -c Fermata -c - call getchar(lineq,iccount,durq) - if (durq .eq. 'd') then - korn = 14 - iorni = ibset(ibclr(iorni,10),14) - call getchar(lineq,iccount,durq) - end if - else - call getchar(lineq,iccount,durq) - end if - if (index('+- :',durq) .eq. 0) then - print*,'Unexpected character at end of ornament: ',durq - call stop1() - end if - if (index('+-',durq) .gt. 0) then -c -c Shift ornament up or down -c - nudorn = nudorn+1 -c -c Set bit 25 in iorni as a signal. This may not really be necessary. -c - iorni = ibset(iorni,25) -c -c Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, -c 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present -c - xofforn = 44-ichar(durq) - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - iofforn = nint(xofforn*fnum) - kudorn(nudorn) = ip+ishft(mod(ivx,16),8)+ishft(nole,12) - * +ishft(korn,19)+ishft(iofforn+32,25) - ivxudorn(nudorn) = ivx - if (index('+-',durq) .gt. 0) then -c -c Horizontal shift -c - kudorn(nudorn) = ibset(kudorn(nudorn),31) - xofforn = 44-ichar(durq) - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) -c 141226 ornhshft(nudorn) = nint(xofforn*fnum) - ornhshft(nudorn) = xofforn*fnum - end if - else if (durq .eq. ':') then -c -c Turn on repeated ornaments -c - ornrpt = .true. -c -c Save the ornament value just set -c - iornq0 = iorni - end if - if (notcrd) then - iornq = ior(iornq,iorni) - else - icrdorn(ncrd) = ior(icrdorn(ncrd),iorni) - end if - return - end - subroutine getpmxmod(global,includeq) -c -c If global=.true., checks for environment variable with path to pmx.mod. -c Then, if variable exists and points to pmx.mod, insert lines from -c pmx.mod into buffer -c If global=.false., checks for existence of includeq and uses it. -c -c lenbuf0 = total length of bufq on entry -c lbuf(i) = length of line (i) -c nlbuf = number of lines stored in bufq -c ilbuf = index of first line after setup stuff (on entry). In general, index of -c next line to be sucked from buffer. -c ilbufmod = counter for lines in pmx.mod as they are grabbed. -c Starts at ilbuf. Points to position of next line after -c pmx.mod stuff in bufq on exiting loop 1 -c ilbuff = transient counter for shifting operations -c ipbuf = on entry, points to last character in setup stuff. In general, points -c to last character of most recent line sucked from buffer. -c ipbufmod = points to last character of most recent inserted line -c from pmx.mod -c - parameter (maxblks=9600,nm=24) - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - logical lastchar,fbon,issegno,isheadr,isvolt - character*(*)includeq - character*80 pmxmoddirq - character*128 lnholdq - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - logical fexist,global - line1pmxmod = ilbuf - if (.not.global) then - inquire(file=includeq,EXIST=fexist) -c -c Transfer includeq to temporary char variable with known length -c - pmxmoddirq = includeq - lpmxmoddirq = lenstr(pmxmoddirq,80) - print* - write(15,'()') - if (.not.fexist) then - call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq) - * //', checking further.') -c -c File named includeq doesn't not exist. Get directory from PMXMODDIR and -c see if it's there -c - call getenv('PMXMODDIR',pmxmoddirq) - lpmxmoddirq = lenstr(pmxmoddirq,80) - if (lpmxmoddirq. gt. 0) then - pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//includeq - lpmxmoddirq = lenstr(pmxmoddirq,80) - else - call printl( - * 'No other directory defined by PMXMODDIR, stopping') - call stop1() - end if - inquire(file=pmxmoddirq,EXIST=fexist) - if (.not.fexist) then - call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq) - * //', stopping.') - call stop1() - end if - end if - call printl('Opening normal include file ' - * //pmxmoddirq(1:lpmxmoddirq)) - open(18,file=pmxmoddirq) - else -c -c Check for existence of pmx.mod -c - call getenv('PMXMODDIR',pmxmoddirq) - lpmxmoddirq = lenstr(pmxmoddirq,80) - if (lpmxmoddirq .eq. 0) return - pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//'pmx.mod' - lpmxmoddirq = lpmxmoddirq+7 - inquire(file=pmxmoddirq,EXIST=fexist) - if (.not.fexist) return - call printl('Opening global include file ' - * //pmxmoddirq(1:lpmxmoddirq)) - open(18,file=pmxmoddirq(1:lpmxmoddirq)) - end if - call printl('Adding include data') -c -c Read lines in from pmx.mod one at a time -c - ipbufmod = ipbuf - lenbufmod = lenbuf0 - do 1 ilbufmod = ilbuf , maxblks - read(18,'(a)',end=3)lnholdq -c -c A line was read. Slide all existing lengths from here forward ahead by 1 -c - do 2 ilbuff = nlbuf , ilbufmod , -1 - lbuf(ilbuff+1) = lbuf(ilbuff) -2 continue -c -c Get length of line from include file -c - lenmodline = lenstr(lnholdq,128) - if (lenmodline .eq. 0) then -c -c Blank line. Make it a single blank with length 1 -c - lenmodline = 1 - lnholdq = ' ' - end if - lbuf(ilbufmod) = lenmodline - call printl(lnholdq(1:lenmodline)) -c -c Insert new stuff into bufq -c - bufq = bufq(1:ipbufmod)//lnholdq(1:lenmodline)// - * bufq(ipbufmod+1:lenbufmod) -c -c Update internal parameters -c - ipbufmod = ipbufmod+lbuf(ilbufmod) - lenbufmod = lenbufmod+lbuf(ilbufmod) - nlbuf = nlbuf+1 -1 continue -3 continue - call printl('Closing '//pmxmoddirq(1:lpmxmoddirq)) - close(18) - linesinpmxmod = linesinpmxmod+ilbufmod-ilbuf - lenbuf0 = lenbufmod -c -c Fix Andre's error reporting problem 101211 leading to log(neg#) due -c to nline being 2 bigger than it should be -c - nline=nline-2 -c - return - end - subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, - * xmtrnum0,npages,nsyst,musicsize,fracindent,istype0, - * inameq,clefq,sepsymq,pathnameq,lpath,isig0) - parameter (nm=24) - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - character*1 clefq(nm),sepsymq(nm) - character*40 pathnameq - character*79 inameq(nm) - character*128 lineq - logical istype0,newway,rename - common /commidisig/ midisig -c -c Get the first line -c - iccount = 0 -9 call getbuf(lineq) - if (lineq(1:1) .eq. '%') go to 9 - istype0 = lineq(1:3).eq.'---' - if (istype0) then -c -c Have TeX input until next line that starts with '---'. Save in scratch. -c - open(17,status='SCRATCH') -3 call getbuf(lineq) - if (lineq(1:3) .ne. '---') then - write(17,'(a)')lineq - go to 3 - end if -c -c Force a new line read on first call to readin -c - iccount = 128 - end if -c -c Here, lineq is first line w/ numerical setup data. -c - nv = nint(readin(lineq,iccount,nline)) - noinst = nint(readin(lineq,iccount,nline)) - newway = noinst.le.0 - if (newway) noinst = -noinst - do 2 iinst = 1 , noinst -c -c Seve # of staves per inst in case later drop some inst's. -c - if (newway) then -c -c Read in nvi for each instrument -c - nsperi(iinst) = nint(readin(lineq,iccount,nline)) - else if (iinst .gt. 1 ) then - nsperi(iinst) = 1 - else - nsperi(iinst) = nv-noinst+1 - end if - iiorig(iinst) = iinst - nspern(iinst) = nsperi(iinst) -2 continue - mtrnuml = nint(readin(lineq,iccount,nline)) - mtrdenl = nint(readin(lineq,iccount,nline)) -cc -cc Kluge to make mtrdenl work -cc -c if (mtrdenl .eq. 1) then -c mtrdenl = 2 -c mtrnuml = mtrnuml*2 -c end if - mtrnmp = nint(readin(lineq,iccount,nline)) - mtrdnp = nint(readin(lineq,iccount,nline)) - xmtrnum0 = readin(lineq,iccount,nline) -c -c Original key sig (before any trnasposition) in next position. Transposed -c sig for topfile was transferred thru pmxtex.dat. Need isig0 for key -c changes if transposed. -c - isig0 = nint(readin(lineq,iccount,nline)) -c 130316 -c do 11 iinst = 1 , noinst -c midisig(iinst) = isig0 - midisig = isig0 -c11 continue - npages = nint(readin(lineq,iccount,nline)) - nsyst = nint(readin(lineq,iccount,nline)) - musicsize = nint(readin(lineq,iccount,nline)) - fracindent = readin(lineq,iccount,nline) -c -c Next noinst non-comment lines are names of instruments. -c - do 4 i = 1 , noinst -5 call getbuf(inameq(i)) - if (inameq(i)(1:1) .eq. '%') go to 5 -4 continue -c -c Next non-comment line has nv clef names -c -6 call getbuf(lineq) - if (lineq(1:1) .eq. '%') go to 6 - iv = 0 - nvsofar = 0 - do 1 jinst = 1 , noinst - nvsofar = nvsofar+nsperi(jinst) - do 10 ivi = 1 , nsperi(jinst) - iv = iv+1 - clefq(iv) = lineq(iv:iv) - if (iv .eq. nvsofar) then - sepsymq(iv) = '&' - else - sepsymq(iv) = '|' - end if -10 continue -1 continue -c -c Mext non-comment line has path name -c -8 call getbuf(pathnameq) - if (pathnameq(1:1) .eq. '%') go to 8 - lpath = index(pathnameq,' ')-1 -c -c 160130 Replace '\' by '/' -c -12 ipos = index(pathnameq,'\') - if (ipos .gt. 0) then - pathnameq(ipos:ipos)='/' -c print*,'Changed pathname to ',pathnameq(1:lpath) - go to 12 - end if - return - end - function getsquez(n,ntot,space,tnote,to) - real*4 tnote(600),to(600) - common /comtol/ tol -c -c Get the squez factor by checking space against tgovern=minimum duration -c of all notes sounding at time of n-th note in the list. -c The starting time of base increment is to(n) and ending time is to(n)+space -c Sounding notes are those that start at or before to(n) .and. end at or -c after tend=to(n)+space -c Since notes are ordered by increasing start times, as soon as we find one -c that starts too late, we are done checking. -c - tgovern = 1000. - tend = to(n)+space - do 1 in = 1 , ntot -c -c Since to() is ordered by start times, exit loop after first note that -c starts later than note of interest. -c - if (to(in) .gt. to(n)+tol) go to 2 - if (to(in)+tnote(in) .gt. tend-tol) then -c -c If here, this note overlaps and must be tested. -c - tgovern = min(tgovern,tnote(in)) - end if -1 continue -2 continue - getsquez = space/tgovern - return - end - subroutine getx(lineq,iccount,irest,shifton,wheadpt,iornq1,ivx, - * irest1,itsofar,ntup,itup,nnodur,dotq,ndoub) - parameter(nm=24) -c -c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. -c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. -c Since during getnote phase time is integer itsofar, which is not updated -c during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if -c not in xtup. -c - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - logical shifton,colon,ess,number - character*128 lineq - character*1 charq,durq,dotq - colon = .false. - ess = .false. - number = .false. - nextbl = iccount+index(lineq(iccount:128),' ')-1 - if (index(lineq(iccount:nextbl),'P') .gt. 0) then -c -c "Parts only", ignore entire symbol -c - iccount = nextbl - return - end if -1 call getchar(lineq,iccount,charq) - if (charq.eq.'B') then -c -c "Both parts and score," ignore character -c - go to 1 - else if (charq .eq. ':') then - colon = .true. - go to 1 - else if (charq .eq. 'S') then - ess = .true. - go to 1 - else if (index('+-.0123456789',charq) .gt. 0) then - number = .true. - if (charq.eq.'-') iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (charq .eq. '-') fnum = -fnum - if (durq .ne. 'p') then - fnum = fnum*wheadpt - iccount = iccount-1 - end if - go to 1 - end if -c -c charq must be blank, so done parsing -c - if (.not.ess .and. .not.colon) then -c -c Ordinary hardspace. Goes before next note. -c (Later, at "|" or "/", check for presence and switch to udoff if there!) -c - nudsp = nudsp+1 - iornq1 = ibset(iornq1,26) - udsp(nudsp) = fnum - tudsp(nudsp) = itsofar - if (ntup .gt. 0) tudsp(nudsp) = tudsp(nudsp) -c * +float(itup-1)/ntup*ifnodur(nnodur,dotq) - * +float(itup-1+ndoub)/ntup*ifnodur(nnodur,dotq) - else if (.not.number) then -c -c Must be "X:" End a group offset. -c - irest = ibset(irest,17) - shifton = .false. - return - else -c -c Only other possibility is start offset, "S" for single, ':' for multiple -c - nudoff(ivx) = nudoff(ivx)+1 - udoff(ivx,nudoff(ivx)) = fnum - if (ess) then - irest1 = ibset(irest1,15) - else - irest1 = ibset(irest1,16) - shifton = .true. - end if - end if - return - end - function i1fnodur(idur,dotq) - character*1 dotq - if (idur .eq. 6) then - i1fnodur=1 - else if (idur .eq. 3) then - i1fnodur=2 - else if (idur .eq. 1) then - i1fnodur=4 - else if (idur .eq. 8) then - i1fnodur=8 - else if (idur .eq. 4) then - i1fnodur=16 - else if (idur .eq. 2) then - i1fnodur=32 - else if (idur .eq. 0) then - i1fnodur=64 - else if (idur .eq. 16) then -c -c Only used for denominator of time signatures, not for notes -c - i1fnodur=4 - else if (idur .eq. 9) then - i1fnodur = 128 - else - print* - print*,'You entered an invalid note-length value:',idur - call stop1() - end if - if (dotq .eq. 'd') i1fnodur = i1fnodur*3/2 - return - end -c integer*4 function longi(ishort) -c integer*2 ishort -c longi = ishort -c return -c end - function iashft(nacc) - integer*4 ias(6) - data ias /-1,1,0,0,-2,2/ - iashft = ias(nacc) - return - end - function ifnodur(idur,dotq) - character*1 dotq - if (idur .eq. 6) then - ifnodur=1 - else if (idur .eq. 3)then - ifnodur=2 - else if(idur .eq. 1) then - ifnodur=4 - else if(idur .eq. 8) then - ifnodur=8 - else if(idur .eq. 4) then - ifnodur=16 - else if(idur .eq. 2) then - ifnodur=32 - else if(idur .eq. 0) then - ifnodur=64 - else if(idur .eq. 9) then - ifnodur=128 - else if (idur .eq. 16) then -c -c Only used for denominator of time signatures, not for notes -c - ifnodur=4 - else - print*,'You entered an invalid note value' - stop - end if - if (dotq .eq. 'd') ifnodur = ifnodur*3/2 - return - end - function ifnolev(noq,oct,ntrans) - character*1 noq - integer oct - ifnolev = 7*oct+mod(ichar(noq)-92,7)+1+ntrans - return - end -c subroutine report(nsdat,isdat1,isdat2) -c integer*4 isdat1(202),isdat2(202) -c write(*,'(a)') -c * ' isd on? iv kv ip id ud1 ud2 ndx ivo iho lev crd lhd rhd' -c do 1 isdat = 1 , nsdat -c isdata = isdat1(isdat) -c ionoff = igetbits(isdata,1,11) -cc iv = iand(7,isdata) -c iv = igetbits(isdata,5,13) -c kv = igetbits(isdata,1,12)+1 -c ip = igetbits(isdata,8,3) -c idcode = igetbits(isdata,7,19) -c iud1 = igetbits(isdata,1,26) -c iud2 = igetbits(isdata,1,27) -c ndxslur = igetbits(isdata,4,28) -c isdatb = isdat2(isdat) -c ivo = igetbits(isdatb,6,6)-32 -c iho = igetbits(isdatb,7,12)-64 -c lev = igetbits(isdatb,7,19) -c icrd = igetbits(isdatb,1,0) -c lhd = igetbits(isdatb,1,1) -c irhd = igetbits(isdatb,7,2) -c write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur, -c * ivo,iho,lev,icrd,lhd,irhd -c1 continue -c print* -c return -c end - function igetbits(isdata,iwidbit,ishift) -c -c Extracts integer given by iwidbit bits of isdata, shifted by ishift, and -c then added to ioff -c - igetbits = iand(2**iwidbit-1,ishft(isdata,-ishift)) - return - end - function igetvarlen(mmidi,icm,imidi,nbytes) -c -c Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. -c - parameter (nm=24,mv=24576) - integer*2 mmidi(0:nm,mv) - igetvarlen = 0 - do 1 nbytes = 1 , 4 - igetvarlen = 128*igetvarlen - * +iand(127,mmidi(icm,imidi+nbytes)) - if (.not.btest(mmidi(icm,imidi+nbytes),7)) return -1 continue - print*,'Messup in igetvarlen' - call stop1() - end - logical function isdotted(nodur,ivx,ip) - parameter (nm=24) -c -c Function returns true if note is dotted or double-dotted. -c Return false for any xtuplet. -c - common /comtol/ tol - integer*4 nodur(nm,200) - if (nodur(ivx,ip) .eq. 0) then - isdotted = .false. - return - else if (ip .gt. 1) then - if (nodur(ivx,ip-1) .eq. 0) then - isdotted = .false. - return - end if - end if -c -c Ruled out all xtups, so is dotted or double-dotted if not a power of 2. -c - isdotted = - * mod(alog(float(nodur(ivx,ip)))/.69314718+.5*tol,1.) .gt. tol - return - end - function isetvarlen(idur,nbytes) - isetvarlen = 0 - itemp = idur - do 1 nbytes = 1 , 4 - isetvarlen = isetvarlen + iand(itemp,127)*256**(nbytes-1) - itemp = ishft(itemp,-7) - if (itemp .gt. 0) then - isetvarlen = isetvarlen+2**(8*nbytes+7) - else - return - end if -1 continue - print*,'Problem in fn. isetvarlen' - call stop1() - end - subroutine istring(i,string,len) -c -c Returns string with integer only if length is 1, otherwise enclosed in -c brackets. -c - character*(*) string - if (i .ne. 0) then - len = alog10(abs(i)*1.0001)+1 - if (i .lt. 0) len = len+1 - else - string = '0' - len = 1 - return - end if - if (len .eq. 1) then - string = char(48+i) - else - string = '{' - write(string(2:1+len),'(i'//char(48+len)//')')i - string = string(1:len+1)//'}' - len = len+2 - end if - return - end - function lenstr(string,n) - character*(*) string - do 1 lenstr = n , 1 , -1 - if (string(lenstr:lenstr) .ne. ' ') return -1 continue - lenstr = 0 - return - end - function levrn(nolev,irest,iud,ncm,mult) -c -c Used for placing numbers in xtups. Returns note level if not a rest, -c else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. -c - logical btest - if (.not.btest(irest,0)) then - levrn = nolev - else -c -c Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. -c - if (mult .gt. 0) then - if (mult .eq. 2) then - ioff = -1+2*iud - else if (mult .ne. 4) then - ioff = iud*mult - else - ioff = 1+4*iud - end if - else -c -c May need to futz with this later for non-beamed xtups (quarter, half rests) -c - ioff = iud*2 - end if - levrn = mod(nolev+20,100)-20+ncm+ioff - endif - return - end - function lfmt1(x) -c -c Computes total length of an "f" format with one decimal place. -c First round to nearest 0.1 -c - if (abs(x) .lt. .001) then - lfmt1 = 2 - else - y = sign(.1*int(10*abs(x)+.5),x) - lfmt1 = int(log10(1000*abs(y)+.001)) - if (y .lt. 0) lfmt1 = lfmt1+1 - end if - return - end - subroutine LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat, - * ispstie,sepsymq) - parameter (nm=24) - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /comoct/ noctup - integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) - logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie - character*1 udq,chax,sepsymq(nm) - character*8 noteq - character*128 notexq -c -c This is called twice from pmxb after having input an entire block, before -c making a bar that starts a new system. So nsdat reflects all slur starts -c and stops in new block, while listslur, which is only set when bars are -c made, reflects only open slurs from the old block. So we must check -c listslur to find open ties, not all nsdat. -c First of two calls (ispstie=.false. on entry) terminates tie at end of line. -c Second (ispstie=.true. on entry) restarts tie at start of new line. Only -c need data from original tie-start for both of these. Tie/slur data from -c closing of full tie are not used except for shape alterations. -c -c do 1 ndx = 0 , 11 - do 1 ndx = 0 , 23 - if (btest(listslur,ndx)) then -c -c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie -c - do 2 isdat = 1 , nsdat -c if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index - if (igetbits(isdat1(isdat),4,28) - * +16*igetbits(isdat1(isdat),1,18) .ne. ndx) go to 2 ! Wrong index - if (.not.btest(isdat1(isdat),11)) go to 2 ! Bypass if stop - if (btest(isdat2(isdat),3)) go to 3 ! "st" - idcode = igetbits(isdat1(isdat),7,19) - if (idcode.eq.1) go to 3 ! "t" - tie = .false. - go to 5 -2 continue - end if - go to 1 -3 continue - tie = .true. -5 continue -c -c A slur or tie is open, with index ndx -c - iv = igetbits(isdat1(isdat),5,13) - kv = igetbits(isdat1(isdat),1,12)+1 - udq = 'd' - if (btest(isdat1(isdat),27)) udq='u' - notexq = chax(92)//'znotes' - lnote = 7 - do 4 iiv = 1 , iv-1 - notexq = notexq(1:lnote)//sepsymq(iiv) - lnote = lnote+1 -4 continue - if (kv .eq. 2) then - notexq = notexq(1:lnote)//chax(92)//'nextvoice' - lnote = lnote+10 - end if -c -c Compute horiz and vert offsets -c -c nolev = igetbits(isdat2(isdat),7,19) - islhgt = igetbits(isdat3(isdat),8,14) - ilb12 = 0 - if (ispstie) ilb12 = 1 - ivoff = igetbits(isdat4(isdat),6,ilb12*16)-32 - if (ivoff .eq. -32) ivoff = 0 -C nolev = nolev+ivoff - islhgt = islhgt+ivoff - ihoff = (igetbits(isdat4(isdat),7,ilb12*16+6)-64) ! This is 10X hoff - if (ihoff .eq. -64) ihoff = 0 -c -c Add starting stuff for command -c - if (.not.ispstie) then ! End 1st segment - notexq = notexq(1:lnote)//chax(92)//'roffset{' - lnote = lnote+9 -c hoff = ihoff*.1-.5 -c hoff = ihoff*.1-.8 - hoff = ihoff*.1-.4 - if (hoff .lt. 0) then - hoff = -hoff - notexq = notexq(1:lnote)//'-' - lnote = lnote+1 - end if - call writflot(hoff,notexq,lnote) - notexq = notexq(1:lnote)//'}{' - lnote = lnote+2 - else - notexq = notexq(1:lnote)//chax(92)//'off{-' - * //chax(92)//'afterruleskip}' - lnote = lnote+21 -c -c 091025 add dotting for 2nd segment if needed -c - if (btest(isdat2(isdat),4)) then - notexq = chax(92)//'dotted'//notexq(1:lnote) - lnote = lnote+7 - end if - end if - if (ispstie .and. tie) then - notexq = notexq(1:lnote)//chax(92)//'tieforis'//udq - lnote = lnote+10 - end if - if (btest(isdat3(isdat),0)) then -c -c Curvature tweak on termination of 1st seg -c - imid = igetbits(isdat3(isdat),6,2)-32 -c -c Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: -c Abs(imid) Postscript slur type -c 1 f -c 4 h -c 5 H -c 6 HH -c - notexq = notexq(1:lnote)//chax(92)//'psforts'//chax(48+imid) - lnote = lnote+9 -c -c Zero out the flag in case there's a different curv on term of 2nd, -c - isdat3(isdat) = ibclr(isdat3(isdat),0) - end if -c -c Add the command name -c - if (ispstie) then - notexq = notexq(1:lnote)//chax(92)//'is'//udq - lnote = lnote+4 - else if (tie) then - notexq = notexq(1:lnote)//chax(92)//'ttie' - lnote = lnote+5 - else - notexq = notexq(1:lnote)//chax(92)//'tslur' - lnote = lnote+6 - end if -c -c Add index -c -c if (11-ndx .lt. 10) then -c notexq = notexq(1:lnote)//chax(59-ndx) -c lnote = lnote+1 -c else -c notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' -c lnote = lnote+4 -c end if - if (23-ndx .lt. 10) then - notexq = notexq(1:lnote)//chax(71-ndx) - lnote = lnote+1 - else if (23-ndx .lt. 20) then - notexq = notexq(1:lnote)//'{1'//chax(61-ndx)//'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//'{2'//chax(51-ndx)//'}' - lnote = lnote+4 - end if - if (ispstie .or. .not.tie) then -c -c Add note name for slur height -c - noctup = 0 - ncm = igetbits(isdat3(isdat),8,22) - if (ncm .eq. 23) noctup = -2 -c call notefq(noteq,lnoten,nolev,ncm) - call notefq(noteq,lnoten,islhgt,ncm) - notexq = notexq(1:lnote)//'{'//noteq(1:lnoten)//'}' - lnote = lnote+1+lnoten+1 - end if - if (ispstie) then -c -c Horizontal shift start of new thing -c - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 -c ihoff = ihoff-13 - if (tie) then - ihoff = ihoff-12 - else - ihoff = ihoff-7 - end if - if (ihoff .lt. 0) then - ihoff = -ihoff - notexq = notexq(1:lnote)//'-' - lnote = lnote+1 - end if - call writflot(ihoff*.1,notexq,lnote) - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if -c -c Add closing stuff -c - if (ispstie) then - notexq = notexq(1:lnote)//chax(92)//'off{' - * //chax(92)//'afterruleskip}' - lnote = lnote+20 - else - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - notexq = notexq(1:lnote)//chax(92)//'en%' - lnote = lnote+4 - write(11,'(a)')notexq(1:lnote) -1 continue - ispstie = .not.ispstie - return - end - subroutine littex(islur,nnl,iv,topmods,lineq,iccount) - parameter (nm=24) - common /comlast/ islast,usevshrink - logical islast,usevshrink - integer islur(nm,200) - logical topmods - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg,merge - character*128 lineq,litq - character*20 voltxtq - character*1 durq,chax - merge = .false. - if (nlit .gt. 0) then - merge = iv.eq.ivlit(nlit) .and. nnl.eq.iplit(nlit) - end if - nlit = nlit+1 - ivlit(nlit) = iv - iplit(nlit) = nnl - itype = 1 -17 call getchar(lineq,iccount,durq) - if (durq .eq. chax(92)) then - itype=itype+1 - go to 17 - end if - litq(nlit) = chax(92)//durq - lenlit(nlit) = 2 -18 call getchar(lineq,iccount,durq) - if (durq.eq.chax(92)) then - call getchar(lineq,iccount,durq) - if (durq .ne. ' ') then -c -c Starting a new tex command within the string -c - litq(nlit) = litq(nlit)(1:lenlit(nlit))//chax(92)//durq - lenlit(nlit) = lenlit(nlit)+2 - go to 18 - end if - else - litq(nlit) = litq(nlit)(1:lenlit(nlit))//durq - lenlit(nlit) = lenlit(nlit)+1 - go to 18 - end if -c -c If here, just read backslash-blank so string is done -c - if (itype .eq. 1) then - islur(iv,nnl) = ibset(islur(iv,nnl),16) - if (merge) then -c -c There are 2 separate strings on the same note, so merge them. -c - nlit = nlit-1 - litq(nlit) = litq(nlit)(1:lenlit(nlit)) - * //litq(nlit+1)(1:lenlit(nlit+1)) - lenlit(nlit) = lenlit(nlit)+lenlit(nlit+1) - if (lenlit(nlit) .gt. 128) then - print* - print*, - * 'Merged type-1 TeX strings longer than 128 characters' - write(15,'(/,a)') - * 'Merged type-1 TeX strings longer than 128 characters' - call stop1() - end if - end if - else -c -c Type 2 or 3. -c - if (itype .eq. 3) then -c -c Write the string NOW -c - if (islast) - * write(11,'(a)')litq(nlit)(1:lenlit(nlit))//'%' - else -c -c Must go at top -c - if (.not.topmods) then - topmods = .true. - open(16,status='SCRATCH') - end if -c -c Must write '%' here rather than later, in case string ends with blank. -c - write(16,'(a)')litq(nlit)(1:lenlit(nlit))//'%' - end if - nlit = nlit-1 - end if - return - end - function llen(strq,n) - character*129 strq - do 1 llen = n , 0 , -1 - if (strq(llen:llen) .ne. ' ') return -1 continue - end - function log2(n) -c -c 5/25/08 Modify to allow more slurs -c -c log2 = alog(1.*n)/0.6931472+.0001 -c log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 - log2 = dlog(1.d0*n)/0.693147181d0+.00000002d0 - return - end - subroutine logbeam(numnew,nip1,nip2) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*1 ulq,sepsymq,sq,ulfq,ulfbq - logical beamon,firstgulp,figbass,figchk,isfig,isxtup,btest, - * autofbon - ibm1(ivx,numnew) = nip1 - ibm2(ivx,numnew) = nip2 - numnow = numnew - if (numnew .gt. 1) then -c -c If it starts before any others, must put it in order -c - do 11 ib = numnew-1 , 1 , -1 - if (ibm1(ivx,ib) .lt. nip1) go to 12 - ibm1(ivx,ib+1) = ibm1(ivx,ib) - ibm2(ivx,ib+1) = ibm2(ivx,ib) - ulq(ivx,ib+1) = ulq(ivx,ib) - ibm1(ivx,ib) = nip1 - ibm2(ivx,ib) = nip2 - numnow = ib -11 continue -12 continue - end if - sum = 0. -c -c Beam has non-xtup within -c - nrests = 0 - isxtup = .false. - do 9 iip = nip1 , nip2 - if (btest(islur(ivx,nip1),21)) then -c -c Forced multiplicity -c - call setbits(mult(ivx,iip),4,0, - * igetbits(islur(ivx,nip1),3,22)+8) - else if (.not.isxtup) then - if (nodur(ivx,iip) .gt. 0) then - call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8) - else -c -c Start xtup within forced beam -c - isxtup = .true. - iip1 = iip - end if - else if (isxtup .and. nodur(ivx,iip).gt.0) then -c -c End of xtup within forced beam. Must count doubled notes -c - ndoub = 0 - do 1 iiip = iip1 , iip - if (btest(nacc(ivx,iiip),18)) ndoub = ndoub+1 -1 continue - multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)- - * alog(nodur(ivx,iip)/2.))/0.69315)-10 - do 74 iiip = iip1 , iip - call setbits(mult(ivx,iiip),4,0,multx+8) -c -c Note the following still works after making mult only the 1st 4 bits. -c - if (btest(nacc(ivx,iiip),18)) - * mult(ivx,iiip) = mult(ivx,iiip)-1 - if (btest(nacc(ivx,iiip),19)) then - mult(ivx,iiip) = mult(ivx,iiip)+1 - else if (iiip .gt. 1) then - if (btest(nacc(ivx,iiip-1),19)) - * mult(ivx,iiip) = mult(ivx,iiip)+1 - end if -74 continue - isxtup = .false. - end if - if (btest(irest(ivx,iip),0)) then - nrests = nrests+1 - else - sum = sum+nolev(ivx,iip) - end if -9 continue -c -c Set beam up-down-ness -c - if (ifb.gt.0 .and. ulfbq(ivx,max(1,ifb)).ne.'x') then - if (ulfbq(ivx,ifb) .eq. 'f') then -c -c Get default, then trade "l" and "u" -c - ulq(ivx,numnow) = char(225-ichar( - * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1)))) - else - ulq(ivx,ifb) = ulfbq(ivx,ifb) - end if -c -c This probably works only because forced beams are done first, so they -c don't have to be re-sorted within each voice. ???? -c - else if (nvmx(iv) .eq. 2) then -c -c Multi-voice per staff -c - if (ivx .le. nv) then - ulq(ivx,numnow) = 'l' - else - ulq(ivx,numnow) = 'u' - end if - else -c -c Defaults -c - ulq(ivx,numnow) = - * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1)) - end if - return - end - subroutine m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) -c -c This is called when (a) macro recording is just starting and -c (b) at the start of a new line, if recording is on -c - parameter (maxblks=9600) - character*128 lineq,lnholdq - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), - * ic1mac(20),ilmac,iplmac - logical mrecord,mplay,endmac - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - lbuf(1) = lbuf(1) - if (.not.mrecord) then -c -c Starting the macro -c - ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount - il1mac(macnum) = ilbuf-1 - ic1mac(macnum) = iccount - mrecord = .true. - end if - if (iccount .lt. 128) then - ndxm = index(lineq(iccount+1:128),'M') - if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M', - * 128-iccount) - if (ndxm .gt. 0) then -c -c This line ends the macro. -c - if (lineq(iccount+ndxm+1:iccount+ndxm+1) .ne. ' ') then - call errmsg(lineq,iccount+ndxm+1,ibarcnt-ibaroff+nbars+1, - * 'Improper macro termination!') - call stop1() - end if - ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm - il2mac(macnum) = ilbuf-1 - mrecord = .false. - end if - end if - return - end - subroutine make1bar(ibmrep,tglp1,tstart,cwrest,squez, - * istop,numbms,istart) - parameter (nm=24,mv=24576) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comipl2/ ipl2(nm,200) - character*10 figq - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,isfig,bar1syst - common /comeskz2/ eskz2(nm,200) - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - common /combeam/ ibmtyp - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comas2/ nasksys,wasksys(800),elasksys(800) - common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - common /comsln/ is1n1,is2n1,irzbnd,isnx - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg,autofbon - character*128 litq - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm), - * numbms(nm),mapfb(16) - real*4 xit(nm),t1xtup(20),tstart(80),squez(80) - character*1 ulfbq - character*79 inameq - character*20 voltxtq - common /comoct/ noctup - character*80 headrq,lowerq - logical cwrferm - common /comcwrf/ cwrferm(nm) - common /comnsp/ space(80),nb,prevtn(nm), - * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) - logical lower,cwrest(nm),vxtup,flgndb,btest,upslur, - * infbmx(nm),lowdot,inxtup(nm),drawbm - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /comstart/ facmtr - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac -c -c Above are factors for grace note, clef spacing. (fraction of wheadpt) -c In 1.04, moved to block data subprogram -c - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /comtol/ tol - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur, - * WrotePsslurDefaults - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /comntot/ ntot - if (ismidi) then -c -c Initialize for this bar the accidental counter for the midi file. -c naccim(icm) = # of accidentals from earlier in the bar -c - do 45 iv = 1 , nv - do 45 kv = 1 , nvmx(iv) - naccim(midchan(iv,kv)) = 0 -45 continue - end if -c -c Time from start of gulp to end of bar, used with forced beams -c - tglp2 = lenb0+ibar*lenb1 - if (lenb0 .gt. 0) tglp2 = tglp2-lenb1 - tglp1 = tglp2-lenbar -c -c infbmx will only be true if in xtup that is NOT in explicit forced beam. -c - do 1 iv = 1 , nv - do 1 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - cwrest(ivx) = .false. - infbmx(ivx) = .false. - inxtup(ivx) = .false. - if (ibar .gt. 1) then - nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1) - else - nn(ivx) = nib(ivx,ibar) - end if -1 continue -c -c initialize list note counter, time(iv), curr. note(iv). The loop to 4 -c ONLY initializes each voice. -c - in = 1 - nxtup = 0 - narp = 0 - do 4 iv = 1 , nv - do 4 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - cwrferm(ivx) = .false. - cnn(ivx) = 1 - ivxo(in) = ivx - ipo(in) = cnn(ivx) - tnote(in) = fnote(nodur,ivx,1,nacc) - to(in) = 0. - xit(ivx) = tnote(in) -c -c Note that xit(ivx) is to END of note in voice, but it1xtup is start time. -c - if (nodur(ivx,ipo(in)) .eq. 0) then -c -c First note of xtuplet at start of bar in voice ivx. -c - nxtup = nxtup+1 - nxtnow(ivx) = nxtup - inxtup(ivx) = .true. - t1xtup(nxtup) = 0. -c -c Xtup at start of bar. If no explicit forced beam, start one, set -c signal infbmx, and save number ifbnow for use at termination. -c - if (nfb(ivx) .gt. 0) then - do 60 ifb = 1 , nfb(ivx) - if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then -c -c No explicit fb here; so exit loop and insert one. -c - go to 61 - else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and. - * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then -c -c IS explicit fb here; must NOT insert one -c - go to 62 - end if -60 continue - end if -61 continue -c -c If here, xtup isn't in explicit fb, so must insert one -c - infbmx(ivx) = .true. - call addfb(nfb,ivx,t1xtup(nxtup)+ - * tglp1,t1fb,t2fb,ulfbq,ifbadd) - ifbnow(ivx) = ifbadd - end if -62 continue - if (abs(xit(ivx)-lenbar) .lt. tol) xit(ivx) = 1000. - in = in+1 -4 continue -c -c Build the list: This is a manual loop starting at 5 -c -5 continue -c -c Determine which voice comes next from end of notes done so far. -c tmin is the earliest ending time of notes done so far -c - tmin = 1000. - do 6 iiv = 1 , nv - do 6 kv = 1 , nvmx(iiv) - iivx = ivmx(iiv,kv) - tminn = min(tmin,xit(iivx)) - if(tminn .lt. tmin-tol) then - tmin = tminn - ivx = iivx - end if -6 continue - if (abs(tmin-1000.) .lt. tol) go to 7 - ivxo(in) = ivx - cnn(ivx) = cnn(ivx)+1 - ipo(in) = cnn(ivx) - to(in) = tmin -c -c Check if this voice is done -c - tnote(in) = fnote(nodur,ivx,cnn(ivx),nacc) - if (cnn(ivx) .eq. nn(ivx)) then - xit(ivx) = 1000. - else - xit(ivx) = xit(ivx)+tnote(in) - end if -c -c Flag xtups -c - if (nodur(ivx,cnn(ivx)) .eq. 0) then - if (.not.inxtup(ivx)) then -c -c First note of xtup, not at start of bar. -c - nxtup = nxtup+1 - nxtnow(ivx) = nxtup - inxtup(ivx) = .true. - t1xtup(nxtup) = xit(ivx)-tnote(in) -c -c (Note: can't be on last note in voice, so xit(ivx) <> 1000) -c Put xtuplet in a forced beam if not already in forced beam -c - if (nfb(ivx) .gt. 0) then - do 70 ifb = 1 , nfb(ivx) - if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then -c -c NO explicit bm; put one in -c - go to 71 - else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and. - * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then -c -c IS explicit bm. Don't put one -c - go to 72 - end if -70 continue - end if -71 continue -c -c If here, no explicit bm, so put one in -c - infbmx(ivx) = .true. - call addfb(nfb,ivx,t1xtup(nxtup)+tglp1, - * t1fb,t2fb,ulfbq,ifbadd) - ifbnow(ivx) = ifbadd - end if -72 continue - else if (inxtup(ivx)) then -c -c This test is sufficient because already know nodur>0 -c - inxtup(ivx) = .false. - if (infbmx(ivx)) then -c -c Xtup is in auto-forced beam, so end it -c - t2fb(ivx,ifbnow(ivx)) = - * t1xtup(nxtnow(ivx))+nodur(ivx,cnn(ivx))+tglp1 - infbmx(ivx) = .false. - end if - end if - if (btest(irest(ivxo(in),ipo(in)),24) .or. - * btest(irest(ivxo(in),ipo(in)),30)) then -c -c For staff jumped beam, flag the first note (lowest voice) at same time. -c Later will start new notes group here. -c - inj = in - if (ivxo(in) .gt. 1) then - do 40 iin = in-1 , 1 , -1 - if (to(iin)+tol .lt. to(in)) go to 41 - if (abs(to(iin)-to(in)) .lt. tol) then - inj = iin - go to 40 - end if -40 continue - end if -41 continue - irest(ivxo(inj),ipo(inj)) = ibset(irest(ivxo(inj),ipo(inj)),29) - end if - in = in+1 - go to 5 -7 continue - ntot = in-1 - do 8 in = 1 , ntot-1 - tno(in) = to(in+1)-to(in) -8 continue - tno(ntot) = tnote(ntot) -c -c Debug writes -c -c write(*,'()') -c write(*,'(a)')' Greetings from PMXB' -c write(*,'(16i5)')(ivxo(in),in=1,ntot) -c write(*,'(16i5)')(ipo(in),in=1,ntot) -c write(*,'(16f5.1)')(to(in),in=1,ntot) -c write(*,'(16f5.1)')(tno(in),in=1,ntot) -c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) -c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) -c -c Done w/ list. Loop for parsing into note blocks: -c - ib = 1 - istart(1) = 1 - space(1) = 0. - in = 1 -c -c A manual loop to set space(ib) and istop(ib) -c -9 continue - - ivx = ivxo(min(in+1,ntot)) - ip = ipo(min(in+1,ntot)) - isl = islur(ivx,ip) - if (in.eq.ntot .or. ((ivx.eq.1 .and. - * (iand(isl,67109216).gt.0 .or. btest(ipl(1,ip),28) -c * .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then -c Bits 1-13: stmgx+Tupf._) -c 14: Down fermata, was F -c 15: Trill w/o "tr", was U - * .or. btest(iornq(1,ip),4))) .or. btest(isl,15) ) -c -c Checking for start of 2nd part of jumped beam -c - * .or. btest(irest(ivx,ip),29) ) then -c -c Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam; -c flow out of if-loop and into block-wrapup -c -c 10/18/97: Problem with clef alignment. Got isl{15} set on lowest-numbered -c voice, but it wasn't first in the list at the same time. So check if -c prior notes in list have same time -c 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef -c changes on last note in the list? -c - if (btest(isl,15) .and. in.lt.ntot) then - do 50 iin = in , 1 , -1 - if (tno(iin) .gt. tol) then - in = iin - islur(ivx,ip) = ibclr(islur(ivx,ip),15) - islur(ivxo(in+1),ipo(in+1)) = - * ibset(islur(ivxo(in+1),ipo(in+1)),15) - go to 51 - end if -50 continue -51 continue - end if - if (space(ib) .lt. tol) then - space(ib) = tno(in) - squez(ib) = 1. - end if - istop(ib) = in - else if (space(ib) .lt. tol) then -c -c space hasn't been set yet, so tentatively set: -c - space(ib) = tno(in) - if (space(ib) .lt. tol) then - in=in+1 - else - squez(ib) = getsquez(in,ntot,space(ib),tnote,to) - istop(ib) = in - end if - go to 9 - else if (tno(in+1) .lt. tol) then -c -c This is not the last note in the group, so -c - in = in+1 - go to 9 - else if (abs(tno(in+1)-space(ib)) .lt. tol) then - xsquez = getsquez(in+1,ntot,space(ib),tnote,to) - if (abs(xsquez-squez(ib)) .lt. tol) then -c -c Keep spacing the same, update tentative stop point -c - in = in+1 - istop(ib) = in - go to 9 - end if - end if -c -c At this point istart and istop are good, so finalize block -c - tstart(ib) = to(istart(ib)) - if (istop(ib) .eq. ntot) go to 15 - ib = ib+1 - istart(ib) = istop(ib-1)+1 - in = istart(ib) -c -c Set tentative block space and squeeze-factor for upcoming block -c - space(ib) = tno(in) - if (space(ib).gt.tol) - * squez(ib)= getsquez(in,ntot,space(ib),tnote,to) - istop(ib) = in - go to 9 -15 continue - nb = ib -c -c Invert the list of places into ipl(0-7), making it easier to analyze a voice -c - do 13 in = 1 , ntot -c -c ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. -c -c ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) - ipl2(ivxo(in),ipo(in)) = in -13 continue -c -c Compute elemskips from start of bar to each note in the bar, for beam slopes -c - eskzb = 0. - ib = 1 - do 30 in = 1 , ntot - if (in .eq. istart(ib)) then - deskb = squez(ib)*feon(space(ib)/squez(ib)) - else if (tno(in-1) .gt. tol) then - eskzb = eskzb+deskb - end if - eskz(ivxo(in),ipo(in)) = eskzb - eskz2(ivxo(in),ipo(in)) = eskzb - if (in .eq. istop(ib)) then - eskzb = eskzb+deskb - ib = ib+1 - end if -30 continue -c -c Analyze for beams. -c - do 20 iv = 1 , nv - do 20 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - numbms(ivx) = 0 - mapfb(1) = 0 - mapfb(2) = 0 - mapfb(3) = 0 - mapfb(4) = 0 -c -c First forced beams. -c - if (nfb(ivx) .gt. 0) then -c -c tglp2 is time from start of gulp to end of current bar. -c - nfbbar = 0 - do 80 ifb = 1 , nfb(ivx) - if (t1fb(ivx,ifb).gt.tglp2-tol) go to 81 - nfbbar = nfbbar+1 - numbms(ivx) = numbms(ivx)+1 - numnew = numbms(ivx) -c -c Times from beginning of bar -c - itbb1 = int(t1fb(ivx,ifb)-tglp1+tol) - itbb2 = int(t2fb(ivx,ifb)-tglp1+tol) - do 83 ip = 1 , nn(ivx) - if (int(to(ipl2(ivx,ip))+tol) .eq. itbb1) then - nip1fb = ip - do 84 ip1 = ip , nn(ivx) - inip1 = ipl2(ivx,ip1) - if (abs(to(inip1)+tnote(inip1)-itbb2) .lt. tol) then - nip2fb = ip1 - itbb3 = itbb2-2 - go to 85 - end if -84 continue - end if -83 continue - print* - print*,'Timing problem w/ forced beams' - write(15,'(/a)')'Timing problem w/ forced beams' -85 continue - call logbeam(numnew,nip1fb,nip2fb) -c -c Set up mapfb for forced beam just logged: -c - ib1 = itbb1/2 - ib2 = itbb3/2 - ibrep = lenbar/ibmrep/2 - do 86 irep = 1 , ibmrep - ib1now = max(0,ib1-(irep-1)*ibrep) - ib2now = min(irep*ibrep-1,ib2-(irep-1)*ibrep) - mapnow = 0 - do 87 ib = ib1now , ib2now - mapnow = ibset(mapnow,ib) -87 continue - mapfb(irep) = ior(mapfb(irep),mapnow) -86 continue -c -c Since we are cycling thru forced beams, for those that start with a rest and -c have height & slope adjustments, move adjustments to next note. -c 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at -c start of beam -c - if (btest(irest(ivx,nip1fb),0)) then - do 88 kp = nip1fb+1 , nip2fb - call setbits(ipl(ivx,kp),6,11, - * igetbits(ipl(ivx,nip1fb),6,11)) - call setbits(ipl(ivx,kp),6,17, - * igetbits(ipl(ivx,nip1fb),6,17)) - call setbits(islur(ivx,kp),2,27, - * igetbits(islur(ivx,nip1fb),2,27)) -88 continue - end if -80 continue -81 continue -c -c Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar. -c Remember, makeabar is called 1/bar, and it calls findbeam once per voice. -c - if (nfbbar .gt. 0) then - nfb(ivx) = nfb(ivx)-nfbbar - do 82 ifb = 1 , nfb(ivx) - t1fb(ivx,ifb) = t1fb(ivx,ifb+nfbbar) - t2fb(ivx,ifb) = t2fb(ivx,ifb+nfbbar) - ulfbq(ivx,ifb) = ulfbq(ivx,ifb+nfbbar) -82 continue - end if - end if - ifb = 0 -c -c Done with forced beam masks for this bar and voice. Now get normal beams. -c - call findbeam(ibmrep,numbms,mapfb) -20 continue - return - end - subroutine make2bar(ninow,tglp1,tstart,cwrest,squez, - * istop,numbms,istart,clefq) - parameter (nm=24,mv=24576) - common /comlast/ islast,usevshrink - logical islast,usevshrink - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comipl2/ ipl2(nm,200) - character*10 figq - character*1 ulq,sepsymq,sq,chax - logical beamon,firstgulp,figbass,figchk,isfig,bar1syst,isbjmp, - * isbj2 - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - common /combeam/ ibmtyp - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comas2/ nasksys,wasksys(800),elasksys(800) - common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - common /comsln/ is1n1,is2n1,irzbnd,isnx - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg,issig,rpndot,autofbon - character*128 litq - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - integer istart(80),istop(80),iaskb(nm),numbms(nm), - * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2) - character*1 ulfbq,udqq,clefq(nm),slurudq,udq - character*8 noteq - character*79 cwrq(nm),notexq,inameq - character*20 voltxtq - common /comoct/ noctup - character*80 soutq,headrq,lowerq - common /comnsp/ space(80),nb,prevtn(nm), - * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) - logical bspend,lower,cwrest(nm),vxtup, - * isgrace,isclef,nofirst,iscln,isdot,isflag, - * isacc,isfirst,flgndb,btest,stemup,upslur, - * isgaft,isarp,isrshft,isaccs,iscacc, - * lowdot,flipend,iscwr,isdotted,beamon1(nm) - real*4 ptgr(37),ptclef(nm),ptsndg(nm),eskndg(nm),tstart(80), - * squez(80) - logical cwrferm,drawbm - common /comcwrf/ cwrferm(nm) - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xelsk(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /comstart/ facmtr - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac -c -c Factors for grace note, clef spacing. (fraction of wheadpt) -c In 1.04, moved to block data subprogram -c - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - common /strtmid/ ihnum3,flipend(nm),ixrest(nm) - common /comtol/ tol - common /comignorenats/ mbrhgt,newmbrhgt,ignorenats - logical ignorenats,newmbrhgt - integer*2 mmidi,iinsiv - logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur - * ,WrotePsslurDefaults - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - logical slmon,dbltie - common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), - * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, - * slmon(0:nm),dbltie - common /comevent/ miditime,lasttime - logical kbdrests - common /comkbdrests/ levbotr(8),levtopr(8),kbdrests - logical secondgrace - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /commidisig/ midisig -c 130316 - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - common /comclefrests/ centrests - logical centrests - common /xjbeambrests/ nbrests - common /comc8flag/ c8flag(nm) - logical c8flag - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - character*4 ivxq - logical rename - common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, - * poefa - real*4 poefa(125) - logical nocodabn - nbrests = 0 -c -c Set up main ib loop within which a block (notes group) is written -c - do 25 iv = 1 , nv - do 25 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - ibmcnt(ivx) = 1 - ibmcnt1(ivx) = 1 - beamon(ivx) = .false. - beamon1(ivx) = .false. - nornb(ivx) = 0 - iaskb(ivx) = 1 - vxtup(ivx) = .false. - drawbm(ivx) = .true. -25 continue - naskb = 0 - ifig(1) = 1 - ifig(2) = 1 - ixtup = 0 - bspend = .false. - iscwr = .false. - rpndot = .false. - do 16 ib = 1 , nb -c -c Check for segno -c - if (btest(iornq(1,ipo(istart(ib))),4) .and. - * ivxo(istart(ib)).eq.1) then - if (noffseg.le.-10) then - write(noteq(1:5),'(1H{,i3,1H})')noffseg - lnoten = 5 - else if (noffseg.lt.0 .or. noffseg.ge.10) then - write(noteq(1:4),'(1H{,i2,1H})')noffseg - lnoten = 4 - else - write(noteq(1:1),'(i1)')noffseg - lnoten = 1 - end if - notexq = sq//'znotes'//sq//'segnoo'//noteq(1:lnoten)//'9' - lnote = 15+lnoten - do 130 iv = 2 , nv - if (lnote .gt. 60) then - if (islast) write(11,'(a)')notexq(1:lnote)//'%' - notexq = sepsymq(iv-1)//sq//'segnoo' - * //noteq(1:lnoten)//'9' - lnote = lnoten+9 - else - notexq = notexq(1:lnote)//sepsymq(iv-1)//sq//'segnoo' - * //noteq(1:lnoten)//'9' - lnote = lnote+lnoten+9 - end if -130 continue - if (islast) write(11,'(a)')notexq(1:lnote)//sq//'en' - lnote = 0 - end if -c -c Check for new clefs -c - isclef = .false. - if (btest(islur(ivxo(istart(ib)),ipo(istart(ib))),15)) - * then -c -c In preceding line, fl32 gave wrong result for ... .gt.0 !!! -c - do 140 in = istart(ib) , istop(ib) - if (btest(islur(ivxo(in),ipo(in)),11)) then - call wsclef(ivxo(in),ninow, - * iand(ishft(islur(ivxo(in),ipo(in)),-12),7)) -c -c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% -c -c if (clefq(ivxo(in)) .eq. '8') then - if (btest(ipl(ivxo(in),ipo(in)),2)) then -c -c Find instrument number for voice ivso(in) -c - iv1 = 1 - do 1111 iinst = 1 , ninow - if (ivxo(in) .lt. iv1+nspern(iinst)) go to 2222 - iv1 = iv1+nspern(iinst) -1111 continue - print* - print*,'Should not be here in make2bar!' - call stop1() -2222 continue - if (iinst .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol', - * iinst,sq//'treblelowoct%' - else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol', - * iinst,sq//'treblelowoct%' - end if - c8flag(ivxo(in)) = .true. - end if - end if -140 continue - if (islast) write(11,'(a)')sq//'pmxnewclefs' - isclef = .true. - end if -c -c Start a notes group. We're just gonna define every one using pnotes{n}, -c where \def\pnotes#1{\vnotes#1\elemskip} -c - soutq = sq//'pnotes{' - eonsqz = squez(ib)*feon(space(ib)/squez(ib)) - if (eonsqz .gt. 9.995) then - write(soutq(9:12),'(f4.1)')eonsqz - else if (eonsqz .gt. 0.995) then - write(soutq(9:12),'(f4.2)')eonsqz - else if (eonsqz .gt. 0.095) then - soutq = soutq(1:8)//'0.' - write(soutq(11:12),'(i2)')nint(100*eonsqz) - else - soutq = soutq(1:8)//'0.0' - write(soutq(12:12),'(i1)')nint(100*eonsqz) - end if - soutq = soutq(1:12)//'}' - lsout = 13 -c -c Check whole block, flag accidentals etc that are too close, one per *time*. -c Note about bar starts and after rpt's/boublebars: There is an afterruleskip -c (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so -c (dotsfac*wheadpt) is presumed to be filled up. -c - in = istart(ib)-1 - itrpt = -1 - itsig = -1 -c -c Begin big manual loop over notes in this block; ends at 112 -c -111 in = in+1 - if (in .gt. istop(ib)) go to 112 - ip = ipo(in) - ivx = ivxo(in) - if (ivx .le. nv) then - iv = ivx - else - do 128 iv = 1 , nv - if (nvmx(iv) .eq. 2 .and. ivmx(iv,2).eq. ivx) go to 129 -128 continue - print*,'Trouble finding iv!, ivx,nvmx,ivmx:',ivx,nvmx(1),nvmx(2) - print*,ivmx(1,1),ivmx(1,2),ivmx(2,1),ivmx(2,2) - stop - end if -129 continue -c -c Call precrd here so we know how much space to add for accid's in chords -c After calling precrd, icashft>0 means there is a shifted chordal accid (incl. -c main note. -c -c To call precrd, need up-downness, so must track if in beam. -c -c Deal w/ staff-jumping beams later -c if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) -c * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. -c * btest(nacc(ivx,ip),21)) then -c if (.not.btest(irest(ivx,ip),24)) then - if ((numbms(ivx).gt.0 .and. ibmcnt1(ivx).le.numbms(ivx) - * .and. ibm1(ivx,ibmcnt1(ivx)) .eq. ip)) then - beamon1(ivx)=.true. - end if - icashft = 0 - if (btest(ipl(ivx,ip),10)) then -c -c There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. -c - if (beamon1(ivx)) then - call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), - * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt1(ivx)), - * .false.,icashft) - else - call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), - * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip), - * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv), - * .false.,icashft) - end if - end if -c -c Turn beam off? -c - if (beamon1(ivx) .and. ibm2(ivx,ibmcnt1(ivx)).eq.ip) then - beamon1(ivx) = .false. - ibmcnt1(ivx) = ibmcnt1(ivx)+1 - end if -c -c Remember, rpts & internal sigs can only come at start of (internal) block -c - isacc = iand(nacc(ivx,ip),3).gt.0 - * .and. .not.btest(nacc(ivx,ip),17) - * .and. .not.btest(ipl(ivx,ip),10) -c -c i.e., do not set for chord. Now check for "(" as ornament on main note, -c -c!!! Need to do this for chord notes too. Maybe in chkarp? -c - isaccs = isacc .or. btest(iornq(ivx,ip),0) -c -c 5/15/02 Add check for ) ornament of prior note. -c 5/16 Nope...fails when grace intervenes. -c if (ip .gt. 1) then -c isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) -c end if - isarp = btest(iornq(ivx,ip),27) - iscacc = .false. - if (btest(ipl(ivx,ip),10)) then -c -c There is a chord here; check for arpeggios and accidentals. Note accid shifts are -c not of concern here, only whether there's an accid, whick causes iscacc=.true. -c - iscacc = igetbits(nacc(ivx,ip),3,0).gt.0 .and. - * .not.btest(nacc(ivx,ip),17) - call chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp) - end if -c -c When we get motivated, will do spacing for arpeggios here. -c - if (ivx.eq.1 .and. iand(islur(ivx,ip),96).gt.0) - * itrpt = nint(to(in)) - issig = btest(ipl(ivx,ip),28) - if (ivx.eq.1 .and. issig) itsig = nint(to(in)) - isgrace = btest(islur(ivx,ip),4) .and. - * .not.btest(ipl(ivx,ip),29) .and. .not.btest(ipl(ivx,ip),31) - isgaft = .false. - if (ip .gt. 1) then - xnd = tnote(ipl2(ivx,ip-1)) - isgaft = btest(ipl(ivx,ip-1),29) .or. btest(ipl(ivx,ip-1),31) - isgrace = isgrace .or. isgaft - end if - iscln = isclef .and. btest(islur(ivx,ip),11) -c -c Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd -c - isflag = ip.gt.1 .and. xnd.gt.tol .and. xnd.lt.16.-tol - if (isflag) - * isflag = .not.btest(irest(ivx,ip-1),0) - * .and. udqq(nolev(ivx,ip-1), - * ncmid(iv,ip-1),islur(ivx,ip-1),nvmx(iv),ivx,nv).eq.'u' - if (isflag) then - do 116 ibmchk = 1 , numbms(ivx) - if (ip-1 .lt. ibm1(ivx,ibmchk)) then - go to 117 -c -c Add check for non-beamed xtuplets. May be problem with stem direction. -c - else if (ip-1.le.ibm2(ivx,ibmchk) .and. - * .not.btest(islur(ivx,ibm1(ivx,ibmchk)),18)) then - isflag = .false. - go to 117 - end if -116 continue - end if -117 continue -c -c If isflag, then won't need to check for dot on prev. note. -c -c 5/16/02 ??? Try using this for ) ornament. -c - isflag = isflag .or. btest(iornq(ivx,ip-1),13) - isdot = ip.gt.1 - if (isdot) isdot = isdotted(nodur,ivx,ip-1) - isrshft = ip .gt. 1 - if (isrshft) isrshft = btest(irest(ivx,ip-1),20) - if (.not.(isaccs.or.isgrace.or.iscln.or.isflag.or.isrshft.or. - * isdot.or.btest(iornq(ivx,ip),26).or. - * btest(irest(ivx,ip),21).or.isarp.or. - * btest(irest(ivx,ip),27).or.iscacc)) go to 111 -c -c Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. -c Compute pts, the total occupied space including prior notehead. -c -c 130324 -c wheadpt1 = wheadpt*fullsize(iv) - wheadpt1 = wheadpt*fullsize(instno(iv)) - pts = wheadpt1 -c -c Set up for possible cautionary accidental here -c - if (isaccs .or. iscacc) then - if (.not.btest(iornq(ivx,ip),31)) then - taccfac = accfac - else - taccfac = 1.4*accfac ! cautionary accidental - end if - end if - if (isgrace) then - secondgrace = .false. - do 122 ig = 1 , ngrace - if (.not. isgaft) then - if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 123 - else if (ip .gt. 1) then - if (ipg(ig).eq.ip-1 .and. ivg(ig).eq.ivx) go to 123 - end if -122 continue - print*,'Problem finding grace index in makeabar' - stop -123 continue -c -c wgr = distance to backspace (in headwidths), less main acc. -c ptgr = same in pts,+ main acc. Not used for after-grace. Distance to backspace. -c spgr = total space needed (w/o main acc). -c Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. -c - if (nng(ig) .eq. 1) then - wgr = grafac - if (multg(ig) .eq. 0) wgr = wgr-.4 - else - wgr = nng(ig)*emgfac - do 126 ing = 2 , nng(ig) - if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac -126 continue - end if - if (graspace(ig) .gt. 0.) then -c -c User-defined space before grace -c - wgr = wgr+graspace(ig) - end if - ptgr(ig) = wgr*wheadpt1 - spgr = ptgr(ig)+xb4fac*wheadpt1 -c -c!!! May need to mod for chord accid's -c - if (isaccs .or. iscacc) ptgr(ig) = ptgr(ig) + taccfac*wheadpt1 - if (naccg(ngstrt(ig)) .gt. 0) spgr = spgr+wheadpt1*agc1fac - pts = pts+spgr -c -c Special check for after-grace on ip-1 and normal on ip. Must go back thru -c loop again for the normal grace. -c - if (isgaft .and. ig.lt.ngrace .and. .not.secondgrace) then - if (ipg(ig+1).eq.ip) then - secondgrace = .true. - ig = ig+1 - go to 123 - end if - end if - end if - if (iscln) then - pts = pts+clefac*wheadpt1 -c -c How far to backspace when printing the clef -c - ptclef(ivx) = 0. -c -c!!! May need to mod for chord accid's -c - if (isaccs .or. iscacc) - * ptclef(ivx) = ptclef(ivx)+taccfac*wheadpt1 - if (isgrace) ptclef(ivx) = ptclef(ivx)+spgr - end if - if (isrshft) then - pts = pts+rtshfac*wheadpt1 - else if (isflag) then - pts = pts+flagfac*wheadpt1 - else if (isdot) then - pts = pts+dotfac*wheadpt1 - end if - if (abs(to(in)-itrpt) .lt. tol) then -c -c Repeat, need a little extra space -c - pts = pts+dotsfac*wheadpt1 - end if - if (isarp) then - pts = pts+arpfac*wheadpt1 - end if -c -c Add in padding space -c - pts = pts+xspfac*wheadpt1 -c -c Now done with all items needing space except accidentals, -c accidental shifts, and left-notehead-shifts, and will later -c subtract a notehead if at start of bar. -c -c Get available space in elemskips (esk) -c - isfirst = ip.eq.1 .or. abs(to(in)-itrpt).lt.tol .or. - * abs(to(in)-itsig).lt.tol - if (isfirst) then -c -c At start of bar or after repeat sign or new signature -c - if (abs(to(in)-itsig).lt.tol) then - esk = 0. - else - esk = fbar - end if - else -c -c Not 1st note of bar -c - esk = eskz(ivx,ip)-eskz(ivx,ip-1) - end if - if (isgrace) then -c -c Since graces can be very long, cannot assume no interference if prior -c note uses >1 noteskip. So must get elsk's back to prior note, whether or -c not it used only one noteskip. -c <>???? -c -c 10/8/05 Kluge to not zero out esk if in xtup -c - esksav = esk - if ((ip.le.2 .or. nodur(ivx,max(1,ip-2)).gt.0) .and. -c * to(in).ne.itsig) - * abs(to(in)-itsig).gt.tol) - * call eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk) - if (abs(esk) .lt. tol) esk = esksav - end if -c -c Done getting available elemskips. Remove headwidth if first. Must do here -c rather than earlier since check uses isfirst -c - if (isfirst) pts = pts-wheadpt1 -c -c Deal with accidental shifts and left-notehead shifts -c - if (btest(ipl(ivx,ip),10)) then -c -c In a chord -c - ptsl = 0. - if (btest(irest(ivx,ip),27)) ptsl = wheadpt1 - ptsadd = max(ptsl,icashft*.05*wheadpt1) -c -c Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK -c - else -c -c Not in a chord -c - ihshft = 0 - if (isaccs) then - ihshft = igetbits(nacc(ivx,ip),7,10) -c if (ihshft .ne. 0) ihshft = max(0,64-ihshft) - if (ihshft .ne. 0) ihshft = max(0,107-ihshft) - end if -c -c Check for left-shifted main note -c - if (btest(ipl(ivx,ip),8)) ihshft = max(20,ihshft) - ptsadd = ihshft*.05*wheadpt1 - end if - pts = pts+ptsadd - if (isgrace) ptgr(ig) = ptgr(ig)+ptsadd - if (iscln) ptclef(ivx) = ptclef(ivx)+ptsadd -c -c Left-shifted, non-chord note before? -c - if (ip .gt. 1) then - if (.not.btest(ipl(ivx,ip-1),10) .and. - * btest(irest(ivx,ip-1),27)) pts = pts-wheadpt1 - end if -c -c Try big accidentals first -c - ptbneed = pts - if (isaccs .or. iscacc) then - ptbneed = ptbneed+wheadpt1*bacfac - end if - if (poefa(iline)*poenom*esk .gt. ptbneed) then -c -c Set flag for big accidental -c - if (isacc) nacc(ivx,ip) = ibset(nacc(ivx,ip),3) - go to 99 - end if -c -c Cannot use big, so try small -c - ptsneed = pts - if (isaccs .or. iscacc) then - ptsneed = ptsneed+taccfac*wheadpt1 - end if - if (poefa(iline)*poenom*esk .lt. ptsneed) then - call addask(to(in),ptsneed,poefa(iline)*esk, - * fixednew,scaldold,0.,poefa(iline),.false.) - end if -99 continue - if (btest(iornq(ivx,ip),26)) then -c -c User-defined space. Warning, "zero" may change value in addask! -c - zero = 0. - call addask(to(in),ptsneed,zero, - * fixednew,scaldold,tglp1,1.,.true.) - end if -c -c End of big manual loop over "in" for accidental checking -c - go to 111 -112 continue -c -c End of ask analysis for this block. -c -c Adjust eskz if there are added spaces. Corrects length of xtup brackets. -c - if (naskb.gt.0) call adjusteskz(ib,istart,poenom) -c -c Check for internal repeat or sig change. -c - if (ib.gt.1 .and. ivxo(istart(ib)).eq.1) then - iirpt = iand(islur(1,ipo(istart(ib))),67109216) - if (iirpt .gt. 0) then -c -c Internal repeat -c - if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%' - if (iirpt .eq. 96) then - if (islast) write(11,'(a)')sq//'leftrightrepeat' - fixednew = fixednew+lrrptfac*wheadpt - else if (btest(iirpt,5)) then - if (islast) write(11,'(a)')sq//'leftrepeat' - fixednew = fixednew+rptfac*wheadpt - else if (btest(iirpt,6)) then - if (islast) write(11,'(a)')sq//'rightrepeat' - fixednew = fixednew+rptfac*wheadpt - else if (btest(iirpt,8)) then - if (islast) write(11,'(a)')sq//'doublebar' - else - print*,'Unexpected mid-bar repeat command R*' - call stop1() - end if - scaldold = scaldold-fbar - end if - if (btest(ipl(1,ipo(istart(ib))),28)) then -c -c Internal signature change. -c - notexq = sq//'generalsignature{' - lnote = 18 - if (isig .lt. 0) then - notexq = notexq(1:lnote)//'-' - lnote = lnote+1 - end if - if (islast) write(11,'(a)')notexq(1:lnote) - * //chax(48+abs(isig))//'}%' - if (islast .and. ignorenats) - * write(11,'(a)')sq//'ignorenats%' - if (islast) write(11,'(a)')sq//'zchangecontext'//sq - * //'addspace{-.5'//sq//'afterruleskip}%' - lnote = 0 - end if - end if - flgndb = .false. -c -c Done with start-of-block stuff. Begin main loop over voices. -c - do 11 iv = 1 , nv - do 11 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - icm = midchan(iv,kv) -c -c A rather klugey way to set flag for figure in this voice -c Must always check figbass before figchk. -c - if (figbass) then - ivf = 0 - if (ivx .eq. 1) then - ivf = 1 - else if (ivx .eq. ivxfig2) then - ivf = 2 - end if - if (ivf.gt.0) figchk(ivf) = nfigs(ivf).gt.0 - end if - if (ivx .gt. 1) then - if (ivx .le. nv) then - call addstr(sepsymq(iv-1),1,soutq,lsout) - else - call addstr(sq//'nextvoice',10,soutq,lsout) - end if - end if - if (ihdht.gt.0 .and. ivx.eq.nv) then -c -c Write header. First adjust height if needed to miss barno. -c - if (bar1syst .and. iline.ne.1) then - ihdht = 15+irzbnd+isnx - end if -c -c Add user-defined vertical shift -c - ihdht = ihdht+ihdvrt - lchead = lenstr(headrq,80) - notexq = sq//'zcharnote{' - write(notexq(12:13),'(i2)')ihdht - notexq = notexq(1:13)//'}{'//sq//'bigfont'//sq//'kern-30pt ' - call addstr(notexq,34,soutq,lsout) - call addstr(headrq(1:lchead)//'}',1+lchead,soutq,lsout) - ihdht = 0 - end if - if (lower .and. ivx.eq.nv) then - lclow = lenstr(lowerq,80) - call addstr(sq//'zcharnote{-6}{'// - * sq//'tempo'//sq//'kern-10pt '// - * lowerq(1:lclow)//'}',33+lclow,soutq,lsout) - lower=.false. - end if - tnow = tstart(ib) - nofirst = .true. -c -c Done setting up voice ivx for start of block ib. Loop over notes in voice. -c - do 10 jn = istart(ib), istop(ib) - if (ivxo(jn) .ne. ivx) go to 10 - ip = ipo(jn) -c -c May have problem with not initializing islhgt, so do it here -c - islhgt = 0 -c - if (nofirst) then - noctup = 0 - if (ncmid(iv,ip) .eq. 23) noctup = -2 - nofirst = .false. - end if -c -c Check for internal floating figure (before last note of group). -c -12 if (figbass) then - if (ivx.eq.1 .or. ivx.eq.ivxfig2) then - ivf = 1 - if (ivx .gt. 1) ivf = 2 - if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.tnow-tol) - * then -c -c Bypassed figure location. Backup, place fig, return. -c - offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib) - call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq, - * lsout) - go to 12 - end if - end if - end if -c -c Put in \sk if needed -c - if (to(jn) .gt. tnow+tol) then - call addstr(sq//'sk',3,soutq,lsout) - tnow = tnow+space(ib) - go to 12 - end if -c -c Check for user-defined shifts -c - if (btest(irest(ivx,ip),15).or.btest(irest(ivx,ip),16)) - * call putshft(ivx,.true.,soutq,lsout) -21 if (iaskb(ivx).le.naskb .and. - * tnow.gt.task(iaskb(ivx))-tol) then - if (task(iaskb(ivx)) .gt. tstart(ib)-tol) then -c -c Insert placeholder for accidental skip -c - call addstr(sq//'ask ',9,soutq,lsout) - nasksys = nasksys+1 - wasksys(nasksys) = wask(iaskb(ivx)) - if (wask(iaskb(ivx)) .gt. 0.) then - elasksys(nasksys) = elask(iaskb(ivx)) - else -c -c This is a signal to permit negative ask's. Should really have elask>=0. -c - elasksys(nasksys) = -elask(iaskb(ivx)) - end if - end if -c -c May have skipped some task's in earlier blocks (due to void voice) -c - iaskb(ivx) = iaskb(ivx)+1 - go to 21 - end if - if (figbass) then - if (ivx.eq.1 .or. ivx.eq.ivxfig2) then - ivf = 1 - if (ivx .gt. 1) ivf = 2 - if (figchk(ivf) .and. - * abs(itfig(ivf,ifig(ivf))-tnow).lt.tol) then -c -c Figure on a note. NB: later special check for late figs. -c - call putfig(ivf,ifig(ivf),0.,figchk(ivf),soutq,lsout) - end if - end if - end if -c -c Check for new clef here. -c - if (isclef .and. btest(islur(ivx,ip),11)) then - if (ptclef(iv) .gt. 0.) then - notexq = sq//'off{-' - if (ptclef(iv) .lt. 9.95) then - write(notexq(7:9),'(f3.1)')ptclef(iv) - lnote = 9 - else - write(notexq(7:10),'(f4.1)')ptclef(iv) - lnote = 10 - end if - notexq = notexq(1:lnote)//'pt}' - lnote = lnote+3 - call addstr(notexq,lnote,soutq,lsout) - end if - call clefsym(islur(iv,ip),notexq,lnote,nclef) -c -c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' -c - if (btest(ipl(ivx,ip),2)) notexq = - * notexq(1:8)//'8'//notexq(10:10) - call addstr(notexq,lnote,soutq,lsout) - if (ptclef(iv) .gt. 0.) then - notexq = sq//'off{' - if (ptclef(iv) .lt. 9.95) then - write(notexq(6:8),'(f3.1)')ptclef(iv) - lnote = 8 - else - write(notexq(6:9),'(f4.1)')ptclef(iv) - lnote = 9 - end if - notexq = notexq(1:lnote)//'pt}' - lnote = lnote+3 - call addstr(notexq,lnote,soutq,lsout) - end if - end if -c -c Checking for literal TeX string BEFORE starting beams!! -c - if (btest(islur(ivx,ip),16)) then - do 124 il = 1 , nlit - if (iplit(il).eq.ip .and. ivlit(il).eq.ivx) go to 125 -124 continue - print*,'Problem finding index for literal string' - call stop1() -125 continue -c -c Write a type 1 tex string. -c - if (lenlit(il) .lt. 71) then -c -c Add normally -c - call addstr(litq(il),lenlit(il),soutq,lsout) - else -c -c Longer than 71. Write souq, Write string, start new soutq. -c - if (islast) write(11,'(a)')soutq(1:lsout)//'%' - if (islast) write(11,'(a)')litq(il)(1:lenlit(il))//'%' - lsout = 0 - end if - end if -c -c Arpeggio on a main (non-chordal) note? -c - if (btest(iornq(ivx,ip),27)) then -c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), - call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip), - * soutq,lsout) - end if -c -c See if a beam starts here -c - if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) - * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. - * btest(nacc(ivx,ip),21)) then - if (.not.btest(irest(ivx,ip),24)) then -c -c Not a jump start -c - if (kbdrests .and. btest(irest(ivx,ip),0) .and. - * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. - * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult,ipl) - call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) -c -c Shift beam start if notehead was shifted -c - if (btest(ipl(ivx,ip),8)) then - call addstr(sq//'loff{',6,soutq,lsout) - else if (btest(ipl(ivx,ip),9)) then - call addstr(sq//'roff{',6,soutq,lsout) - end if - if (lnote .gt. 0) call addstr(notexq,lnote,soutq,lsout) - if (btest(ipl(ivx,ip),8) .or. - * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) - else -c -c Jump start. Set marker for second part of a jump beam. Note ivbj2 was set -c to 0 at end of first part of jump beam -c - ivbj2 = ivx -c -c Check for xtup since we bypassed beamstrt wherein vxtup is normally set -c - if (btest(irest(ivx,ip),28) .and. ixrest(ivx).ne.2) - * vxtup(ivx) = .true. -c -c Since beamstrt is not called, and drawbm is normally set there, need to set -c it here. This could cause problems if someone tries a staff-jumping, -c unbarred beam, which I'll deal with when it comes up. -c - drawbm(ivx) = .true. - end if - if (ixrest(ivx) .eq. 0) then - beamon(ivx) = .true. - bspend = .true. - if (.not.btest(irest(ivx,ip),24))bspend = .true. - end if - end if -c -c Setup for chords and possible slurs in chords -c - if (btest(ipl(ivx,ip),10)) then -c -c There is a chord on this note. Just rerun precrd. Klunky, but saves -c me from tracking down errors instroduced when I moved 1st call -c forward for accidental spacing analysis. -c - if (beamon(ivx)) then - call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), - * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt(ivx)), - * .true.,icashft) - else - call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), - * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip), - * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv), - * .true.,icashft) - end if - end if -c -c Is there slur or grace activity? -c - isgrace = btest(islur(ivx,ip),4) - if (ip .gt. 1) isgrace = isgrace.or.btest(ipl(ivx,ip-1),31) -c -c isgrace if not 1st note in bar and previous note has Way-after grace. -c - if (btest(islur(ivx,ip),0) .or. isgrace) then - if (btest(islur(ivx,ip),0)) then - if (fontslur) then -c -c Call routine for non-postscript slurs -c - call doslur(nolev(ivx,ip),isdat1,isdat2,isdat3,nsdat, - * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout, - * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip), - * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), - * nacc(ivx,ip)) - else -c -c Postscript slurs -c - call dopsslur(nolev(ivx,ip),isdat1,isdat2,isdat3, - * isdat4,nsdat, - * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout, - * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip), - * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), - * nacc(ivx,ip)) - end if - end if - if (isgrace) then -c -c Grace note. -c - iphold = ip - isgrace = .false. - if (ip .gt. 1) isgrace = btest(ipl(ivx,ip-1),31) - if (isgrace) iphold = iphold-1 - isgrace = isgrace .or. (.not.btest(ipl(ivx,ip),31) - * .and..not.btest(ipl(ivx,ip),29)) -c -c Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace -c on current note. Do A-grace on current note, and W-grace at barend, later. -c - if (isgrace) then - call dograce(ivx,iphold,ptgr,soutq,lsout,ncmid(iv,ip), - * nacc(ivx,ip),ig,ipl(ivx,iphold),.false., - * beamon(ivx),nolev(ivx,ip),ncmid(iv,ip), - * islur(ivx,ip),nvmx(iv),nv,ibmcnt(ivx), -c 130324 -c * tnote(ipl2(ivx,ip)),ulq) - * tnote(ipl2(ivx,ip)),ulq,instno(iv)) - if (slurg(ig)) then -c -c Terminate slur started in dograce. Get direction of main note stem -c - if (.not.beamon(ivx)) then -c -c Separate note. Get stem direction. -c - stemup = udqq(nolev(ivx,ip),ncmid(iv,ip), - * islur(ivx,ip),nvmx(iv),ivx,nv) .eq. 'u' - else -c -c In a beam -c - stemup = ulq(ivx,ibmcnt(ivx)) .eq. 'u' - end if -c -c Stop the shift if whole note -c - stemup = stemup .or. - * tnote(ipl2(ivx,ip)).gt.63 - call endslur(stemup,.not.upg(ig),nolev(ivx,ip),0, - * ndxslur,0,ncmid(iv,ip),soutq,lsout,fontslur) - end if - end if - end if - if (btest(iornq(ivx,ip),24)) then -c -c Start slur on main note for After- or Way-after-grace. -c -c???? ndxslur = log2(33554431-listslur) - ndxslur = log2(16777215-listslur) -c -c Get note name -c - call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) -c -c Get slur direction -c - slurudq = 'u' - if (.not.beamon(ivx)) then - if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), - * nvmx(iv),ivx,nv) .eq. 'u') slurudq = 'd' - else - if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') slurudq = 'd' - end if -c -cc Replace ndxslur by 11-ndxslur when printing only. -c Replace ndxslur by 23-ndxslur when printing only. -c -c if (11-ndxslur .lt. 10) then - if (23-ndxslur .lt. 10) then -c notexq = sq//'islur'//slurudq//chax(59-ndxslur) - notexq = sq//'islur'//slurudq//chax(71-ndxslur) - * //noteq(1:lnoten) - call addstr(notexq,8+lnoten,soutq,lsout) - else if (23-ndxslur .lt. 20) then - notexq = sq//'islur'//slurudq//'{1'//chax(61-ndxslur) - * //'}'//noteq(1:lnoten) - call addstr(notexq,11+lnoten,soutq,lsout) - else - notexq = sq//'islur'//slurudq//'{2'//chax(51-ndxslur) - * //'}'//noteq(1:lnoten) - call addstr(notexq,11+lnoten,soutq,lsout) - end if -c call setbits(ipl(ivx,ip),4,23,ndxslur) - call setbits(ipl(ivx,ip),5,23,ndxslur) - if (btest(ipl(ivx,ip),31)) -c -c Starting slur on W-grace on THIS note. Record ndxslur. -c - * listslur = ibset(listslur,ndxslur) - end if - end if -c -c Process dynamic marks -c - if (btest(irest(ivx,ip),26)) then - call dodyn(ivx,ip, - * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip), - * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq, - * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout) - end if -c -c Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. -c - if (btest(ipl(ivx,ip),10)) then -c -c Need a duration to set type of note head -c -c Clumsy test, but vxtup is not set until main note is processed. -c - if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then - nodu = nodur(ivx,ip) - else if (btest(irest(ivx,ip),2) .or. - * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then -c -c In a 2-note tremolo -c - if (btest(irest(ivx,ip),2)) then -c -c First note of tremolo, duration is on next note -c - nodu = nodur(ivx,ip+1) - else - nodu = nodur(ivx,ip) - end if - else if (iand(mult(ivx,ip),15)-8 .lt. 0) then - nodu = 32 - else - nodu = 16 - end if - call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout, - * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv, - * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen, - * btest(nacc(ivx,ip),27),nacc(ivx,ip), - * irest) - end if -c -c Now that chords are done, add stuff to midi file -c - if (ismidi) call addmidi(icm, -c 130316 - * nolev(ivx,ip)+miditran(instno(iv)), - * iand(nacc(ivx,ip),7),midisig, - * tnote(ipl2(ivx,ip)), - * btest(irest(ivx,ip),0),.false.) -c -c Check for breath or caesura -c - if (btest(iornq(ivx,ip),28)) then - call putcb(ivx,ip,notexq,lnote) - call addstr(notexq,lnote,soutq,lsout) - end if -c -c Check for main-note ornaments. ')' on dotted notes go in with note, not here. -c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F -c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD -c -c isacc = iand(iornq(ivx,ip),4194287) .gt. 0 -c isacc = iand(iornq(ivx,ip),541065199) .gt. 0 - isacc = iand(iornq(ivx,ip),1614807023) .gt. 0 -c -c isacc=.true. if any ornament except segno -c - if (btest(iornq(ivx,ip),13) .and. nodur(ivx,ip).gt.0) then -c -c If ). is only ornament, bypass. If with others, temporarirly zero the bit. -c - if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then - if (iand(iornq(ivx,ip),516079) .eq. 0) then -c -c ). is the only non-segno ornament -c - isacc = .false. - else -c -c There are other ornaments in addition -c - rpndot = .true. - iornq(ivx,ip) = ibclr(iornq(ivx,ip),13) - end if - end if - end if - if (isacc .and. .not.cwrferm(ivx)) then -c -c Check for centered whole-bar rest with fermata (bits 10 or 14). -c - if (iand(iornq(ivx,ip),17408).gt.0 - * .and. btest(irest(ivx,ip),0) .and. - * nodur(ivx,ip).eq.lenbar .and. - * .not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)) then - cwrferm(ivx) = .true. - go to 30 - end if - call putorn(iornq(ivx,ip),nolev(ivx,ip),nolev(ivx,ip), - * nodur(ivx,ip),nornb,ulq,ibmcnt(ivx),ivx,ncmid(iv,ip), - * islur(ivx,ip),nvmx(iv),nv,ihornb,stemlen, - * notexq,lnote,ip,islhgt,beamon(ivx), - * btest(ipl(ivx,ip),10)) - call addstr(notexq,lnote,soutq,lsout) - end if - if (rpndot) then - iornq(ivx,ip) = ibset(iornq(ivx,ip),13) - rpndot = .false. - end if -30 continue -c -c Check for main note accidental -c - if (iand(nacc(ivx,ip),3).gt.0 .and. - * .not.btest(nacc(ivx,ip),17)) then - ihshft = igetbits(nacc(ivx,ip),7,10) - if (ihshft .ne. 0) ihshft=ihshft-107 - if (.not.btest(ipl(ivx,ip),10) .and. btest(ipl(ivx,ip),8)) -c -c Not a chord, and left-shifted main note, so left-shift accid -c - * ihshft = ihshft-20 - call doacc(ihshft,igetbits(nacc(ivx,ip),6,4), - * notexq,lnote,nacc(ivx,ip),nolev(ivx,ip),ncmid(iv,ip), - * btest(irest(ivx,ip),31)) - call addstr(notexq,lnote,soutq,lsout) - end if -c -c Lower dot for lower-voice notes. Conditions are: -c 1. Dotted time value -c 2. Lower voice of two -c 3. Note is on a line -c 4. Not a rest -c. 5. Flag (lowdot) is set to true -c 6. Not in an xtuplet -c - if (lowdot .and. nvmx(iv).eq.2 .and. ivx.le.nv - * .and. nodur(ivx,ip).ne.0) then - if (.not.btest(irest(ivx,ip),0) .and. - * 2**log2(nodur(ivx,ip)).ne.nodur(ivx,ip) .and. - * mod(nolev(ivx,ip)-ncmid(ivx,ip),2).eq.0) then - if (btest(irest(ivx,ip),19)) then -c -c Note already in movdot list. Drop by 2. -c - updot(ivx,ndotmv(ivx)+1) = - * updot(ivx,ndotmv(ivx)+1)-2. - else -c -c Not in list so just move it right now -c - call dotmov(-2.,0.,soutq,lsout, - * igetbits(islur(ivx,ip),1,3)) - end if - end if - end if -c -c Check for dotted main notes with moved dots. Chord notes done elsewhere. -c Added check rules out special chordal 2nds, but later must check -c substituted chord note for dot shift that now applies to main note. -c - if (btest(irest(ivx,ip),19)) then - ndotmv(ivx) = ndotmv(ivx)+1 - call dotmov(updot(ivx,ndotmv(ivx)),rtdot(ivx,ndotmv(ivx)), - * soutq,lsout,igetbits(islur(ivx,ip),1,3)) - end if -c -c Stemlength changes -c - if (btest(mult(ivx,ip),27)) then - dstemlen = igetbits(mult(ivx,ip),6,10)*.5-4. - call addstr(sq//'stdstemfalse',13,soutq,lsout) - stemshort = 4.66+.667*dstemlen - call addstr(sq//'stemlength{',12,soutq,lsout) - write(notexq,'(f4.1)')stemshort - call addstr(notexq(1:4)//'}',5,soutq,lsout) - else if (ip .gt. 1) then - if (btest(mult(ivx,ip-1),27)) -c -c Cancel shortening. Looks like it gets automatically restored if new inst. or -c new line, so no need to worry about affecting other lines -c - * call addstr(sq//'stemlength{4.66}',17,soutq,lsout) - end if -c -c Zero out slur-height marker for raising ornaments -c - islhgt = 0 -c -c Now start with spacing notes. Is a beam start pending? -c - if (bspend .and. - * ibm2(ivx,ibmcnt(ivx)).gt.ibm1(ivx,ibmcnt(ivx))) then - if (ixrest(ivx) .eq. 4) then -c -c Special path for single note at end of otherwise beamed xtup -c - ixrest(ivx) = 0 - else - if (kbdrests .and. btest(irest(ivx,ip),0) .and. - * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. - * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult,ipl) - if (btest(islur(ivx,ip),29) - * .and.btest(irest(ivx,ip),24)) then - notexq = chax(92)//'sk' - lnote = 3 - else - call beamn1(notexq,lnote) -c if (isbjmp .and. - if (isbjmp .and. ivbj2.ne.0 .and. - * iand(mult(ivx,ip),15)-8 .gt. multbj1) then -c -c Need to increase multiplicity at the beam jump -c -c ibmcnt was increased by 1 at the end of first seg of jump beam!? -c Try adding e.g. \nbbu1 if needed to increase multiplicity. Add -c character in reverse order to start of notexq. -c - if (ivbj1 .lt. 9) then - notexq = char(48+ivbj1)//notexq(1:lnote) - lnote = lnote+1 - else - notexq = '{1'//char(38+ivbj1)//'}' - * //notexq(1:lnote) - lnote = lnote+4 - end if - notexq = 'bb'//ulq(ivbj1,ibmcnt(ivbj1)-1) - * //notexq(1:lnote) - lnote = lnote+3 - if (iand(15,mult(ivx,ip))-8 .eq. 3) then - notexq = 'b'//notexq(1:lnote) - lnote = lnote+1 - end if - notexq = sq//'n'//notexq(1:lnote) - lnote = lnote+2 - end if - end if - end if - bspend = .false. -c -c Is a beam ending? -c - else if (numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) - * .and. (ibm2(ivx,ibmcnt(ivx)).eq.ip .or. - * btest(nacc(ivx,ip),20))) then - if (bspend) then -c -c Must be a single-note ending of a jump-beam -c - bspend = .false. - end if - call beamend(notexq,lnote) - if (isbjmp .and. ivx.eq.ivbj1) then -c -c Jump beam segment is ending, check if multiplicity DECREASES -c - if (space(ib+1) .gt. space(ib)) then -c -c Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8. -c - if (ivx .lt. 10) then - ivxq = char(ivx+48) - livx = 1 - else - ivxq = '{1'//char(ivx-10)//'}' - livx = 4 - end if -c Changes to get staffcrossall.pmx to work. Not clear how. -c if (nint(space(ib+1)-space(ib)) .eq. 6) then - if (space(ib+1).eq.8..and.space(ib).eq.2.) then - notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))// - * ivxq(1:livx)//sq//'tbb'// - * ulq(ivx,ibmcnt(ivx))//ivxq(1:livx)//notexq(1:lnote) - lnote = lnote+11+2*livx -c else if (nint(space(ib+1)-space(ib)) .eq. 4) then - else if (space(ib+1).eq.8..and.space(ib).eq.4.) then - notexq = sq//'tbb'//ulq(ivx,ibmcnt(ivx))// - * ivxq(1:livx)//notexq(1:lnote) - lnote = lnote+5+livx -c else - else if (space(ib+1).eq.4..and.space(ib).eq.2.) then - notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))// - * ivxq(1:livx)//notexq(1:lnote) - lnote = lnote+6+livx - end if - end if - end if - if (.not.btest(nacc(ivx,ip),20)) then - vxtup(ivx) = .false. - nornb(ivx) = 0 - ibmcnt(ivx) = ibmcnt(ivx)+1 - beamon(ivx) = .false. - end if -c -c Or if we're in the middle of a beam -c - else if (numbms(ivx).gt.0 .and. beamon(ivx)) then -c -c Added 130127 -c - if (kbdrests .and. btest(irest(ivx,ip),0) .and. - * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. - * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult,ipl) - call beamid(notexq,lnote) -c -c Or whole-bar rest -c - else if (btest(irest(ivx,ip),0) - * .and. nodur(ivx,ip).eq.lenbar - * .and..not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0) - * .and..not.btest(irest(ivx,ip),25) - * .and..not.btest(islur(ivx,ip),29)) then -c -c Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp -c - cwrest(ivx) = .true. - iscwr = .true. - call notex(cwrq(ivx),lcwr(ivx)) - tnow = tnow+lenbar - go to 10 - else if (ixrest(ivx) .eq. 0) then -c -c Before writing note or rest, check for keyboard rest height adjustment. -c Conditions are 0. This is a non-blank rest -c 1. kbdrests = .true. -c 2. There are two voices on the staff -c 3. No user-def height adjustments have been applied (nolev<50) -c - if (kbdrests .and. btest(irest(ivx,ip),0) .and. - * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. - * nolev(ivx,ip).le.50) then - call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, - * mult,ipl) - end if - if (btest(ipl(ivx,ip),4)) then -c -c Deal with single stem tremolo -c Get up-downness, borrowed from notex -c - if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), - * nvmx(iv),ivx,nv).eq.'u') then - udq = 'u' - else - udq = 'l' - end if - multtrem = igetbits(ipl(ivx,ip),2,5)+1 - if (nodur(ivx,ip) .lt. 64) then - notexq = sq//'tr' - else - notexq = sq//'Tr' - end if - lnote = 3 - if (multtrem .eq. 2) then - notexq = notexq(1:3)//'r' - lnote = 4 - else if (multtrem .eq.3) then - notexq = notexq(1:3)//'rr' - lnote = 5 - end if -c -c Get a numerical pitch argument -c - lineno = nolev(ivx,ip)-ncmid(iv,ip)+4 - if (lineno .lt.0 .or. lineno .gt.9) then - write(noteq,'(a1,i2,a1)')'{',lineno,'}' - lnoten = 4 - else - noteq = char(lineno+48) - lnoten = 1 - end if - notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten) - lnote = lnote+2+lnoten - call addstr(notexq,lnote,soutq,lsout) - end if -c -c Get code for a separate note or rest -c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), -c pitch will be shifted +/-1 inside notex. -c - call notex(notexq,lnote) - end if -c -c Right offset? This may cause trouble -c - if (btest(ipl(ivx,ip),8)) then - call addstr(sq//'loff{',6,soutq,lsout) - else if (btest(ipl(ivx,ip),9)) then - call addstr(sq//'roff{',6,soutq,lsout) - end if - if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then - call addstr(notexq,lnote,soutq,lsout) - end if - if (btest(ipl(ivx,ip),8) .or. - * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) -c -c Terminate user-defined offsets. Fix format -c - if (btest(irest(ivx,ip),15) .or. btest(irest(ivx,ip),17)) - * call putshft(ivx,.false.,soutq,lsout) -c -c Deal with After- and Way-after-graces. First, if end of bar, compute space -c needed since it wasn't done during general ask-checks. If extra space is -c rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. -c But will still need to add extra space as hardspace. -c - if (ip.eq.nn(ivx) .and. (btest(ipl(ivx,ip),31).or. - * btest(ipl(ivx,ip),29))) then - do 77 ig = 1 , ngrace - if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 78 -77 continue - print*,'Problem finding grace index at "do 77"' - call stop1() -78 continue -c -c Get elemskip to end of bar. WON'T WORK IF XTUPS !! -c - esk = 0. - do 40 iib = ib , nb - if (iib .eq. ib) then - itleft = nint(to(ipl2(ivx,ip))) - else - itleft = nint(tstart(ib)) - end if - if (iib .lt. nb) then - itright = nint(tstart(iib+1)) - else - itright = lenbar - end if - esk = esk+feon(space(ib))* - * (itright-itleft)/space(ib) -40 continue - ptsavail = poenom*esk-wheadpt - if (nng(ig) .eq. 1) then - wgr = grafac - else - wgr = nng(ig)*emgfac - do 41 ing = 1 , nng(ig) - if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac -41 continue - end if - ptgr(ig) = wgr*wheadpt - ptsneed = (wgr+0.5)*wheadpt - ptsndg(ivx) = 0. - if (ptsavail .lt. ptsneed) then - ptsndg(ivx) = ptsneed - eskndg(ivx) = esk - if (btest(ipl(ivx,ip),31)) then -c -c Convert GW to GA -c - ipl(ivx,ip) = ibset(ibclr(ipl(ivx,ip),31),29) - end if - end if - end if -c -c Check for GA -c - if (btest(ipl(ivx,ip),29)) - * call dograce(ivx,ip,ptgr,soutq,lsout,ncmid(iv,ip), - * nacc(ivx,ip),ig,ipl(ivx,ip),.false., -c 130324 -c * .false.,0,0,0,0,0,0,0.,ulq) - * .false.,0,0,0,0,0,0,0.,ulq,instno(iv)) -c -c Update running time -c - tnow = tnow+space(ib) -10 continue -c -c Have finished last note in this voice and block -c - itendb = nint(to(istop(ib))+space(ib)) - if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then - ivf = 1 - if (ivx .gt. 1) ivf = 2 -17 if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.itendb) then -c -c There's at least one figure left. offnsk could be <0 -c - offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib) - call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,lsout) - go to 17 - end if - end if -c -c Check for flag, dot, or upstem on last note of bar. -c - if (ib .eq. nb) then - ip = ipo(ipl2(ivx,nn(ivx))) - flgndv(ivx) = 0. - if (abs(tnote(ipl2(ivx,ip))-space(ib)).lt.tol) then - if (space(ib) .lt. 16.-tol) then -c -c Note in last space, smaller than a quarter note. -c - if ((.not.btest(irest(ivx,ip),0) .and. - * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), - * nvmx(iv),ivx,nv).eq.'u') - * .or. isdotted(nodur,ivx,ip)) then -c -c Upstem non-rest, or dotted -c - if (numbms(ivx).gt.0 - * .and. ip.eq.ibm2(ivx,max(1,numbms(ivx))) - * .and. .not.isdotted(nodur,ivx,ip)) - * then -c -c In beam and not dotted, so use smaller space -c - flgndv(ivx) = upstmfac - else - flgndv(ivx) = flagfac - end if - end if - else -c -c Last space, nonflagged (no beam) only worry dot or up -c - if (isdotted(nodur,ivx,ip)) then - flgndv(ivx) = flagfac - else if (tnote(ipl2(ivx,ip)).lt.64 .and. - * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), - * nvmx(iv),ivx,nv).eq.'u') then -c -c Upstem on last note , non-flagged -c - flgndv(ivx) = upstmfac - end if - end if - end if -c -c Check for right-shifted chordal note -c - if (btest(irest(ivx,ip),20)) flgndv(ivx) = rtshfac - flgndb = flgndb .or. flgndv(ivx).gt.0. - if (ismidi) then -c -c For midi, set flags for accidentals on last note of bar. Assume they affect -c first note of next bar whether or not tied. -c Note has already been done, so next entry into addmidi is 1st in new bar. -c First do main note, then chord notes -c -c Gyrations needed to account for multi-bar tied full-bar notes? -cc Old old lbacc(icm) = iand(nacc(ivx,ip),7) -c New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) -c - if (iand(nacc(ivx,ip),7) .gt. 0) then -c -c Explicit accidental on last main note in bar -c - do 55 kacc = 1 , naccbl(icm) - if (laccbl(icm,kacc) .eq. nolev(ivx,ip)) go to 56 -55 continue - naccbl(icm) = naccbl(icm)+1 - laccbl(icm,naccbl(icm)) = nolev(ivx,ip) - jaccbl(icm,naccbl(icm)) = iashft(iand(nacc(ivx,ip),7)) - end if -56 continue - if (btest(ipl(ivx,ip),10) .and. crdacc) then - do 57 icrd = icrd1 , icrd2 - iacc = igetbits(icrdat(icrd),3,20) - if (iacc .gt. 0) then -c -c Explicit accidental on chord note at end of bar -c - nolevc = igetbits(icrdat(icrd),7,12) - do 58 kacc = 1 , naccbl(icm) - if (laccbl(icm,kacc) .eq. nolevc) go to 59 -58 continue - naccbl(icm) = naccbl(icm)+1 - laccbl(icm,naccbl(icm)) = nolevc - jaccbl(icm,naccbl(icm)) = iashft(iacc) - end if -59 continue -57 continue - end if -c if (lbacc(icm).eq.0 .and. accb4(icm)) then - do 65 kacc = 1 , naccim(icm) -c -c If naccim(icm)>0, -c possible implicit accidental from earlier in the bar. Check for prior accid -c in this bar at relevant note levels, main and chord notes. Only act if no -c explicit action from just above. Assuming any accid on last note in bar, -c either explicit or implicit, has same effect on 1st note of next bar. -c - if (nolev(ivx,ip) .eq. laccim(icm,kacc)) go to 66 - if (btest(ipl(ivx,ip),10)) then - do 67 icrd = icrd1 , icrd2 - if (iand(ishft(icrdat(icrd),-12),127) .eq. - * laccim(icm,kacc)) go to 66 -67 continue - end if - go to 65 -66 continue -c -c So far we know there is a main or chord note at level laccim(icm,kacc). So -c it will get a bl-accid if it didn't just already get one. -c - do 68 macc = 1 , naccbl(icm) - if (laccbl(icm,macc) .eq. laccim(icm,kacc)) go to 65 -68 continue - naccbl(icm) = naccbl(icm)+1 - laccbl(icm,naccbl(icm)) = laccim(icm,kacc) - jaccbl(icm,naccbl(icm)) = jaccim(icm,kacc) -65 continue - end if - end if -11 continue -c -c Close out the notes group -c - call addstr(sq//'en',3,soutq,lsout) - if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%' -16 continue -c -c Check for way-after graces at end of bar. We could not link these to notes -c as in midbar since there is no note following grace! Also, set flag if -c hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. -c - isgrace = .false. - do 75 iv = 1 , nv - nvmxsav(iv) = nvmx(iv) - do 75 kv = 1 , nvmx(iv) - ivmxsav(iv,kv) = ivmx(iv,kv) - ivx = ivmx(iv,kv) - ptsgnd = 0. - if ((btest(ipl(ivx,nn(ivx)),29).or.btest(ipl(ivx,nn(ivx)),31)) - * .and. ptsndg(ivx).gt.0.) then - flgndb = .true. - if (ptsndg(ivx) .gt. ptsgnd) then - ptsgnd = ptsndg(ivx) - eskgnd = eskndg(ivx) - end if - end if - if (btest(ipl(ivx,nn(ivx)),31)) then -c -c This voice has a way-after grace here at end of bar -c - if (.not.isgrace) then -c -c This is the first one, so set up the string -c - isgrace = .true. - ivlast = 1 - soutq = sq//'znotes' - lsout = 7 - end if - do 76 iiv = ivlast , iv-1 - call addstr(sepsymq(iiv),1,soutq,lsout) -76 continue - ivlast = iv -c -c No need to put in 'nextvoice', even if 2 lines/staff -c - call dograce(ivx,nn(ivx),ptgr,soutq,lsout,ncmid(iv,nn(ivx)), - * nacc(ivx,nn(ivx)),ig,ipl(ivx,nn(ivx)),.true., -c 130324 -c * .false.,0,0,0,0,0,0,0.,ulq) - * .false.,0,0,0,0,0,0,0.,ulq,instno(iv)) - end if -75 continue - if (isgrace) then - call addstr(sq//'en%',4,soutq,lsout) - if (islast .and. lsout .gt. 0) write(11,'(a)')soutq(1:lsout) - end if - lsout = 0 -c -c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest -c This has to be the only use of atnextbar -c - if (ibar.eq.ibarmbr .and. islast) then - if (newmbrhgt) then - soutq = sq//'def'//sq//'mbrhgt{' - if (mbrhgt .le. -10) then - write(soutq(13:15),'(i3)')mbrhgt - lsout = 15 - else if (mbrhgt.ge.10.or.mbrhgt.le.-1) then - write(soutq(13:14),'(i2)')mbrhgt - lsout = 14 - else - soutq = soutq(1:12)//char(48+mbrhgt) - lsout = 13 - end if - soutq = soutq(1:lsout)//'}%' - write(11,'(a)')soutq(1:lsout+2) - newmbrhgt = .false. - end if - soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes' - lsout = 22 - notexq = sq//'mbrest' - lnote = 7 - call istring(mbrest,noteq,len) - notexq = notexq(1:lnote)//noteq(1:len) - lnote = lnote+len - mtrspc = nint(xb4mbr) - xb4mbr = 0. - call istring(mtrspc,noteq,len) - notexq = notexq(1:lnote)//noteq(1:len)//'0' - lnote = lnote+len+1 - do 62 iv = 1 , nv - call addstr(notexq,lnote,soutq,lsout) - if (iv .lt. nv) call addstr(sepsymq(iv),1,soutq,lsout) -62 continue - call addstr(sq//'en}%',5,soutq,lsout) - write(11,'(a)')soutq(1:lsout) - lsout = 0 - if (ishort .gt. 0) then - mbrsum = mbrsum+mbrest - nmbr = nmbr+1 - end if - if (mbrest .gt. 1) then - ndig = int(alog10(mbrest-1+.01))+1 - write(11,'(a14,i'//chax(48+ndig)//',a1)') - * sq//'advance'//sq//'barno',mbrest-1,'%' - end if - else if (iscwr) then -c -c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar -c to check for new clef and add space by redefining \CenterBar -c - centrests = .true. - call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout) - call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22, - * soutq,lsout) - do 60 iv = 1 , nv -c added - lnote = 0 -c - do 61 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - if (cwrest(ivx)) then - call addstr(sq//'CenterBar{',11,soutq,lsout) - if (.not.cwrferm(ivx)) then - if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then -c -c Kluge to use new definitions for centered, stacked rests -c - if (cwrq(ivx)(2:10).eq.'liftpause' .or. - * cwrq(ivx)(2:10).eq.'liftPAuse') - * cwrq(ivx)(10:10) = 'c' - end if - call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq, - * lsout) - call addstr('}{-2}{'//sq//'value}',13,soutq,lsout) - else -c -c Fermata on centered rest. Will need to fix up level. -c 12/6/07 shift it left so it's centered over rest -c - notexq = notexq(1:lnote)//sq//'loffset{.33}{' - * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx)) - * //'}{-2}{'//sq//'value}' - lnote = lnote+26+lcwr(ivx)+13 - call addstr(notexq,lnote,soutq,lsout) - cwrferm(ivx) = .false. - end if - end if -61 continue - if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout) -60 continue - if (islast) then - call addstr(sq//'en}%',5,soutq,lsout) - if (lsout.gt.0)write(11,'(a)')soutq(1:lsout) - end if - end if -c -c End of block for centered whole-bar rests and multi-bar rests -c -c If at end of block, save durations of last notes in bar, for possible use -c if clef changes at start of next bar -c - if (ibar .eq. nbars) then - do 63 iv = 1 , nv - do 63 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - prevtn(ivx) = tnote(ipl2(ivx,nn(ivx))) -63 continue - end if -c -c Update time for midi. This is only used for the event track -c - if (ismidi) then - miditime = miditime+15*lenbar -c -c If pickup, write the real time signature to the event track. Cannot use -c mtrnuml since it was reset to 0, have to recompute it -c - if (lenb0 .eq. lenbar) - * call midievent('m',mtrdenl*lenb1/64,mtrdenl) - end if - return - end - subroutine makeabar() -c -c On input, have pseudo-durations in nodur(ivx,ip). Not real durations for -c xtups, since only last note of xtup gets non-zero nodur, which -c corresponds to single note of full length of xtup. -c In this subroutine we make an ordered list of all notes in all voices. -c ilnc = list note counter -c ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note. -c to(ilnc) = real start time of note in PMX-units (64=whole note) -c tno(ilnc) = time to next event in the bar. -c tnote(ilnc) = actual duration of note -c Then run thru list, grouping consecutive notes into \notes groups ib. -c space(ib) = real time unit for the \notes group -c squez(ib) = factor on space to get effective space. This will be 1 if -c there is a note exactly spanning each interval of space, and -c <1 if not. -c Details: let eon = elemskips per noteskip (like length). Basic formula is -c eon = sqrt(space/2.) -c If tgovern >= space, then -c eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern). -c Time needed to give this eon using basic formula is -c teq = space**2/tgovern -c Factor on space to get teq is -c squez(ib) = space/tgovern -c The eon for each ib can then be computed based on time of space*squez. -c Iff squez = 1, there is a note spanning every increment in the \notes group. -c -c tnminb = minimum time span in the bar for increments spanned by notes, -c i.e., with squez=1. Use after parsing into line to decide if -c spacing needs to be "flattened" among notes groups. -c - common /comtol/ tol - parameter (nm=24,nkb=3999,maxblks=9600) - common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), - * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, - * nbars,itsofar(nm),nib(nm,15),nn(nm), - * rest(nm,200),lenbr0,lenbr1,firstline,newmeter - common /linecom/ elskb,tnminb(nkb) - common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), - * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, -c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) - * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) - common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) -c logical rest,firstline,newmeter,gotclef - logical rest,firstline,newmeter - integer cnn(nm),istart(80),istop(80) - real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600) - elskb = 0. - tnminb(ibarcnt) = 1000. - do 1 iv = 1 , nv - do 1 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - if (ibar .gt. 1) then - nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1) - else - nn(ivx) = nib(ivx,ibar) - end if -1 continue -c -c initialize list note counter, time(iv), curr. note(iv) -c - ilnc = 1 - do 4 iv = 1 , nv - do 4 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - cnn(ivx) = 1 - ivxo(ilnc) = ivx - ipo(ilnc) = 1 - to(ilnc) = 0. - tnote(ilnc) = fnote(nodur,ivx,1,nacc) - xit(ivx) = tnote(ilnc) - if (abs(xit(ivx)-lenbar).lt.tol) xit(ivx) = 1000. - ilnc = ilnc+1 -4 continue -c -c Build the list -c -5 continue -c -c Determine which voice comes next from end of notes done so far. -c tmin is the earliest ending time of notes done so far -c - tmin = 1000. - do 6 iv = 1 , nv - do 6 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - tminn = min(tmin,xit(ivx)) - if(tminn .lt. tmin) then - tmin = tminn - ivnext = ivx - end if -6 continue - if (tmin .gt. 999.) go to 7 - ivxo(ilnc) = ivnext - cnn(ivnext) = cnn(ivnext)+1 - ipo(ilnc) = cnn(ivnext) - to(ilnc) = tmin -c -c Check if this voice is done -c - tnote(ilnc) = fnote(nodur,ivnext,cnn(ivnext),nacc) - if (cnn(ivnext) .eq. nn(ivnext)) then - xit(ivnext) = 1000. - else - xit(ivnext) = xit(ivnext)+tnote(ilnc) - end if - ilnc = ilnc+1 - go to 5 -7 continue - ntot = ilnc-1 - if (ntot .gt. 600) then - call printl(' ') - call printl('Cannot have more than 600 notes per bar, stopping') - call stop1() - end if - do 8 in = 1 , ntot-1 - tno(in) = to(in+1)-to(in) -8 continue - tno(ntot) = fnote(nodur,ivxo(ntot),ipo(ntot),nacc) - tnote(ntot) = tno(ntot) -c -c Debug writes -c -c write(*,'()') -c write(*,'(16i5)')(ivxo(in),in=1,ntot) -c write(*,'(16i5)')(ipo(in),in=1,ntot) -c write(*,'(16f5.1)')(to(in),in=1,ntot) -c write(*,'(16f5.1)')(tno(in),in=1,ntot) -c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) -c write(*,'(16f5.1)')(tnote(in),in=1,ntot) -c -c Done w/ list. Initialize loop for building note blocks: -c - ib = 1 - istart(1) = 1 - space(1) = 0. - in = 1 -c -c Start the loop -c -9 continue - if (in .eq. ntot) then - if (space(ib) .lt. tol) then - space(ib) = tno(in) -c -c Last gap in bar is spanned by a note, so cannot need a squeeze. -c - squez(ib) = 1. - end if - istop(ib) = ntot -c -c From here flow out of this if block and into block-setup -c - else if (space(ib) .lt. tol) then -c -c space hasn't been set yet, so tentatively set: -c - space(ib) = tno(in) - if (space(ib) .lt. tol) then - in=in+1 - else -c -c Tentative space tno(in) is non-zero. Set squez, which will be kept (since -c it is a unique property of the particular increment starting here) : -c - squez(ib) = getsquez(in,ntot,space(ib),tnote,to) - istop(ib) = in - end if - go to 9 - else if (tno(in+1) .lt. tol) then -c -c This is not the last note in the space, so -c - in = in+1 - go to 9 - else if (abs(tno(in+1)-space(ib)) .lt. tol) then -c -c Next increment has same space. Does it have same squez? -c - xsquez = getsquez(in+1,ntot,space(ib),tnote,to) -c -c If it does have the same squez, loop, otherwise flow out -c - if (abs(xsquez-squez(ib)) .lt. tol) then -c -c Keep spacing the same, update tentative stop point -c - in = in+1 - istop(ib) = in - go to 9 - end if - end if -c -c At this point istart, istop, space, and squez are good, so close out block -c - tstart(ib) = to(istart(ib)) -c -c Compute elemskips assuming no flattening to increase min space. The formula -c is only correct if f1eon(t) = sqrt(t/2); more generally (after possible -c flattening in pmxb), elsperns = squez*feon(space/squez) -c - elsperns = f1eon(space(ib)*squez(ib)) - if (istop(ib) .eq. ntot) then - nnsk = nint((lenbar-tstart(ib))/space(ib)) - else - nnsk = nint((to(istop(ib)+1)-tstart(ib))/space(ib)) - end if - elskb = elskb+elsperns*nnsk - if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then - call catspace(space(ib),squez(ib),nnsk) - else -c -c This is the first entry for this bar -c - nnpd(nptr(ibarcnt)) = nnsk - durb(nptr(ibarcnt)) = space(ib) - sqzb(nptr(ibarcnt)) = squez(ib) - nptr(ibarcnt+1) = nptr(ibarcnt+1)+1 - end if -c -c Update minimum space spanned by a note -c - if (abs(squez(ib)-1) .lt. tol) - * tnminb(ibarcnt) = min(tnminb(ibarcnt),space(ib)) - if (istop(ib) .eq. ntot) go to 15 -c -c End of spatial accounting for now -c - ib = ib+1 - istart(ib) = istop(ib-1)+1 - in = istart(ib) -c -c Set tentative block space for new block -c - space(ib) = tno(in) - if (space(ib).gt.tol) - * squez(ib)= getsquez(in,ntot,space(ib),tnote,to) - istop(ib) = in - go to 9 -15 continue -c nb = ib -c -c Debug writes -c -c write(*,'(16i5)')(istart(ib),ib=1,nb) -c write(*,'(16i5)')(istop(ib),ib=1,nb) -c write(*,'(16f5.1)')(space(ib),ib=1,nb) -c write(*,'(16f5.1)')(squez(ib),ib=1,nb) -c - return - end - subroutine midievent(typeq,in1,in2) -c -c We now store "conductor" events in mmidi(numchan,.), and count bytes -c with imidi(numchan) -c - parameter (nm=24,mv=24576) - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /comevent/ miditime,lasttime - character*1 typeq - idur = isetvarlen(miditime-lasttime,nbytes) - imidi(numchan) = imidi(numchan)+nbytes+1 - do 1 i = 1 , nbytes - mmidi(numchan,imidi(numchan)-i) = mod(idur,256) - idur = ishft(idur,-8) -1 continue - mmidi(numchan,imidi(numchan)) = 255 - if (typeq .eq. 't') then -c -c Tempo event. in1 = quarters per minute (integer) -c - mmidi(numchan,imidi(numchan)+1) = 5*16+1 - mmidi(numchan,imidi(numchan)+2) = 3 - misperq = nint(60000000./in1) - do 2 i = 1 , 3 - mmidi(numchan,imidi(numchan)+6-i) = mod(misperq,256) - misperq = ishft(misperq,-8) -2 continue - imidi(numchan) = imidi(numchan)+5 - else if (typeq .eq. 'm') then -c -c Meter event. in1=numerator, in2=denom (power of 2) -c - mmidi(numchan,imidi(numchan)+1) = 5*16+8 - mmidi(numchan,imidi(numchan)+2) = 4 - mmidi(numchan,imidi(numchan)+3) = in1 - if (in2 .gt. 0) then - mmidi(numchan,imidi(numchan)+4) = log2(in2) - else - mmidi(numchan,imidi(numchan)+4) = 0 - end if - mmidi(numchan,imidi(numchan)+5) = 24 - mmidi(numchan,imidi(numchan)+6) = 8 - imidi(numchan) = imidi(numchan)+6 - else if (typeq .eq. 'k') then -c -c Keychange event. in1 = isig -c - mmidi(numchan,imidi(numchan)+1) = 5*16+9 - mmidi(numchan,imidi(numchan)+2) = 2 - mmidi(numchan,imidi(numchan)+3) = mod(256+in1,256) - mmidi(numchan,imidi(numchan)+4) = 0 - imidi(numchan) = imidi(numchan)+4 - else - print*,'Program flameout in midievent' - call stop1() - end if - lasttime = miditime - return - end - subroutine moveln(iuin,iuout,done) - logical done - character*129 outq - done = .false. - read(iuin,'(a)',end=1) outq - lenout = llen(outq,129) - write(iuout,'(a)') outq(1:lenout) - return -1 done = .true. - return - end - subroutine mrec1(lineq,iccount,ndxm) -c -c This is called when (a) macro recording is just starting and -c (b) at the start of a new line, if recording is on -c - parameter (maxblks=9600) - character*128 lineq,lnholdq - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - logical mrecord,mplay,endmac - common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), - * ic1mac(20),ilmac,iplmac - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - if (.not.mrecord) then -c -c Starting the macro -c - ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount - il1mac(macnum) = ilbuf-1 - ic1mac(macnum) = iccount - mrecord = .true. - end if - if (iccount .lt. 128) then - ndxm = index(lineq(iccount+1:128),'M') - if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M', - * 128-iccount) - if (ndxm .gt. 0) then -c -c This line ends the macro. -c - ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm - il2mac(macnum) = ilbuf-1 - mrecord = .false. - end if - end if - return - end - function ncmid(iv,ip) - parameter (nm=24) - common /all/ mult(nm,200),jv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comipl2/ ipl2(nm,200) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,isfig - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtol/ tol - if (ncc(iv) .eq. 1) then - ncmid = ncmidcc(iv,1) - else - xtime = to(ipl2(ivx,ip)) - do 1 icc = ncc(iv) , 1 , -1 - if (xtime .gt. tcc(iv,icc)-tol) then - ncmid = ncmidcc(iv,icc) - return - end if -1 continue - print*,'Problem in ncmid()' - stop - end if - end - function ncmidf(clefq) -c -c Return middle line of a clef -c - character*1 clefq - if (clefq .eq. '8') then -c -c treblelowoct; will treat as treble for this purpose -c - ncmidf = 35 - else - ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 - end if - return - end - subroutine newvoice(jv,clefq,change) - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,isfig - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - character*1 ulfbq,clefq - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - logical change,autofbon - nvmx(jv) = 1 - ivmx(jv,1) = jv - itsofar(jv) = 0 - nnl(jv) = 0 - nfb(jv) = 0 - if (firstgulp .or. change) then - ncmidcc(jv,1) = ncmidf(clefq) - else - ncmidcc(jv,1) = ncmidcc(jv,ncc(jv)) - end if - tcc(jv,1) = 0. - ncc(jv) = 1 - nudoff(jv) = 0 - ndotmv(jv) = 0 - do 5 j = 1 , 200 - irest(jv,j) = 0 - islur(jv,j) = 0 - ipl(jv,j) = 0 - nacc(jv,j) = 0 - iornq(jv,j) = 0 - mult(jv,j) = 0 - if (jv.le.2) isfig(jv,j) = .false. -5 continue - return - end - subroutine notefq(noteq,lnote,nolev,ncmid) -c -c Returns name of note level with octave transpositions, updates noctup. -c - common /comoct/ noctup - character*8 noteq - character*1 upcaseq,noteqt,chax - nupfroma = mod(nolev+1,7) - iname = 97+nupfroma - ioctup = (nolev+1)/7-4 - noteqt = chax(iname) - if (ncmid .eq. 23) noteqt = upcaseq(noteqt) - if (ioctup .eq. noctup) then - noteq = noteqt - lnote = 1 -c -c Must ALWAYS check if lnote=1 for use with functions requiring a blank -c - else if (ioctup .gt. noctup) then -c -c Raise octave. Encase in {} -c - write(noteq,'(8a1)')'{',(chax(39),i=noctup,ioctup-1), - * noteqt,'}' - lnote = 3+ioctup-noctup - noctup = ioctup - else -c -c Lower octave -c - write(noteq,'(8a1)')'{',(chax(96),i=ioctup,noctup-1), - * noteqt,'}' - lnote = 3+noctup-ioctup - noctup = ioctup - end if - return - end - subroutine notex(notexq,lnote) -c -c Returns non-beamed full note name -c - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk, - * isfig,ispoi,btest,even - character*1 udq,udqq,chax - character*4 dotq - character*2 numq - character*79 notexq - character*8 noteq - character*40 restq - common /compoi/ ispoi - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - character*10 figq - ip = ipo(jn) - nole = nolev(ivx,ip) -c -c Check for special situations with 2nds (see precrd) -c - if (btest(nacc(ivx,ip),30)) then - nole = nole - 1 - else if (btest(nacc(ivx,ip),31)) then - nole = nole + 1 - end if - nodu = nodur(ivx,ip) - if (.not.btest(irest(ivx,ip),0)) then - udq = udqq(nole,ncmid(iv,ip), - * islur(ivx,ip),nvmx(iv),ivx,nv) - end if -c -c Check figure level -c -c if (figbass .and. isfig(ivx,ip) -c * .and. .not.btest(irest(ivx,ip),0)) then - if (figbass .and. .not.btest(irest(ivx,ip),0) .and. - * ((ivx.eq.1.and.isfig(1,ip)) - * .or.(ivx.eq.ivxfig2.and.isfig(2,ip)))) then - if (udq .eq. 'u' .or. nodu.ge.64) then -c -c Upper or no stem, fnole (in noleunits) set by notehead -c - fnole = nole - else -c -c Lower stem, fnole set by bottom of stem -c - fnole = nole-stemlen - end if - zmin = fnole-ncmid(ivx,ip)+4 - if (ivx .eq. 1) then - ifigdr(1,iline) = max(ifigdr(1,iline),nint(4-zmin)) - else - ifigdr(2,iline) = max(ifigdr(2,iline),nint(4-zmin)) - end if - end if - if (.not.btest(irest(ivx,ip),0)) then - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - if (lnoten .eq. 1) call addblank(noteq,lnoten) - if (nodu .eq. 1) then - notexq =sq//'cccc'//udq//noteq(1:lnoten) - lnote = lnoten+6 - else if (nodu .eq. 2) then - notexq =sq//'ccc'//udq//noteq(1:lnoten) - lnote = lnoten+5 - else if (nodu .eq. 4) then - notexq =sq//'cc'//udq//noteq(1:lnoten) - lnote = lnoten+4 - else if (nodu .eq. 8) then - notexq =sq//'c'//udq//noteq(1:lnoten) - lnote = lnoten+3 - else if (nodu .eq. 16) then - notexq =sq//'q'//udq//noteq(1:lnoten) - lnote = lnoten+3 - else if (nodu .eq. 32) then - notexq =sq//'h'//udq//noteq(1:lnoten) - lnote = lnoten+3 - else if (nodu .eq. 64) then - notexq =sq//'wh'//noteq(1:lnoten) - lnote = lnoten+3 - else if (nodu .eq. 128) then -c notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' -c lnote = lnoten+10 - notexq =sq//'breve'//noteq(1:lnoten) - lnote = lnoten+6 - else - dotq = 'p' - ldot = 1 - if (btest(iornq(ivx,ip),13)) then -c -c Dotted note with ')' ornament -c - dotq='m' - else if (btest(islur(ivx,ip),3)) then -c -c Double dot -c - dotq = 'pp' - ldot = 2 - end if - if (nodu .ge. 192) then - notexq =sq//'breve'//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+6+ldot - else if (nodu .ge. 96) then - notexq =sq//'wh'//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+3+ldot - else if (nodu .ge. 48) then - notexq =sq//'h'//udq//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+3+ldot - else if (nodu .ge. 24) then - notexq =sq//'q'//udq//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+3+ldot - else if (nodu .ge. 12) then - notexq =sq//'c'//udq//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+3+ldot - else if (nodu .ge. 6) then - notexq =sq//'cc'//udq//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+4+ldot - ispoi = .true. - else - notexq =sq//'ccc'//udq//dotq(1:ldot)//noteq(1:lnoten) - lnote = lnoten+5+ldot - ispoi = .true. - end if - if (dotq(1:1) .eq. 'm') then -c -c Need another call to the note, in case the first one has octave shifts -c - if (lnoten .eq. 2) then - notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}' - lnote = lnote+3 - else - notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) - lnote = lnote+1 - end if - end if - end if - else if (btest(islur(ivx,ip),29)) then -c -c Blank rest -c - notexq = sq//'sk' - lnote = 3 - else -c -c Non-blank rest -c - lnote = 0 - nole = mod(nole+20,100)-20 -c -c Kluge to get pause symbol for rp: -c - if (btest(islur(ivx,ip),19)) nodu = 64 - if (nodu .le. 28) then -c -c Normal rest < or = double-dotted quarter -c - lrest = 3 - if (nodu .gt. 14) then - restq =sq//'qp' - else if (nodu .gt. 7) then - restq =sq//'ds' - else if (nodu .gt. 3) then - restq =sq//'qs' - else if (nodu .gt. 1) then - restq =sq//'hs' - else - restq =sq//'qqs' - lrest = 4 - end if -c -c Special case for rest at start of F-tuplet inside a forced beam -c - if (btest(nacc(ivx,ip),18) .and. - * btest(nacc(ivx,ip),19)) then - restq = sq//'pt4'//restq(1:lrest) - lrest = lrest+4 - end if - notexq = restq - lnote = lrest -c -c At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. -c - if (nole .ne. 0) then - if (abs(nole) .lt. 10) then - noteq = chax(48+abs(nole)) - lnoten = 1 - else - write(noteq(1:2),'(i2)')abs(nole) - lnoten = 2 - end if - if (nole .gt. 0) then - notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' - else - notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' - end if - lnote = 16+lnoten - notexq = notexq(1:lnote)//restq(1:lrest) - lnote = lnote+lrest - end if - if (2**log2(nodu) .ne. nodu) then -c -c Deal with dots (on rests shorter than half rest) -c - restq = sq//'pt' - lrest = 3 - if (2*nodu .gt. 3*2**log2(nodu)) then - restq = sq//'ppt' - lrest = 4 - end if - nole = nole+4 - raisedot = 0 -c -c Tweak dot positions for special cases -c - even = (mod(100+nole,2).eq.0) -c if (.not.even.and.nodu.gt.8.and. -c * (nole.lt.0.or.nole.gt.8)) then - if (.not.even .and. (nole.lt.0.or.nole.gt.8)) then - raisedot = 1 - end if - if (nole.ge.10 .or. nole.le.-1) then - write(numq,'(i2)')nole - restq = restq(1:lrest)//'{'//numq//'}' - lrest = lrest+4 - else - restq = restq(1:lrest)//chax(nole+48) - lrest = lrest+1 - end if - if (raisedot.gt.0) then - restq = sq//'raise'//sq//'internote'// - * sq//'hbox{'//restq(1:lrest)//'}' - lrest = lrest+23 - end if - notexq = restq(1:lrest)//notexq(1:lnote) - lnote = lnote+lrest - end if - else -c -c Half rest or longer -c - if (nole .eq. 0) then -c -c Half or longer rest is not raised or lowered -c - if (nodu .le. 56) then - notexq =sq//'hpause' - lnote = 7 - else if (nodu .le. 112) then - if (.not.btest(islur(ivx,ip),19) .or. - * btest(irest(ivx,ip),25)) then - notexq = sq//'pause' - else - notexq = sq//'pausc' - end if - lnote = 6 - else - notexq =sq//'PAuse' - lnote = 6 - end if - if (2**log2(nodu) .ne. nodu) then -c -c Dotted rest, hpause or longer -c - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - if (2*nodu .gt. 3*2**log2(nodu)) then -c -c Double dotted long rest -c - notexq = notexq(1:lnote)//'p' - lnote = lnote+1 - end if - end if - else -c -c Raised or lowered half or whole rest -c - if (nodu .eq. 32) then - notexq = sq//'lifthpause' - lnote = 11 - else if (nodu .eq. 48) then - notexq = sq//'lifthpausep' - lnote = 12 - else if (nodu .eq. 56) then - notexq = sq//'lifthpausepp' - lnote = 13 - else if (nodu .eq. 64) then - notexq = sq//'liftpause' - lnote = 10 - else if (nodu .eq. 96) then - notexq = sq//'liftpausep' - lnote = 11 - else if (nodu .eq. 112) then - notexq = sq//'liftpausepp' - lnote = 12 - else if (nodu .eq. 128) then - notexq = sq//'liftPAuse' - lnote = 10 - else -c -c Assume dotted double whole rest -c - notexq = sq//'liftPAusep' - lnote = 11 - end if -c -c Set up height spec -c - nole = sign(abs(nole)/2,nole) - if (nole.le.9 .and. nole.ge.0) then - noteq = chax(48+nole) - lnoten = 1 - else - noteq = '{' - if (nole .ge. -9) then - write(noteq(2:3),'(i2)')nole - lnoten = 3 - else - write(noteq(2:4),'(i3)')nole - lnoten = 4 - end if - noteq = noteq(1:lnoten)//'}' - lnoten = lnoten+1 - end if - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - end if - end if - end if - return - end - function ntindex(line,s2q,lenline) -c -c Returns index(line,s2q) if NOT in TeX string, 0 otherwise -c - character*(*) s2q,line - character*1 chax - logical intex - ndxs2 = index(line,s2q) - ndxbs = index(line,chax(92)) - if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then - ntindex = ndxs2 - else -c -c There are both bs and s2q, and bs is to the left of sq2. So check bs's to -c right of first: End is '\ ', start is ' \' -c - len = lenstr(line,lenline) - intex = .true. - do 1 ic = ndxbs+1 , len - if (ic .eq. ndxs2) then - if (intex) then - ntindex = 0 - ndxs2 = index(line(ic+1:len),s2q)+ic - else - ntindex = ndxs2 - return - end if - else if (intex .and. line(ic+1:ic+2).eq.chax(92)//' ') then - intex = .false. - else if (.not.intex .and. line(ic+1:ic+2).eq.' '//chax(92)) - * then - intex = .true. - end if -1 continue - end if - return - end - subroutine ntrbbb(n,char1q,ulqq,iv,notexq,lnote) -c -c This appends to notexq e.g. '\ibbbu1' -c - common /combbm/ isbbm - logical isbbm - character*79 notexq - character*1 char1q,ulqq,chax - character*4 tempq - if (n .ge. 5) isbbm = .true. - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//chax(92)//char1q - else - notexq = chax(92)//char1q - end if - lnote = lnote+2 - do 3 im = 1 , n - notexq = notexq(1:lnote)//'b' - lnote = lnote+1 -3 continue -c -c add the number, 0 if 12 -c -c 5/25/08 Allow >12 -c -c call istring(mod(iv,12),tempq,len) - if (iv .lt. 24) then - call istring(iv,tempq,len) - else if (iv .eq. 24) then - tempq(1:1) = '0' - len = 1 - else - call printl('Sorry, too man open beams') - call stop1() - end if - notexq = notexq(1:lnote)//ulqq//tempq(1:len) - lnote = lnote+1+len - return - end - function numclef(clefq) -c -c Returns the number to be used as argument of \setclef for MusiXTeX -c For input 0-6 or tsmanrb return 0-7 -c 7 f 9 -c 8 0 -c - character*1 clefq - if (ichar(clefq) .lt. 55) then -c if (ichar(clefq) .le. 55) then - numclef = ichar(clefq)-48 -c if (numclef .eq. 7) numclef = 9 - else if (clefq .eq. '7') then - numclef = 9 - else if (clefq .eq. '8') then - numclef = 0 - else - numclef = index('tsmanrbxxf',clefq)-1 - end if - return - end - subroutine outbar(i,jlast) - character*1 chax - nfmt = log10(i+.5)+2 - if (jlast+5+nfmt .lt. 80) then - write(*,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i - write(15,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i - jlast = jlast+5+nfmt - else - write(*,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i - write(15,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i - jlast = 5+nfmt - end if - return - end - subroutine pmxa(basenameq,lbase,isfirst,nsyout,nbarss,optimize) -cccccccccccccccccccccccccccccccccccccccccccccccc -cc cc -cc Subroutine, combine with pmxb.for -cc -cccccccccccccccccccccccccccccccccccccccccccccccc -cc -cc Need to consider X spaces in xtuplets when getting poenom, and -cc maybe fbar? -cc mx06a -cc ID numbers for voices when number of voices is reduced. -cc -cc mx03a -cc account for new fracindent for new movements. -cc -cc Known changes since pmxa. Version 1.1b (see pmxb for longer list) -cc -cc Check ID codes for slurs. -cc Version 1.24 still does not have details for spacing/positioning -cc arpeggios if there are accidentals or shifted notes or crowded scores. -cc Fix problem in 1.22 with arpeggios across multi-line staves -cc Fix problem in 1.22 with flat key signatures -cc Read setup data as strings -cc Warning for octave designation plus +/- -cc Don't pause for volta warning, -cc Macros -cc Correct fsyst to account for transposition and key changes. -cc Check for nbars > nsyst -cc -ccccccccccccccccccccccccccccccccccc - parameter (nm=24,nkb=3999,nks=125,maxblks=9600) - logical loop,usefig,isfirst,optimize - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - integer nn(nm),nodur(nm,200),ivxo(600),ipo(600), - * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks) - common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), - * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, -c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) - * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) - common /compage/ widthpt,ptheight,hoffpt,voffpt, - * nsyst,nflb,ibarflb(0:40), - * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), - * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), - * nistaff(0:40) - common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1, - * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS - real*4 elsk(nkb),celsk(0:nkb),elss(nks),to(600),tno(600) - character*128 lnholdq - character*44 basenameq - logical rest(nm,200),firstline,fbon,isvolt,iskchb,kchmid,ornrpt, - * stickyS - common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, - * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 - logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr, - * shifton,barend - common /a1ll/ iv,ivxo,ipo,to,tno,nnl,nv,ibar,mtrnuml, - * nodur,lenbar,iccount,nbars,itsofar,nib,nn, - * rest,lenbr0,lenbr1,firstline,newmeter - common /linecom/ elskb,tnminb(nkb) - common /cblock/ - * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, - * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh - common /cominbot/ inbothd - common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - common /commus/ musize,whead20 - common /comeon/ eonk,ewmxk -c logical mrecord,mplay,endmac,gotclef,cstuplet - logical mrecord,mplay,endmac,cstuplet - logical novshrinktop,upslur,fontslur,WrotePsslurDefaults - common /comnvst/ novshrinktop,cstuplte - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /comligfont/ isligfont - logical isligfont - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - logical fulltrans - common /comis4bignv/ is4bignv,AIset - logical is4bignv,AIset - common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, - * poefa - real*4 poefa(125) - logical nocodabn - data wtimesig,wclef,wkeysig - * / 0.72 , 0.8 , 0.28 / -c data poefa /125*1./ -c This corrected a problem in Bob Tennent's compilation of pmx2.94 -c - do 97 i = 1 , 125 - poefa(i) = 1. -97 continue - is4bignv = .false. - AIset = .false. - whead20 = 0.3 - ishort = 0 - if (.not.optimize) then - print* - print*,'Starting first PMX pass' - write(15,'(a)') ' Starting first PMX pass' - end if - if (isfirst) then - open(19,file='pmxaerr.dat') - write(19,'(i6)') 0 - close(19) - end if - if (.not.optimize) jprntb = 81 - macuse = 0 - ornrpt = .false. - stickyS = .false. - mrecord = .false. - mplay = .false. - lastchar = .false. - novshrinktop = .false. - cstuplet = .false. - fontslur = .true. - isligfont = .false. - fulltrans = .false. - do 42 ibarcnt = 1 , nkb - udsp(ibarcnt) = 0. - wminnh(ibarcnt) = -1. -42 continue -c -c Initialize input buffer -c - lenbuf0 = ipbuf - ipbuf = 0 - ilbuf = 1 - call g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, - * xmtrnum0,newkey(1),npages,nsyst,musize,bottreb) -c -c Set up list of instrument numbers (iv) -c - ivnow = 0 - do 13 instnow = 1 , noinst - do 14 iscount = 1 , nsperi(instnow) - ivnow = ivnow+1 - instno(ivnow) = instnow -14 continue -13 continue -c -c Save initial meter for midi -c - if (.not.isfirst .and. npages.eq.0) then - print*,'Sorry, must have npages>0 for optimization.' - call stop1() - end if - nsyout = nsyst -c -c isig1 will be changed in getnote if there is a transposition -c - isig1 = newkey(1) - if (npages .gt. nsyst) then - call printl('npages > nsyst in input. Please fix the input.') - call stop1() - end if -c -c fbar = afterruleskip/elemskip -c apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt -c - fbar = 1. - wheadpt = whead20*musize - ifig = 0 - usefig = .true. - lenbeat = i1fnodur(mtrdenl,'x') - lenmult = 1 - if (mtrdenl .eq. 2) then - lenbeat = 16 - lenmult = 2 - end if - lenbr1 = lenmult*mtrnuml*lenbeat - lenbr0 = nint(lenmult*xmtrnum0*lenbeat) - mtrnuml = 0 - if (lenbr0 .ne. 0) then - ibaroff = 1 - lenbar = lenbr0 - else - ibaroff = 0 - lenbar = lenbr1 - end if - ibarcnt = 0 - nptr(1) = 1 - iccount = 128 - nmovbrk = 0 - nflb = 0 - nfpb = 0 - ipagfpb(0) = 1 - isysfpb(0) = 1 - ibarflb(0) = 1 - isysflb(0) = 1 - nistaff(0) = nv-1 -c -c Check for pmx.mod -c - linesinpmxmod = 0 -c line1pmxmod = ilbuf - call getpmxmod(.true.,' ') - if (.not.isfirst .and. linesinpmxmod .gt. 0) then - print*,'Sorry, cannot optimize if there is a pmx.mod file' - call stop1() - end if -c -c Initialize for loop over lines -c - nkeys = 1 - ibrkch(1) = 1 - mbrestsav = 0 - shifton = .false. - firstline = .true. - newmeter = .false. - ihead = 0 - isheadr = .false. -c gotclef = .false. - idsig = 0 - iddot = 0 - fintstf = -1. - gintstf = 1.0 - listcresc = 0 - listdecresc = 0 -30 loop = .true. - iskchb = .false. - issegno = .false. - nbars = 0 - ibarmbr = 0 - do 4 iv = 1 , nv - nvmx(iv) = 1 - ivmx(iv,1) = iv - itsofar(iv) = 0 - nnl(iv) = 0 - do 5 j = 1 , 200 - rest(iv,j) = .false. - nacc(iv,j) = 0. -5 continue -4 continue - iv = 1 - ivx = 1 - fbon = .false. - barend = .false. - isvolt = .false. -2 if (loop) then -c -c Within this short loop, nv voices are filled up for the duration of a block. -c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) -c nodur(..),rest(..). nnl will later be -c increased and things slid around as accidental skips are added. -c - call g1etnote(loop,ifig,optimize,fulltrans) - if (lastchar) go to 20 - go to 2 - end if - if (mbrestsav .gt. 0) then - call printl(' ') - call printl( - * 'You must enter the same multibar rest in ALL parts') - call stop1() - end if - do 10 ibar = 1 , nbars - ibarcnt = ibarcnt+1 -c -c The following is just a signal to start a new bar when cataloging spaces -c for catspace(...) -c - nptr(ibarcnt+1) = nptr(ibarcnt) - newmb(ibarcnt) = .false. - if (newmeter.and.ibar.eq.1) newmb(ibarcnt) = .true. -c -c Above is only for spacing calcs later on. Remember new meter can only occur -c at START of a new input line (ibar = 1) -c - if (ibar .ne. ibarmbr) then - if (.not.optimize) call outbar(ibarcnt-ibaroff,jprntb) - else - if (.not.optimize) then - write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars', - * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1 - write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars', - * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1 - jprntb = 0 - end if - ibaroff = ibaroff-mbrest+1 - end if - if (firstline .and. lenbr0.ne.0) then - if (ibar .eq. 1) then - lenbar = lenbr0 - else - lenbar = lenbr1 - end if - end if - if (ibar .gt. 1) then -c -c For bars after first, slide all stuff down to beginning of arrays -c - do 11 iv = 1 , nv - do 11 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - ioff = nib(ivx,ibar-1) - do 12 ip = 1 , nib(ivx,ibar)-ioff - nodur(ivx,ip) = nodur(ivx,ip+ioff) - rest(ivx,ip) = rest(ivx,ip+ioff) - nacc(ivx,ip) = nacc(ivx,ip+ioff) -12 continue -11 continue - end if - do 67 iv = 1 , nv - do 67 kv = 1 , nvmx(iv) - ioff= 0 - if(ibar.gt.1)ioff = nib(ivmx(iv,kv),ibar-1) -67 continue - call makeabar() - elsk(ibarcnt) = elskb+fbar -10 continue - newmeter = .false. - firstline = .false. - go to 30 -20 continue -c -c Vertical analysis. -c - if (npages .eq. 0) then - if (nsyst .eq. 0) then - print*,'When npages=0, must set nsyst=bars/syst, not 0' - call stop1() - end if - nsyst = (ibarcnt-1)/nsyst+1 - if (nv .eq. 1) then - nsystpp = 12 - else if (nv .eq. 2) then - nsystpp = 7 - else if (nv .eq. 3) then - nsystpp = 5 - else if (nv .eq. 4) then - nsystpp = 3 - else if (nv .le. 7) then - nsystpp = 2 - else - nsystpp = 1 - end if - npages = (nsyst-1)/nsystpp+1 - end if -c -c Check nsyst vs ibarcnt -c - if (nsyst .gt. ibarcnt) then - print* - print*,'nsyst,ibarcnt:',nsyst,ibarcnt - print*,'There are more systems than bars.' - write(15,'(a,2i5)')' nsyst,ibarcnt:',nsyst,ibarcnt - write(15,'(a)')' There are more systems than bars.' - call stop1() - end if -c -c Set up dummy forced line & page breaks after last real one -c - nflb = nflb+1 - ibarflb(nflb) = ibarcnt+1 - isysflb(nflb) = nsyst+1 - nfpb = nfpb+1 - ipagfpb(nfpb) = npages+1 - isysfpb(nfpb) = nsyst+1 - heightil = ptheight*4./musize - open(12,status='SCRATCH') - write(12,'(a)')basenameq(1:lbase) - write(12,*)lbase -c -c Pass to pmxb the initial signature, including effect of transposition. -c - write(12,'(6f10.5/f10.5,3i5)')fbar,wheadpt,etait, - * etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1 - write(12,*)npages,widthpt,ptheight,hoffpt,voffpt,nsyst - iflbnow = -1 - isysb4 = 0 - do 8 ifpb = 1 , nfpb -c -c Each time thru this loop is like a single score with several pages -c - npages = ipagfpb(ifpb)-ipagfpb(ifpb-1) - nsyst = isysfpb(ifpb)-isysfpb(ifpb-1) - nomnsystp = (nsyst-1)/npages+1 - nshort = nomnsystp*npages-nsyst - do 7 ipage = 1 , npages - nsystp = nomnsystp - if (ipage .le. nshort) nsystp = nsystp-1 -c -c Last system number on this page: - isysendpg = isysb4+nsystp - nintpg = 0 - do 15 isy = isysb4+1, isysendpg - if (isysflb(iflbnow+1) .eq. isy) iflbnow = iflbnow+1 - nintpg = nintpg+nistaff(iflbnow) -15 continue - xilfrac = 0. - xiltxt = 0. - if (ipage.eq.1 .and. ihead.gt.0) then -c -c Needn't zero out ihead after printing titles if we only allow titles at top? -c - if (iand(ihead,1) .eq. 1) then - xiltxt = xiltxt+hgtin*4/musize - xilfrac = xilfrac+etait - end if - if (iand(ihead,2) .eq. 2) then - xiltxt = xiltxt+hgtti*4/musize - xilfrac = xilfrac+etatc - end if - if (iand(ihead,4) .eq. 4) then - xiltxt = xiltxt+hgtco*4/musize - xilfrac = xilfrac+etacs1 - else -c -c Use double the title-composer space if there is no composer -c - xilfrac = xilfrac+etatc - end if - end if - D = xilfrac+nsystp-1+etatop+etabot -c C = nsystp*(nv-1) - C = nintpg -c xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn - xN = heightil - xiltxt - 4*(nintpg+nsystp) - (nsystp-1)*xilbn - if (bottreb) xN = xN-(nsystp-1)*xilbtc - if (ihead.eq.0 .and. isheadr) xN = xN - xilhdr - if (ifig .eq. 1) then - xN = xN - nsystp*xilfig - end if - glueil = (xN-b*C)/(D+a*C) - omegaG = (b*D+a*xN)/(D+a*C) -c -c G = \interlines between systems -c omega*G = \interlines between staves of the same system -c \interstaff = 4+omega*G -c C = total number of interstaff spaces in the page -c D = omega-indep factors for scalable height = nsy-1 (intersystem glue) -c + etatop + etabot + etatxt + -c N = scaleable height (\interlignes) = height - htext - staff heights - xil -c xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles -c + (nsy-1)*xiltcb for treble clef bottoms -c + nsy*xilfig for figures -c G = N/(D + omega * C) = glueil, (1) -c But (empirically) omega*G = a*G + b (2) -c with a=1.071 and b=2.714 -c Solving (1) and (2) gives -c G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C) -c Pass to pmxb omega*G (=\interstaff-4) -c (etatop,bot,it,tc,cx)*G as inputs to \titles -c -c glueil = (heightil-xiltxt-nsystp*(xil+4*nv)) -c * /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac) -c xnsttop = glueil*etatop -c xintstaff = 4+gfact*glueil -c -c Only the first page will get local adjustment now if needed, others in pmxb -c - if (ifpb.eq.1 .and. ipage.eq.1 .and. fintstf.gt.0.) then - facins = fintstf - fintstf = -1. - else -c -c gintstf = 1.0 by default, but may be changed with AI -c - facins = gintstf - end if - write(12,*)nsystp,max(0.,etatop*glueil),facins*(omegaG+4) - ihead = 0 - isheadr = .false. - isysb4 = isysendpg -7 continue -8 continue -c -c Done with vertical, now do horizontals -c - celsk(1) = elsk(1) - do 21 ibar = 2 , ibarcnt - celsk(ibar) = celsk(ibar-1)+elsk(ibar) -21 continue - lastbar(0) = 0 - ibar1 = 1 - wmins = -1. - iflb = 1 - imovbrk = 0 - ikey = 1 -c -c Return nsyst to its *total* value -c - nsyst = isysfpb(nfpb)-1 - do 22 isyst = 1 , nsyst - if (isyst .eq. isysflb(iflb)) iflb = iflb+1 - if (nmovbrk.gt.0 .and. imovbrk.lt.nmovbrk) then - if (isyst .eq. isysmb(imovbrk+1)) imovbrk = imovbrk+1 - end if - ibarb4 = lastbar(isyst-1) - if (isyst .eq. 1) then - if (isfirst) elsstarg = celsk(ibarflb(1)-1)/ - * (isysflb(1)-1-fracindent)*(1-fracindent) - celskb4 = 0. - else - celskb4 = celsk(ibarb4) -c -c Must dimension isysmb(0:*) just so I can execute this test! -c - if (isfirst) then - if (nmovbrk.gt.0 .and. isyst.eq.isysmb(imovbrk)) then -c -c First syst after forced line break. There may be indentation. -c - elsstarg = (celsk(ibarflb(iflb)-1)-celskb4) - * /(isysflb(iflb)-isyst-fracsys(imovbrk)) - * *(1-fracsys(imovbrk)) - else -c -c There is no indentation to deal with -c - elsstarg = (celsk(ibarflb(iflb)-1)-celskb4) - * /(isysflb(iflb)-isyst) - end if - end if - end if - if (isfirst) then - diff1 = abs(elsstarg-elsk(ibarb4+1)) - do 23 ibar = ibarb4+2 , ibarcnt - diff = elsstarg-(celsk(ibar)-celskb4) - if (abs(diff) .ge. diff1) go to 24 - diff1 = abs(diff) -23 continue -24 ibar = ibar-1 - lastbar(isyst) = ibar - nbarss(isyst) = ibar-ibarb4 - else -c -c nbarss is given as an input, must compute lastbar and ibar -c - lastbar(isyst) = nbarss(isyst)+ibarb4 - ibar = lastbar(isyst) - end if -c -c elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. -c - elss(isyst) = celsk(ibar)-celskb4 - write(12,'(i5)')lastbar(isyst-1)+1 -c -c Transposed sigs are isig1, newkey(2,3,...). -c - if (ikey .eq. 1) then - key1 = isig1 - else - key1 = newkey(ikey) - end if - fsyst = wclef+abs(key1)*wkeysig+2./musize - xelsk = 0. -1 if (ikey.lt.nkeys) then - if (ibrkch(ikey+1).le.lastbar(isyst)) then -c -c Add space for all key changes -c - ikey = ikey+1 - key2 = newkey(ikey) - naccs = max(abs(key2-key1),max(abs(key1),abs(key2))) - fsyst = fsyst+naccs*wkeysig -c -c Account for afterruleskips (fbar) -c - xelsk = xelsk+fbar/2 - if (ibrkch(ikey).lt.lastbar(isyst) .and. .not.kchmid(ikey)) - * xelsk = xelsk-1. - key1 = key2 - go to 1 - end if - end if -c -c Add extra fixed space for double bar -c - if (isyst .eq. nsyst) then - fsyst = fsyst+4.5/musize - end if -c -c Add extra fixed space for initial time signature -c - if (isyst .eq. 1) then - fsyst = fsyst+wtimesig - end if -c -c Add extra fixed space for time signature changes & user-defined spaces -c - do 26 ibars = ibarb4+1 , lastbar(isyst) - if (newmb(ibars)) fsyst = fsyst+wtimesig - fsyst = fsyst+udsp(ibars)/musize -26 continue - if (isyst .eq. 1) then - wdpt = widthpt*(1-fracindent) - else - if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and. - * isyst.eq.isysmb(imovbrk)) then - wdpt = widthpt*(1-fracsys(imovbrk)) - else - wdpt = widthpt - end if - end if - wsyspt = wdpt-fsyst*musize-0.4*nbarss(isyst) -c -c Checks for min spacing -c Get min allowable space -c - dtmin = 1000. - do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1 - dtmin = min(dtmin,tnminb(ibar)) - if (wminnh(ibar).ge.0.) wmins = wminnh(ibar) -45 continue - if (wmins .lt. 0) wmins = 0.3 - wminpt = (1+wmins)*0.3*musize -c -c Find max duration & # of notes for this system -c - dtmax = 0. - nns = 0 - do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1 - dtmax = max(dtmax,durb(iptr)) - nns = nns + nnpd(iptr) -43 continue - elmin0 = wsyspt*f1eon(dtmin)/(elss(isyst)+xelsk) - if (elmin0 .ge. wminpt) then -c -c Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; -c there is no need to "flatten" -c - sumelsk = elss(isyst)-fbar*nbarss(isyst) - eonk = 0. - ewmxk = 1. - else - elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/f1eon(dtmax)+nns) - if (elmin1 .le. wminpt) then -c print* -c print*,'In system #',isyst,' cannot meet min. space rqmt' -c write(15,'(/a,i5,a)') -c * 'In system #',isyst,' cannot meet min. space rqmt' - eonk = 0.9 - else -c -c Find eonk by Newton method -c - call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1, - * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax, - * (wminpt-elmin0)/(elmin1-elmin0)) - eonk = min(.9,eonk) - end if - ewmxk = f1eon(dtmax)**eonk -c -c Recompute poenom! -c - sumelsk = 0 - do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1 - sumelsk = sumelsk - * + nnpd(iptr)*sqzb(iptr)*feon(durb(iptr)/sqzb(iptr)) -44 continue - end if - poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk) -c -c Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 -c - if (isyst .gt. 0) then - if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and. - * isyst.eq.isysmb(imovbrk)) then - fracindent = fracsys(imovbrk) - else - fracindent = 0. - end if - end if - write(12,'(1pe12.5/i5,5e12.3)') poenom,nbarss(isyst), - * sumelsk,fsyst,fracindent,eonk,ewmxk - ibar1 = ibar1+nbarss(isyst) -22 continue - rewind(12) - open(13,status='SCRATCH') - write(13,'(i5)')ifig - rewind(13) - ilbuf = 1 - ipbuf = 0 - if (.not.optimize) then - write(*,'(/,a)')' Done with first pass' - print* - write(15,'(/,a)')' Done with first pass' - write(15,'()') - end if -c -c Following syntax is needed since pmxa is called with literal argument .false. -c - if (isfirst) isfirst = .false. - return - end - subroutine pmxb(inlast,poevec,ncalls,optimize) -cccccccccccccccccccccccccc -cc -cc To Do -cc -cc Resolve disagreement in final poe for 1st system, compared with *.mx2 -cc Shift slurs on right- or left-shifted main notes (2/7/99) -cc Various end-of-input-block repeat problems (ick142.pmx). -cc Force multiplicity for un-beamed xtups. -cc Clef change at end of piece -cc Global "A" option to maximize "X" at a given time tick. -cc Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted -cc note. See trubl18.pmx -cc Tab character as space. -cc Clef interference with second line of music. -cc Add space for interferences between *different* lines of music? -cc Shift arpeggios, both automatic and manual. -cc Different musicsize for different instruments. -cc Spacing checks for accid's on left-shifted chord notes -cc Spacing checks for double dots -cc Allow forced line breaks w/o setting nsyst. -cc Cresc-Decresc. (Enhance MusiXTeX first?) -cc Dynamic Marks. -cc Bug with Voltas at line end (MusiXTeX problem?). -cc Subtle bug w/ slur hgt over line brk, see trubl15.pmx -cc Stem-end slurs. -cc Allow units in indentation. -cc Make inline TeX more context sensitive. -cc Werner's 4/2/98 problem with "o?" -cc Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong. -cc converts e.g. "r2db" into "r2d", which might be wrong. -cc Werner's generalsignature problem with Key change and new transposition. -cc (wibug8.pmx) -cc Unequal xtuplets -cc Print both sets of bar #'s in tex file. -cc Make barlines invisible \def\xbar{\empty} , fix fbar. -cc Auto-tie slurs 'At' -cc Forced line break anywhere (e.g. at a mid-bar repeat). -cc Clef change at very start of file. -cc Tighten test for M as macro terminator. -cc Fix title so not separate limit on author length + composer length. -cc Arpeggios in xtups. -cc -cc mx10b -cc Option for instrument name at top center. Last item in P command: -cc P[n]c text is instrument name (use in parts) -cc P[n]cstuff text is stuff (up to 1st blank) -cc P[n]c"stuff with spaces" text is stuff with spaces -cc -cc Post version 1.43 -cc Reduced space rqmt for multiplicity-0 graces (no flag) -cc Removed last sepsym in centered whole-bar rests, fixes volta height bug. -cc -cc Version 1.43 -cc Fix spacing for end-of-line signature change. -cc Adjust left-shift of grace group for shifted accidentals. -cc Put in extra space for left-shifted accidentals. -cc Fix bug with dot-shift before accid-shift on chord note. -cc Space-check for right-shifted main notes. -cc Enable forcing stem direction of single notes in non-beamed xtups. -cc Disallow clef change after last note before end of input block (pmxa) -cc Print meter change before page break -cc increase length of strings for \titles macro -cc version 1.42 -cc Loosen up input syntax for "X" commands. Subroutine getx() -cc "B" and "P" in "X" commands -cc mx09b -cc Allow multiple rests at start of xtup -cc Add 64th rest -cc Fix xtup numbers over rests. (subroutine levrn) -cc Initialize notcrd=.false. every gulp. Avoids undefined state with e.g. -cc c za / ( c a ... -cc Allow double dots to be shifted. -cc Fix spacing with double dotted notes; permit splitting small note. -cc Fix \dotted printout so it works with old compiler -cc mx08b -cc Automatic spaces if needed for shifted accidentals. -cc Some Dynamics -cc Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc) -cc version 1.41 -cc Allow ":" as last char of path name -cc Dotted slurs "sb" -cc Continue bar numbering at movement break "L[integer]Mc" -cc mx07b -cc Whole-bar rests with double lines of music. Fixed all options ? -cc Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number]. -cc Option to suppress centering full-bar rests. "o" -cc mx06b -cc Shift accid on left-shifted chord note. -cc Rest as first note of xtup. -cc Wrong slopes with small widths. Scale slfac1 by widthpt_default/widthpt -cc Allow Rb for single bar at movemnet break or end of piece. (islur(25)) -cc Change # of inst at a movement break. noinst is total # and must be used -cc in 1st movement. ninow is current. nspern(1,...,ninow) is current -cc staves/inst, nsperi(1,...,noinst) is original. rename tells whether to -cc reprint names in parindent at a movement break. Default is .false. -cc unless ninow changes, then .true. But can force either with r+/- as -cc option in 'M' -cc mx04b -cc Double-dotted notes, separate+beamed, main+chord, still no extra space. -cc ??? Don't shift slur ends on whole notes. -cc (pmxa) Write line number of error in pmxaerr.dat -cc mx02b -cc Admit "RD" before "/" (search for "rptfq2:" ) -cc In doslur, for multi-line staves, single notes, check forced stem dir'n -cc before setting stemup (used to set horiz offset). -ccccccccccccccccccccccccccccccc - parameter (nm=24,nks=125,mv=24576,maxblks=9600) -c -c FYI /all/ differs in appearance in function ncmid -c - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comipl2/ ipl2(nm,200) -ccccccccccccc -cc islur cc -ccccccccccccc -c bit meaning -c 0 slur activity on this note -c 1 t-slur here. -c 2 force 0-slope beam starting on this note -c 3 Double dotted note! -c 4 grace before main note -c 5 left repeat -c 6 right repeat -c 7 start Volta -c 8 doublebar -c 9 end Volta -c 10 on=>endvoltabox -c 11 on=>clefchange -c 12-14 0=>treble, ... , 6=>bass -c 15 on=> start new block for clef change (maybe diff. voice) -c 16 literal TeX string -c 17 1=up, 0=down stem for single note (override) See bit 30! -c 18 if on, prohibit beaming -c 19 if on, full bar rest as pause -c 20 Beam multiplicity down-up -c 21 Forced multiplicity for any beam including xtups -c 22-24 Value of forced multiplicity -c 25 single barline at movement break -c 26 doubleBAR (see bits 5,6,8) -c 27-28 Forced beam fine-tune height (1 to 3) -c 29 Blank rest -c 30 If on, get stem dir'n from bit 17 -c 31 If on, suppress printing number with xtuplet starting here -ccccccccccccc -cc ipl cc -ccccccccccccc -c 0 blank barline (must be iv=1) (would have used islur but no room) -c 1 look left for K rests, moved here from iornq(30) -c 2 treblelowoct -c 3 Open notehead in forced beam xtup -c 4 Set if single stem tremolo -c 5-6 termulo multiplicity - 1 -c 7 unused -c 8 left offset main note one headwidth -c 9 right offset main note one headwidth -c 10 chord present? -c 11-16 Forced beam height adjustment (-30 to +30) -c 17-22 Forced beam slope adjustment (-30 to +30) -c 23-26 Slur index for Way-after grace. Inserted when slur is started. -c 27 5th bit for slur index for Way-after grace (100712) -c 28 key change: only in voice 1 -c 29 Grace after main note. (Type A) -c 30 In forced beam. Signals need to check beam heights -c 31 Grace way after main note. (stretch to next note, type W) -ccccccccccccc -cc iornq cc -ccccccccccccc -c 0 Ornament "(". Was user-defined horizontal slur shift on this note -c until 9/24/97; changed that to irest(21) -c 1-13 stmgx+Tupf._) -c 14 Down fermata, was F -c 15 Trill w/o "tr", was U -c 16-18 Editorial s,f,n -c 19-20 >^ -c 21 "?" for editorial accid, w/ or w/o s,f,n -c 22 Set if ihornb governs ornament height. Same in icrdorn. -c 23 Set in getorn if ANY note at time of this main note has ornament. -c This is ONLY used in beamstrt to signal whether to do more -c tests for whether ihornb is needed. (ihornb is only needed -c if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note) -c (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm. -c 24 Slur on after or way-after grace. Use as signal to START slur. -c 25 Tweak orn ht. Same in icrdorn for chord note -c 26 Insert user-defined space before this note (was 22) -c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord -c 28 caesura or breath -cc 29 blank barline (must be iv=1) (would have used islur but no room) -c 29 coda -cc 30 "Look-left" option for keyboard rest -c 30 Part-by-part segno oG -c 31 Set if any note (main or chord) has cautionary accid, for space checks -ccccccccccccc -cc irest cc -ccccccccccccc -c 0 rest=1, no rest = 0 -c 1 There will be a vertical shift for number of this xtup -c 2 Set if 2-note tremolo starts here -c 3-4 nsolid, # of solid beams in 2-note tremolo -c 5-6 nindent, # of indented beams in 2-note tremolo -c 7 There is a horizontal shift for xtup number -c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 -c 14 Flip up/down-ness of xtup number -c 15 Single-voice, single note shift X(...)[p]S -c 16 Start single-voice, multinote shift with this note X(...)[p]: -c 17 End single-voice, multinote shift after this note. Enter symbol -c after note. X: -c 18 User-defined hardspace after last note of bar, *after* this note. -c Value still stored in udoff(ivx,nudoff(ivx)), not with other -c hardspaces in udsp, to avoid confusion with time checks. -c 19 Move the dot. Data stored in ndotmv,updot,rtdot -c 20 Set if right-shifted main or chord note here. Use for space checks. -c 21 User-defined hardspace in xtup -c 22 User-defined slur shift horizontal slur shift. -c 23 Set on last note before staff-jumping a beam. -c 24 Set on first note after staff-jumping a beam -c 25 Suppress rest centering. "ro" -c 26 Dynamic on this note -c 27 Set if left-shifted main or chord note here. Use for space checks. -c 28 Set if xtup starts on this note. -c 29 Set on lowest-voice note at same time as 1st note after jump-beam. -c 30 Set on note after end of jump-beam segment, to force new note group -c 31 Flag for cautionary accidental -ccccccccccccc -cc nacc cc -ccccccccccccc -c 0-1 0=no accid, 1=fl, 2=sh, 3=na -c 2 double -c 3 big -c 4-9 vertshift-32 -c 10-16 20*(horiz. shift + 5.35) (Recentered ver 2.32) -c 17 Midi-only accidental -c 18 2:1 xtup -c 19 Together with nacc(18), increase multiplicity by 1 and dot 1st note. -c 20 Set on last note of each seg except last seg of single-slope beam. -c 21 Set on 1st note of each seg except 1st seg of single-slope beam. -c 22-26 If .ne.0, printed xtup number for xtup starting on this note. -c 27 Set for dotted xtup note. Mult dur by 1.5, mult next by .5 & increase -c multiplicity by 1 -c 28 Set on main note of chord if accidentals are ordered. -c 29 Tag for chordal accidental shift...means add to autoshifts. -c 30-31 Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted. -c If upstem|downstem, main is upper|lower member of 2nd -c Action is to interchange pitches only when notes are placed. -ccccccccccccc -cc mult cc -ccccccccccccc -c 0-3 Multiplicity+8 (mult= # of flags) -c 4 Set if slope adjustment for xtup bracket -c 5-9 16+slope adjustment -c 10-15 New stem length, [0-63] => (-4,0,+27.5) -c 16-22 64+Vertical offset of xtup # -c 27 Stemlength override -cc 28-30 New stem length. -ccccccccccccc -cc isdat1 cc -ccccccccccccc -c 13-17 iv -c 3-10 ip -c 11 start/stop switch -c 12 kv-1 -c 19-25 ichar(code$) -c 26 force direction? -c 27 forced dir'n = up if on, set in sslur; also -c final direction, set in doslur when beam is started, used on term. -c 28-31 ndxslur, set in doslur when beam is started, used on term. -ccccccccccccc -cc isdat2 cc -ccccccccccccc -c 0 Chord switch. Not set on main note. -c 1-2 left/right notehead shift. Set only for chord note. -c 3 tie positioning -c 4 dotted slur -c 6-11 voff1 1-63 => -31...+31 -c 12-18 hoff1 1-127 => -6.3...+6.3 -c 19-25 nolev -c 26 \sluradjust (p+s) -c 27 \nosluradjust (p-s) -c 28 \tieadjust (p+t) -c 29 \notieadjust (p-t) -ccccccccccccc -cc isdat3 cc -ccccccccccccc -c 0 set if midslur (at least one argument) -c 1 set if curve (2 more args) -c 2-7 32+first arg (height correction) (1st arg may be negative) -c 8-10 second arg (initial slope) -c 11-13 third arg (closing slope) -c 14-21 tie level for use in LineBreakTies -c 22-29 ncm for use in LineBreakTies -ccccccccccccc -cc isdat4 cc Set these all at turn-on using s option -ccccccccccccc -c 0-5 Linebreak seg 1 voff 1-63 => -31...+31 -c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 -c 16-21 Linebreak seg 2 voff 1-63 => -31...+31 -c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 -ccccccccccccc -c icrdat c -ccccccccccccc -c 0-7 ip within voice -c 8-11 ivx (together with 28th bit) -c 12-18 note level -c 19 accidental? -c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) -c 23 shift left -c 24 shift right -c 25 arpeggio start or stop -c 26 flag for moved dot (here, not icrdot, since this is always reset!) -c 27 Midi-only accidental -c 28 (6/27/10) 5th bit for ivx, to allow up to 24 voices -c 29 Tag for accidental shift...means add to autoshifts. -c 31 Flag for cautionary accidental on chord note -ccccccccccccc -c icrdot c: -ccccccccccccc -c 0-6 10*abs(vertical dot shift in \internote) + 64 -c 7-13 10*abs(horizontal dot shift in \internote) + 64 -c 14-19 vert accidental shift-32 -c 20-26 20*(horiz accidental shift+3.2) -c 27-29 top-down level rank of chord note w/accid. Set in crdaccs. -c -c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. -c -cccccccccccccccccccccccccccccccc - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - character*10 figq - common /comignorenats/ mbrhgt,newmbrhgt,ignorenats - logical ignorenats,newmbrhgt - character*1 ulq,sepsymq,sq,chax - logical beamon,firstgulp,figbass,figchk, - * isfig,rptnd1,rptprev - logical loop,lastchar,slint,svolta,evolta,onvolt, - * cwrest(nm),islast,inlast,optimize - integer istop(80),numbms(nm),istart(80) - real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks), - * tstart(80),squez(80) - character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq - character*79 notexq,inameq - character*40 pathnameq - character*44 basenameq - character*24 fmtq - character*20 voltxtq - character*120 instrq,titleq,compoq - common /comlast/ islast,usevshrink - logical usevshrink,stickyS,OptLineBreakTies,autofbon - common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 - common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, - * inhead - common /cominbot/ inbothd - common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2,ivvfig(2,74) - common /comnsp/ space(80),nb,prevtn(nm), - * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) - common /comstart/ facmtr - common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, - * tautofb,autofbon,t1autofb - common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, - * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, - * rptprev,equalize,rptfq1,rptfq2 - common /combeam/ ibmtyp - common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, - * OptLineBreakTies,HeaderSpecial - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comas2/ nasksys,wasksys(800),elasksys(800) - common /comas3/ ask(2500),iask,topmods - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - common /comsln/ is1n1,is2n1,irzbnd,isnx - common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, - * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, - * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, - * graspace(37), - * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), - * naccg(74),voltxtq(6),litq(83) - logical upg,slurg,slashg,fbon,ornrpt,shifton,isbjmp,notcrd,was2, - * isbj2,fontslur,WrotePsslurDefaults,HeaderSpecial - common /comivxudorn/ivxudorn(63) - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - character*128 litq,lnholdq - logical upslur,bar1syst,vshrink,lrpt,rrpt,lrptpend, - * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb, - * btest,sluron,setis,nobar1 - common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) - common /compoi/ ispoi - common /combc/ bcspec - common /comeon/ eonk,ewmxk - common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, - * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, - * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, - * rtshfac - common /comhsp/ hpttot(176) - common /combmh/ bmhgt,clefend - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - common /strtmid/ ihnum3,flipend(nm),ixrest(nm) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - common /commus/ musize,whead20 - common /comtol/ tol - common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), - * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), - * idynda2(99),levhssav(nm),listcresc,listdecresc - character*128 txtdynq - logical mrecord,mplay,endmac,flipend,istype0,lowdot,rename,ispstie - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc,equalize, - * ismbr,putmbr - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /comcb/ nbc,ibcdata(36) - common /comclefq/ clefq - common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), - * ArpShift(20) - common /comligfont/ isligfont - logical isligfont - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /combibarcnt/ ibarcnt - character*40 nmq - common /commidisig/ midisig - common /comclefrests/ centrests - logical newclef, centrests - common /comlyr/ inputmlyr - logical inputmlyr - common /combottop/ botamt,topamt,bottopgap - logical bottopgap - common /comis4bignv/ is4bignv,AIset - logical is4bignv,AIset - common /comhair/ idhairuse,idhair(nm) - common /comc8flag/ c8flag(nm) - logical c8flag - common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, - * poefa - real*4 poefa(125) - logical nocodabn - character*3 shortfraq,rendq - bottopgap = .false. - inputmlyr = .false. - idhairuse = 0 - if (.not.optimize) then - print* - print*,'Starting second PMX pass' - print* - write(15,'(a)')'Starting second PMX pass' - end if - newclef = .false. - centrests = .false. - ncalls = ncalls+1 - islast = inlast - macuse = 0 - isyscnt = 0 - stemmax = 8.2 - stemmin = 3.9 - stemlen = 6.0 - sq = chax(92) - ignorenats = .false. - newmbrhgt = .false. - bcspec = .true. - topmods = .false. - ismbr = .false. - read(12,'(a)')basenameq - read(12,*)lbase - read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop, - * etabot,inbothd,inhnoh,isig - ilbuf = 1 - ipbuf = 0 - call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,xmtrnum0, - * npages,nsyst,musicsize,fracindent,istype0,inameq, - * clefq,sepsymq,pathnameq,lpath,isig0) - if (ismidi) then -c -c Initial key signature and meter for pickup bar -c 130313 Unless explicit miditranspose for all parts (to be dealt with later), -c want concert sig (isig0) here. K+n+m will have changed sig to isig -c call midievent('k',isig,0) -c 130316 -c call midievent('k',isig0,0) -c call midievent('k',midisig,0) -c -c Above is probably cosmetic -c call midievent('k',midisig,0) - if (xmtrnum0 .gt. tol) then -c -c We have a pickup. Some tricky stuff to get a meter: -c - xntrial = xmtrnum0 - do 5 ip2 = 0 , 5 - if (abs(mod(xntrial,1.)) .lt. tol) go to 6 - xntrial = xntrial*2 -5 continue - print*,'Problem finding meter for pickup bar' - xntrial = 1. - ip2 = 0 -6 continue - call midievent('m',nint(xntrial),2**ip2*mtrdenl) - else -c -c No pickup, enter the starting meter -c - call midievent('m',mtrnuml,mtrdenl) - end if - end if -c -c Set musicsize from value passed in common, due to possible reset by S[n]m16 -c - musicsize = musize - read(12,*)npages,widthpt,height,hoffpt,voffpt,nsyst, - * (nsystp(ipa),xnsttop(ipa),xintstaff(ipa),ipa=1,npages),iauto -c -c If default width ever changes, must adjust this stmt. -c - slfac1 = 0.00569*524./widthpt - figbass = .false. - read(13,*)ifig - if (ifig .eq. 1) then - figbass = .true. - open(14,status='SCRATCH') - write(14,'(a)')sq//'def'//sq//'fixdrop{'//sq//'advance'//sq// - * 'sysno by 1'//sq//'ifcase'//sq//'sysno%' - end if - lastchar = .false. - ibcoff = 0 - if (xmtrnum0 .gt. 0.) ibcoff = -1 - open(11,status='SCRATCH') -c -c vshrink for the first page is calculated in topfile, -c and if true set interstaff=10. vshrink affects Titles. -c Must also save vshrink for page ending. -c - call topfile(basenameq,lbase,nv,clefq,noinst,musicsize, - * xintstaff(1),mtrnmp,mtrdnp,vshrink,fbar,fontslur) -c -c ninow is working value of # of instruments. noinst is max #, and # at start. -c - ninow = noinst -c -c Save original printed meter in case movement breaks -c - movnmp = mtrnmp - movdnp = mtrdnp -c - if (islast .and. figbass .and. musicsize.eq.16) - * write(11,'(a)')sq//'def'//sq//'figfont{'//sq//'eightrm}%' -c - if (islast .and. isligfont) then - if (musicsize .eq. 16) then - write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 8pt%' - else - write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 10pt%' - end if - end if - lenbeat = ifnodur(mtrdenl,'x') - if (mtrdenl .eq. 2) lenbeat = 16 - lenb1 = mtrnuml*lenbeat - if (mtrdenl .eq. 2) lenb1 = lenb1*2 - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - lenb0 = nint(xmtrnum0*lenbeat) - if (mtrdenl .eq. 2) lenb0 = lenb0*2 - if (lenb0 .ne. 0) then - if (islast) write(11,'(a)')sq//'advance'//sq//'barno by -1' - lenbar = lenb0 - else - lenbar = lenb1 - end if -c -c Initialize full-program variables -c - fixednew = 0. - scaldold = 0. - fintstf = -1. - gintstf = 1. - nasksys = 0 - ibarcnt = 0 - iline = 0 - movbrk = 0 - isystpg = 0 - ipage = 1 - iccount = 128 - iask = 0 - nhstot = 0 - nb = 1 - if (.not.optimize) jprntb = 81 - idsig = 0 - iflagbot = 0 -c -c Next 5 are raise-barno parameters. irzbnd is integer part of default level. -c - irzbnd = 3 - if (isig.eq.3 .and. clefq(nv).eq.'t') irzbnd = 4 - is1n1 = 0 - isnx = 0 - SlurCurve = 0. - ishort = 0 - nocodabn = .false. - mbrsum = 0 - nmbr = 0 -c -c 111109 Made global rather than per gulp -c - ndyn = 0 - ispoi = .false. - slint = .false. - lrptpend = .false. - rptnd1 = .false. - rptfq2 = 'E' - rptprev = .false. - onvolt = .false. - flgndb = .false. - fbon = .false. - shifton = .false. - ornrpt = .false. - setis = .false. - lowdot = .false. - rename = .false. - nobar1 = .false. - equalize = .false. - usevshrink = .true. - WrotePsslurDefaults = .false. - OptLineBreakTies = .false. - HeaderSpecial = .false. -c -c vshrink is initialized in topfile -c - stickyS = .false. -c -c ixrest = 1 or 2 if xtup has started with a rest -c - do 1 ivx = 1 , nm - ixrest(ivx) = 0 - fullsize(ivx) = 1. -c -c Set legacy note level to middle c as default -c - ndlev(ivx,1) = 29 - ndlev(ivx,2) = 29 -1 continue - npreslur = 0 - nhssys = 0 - listslur = 0 - do 31 i = 1 , 202 - isdat1(i) = 0 - isdat2(i) = 0 -31 continue - nsdat = 0 -c -c Initialize flag for figures in any other voice than 1 -c - ivxfig2 = 0 -c -c Initialize for loop over gulps -c - firstgulp = .true. -c -c Start a gulp -c -30 loop = .true. - notcrd = .true. - isbjmp = .false. - isbj2 = .false. - autofbon = .false. - tautofb = 0. - nbars = 0 - nfigs(1) = 0 - nfigs(2) = 0 - ngrace = 0 - ntrill = 0 - ncrd = 0 - nudorn = 0 - nlit = 0 - nvolt = 0 - ibarmbr = 0 - nudsp = 0 -c ndyn = 0 ! 111109 - ntxtdyn = 0 - nbc = 0 - NumArpShift = 0 - do 3 i = 1 , 37 - graspace(i) = 0. -3 continue -c -c Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst. -c and also if nv increases in an 'M' directive. -c - do 4 iv = 1 , nv - call newvoice(iv,clefq(iv),.false.) -4 continue -c -c Check if endsymbol was set earlier -c - if (rptnd1) then - rptnd1 = .false. - rptfq2 = rptfq1 - else -c -c Only use if movbrk>0, to signal default ('RD') -c - rptfq2 = 'E' - end if - iv = 1 - ivx = 1 -2 if (loop) then -c -c Within this loop, nv voices are filled up for the duration of the block. -c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) -c nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..). -c nbars is for this input block. -c Only at the beginning of an input block will there be a possible mtr change, -c signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) -c - call getnote(loop) - if (lastchar) go to 40 - go to 2 - end if -c -c Finished an input block (gulp). -c - if (ismidi) then -c -c Put rests into midi array for 2nd lines that were not used in this gulp. -c - do 60 iv = 1 , nv - if (twoline(iv) .and. nvmx(iv).eq.1) then - if (firstgulp .and. lenb0.ne.0) then - call addmidi(midchan(iv,2),0,0,0, - * (nbars-1.)*lenbar+lenb0,.true.,.false.) - else - call addmidi(midchan(iv,2),0,0,0,1.*nbars*lenbar,.true., - * .false.) - end if - end if -60 continue - end if - nvolt = 0 - do 28 iv = 1 , nm - nudoff(iv) = 0 - maxdotmv(iv) = ndotmv(iv) - ndotmv(iv) = 0 -28 continue -c -c Put stuff at top of p.1. Must wait until now to have read title info. -c - if (ibarcnt .eq. 0) then - call puttitle(inhnoh,xnsttop(ipage), - * etatop,sq,etait,etatc,etacs1,nv,vshrink,sepsymq) - if (HeaderSpecial) -c -c Write special header for first page -c - * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%' - end if - do 10 ibar = 1 , nbars - ibarcnt = ibarcnt+1 - bar1syst = ibarcnt .eq. iauto - ndig = max(0,int(log10(.001+ibarcnt+ibcoff))) - if (islast) - * write(11,'(a11,i'//chax(50+ndig)//')') - * '% Bar count',ibarcnt+ibcoff - if (ibar .ne. ibarmbr) then - if (.not.optimize) call outbar(ibarcnt+ibcoff,jprntb) - else - if (.not.optimize) then - write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars', - * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1 - write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars', - * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1 - jprntb = 0 - end if - ibcoff = ibcoff+mbrest-1 -c if (ibar.eq.1 .and. firstgulp .and. -c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize - if (ibar.eq.1 .and. firstgulp .and. - * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize - end if -c -c Move the read to after end-of-bar hardspace checks, so we get right poenom -c at end of a line. -c if (bar1syst) read(12,*) poenom -c -c Check for clef at start of bar. No slide yet. Also flags at end of prev. -c bar. This block is run at the start of every bar. May fail for flag at -c end of last bar. To account for necc. hardspaces, compute and store -c nhssys = # of hard spaces for this system -c hesk(nhssys) = elemskips avialable -c hpts(nhssys) = hard points needed, including notehead -c Here, merely insert placeholder into output. Later, when poe is computed, -c compute additional pts and store them in hpttot(1...nhstot). Finally in -c subroutine askfig, write true pts where placeholders are. -c - ioff = 0 - if (ibar .gt. 1) ioff = nib(1,ibar-1) - clchb = btest(islur(1,ioff+1),15) - putmbr = .false. - if (ismbr) then - if (clchb) then -ccc -ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. -ccc - write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest' - * //sq//'def'//sq//'mbrest#1#2#3{%' - write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55, - * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%' -cc -cc RDT suggestion is inset blank barline - 160103 Abandoned -cc -c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' -c * //sq//'advance'//sq//'barno-1' - end if - ismbr = .false. - putmbr = .true. - end if - if (ibar .eq. ibarmbr) ismbr = .true. -c -c Set flag here so at start of next bar, if there's a clef change, can add space -c after the mbr with the above kluge -c - if (.not.(clchb .or. flgndb)) go to 23 -c -c Must check available space -c - ptsndb = 0. -c -c Zero out block signal -c - if (clchb) islur(1,ioff+1) = ibclr(islur(1,ioff+1),15) -c -c In this loop, we determine how much hardspace is needed (if any) -c 9/7/97 Note that for last bar in input block, if number of lines of -c music decreases in new block, highest numbered ones won't be checked -c since the loop below covers the new nvmx(iv), not necessarily the old -c one. -c 4/18/98 Apparently nmxsav was a solution to the above problem -c - do 16 iv = 1 , nv - do 16 kv = 1 , nvmxsav(iv) - ivx = ivmxsav(iv,kv) - ptsndv = flgndv(ivx)*wheadpt - ioff = 0 - if (ibar .gt. 1) then - ioff = nib(ivx,ibar-1) - ip = ioff - if (ibar.gt.2) ip = ioff-nib(ivx,ibar-2) -c prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) - prevtn(ivx) = tnote(ipl2(ivx,ip)) -c -c If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. -c - end if -c -c Only allow clef changes when ivx <= nv -c - if (ivx .le. nv) then - clchv(iv) = clchb .and. btest(islur(iv,ioff+1),11) - if (clchv(iv)) then -c -c Clef change in this voice. Turn off signal. Get space avail. -c - islur(iv,ioff+1) = ibclr(islur(iv,ioff+1),11) - if (abs(prevtn(iv)-space(nb)).lt.tol) ptsndv = - * ptsndv+clefend*wheadpt - end if - end if - ptsndb = max(ptsndb,ptsndv+wheadpt*xspfac) -16 continue -c -c ???? where is nb set??? nb probably in left over from makeabar -c - esk = feon(space(nb)*squez(nb)) - ptsdflt = esk*poenom-wheadpt -c if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then - if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0 - * .and. .not.putmbr) then -c -c Must ADD hardspace! So put in a placeholder, and store params for later. -c - if (islast) write(11,'(a)')sq//'xardspace{ pt}%' - nhssys = nhssys+1 - if (ptsndb-ptsdflt .gt. ptsgnd-poenom*eskgnd) then - hesk(nhssys) = esk - hpts(nhssys) = ptsndb+wheadpt - else - hesk(nhssys) = eskgnd - hpts(nhssys) = ptsgnd+wheadpt - end if - fixednew = fixednew+hpts(nhssys) - scaldold = scaldold+hesk(nhssys) - end if - if (clchb) then - do 17 iv = 1 , nv - if (clchv(iv)) then - notexq = sq//'znotes' - lnote = 7 - do 24 iiv = 2 , iv - notexq = notexq(1:lnote)//sepsymq(iiv-1) - lnote = lnote+1 -24 continue -c -c Recompute ioff since it will vary from voice to voice -c - if (ibar .eq. 1) then - ioff = 0 - else - ioff = nib(iv,ibar-1) - end if -c -c Must call clefsym to get nclef, even if there is a movement break -c - call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef) -c -c If clefq = '8', must change '0' in pos'n 9 to '8' -c - if (btest(ipl(iv,ioff+1),2)) fmtq = - * fmtq(1:8)//'8'//fmtq(10:10) - if (movbrk.eq.0 .and. - * islast) - * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%' - call wsclef(iv,ninow,nclef) -c -c Set new flag to be used just outside this loop, to kluge -c any calls to \CenterBar for full-bar rests, to make room for clef. -c - newclef = .true. -c -c 151220 -c wrong test: -c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% -c Replaced with right one. But also, clefq(iv) seems to stay at 8 here, -c and if we change from TLO to normal clef, need to resetclefsymbols -c -c if (clefq(iv) .eq. '8') then - if (btest(ipl(iv,ioff+1),2)) then -c -c Find instrument number for voice iv -c - iv1 = 1 - do 1111 iinst = 1 , ninow - if (iv .lt. iv1+nspern(iinst)) go to 2222 - iv1 = iv1+nspern(iinst) -1111 continue - print* - print*,'Should not be here in pmxb!' - call stop1() -2222 continue - if (iinst .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iinst, - * sq//'treblelowoct%' - else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iinst, - * sq//'treblelowoct%' - end if - c8flag(iv) = .true. - else - if (clefq(iv) .eq. '8') then - write(11,'(a20)')sq//'resetclefsymbols' - end if - end if - end if -17 continue - if (islast) write(11,'(a)')sq//'pmxnewclefs' - end if -23 continue -c -c Kluge \CenterBar for whole bar rests if necessary -c - if (newclef .and. centrests) then -c write(11,'(a)')sq//'def'//sq//'value{11}%' - nvalue = nint(.55*musicsize) - if (nvalue .gt. 10) then - write(11,'(a11,i2,a2)') - * sq//'def'//sq//'value{',nvalue,'}%' - else - write(11,'(a11,i1,a2)') - * sq//'def'//sq//'value{',nvalue,'}%' - end if - end if - newclef = .false. - centrests = .false. -c -c End of loop for end-of-bar hardspaces and non-movbrk clef symbol. -c - if (bar1syst) then - read(12,*) poenom - end if -c -c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) -c - if (ibar .eq. 1) then - islnow = islur(1,1) -c iornqnow = iornq(1,1) - iplnow = ipl(1,1) - else - islnow = islur(1,nib(1,ibar-1)+1) -c iornqnow = iornq(1,nib(1,ibar-1)+1) - iplnow = ipl(1,nib(1,ibar-1)+1) - end if -c -c Check for R-symbols set at end of prior input block -c - if (movbrk.eq.0 .and. rptfq2.ne.'E') then - if (rptfq2 .eq. 'D') then - islnow = ibset(islnow,26) - else if (rptfq2 .eq. 'r') then - islnow = ibset(islnow,6) - else if (rptfq2 .eq. 'd') then - islnow = ibset(islnow,8) - else if (rptfq2 .eq. 'b') then - islnow = ibset(islnow,25) - else - print* - print*,'Illegal symbol with "R" at end of input block:', - * rptfq2 - call stop1() - end if - rptfq2 = 'E' - end if - if (iand(islnow,352) .ne. 0) then -c -c Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set -c - lrpt = btest(islnow,5) - rrpt = btest(islnow,6) - lrptpend = lrpt.and.bar1syst - if (lrpt .and. .not.lrptpend) then - if (rrpt) then - if (islast) write(11,'(a)')sq//'setleftrightrepeat' - fixednew = fixednew+wheadpt*lrrptfac-0.4 - else - if (islast) write(11,'(a)')sq//'setleftrepeat' - fixednew = fixednew+wheadpt*rptfac-0.4 - end if - else if (rrpt) then - if (islast) write(11,'(a)')sq//'setrightrepeat' - fixednew = fixednew+wheadpt*rptfac-0.4 - else if (btest(islnow,8)) then - if (islast) write(11,'(a)')sq//'setdoublebar' - fixednew = fixednew+wheadpt*dbarfac-0.4 - end if - else if (btest(islnow,26)) then -c -c doubleBAR -c - if (islast) write(11,'(a)')sq//'setdoubleBAR' - fixednew = fixednew+wheadpt*ddbarfac-0.4 -c else if (btest(iornqnow,29)) then - else if (btest(iplnow,0)) then -c -c no bar line -c -c-- if (islast) write(11,'(a)')sq//'setzalaligne' -c++ - if (islast) then - if (movbrk .eq. 0) then - write(11,'(a)')sq//'setzalaligne' - else -c -c Encountered "Rz" at start of input block at start of new movement, Must -c use newmovement macro with arg 4 rather than setzalaligne, since former -c already redefines stoppiece. -c - rptfq2 = 'z' - end if - end if -c++ - fixednew = fixednew-0.4 - end if -c -c 1st and 2nd endings -c - svolta = btest(islnow,7) - evolta = btest(islnow,9) - if (evolta) then - if (btest(islnow,10)) then - if (islast) write(11,'(a)')sq//'endvoltabox' - else - if (islast) write(11,'(a)')sq//'endvolta' - end if - onvolt = .false. - end if - if (svolta) then - nvolt = nvolt+1 - lvoltxt = index(voltxtq(nvolt),' ')-1 - if (lvoltxt .eq. 1) then - if (islast) write(11,'(a)')sq//'Setvolta' - * //voltxtq(nvolt)(1:1)//'%' - else - if (islast) write(11,'(a)')sq//'Setvolta'//'{'// - * voltxtq(nvolt)(1:lvoltxt)//'}%' - end if - onvolt = .true. - end if - if (ibar .gt. 1) then - ipnow = nib(1,ibar-1)+1 - else - ipnow = 1 - end if - iplnow = ipl(1,ipnow) - if (bar1syst) then -c -c If listslur>0, then there is at least one slur or tie carried over the break -c - ispstie = .false. - if (OptLineBreakTies .and. .not.fontslur .and. listslur.ne.0 - * .and. islast) - * call LineBreakTies(isdat1,isdat2,isdat3,isdat4, nsdat, - * ispstie,sepsymq) - iline = iline+1 -c -c End an old system, Start a new system -c -c Reduce space before mbrest at start of system -c Need this even if no accidentals in key signature -c - if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize -c - if (iline .ne. 1) then -c -c Not first line. -c Get corrected poe = points/elemskip for *previous* system -c - wdpt = widthpt*(1-fracindent) - poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/ - * (elsktot+fbar*nbarss-scaldold) - isyscnt = isyscnt+1 - poevec(isyscnt) = poe -c -c Transfer data for system into global arrays to hold until very end -c - do 9 ia = 1 , nasksys - iask = iask+1 - ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia))) - * /poefa(iline-1) -c -c Only admit negative ask if it was user-defined space, signalled by elask<=0. -c - if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.) -9 continue - do 25 ia = 1 , nhssys - nhstot = nhstot+1 - hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.) -25 continue -c -c Reset counters for new system -c - scaldold = 0. - fixednew = 0. - nasksys = 0 - nhssys = 0 - end if -c -c End of if block for first bar of non-first system. Still 1st bar, any system -c - if (islast.and.figbass) write(11,'(a)')sq//'fixdrop%' - isystpg = isystpg+1 -c -c Try moving the next stmt way down, to fix a bug and get \eject printed at -c end of single-system page. -c if (isystpg .eq. nsystp(ipage)) isystpg = 0 - read(12,*)nbarss,elsktot,fsyst,frac,eonk,ewmxk - if (iline .gt. 1) fracindent=frac - if (figbass) then - ifigdr(1,iline) = 4 - ifigdr(2,iline) = 4 - end if - slfac = slfac1*musicsize*elsktot - if (iline .ne. 1) then -c -c For the line just _finished_, put figdrop in separate file. -c - if (figbass) write(14,'(a9,i2,a10,i2,1x,a4)') - * sq//'figdrop=',ifigdr(1,iline-1), - * ' '//sq//'figdtwo=',ifigdr(2,iline-1),sq//'or%' -c -c Check slurs in top staff for interference w/ barno. Only check when -c # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS -c keep track of ons and offs when |isig|<=3. -c - ndigbn = int(alog10(ibarcnt+ibcoff+.01))+1 - isnx = 0 - if (ndigbn.ge.iabs(isig) .and. is1n1.gt.0) then -c -c There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 -c Look for termination in remainder of this input block. If not found, -c just use is1n1. Remember, haven't slid down yet. -c - ioff = 0 - if (ibar .gt. 1) ioff = nib(ivmx(nv,nvmx(nv)),ibar-1) - do 50 isdat = 1 , nsdat - if (igetbits(isdat1(isdat),5,13).eq.ivmx(nv,nvmx(nv)) - * .and. .not.btest(isdat1(isdat),11) - * .and. igetbits(isdat1(isdat),7,19).eq.is2n1) then -c -c Found slur ending. Just check note height, can't do fine adjustments. -c -c is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) - is1n1 = max(is1n1,igetbits(isdat2(isdat),7,19)) - go to 51 - end if -50 continue -c -c If exiting loop normally, did not find end of slur. c'est la vie. -c -51 continue - isnx = idim(is1n1,ncmid(nv,1)+1+irzbnd) - if (isnx .gt. 0) then -c -c AHA! Slur likely to interfere with barno. -c -c Modified 090525 to use \bnrs -c - slint = .true. - fmtq = '(a16,i1,a14)' - if (irzbnd+isnx .gt. 9) fmtq = '(a16,i2,a14)' - if (islast) write(11,fmtq)sq//'def'//sq//'raisebarno{', - * irzbnd+isnx,'.5'//sq//'internote}%' -c if (islast) then -c if (isnx .le. 9) then -c write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%' -c else -c write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%' -c end if -c end if -c - end if - end if - if (movbrk .gt. 0) then -c -c movbrk = 0 -c Move the reset down, so can use movbrk>0 to stop extra meter prints. -c -c New movement. Redefine stoppiece, contpiece. These will be called either -c explicitly or as part of alaligne. -c indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. -c This is passed to \newmovement. -c - if (rptfq2 .eq. 'E') rptfq2 = 'D' - indsym = index('Ddrbz',rptfq2)-1 - rptfq2 = 'E' -c -c Also check for Rd or Rr set the normal way -c - if (btest(islnow,8)) then - indsym = 1 - else if (btest(islnow,6)) then - indsym = 2 - end if - if (indsym .lt. 0) then - print* - print*,'Illegal end symbol before "/"' - call stop1() - end if -c -c Check for continuation (no bar number reset) -c - if (islast.and.nobar1) then - write(11,'(a)')sq//'advance'//sq//'barno1' - * //sq//'global'//sq//'startbarno'//sq//'barno%' -c -c Need above for shortening case mcm with Mc -c - end if -c -c Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement -c -c if (movgap .lt. 10) then -c if (islast) write(11,'(a12,2i1,a1)') -c * sq//'newmovement',movgap,indsym,'%' -c else -c if (islast) write(11,'(a13,i2,a1,i1,a1)') -c * sq//'newmovement{',movgap,'}',indsym,'%' -c end if - if (islast) then - nmq = sq//'newmovement' - lnmq = 12 - if (movgap .lt. 10) then - lnmq = 14 - write(nmq(13:14),'(2i1)')movgap,indsym - else - lnmq = 17 - write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym - end if - if (ninow .lt. 10) then - lnmq = lnmq+1 - write(nmq(lnmq:lnmq),'(i1)')ninow - else - lnmq = lnmq+4 - write(nmq(lnmq-3:lnmq),'(a1,i2,a1)')'{',ninow,'}' - end if - lnmq = lnmq+1 - write(nmq(lnmq:lnmq),'(a1)')'%' - if (ishort .eq. 4) then -c -c Ending Short-blank-coda -c - write(11,'(a)')sq//'Endpiece}}%' - end if - write(11,'(a)')nmq(1:lnmq) - if (ishort .eq. 2) then - write(11,'(a)')sq//'stoppiece}}%' - ishort = 5 - else if (ishort .eq. 4) then - write(11,'(a)')sq//'let'//sq//'stoppiece'//sq// - * 'holdstop%' -c -c Since we bypass newmovement, need to set the vertical gap. -c - if (movgap .gt. 10) then - write(11,'(a6,i2,a11)') - * sq//'vskip',movgap,sq//'internote%' - else if (movgap .gt. 0) then - write(11,'(a6,i1,a11)') - * sq//'vskip',movgap,sq//'internote%' - end if - ishort = 6 - end if - if ((ishort.eq.5.or.ishort.eq.6).and..not.rename) then - do 62 iinst = 1 , ninow - if (islast) then - if (iinst .lt. 10) then - write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%' - else - write(11,'(a9,i2,a4)')sq//'setname{',iinst, - * '}{}%' - end if - end if -62 continue - end if - rename = .false. - end if -c -c Change generalmeter if necessary -c - if (islast) then - call wgmeter(mtrnmp,mtrdnp) - end if - mtrnuml = 0 -c -c (Moved all name-writing to getnote, right when 'M' is detected) -c - if (btest(iplnow,28)) then -c -c Key signature at movement break -c - iplnow = ibclr(iplnow,28) - if (isig .gt. 0) then - if (islast) write(11,'(a18,i1,a2)') - * sq//'generalsignature{',isig,'}%' - else - if (islast) write(11,'(a18,i2,a2)') - * sq//'generalsignature{',isig,'}%' - end if - if (islast .and. LaterInstTrans) then - call Writesetsign(nInstTrans,iInstTrans,iTransKey, - * LaterInstTrans) - end if - end if - if (parmov .ge. -.1) then -c -c Resent paragraph indentation -c - ipi = parmov*widthpt+.1 - if (ipi .lt. 10) then - if (islast) write(11,'(a11,i1,a2)') - * sq//'parindent ',ipi,'pt' - else if (ipi .lt. 100) then - if (islast) - * write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt' - else - if (islast) - * write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt' - end if - end if - if (ishort .eq. 6) then - if (iflagbot .eq. 1) then - write(11,'(a)')sq//'vfill'//sq//'eject' -c iflagbot = 0 -c ishort = 0 - else - write(11,'(a)')sq//'contpiece' - end if -c -c Zero ishort later trying to write alaligne -c - end if - end if ! End of movement break stuff - if (isystpg .eq. 1) then -c -c First line on a page (not 1st page, still first bar). Tidy up old page -c then eject. -c -c Removed this 5/13/01 as it was causing double endvoltas. This probably -c is only needed at the end in case there is no endvolta specified. -c if (onvolt) then -cc if (islast) write(11,'(a)')sq//'endvoltabox%' -cc onvolt = .false. -c end if -c -c -c Check for meter change at start of a new PAGE -c - if (mtrnuml .gt. 0) then -c -c Meter change at start of a new page. Ugly repeated coding here. -c - mtrnms = mtrnuml - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - mtrnuml = mtrnms - if (movbrk .eq. 0 .and. islast) then - call wgmeter(mtrnmp,mtrdnp) - end if - end if -c -c Key signature change? -c - if (btest(iplnow,28) .and. movbrk.eq.0) then - notexq = sq//'xbar'//sq//'addspace{-'//sq// - * 'afterruleskip}'//sq//'generalsignature{' - lnote = 49 - if (isig .lt. 0) then - notexq = notexq(1:49)//'-' - lnote = 50 - end if - if (islast) write(11,'(a)') - * notexq(1:lnote)//chax(48+abs(isig))//'}%' - if (islast .and. LaterInstTrans) then - call Writesetsign(nInstTrans,iInstTrans,iTransKey, - * LaterInstTrans) - end if - if (islast .and. ignorenats) - * write(11,'(a)')sq//'ignorenats%' - if (islast) write(11,'(a)')sq//'zchangecontext'//sq - * //'addspace{-'//sq//'afterruleskip}' - * //sq//'zstoppiece'//sq//'PMXbarnotrue%' - else if (mtrnuml.gt.0 .and. movbrk.eq.0) then -c -c Meter change but no signature change -c - if (islast) - * write(11,'(a)')sq//'xchangecontext'//sq//'addspace{-'// - * sq//'afterruleskip}'//sq//'let'//sq//'bnat'//sq// - * 'barnoadd%' - if (islast) - * write(11,'(a)')sq//'def'//sq//'barnoadd{'//sq//'let'// - * sq//'barnoadd'//sq//'bnat}'//sq//'zstoppiece%' - else - if (islast) then - if ((ishort.eq.4.or.ishort.eq.2) - * .and. iflagbot.eq.1) then - ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum - if (ntmp .le. 9) then - shortfraq(1:1) = char(48+ntmp) - lntmp = 1 - else - write(shortfraq(1:2),'(i2)')ntmp - lntmp = 2 - end if - write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq - * //'barno'//shortfraq(1:lntmp) -c -c Move down so can insert fil@begin -c iflagbot = 0 -c ishort = 0 -c - else if ((ishort.ne.6.and.ishort.ne.2) .or. - * iflagbot.ne.1) then - write(11,'(a)')sq//'stoppiece%' - end if - end if - end if -c -c This is the key spot when vshrink is used. Value of vshrink here comes from -c just after the prior pagebreak, i.e., it is not affected by "Av" -c that may have been entered at this pagebreak, since that only affects usevshrink. -c So choose page *ending* (with or without \vfill) depending on old vshrink. Then -c check value of usevshrink to reset vshrink if necessary for the new page, where -c we have to set \interstaff and later call puttitle. -c Top of first page needs special treatment. For this we use -c novshrinktop, which was set in g1etnote on the first pass, since on -c second pass, vshrink at top of page one is dealt with in topfile, which is called -c *before* any reading in any "Av" at the top of the first input block. -c - if (.not.vshrink) then - if (islast .and. bottopgap) then - if (abs(botamt) .gt. 1.e-6) then - if (botamt .gt. 9.95) then - fmtq = '(a,f4.1,a)' - else if (botamt .gt. 0.) then - fmtq = '(a,f3.1,a)' - else if (botamt .gt. -9.95) then - fmtq = '(a,f4.1,a)' - else - fmtq = '(a,f5.1,a)' - end if - write(11,fmtq)sq//'null'//sq//'vskip',botamt, - * sq//'Internote%' - end if - end if - xnstbot = xnsttop(ipage)*etabot/etatop - if (xnstbot .lt. 9.95) then - fmtq = '(a,f3.1,a)' - else - fmtq = '(a,f4.1,a)' - end if - if (islast) write(11,fmtq)sq//'vskip',xnstbot, - * sq//'Interligne'//sq//'eject%' - if (islast .and. bottopgap) then - if (abs(topamt) .gt. 1.e-6) then - if (topamt .gt. 9.95) then - fmtq = '(a,f4.1,a)' - else if (topamt .gt. 0.) then - fmtq = '(a,f3.1,a)' - else if (topamt .gt. -9.95) then - fmtq = '(a,f4.1,a)' - else - fmtq = '(a,f5.1,a)' - end if - write(11,fmtq)sq//'null'//sq//'vskip',topamt, - * sq//'Internote%' - end if - bottopgap = .false. - end if - else - if (islast) then - if (iflagbot.eq.1.and.ishort.eq.6)then -c -c cleanup for case bcm only -c - iflagbot = 0 - ishort = 0 - else - write(11,'(a)') sq//'vfill'//sq//'eject%' - if (iflagbot.eq.1.and.ishort.eq.2) then -c Clean up case bsl only - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - iflagbot = 0 - ishort = 0 - end if - end if - end if - end if - ipage = ipage+1 -c -c Now that page is ejected, compute new vshrink -c - vshrink = xintstaff(ipage).gt.20 .and. usevshrink - if (vshrink) then - xinsnow = 10 - else - xinsnow = xintstaff(ipage) - end if - if (fintstf.gt.0 .and. ipage.gt.1) then - xinsnow = xinsnow*fintstf/gintstf - fintstf = -1. - end if - if (xinsnow .lt. 9.95) then - fmtq = '(a,f3.1,a)' - else if (xinsnow .lt. 99.95) then - fmtq = '(a,f4.1,a)' - else - fmtq = '(a,f5.1,a)' - end if -c -c Vertical spacing parameters, then restart -c - if (is4bignv) xinsnow = .95*xinsnow - if (islast) then - write(11,fmtq)sq//'interstaff{',xinsnow, - * '}'//sq//'contpiece' - end if -c -c Check for meter change at start of a new PAGE -c - if (mtrnuml .gt. 0) then -c -c Meter change at start of a new page -c - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - if (movbrk .eq. 0) then - if (islast) then - call wgmeter(mtrnmp,mtrdnp) - end if - if (mtrdnp .gt. 0) then - if (islast) write(11,'(a)')sq//'newtimes2%' - if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize - end if - end if - end if -c -c If no real titles here, which there probably will never be, make vertical -c space at page top with \titles{...}. headlog=.false.<=>no real titles -c - if (ishort.eq.4 .and. iflagbot.eq.1) then - ishort = 0 - iflagbot = 0 - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'//sq// - * 'makeatother' - end if - call puttitle(inhnoh,xnsttop(ipage),etatop, - * sq,etait,etatc,etacs1,nv,vshrink,sepsymq) - if (HeaderSpecial) -c -c Write special header for first page -c - * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%' - else -c -c First bar of system, not a new page, force line break -c - if (btest(iplnow,28)) then -c -c Signature change -c - notexq = sq//'xbar'//sq//'addspace{-'//sq// - * 'afterruleskip}'//sq//'generalsignature{' - lnote = 49 - if (isig .lt. 0) then - notexq = notexq(1:49)//'-' - lnote = 50 - end if - if (islast) write(11,'(a)')notexq(1:lnote) - * //chax(48+abs(isig))//'}%' - if (islast .and. LaterInstTrans) then - call Writesetsign(nInstTrans,iInstTrans,iTransKey, - * LaterInstTrans) - end if - if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%' - if (mtrnuml .ne. 0) then -c -c Meter+sig change, new line, may need mods if movement break here. -c - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - if (islast) then - call wgmeter(mtrnmp,mtrdnp) - if (ignorenats) write(11,'(a)')sq//'ignorenats%' - write(11,'(a)')sq//'xchangecontext'//sq// - * 'addspace{-'//sq//'afterruleskip}' - * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%' - write(11,'(a)')sq//'addspace{-'//sq - * //'afterruleskip}%' - call wgmeter(mtrnmp,mtrdnp) - if (ignorenats) write(11,'(a)')sq//'ignorenats%' - write(11,'(a)')sq//'zchangecontext' - end if - else - if (islast .and. ignorenats) - * write(11,'(a)')sq//'ignorenats%' - if (islast) write(11,'(a)')sq//'xchangecontext'//sq// - * 'addspace{-'//sq//'afterruleskip}' - * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%' - end if - else if (mtrnuml.eq.0.and.(ishort.eq.0.or.ishort.eq.6)) - * then -c -c No meter change -c - if (islast) then - if (ishort .ne. 6) then - write(11,'(a)')sq//'alaligne' - else - ishort = 0 - end if - end if - else if (ishort .ne. 0) then - if (ishort .eq. 1) then ! Start short line - write(shortfraq,'(f3.2)')shortfrac - write(11,'(a)')sq//'stoppiece'//sq//'parindent 0pt' - write(11,'(a)')sq//'vskip'//sq//'parskip' - write(11,'(a)')sq//'hbox to'//sq// - * 'hsize{'//sq//'vbox{'// - * sq//'hsize='//shortfraq//sq//'hsize%' - write(11,'(a)')sq//'contpiece' - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - ibarcnt0 = ibarcnt - mbrsum = 0 - ishort = 2 - nmbr = 0 - else if (ishort .eq. 2) then ! End short line, no new mvt - ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum - if (ntmp .le. 9) then - shortfraq(1:1) = char(48+ntmp) - lntmp = 1 - else - write(shortfraq(1:2),'(i2)')ntmp - lntmp = 2 - end if - write(11,'(a)')sq//'stoppiece}}'//sq//'advance'//sq - * //'barno'//shortfraq(1:lntmp) -c -c Not clear why we needed this -c //sq//'startbarno'//sq//'barno%' - write(11,'(a)')sq//'contpiece' - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - ishort = 0 - else if (ishort .eq. 5) then ! End short line, new mvt - if (nobar1) then ! Continue bar numbering - write(11,'(a)')sq//'advance'//sq - * //'barno'//char(ibarcnt-ibarcnt0+48) - * //sq//'startbarno'//sq//'barno%' -c -c Must leave in \startbarno to get msm with LMc to work. -c - end if - write(11,'(a)')sq//'startpiece'//sq//'addspace'//sq - * //'afterruleskip%' - ishort = 0 - else if (ishort .eq. 3) then ! Mid line gap, start coda -c May never come thru here. Stuff is done later at least for mcl.pmx - write(shortfraq,'(f3.2)')codafrac - write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq - * //'barno'//char(ibarcnt-ibarcnt0+48)//sq// - * 'startbarno'//sq//'barno%' - write(11,'(a)')sq//'hfill'//sq// - * 'vbox{'//sq//'hsize='//shortfraq//'%' - write(11,'(a)')sq//'contpiece' - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - ishort = 4 - else if (ishort .eq. 4) then ! End coda - ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum - if (ntmp .le. 9) then - shortfraq(1:1) = char(48+ntmp) - lntmp = 1 - else - write(shortfraq(1:2),'(i2)')ntmp - lntmp = 2 - end if - write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq - * //'barno'//shortfraq(1:lntmp) - write(11,'(a)')sq//'contpiece' - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - ishort = 0 - mbrsum = 0 - nmbr = 0 - end if - else if (mtrnuml .ne. 0) then - -c -c New meter, no new sig, end of line, not new page. -c -c \generalmeter{\meterfrac{3}{4}}% -c \xchangecontext\addspace{-\afterruleskip}% -c \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% -c \zchangecontext -c - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - if (movbrk .eq. 0) then - if (islast) then - call wgmeter(mtrnmp,mtrdnp) - end if - if (mtrdnp .gt. 0) then - if (islast) then - write(11,'(a)') - * sq//'let'//sq//'bnat'//sq//'barnoadd' - * //sq//'def'//sq//'barnoadd{'//sq//'empty}%' - write(11,'(a)')sq//'xchangecontext'//sq// - * 'addspace{-'//sq//'afterruleskip}'//sq// - * 'zalaligne'//sq//'let'//sq//'barnoadd'//sq//'bnat' - call wgmeter(mtrnmp,mtrdnp) - write(11,'(a)')sq//'addspace{-'//sq// - * 'afterruleskip}'//sq//'zchangecontext' - end if - if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize - else - if (islast) write(11,'(a)')sq//'alaligne' - end if - else - if (islast) write(11,'(a)')sq//'alaligne' - end if - end if - end if -c -c Modified 090525 to use \bnrs -c - if (slint) then - slint = .false. - if (islast) write(11,'(a16,i1,a14)')sq//'def'//sq// - * 'raisebarno{',irzbnd,'.5'//sq//'internote}%' - end if - movbrk = 0 - end if -c -c Clean up if we squelched bar number reset at movement break -c - if (nobar1) then - if (islast) write(11,'(a)')sq//'startbarno1' - nobar1 = .false. - end if - read(12,*,end=14)iauto -14 continue -c -c We come thru here for the 1st bar of every system, so initialize is1n1 -c - is1n1 = 0 -c -c Brought down from above -c - if (isystpg .eq. nsystp(ipage)) then - isystpg = 0 -c -c The following is to avoid moving this reset of isystpg, but still send a signal -c down below for last system shortening events -c - if (ishort.eq.2) iflagbot = 1 - end if -c -c Check for linebreak ties -c - if (ispstie) - * call LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat, - * ispstie,sepsymq) - else -c -c Not first bar of system -c - if (btest(iplnow,28)) then -c -c Signature change -c - if (mtrnuml .ne. 0) then -c -c Meter+signature change mid line, assume no movement break -c - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - if (islast) call wgmeter(mtrnmp,mtrdnp) - notexq = sq//'generalsignature{' - lnote = 18 - if (isig .lt. 0) then - notexq = notexq(1:18)//'-' - lnote = 19 - end if - if (islast) then - iptemp = 48+abs(isig) - charq = chax(iptemp) - notexq = notexq(1:lnote)//charq//'}%' - lnote = lnote+3 - write(11,'(a)')notexq(1:lnote) - if (islast .and. LaterInstTrans) then - call Writesetsign(nInstTrans,iInstTrans,iTransKey, - * LaterInstTrans) - end if - if (ignorenats) write(11,'(a)')sq//'ignorenats%' - write(11,'(a)')sq//'xchangecontext%' - end if - if (ibar .eq. ibarmbr) then -c -c Compute space for multibar rest -c - if (lastisig*isig .ge. 0) then - naccs = max(abs(lastisig),abs(isig)) - else - naccs = abs(lastisig-isig) - end if -c xb4mbr = (facmtr+naccs*.24)*musicsize - xb4mbr = -.2*musicsize - end if - else -c -c Signature change only -c - notexq = sq//'xbar'//sq//'addspace{-'//sq// - * 'afterruleskip}'//sq//'generalsignature{' - lnote = 49 - if (isig .lt. 0) then - notexq = notexq(1:49)//'-' - lnote = 50 - end if - if (islast) - * write(11,'(a)')notexq(1:lnote)//chax(48+abs(isig))//'}%' - if (islast .and. LaterInstTrans) then - call Writesetsign(nInstTrans,iInstTrans,iTransKey, - * LaterInstTrans) - end if - if (islast .and. ignorenats) - * write(11,'(a)')sq//'ignorenats%' - if (islast) write(11,'(a)')sq//'zchangecontext'//sq - * //'addspace{-.5'// sq//'afterruleskip}%' - if (ibar .eq. ibarmbr) then -c -c Compute space for multibar rest -c - if (lastisig*isig .ge. 0) then - naccs = max(abs(lastisig),abs(isig)) - else - naccs = abs(lastisig-isig) - end if -c xb4mbr = naccs*.24*musicsize - xb4mbr = -.2*musicsize - end if - end if - else if (ishort .eq. 3) then -c -c Gap before coda, assumed no signature change! -c - ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum - if (ntmp .le. 9) then - shortfraq(1:1) = char(48+ntmp) - lntmp = 1 - else - write(shortfraq(1:2),'(i2)')ntmp - lntmp = 2 - end if - write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq - * //'barno'//shortfraq(1:lntmp) - if (nocodabn) then - write(11,'(a)')sq//'nobarno' - nocodabn = .false. - end if - write(shortfraq,'(f3.2)')codafrac - write(11,'(a)')sq//'hfill'//sq// - * 'vbox{'//sq//'hsize='//shortfraq//sq//'hsize%' - write(11,'(a)')sq//'contpiece' - write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' - * //sq//'makeatother' - ishort = 4 - else if (mtrnuml .eq. 0) then -c -c No meter change -c - if (islast) write(11,'(a)')sq//'xbar' - else -c -c Change meter midline -c - call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) - if (movbrk .eq. 0) then - if (islast) then - call wgmeter(mtrnmp,mtrdnp) - end if - if (mtrdnp .gt. 0) then - if (islast) then - write(11,'(a,2i1,a)')sq//'newtimes0%' - end if -c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize - if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize - else - if (islast) write(11,'(a)')sq//'xbar' - end if - end if - end if - end if -c -c Now that xbar's are written, can put in left-repeats at line beginnings -c - if (lrptpend) then - if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1' - * //sq//'leftrepeat' - lrptpend = .false. - end if - if (ibar .gt. 1) then -c -c For bars after first, slide all stuff down to beginning of arrays -c - do 11 iv = 1 , nv - do 11 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - ioff = nib(ivx,ibar-1) - do 12 ip = 1 , nib(ivx,ibar)-ioff - nolev(ivx,ip) = nolev(ivx,ip+ioff) - nodur(ivx,ip) = nodur(ivx,ip+ioff) - nacc(ivx,ip) = nacc(ivx,ip+ioff) - irest(ivx,ip) = irest(ivx,ip+ioff) - islur(ivx,ip) = islur(ivx,ip+ioff) - ipl(ivx,ip) = ipl(ivx,ip+ioff) - iornq(ivx,ip) = iornq(ivx,ip+ioff) - mult(ivx,ip) = mult(ivx,ip+ioff) - if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then - if (ivx.eq.1) then - isfig(1,ip) = isfig(1,ip+ioff) - else - isfig(2,ip) = isfig(2,ip+ioff) - end if - end if -12 continue - if (ivx.le.nv .and. ncc(iv).gt.1) then - islide = 0 - do 13 icc = 1 , ncc(iv) - if (tcc(iv,icc) .le. lenbar) then -c -c This time will drop <=0 when slid. -c - islide = icc-1 - ncmidcc(iv,1) = ncmidcc(iv,icc) - else - tcc(iv,icc-islide) = tcc(iv,icc)-lenbar - ncmidcc(iv,icc-islide) = ncmidcc(iv,icc) - end if -13 continue - ncc(iv) = ncc(iv)-islide - tcc(iv,1) = 0. - end if -11 continue - do 15 ig = 1 , ngrace - ipg(ig) = ipg(ig)-nib(ivg(ig),ibar-1) - if (ibar .gt. 2) ipg(ig) = ipg(ig)+nib(ivg(ig),ibar-2) -15 continue - do 21 il = 1 , nlit - iplit(il) = iplit(il)-nib(ivlit(il),ibar-1) - if (ibar .gt. 2) iplit(il) = iplit(il)+nib(ivlit(il),ibar-2) -21 continue - do 22 it = 1 , ntrill - iptrill(it) = iptrill(it)-nib(ivtrill(it),ibar-1) - if (ibar .gt. 2) iptrill(it) = - * iptrill(it)+nib(ivtrill(it),ibar-2) -22 continue - do 27 icrd = 1 , ncrd - ivx = iand(15,ishft(icrdat(icrd),-8)) - * +16*igetbits(icrdat(icrd),1,28) - ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1) - if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) - icrdat(icrd) = iand(not(255),icrdat(icrd)) - icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd)) -27 continue - do 29 iudorn = 1 , nudorn - ivx = ivxudorn(iudorn) - ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1) - if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) - kudorn(iudorn) = iand(not(255),kudorn(iudorn)) - kudorn(iudorn) = ior(max(0,ipnew),kudorn(iudorn)) -29 continue - do 42 idyn = 1 , ndyn - idynd = idyndat(idyn) - ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10) - ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) -c -c The following construction avoids array bound errors in some compilers -c - if (ibar .gt. 2) then - ipnew = ipnew+nib(ivx,ibar-2) - end if - ipnew = dim(ipnew,0) - call setbits(idynd,8,4,ipnew) - idyndat(idyn) = idynd -42 continue - do 43 itxtdyn = 1 , ntxtdyn - idynd = ivxiptxt(itxtdyn) - ivx = iand(31,idynd) - ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1) - if (ibar .gt. 2) then - ipnew = ipnew+nib(ivx,ibar-2) - end if - ipnew = dim(ipnew,0) -c call setbits(idynd,8,4,ipnew) - call setbits(idynd,8,5,ipnew) - ivxiptxt(itxtdyn) = idynd -43 continue - do 41 isdat = 1 , nsdat - isdata = isdat1(isdat) - ivx = ivmx(igetbits(isdata,5,13),igetbits(isdata,1,12)+1) - ipnew = igetbits(isdata,8,3)-nib(ivx,ibar-1) - if (ibar .gt. 2) then - ipnew = ipnew+nib(ivx,ibar-2) - end if - ipnew = dim(ipnew,0) - call setbits(isdata,8,3,ipnew) - isdat1(isdat) = isdata -41 continue - do 44 ibc = 1 , nbc - ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) - ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1) - if (ibar .gt. 2) then - ipnew = ipnew+nib(ivx,ibar-2) - end if - ipnew = dim(ipnew,0) - call setbits(ibcdata(ibc),8,4,ipnew) -44 continue - do 45 iarps = 1 , NumArpShift - IpArpShift(iarps) = - * IpArpShift(iarps)-nib(IvArpShift(iarps),ibar-1) - if (ibar .gt. 2) then - IpArpShift(iarps) = - * IpArpShift(iarps)+nib(IvArpShift(iarps),ibar-2) - end if -45 continue -c -c Bookkeeping for figures. This will set nfigs = 0 if there are no figs left. -c If there are figs left, it will reset all times relative to start of -c current bar. -c - do 46 ivx = 1 , 2 - if (figbass) then - islide = 0 - do 20 jfig = 1 , nfigs(ivx) - if (itfig(ivx,jfig) .lt. lenbar) then -c -c This figure was already used -c - islide = jfig - else - itfig(ivx,jfig-islide) = itfig(ivx,jfig)-lenbar - figq(ivx,jfig-islide) = figq(ivx,jfig) - itoff(ivx,jfig-islide) = itoff(ivx,jfig) - ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig) - ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig) - end if -20 continue - nfigs(ivx) = nfigs(ivx)-islide - end if - if (nfigs(2) .eq. 0) go to 47 -46 continue -47 continue - end if -c -c End of sliding down for bars after first in gulp. -c -c The following may not be needed by makeabar, but just in case... -c - if (firstgulp .and. lenb0.ne.0) then - if (ibar .eq. 1) then - lenbar = lenb0 - else - lenbar = lenb1 - end if - end if -c -c Equal line spacing stuff -c - if (equalize .and. bar1syst) then - if (isystpg .eq. 1) then - write(11,'(a)')sq//'starteq%' - else if (isystpg .eq. nsystp(ipage)-1) then - write(11,'(a)')sq//'endeq%' - end if - end if - call make1bar(ibmrep,tglp1,tstart,cwrest,squez, - * istop,numbms,istart) - call make2bar(ninow,tglp1,tstart,cwrest,squez, - * istop,numbms,istart,clefq) -c -c Hardspace before barline? -c - hardb4 = 0. - do 35 iv = 1 , nv - do 35 kv = 1 , nvmx(iv) - ivx = ivmx(iv,kv) - if (btest(irest(ivx,nn(ivx)),18)) then - nudoff(ivx) = nudoff(ivx)+1 - hardb4 = max(hardb4,udoff(ivx,nudoff(ivx))) - end if -35 continue - if (hardb4 .gt. 0.) then - if (islast) write(11,'(a11,f5.1,a4)')sq - * //'hardspace{',hardb4,'pt}%' -c -c This was causing an incorrect poe in an example, which did not affect main -c spacing, but did cause an extra accidental space to be too small -c - fixednew = fixednew-hardb4 - end if -10 continue - firstgulp = .false. - lenb0 = 0 - go to 30 -40 close(12) - close(13) - ilbuf = 1 - ipbuf = 0 - wdpt = widthpt - if (iline .eq. 1) wdpt = widthpt*(1-fracindent) - poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/ - * (elsktot+fbar*nbarss-scaldold) - poevec(nsyst) = poe - if (.not.islast) then - close(11) - close(16) - if (figbass) close(14) - return - end if - do 19 ia = 1 , nasksys - iask = iask+1 - ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))/poefa(iline) - if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.) -19 continue - do 26 ia = 1 , nhssys - nhstot = nhstot+1 - hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.) -26 continue - if (islast .and. - * onvolt) write(11,'(a)')sq//'endvoltabox' - rendq = '% ' - if (ishort .ne. 0) rendq = '}}%' - if (rptfq2 .ne. 'E') then -c -c Terminal repeat. Right or double? -c - if (rptfq2 .eq. 'r') then - if (islast) write(11,'(a)')sq//'setrightrepeat' - * //sq//'endpiece'//rendq - else if (rptfq2 .eq. 'd') then - if (islast) write(11,'(a)')sq//'setdoublebar'//sq//'endpiece' - * //rendq - else if (rptfq2 .eq. 'b') then - if (islast) write(11,'(a)')sq//'endpiece'//rendq - else if (rptfq2 .eq. 'z') then - if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece' - * //rendq - else - print* - print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 - write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 - if (islast) write(11,'(a)')sq//'Endpiece' - end if - else - write(11,'(a)')sq//'Endpiece'//rendq - end if - if (.not.vshrink) then - if (islast .and. bottopgap) then - if (abs(botamt) .gt. 1.e-6) then - if (botamt .gt. 9.95) then - fmtq = '(a,f4.1,a)' - else if (botamt .gt. 0.) then - fmtq = '(a,f3.1,a)' - else if (botamt .gt. -9.95) then - fmtq = '(a,f4.1,a)' - else - fmtq = '(a,f5.1,a)' - end if - write(11,fmtq)sq//'null'//sq//'vskip',botamt, - * sq//'Internote%' - end if - end if - xnstbot = xnsttop(ipage)*etabot/etatop - if (xnstbot .lt. 9.95) then - fmtq = '(a,f3.1,a)' - else - fmtq = '(a,f4.1,a)' - end if - if (islast) write(11,fmtq)sq//'vskip',xnstbot, - * sq//'Interligne'//sq//'eject'//sq//'endmuflex' - if (islast) write(11,'(a)')sq//'bye' - else - if (islast) write(11,'(a)') - * sq//'vfill'//sq//'eject'//sq//'endmuflex' - if (islast) write(11,'(a)')sq//'bye' - end if - rewind(11) - if (figbass) then - write(14,'(a9,i2,a10,i2,1x,a5)') - * sq//'figdrop=',ifigdr(1,iline), - * ' '//sq//'figdtwo=',ifigdr(2,iline),sq//'fi}%' - rewind(14) - end if - call askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0) - if (.not.optimize) then - print* - print*,'Writing ' - * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex' - print*,'Done with second PMX pass.' - write(15,'(/,a)')'Writing ' - * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex' - write(15,'(a)')' Done with second PMX pass. Now run TeX' - end if - return - end - subroutine poestats(nsyst,poe,poebar,devnorm) - parameter (nks=125) -c -c Compute avg. & norm. std. dev. of poe. -c - real*4 poe(nks) - sumx = 0. - sumxx = 0. - do 1 isyst = 1 , nsyst - sumx = sumx+poe(isyst) - sumxx = sumxx+poe(isyst)**2 -1 continue - devnorm = sqrt(nsyst*sumxx/sumx**2-1) - poebar = sumx/nsyst - return - end - subroutine precrd(ivx,ip,nolevm,nacc,ipl,irest,udq, - * twooftwo,icashft) -c -c Analyzes chords, data to be used with slurs on chords and plain chords. -c Check for 2nds, shift notes if neccesary. -c ipl(10) chord present -c irest(20) set if any note is right shifted -c irest(27) set if any note is left shifted -c ipl(8|9) left|right shift main note -c icrdat(23|24) ditto chord note -c udq is updown-ness, needed to analyze 2nds. -c levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. -c icrdot(icrd)(27-29) sequence order of chord note if accid, top down -c - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - logical btest,is2nd,twooftwo - integer*4 kicrd(10),levtabl(88) - character*1 udq - do 11 i = 1 , 88 - levtabl(i) = 0 -11 continue - do 1 icrd1 = 1 , ncrd - ivx1 = iand(15,ishft(icrdat(icrd1),-8)) - * +16*igetbits(icrdat(icrd1),1,28) - ip1 = iand(255,icrdat(icrd1)) - if (ip1.eq.ip .and. ivx1.eq.ivx) go to 2 -1 continue - print* - print*, - * 'Cannot find first chord note in precrd. Send source to Dr. Don!' - call stop1() -2 continue - maxlev = nolevm - minlev = nolevm - levtabl(nolevm) = -1 - is2nd = .false. - naccid = 0 - levmaxacc = -100 - levminacc = 1000 -c -c Check 1st 3 bits of nacc for accid on main note of chord. -c - if (iand(7,nacc) .gt. 0) then - naccid = 1 -c -c Start list of notes with accid's. There will be naccid of them. kicrd=0 if main, -c otherwise icrd value for note with accidental. -c - kicrd(1) = 0 - levmaxacc = nolevm - levminacc = nolevm -c -c Start the level-ranking -c - icrdot0 = 1 - end if - do 3 icrd2 = icrd1 , ncrd - nolev = igetbits(icrdat(icrd2),7,12) - levtabl(nolev) = icrd2 - maxlev = max(maxlev,nolev) - minlev = min(minlev,nolev) -c -c Check for accidental -c - if (btest(icrdat(icrd2),19)) then - naccid = naccid+1 - levmaxacc = max(levmaxacc,nolev) - levminacc = min(levminacc,nolev) -c -c Add this icrd to list of values for notes with accid's. -c - kicrd(naccid) = icrd2 - if (.not.btest(nacc,28)) then -c -c Order not forced, so get the level-ranking, top down -c - iorder = 1 - do 12 iaccid = 1 , naccid-1 - if (kicrd(iaccid) .eq. 0) then - if (nolevm .gt. nolev) then - iorder = iorder+1 - else - icrdot0 = icrdot0+1 - end if - else - if (igetbits(icrdat(kicrd(iaccid)),7,12) - * .gt. nolev) then - iorder = iorder+1 - else - iold = igetbits(icrdot(kicrd(iaccid)),3,27) - call setbits(icrdot(kicrd(iaccid)),3,27,iold+1) - end if - end if -12 continue - call setbits(icrdot(icrd2),3,27,iorder) - end if - end if -c -c Exit loop if last note in this chord -c - if (icrd2 .eq. ncrd) go to 4 - if (igetbits(icrdat(icrd2+1),8,0) .ne. ip .or. -c * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 - * igetbits(icrdat(icrd2+1),4,8) - * +16*igetbits(icrdat(icrd2+1),1,28) .ne. ivx) go to 4 -3 continue - print* - print*,'Failed to find last chord note. Send source to Dr. Don!' - call stop1() -4 continue -c -c Now icrd1, icrd2 define range of icrd for this chord. -c -c Bypass autos-shifting if any manual shifts are present -c - if (btest(irest,20) .or. btest(irest,27)) go to 10 -c -c Check for 2nds -c - do 5 ilev = 1 , 87 - if (levtabl(ilev).ne.0 .and. levtabl(ilev+1).ne.0) then -c -c There is at least one 2nd.. -c - if (udq .eq. 'u') then -c -c Upstem. Start with 2nd just found and go up, rt-shifting upper -c member of each pair -c - ile = ilev -c -c Set main-note flag for ANY right-shift -c - irest = ibset(irest,20) -7 continue - if (levtabl(ile+1) .lt. 0) then -c -c Upstem, & upper member is main so must be rt-shifted. This would move -c stem too, so we rt-shift the OTHER note, and set flag that signals -c to interchange pitches just when these two notes are placed. -c - nacc = ibset(nacc,30) - icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),24) - else -c -c Upper member is chord note, must be rt-shifted -c - icrdat(levtabl(ile+1)) = ibset(icrdat(levtabl(ile+1)),24) - end if - ile = ile+1 -8 continue - ile = ile+1 - if (ile .lt. 87) then - if (levtabl(ile).ne.0 .and. levtabl(ile+1).ne.0) then - go to 7 - else - go to 8 - end if - end if - go to 10 - else -c -c Downstem. Start at top and work down, left-shifting lower member of each pair. -c We know that lowest pair is at (ilev,ilev+1). -c - ile = 88 -c -c Set main-note flag for ANY right-shift -c - irest = ibset(irest,27) -9 continue - if (levtabl(ile).ne.0 .and. levtabl(ile-1).ne.0) then - if (levtabl(ile-1) .lt. 0) then -c ipl = ibset(ipl,8) -c -c Dnstem, & lower member is main so must be left-shifted. This would move -c stem too, so we left-shift the OTHER note, and set flag that signals -c to interchange pitches just when these two notes are placed. -c - nacc = ibset(nacc,31) - icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),23) - else -c -c Lower member is chord note, must be shifted -c - icrdat(levtabl(ile-1)) = - * ibset(icrdat(levtabl(ile-1)),23) - end if - ile = ile-1 - end if - ile = ile-1 - if (ile .ge. ilev+1) go to 9 - go to 10 - end if - end if -5 continue -10 continue -c -c Done with 2nds, now do accid's. Call even if just one, in case left shifts. -c -c if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, - if (naccid .ge. 1) call crdaccs(nacc,ipl,irest,naccid, - * kicrd,nolevm,levmaxacc,levminacc,icrdot0,twooftwo,icashft) - return - end - subroutine printl(string) - character*(*) string -c -c Send string to console and to log file -c - print*,string - write(15,'(a)')string - return - end - subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) - parameter (nm=24) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comtol/ tol - common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), - * ArpShift(20) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - logical lowdot,IsArpShift - character*80 soutq - character*79 notexq - character*8 symq(2) - character*1 chax - data symq /'raisearp','arpeggio'/ -c -c NOTE iv in arg list is really ivx, referring to voice rather than staff. -c -c Find which iarp, if any -c - do 1 iarp = 1 , narp - if (abs(tnow-tar(iarp)).lt.tol) go to 2 -1 continue -c -c If here, this is the *first* call for this arp. -c - narp = narp+1 - tar(narp) = tnow+tol*.5 - ivar1(narp) = iv - ipar1(narp) = ip - levar1(narp) = nolev - ncmar1(narp) = ncm - return -2 continue -c -c If here, this is *second* call at this time, narp points to values from 1st. -c -c Check for shift. Set IsArpShift and iarps -c - do 3 iarps = 1 , NumArpShift - if (IvArpShift(iarps) .eq. ivar1(iarp) .and. - * IpArpShift(iarps) .eq. ipar1(iarp)) then - IsArpShift = .true. - notexq = chax(92)//'loffset{' - write(notexq(10:14),'(f3.1,a2)') Arpshift(iarps),'}{' - lnote = 14 - go to 4 - end if -3 continue - IsArpShift = .false. - lnote = 0 -4 continue - if (iv .eq. ivar1(iarp)) then -c -c Arp is in a single voice. -c - levbot = min(levar1(iarp),nolev)-ncm+3 - invert = abs(levar1(iarp)-nolev)+1 - else -c -c Arp covers >1 voice. Lower voice has to be the first, upper is current and -c is where the symbol will be written. -c Check whether ivx's ivar1(iarp) & iv are in same staff -c - do 5 iiv = 1 , nm - if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and. - * ivmx(iiv,2).eq.ivar1(iarp))) then - iivivx1 = iiv - go to 6 - end if -5 continue - print*,'Screwup#1 in putarp' - stop -6 continue - do 7 iiv = 1 , nm - if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and. - * ivmx(iiv,2).eq.iv)) go to 8 -c -c Found iv for both voices (iivivx1, iiv), done looking -c -7 continue - print*,'Screwup#2 in putarp' - stop -8 continue - if (iivivx1 .eq. iiv) then - nstaffshift = 0 - else - nstaffshift = -nint(2*xinsnow) - end if -c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) - levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) - invert = -levbot+4+nolev-ncm - end if -c -c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote -c - isym = mod(invert,2)+1 - ilvert = (invert+1)/2 - if (levbot .ge. 0 .and. levbot .le. 9) then -c -c Single digit -c - if (.not.IsArpShift) then - notexq = chax(92)//symq(isym)//chax(48+levbot) - else - notexq = notexq(1:lnote)// - * chax(92)//symq(isym)//chax(48+levbot) - end if - lnote = lnote+10 - else - if (.not.IsArpShift) then - notexq = chax(92)//symq(isym)//'{' - else - notexq = notexq(1:lnote)//chax(92)//symq(isym)//'{' - end if - lnote = lnote+10 - if (levbot .ge. -9) then -c -c Need two spaces for number -c - write(notexq(lnote+1:lnote+3),'(i2,a1)')levbot,'}' - lnote = lnote+3 - else - write(notexq(lnote+1:lnote+4),'(i3,a1)')levbot,'}' - lnote = lnote+4 - end if - end if -c if (ilvert .le. 9) then -c call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, -c * soutq,lsout) -c else -c write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' -c call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) -c end if - - if (ilvert .gt. 9) then - write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//chax(48+ilvert) - lnote = lnote+1 - end if - if (IsArpShift) then - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - end if - call addstr(notexq(1:lnote),lnote,soutq,lsout) -c -c cancel out the stored time, to permit two arps at same time! -c - tar(iarp) = -1. - return - end - subroutine putast(elask,indxask,outq) - character*129 outq,tag - character*9 fmtq - if (elask .ge. 0.) then - if (elask.lt.0.995) then - lp = 3 - else if (elask .lt. 9.995) then - lp = 4 - else - lp = 5 - end if - write(fmtq,'(a5,i1,a3)')'(a2,f',lp,'.2)' - else - lp = 5 - fmtq = '(a2,f5.1)' - end if -c -c Overwrite as follows: ...xyz*ask *lmnop... -> -c ...xyz*ast{.nn}*lmnop... -c ...xyz*ast{n.nn}*lmnop... -c ...xyz*ast{nn.nn}*lmnop... -c or for negative, ...xyz*ast{-nn.n}*lmnop... - tag = outq(indxask+9:) - write(outq(indxask+3:),fmtq)'t{',elask - outq = outq(1:indxask+4+lp)//'}'//tag - return - end - subroutine putcb(ivx,ip,notexq,lnote) - common /comcb/ nbc,ibcdata(36) - character*79 notexq - logical btest -c ivxip = ivx+16*ip - do 1 ibc = 1 , nbc -c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 -c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) -c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 - ivxbc = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) - ipbc = igetbits(ibcdata(ibc),8,4) - if (ivx .eq. ivxbc .and. ip .eq.ipbc) go to 2 -1 continue - call printl('Error in putbc, Call Dr. Don') - stop -2 continue - if (btest(ibcdata(ibc),27)) then - lnote = 8 - notexq = char(92)//'pbreath' - else - lnote = 9 - notexq = char(92)//'pcaesura' - end if - ivshft = igetbits(ibcdata(ibc),6,13) -c?? ivshft = igetbits(ibcdata(ibc),6,13)-32 - if (ivshft .gt. 0) ivshft = ivshft-32 - if (ivshft.lt.0 .or. ivshft.gt.9) then - notexq = notexq(1:lnote)//'{' - lnote = lnote+1 - if (ivshft .lt. -9) then - write(notexq(lnote+1:lnote+3),'(i3)')ivshft - lnote = lnote+3 - else - write(notexq(lnote+1:lnote+2),'(i2)')ivshft - lnote = lnote+2 - end if - notexq = notexq(1:lnote)//'}' - lnote = lnote+1 - else - notexq = notexq(1:lnote)//char(48+ivshft) - lnote = lnote+1 - end if - ihshft = igetbits(ibcdata(ibc),8,19) - if (ihshft .eq. 0) then - notexq = notexq(1:lnote)//'0' - lnote = lnote+1 - else - hshft = .1*(ihshft-128) -c -c -12.81 ornament on a note, next line is top of manual loop. -c -2 continue -c -cc Bit # of last ornament (last of bits 0-21) -cc Bit # of last ornament (last of bits 0-24) -c Bit # of last ornament (last of bits 0-24,29-30) - if (btest(iornq,29)) then - ibit = 29 - else if (btest(iornq,30)) then - ibit = 30 - else - ibit = log2(iand(iornq,4194303)) -c ibit = log2(iand(iornq,33554431)) - end if - iornt = 2**ibit -c -c Begin routine to set height. Bits 0-13: (stmgx+Tupf._) -c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n -c 19-20: >^, 21: ? (with or w/o 16-18) -c and 29-30: C (coda), G (new segno) -c -c Do not use beam height for . or _ -c - if (btest(iornq,22) .and. iand(iornt,6144).eq.0) then -c -c Height is set by special beam stuff. -c Do not leave ihorn set, do separately for every ornament -c - ihorn = ihornb(ivx,nornb(ivx)) - if (ulpzq .eq. 'u') ihorn = ihorn-2 -c -c Following flag tells whether to increment nornb when exiting the subroutine. -c - usehornb = .true. - else if (ibit .eq. 14) then -c -c Down fermata. Don't worry about upper chord notes. -c - if (ulpzq .eq. 'l') then - ihorn = min(nolev,ncm-3) - else - ihorn = min(nolev-stemlen,ncm-3.) - end if - else if (btest(iornt,13) .or. btest(iornt,0)) then -c -c ( or ) -c - ihorn = nolev - else if (iand(iornt,6144) .gt. 0) then -c -cc Staccato . or tenuto _ , but not special beam stuff. Need up-down info -c NOTE: removed .&_ from special beam treatment. -c Staccato . or tenuto _ Need up-down info -c - if (.not.iscrd .or. (maxlev.ne.nolev.and.ulpzq.eq.'l') .or. - * (minlev.ne.nolev.and.ulpzq.eq.'u')) then - ihorn = nolev - else if (maxlev .eq. nolev) then - ulpzq = 'u' - ihorn = max(nolev+stemlen,ncm+3.) - else - ulpzq = 'l' - ihorn = min(nolev-stemlen,ncm-3.) - end if - else if (iscrd .and. nolev .eq. minlev) then - if (ulpzq .eq. 'l') then - ihorn = min(nolev-3,ncm-6) - else - ihorn = min(nolev-nint(stemlen)-3,ncm-6) - end if - else if (ibit.eq.10 .and. nolev.gt.90) then -c -c Special treatment for fermata on a shifted rest -c - ihorn = ncm+5 - else if (ulpzq.eq.'l') then -c -c (iscrd and nolev=maxlev) or (.not.iscrd) -c - ihorn = max(nolev+stemlen+2,ncm+5.) - else if (ibit.eq.29 .or. ibit.eq.30) then -c -c coda or new segno, no height tweak -c - ihorn = ncm+5 - else - ihorn = max(nolev+2,ncm+5) - end if - ioff = 0 - iclracc = 0 -c -c Begin routine to set name. Bits 0-13: (stmgx+Tupf._) -c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n -c - if (btest(iornt,2)) then - notexq = sq//'shake' - lnote = 6 - else if (btest(iornt,3)) then - notexq = sq//'mordent' - lnote = 8 - else if (btest(iornt,1)) then - notexq = sq//'mtr' - lnote = 4 - else if (btest(iornt,5)) then - notexq = sq//'xtr' - lnote = 4 - else if (btest(iornt,6)) then - notexq = sq//'ptr' - lnote = 4 - else if (btest(iornt,13)) then - notexq = sq//'rpn' - lnote = 4 - else if (btest(iornt,0)) then - notexq = sq//'lpn' - lnote = 4 - else if (btest(iornt,12)) then - notexq = sq//ulpzq//'st' - lnote = 4 - else if (btest(iornt,11)) then - notexq = sq//ulpzq//'pz' - lnote = 4 - else if (btest(iornt,8)) then - notexq = sq//'upz' - lnote = 4 - ioff = -2 - else if (btest(iornt,9)) then - notexq = sq//'uppz' - lnote = 5 - ioff = -2 - else if (btest(iornt,10)) then - if (nodur .lt. 48) then - notexq = sq//'fermataup' - else - notexq = sq//'Fermataup' - end if - lnote = 10 - ioff = -2 - else if (btest(iornt,14)) then - if (nodur .lt. 48) then - notexq = sq//'fermatadown' - else - notexq = sq//'Fermatadown' - end if - lnote = 12 - else if (btest(iornt,21)) then -c -c "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 -c - if (btest(iornq,16)) then - notexq = sq//'qsharp' - lnote = 7 - ioff = 2 - iornq = ibclr(iornq,16) - iclracc = 16 - else if (btest(iornq,17)) then - notexq = sq//'qflat' - lnote = 6 - ioff = 1 - iornq = ibclr(iornq,17) - iclracc = 17 - else if (btest(iornq,18)) then - notexq = sq//'qnat' - lnote = 5 - ioff = 2 - iornq = ibclr(iornq,18) - iclracc = 18 - else - notexq = sq//'qedit' - lnote = 6 - ioff = 0 - end if - else if (btest(iornt,16)) then - notexq = sq//'esharp' - lnote = 7 - ioff = 2 - else if (btest(iornt,17)) then - notexq = sq//'eflat' - lnote = 6 - ioff = 1 - else if (btest(iornt,18)) then - notexq = sq//'enat' - lnote = 5 - ioff = 2 - else if (btest(iornt,19)) then - notexq = sq//'usf' - lnote = 4 - ioff = -2 - else if (btest(iornt,20)) then - notexq = sq//'usfz' - lnote = 5 - ioff = -2 - else if (btest(iornt,29)) then - notexq = sq//'ccoda' - lnote = 6 - else if (btest(iornt,30)) then - notexq = sq//'ssegno' - lnote = 7 - end if - iudorn = 0 -c -c User-defined level shift of ornament from default? -c - if (btest(iornq,25)) then -c -c Find which (if any) element of kudorn has the shift. -c - do 3 iudorn = 1 , nudorn -c if (ibit .lt. 21) then -c if (ibit.lt.21 .or. ibit.eq.29) then - if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then - ibitt = ibit -c -c Could have oes, but not oe? or oes? -c - else if (iclracc .gt. 0) then -c -c Earlier cleared edit. accid, meaning it was oes? -c - ibitt = iclracc+6 - else - ibitt = 21 - end if - ibitt=ip+ishft(mod(ivx,16),8)+ishft(nolev,12)+ishft(ibitt,19) -c if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 - if (ibitt .eq. iand(33554431,kudorn(iudorn)) - * .and. ivx.eq.ivxudorn(iudorn)) go to 4 -3 continue -c -c Nothing shifted on this note; exit this if block -c - iudorn = 0 - go to 5 -4 continue - ioffinc = iand(63,ishft(kudorn(iudorn),-25))-32 - if (ibit.eq.19 .and. ioffinc .lt. -7) then -c -c Convert usf to lsf. The reason has to do with positioning being impossile -c for some mysterious reason when you drop \usf below the staff -c - notexq = sq//'lsf' - ioffinc = ioffinc+6 - end if - ioff = ioff+ioffinc - end if -5 continue -c -c Shift level to avoid slur. Conditions are -c 1. There is a slur -c 2. No user-defined orn height shift (btest(iornq,25)) -c 3. upslur (islhgt>0) -c 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 -c 5. islhgt+3 >= height already computed. -c - if (.not.btest(iornq,25) .and. - * islhgt.gt.0 .and. iand(iornt,30737).eq.0) - * ioff = ioff+dim(islhgt+3,ihorn ) - call notefq(noteq,lnoten,ihorn+ioff,ncm) - if (lnoten.eq.1) call addblank(noteq,lnoten) - if (iand(iornt,32896) .gt. 0) then -c -c T-trill or trill w/o "tr" -c - call dotrill(ivx,ip,iornt,noteq,lnoten,notexq,lnote) - else - notexq = notexq(1:lnote)//noteq(1:lnoten) - lnote = lnote+lnoten - end if - if (iudorn .gt. 0) then - if (btest(kudorn(iudorn),31)) then -c -c Horizontal shift -c - lform = lfmt1(ornhshft(iudorn)) - write(noteq(1:lform),'(f'//chax(48+lform)//'.1)') - * ornhshft(iudorn) - notexq = sq//'roffset{'//noteq(1:lform)//'}{' - * //notexq(1:lnote)//'}' - lnote = lnote+lform+12 - ornhshft(iudorn) = 0. - kudorn(iudorn) = ibclr(kudorn(iudorn),31) - end if - end if -c -c Zero out the bit for ornament just dealt with. -c - iornq = ibclr(iornq,ibit) - if (lout .eq. 0) then - outq = notexq(1:lnote) - else - outq = outq(1:lout)//notexq(1:lnote) - end if - lout = lout+lnote -c -c Check bits 0-21, go back if any are still set -c If bit 29 or 30 had been set, would have been used first time thru, -c and you wouldn't use both coda and segno on same note -c - if (iand(iornq,4194303) .gt. 0) go to 2 - if (usehornb) nornb(ivx) = nornb(ivx)+1 - return - end - subroutine putshft(ivx,onoff,soutq,lsout) - parameter (nm=24) - common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) - character*80 soutq,notexq - character*1 sq,chax - logical onoff - sq = chax(92) -c -c Start user-defined offsets X(...): or X(...)S -c - if (onoff) nudoff(ivx) = nudoff(ivx)+1 -c -c Xoff is in pts. Round off to nearest .1. Will use at end of shift. -c - xoff = udoff(ivx,nudoff(ivx)) - xoff = sign(int(10.*abs(xoff)+.5)/10.,xoff) - if (.not.onoff) xoff = -xoff - if (xoff .lt. -9.95) then - ifmt = 5 - else if (xoff.lt.-.95 .or. xoff.gt.9.95) then - ifmt = 4 - else - ifmt = 3 - end if - write(notexq,'(f'//chax(48+ifmt)//'.1)')xoff - call addstr(sq//'off{'//notexq(1:ifmt)//'pt}',8+ifmt, - * soutq,lsout) - return - end - subroutine puttitle(inhnoh,xnsttop,etatop,sq,etait,etatc, - * etacs1,nv,vshrink,sepsymq) -c -c Called once per page, at top of page! If vshrink, only called for p.1. -c Actual titles only allowed on p.1. (set by headlog). -c 3/18/01: The above comment is probably bogus...can use Tt on later pages. -c - common /comlast/ islast,usevshrink - logical islast,usevshrink - common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, - * inhead - common /cominbot/ inbothd - character*127 notexq - character*120 instrq,titleq,compoq - parameter (nm=24) - character*1 sq,sepsymq(nm),chax - logical headlog,vshrink - notexq = sq//'znotes' - lenline = 7 - do 22 iv = 1 , nv-1 - notexq = notexq(1:lenline)//sepsymq(iv) - lenline = lenline+1 -22 continue - notexq = notexq(1:lenline)//sq//'zcharnote{' - lenline = lenline+11 - if (.not.headlog) then - inhead = inhnoh - end if - if (vshrink .and. usevshrink) then - inhead = 16 - end if - ndig = int(alog10(inhead+.01))+1 - write(notexq(lenline+1:lenline+ndig+10),'(i'//chax(48+ndig)// - * ',a10)')inhead,'}{'//sq//'titles{' - lenline = lenline+ndig+10 -c -c Vertical skip at top of page (\Il) = etatop*glueil. Needed whether -c headers are present or not. -c - glueil = xnsttop/etatop - vskil = etatop*glueil - if (vshrink .and. usevshrink) vskil = 2 - call writflot(vskil,notexq,lenline) - if (.not.headlog) then - if (islast) write(11,'(a)')notexq(1:lenline) - * //'}{}{0}{}{0}{}{0}}'//sq//'en%' - else - notexq = notexq(1:lenline)//'}{' - lenline = lenline+2 - lcq = lenstr(instrq,120) - if (lcq .gt. 0) then - xitil = etait*glueil - if (vshrink .and. usevshrink) xitil = 2 - notexq = notexq(1:lenline)//instrq(1:lcq)//'}{' -c -c Null out instrument once used -c - instrq = ' ' - lenline = lenline+lcq+2 - call writflot(xitil,notexq,lenline) - else - notexq = notexq(1:lenline)//'}{0' - lenline = lenline+3 - end if - if (islast) write(11,'(a)')notexq(1:lenline)//'}%' - notexq = '{' - lenline = 1 - lcq = lenstr(titleq,120) - if (lcq .gt. 0) then - notexq = notexq(1:lenline)//titleq(1:lcq) - lenline = lenline+lcq - else - call printl(' ') - call printl('WARNING') - call printl( - * ' In a title block, you have specified instrument and/or') - call printl( - * ' composer but no title for the piece.') - end if - notexq = notexq(1:lenline)//'}{' - lenline = lenline+2 - xtcil = etatc*glueil - lcq = lenstr(compoq,120) - if (lcq .eq. 0) xtcil = 2*xtcil - if (vshrink .and. usevshrink) xtcil = 2 - call writflot(xtcil,notexq,lenline) - notexq = notexq(1:lenline)//'}{' - lenline = lenline+2 - if (lcq .gt. 0) then - notexq = notexq(1:lenline)//compoq(1:lcq)//'}{' - lenline = lenline+2+lcq -c -c Null out compoq so it does not get written later -c - compoq = ' ' - xcsil = etacs1*glueil - if (vshrink .and. usevshrink) xcsil = 2 - call writflot(xcsil,notexq,lenline) - else - notexq = notexq(1:lenline)//'}{0' - lenline = lenline+3 - end if - if (islast) write(11,'(a)')notexq(1:lenline)//'}}'//sq//'en%' - headlog = .false. - end if - return - end - subroutine putxtn(ntupv,iflop,multb,iud,wheadpt,poenom, - * nolev1,islope,slfac,xnlmid,islur,lnote,notexq,ncmid,nlnum, -c * eloff,iup,irest,usexnumt) - * eloff,iup,irest,mult,usexnumt) -c -c Places digit for xtuplet. -c - character*1 chax - character*8 noteq - character*79 notexq - logical btest,usexnumt - if (iflop.ne.0 .and. multb.gt.0) then -c -c Number goes on beam side, move R/L by .5 wheadpt for upper/lower -c - eloff = eloff-0.5*iud*wheadpt/poenom -c -c Number goes on beam side, must use beam parameters to set pos'n -c - nlnum = nolev1+islope/slfac*eloff+iup*(multb+8) - if (multb .ge. 2) nlnum = nlnum+iup - else - nlnum = nint(xnlmid-1+3*iud+iflop*11) - end if - if (.not.btest(islur,31)) then -c -c Only print number when wanted. First check vert, horiz offset -c - if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64 - if (btest(irest,7)) eloff = eloff+ - * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom - if (.not.usexnumt) then - notexq = chax(92)//'xnum{' - lnote = 10 - istrtn = 7 - else - notexq = chax(92)//'xnumt{' - lnote = 11 - istrtn = 8 - end if - if (eloff .lt. 0.995) then - write(notexq(istrtn:istrtn+3),'(i1,f3.2)')0,eloff - else if (eloff .lt. 9.995) then - write(notexq(istrtn:istrtn+3),'(f4.2)')eloff - else - write(notexq(istrtn:istrtn+4),'(f5.2)')eloff - lnote = lnote+1 - end if - call notefq(noteq,lnoten,nlnum,ncmid) - notexq = notexq(1:lnote)//'}'//noteq(1:lnoten) - lnote = lnote+1+lnoten - if (ntupv .lt. 10) then - write(notexq(lnote+1:lnote+1),'(i1)')ntupv - lnote = lnote+1 - else - notexq = notexq(1:lnote)//'{' - write(notexq(lnote+2:lnote+3),'(i2)')ntupv - notexq = notexq(1:lnote+3)//'}' - lnote = lnote+4 - end if - end if - return - end - subroutine read10(string,lastchar) - parameter (maxblks=9600) - character*131072 bufq - integer*2 lbuf(maxblks) - common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - character*(*) string - character*128 lnholdq - logical lastchar - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - logical mrecord,mplay,endmac - common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), - * ic1mac(20),ilmac,iplmac - if (.not.mplay) then - if (ilbuf .gt. nlbuf) go to 999 - call getbuf(string) - return -999 lastchar = .true. - return - else -c -c Play a macro. Set pointer to first character needed in buffer -c - if (ilmac .eq. il1mac(macnum)) then -c -c Getting first line of macro -c - ip1 = ip1mac(macnum) - iplmac = ip1-ic1mac(macnum) - else if (ilmac .le. il2mac(macnum)) then -c -c Beyond first line of macro. Advance line-start pointer. -c - iplmac = iplmac+lbuf(ilmac-1) - ip1 = iplmac+1 - else -c -c Beyond last line of macro. Terminate it! -c - mplay = .false. - endmac = .true. - return - end if - if (ilmac .eq. il2mac(macnum)) then -c -c Getting last line of macro. -c - ip2 = ip2mac(macnum) - else -c -c Getting line before last line of macro. -c - ip2 = iplmac+lbuf(ilmac) - end if - if (ip2 .ge. ip1) then - string = bufq(ip1:ip2) - else -c -c Kluge for when macro start is on a line by itself -c - string = ' ' - end if - ilmac = ilmac+1 - return - end if - end - function readin(lineq,iccount,nline) -c -c Reads a piece of setup data from file lineq, gets a new lineq from -c file 10 (jobname.pmx) and increments nline if needed, passes over -c comment lines -c - character*128 lineq - character*1 durq,chax -4 if (iccount .eq. 128) then -1 call getbuf(lineq) - nline = nline+1 - if (lineq(1:1) .eq. '%') go to 1 - iccount = 0 - end if - iccount = iccount+1 -c -c Find next non-blank or end of line -c - do 2 iccount = iccount , 127 - if (lineq(iccount:iccount) .ne. ' ') go to 3 -2 continue -c -c If here, need to get a new line -c - iccount = 128 - go to 4 -3 continue -c -c iccount now points to start of number to read -c - i1 = iccount -5 call getchar(lineq,iccount,durq) -c -c Remember that getchar increments iccount, then reads a character. -c - if (index('0123456789.-',durq) .gt. 0) go to 5 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - call stop1() - end if - icf = i2-i1+49 - read(lineq(i1:i2),'(f'//chax(icf)//'.0)')readin - return - end - subroutine readmeter(lineq,iccount,mtrnum,mtrden) - character*128 lineq - character*1 durq,chax - if (index(lineq(iccount+1:iccount+3),'/') .eq. 0) then -c -c No slashes, so use old method -c - call getchar(lineq,iccount,durq) - if (durq .eq. '-') then -c -c Negative numerator is used only to printed; signals vertical slash -c - call getchar(lineq,iccount,durq) - mtrnum = -(ichar(durq)-48) - else if (durq .eq. 'o') then -c -c Numerator is EXACTLY 1 -c - mtrnum = 1 - else - mtrnum = ichar(durq)-48 - if (mtrnum .eq. 1) then -c -c Numerator is >9 -c - call getchar(lineq,iccount,durq) - mtrnum = 10+ichar(durq)-48 - end if - end if - call getchar(lineq,iccount,durq) - if (durq .eq. 'o') then - mtrden = 1 - else - mtrden = ichar(durq)-48 - if (mtrden .eq. 1) then - call getchar(lineq,iccount,durq) - mtrden = 10+ichar(durq)-48 - end if - end if - else -c -c Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' -c - iccount = iccount+1 - ns = index(lineq(iccount:128),'/') - read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrnum -c -c Reset iccount to start of second integer -c - iccount = iccount+ns -c -c There must be either a slash or a blank at pos'n 2 or 3 -c - ns = index(lineq(iccount:iccount+2),'/') - if (ns .eq. 0) ns = index(lineq(iccount:iccount+2),' ') - read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrden -c -c Set iccount to last character used -c - iccount = iccount+ns-1 - end if - return - end - subroutine readnum(lineq,iccount,durq,fnum) -c -c This reads a number starting at position iccount. Remember that on exit, -c getchar leaves iccount at the last character retrieved. So must only -c call this routine *after* detecting a number or decimal. -c On exit, durq is next character after end of number. -c - character*128 lineq - character*1 durq,chax - i1 = iccount -1 call getchar(lineq,iccount,durq) - if (index('0123456789.',durq) .gt. 0) go to 1 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - call stop1() - else if (lineq(i1:i1).eq.'.'.and.lineq(i2:i2).eq.'.') then - i2 = i2-1 - iccount = iccount-1 - end if - icf = i2-i1+49 - read(lineq(i1:i2),'(f'//chax(icf)//'.0)')fnum - return - end - subroutine setbits(isdata,iwidbit,ishift,ivalue) -c -c Sets iwidbits of isdata, shifted by ishift, to ivalue -c - ibase = 2**iwidbit-1 - isdata = iand(not(ishft(ibase,ishift)),isdata) - isdata = ior(isdata,ishft(ivalue,ishift)) - return - end - subroutine setbm2(xelsk,nnb,sumx,sumy,ipb,islope,nolev1) -c -c The MEAN SQUARE slope algorithm -c - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk, - * isfig - real*4 xelsk(24) - integer ipb(24) - ibc = ibmcnt(ivx) - sumxx = 0. - sumxy = 0. - do 2 inb = 1 , nnb - sumxx = sumxx+xelsk(inb)**2 - sumxy = sumxy+xelsk(inb)*nolev(ivx,ipb(inb)) -2 continue - delta = nnb*sumxx-sumx*sumx - em = (nnb*sumxy-sumx*sumy)/delta - islope = nint(0.5*em*slfac) - if (iabs(islope) .gt. 9) islope = isign(9,islope) - beta = (sumy-islope/slfac*sumx)/nnb - nolev1 = nint(beta) -c -c Check if any stems are too short -c - smin = 100. - iul = -1 - if (ulq(ivx,ibc) .eq. 'u') iul = 1 - do 4 inb = 1 , nnb - ybeam = nolev1+iul*stemlen+islope*xelsk(inb)/slfac - ynote = nolev(ivx,ipb(inb)) - smin = min(smin,iul*(ybeam-ynote)) -4 continue - if (smin .lt. stemmin) then - deficit = stemmin-smin - nolev1 = nint(nolev1+iul*deficit) - end if - return - end - subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq, - * ivx,nline) - character*1 charq,durq - common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac - logical mrecord,mplay,endmac,btest - character*128 lnholdq,lineq - common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), - * ic1mac(20),ilmac,iplmac -c -c Macro action -c - call g1etchar(lineq,iccount,charq) - if (charq.eq.'S' .and. ivx.ne.1) then - print* - print* - print*,'*********WARNING*********' - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * '"MS..." only put in parts by scor2prt if in voice #1!') - end if - if (index('RSP ',charq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "M" (macro)!') - call stop1() - else if (charq .ne. ' ') then -c -c Record or playback a macro. Get the number of the macro. -c - call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Must input number after "MR","MP", or "MS"!') - call stop1() - end if - call readnum(lineq,iccount,durq,fnum) - macnum = nint(fnum) - if (durq .ne. ' ') then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Macro number must be followed by a blank!') - call stop1() - end if - if (index('RS',charq ).gt. 0) then -c -c Record or save a macro -c - if (macnum.lt.1 .or. macnum.gt.20) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Macro number not in range 1-20!') - call stop1() - end if - macuse = ibset(macuse,macnum) - if (charq .eq. 'R') then - call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) - else if (charq .eq. 'S') then -c -c Save (Record but don't activate) -c -1 call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) - if (mrecord) then - call getbuf(lineq) - nline = nline+1 - iccount = 0 - go to 1 - end if - iccount = iccount+ndxm+1 - end if - else -c -c Playback the macro -c - if (.not.btest(macuse,macnum)) then - call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, - * 'Cannot play a macro that has not been recorded!') - call stop1() - end if - icchold = iccount - lnholdq = lineq - iccount = 128 - mplay = .true. - ilmac = il1mac(macnum) - end if - end if - return - end - subroutine setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) -c -c Sets last 2 args depending on 1st 2, (logical) num, denom. -c ibmtyp = 1, 2, or 3 defines set of masks for beam groupings. -c 1: all duple meters -c 2: triple w/ denom=4, subdivide in groups of 2 8ths -c 3: triple w/ denom=8, subdivide in groups of 3 8ths -c Note that lenbar is set at top or when 'm' symbol is read in getnote -c - if (mtrdenl .eq. 4) then - if (mod(mtrnuml,3) .eq. 0) then - ibmtyp = 2 - ibmrep = mtrnuml/3 - else - ibmtyp = 1 - ibmrep = mtrnuml/2 - end if - else if (mtrdenl .eq. 2) then - ibmtyp = 1 - if (mtrnuml .eq. 3) then - ibmrep = 3 - else - ibmrep = 2*mtrnuml/mtrdenl - end if - else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then -c -c Added 170726 -c - ibmtyp = 1 - ibmrep = mtrnuml/4 - else -c -c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 -c - ibmtyp = 3 - ibmrep = mtrnuml/3 - end if -c -c Reset so we don't keep writing new meters -c - mtrnuml = 0 -c -c Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter -c - ibmrep = max(ibmrep,1) - return - end - subroutine SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest) -c -c The outer combo algorithm -c - parameter (nm=24) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - common /comipl2/ ipl2(nm,200) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,btest, - * isfig,vxtup,l1ng,l2ng,bar1syst,drawbm - common /comeskz2/ eskz2(nm,200) - real*4 slope(800),xelsk(24) - integer ipb(24) - common /comask/ bar1syst,fixednew,scaldold, - * wheadpt,fbar,poenom - common /comas1/ naskb,task(40),wask(40),elask(40) - common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), - * mtupv(nm,9),nxtinbm(nm), - * islope(nm),xels11(24),eloff(nm,9), - * nssb(nm),issb(nm),lev1ssb(nm,20) - common /comdraw/ drawbm(nm) - common /combmh/ bmhgt,clefend - common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtol/ tol - ibc = ibmcnt(ivx) - nxtinbm(ivx) = 0 - n1 = ipl2(ivx,ibm1(ivx,ibc)) -c -c Initialize counters used in this subroutine, and then later during actual -c beam drawing, to count later segments of single-slope beam groups -c - nssb(ivx) = 0 - issb(ivx) = 0 -c -c Set flag for xtup beam starting with rest (no others can start with rest) -c - if (btest(irest(ivx,ipo(n1)),0)) ixrest = 1 -c -c Figure how many elemskips to each note. Use the list, counting only non-rests. -c - eskz0 = eskz(ivx,ibm1(ivx,ibc)) - nnb = 0 - sumx = 0. - sumy = 0. - ipxt1 = 0 - iplast = ibm2(ivx,ibc) - do 2 ip = ibm1(ivx,ibc) , iplast - if (.not.btest(irest(ivx,ip),0)) then - nnb = nnb+1 - ipb(nnb) = ip - xelsk(nnb) = eskz(ivx,ip)-eskz0 - sumx = sumx+xelsk(nnb) - sumy = sumy+nolev(ivx,ipb(nnb)) - if (btest(nacc(ivx,ip),21)) then -c -c This is the starting note of later segment of single-slope beam group -c Temporarily store ip here. -c - nssb(ivx) = nssb(ivx)+1 - lev1ssb(ivx,nssb(ivx)) = nnb - end if - end if -c -c New xtup stuff here. Final object is to get distance from start of xtup -c to number. xtinbm counts xtups in this beam only. mtupv is the printed -c number. ntupv is number of notes in xtup, and is only used to get -c eloff, the distance from start of xtup to the number. -c - if (btest(nacc(ivx,ip),18)) ndoub = ndoub+1 - if (ipxt1.eq.0 .and. nodur(ivx,ip).eq.0) then -c -c Xtup is starting here -c - nxtinbm(ivx) = nxtinbm(ivx)+1 - ipxt1 = ip - if (btest(nacc(ivx,ip),18)) then - ndoub = 1 - else - ndoub = 0 - end if - else if (ipxt1.gt.0 .and. nodur(ivx,ip).gt.0) then -c -c Xtup ends here. Set total number of notes in xtup. -c - ntupv(ivx,nxtinbm(ivx)) = ip+1-ipxt1 -c -c Set printed number for embedded xtup. -c - mtupv(ivx,nxtinbm(ivx)) = ntupv(ivx,nxtinbm(ivx))+ndoub -c -c Middle note of xtup if ntupv odd, note to left of gap if even. -c - ipxtmid = (ip+ipxt1)/2 - eloff(ivx,nxtinbm(ivx)) = eskz2(ivx,ipxtmid)-eskz2(ivx,ipxt1) - if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) - * eloff(ivx,nxtinbm(ivx)) = eloff(ivx,nxtinbm(ivx))+ - * .5*(eskz2(ivx,ipxtmid+1)-eskz2(ivx,ipxtmid)) - ipxt1 = 0 - end if -2 continue -c -c Reset nxtinbm for use as counter as #'s are posted by putxtn(..) -c - nxtinbm(ivx) = 0 - smed = 0. -c if (.not.btest(islur(ivx,ipb(1)),2)) then - if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then -c -c No forced 0 slope -c -c if (nnb .eq. 1) go to 6 - nsc = 0 - do 5 inb = 1 , nnb-1 - do 5 jnb = inb+1 , nnb - nsc = nsc+1 - slope(nsc) = (nolev(ivx,ipb(jnb))-nolev(ivx,ipb(inb)))/ - * (xelsk(jnb)-xelsk(inb)) - if (abs(slope(nsc)) .lt. 1.e-4) then - nsc = nsc+1 - slope(nsc) = slope(nsc-1) - nsc = nsc+1 - slope(nsc) = slope(nsc-1) - end if -5 continue - if (nsc .eq. 1) then - smed = slope(1) - go to 6 - end if - nscmid = nsc/2+1 - do 7 i = 1 , nscmid - do 7 j = i+1 , nsc - if (slope(j) .lt. slope(i)) then - t = slope(j) - slope(j) = slope(i) - slope(i) = t - end if -7 continue - smed = slope(nscmid) - if (nsc .eq. 2*(nsc/2)) then -c -c Even number of slopes in the list, so median is ambiguous -c - if (abs(slope(nscmid-1)) .lt. abs(slope(nscmid))-tol) then -c -c Lower-numbered one is truly less in absolute value, so use it -c - smed=slope(nscmid-1) - else if (abs(slope(nscmid-1)+slope(nscmid)) .lt. tol) then -c -c Two slopes are effectively equal. Take the one with sign of the average -c - sum = 0. - do 1 i = 1 , nsc - sum = sum+slope(i) -1 continue - smed = sign(smed,sum) - end if - end if -6 continue - islope(ivx) = nint(0.5*smed*slfac) - if (iabs(islope(ivx)) .gt. 9) - * islope(ivx) = isign(9,islope(ivx)) - else -c -c Forced horizontal beam -c - islope(ivx) = 0 - end if - beta = (sumy-islope(ivx)/slfac*sumx)/nnb -c -c If ixrest>0, this is a virtual nolev1 at location of rest. Will first use -c as is for placing xtup number and/or bracket, then reset it for start of -c actual beam -c - nolev1(ivx) = nint(beta) -c -c Check if any stems are too short -c - smin = 100. - iul = -1 - if (ulq(ivx,ibc) .eq. 'u') iul = 1 - ssq = 0. - syb = 0. - yb1 = nolev1(ivx) - * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)) - do 4 inb = 1 , nnb - ybeam = yb1+islope(ivx)*xelsk(inb)/slfac - * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1) - syb = syb+ybeam - ynote = nolev(ivx,ipb(inb)) - off = ybeam-ynote - if (inb .eq. 1) then - off1 = off - else if (inb .eq. nnb) then - off2 = off - end if - ssq = ssq+off*off - smin = min(smin,iul*off) -4 continue - dnolev = 0. - if (smin .lt. stemmin) then - deficit = stemmin-smin - nolevo = nolev1(ivx) - nolev1(ivx) = nint(nolev1(ivx)+iul*deficit) - dnolev = nolev1(ivx)-nolevo - off1 = off1+dnolev - off2 = off2+dnolev - end if - ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2 - if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and. - * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax) -c * .and. .not.btest(islur(ivx,ipb(1)),2)) then - * .and. .not.btest(islur(ivx,ipb(1)),2) - * .and. nnb.ne.1) then -c -c The first check is to save trouble of putting xtup's in setbm2. -c The penultimate check is that first and last stems aren't both excessive. -c The last check is that a 0 slope has not been forced -c - call setbm2(xelsk,nnb,sumx,sumy,ipb,islope(ivx),nolev1(ivx)) - end if -c -c Check if beam starts or ends too high or low. -c - xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1) - l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0. - xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb) - l2ng = iul*(xnolev2-ncmid(iv,ipb(nnb)))+xboff+7 .lt. 0 - if (l1ng .or. l2ng) then -c -c Need to correct start or stop, also slope -c - if (l1ng) then - nolev1(ivx) = nint(ncmid(iv,ipb(1))-(7.+xboff)*iul) - end if - if (l2ng) then - xnolev2 = nint(ncmid(iv,ipb(nnb))-(7.+xboff)*iul) - end if -c -c Since one or the other end has changed, need to change slope -c -c if (.not.btest(islur(ivx,ipb(1)),2)) - if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1) - * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb)) - end if - if (nssb(ivx) .gt. 0) then -c -c This is a single-slope beam group. Store start heights for later segs. -c - do 3 issbs = 1 , nssb(ivx) - lev1ssb(ivx,issbs) = nolev1(ivx)+islope(ivx)/slfac* - * xelsk(lev1ssb(ivx,issbs)) -3 continue - end if - return - end - subroutine sortpoe(nsyst,poe,ipoe) - parameter (nks=125) - real*4 poe(nks) - integer*4 ipoe(nks) -c -c Initialize ipoe: -c - do 3 iord = 1 , nsyst - ipoe(iord) = iord -3 continue -c -c Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will -c be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. -c - do 4 io1 = 1 , nsyst-1 - do 5 io2 = io1+1 , nsyst - if (poe(ipoe(io1)) .gt. poe(ipoe(io2))) then -c -c Interchange the indices -c - itemp = ipoe(io1) - ipoe(io1) = ipoe(io2) - ipoe(io2) = itemp - end if -5 continue -4 continue - return - end - subroutine spsslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3, - * isdat4,nsdat,notcrd,nolev,starter) - parameter (nm=24) -c -c Reads in slur data. Record all h/v-shifts for non-chords, user-specified -c ones for chords. -c 5/26/02 This subr is called ONLY for postscript slurs. -c -c See subroutine doslur for bit values in isdat1,2,3 -c - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) - logical notcrd,btest - character*128 lineq - character*1 durq,dumq,starter - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - logical upslur,fontslur,WrotePsslurDefaults -c -c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve -c - numint = 0 - ivoff = 0 - ihoff = 0 - nsdat = nsdat+1 - if (starter.eq.'{' .or. starter.eq.'}') - * isdat2(nsdat)=ibset(isdat2(nsdat),3) - call setbits(isdat1(nsdat),5,13,iv) - call setbits(isdat1(nsdat),1,12,kv-1) - call setbits(isdat1(nsdat),8,3,ip) - isdat3(nsdat) = 0 - isdat4(nsdat) = 0 - ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur -c -c Get ID code -c - call getchar(lineq,iccount,durq) -c if (index('uldtb+-hfnHps ',durq) .gt. 0) then - if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then -c -c Null id. Note for ps slurs, 'H' cannot be an ID -c - iccount = iccount-1 - if (lineq(iccount:iccount) .eq. 't') then - idcode = 1 - else - idcode = 32 - end if - else -c -c Set explicit idcode -c - idcode = ichar(durq) - if (lineq(iccount-1:iccount-1) .eq. 't') then -c -c Make t[ID] look like s[ID]t -c - isdat2(nsdat) = ibset(isdat2(nsdat),3) - end if - if (lineq(iccount+1:iccount+1).eq.'x') then -c -c Flag for 2-voice, indexed slurs -c - iccount = iccount+1 - call setbits(isdat1(nsdat),1,1,1) - end if - end if - call setbits(isdat1(nsdat),7,19,idcode) -c -c Set start/stop: look thru list from end for same idcode,iv,kv -c - do 2 isdat = nsdat-1 , 1 , -1 - if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. - * iv .eq. igetbits(isdat1(isdat),5,13) .and. -c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then - * (kv-1 .eq. igetbits(isdat1(isdat),1,12) - * .or. btest(isdat1(isdat),1))) then -c -c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. -c - if (btest(isdat1(isdat),11)) go to 3 -c -c Found slur is a turnoff, so new one is a turnon. Jump down to set bit -c - go to 4 - end if -2 continue -c -c If here, this is turnon. -c -4 continue - isdat1(nsdat) = ibset(isdat1(nsdat),11) -3 continue -c -c Now done with initial turnon- or turnoff-specifics. -c - if (nint(SlurCurve).ne.0 .and. btest(isdat1(nsdat),11)) then -c -c There's a default curvature tweak -c - icurv1 = nint(SlurCurve)+3 - if (icurv1 .eq. 2) icurv1 = 1 - isdat3(nsdat) = ibset(isdat3(nsdat),0) - call setbits(isdat3(nsdat),6,2,32+icurv1) - end if -c -c Loop for rest of input -c -1 call getchar(lineq,iccount,durq) - if (index('uld',durq) .gt. 0) then -c -c Force direction -c - isdat1(nsdat) = ibset(isdat1(nsdat),26) - if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27) - go to 1 - else if (index('+-',durq) .gt. 0) then - numint = numint+1 - if (numint .eq. 1) then -c -c Vertical offset -c - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - iccount = iccount-1 - ivoff = nint(fnum) - if (durq .eq. '-') ivoff = -ivoff - else if (numint .eq. 2) then -c -c Horizontal offset -c - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - iccount = iccount-1 -c -c fnum is abs(hshift), must be 0 to 6.3 -c - ihoff = fnum*10 + .5 - if (durq .eq. '-') ihoff = -ihoff -c -c Later will set bits to 1...127 to represent -6.3,...+6.3 -c - else -c -c Must be the 3rd signed integer, so it's a curve specification -c - isdat3(nsdat) = ibset(isdat3(nsdat),0) - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - icurv1 = nint(fnum) - if (durq .eq. '-') icurv1 = -icurv1 - call setbits(isdat3(nsdat),6,2,32+icurv1) - if (dumq .ne. ':') then -c -c Back up the pointer and loop for more input -c - iccount = iccount-1 - else -c -c Expect two single digits as parameters for curve -c - isdat3(nsdat) = ibset(isdat3(nsdat),1) - call setbits(isdat3(nsdat),3,8, - * ichar(lineq(iccount+1:iccount+1))-48) - call setbits(isdat3(nsdat),3,11, - * ichar(lineq(iccount+2:iccount+2))-48) - iccount = iccount+2 - end if - end if - go to 1 - else if (durq .eq. 't') then - isdat2(nsdat) = ibset(isdat2(nsdat),3) - go to 1 - else if (durq .eq. 'b') then - isdat2(nsdat) = ibset(isdat2(nsdat),4) - go to 1 - else if (durq .eq. 's') then -c -c Endpoint tweaks for linebreak slurs. -c - call getchar(lineq,iccount,durq) ! Must be +|- -c -c Next is vertical offset -c - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - if (durq .eq. '-') fnum=-fnum - call setbits(isdat4(nsdat),6,ilb12*16,nint(fnum)+32) - if (index('+-',dumq) .gt. 0) then -c -c Also a horizontal offset -c - iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - if (dumq .eq. '-') fnum=-fnum - call setbits(isdat4(nsdat),7,ilb12*16+6,nint(10*fnum)+64) - end if - iccount = iccount-1 - ilb12 = 1 - go to 1 - else if (index('fnhH',durq).gt.0) then -c -c Special ps slur curvatures. -c Translate to old \midslur args (1,4,5,6) -c - icurv1 = index('fnxhH',durq) - if (icurv1 .eq. 5) then -c -c check for 2nd H -c - if (lineq(iccount+1:iccount+1) .eq. 'H') then - iccount = iccount+1 - icurv1 = 6 - end if - end if - isdat3(nsdat) = ibset(isdat3(nsdat),0) - call setbits(isdat3(nsdat),6,2,32+icurv1) - go to 1 - else if (durq .eq. 'p') then ! Local adjustment - call getchar(lineq,iccount,durq) ! +|- - call getchar(lineq,iccount,dumq) ! s|t -c 26 \sluradjust (p+s) -c 27 \nosluradjust (p-s) -c 28 \tieadjust (p+t) -c 29 \notieadjust (p-t) - if (durq .eq. '+') then - if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),26) - else - isdat2(nsdat) = ibset(isdat2(nsdat),28) - end if - else - if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),27) - else - isdat2(nsdat) = ibset(isdat2(nsdat),29) - end if - end if - go to 1 - else if (durq .eq. 'v') then ! Stem slur - isdat1(nsdat) = ibset(isdat1(nsdat),2) - go to 1 - end if -c -c Record shifts -c - call setbits(isdat2(nsdat),6, 6,ivoff+32) - call setbits(isdat2(nsdat),7,12,ihoff+64) -c -c Record chord flag, note level, notehead shift -c - if (notcrd) then - call setbits(isdat2(nsdat),7,19,nolev) - else - nolevc = igetbits(icrdat(ncrd),7,12) - call setbits(isdat2(nsdat),7,19,nolevc) - isdat2(nsdat) = ibset(isdat2(nsdat),0) - call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23)) - end if - return - end - subroutine sslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3, - * nsdat,notcrd,nolev,starter) - parameter (nm=24) -c -c Reads in slur data. Record all h/v-shifts for non-chords, user-specified -c ones for chords. -c 5/26/02 now only for non-postscript slurs, use spsslur() for postscript -c -c See subroutine doslur for bit values in isdat1,2,3 -c - common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), - * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, - * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 - integer*4 isdat1(202),isdat2(202),isdat3(202) - logical notcrd,btest - character*128 lineq - character*1 durq,dumq,starter - common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur - * ,WrotePsslurDefaults,SlurCurve - logical upslur,fontslur,WrotePsslurDefaults -c -c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve -c - numint = 0 - ivoff = 0 - ihoff = 0 - nsdat = nsdat+1 - if (starter.eq.'{' .or. starter.eq.'}') - * isdat2(nsdat)=ibset(isdat2(nsdat),3) - call setbits(isdat1(nsdat),5,13,iv) - call setbits(isdat1(nsdat),1,12,kv-1) - call setbits(isdat1(nsdat),8,3,ip) - isdat3(nsdat) = 0 -c -c Get id letter -c - if (lineq(iccount:iccount) .eq. 't') then -c -c Old-style t-slur. Use special idcode = 1 -c - idcode = 1 - else - call getchar(lineq,iccount,durq) - if (index('uldtb+-hf ',durq) .gt. 0) then -c -c Null id -c - idcode = 32 - iccount = iccount-1 - else if (durq.eq.'H') then -c -c Postscript slur, cannot use 'H' as code, must check for 2nd 'H' -c - idcode = 32 - iccount = iccount-1 -c -c There may be another "H", but no need to deal with it yet -c - else -c -c Set explicit idcode -c - idcode = ichar(durq) - end if - end if - call setbits(isdat1(nsdat),7,19,idcode) -c -c Set start/stop: look thru list from end for same idcode,iv,kv -c - do 2 isdat = nsdat-1 , 1 , -1 - if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. - * iv .eq. igetbits(isdat1(isdat),5,13) .and. - * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then -c -c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. -c - if (btest(isdat1(isdat),11)) go to 3 -c -c Found slur is a turnoff, so new one is a turnon. Jump down to set bit -c - go to 4 - end if -2 continue -c -c If here, this is turnon. -c -4 continue - isdat1(nsdat) = ibset(isdat1(nsdat),11) -3 continue -c -c Now done with initial turnon- or turnoff-specifics. Loop for rest of input -c -1 call getchar(lineq,iccount,durq) - if (index('uld',durq) .gt. 0) then -c -c Force direction -c - isdat1(nsdat) = ibset(isdat1(nsdat),26) - if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27) - go to 1 - else if (index('+-',durq) .gt. 0) then - numint = numint+1 - if (numint .eq. 1) then -c -c Vertical offset -c - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - iccount = iccount-1 - ivoff = nint(fnum) - if (durq .eq. '-') ivoff = -ivoff - else if (numint .eq. 2) then -c -c Horizontal offset -c - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - iccount = iccount-1 -c -c fnum is abs(hshift), must be 0 to 6.3 -c - ihoff = fnum*10 + .5 - if (durq .eq. '-') ihoff = -ihoff -c -c Later will set bits to 1...127 to represent -6.3,...+6.3 -c - else -c -c Must be the 3rd signed integer, so it's a curve specification -c - isdat3(nsdat) = ibset(isdat3(nsdat),0) - iccount = iccount+1 - call readnum(lineq,iccount,dumq,fnum) - icurv1 = nint(fnum) - if (durq .eq. '-') icurv1 = -icurv1 - call setbits(isdat3(nsdat),6,2,32+icurv1) - if (dumq .ne. ':') then -c -c Back up the pointer and loop for more input -c - iccount = iccount-1 - else -c -c Expect two single digits as parameters for curve -c - isdat3(nsdat) = ibset(isdat3(nsdat),1) - call setbits(isdat3(nsdat),3,8, - * ichar(lineq(iccount+1:iccount+1))-48) - call setbits(isdat3(nsdat),3,11, - * ichar(lineq(iccount+2:iccount+2))-48) - iccount = iccount+2 - end if - end if - go to 1 - else if (durq .eq. 't') then - isdat2(nsdat) = ibset(isdat2(nsdat),3) - go to 1 - else if (durq .eq. 'b') then - isdat2(nsdat) = ibset(isdat2(nsdat),4) - go to 1 - else if (index('fhH',durq) .gt. 0) then -c -c Special ps slur curvatures. Translate to old \midslur args (1,4,5,6) -c - icurv1 = 2+index('fhH',durq) - if (icurv1 .eq. 3) then - icurv1 = 1 - else if (icurv1 .eq. 5) then -c -c check for 2nd H -c - if (lineq(iccount+1:iccount+1) .eq. 'H') then - iccount = iccount+1 - icurv1 = 6 - end if - end if - isdat3(nsdat) = ibset(isdat3(nsdat),0) -c -c Must change sign if downslur, but cannot do it now since we don't know -c slur direction for sure. -c - call setbits(isdat3(nsdat),6,2,32+icurv1) - go to 1 - end if -c -c Record shifts -c - call setbits(isdat2(nsdat),6, 6,ivoff+32) - call setbits(isdat2(nsdat),7,12,ihoff+64) -c -c Record chord flag, note level, notehead shift -c - if (notcrd) then - call setbits(isdat2(nsdat),7,19,nolev) - else - nolevc = igetbits(icrdat(ncrd),7,12) - call setbits(isdat2(nsdat),7,19,nolevc) - isdat2(nsdat) = ibset(isdat2(nsdat),0) - call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23)) - end if - return - end - subroutine stop1() - call exit(1) - end - subroutine topfile(basenameq,lbase,nv,clefq,noinst,musicsize, - * xinstf1,mtrnmp,mtrdnp,vshrink,fbar,fontslur) - parameter (nm=24) - common /comlast/ islast,usevshrink - logical islast,usevshrink,fontslur - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), - * xinsnow,lowdot - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - character*79 inameq - character*44 basenameq - character*24 fmtq - character*5 fbarq - character*1 clefq(nm),sq,chax,clefqiv - common /comstart/ facmtr - logical vshrink,lowdot,rename - logical novshrinktop,cstuplet - common /comnvst/ novshrinktop,cstuplet - common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), - * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans - logical EarlyTransOn,LaterInstTrans - common /comsize/ isize(nm) - common /comis4bignv/ is4bignv,AIset - logical is4bignv,AIset - common /comc8flag/ c8flag(nm) - logical c8flag - sq = chax(92) - vshrink = xinstf1.gt.20. .and. .not.novshrinktop - if (vshrink) then - xinsnow = 10. - else - xinsnow = xinstf1 - end if - if (.not.islast) return -c -c Initialize octave treble clef tracker -c - do 6 im = 1 , nm - c8flag(im) = .false. -6 continue - write(11,'(a)')'%%%%%%%%%%%%%%%%%' - write(11,'(a)')'%' - write(11,'(a)')'% '//basenameq(1:lbase)//'.tex' - write(11,'(a)')'%' - write(11,'(a)')'%%%%%%%%%%%%%%%%' - write(11,'(a)')sq//'input musixtex' - write(11,'(a)')sq//'input pmx' - write(11,'(a)') - * sq//'setmaxslurs{24}'//sq//'setmaxinstruments{24}%' - if (.not.fontslur) write(11,'(a)')sq//'input musixps' -c -c Need to input musixmad to permit more slurs. -c - if (musicsize .eq. 20) then - write(11,'(a)')sq//'normalmusicsize%' - else if (musicsize .eq. 16) then - write(11,'(a)')sq//'smallmusicsize%' - else if (musicsize .eq. 24) then - write(11,'(a)')sq//'largemusicsize%' -c -c Eliminate, per Tennent's analysis and musixtex changes since first input -c -c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// -c * 'meterlargefont}%' - else if (musicsize .eq. 29) then - write(11,'(a)')sq//'Largemusicsize%' -c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// -c * 'meterLargefont}%' - end if -c -c Set sizes. Have sizes per staff in isize(.) and noinst per staff in -c nsperi(.) -c -c 130324 -c iiv = 1 - do 5 iinst = 1 , noinst -c if (isize(iiv) .eq. 1) then - if (isize(iinst) .eq. 1) then - if(iinst.le.9) then - write(11,'(a8,i1,a)') - * sq//'setsize',iinst,sq//'smallvalue%' - else - write(11,'(a9,i2,a)') - * sq//'setsize{',iinst,'}'//sq//'smallvalue%' - end if -c else if (isize(iiv) .eq. 2) then - else if (isize(iinst) .eq. 2) then - if(iinst.le.9) then - write(11,'(a8,i1,a)') - * sq//'setsize',iinst,sq//'tinyvalue%' - else - write(11,'(a9,i2,a)') - * sq//'setsize{',iinst,'}'//sq//'tinyvalue%' - end if - end if -c iiv = iiv+nsperi(iinst) -5 continue - write(fbarq,'(f5.3)')fbar - write(11,'(a)')sq//'nopagenumbers' - write(11,'(a)')sq//'tracingstats=2'//sq//'relax' - write(11,'(a7,i3,a2)')sq//'hsize=',nint(widthpt),'pt' - write(11,'(a6,i'//chax(49+int(log10(height+.1)))//',a2)') - * sq//'vsize',int(height+.1),'pt' - if (abs(hoffpt) .gt. 0.1) then - if (hoffpt .le. -10.) then - write(11,'(a8,i3,a2)')sq//'hoffset',nint(hoffpt),'pt' - else if (hoffpt .lt. 0.) then - write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt' - else if (hoffpt .lt. 10.) then - write(11,'(a8,i1,a2)')sq//'hoffset',nint(hoffpt),'pt' - else - write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt' - end if - end if - if (abs(voffpt) .gt. 0.1) then - if (voffpt .le. -10.) then - write(11,'(a8,i3,a2)')sq//'voffset',nint(voffpt),'pt' - else if (voffpt .lt. 0.) then - write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt' - else if (voffpt .lt. 10.) then - write(11,'(a8,i1,a2)')sq//'voffset',nint(voffpt),'pt' - else - write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt' - end if - end if -c -c The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if -c 3 sharps and treble clef, to avoid vertical clash with top space g# -c - if (isig.eq.3 .and. clefq(nv).eq.'t') write(11,'(a)') - * sq//'def'//sq//'raisebarno{4.5'//sq//'internote}' - if (noinst .lt. 10) then - write(11,'(a19,i1,a1)')sq//'def'//sq//'nbinstruments{', - * noinst,'}' - else - write(11,'(a19,i2,a1)')sq//'def'//sq//'nbinstruments{', - * noinst,'}' - end if - iv = 0 - do 1 iinst = 1 , noinst - nstaves = nsperi(iinst) - if (iinst .lt. 10) then - write(11,'(a)')sq//'setstaffs'//chax(48+iinst) - * //chax(48+nstaves) - else - write(11,'(a11,i2,a)')sq//'setstaffs{',iinst,'}' - * //chax(48+nstaves) - end if - iv = iv+1 - clefqiv = clefq(iv) - if (clefqiv.eq.'8') then - clefqiv='t' - iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) - c8flag(iv) = .true. - end if - if (nstaves .eq. 1) then - fmtq = chax(48+numclef(clefq(iv))) - lfmtq = 1 - else - fmtq = '{'//chax(48+numclef(clefq(iv))) - lfmtq = 2 - do 2 k = 2 , nstaves - iv = iv+1 - fmtq = fmtq(1:lfmtq)//chax(48+numclef(clefq(iv))) - lfmtq = lfmtq+1 -2 continue - fmtq = fmtq(1:lfmtq)//'}' - lfmtq = lfmtq+1 - end if - if (iinst .lt. 10) then - write(11,'(a)')sq//'setclef'//chax(48+iinst)//fmtq(1:lfmtq) - else - write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq) - end if - if (clefq(iv) .eq. '8') then - if (iinst .lt. 10) then - write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)// - * sq//'treblelowoct%' - else - write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'// - * sq//'treblelowoct%' - end if - c8flag(iv) = .true. - end if - do 3 lname = 79 , 2 , -1 - if (inameq(iinst)(lname:lname) .ne. ' ') go to 4 -3 continue -4 continue - lnam(iinst) = lname - if (iinst .lt. 10) then - write(11,'(a8,i1,a)')sq//'setname',iinst, - * '{'//inameq(iinst)(1:lname)//'}' - else - write(11,'(a9,i2,a)')sq//'setname{',iinst, - * '}{'//inameq(iinst)(1:lname)//'}' - end if -1 continue - write(11,'(a18,i2,a2)')sq//'generalsignature{',isig,'}%' - if (EarlyTransOn) - * call Writesetsign(nInstTrans,iInstTrans,iTransKey,EarlyTransOn) - call wgmeter(mtrnmp,mtrdnp) - ipi = nint(fracindent*widthpt) - if (ipi .lt. 10) then - write(11,'(a11,i1,a2)')sq//'parindent ',ipi,'pt' - else if (ipi .lt. 100) then - write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt' - else - write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt' - end if - write(11,'(a)')sq//'elemskip1pt'//sq//'afterruleskip' - * //fbarq//'pt'//sq//'beforeruleskip0pt'//sq//'relax' - if (.not.vshrink) then - if (xinstf1 .lt. 9.95) then - fmtq = '(a,f3.1,a)' - else - fmtq = '(a,f4.1,a)' - end if - facis = 1. - if (is4bignv) facis = .95 - write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt' - * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax' - else - write(11,'(a)')sq//'stafftopmarg0pt'// - * sq//'staffbotmarg5'//sq//'Interligne'//sq// - * 'interstaff{10}'//sq//'relax' - end if - if (nv.eq.1) write(11,'(a)')sq//'nostartrule' - write(11,'(a)')sq//'readmod{'//basenameq(1:lbase)//'}' - if (cstuplet) then - write(11,'(a)')sq//'input tuplet' - * //sq//'def'//sq//'xnumt#1#2#3{'//sq//'zcharnote{#2}{~}' - * //sq//'def'//sq//'tuplettxt{'//sq//'smalltype'//sq//'it{#3}' - * //sq//'/'//sq//'/}}%' - write(11,'(a)')sq//'let'//sq//'ovbkt'//sq//'uptuplet' - * //sq//'let'//sq//'unbkt'//sq//'downtuplet%' - end if - write(11,'(a)')sq//'startmuflex'//sq//'startpiece'//sq// - * 'addspace'//sq//'afterruleskip%' - return - end - character*1 function udfq(nolev,ncm) -c -c Slur directions -c - common /combc/ bcspec - logical bcspec - ntest = nolev-ncm - if (ntest.lt.0 .or. - * (ntest.eq.0 .and. bcspec .and. ncm.eq.23) ) then - udfq = 'd' - else - udfq = 'u' - end if - return - end - character*1 function udqq(nole,ncm,isl,nvmx,ivx,nv) -c -c Stem direction for single notes -c - character*1 ulfq - character*1 udqqq - logical btest - if (btest(isl,30)) then -c -c Absolute override -c - if (btest(isl,17)) then - udqqq = 'u' - else - udqqq = 'l' - end if - else if (nvmx .eq. 1) then -c -c Single voice per staff, default -c - udqqq = ulfq(1.*nole,ncm) - else -c -c Multi-voice per staff, 1st is lower, 2nd upper -c - if (ivx .le. nv) then - udqqq = 'l' - else - udqqq = 'u' - end if - end if - udqq = udqqq - return - end - character*1 function ulfq(xnolev,ncm) -c -c Stem directions -c - common /combc/ bcspec - logical bcspec - test = xnolev-ncm - if (test.lt.-.001 .or. - * (test.lt..001.and.bcspec.and.ncm.eq.23) ) then - ulfq = 'u' - else - ulfq = 'l' - end if - return - end - function upcaseq(chq) - character*1 chq,upcaseq,chax - if (ichar(chq).ge.61.and.ichar(chq).lt.122) then - upcaseq = chax(ichar(chq)-32) - else - upcaseq = chq - print*,'Warning, upcaseq was called with improper argument: ' - * //chq - stop - end if - return - end - subroutine wgmeter(mtrnmp,mtrdnp) -c -c Writes meter stuff to file 11, so only called if islast=.true. -c - character*1 sq,chax - if (mtrdnp .eq. 0) return - sq=chax(92) - if (mtrnmp.gt.0 .and. mtrnmp.le.9) then - if (mtrdnp .lt. 10) then - write(11,'(a25,i1,a2,i1,a3)') - * sq//'generalmeter{'//sq//'meterfrac{', - * mtrnmp,'}{',mtrdnp,'}}%' - else - write(11,'(a25,i1,a2,i2,a3)') - * sq//'generalmeter{'//sq//'meterfrac{', - * mtrnmp,'}{',mtrdnp,'}}%' - end if - else if (mtrnmp .ge. 10) then - if (mtrdnp .lt. 10) then - write(11,'(a25,i2,a2,i1,a3)') - * sq//'generalmeter{'//sq//'meterfrac{', - * mtrnmp,'}{',mtrdnp,'}}%' - else - write(11,'(a25,i2,a2,i2,a3)') - * sq//'generalmeter{'//sq//'meterfrac{', - * mtrnmp,'}{',mtrdnp,'}}%' - end if - else if (mtrnmp .lt. 0) then - write(11,'(a26,i1,a2,i1,a3)') - * sq//'generalmeter{'//sq//'meterfracS{', - * -mtrnmp,'}{',mtrdnp,'}}%' - else if (mtrdnp .le. 4) then - write(11,'(a21,i1,a2)') - * sq//'generalmeter{'//sq//'meterN',mtrdnp,'}%' - else if (mtrdnp .eq. 5) then - write(11,'(a)')sq//'generalmeter'//sq//'allabreve%' - else if (mtrdnp .eq. 6) then - write(11,'(a)')sq//'generalmeter'//sq//'meterC%' - else if (mtrdnp .eq. 7) then - write(11,'(a)')sq//'generalmeter'//sq//'meterIIIS%' - end if - return - end - subroutine writemidi(jobname,ljob) - parameter(nm=24,mv=24576) - common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, - * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), - * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), - * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), - * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, - * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), - * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), - * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), - * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) - character*1 ulq,sepsymq,sq - logical beamon,firstgulp,figbass,figchk,isfig - character*1 byteq(4),char,chax - character*10 tempoq,instq - character*44 jobname - integer*2 mmidi - logical restpend,relacc,notmain,twoline,ismidi,crdacc - common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, - * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), - * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), - * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, - * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), - * debugmidi - logical debugmidi - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) - * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - common /comevent/ miditime,lasttime - logical mmacrec,gottempo - common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, - * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), - * mmacrec,gottempo - character*79 inameq - common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, - * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, - * lnam(nm),inameq(nm) - logical rename - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) -c -c Used to be icmm(0:nm); did midi fail when nv>16? -c - integer*2 iinsiv,icmm(0:15) - character*5 versionc - common /comver/ versionc -c -c These are not consecutive because channel 9 is reserved for percussion. -c - data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/ -c -c Write Header -c - write(51,'(a,$)')'MThd'//char(0)//char(0)//char(0)//char(6) - * //char(0)//char(1)//char(0)//char(numchan+1)//char(0)//char(240) - if (debugmidi) - * write(52,'(a6,10Z4)')'"MThd"',0,0,0,6, - * 0,1,0,numchan+1,0,240 -c -c Write the "conductor" track, for keys, meter, and tempos -c Get the number of bytes in the conductor event stream -c - ndata = 1+imidi(numchan)-msecstrt(numchan,nmidsec) - do 15 isec = 1 , nmidsec-1 - ndata = ndata+1+msecend(numchan,isec)-msecstrt(numchan,isec) -15 continue -c ib1 = (4+ljob+26+ndata+4)/256 -c ib0 = 4+ljob+26+ndata+4-256*ib1 - ib1 = (4+ljob+27+ndata+4)/256 - ib0 = 4+ljob+27+ndata+4-256*ib1 - write(51,'(a,$)')'MTrk'//char(0)//char(0)//char(ib1)//char(ib0) -c -c Text header -c -c * //char(0)//char(255)//char(1)//char(ljob+26) - * //char(0)//char(255)//char(1)//char(ljob+27) - if (debugmidi) - * write(52,'(a6,8z4)')'"MTrk"',0,0,ib1,ib0, - * 0,255,1,ljob+27 - write(51,'(a,$)')jobname(1:ljob) - if (debugmidi) write(52,'(a)')'"'//jobname(1:ljob)//'"' -c -c (separate writes are needed to defeat compiler BUG!!!) -c -c write(51,'(a,$)')'.mid, produced by PMX 2.30' - write(51,'(a,$)')'.mid, produced by PMX '//versionc - if (debugmidi) write(52,'(a)') - * '".mid, produced by PMX '//versionc//'"' -c -c Conductor event data: Loop over sections. -c - do 16 isec = 1 , nmidsec - if (isec .lt. nmidsec) then - mend = msecend(numchan,isec) - else - mend = imidi(numchan) - end if - do 17 i = msecstrt(numchan,isec) , mend - write(51,'(a,$)')char(mmidi(numchan,i)) - if (debugmidi) write(52,'(z4)')mmidi(numchan,i) -17 continue -16 continue -c -c And close out the time sig / tempo track. -c - write(51,'(a,$)')char(0)//char(255)//char(2*16+15)//char(0) - if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0 -c -c Loop over track for each voice: The following sets up iv. -c - iv = nv - if (twoline(nv)) then - kv = 2 - else - kv = 1 - end if -c - do 5 icm = 0 , numchan-1 -c -c Get the number of bytes in the data stream -c - ndata = 1+imidi(icm)-msecstrt(icm,nmidsec) - do 11 isec = 1 , nmidsec-1 - ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec) -11 continue -c -c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, -c - ndata = ndata+11 -c -c Add 4+lnam(iinsiv(iv)) if lnam>0 , -c - if (lnam(iinsiv(iv)).gt.0) ndata = ndata+4+lnam(iinsiv(iv)) -c -c Separate total byte counts into 4 bytes -c - do 2 ibyte = 1 , 4 - if (ndata .gt. 0) then - byteq(ibyte) = char(mod(ndata,256)) - ndata = ishft(ndata,-8) - else - byteq(ibyte) = char(0) - end if -2 continue -c -c Now write front stuff for this track -c - write(51,'(a,$)')'MTrk'//byteq(4)//byteq(3)//byteq(2)//byteq(1) - * //char(0)//char(12*16+icmm(icm))//char(midinst(iinsiv(iv))) - * //char(0)//char(11*16+icmm(icm))//char(10)//char(midbc(icm)) - if (debugmidi) write(52,'(a4,z2,a7,11z4)')'icm=',icm, - * ' "MTrk"',ichar(byteq(4)),ichar(byteq(3)),ichar(byteq(2)), - * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iinsiv(iv)), - * 0,11*16+icmm(icm),10,midbc(icm) - if (lnam(iinsiv(iv)) .gt. 0) then -c -c Add instrument name as sequence name -c - write(51,'(a,$)')char(0)//char(255)//char(3) - * //char(lnam(iinsiv(iv))) - if (debugmidi) write(52,'(4z4)')0,255,3,lnam(iinsiv(iv)) - write(51,'(a,$)') - * inameq(iinsiv(iv))(1:lnam(iinsiv(iv))) - if (debugmidi) write(52,'(a)') - * '"'//inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))//'"' - end if - write(tempoq,'(i2)')icm - write(instq,'(i3)')midinst(iinsiv(iv)) - call printl('MIDI instrument '//tempoq(1:2)//' is '//instq(1:3)) -c -c Notes: Loop over sections. -c - do 9 isec = 1 , nmidsec - if (isec .lt. nmidsec) then - mend = msecend(icm,isec) - else - mend = imidi(icm) - end if - do 10 i = msecstrt(icm,isec) , mend - write(51,'(a,$)')char(mmidi(icm,i)) - if (debugmidi) write(52,'(z4)')mmidi(icm,i) -10 continue -9 continue -c -c Closing 4 bytes -c - write(51,'(a,$)')chax(0)//char(255)//char(2*16+15)//char(0) - if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0 - if (kv .eq. 2) then - kv = 1 - else if (iv .eq. 1) then - go to 5 - else - iv = iv-1 - if (twoline(iv)) kv=2 - end if -5 continue - write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan) - write(15,'(1x,a12,(10i6))') - * 'Bytes used:',(imidi(icm),icm=0,numchan) - close(51) - if (debugmidi) close(52) - return - end - subroutine Writesetsign(nInstTrans,iInstTrans,iTransKey,flag) - parameter(nm=24) - integer*4 iInstTrans(nm),iTransKey(nm) - character*79 notexq - character*1 chax - logical flag -c -c Assumes notexq is blank -c - do 1 i = 1 , nInstTrans - notexq = chax(92)//'setsign' - lnote = 8 - if (iInstTrans(i) .lt. 10) then - notexq = notexq(1:lnote)//chax(48+iInstTrans(i)) - lnote = lnote+1 - else - write(notexq(lnote+1:lnote+4),'(a1,i2,a1)') - * '{',iInstTrans(i),'}' - lnote = lnote+4 - end if - if (iTransKey(i) .lt. 0) then - write(notexq(lnote+1:lnote+4),'(a1,i2,a1)') - * '{',iTransKey(i),'}' - lnote = lnote+4 - else - notexq = notexq(1:lnote)//chax(48+iTransKey(i)) - lnote = lnote+1 - end if - write(11,'(a)')notexq(1:lnote)//'%' -1 continue - flag = .false. - return - end - subroutine writflot(x,notexq,lenline) - character*(*) notexq - if (x .lt. 0.95) then - write(notexq(lenline+1:lenline+2),'(f2.1)')x - lenline = lenline+2 - else if (x .lt. 9.95) then - write(notexq(lenline+1:lenline+3),'(f3.1)')x - lenline = lenline+3 - else - write(notexq(lenline+1:lenline+4),'(f4.1)')x - lenline = lenline+4 - end if - return - end - subroutine wsclef(iv,ninow,nclef) -c subroutine wsclef(iv,ninow,clefq,nclef) -c -c Writes \setclef for instrument containing *staff* iv -c - parameter (nm=24) - common /comlast/ islast,usevshrink - logical islast,usevshrink - common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) - logical rename -c -c In pmx271, had removed clefq, so with 2 or more staves in -c an instrument, had problems. So replace in 272 -c - common /comclefq/ clefq(nm) - character*1 clefq,chax - character*40 temq - common /comc8flag/ c8flag(nm) - logical c8flag - if (nclef .lt. 7) then - clefq(iv) = chax(48+nclef) - else - clefq(iv)='9' - end if - if (.not.islast) return - iv1 = 1 - do 1 iinst = 1 , ninow - if (iv .lt. iv1+nspern(iinst)) go to 2 - iv1 = iv1+nspern(iinst) -1 continue - print* - print*,'Should not be here in wsclef!' - call stop1() -2 continue -c -c Here, iinst is the instrument number with staff of clef change -c - iv2 = iv1+nspern(iinst)-1 - if (iinst .lt. 10) then - temq = chax(92)//'setclef'//chax(48+iinst) - ltem = 9 - else - write(temq,'(a9,i2,a1)') chax(92)//'setclef{',iinst,'}' - ltem = 12 - end if - if (iv1 .eq. iv2) then -c -c Only one staff (iv) in instrument with clef change -c - write(11,'(a)')temq(1:ltem)//clefq(iv)//'%' - else - temq = temq(1:ltem)//'{' - ltem = ltem+1 -c -c Loop over staves, but clefq has only changed for one of them -c - do 3 iiv = iv1 , iv2 - temq = temq(1:ltem)//chax(48+numclef(clefq(iiv))) - ltem = ltem+1 -3 continue - write(11,'(a)')temq(1:ltem)//'}%' - end if - if (c8flag(iv)) then -c -c If we change FROM octave treble clef to some other, need the following. -c - write(11,'(a)')char(92)//'settrebleclefsymbol'//chax(48+iinst) - * //char(92)//'trebleclef%' - c8flag(iv) = .false. - end if - return - end - subroutine chkpmxlyr(lineq,iccount,lyrerr) - character*128 lineq - character*1 charq - lyrerr = 0 -c -c On entry, last char was " -c -18 call g1etchar(lineq,iccount,charq) - if (iccount .eq. 121) then - lyrerr = 2 - return -c else if (charq.eq.'"') then - else if (charq.eq.'"' .and. - * .not.(lineq(iccount-1:iccount-1).eq.char(92))) then - call g1etchar(lineq,iccount,charq) -c -c Check for raise/lower command -c - if (charq .eq. '@') then -c -c @ positions lyrics vertically for current voice -c [a,b] above or below of the staff -c +/- i offset, \internotes -c - call g1etchar(lineq,iccount,charq) - if (index('ab',charq).eq.0) then - lyrerr = 3 - return - end if - call g1etchar(lineq,iccount,charq) - if (index('+-',charq).eq.0) then - lyrerr = 4 - return - end if - call g1etchar(lineq,iccount,charq) - if (index('0123456789',charq).eq.0) then - lyrerr = 5 - return - end if - else if (charq .ne. ' ') then -c -c 2nd " must be followed by ' ' -c - lyrerr = 1 - return - end if - return - end if - go to 18 - end - subroutine dopmxlyr(lineq,iccount) -c -c lineq has " at iccount. Find end of lyrics string, replace "..." -c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', -c (unless preceded with '\'), check length -c - character*128 lineq,lineqt - character*1 sq,chax - sq = chax(92) - iend = lenstr(lineq,128) -c -c i2nd = iccount+index(lineq(iccount+1:128),'"') -c Find position of closing '"'; must bypass any \" which is used for umlaut -c - i2nd = iccount+index(lineq(iccount+1:128),'"') -2 continue - if (lineq(i2nd-1:i2nd-1).eq.char(92)) then - i2nd = i2nd+index(lineq(i2nd+1:128),'"') - go to 2 - end if - istart = iccount -1 itilde = istart+index(lineq(istart+1:i2nd-1),'~') - if (itilde.gt.istart.and.itilde.lt.i2nd) then -c -c Replace tilde if not preceded by \ -c - if (iend .ge. 117) then - print*,'Sorry, lyric string is too long, stopping' - call stop1() - else if (lineq(itilde-1:itilde-1) .eq. sq) then - istart = itilde - go to 1 - end if - lineqt = lineq(1:itilde-1)//sq//'lk ' - * //lineq(itilde+1:iend) - iend = lenstr(lineqt,128) - i2nd = i2nd+3 - lineq = lineqt - go to 1 - end if - if (iccount .eq. 1) then - lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq - * //lineq(i2nd+1:128) - else - lineqt = lineq(1:iccount-1)//sq//'pmxlyr{' - * //lineq(iccount+1:i2nd-1)//'}'//sq - * //lineq(i2nd+1:128) - end if - i2nd = i2nd+8 - lineq = lineqt - if (lineq(i2nd+1:i2nd+1) .eq. '@') then - lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq - * //lineq(i2nd+5:128) - lineq = lineqt - end if - return - end - subroutine inst2chan(midc,midi,midchan,nv,iinsiv,twoline) -c propagate per-instrument quantities to per-channel ones - parameter (nm=24) - integer*4 midc(0:nm),midi(nm),midchan(nm,2) - integer*2 iinsiv(nm) - logical twoline(nm) - do iv = nv, 1, -1 - if (twoline(iv)) then - midc(midchan(iv,2)) = midi(iinsiv(iv)) - end if - midc(midchan(iv,1)) = midi(iinsiv(iv)) - end do - end - - diff --git a/Build/source/utils/pmx/pmx-src/pmx298.for b/Build/source/utils/pmx/pmx-src/pmx298.for new file mode 100644 index 00000000000..dfa03633d2a --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/pmx298.for @@ -0,0 +1,26079 @@ + program pmxab +c +c This program, PMX, developed by Don Simons +c (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with +c MusiXTeX and TeX, its purpose is to allow the user to create high-quality +c typeset musical scores by including a sequence of PMX commands in an ASCII +c input file. +c +c This program is free software: you can redistribute it and/or modify +c it under the terms of the GNU General Public License as published by +c the Free Software Foundation, either version 3 of the License, or +c (at your option) any later version. +c +c This program is distributed in the hope that it will be useful, +c but WITHOUT ANY WARRANTY; without even the implied warranty of +c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +c GNU General Public License for more details. +c +c You should have received a copy of the GNU General Public License +c along with this program. If not, see . +c +c + character*9 date + character*5 version,versionc + common /comver/ versionc +c +c To compile with gfortran: +c 1. Merge all files using copy *.for epmx[nnnn].for +c 2. Search and replace all character*65536 with character*131072 +c 3. Comment/uncomment getarg lines +c 4. gfortran -O pmx[nnnn].for -o pmxab.exe +c +c To do +c Correct Rainer's email address in manual +c Linesplit (\\) in h +c Tt at start of a movement. +c Toggle midi on or off; allow midi only. +c Page number printed on 1st page even if 1 system. +c Still need inserted space for chordal accidentals +c Voicewise transposition. +c better segno +c coda +c duevolte +c Fix xtup bracket direction in 2-line staves?? (maybe leave as is) +c Sticky ornaments with shifts. +c Deal with Werner's vertical spacing thing associated with title. +c Multiple ties in midi +c Werner's missing c in MIDI due to start/stop ties on same note. +c Beams with single 64ths +c 128ths and/or dotted 64ths +c Close out MIDI with integral # of beats? +c Increase ast dimensions or redo logic. +c Does slur direction get set for user-defined single-note stem dir'ns? +c Transpose by sections. +c Optimization loop over sections only +c Command-line option to read nbarss in. Write out nbarss when optimizing. +c (or just read from .plg?) +c Beams over bar lines. +c 2-digit figures +c A real coule (slanted line between notes in a chord) +c Dotted slurs for grace notes. +c Undotted chord notes with dotted main note. +c Forced line break without line number +c Fix dot moving when 2nds in chord get flipped +c To do: increase length on notexq in dodyn +c 2.98 +c Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...) +c 2.97 +c Fix problem with beaming after new movement command +c 2.96 and 2.95 +c replace and '\','/'. and '"' with chax(); +c eliminate do loops with shared last line +c delete superfluous comments in source +c 2.94 +c Allow moving dots on main and chord note in 2-note termolos +c Add definitions of \hbp and \hbpp to pmx.tex +c 2.91 +c Tweak: insert \stdstemfalse before every user-shortened or lengthened stem. +c This cancels defaul extensions to middle line and also (with 'L') allows +c stems that are longer than 4.66 but still don't reach middle line. +c Allow alteration of number height in multibar rest, option n. +c Fix bug introduced in 2.89 so that the "o" in "mo800" is now OK. +c 2.90 +c Many tweaks to allow gaps at end or middle of a system using +c L[n]S[x] and LC[y]. New pmx.tex. +c 2.88 +c Comment out print*,"Changed pathname to..." since it was going +c iteration when optimizing linebreaks with the undocumented option Ao. +c Add nv back in as argument for getmidi, so loop transferring data +c from midivel to midvelc can be executed. This corrects bug and +c allows per-instrument change in midi velocities at the start +c of any block +c Add subroutine inst2chan to transfer midi data as noted above. Works with +c Iv but buggy when used with IT and Ib +c 2.87 +c Allow changes to and from octave treble clef. Instrument with it +c must only have one staff. +c Some fixes for beam multiplicity changes at staff jumps. Must still +c use inline for mult. increase at downward staff jump. See sjb.pmx. +c 2.84 +c Bug fix: dots in chordal seconds +c Bug fix: Initialize ihornb for non-beamed, down xtup +c Bug fix: When using "AT" with 2-note x3c rD. +c 2.83 +c Fix problems when changing to or from octave treble clef. +c Fix beaming (or not) and number location for xtups with +c multiple rests. Still some problems with number height but +c can be band-aided with number height tweak option. +c Tweak error messages for options on "R" command. +c Allow forced beam height and slope tweaks with 2-note tremolos +c Allow chordal note with 2-note tremolos, adding dots as needed. +c Fix call to ncmid in beamstrt when setting start height for beam of +c 2-note trem, by changing arg from ivx to iv +c 2.82 +c bugfix: beams with rests, not confused with xtups. +c x option after slur index to allow slurs to go from one voice to another. +c x option also for ties +c 2.81 +c Allow string of rests to end xtup +c in chordal half-note 2-note tremolo, make chord notes open. +c 2.80 +c Add 2-note tremolos +c 2.78 +c Expand bufq to 131072 bytes +c Expand maxblks tp 9600 +c Allow up to 75 pages +c Index postscript hairpins from 1 up instead of by voice #. +c Add option 'o' to forced beam for open notehead (\hb); set ipl(3) +c Add option T[n], n=1,2,3 for single stem tremolo +c 2.77 +c Enable AV+/-x+/-y to add vskip bigh before or after \eject +c 2.76 +c 2.75 +c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and +c 2 or 3 flags on shortened note. +c 2.74 +c Bugfix: allow "0" as argument of @ command on lyrics string. +c Check for and allow "\ in centered page headings with P command. +c Check for and allow "\ in text dynamics with D command. +c For lyrics string starting in xtuplet, insert check for inputting musixlyr. +c For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam +c starts with a blank rest, put '\sk' into the TeX. +c To enable high-to-both beamed etup staff-crossing chord, for blank +c rest at start of forced beam, shift \sk's from before to after \ib..; +c so \ib is at start and note in upper voice has a beam to connect to. +c Expand range of vertical xtup number shift, now stored in mult(16-22) +c Check for and allow \" within lyrics strings, for umlauts. +c 2.73 (160121) +c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as +c inline TeX. Replace all '~' inside "..." and not preceded with '\', by +c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ +c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", +c add (as type 2 string) '\\input musixlyr \' +c After inputting pathname, change any '\' to '/', for Linux compatibility. +c 2.72 (160110) +c Really finalize \mbrest...go back to 3 args to deal with clef changes. +c Fine tune centered whole bar rests to deal with clef changes +c Fix bug in wsclef when >1 staff per instrument, since \setclef +c needs to know instrument and specify clefs on all staves for that +c instrument. Ones that were not changed by user will not be printed, +c and will be kept the same as before. +c Fix bug with arpegii from one voice to another in same staff. +c 2.71 (151226) +c Finalize mbrest mods +c 2.705 +c Fix error message +c 2.704 (140614) +c Octave treble clef +c Make horizontal ornament shift (ornhshft) floating +c 2.703 (140323) +c Option v[-]n at end of any figure will alter figdrop for rest of system +c 2.702 +c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" +c 2.701 +c oC = coda (\code{10}) +c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) +c oG = new seqno +c To do: fix grace note spacing problem (partially done) +c 2.622 +c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes +c Kn[+/-...] \ignorenats at signature changes +c Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs +c before checking and setting pitch levels levson() and levsoff() +c Define midisig separately from isig. Put in common commidisig. +c Use for explicit midi signature and for accid corrections to midi piches +c in addmidi. +c 2.621 +c Make keyboard rest option work in xtuplets. Created subroutine +c chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd. +c 2.620 +c Allow user-defined rest height tweaks at start of beam. +c 2.619 +c At movement break, change \nbinstruments in \newmovement macro; add +c 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for +c to remove call to newnoi and change call to \newmovement +c 2.618 +c Add option Ac[l,4] to set vert and horiz size and offsets to properly +c center page for letter or a4 paper. +c 2.617 +c In g1etnote, change if-check for note to use index(...) instead +c of ichar(charq) since it was messing up gfortran optimizer +c After pmxa, search for and remove penultimate line / +c because it was screwing up linux-compiled versions +c Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...) +c 2.616 (111110) +c Allow hairpins to span multiple notes groups (gulps). +c 2.615+ (110810) +c Fix midi when some instruments are transposed, by subtracting +c iTransAmt(instno(iv)) from pitch values sent to via addmidi in +c make2bar.for (for main notes) and docrd (for chord notes) +c 2.615 (110725) +c Fig bug with size-setting (in topfile) when instrument has >1 staves +c 2.615 (110724) +c Make AS[0|-|s|t]... really set sizes +c 2.614 +c Mod notex.for to fix Terry's bug with raised dotted rests (caused +c by double-hboxing). +c 2.613 +c Bugfix: In pmxa, change "do while" limit to keep from overwriting instno. +c 2.612 +c Enhance AS to allow s or t for smallsize or tinysize +c 2.611 +c Error trap for "D" before any notes in a block. +c 2.610 +c Instrument-wise key changes and transposition (incomplete) +c 2.603 +c 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors +c following reading in an include file. +c 101121 Added some error messages in g1etset.for setup data +c 2.602 +c Correct slur indexing in linebreakslurs. +c Account for comment lines in line count for error messages +c 2.601 +c Bug fix: allow 24 slurs with graces +c 2.60 Changes made make it really big +c increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o +c major reprogramming, and 16 may also be a problem (icmm) +c nm=24 (voices) done +c 24 slurs done +c 24 simultaneous beams (Replace index 24 by 0, so get 0-23) +c bufq*131072 (gfortran only) +c getarg syntax (gfortran only) +c 2.523+ +c Fix voice numbering for normal dynamics and text dynamics +c 2.523 +c Version of bigpmx first posted to Hiroaki's web site. +c 2.522 +c 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it. +c With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices. +c 5/13/10 Fix log2 function +c 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. +c 2.521+ +c 091025 Enable dotting 2nd part of linebreak slur or tie. +c To adjust barno height due to linebreak slur, use \bnrs instead of +c explicitly redefining \raisebarno (pmxb) +c 2.521 +c Bugfix +c 2.520 +c 090519 Enable ligfonts (special figured bass characters) +c 2.519 +c Fix another bug which kept \sk from being output so misaligned some notes. +c 2.518 +c Fix bugs: referencing fig data, char declaration for member of +c common/comfig/ +c 2.517 +c Allow figures in voice 1 + any one other. +c 2.516 +c Allow figures in voice #2 +c 2.515+ to do: Change manual and activate rule against clef change in voice #2. +c 2.515 +c 071222 Changes in getnote to allow auto forced beams to start anywhere. +c 071206 In make2bar, shift fermataup7 to left over centered pause. +c 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line +c staff (it was screwing up vertical justification). +c n34 for tweaks to midi durations of quarter note septuplets. +c To do: In ref250.tex, the tables where 's,t,)' is explained, the line +c [+,- i] ... Vertical adjustment of the start of second segment +c should it be replaced by +c [s +,- i] ... Vertical adjustment of the start of second segment +c 2.514 +c Changes in make2bar to get horizontal spacing right when normal grace +c follows after grace +c Changes in dograce to get octaves right for any material entered inside +c \gaft, which shields transpose register changes from the outside world. +c 2.513 +c In make1bar, near end, for forced beams starting with a rest, copy hgt and +c slope tweaks to ALL notes after first, not just the second one, so if +c there's more than one rest at start the tweaks are still observed. +c In beamid and beamend, add stand-alone triply-flagged notes for xtups. +c 2.512 +c Near end of pmxb, fix error trap to allow redundant 'RD' +c Enable multiplicity down-up '][' within xtup. +c 2.511 +c Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by +c adjusteskz as in bar 7 of barsant. +c 2.510a +c Test: remove restriction on tempo changes in MIDI macros +c Send to CM for beta testing. +c 2.509+ +c To do: Correct manual on AS. "-" is for smaller staves. +c 2.510 +c Forgot to declare litq, voltxtq as character in subroutine getgrace +c 2.509 +c Corrected small bug in arpeggio shifting (ivx <= iv in call putarp) +c 2.508 +c Allow graces in xtups. New subroutine getgrace. +c 2.507 +c To do: Raise/lower figures. +c To do: Add 24, 29 to list of musicsizes in manual +c New sub adjusteskz to account for ask's when computing lengths of +c brackets for unbeamed xtups, slopes and horizontal posn's of number +c Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags +c Add look-left option for keyboard rests, "L" in rest command, set iornq(30) +c 2.506 +c Fix bug with AK, when simultaneous rests have same duration, use defaults. +c 2.505 +c Keyboard rests AK +c 2.504 +c Space after normal grace: option X[n] +c Fixed og when nv .ne. noinst, by using sepsymq instead of '&' +c (To do) length of xtup bracket when there is added non-collision space. +c Trap musicsize if .ne. 16,20,24,29. +c 2.503 +c Enable arpeggio left shift with ?-x +c To do: In manual, arpeggio over 2 staves. +c Allow musicsize of 24 and 29. Had to define meter font size explicitly, +c also change font size for text dynamics, but not much else so far. +c Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn +c was called, causing error in printing replacement number. +c 2.502 +c Incorporate Dirk Laurie's patch to use { , } , for ties. +c Figure height adjustment: append +[n] +c Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?) +c 2.501 +c Readjust horizontal offset back to .8 in LineBreakTies +c Fix zero-subscript (iudorn) in putorn +c 2.50 +c Increase number of text-dynamics (dimension of txtdynq) per block +c from 12 to 41. +c Slur option n to override altered default curvature. +c Allow default ps slur curvature tweaks with Ap+/-c +c 2.416 +c Increase length of textdynq from 24 to 128 +c (Todo) Add comment in manual about blank lines at end. +c Configuration file: Define subroutine getpmxmod, check path in environment +c variable pmxmoddir, check existence, read lines into bufq after setup. +c Increase dimension on idynn in dodyn from 4 to 10 for max number +c of marks in a bar +c Increase allowable # of lines from 2000 to 4000. +c (To do) Replace definition of \liftpausc per Olivier. +c (To do) Fix extraneous error message if RD is placed at very end. +c 2.415 +c Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt +c instead of redefining \xnum. Change font used to \smallfont (as for +c normal xtups, +c Allow slur to start on rest. +c 2.414 +c Correct bug in crdacc when adding accidental to boundary causes number of +c segments to decrease +c Special rule for 3-accidental chords: If no 2nds, place them in order +c top, bottom, middle. +c 2.413 +c Correct bugs in chordal accidentals, related to left-shifted noteheads +c (a) Special problems with downstem when main note needs shifting +c (b) Assign 0 rank to boundary segs due to left-shifted noteheads +c 2.412 +c Change default horiz shift of start of seg 2 of linebreak slurs: +c -.7 for slurs, -1.2 for ties, +c Use height of start of seg 1 slur itself for end of 1 and start of 2. +c 2.411 +c "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2. +c "s" option in start of slur/tie as precursor to vert/horiz tweaks for end +c of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2. +c With "Apl", curvature adjustments on starting slur command apply to seg 1, +c those on ending command to seg 2. +c 2.410 +c "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine +c \xnum, \unbkt, \ovbkt. +c "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is +c flag, mult(5-9) is tweak value+16 +c 2.409 +c Bugfix in docrd for MIDI: Use original pitch in case main/chord were +c switched due to 2nds. +c Remove "o" from error message for "A" command. +c New syntax: optional instrument number separator ":" in movement +c break command to precede a 2-digit instrument. +c Conditional output formats for \setname at movement break to allow +c instrument numbers >9. +c Bugfix in coding to raise barno due to slur over line break (pmxb) +c Move date/version data statement in pmxab to a better place. +c 2.408 +c Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar). +c Bug fix in \liftPAusep in notex.for and in pmx.tex +c Character variables for version and date +c For up-stem single graces slurred to down-stem, shift slur start left by +c 0.8 so slur doesn't get too short. +c Initialize and slide mult, same as other full-program variables in /all/. +c 2.407 +c Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n, +c 2.406 +c Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing +c equalization). +c Put dimensions of double sharps and flats in crdacc (for chords). +c Bugfix: Use sepsymq in LineBreakTies(..) instead of '&' +c Use only first 4 bits of mult for multiplicity+8, so rest can be used +c for other stuff. +c Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict. +c 2.405: Not published but saved for safety. +c Option Aph to write \special{header=psslurs.pro} top of each page, so +c dviselec will work OK. +c 2.404 +c Allow slur to end on rest, but not start on a rest. Efaults height +c of ending is default height of start (before any automatic or user- +c defined djustments). User may adjust height as normal from default. +c 2.403 +c Bugfix: turn off repeated beaming patterns.at end of non-last voice. +c 2.402 +c Automatic repeated forced beams. Start with "[:" End with next explicit +c forced beam or end of input block. +c Increase # of forced beams per line of music per input block from 20 to 40 +c 2.401 +c Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies. +c Makes 1st part normal shape, and starts 2nd part a little further left. +c Enable arpeggios in xtuplets. Had to make time itar(narp) a real. +c 2.40 +c Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap. +c Fix non-ps-slur input to \midslur (third signed integer). Do not reverse +c sign for down-slurs. +c 2.359 +c Add error exit subroutine stop1 to make exit status g77-compatible.. +c Absolute octave on xtup chord note was 2 octave too high, fixed in getnote +c Fermata on vertically shifted rest: special trap in putorn() to set height. +c Correct multiple grace note spacing for small staves (in dograce, +c define wheadpt1 depending on staff size) +c 2.358 +c Allow curvature corrections at start of postscript slur, in dopsslur() +c Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust +c Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h] +c Make t[ID] act like s[ID]t, most mods in spsslur(). +c Add spsslur() to read in data for ps slurs, call from getnote. +c In beamstrt, save args for SetupB in common comipb to save them for +c 2nd call when xtup starts with rest +c Add spacing for ornament ")" as if it were accidental, in make2bar(). +c Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur() +c Horiz. shift start of ps grace slur, 2 places in dograce(). +c Horiz shift end of grace slur in endslur() +c Make st slurs into postscript ties. Separate subroutine dopsslur(), +c Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.) +c Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn. +c 2.357a +c Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote +c 2.357 +c Increase dimension for # of lit TeX strings from 52 to 83. +c Allow blank rest in middle of xtuplet. Only mods in g*etnote(). +c 2.356 +c Increased some dimensions from 30 to 40 to allow up to 40 pages. +c In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt(). +c Fix parsing of "f,h,H,HH" in sslur. +c Fix bug with cdot, note-level for slur termination (in getnote) +c 2.355 +c Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], +c n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues +c Make midi recognize ps ties in doslur. +c Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote +c to get octave right. +c 2.354 +c With postscript slurs, make t-slurs real ties by inserting replacement +c macros \tieforisu, etc, defined in pmx.tex +c Check for open cresc or decresc at end of input block, using list[de]cresc +c Hairpin syntax conditional on postscript slurs. Backup to fill in start +c level, using new backfill(...). Separate height tweaks for +c start and finish. +c 2.353 +c K-0+n to transpose by half step (rather than just change key) +c Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of +c \mbrest's +c Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end +c of input block before movement break, and at start of block after +c movement break, using \newmovement rather than \setzalaligne, since +c former already redefines \stoppiece. In second case, set rptfg2='z'. +c Make clefq(nm) common between pmxb and getnote; change references in +c getnote at 'M' to array elements, setting all new clefs as you go. +c 2.352 +c Remove \parskip redefinition from pmx.tex; write it into TeX file when +c "Ae" is invoked. +c Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine +c \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH', +c translate them thru mapping to (1,4,5,6) as \midslur params, then let +c \psforts translate them back to ps slur macors. +c 2.351 +c Number slurs from 0 up instead of 11 down, anticipating postscript slurs. +c Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size. +c Increase length of basenameq to 44 characters everywhere. +c Increase dimension of mcpitch (midi-chord-pitch) to 20. +c Set default systems per page to 1 if nv>7 +c In pmxb, move place where isystpg is reset to 0, so that \eject gets +c written when there is just one system per page. +c 2.35 +c Cautionary accidentals with 'c' anywhere in note symbol. +c NEW pmx.tex with \resetsize to set size to normal or small depending on +c current \internote. Used with new coding in dograce() to get right +c new size in case user has \setsize'ed some lines to \smallvalue. For +c \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. +c Affects pmx.tex. +c Continuation figure with fractional length. May now mix with other figures. +c If another figure follow Cont-fig, separate with colon. +c 2.342 +c Bugfix in getnote to recognize relative octave shift in grace at start of +c input block. +c In make2bar, initialize islhgt=0 earlier than before (possible solution +c to Suse g77 compile problem that I could not reproduce).. +c Bugfix in beamstrt & beamn1 for r2x6 c4D d d d +c 2.341 +c Syntax check: Forced page break page number must be > than previous. +c Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb. +c 2.34 +c New pmx.tex with redefined liftpausc +c Bug fix with dotted, non-beamed xtups. +c 2.332 +c Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads. +c Allow arbitrary pos. input to W in g1etnote and getnote. +c 2.331 +c Bug-fix in dodyn(..): typo on length of arg of txtdyn +c 2.33 +c Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata() +c 2.321 +c Rescale accidental shifts. Still use 7 bits but now map (0,127) +c onto (-1.,5.35) +c Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups +c 2.32 (Noticed after posting) +c Prohibit "/" as figure. +c 2.32 (Posted) +c Tidied up accidentals in chords, do spacing. +c Still to do: +c check for "(" on chord notes in spacing algo +c small accids +c double accids +c autoshift slurs +c 2.310 +c Extra call to precrd ahead of spacing chk, and single-note crd/acc +c shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time. +c 2.309 +c Alternate algo for accid shifts in chords. +c 2.308 +c Auto horiz. notehead shifting added to precrd. +c 2.307 +c Auto shifting of multiple accidentals in chords. +c "Ao" in main chord note to keep accidentals in order. Set nacc(28). +c If there are any manual main or chord note shifts, then +c If any manual shift is preceded by "A" then +c 1. Auto-shifting proceeds +c 2. "A"-shifts add to autoshifts +c 3. non-"A" shifts are ignored! +c Else (>0 man shifts, none has "A") +c No auto-ordering, No autoshifts, +c End if +c End if +c 2.306 +c Initialize legacy note level to middle C in case user forgets to set +c octave. +c Shift xtup note? +c Shift in elemskips rather than noteheads? +c 2.305 +c Stop pmxb from multiple endvolta's at start of new page. +c 2.304 +c "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on +c for multiple notes in the voice, "S:" last shortened note. +c 2.303 +c vshrink stuff all OK? Description is in pmxb. +c 2.302 +c Toggle vshrink with "Av". vshrink normally kicks in when \interstaff +c hits 20. This still needs work. +c Add " /" to last line if last char is not % or /. +c 2.301 +c Check in beamn1 for single note before multiplicity down-up. +c allow '.PMX' as well as '.pmx' +c 2.299 +c Correct typo in pmxb involving PMXbarnotrue. +c Replacement printed number for xtup: Unsigned integer after 'n' after 'x' +c Minor upgrade parsing xtuplet options 'x...' +c Correct dimension of nxtinbm in make2bar. +c 2.298 +c Account for doubled xtup notes in subroutine getx (user-defined spaces), +c by adding ndoub as an argument.. +c 2.297 +c Created and solved compiler problem. Put drawbm(NM) in its own common. +c Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar +c when \centerbar is used. +c Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX +c use right 2nd and 3rd args for \mbrest when key, meter, or clef changes. +c 2.296 +c Correct printed numbers for forced beams with multiple xtups. For each beam +c make list in setupb by voice of eloff (h-offset) and mtupv (printed #) +c Increase lengths of jobname and infileq by 20 characters +c Enable whole notes and breves as 1st or last note of xtup in beamn1 and +c beamend, and wholes in beamid. +c 2.295 +c Midi balance Ib[n1]:[n2]:...[nn] +c Single-slope beam groups [...]-[...] +c Trap "i" unless after accidental (main notes, xtups, chord notes) +c 2.294 +c Unequal xtups with "D" to double a note in an xtup. +c As above, "F" will (a) increase multiplicity by 1 for marked note and next +c one and (b) add a dot to the first one. +c Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on +c when "." is encountered, then correcting beam start time.(end of getnote) +c MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]... +c 2.293 +c Check for single notes spanning bar lines. +c Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup +c must be set in make2bar since beamstrt is not called, fixing problem with +c dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix +c problem when >2 staves. +c Add nodur to args of dodyn, so can check if stemless and avoid height tweak +c Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak +c 2.292a +c Undo syntax check for Type 2 or 3 TeX string starting in column 1. +c Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! +c 2.292 +c Allow comments in xtuplets +c Enable multiple octave jumps in grace notes. +c Allow dynamics in xtuplets. +c Fix bug in getdyn searching for end of text string (correct length of lineq +c to 128) +c Fix bug in dodyn, must ignore horiz. interaction tweak for +c user-text (idno = 0) +c Syntax check for Type 2 or 3 TeX string starting in column 1 +c (NOTE: later undone!) +c Syntax check for page number > npages at forced line break. +c 2.291 +c Fix error in AS command (accid spacing for small systems), making only +c one spec per staff, nv total. +c Stop using MIDI channel 10 +c 2.29 +c Fix error in console output format for # of bytes used in MIDI file. +c Fix bug in dograce so no space is added between grace and main note when +c there is a MIDI-only accidental. +c Fix bug so oes?+4 works. It was too ugly to explain. +c ...Different ways of storing accidental specs on input and output. +c No longer zap \writezbarno in special situations. +c Fix bug in dyntxt level on rest +c Line spacing equalization. Add macros \starteq, \endeq, \spread, etc. +c Activate with Ae. (Maybe later could input alternate values for +c \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1 +c in the page, and \endeq on 1st note of next-to-last line in page. +c 2.28 +c Flip direction of forced beam "[f..." +c Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) +c Fix bug in sliding ip's for txtdyn's +c In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99) +c 2.27 +c Comment out lines in dodyn checking number of dynamic marks found. Voice +c order may not be monotonic if two lines on a staff. +c Literal dynamic: D"[text]" +c 2.26 +c Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn, +c increasing dimension of idynn to 4 to allow 4 symbols on same note. +c Increase voltxtq length from 10 to 20. +c AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough +c accounting for ast's is done by defining effective headwidth +c whead1 in makebar2 to be 0.8*whead. +c 2.25 +c Fix logic bug with sepsym's when # of instruments changes. +c Slight increases in default offsets for hairpin starts after "p" +c 2.24 +c Hairpins D< or D> as toggle. +c Many automatic position tweaks for letter-group dynamics and hairpins. +c 2.23 +c Continued rhythmic shortcuts: space followed by "." or "," +c 2.22 +c In call to doslur, change tno(...) to tnote(...). This was only +c used when checking to slurs per stem directions, and should have been +c the note duration all along. +c MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. +c Use "i" anywhere in note symbol. +c 2.21 +c Increase from 20 to 30 dimensions for movement breaks and midi sections. +c Fix out-of-order declarations per mutex comments +c Add "Bad error" and "Kluging" messages to log file. +c 2.197 +c add /comips/ to save tie-check midi variables +c For spacing of clef changes at start of input block, changed integer time +c lastnodur to prevtn, so it works with xtups. Possible incompatibility! +c 2.196 +c Fix Ickbug with time check in ncmid() +c Interchange \fermataup7 and \pausec to get proper alignment +c Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX. +c Add defn's of \hsp, \hspp to pmx.tex +c Fix pre-slurs on xtup chord notes. +c Fixed raised PAuse, define \liftPAuse +c Replace \zbreve\sk with \breve. +c Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what +c about "o" and 1 as shorthand for 16???? Search for "Kluge" +c Added "vo" (voice) as MIDI instrument 55 +c Allow 3-digit page numbers (search for "toppageno") +c Fix bug caused by prior fix (cancelling accid after bar line was ignored). +c Fix double accids in chords +c 2.194 +c Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if +c block. +c Add meter to MIDI file with every pause +c Purify FORTRAN? +c 2.193 +c Increased # of in-line TeX strings from 36 to 52. +c Fix entry of # of bytes in header of tempo/meter/key track to allow >255. +c 2.191 +c Event track: Tempos, meters, keys all together. Data in comevent +c 2.15 +c Pretty good midi capability. Still no attention to slurs on chord notes. +c 2.11 +c 11 Dec 99 c rm1 +c 11 Dec 99 "oes?", "oe?" +c 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes +c 11 Dec 99 Error message for shifted, repeated ornaments. +c 2.10 (Version 2.1) +c Fix bug with lowdot and xtuplets +c 2.09 +c Fix bug with multiple ornament heights over beams, when one is . or _ +c Error message from pmxa if rest on last note of xtup. +c Enable 12 slurs. +c Reinstate multiple rests at start of xtup. +c 2.07 +c Combine consecutive type-1 TeX strings. +c \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's. +c Fixed breve chord notes in docrd +c Check irest(28) as well as vxtup when setting nodur for chord notes, since +c vxtup isn't set until 1st *main* note in xtup +c Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing. +c 2.06+ +c Make deterministic the beam slope calculation when there are an even # of +c slopes in list and middle two are equal magnitude but opposite sign. +c pmxa Trap for "o:" before 1st note in block +c Partial bug fix for 64th notes in xtuplets. +c Make ixrest a vector, since with new time scheme may not finish xtup in +c same notes block. +c Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb) +c 2.06 +c Account for changes in nv when computing \interstaff. Add a counter +c nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever +c setting isysflb(iflb). Note nv can only change at a forced line break. +c Note also, iflb starts at 0! +c 2.05 +c Automatic start of new notes group with part 2 of staff-jump beam +c In make1bar, set irest bit 29 of lowest-voice note at same time, +c use as flag when making notes groups. +c For now, remove dummy blank line at end...it zaps terminal repeats. +c 2.02 +c Fixed slur-counting bug for multiple, slurred, aftergraces. +c 2.01 +c Increase to ask(1400) +c Increase max forced page breaks to 18 +c Define pausc for centered pause +c 2.0a +c Insert dummy blank line at very end to handle input files w/o terminal CR-LF +c pmx03r +c Option m[n] in S symbol to change musicsize (for parts) +c Double dotted rests now work. +c Write file name to log file +c Check existence of input file +c Allow 24-char jobname, may end with ".pmx" +c Comment out time stuff +c Replace 3-argument getarg with 2-argument + iargc +c Fix bug with negative noinst due to nint<=int replacement +c move lovation of iv in isdat1 to allow iv>7. +c Set nm=12 +c pmx03q +c replace int(x+.001) with nint(x) +c Write TeX file name to screen and to pml. +c Replace char(...) with chax(...) to sovle msdev bug. +c Bug fix: macro terminations when M is on a line by itself. +c Bug fix: don't accumulate space for XS in pmxa. +c Streamline Macros: use pointers to bufq instead of scratch files +c pmx03p +c Store input file in single character array bufq. +c lbuf(i)*2 is length of line i +c ipbuf is position just before next line to be read. +c pmx03 +c Optimize read/writes +c pmx02 +c Fix line count (for errors) when there are saved macros +c pmx01 +c In optimize mode, open/close macros (Watch out for residual zz files!) +c Command line input +c Option Ao to optimize, otherwise normal processing +c +ccccccc + parameter (nks=125,nm=24,mv=24576,maxblks=9600) + character*128 lnholdq + character*131072 bufq + integer*2 lbuf(maxblks) + common /comevent/ miditime,lasttime + logical slmon,dbltie + common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), + * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, + * slmon(0:nm),dbltie + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + integer*2 iinsiv + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + common /commus/ musize,whead20 + integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks) + real*4 poe0(nks),poe(nks) + logical isfirst,optimize + logical*4 fexist + character*44 jobname + character*47 infileq + common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), + * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, + * idum,itsofar(nm),nib(nm,15),nn(nm), + * rest(nm,200),lenbr0,lenbr1,firstline,newmeter + logical rest,firstline,newmeter + common /comdiag/ n69(0:nm),n34(0:nm) + logical mmacrec,gottempo + common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, + * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), + * mmacrec,gottempo + common /truelinecount/ linewcom(20000) +c +c Added 130302 only to get nsperi from g1etnote, for use in midi setup +c + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + logical lastchar,fbon,issegno,isheadr,isvolt + character*1 chax +c +c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing +c nmidsec section starts and stops based on PLAYING macros (not recording). +c +ccccccccccccccccccccccccc +c + data date /'12 Dec 21'/ + data version /'2.98'/ +c +ccccccccccccccccccccccccc + data maxit,ncalls /200,0/ + data isfirst /.true./ +c itstart = mytime() + versionc = version +c +c Initialize midi parameters +c + gottempo = .false. + ismidi = .false. + debugmidi = .false. + relacc = .false. + mmacrec = .false. + nmidsec = 1 + mgap = 10 + miditime = 0 + lasttime = 0 + nmidcrd = 0 + nusebl = 0 + notmain = .false. + do 3 ivx = 1 , nm + twoline(ivx) = .false. + midinst(ivx) = 6 + midivel(ivx) = 127 + midibal(ivx) = 64 + miditran(ivx) = 0 +3 continue + do 12 icm = 0 , nm + imidi(icm) = 0 + restpend(icm) = .false. + trest(icm) = 0. + levson(icm) = 0 + levsoff(icm) = 0 + slmon(icm) = .false. + naccbl(icm) = 0 + n69(icm) = 0 + n34(icm) = 0 + msecstrt(icm,1) = 1 +12 continue +c +c End of midi parameter initialization +c + musize = 0 + optimize = .false. + numargs = iargc() + if (numargs .eq. 0) then + print*,'You could have entered a jobname on the command line,' + print*,' but you may enter one now:' + read(*,'(a)')jobname + numargs = 1 + else +c call getarg(1,jobname,idum) ! May need to replace this w/ next line + call getarg(1,jobname) + end if +10 ljob = lenstr(jobname,44) + if (ljob .gt. 44) then + print*,'Jobname is too long. Try again.' + call stop1() + else if (ljob .eq. 0) then + print*,'No was jobname entered. Try again.' + call stop1() + else if (numargs .eq. 2) then + if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then + optimize = .true. +c call getarg(2,jobname,idum) ! May need to replace this w/ next line + call getarg(2,jobname) + numargs = 1 + go to 10 + else + print*,'Illegal option on command line' + call stop1() + end if + end if +c +c Strip ".pmx" if necessary +c + ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX')) + if (ndxpmx .gt. 0) then + jobname = jobname(1:ndxpmx-1) + ljob = ljob-4 + end if +c +c Check for existence of input file +c + infileq = jobname(1:ljob)//'.pmx' + inquire(file=infileq,EXIST=fexist) + if (.not.fexist) then + inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist) + if (.not.fexist) then + print*,'Cannot find file '//infileq + call stop1() + else + infileq = jobname(1:ljob)//'.PMX' + end if + end if +c +c Open a log file +c + open(15,file=jobname(1:ljob)//'.pml') + call printl('This is PMX, Version '//version//', '//date) + ljob4 = ljob + call printl('Opening '//infileq) + open(18,file=infileq) +c +c Copy input file into common buffer +c + ipbuf = 0 + linewcom(1) = 1 + do 8 ilbuf = 1 , maxblks + ncomments = 0 +14 read(18,'(a)',end=9)lnholdq + lbuf(ilbuf) = lenstr(lnholdq,128) + if (lbuf(ilbuf) .eq. 0) then +c +c Blank line. Make it a single blank with length 1 +c + lbuf(ilbuf) = 1 + lnholdq = ' ' + end if +c +c Now line has at least one non blank character. Check for comment +c As of Version 260, do not copy comments into bufq +c But need to count %'s for error messaging +c if (lnholdq(1:1).eq.'%') go to 14 + if (lnholdq(1:1).eq.'%') then + ncomments = ncomments+1 + go to 14 + end if +c +c When here, have counted all preceding comments and have a real line +c + if (ilbuf .gt. 1) then + linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments + else + linewcom(1) = 1+ncomments + end if + if (ipbuf+lbuf(ilbuf).gt.131072) then + print*,'Too many characters in file, stopping' + call stop1() + end if + bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq + ipbuf = ipbuf+lbuf(ilbuf) +8 continue + call printl('Too many lines in input file') + call stop1() +9 continue +c +c Insert dummy line to handle input files w/o CR-LF at end. +c + nlbuf = ilbuf-1 +c nlbuf = ilbuf +c bufq(ipbuf+1:ipbuf+3) = ' / ' +c lbuf(nlbuf) = 3 + close(18) + do 6 numit = 1 , maxit + if (optimize) call printl('Starting an iteration') +c +c When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. +c Otherwise, nbars0 is the input +c When islast=.false., pmxb only returns poe's, otherwise does whole job +c + call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize) + if (.not.optimize) then + if (ismidi) then +c +c This was moved here from writemidi 130302 to allow midivel,bal,tran, to be +c set up here as functions of instrument rather than iv (staff). +c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) +c + nstaves = 0 + ivt = 0 + do 16 iinst = 1 , nm + nstaves = nstaves+nsperi(iinst) + do 17 ivtt = 1 , nsperi(iinst) + ivt = ivt+1 + iinsiv(ivt) = iinst +17 continue + if (nstaves .eq. nv) go to 18 +16 continue + print*,'Screwup!' + call stop1() +18 continue +c +c Set up channel numbers for midi. +c + numchan = 0 + do 11 iv = nv , 1 , -1 + if (twoline(iv)) then + midchan(iv,2) = numchan + numchan = numchan+1 + end if + midchan(iv,1) = numchan + numchan = numchan+1 +11 continue +c +c numchan will now be the number of channels, but max channel # is numchan-1 +c +c Set up velocities, balances, and midi-transpositions +c + do 13 iv = nv , 1 , -1 + if (twoline(iv)) then +c 130302 Make these functions of instrument rather than staff (iv) + midvelc(midchan(iv,2)) = midivel(iinsiv(iv)) + midbc(midchan(iv,2)) = midibal(iinsiv(iv)) + midtc(midchan(iv,2)) = miditran(iinsiv(iv)) + end if + midvelc(midchan(iv,1)) = midivel(iinsiv(iv)) + midbc(midchan(iv,1)) = midibal(iinsiv(iv)) + midtc(midchan(iv,1)) = miditran(iinsiv(iv)) +13 continue + end if +c +c TEMPORARY!!! +c + write(15,*)'nlbuf: ',nlbuf + ip1 = 1 + do 10000 ilb = 1 , nlbuf + ip1 = ip1+lbuf(ilb) +10000 continue + iplast = ip1-1 +c +c Check to see if (1) last line is "/" and (2) next to last +c line is "/" +c + if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then + if(bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.chax(47))then + print*,'Removing last line of "/"' + write(15,*)'Removing last line of "/"' + nlbuf = nlbuf-1 + end if + end if +c + call pmxb(.true.,poe0,ncalls,optimize) + if (ismidi) then +c +c Write midi file +c + open(51,file=jobname(1:ljob)//'.mid') + if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm') + call printl(' ') + call printl('Writing '//jobname(1:ljob)//'.mid') + call writemidi(jobname,ljob) + end if + close(15) + stop + end if + write(15,*)'nlbuf: ',nlbuf + ip1 = 1 + call pmxb(.false.,poe0,ncalls,optimize) + call poestats(nsyst,poe0,poebar0,devnorm0) +c +c Save initial deviation and line breaks for later comparison +c + if (numit .eq. 1) then + devpmx = devnorm0 + do 20 isys = 1 , nsyst + nbari(isys) = nbars0(isys) +20 continue + end if + call sortpoe(nsyst,poe0,ipoe) + do 1 iupord = nsyst , 1 , -1 + isysu = ipoe(iupord) + print*,'isysu=',isysu + write(15,*)'isysu=',isysu +c +c Skip if system isysu has poe0 < avg or isysd has poe0 > avg +c + if (poe0(isysu).lt.poebar0) go to 1 + do 5 idnord = 1 , nsyst + isysd = ipoe(idnord) + if (isysu.eq.isysd .or. nbars0(isysd).eq.1 + * .or. poe0(isysd).gt.poebar0) go to 5 + do 2 isyst = 1 , nsyst + nbars(isyst) = nbars0(isyst) + if (isyst .eq. isysu) then + nbars(isyst) = nbars(isyst)+1 + else if (isyst .eq. isysd) then + nbars(isyst) = nbars(isyst)-1 + end if +2 continue + call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize) + call pmxb(.false.,poe,ncalls,optimize) + call poestats(nsyst,poe,poebar,devnorm) + if (devnorm .lt. devnorm0) then + devnorm0 = devnorm + poebar0 = poebar + do 4 isys = 1 , nsyst + nbars0(isys) = nbars(isys) + poe0(isys) = poe(isys) +4 continue + print*,'Improved with iup,idown,devnorm:', + * isysu,isysd,devnorm0 + write(15,*)'Improved with iup,idown,devnorm:', + * isysu,isysd,devnorm0 + write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) + write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) + call sortpoe(nsyst,poe0,ipoe) + go to 6 + end if +5 continue +1 continue +c +c If we get here, must have gone thru all switches and found nothing better, +c so done! +c + go to 7 +6 continue +7 continue + print*,'Optimum located, numit:',numit,', ncalls:',ncalls + write(15,*)'Optimum located, numit:',numit,', ncalls:',ncalls + print*,'Final error:',devnorm0,', initial error:',devpmx + write(15,*)'Final error:',devnorm0,', initial error:',devpmx + print*,'Percentage improvement:',100.*(1-devnorm0/devpmx) + write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx) + call printl('Initial bars/system:') + write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst) + write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst) + call printl('Final bars/system:') + write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) + write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) + call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize) + call pmxb(.true.,poe0,ncalls,optimize) + close(15) + end + subroutine accsym(nacc,acsymq,lacc) + character*3 acsymq + iacc = iand(nacc,7) + if (iacc .eq. 1) then + acsymq = 'fl' + lacc = 2 + else if (iacc .eq. 2) then + acsymq = 'sh' + lacc = 2 + else if (iacc .eq. 3) then + acsymq = 'na' + lacc = 2 + else if (iacc .eq. 5) then + acsymq = 'dfl' + lacc = 3 + else if (iacc .eq. 6) then + acsymq = 'dsh' + lacc = 3 + else + print*,'bad accidental: ',iacc + end if + return + end + subroutine addask(taskn,waskn,elaskn, + * fixednew,scaldold,tglp1,scfac,isudsp) + parameter (nm=24) + logical isudsp + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + common /comtol/ tol + scoarg = scaldold*scfac + if (isudsp) then +c +c Find which udsp we're dealing with +c + do 1 iudsp = 1 , nudsp + if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2 +1 continue + print*,'You should note BEEE here in addask!' + call stop1() +2 continue +c +c Fixednew and scaldold must not be changed, since udsp's are already included +c in fsyst from pmxa, and udsp don't involve scaled space.. +c + if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then +c +c Must add user-defined space to what's there already. +c + wask(naskb) = wask(naskb)+udsp(iudsp) + else +c +c This place has no other space. +c + naskb = naskb+1 + task(naskb) = taskn + wask(naskb) = udsp(iudsp) + elask(naskb) = 0. + end if + else +c 130330 start + oldwask = 0. + oldelask = 0. +c 130330 end +c +c This is a normal space, no effect if smaller than existing space +c + if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then +c +c We already put in some space at this time +c Check if new one needs more space than old one at same time +c + if (waskn .gt. wask(naskb)) then +c +c 130330 We were double counting the larger space when it came 2nd +c Need to fix but don't see how yet. Assume times came in order and +c that last naskb defined spaces that need updating +c + oldwask = wask(naskb) + oldelask = elask(naskb) +c End of 130330 insertions + naskb = naskb-1 + else + return + end if + end if + naskb = naskb+1 + task(naskb) = taskn + wask(naskb) = waskn + elask(naskb) = elaskn +c 130330 start +c fixednew = fixednew+waskn +c scaldold = scaldold+elaskn + fixednew = fixednew+waskn-oldwask + scaldold = scoarg+elaskn-oldelask +c 130330 end + end if + return + end + subroutine addblank(noteq,lnoten) + character*8 noteq + character*1 tchar + tchar = noteq(1:1) + noteq = ' '//tchar + lnoten = 2 + return + end + subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd) + parameter (nm=24) + integer nfb(nm) + common /comtol/ tol + real*4 t1fb(nm,20),t2fb(nm,20) + character*1 ulfbq(nm,20) + ifbadd = 1 + nfb(iv) = nfb(iv)+1 + do 1 ifb = nfb(iv)-1 , 1 , -1 + if (tnew .lt. t1fb(iv,ifb)-tol) then + t1fb(iv,ifb+1) = t1fb(iv,ifb) + t2fb(iv,ifb+1) = t2fb(iv,ifb) + ulfbq(iv,ifb+1) = ulfbq(iv,ifb) + else + ifbadd = ifb+1 + go to 2 + end if +1 continue +2 continue + t1fb(iv,ifbadd) = tnew + ulfbq(iv,ifbadd) = 'x' + return + end + subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest) +c subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest) + parameter(nm=24,mv=24576) + integer*2 mmidi,itk(25) + integer*4 itiesav(5,100) + character*1 notenumq + logical endrest,eximacc,it1found + logical rest + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + integer*2 iinsiv + logical slmon,dbltie + common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), + * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, + * slmon(0:nm),dbltie + common /comevent/ miditime,lasttime + common /comdiag/ n69(0:nm),n34(0:nm) +c common /commidisig/ midisig(nm) +c +c Following variables are local but must be saved. I hope they are. +c (3/18/00) With g77 they are not, so add a common block here. +c +c integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12) + integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15) + common /comips/ ipslon,lusebl,jusebl +c data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/ + data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/ +c +c Cancel out barline accidentals if there's a rest. +c + if (rest) naccbl(icm) = 0 +c +c Special path to insert dummy rest at end of a section +c + if (endrest) go to 20 +c + do 7 ion = 0 , nmidcrd +c +c check if this is only to get pitch of a chord note +c + if (notmain) go to 6 +c +c check for rest +c + if (rest) then +c +c Will not put in a note, but must update timing +c + if (.not.restpend(icm)) then +c +c First rest in sequence, save the time +c + restpend(icm) = .true. + trest(icm) = time + else + trest(icm) = trest(icm)+time + end if +c +c Note: code checkers don't like the above due to calling addmidi(trest(icm)) +c but this only happens if rest at end of section (endrest=.true.) (called +c from getmidi(), in which case these above lines are bypassed. +c + call chkimidi(icm) + return + end if +c +c time tics +c + if (imidi(icm).gt.0 .and. ion.eq.0) then + idur = mgap + else + idur = 0 + end if + if (restpend(icm)) then + restpend(icm) = .false. + idur = idur+nint(15*trest(icm)) + end if +c +c time to start of note +c + idurvar = isetvarlen(idur,nby2on) + if (nby2on .gt. 4) then + print*,'You got >4 bytes, something is bogus.' + call stop1() + end if + imidi(icm) = imidi(icm)+1 + do 2 i = 1 , nby2on +c +c imidi points to cell before highest (leftmost) byte. Start with lowest byte +c at far right, fill in backwards +c + mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256) + if (nby2on .gt. 1) idurvar = idurvar/256 +2 continue + imidi(icm) = imidi(icm)+nby2on-1 +c +c Note-on signal +c + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = 9*16+icmm(icm) +c +c Entry point for chord note pitch determination +c +6 continue +c +c Get midi pitch. On chord iteration, only do this first time (main note), +c since pitch was already computed for nonmain chord notes. +c + if (ion .eq. 0) then + ipsav = nolev*12./7+11 + ipsav0 = ipsav + if (midisig .ne. 0) then +c +c Adjust for signature +c + notenumq = char(48+mod(nolev,7)) + if (midisig.ge.index('4152630',notenumq)) then + ipsav = ipsav+1 + else if (-midisig.ge.index('0362514',notenumq)) then + ipsav = ipsav-1 + end if + end if +c +c Deal with accidentals. +c +c iacc 0 1 2 3 4 5 6 7 +c effect X fl sh na X dfl dsh X +c iashft X -1 1 0 X -2 2 X +c + jacc = 0 + eximacc = .false. + if (iacc .gt. 0) then +c +c Adjust key-sig-adjusted pitch for explicit accidental (and exit) +c + jacc = iashft(iacc) + eximacc = .true. + if (.not.relacc) jacc = jacc+ipsav0-ipsav +c +c (Above) Shift applies to diatonic pitch but will be added to adjusted one +c + else if (naccim(icm) .gt. 0) then +c +c Possible implicit accidental from earlier in the bar +c Check for prior accid in this bar at this note level +c + do 3 kacc = 1 , naccim(icm) + if (laccim(icm,kacc) .eq. nolev) then + jacc = jaccim(icm,kacc) + eximacc = .true. + if (.not.relacc) jacc = jacc+ipsav0-ipsav + go to 4 + end if +3 continue +4 continue + end if +c +c Must split off the following if block from those above because chord +c notes can cause naccim>0, forcing us to miss other chord note's +c accross-bar-line accidental +c + if (naccbl(icm).gt.0 .and. .not.eximacc) then +c +c Possible carryover accid from prior bar (or prior same-pitch note). +c + do 21 kacc = 1 , naccbl(icm) + if (laccbl(icm,kacc) .eq. nolev) then + jacc = jaccbl(icm,kacc) +c +c Since we are *using* the bar-line accid, must flag it to be saved for next. +c + nusebl = nusebl+1 + jusebl(nusebl) = jacc + lusebl(nusebl) = nolev + if (.not.relacc) jacc = jacc+ipsav0-ipsav + go to 22 + end if +21 continue +22 continue + end if + ipsav = ipsav+jacc + end if + if (notmain) then + mcpitch(nmidcrd) = ipsav +c +c Save pitch for tie checks +c + if (levson(icm).eq.nolev.and..not.slmon(icm)) + * ipslon(icm) = ipsav + else + imidi(icm) = imidi(icm)+1 + if (ion.eq.0) then + mmidi(icm,imidi(icm)) = ipsav + if (levson(icm).eq.nolev.and..not.slmon(icm)) + * ipslon(icm) = ipsav + else + mmidi(icm,imidi(icm)) = mcpitch(ion) + end if + end if + if (ion .eq. 0) then +c +c Only record accids for non-chords, main chord note during chord iteration +c and chordnotes on first call but not during iteration +c + if (iacc.gt.0) then +c +c Set marker for accidental for possible continuations later this bar +c but first check and clear earlier ones on same note. +c + do 23 kacc = 1 , naccim(icm) + if (laccim(icm,kacc) .eq. nolev) then + do 24 macc = kacc , naccim(icm)-1 + laccim(icm,macc) = laccim(icm,macc+1) + jaccim(icm,macc) = jaccim(icm,macc+1) +24 continue + go to 25 + end if +23 continue + go to 26 +25 continue + naccim(icm) = naccim(icm)-1 +26 continue +c +c Flag new accidental +c + naccim(icm) = naccim(icm)+1 + laccim(icm,naccim(icm)) = nolev + jaccim(icm,naccim(icm)) = iashft(iacc) + end if +c +c Bail if this is a chord note on the first call (from docrd) +c + if (notmain) then + call chkimidi(icm) + return + end if + end if +c +c Vel +c + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = midvelc(icm) + call chkimidi(icm) +7 continue +c +c For tie checks +c + if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm) +c +c Entry point for special rests at section ends (endrest=T) +c +20 continue +c +c Now insert all the ends +c + do 8 ioff = 0 , nmidcrd + if (ioff .eq. 0) then +c +c time to end +c + idur1 = nint(15*time) + if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then + idur = idur1-mgap + else + idur = idur1 + end if +c +c Deal with roundoff problems with 7-tuplets on half or quarters +c + if (idur1 .eq. 69) then + n69(icm) = n69(icm)+1 +c if (mod(n69(icm)+6,7) .gt. 3) idur = 58 + if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1 + else if (idur1 .eq. 34) then + n34(icm) = n34(icm)+1 + if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1 + end if + idurvar = isetvarlen(idur,nby2off) + if (nby2off .gt. 4) then + print*,'You got >4 bytes, something is bogus.' + call stop1() + end if + imidi(icm) = imidi(icm)+1 + call chkimidi(icm) + do 1 i = 1 , nby2off + mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256) + if (nby2off .gt. 1) idurvar = idurvar/256 +1 continue + imidi(icm) = imidi(icm)+nby2off-1 + else +c +c Inserting end of chord note, delta time is 0 +c + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = 0 + end if +c +c Note off +c + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = 8*16+icmm(icm) +c +c Pitch +c + imidi(icm) = imidi(icm)+1 + if (ioff .eq. 0) then + mmidi(icm,imidi(icm)) = ipsav + else + mmidi(icm,imidi(icm)) = mcpitch(ioff) + end if +c +c Vel +c + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = 0 + call chkimidi(icm) + if (endrest) then + return + end if +8 continue + naccbl(icm) = nusebl + if (nusebl .gt. 0) then +c +c Fix tables of "bar-line" accids that are saved due to consecutive notes. +c + do 30 kacc = 1 , nusebl + laccbl(icm,kacc) = lusebl(kacc) + jaccbl(icm,kacc) = jusebl(kacc) +30 continue + nusebl = 0 + end if +c +c Begin tie checks +c + if (slmon(icm)) then +c +c Prior note had a slur start +c + if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then +c +c We have a tie! (Assumed there would be no accidental on tie-ending note) +c Make a list of times of all events back to the one starting at imidso+1, +c which is at or before where the tie started. Ident tie start and stop by +c comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) +c Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial +c time. + nsav4tie = 0 + imidt = imidso(icm) +10 nsav4tie = nsav4tie+1 + itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes) + imidt = imidt+nbytes + do 11 j = 1 , 3 + itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j) +11 continue + imidt = imidt+3 + if (nsav4tie .eq. 1) then + itiesav(5,1) = itiesav(1,1) + else + itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+ + * itiesav(5,nsav4tie-1) + end if + if (imidt .ne. imidi(icm)) go to 10 +c +c Find which two pitches agree with saved slur pitch. +c + it1found = .false. + do 12 it2 = 1 , nsav4tie + if (itiesav(3,it2) .eq. ipslon(icm)) then + if (it1found) go to 13 + it1 = it2 + it1found = .true. + end if +12 continue + call printl( + * 'Program error, tied notes, send source to Dr. Don') + it1 = nsav4tie+1 + it2 = nsav4tie+1 +13 continue +c +c List the positions we want to keep +c + jsav = 0 + do 14 isav = 1 , nsav4tie + if (isav.eq.it1 .or. isav.eq.it2) go to 14 + jsav = jsav+1 + itk(jsav) = isav +14 continue + nsav4tie = nsav4tie-2 +c +c Now dump events it1 & it2, recompute times, restack mmidi. +c + imidi(icm) = imidso(icm) + do 15 isav = 1 ,nsav4tie + if (isav .eq. 1) then + idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes) + else + idurvar = isetvarlen(itiesav(5,itk(isav))- + * itiesav(5,itk(isav-1)),nbytes) + end if + imidi(icm) = imidi(icm)+1 + do 16 i = 1 , nbytes + mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256) + if (nbytes .gt. 1) idurvar = idurvar/256 +16 continue + imidi(icm) = imidi(icm)+nbytes-1 + do 17 i = 2 , 4 + imidi(icm) = imidi(icm)+1 + mmidi(icm,imidi(icm)) = itiesav(i,itk(isav)) +17 continue +15 continue + end if + slmon(icm) = .false. + levsoff(icm) = 0 + if (.not.dbltie) levson(icm) = 0 + end if + if (levson(icm).gt.0) slmon(icm) = .true. + if (nmidcrd .gt. 0) nmidcrd = 0 + call chkimidi(icm) + return + end + subroutine addstr(notexq,lnote,soutq,lsout) + common /comlast/ islast,usevshrink + logical islast,usevshrink + character*(*) notexq + character*80 soutq + if (lsout+lnote .gt. 72) then + if (islast) write(11,'(a)')soutq(1:lsout)//'%' + lsout = 0 + end if + if (lsout .gt. 0) then + soutq = soutq(1:lsout)//notexq(1:lnote) + else + soutq = notexq(1:lnote) + end if + lsout = lsout+lnote + return + end + subroutine adjusteskz(ib,istart,poenom) +c +c For block ib, this adds accidental spaces to eskz, for use in getting +c length of xtup bracket and slopes of brackets and beams. +c + parameter (nm=24) + common /comas1/ naskb,task(40),wask(40),elask(40) + integer*4 istart(80) + common /comnsp/ space(80),nb,prevtn(nm), + * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,isfig + common /comeskz2/ eskz2(nm,200) + common /comtol/ tol + common /comntot/ ntot + inmin = istart(ib)+1 + do 10 iaskb = 1 , naskb + if (task(iaskb) .lt. to(istart(ib))-tol) go to 10 + eskadd = wask(iaskb)/poenom-elask(iaskb) + do 11 in = inmin , ntot + if (to(in) .gt. task(iaskb)-tol) then + eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd + if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1 + else + inmin = inmin+1 + end if +11 continue +10 continue + return + end + subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0) + logical figbass,ispoi,topmods,istype0,done,isbbm + common /comhsp/ hpttot(176) + common /compoi/ ispoi + common /combbm/ isbbm + common /comas3/ ask(2500),iask,topmods + character*40 pathnameq + character*44 basenameq + character*1 sq,chax + character*129 outq + sq = chax(92) + open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex') +c +c Transfer first 5 lines of main internal TeX file +c + do 11 il = 1 , 5 + call moveln(11,12,done) +11 continue + if (istype0) then +c +c Transfer literal TeX stuff from special scratch file +c + rewind(17) +10 call moveln(17,12,done) + if (.not.done) go to 10 + close(17) + end if +c +c Transfer next 2 lines from main scratch file +c + do 3 il = 1 , 2 + call moveln(11,12,done) +3 continue + if (ispoi) write(12,'(a)')sq//'input musixpoi' + if (isbbm) write(12,'(a)')sq//'input musixbbm' + if (figbass) then +c +c Transfer .fig data from scratch (unit 14) into external .tex (unit 12) +c +4 call moveln(14,12,done) + if (.not.done) go to 4 + close(14) + end if + iask = 0 + ihs = 0 +1 read(11,'(a129)',end=999)outq +c +c Hardspaces. +c + if (outq(1:5) .eq. sq//'xard') then + ihs = ihs+1 + outq(2:2) = 'h' + write(outq(12:15),'(f4.1)')hpttot(ihs) + lenout = 19 + go to 9 + end if +c +c This part hard-wires ask's into new .tex file as ast's +c +2 indxask = index(outq,sq//'ask') + if (indxask .ne. 0) then + iask = iask+1 + call putast(ask(iask),indxask,outq) + go to 2 + end if + lenout = llen(outq,129) +9 continue + write(12,'(a)')outq(1:lenout) +c +c If this is the line with "readmod", check for topmods. +c + if (topmods .and. outq(2:8).eq.'readmod') then + topmods = .false. + rewind(16) + do 7 il = 1 , 1000 + read(16,'(a129)',end=8)outq + lenout = llen(outq,129) +c +c We inserted the '%' in subroutine littex, to guarantee including blank. +c + write(12,'(a)')outq(1:lenout) +7 continue +8 continue + close(16) + end if + go to 1 +999 close(11) + close(12) + return + end + subroutine backfill(iunit,oldq,lenold,newq,lennew) +c +c In iunit, looks backward for oldq, overwrites newq +c Safest if both are same length! +c + character*128 lineq(200),nowq + character*(*) oldq,newq + linesback = 0 +1 continue + backspace(iunit) + read(iunit,'(a)')nowq + ndx = index(nowq,oldq(1:lenold)) +c +c Save the line just read +c + linesback = linesback+1 + lineq(linesback) = nowq + if (ndx .eq. 0) then + backspace(iunit) + go to 1 + end if +c +c If here, it's replacement time. +c + lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew) + * //nowq(ndx+lenold:128) + backspace(iunit) + do 2 line = linesback , 1 , -1 + write(iunit,'(a128)')lineq(line) +2 continue + return + end + subroutine beamend(notexq,lnote) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq,ulqq,chax + logical beamon,firstgulp,figbass,figchk,flipend,btest, + * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comoct/ noctup + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /strtmid/ ihnum3,flipend(nm),ixrest(nm) + character*4 tempq + character*8 noteq + character*79 notexq + ip = ipo(jn) + multip = iand(mult(ivx,ip),15)-8 + lnote = 0 + if (ixrest(ivx) .eq. 4) then +c +c This is the LAST note in the xtup (i.e., all rests before). Make single. +c + nodur(ivx,ip) = 2**(4-multip) + call notex(notexq,lnote) + ixrest(ivx) = 0 + return + end if + nole = nolev(ivx,ip) +c +c Check for special situations with 2nds (see precrd) +c + if (btest(nacc(ivx,ip),30)) then + nole = nole - 1 + else if (btest(nacc(ivx,ip),31)) then + nole = nole + 1 + end if +c +c Terminate indented beams for 2-note tremolo if needed +c + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) + addoff = addoff+.0822*islope(ivx) + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 + end if + if (.not.drawbm(ivx)) then +c +c Xtuplet with no beam, just put in the right kind of note +c + if (btest(irest(ivx,ip),0)) then +c +c Rest at end of unbeamed xtup +c + lnote = 3 + if (btest(islur(ivx,ip),29)) then + notexq = sq//'sk' +c +c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for +c a blank rest ending xtup, but hopefully returning from here will handle it. +c + return + else if (multip .eq. 0) then + notexq = sq//'qp' + else if (multip .eq. -1) then + notexq = sq//'hp' + else if (multip .eq. 1) then + notexq = sq//'ds' + else if (multip .eq. 2) then + notexq = sq//'qs' + else + notexq = sq//'hs' + end if +c +c 180106 Deal with possible level tweak +c + nole = mod(nolev(ivx,ip)+50,100)-50 + if (nole .ne. 0) then + if (abs(nole) .lt. 10) then + noteq = chax(48+abs(nole)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole) + lnoten = 2 + end if + if (nole .gt. 0) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + end if + if (btest(islur(ivx,ip),30)) then +c +c Forced stem direction +c + ndsav = nodur(ivx,ip) + nodur(ivx,ip) = 2**(4-multip) + if (btest(nacc(ivx,ip-1),27)) + * nodur(ivx,ip)=nodur(ivx,ip)/2 + call notex(notexq,lnote) + nodur(ivx,ip) = ndsav + else + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) call addblank(noteq,lnoten) +c +c To reduce confusion due to this early update of lnote, do it +c below, separately in each case/ +c lnote = lnoten+3 + if (.not.btest(nacc(ivx,ip-1),27)) then +c +c Prior note is not regular-dotted +c + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then +c +c Unbeamed tremolo with indented beams. Put termination in right here +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c +c Is there an islope here, for unbeamed? +c + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq// + * 'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 + end if + if (multip .eq. 0) then + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).gt.24) then +c +c 2nd note of unbeamed half-note trem; make open +c But it's not clear if unbeamed half-note tremolo is Kosher, +c so don't worry about stem lengths here now. +c + if (lnote .eq. 0) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + else + notexq = notexq(1:46)// + * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + lnote = 46 + end if + else + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then +c +c Need a dot. +c + lnote = 46 + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if +c +c Insert stemlength stuff here for unbeamed dotted tremolo. +c May later combine with below to avoid repeat. But need to +c return to normal stem length after note is set. +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote) + lnote = lnote+10 + end if +c +c Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem +c (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot) +c + if (btest(irest(ivx,ip-1),2)) then + if (lnote .eq. 0) then +c notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//'p' + * //noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'q' +c * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + * //ulq(ivx,ibmcnt(ivx))//'p'//noteq(1:lnoten) + end if +c lnote = lnote+3+lnoten + lnote = lnote+4+lnoten + else + if (lnote .eq. 0) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + * //noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'q' + * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + end if + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then + notexq = notexq(1:lnote)//sq//'slz' + lnote=lnote+4 + end if + end if + else if (btest(irest(ivx,ip-1),2)) then +c +c 2nd note of unbeamed quarter or 8th trem; make quarter note +c Get stemlength change +c + lnote = 46 + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = notexq(1:46)//sq//'slx{'//tempq//'}' + lnote = lnote+10 +c +c Check for dotted unbeamed tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if + notexq = notexq(1:lnote)// + * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) +c * //sq//'stemcut' + * //sq//'slz' +c lnote=lnote+3+lnoten+8 + lnote=lnote+3+lnoten+4 + else if (multip .eq. -1) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 + else if (multip .eq. 1) then + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 + else if (multip .eq. 2) then + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+4 + else if (multip .eq. 3) then + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+5 + else if (multip .eq. -2) then + notexq = sq//'wh'//noteq(1:lnoten) + lnote = lnoten+3 + else if (multip .eq. -3) then + notexq = sq//'breve'//noteq(1:lnoten) + lnote = lnoten+6 + else + print* + print*,'(Error in beamend, send source to Dr. Don)' + call stop1() + end if + else +c +c Prior note is regular-dotted so this one is halved +c + lnote = lnoten+3 + if (multip .eq. 0) then + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq + else if (multip .eq. -1) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq + else if (multip .eq. -2) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + else if (multip .eq. 1) then + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq + lnote = lnoten+4 + else if (multip .eq. 2) then + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq + lnote = lnoten+5 + end if + end if + end if + return + end if +c +c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just +c skipping the call in that case. +c + if (.not.btest(irest(ivx,ip),0)) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if +c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) +c lnote = 0 +c +c New way, with flipend, which was computed in beamstrt. +c + if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then + ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + flipend(ivx) = .false. + end if + if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then +c +c This is not a one-noter from beam-jump. Check if multiplicity has increased +c + if (btest(irest(ivx,ip-1),0)) then +c +c Prior note is a rest, check one before that +c + mp = iand(mult(ivx,ip-2),15)-8 + else + mp = iand(mult(ivx,ip-1),15)-8 + end if + if (multip .gt. mp) then +c +c Assume 1-3, 2-3, or 1-2 +c + do 2 imp = multip , mp+1 , -1 + call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) +2 continue + else if (btest(nacc(ivx,ip-1),27)) then +c +c 2nd member of dotted xtup +c + call ntrbbb(multip+1,'t', + * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) + end if + end if +c +c Beam termination and direction analysis +c + if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then +c +c This is the end of the first segment in a jump-beam. ivbj1=ivx will be number +c of the jump-beam. ivbj2 will be tested along with isbjmp to see if in the +c voice of the 2nd part of jumped beam. (May need special treatment for +c multi-segment jump-beams +c + isbjmp = .true. + ivbj1 = ivx + multbj1 = iand(15,mult(ivx,ip)-8) + ivbj2 = 0 + end if + if (.not.btest(irest(ivx,ip),23)) then +c +c This is either a normal beamend or end of a sequence of jump-beam segments, +c (170409) or rest at end of xtup +c so some sort of termination is required +c + ulqq = ulq(ivx,ibmcnt(ivx)) + if (.not.isbjmp .or. ivx.ne.ivbj2) then + if (btest(irest(ivx,ip),0)) then +c +c Xtup ends with rest +c + if (multip .eq. 1) then + notexq = sq//'ds' + lnote = 3 + else if (multip .eq. 2) then + notexq = sq//'qs' + lnote = 3 + else if (multip .eq. 3) then + notexq = sq//'hs' + lnote = 3 + end if +c +c 170801 Borrowed from main rest entry way down below to get level adjustment: +c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? +c "... Now raise if necc." +c + if (btest(islur(ivx,ip),29)) then +c +c Blank rest +c + notexq = sq//'sk' + lnote = 3 + else if (nole .ne. 0) then +c +c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with +c nolev=-4 but expected 100+/-. Try to fix. +c + if (abs(nole).lt.30) nole = 100+nole +c + if (abs(nole-100) .lt. 10) then + noteq = chax(48+abs(nole-100)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole-100) + lnoten = 2 + end if +c ??? if (nole .gt. 0) then + if (nole .gt. 100) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + else +c +c Normal termination +c + call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) + end if + else +c +c Terminate a sequence of jump-beam segments. +c + ulqq = chax(225-ichar(ulqq)) + call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote) + end if + end if +c +c Check for end of 2nd seg of staff-jump xtup chord blank rest +c +c if (isbjmp.and.ivx.eq.ivbj2 + if (isbjmp + * .and.btest(islur(ivx,ip),29)) then + notexq = notexq(1:lnote)//sq//'sk' + return + end if +c +c And now the note, checking for open-head beamed tremolo +c + if (btest(irest(ivx,ip-1),2)) then +c +c Check for dotted tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then +c +c Solid notehead +c + notexq = notexq(1:lnote)//sq//'qbp' + else +c +c Assuming open notehead and nodur = 48 +c + notexq = notexq(1:lnote)//sq//'hbp' + end if + lnote = lnote+4 + else + if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if + else + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + end if + lnote = lnote+3 + end if + else +c +c No tremolo +c + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + lnote = lnote+3 + end if + isdotm = .false. + if (.not.vxtup(ivx)) then + if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then + if (.not.btest(iornq(ivx,ip),13)) then + notexq = notexq(1:lnote)//'p' + else + notexq = notexq(1:lnote)//'m' + isdotm = .true. + end if + lnote = lnote+1 + end if + end if +c +c 5/25/08 Allow >12 +c 5/9/10 Up to 24; replace 24 with 0 +c + if (.not.(isbjmp.and.ivx.eq.ivbj2)) then + call istring(mod(ivx,24),tempq,len) + else + call istring(mod(ivbj1,24),tempq,len) + end if + if (isbjmp .and. ivx.eq.ivbj2 + * .and..not.btest(irest(ivx,ip),23)) isbjmp=.false. + notexq = notexq(1:lnote)//tempq(1:len) + lnote = lnote+len + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + if (isdotm) then + if (lnoten .eq. 1) then + notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}' + lnote = lnote+3 + else + notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) + lnote = lnote+1 + end if + end if + return + end + subroutine beamid(notexq,lnote) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq,ulqq,chax + logical beamon,firstgulp,figbass,figchk,flipend,btest, + * isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm + character*79 notexq + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comoct/ noctup + common /strtmid/ ihnum3,flipend(nm),ixrest(nm) + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + character*8 noteq + character*4 tempq + lnote = 0 + ip = ipo(jn) + nole = nolev(ivx,ip) +c +c Check for special situations with 2nds (see precrd) +c + if (btest(nacc(ivx,ip),30)) then + nole = nole - 1 + else if (btest(nacc(ivx,ip),31)) then + nole = nole + 1 + end if + if (.not.btest(irest(ivx,ip),0)) then + multip = iand(mult(ivx,ip),15)-8 +c if (btest(islur(ivx,ip-1),3)) multip = multip+1 +c +c (Above test OK since must have ip>1). Double dotted note preceding +c +c Move the following, because can't ask for note until after checking for +c embedded xtup with number, due to ordering/octave feature. +c +c call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) + end if + if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true. + if (vxtup(ivx)) then +c +c In an xtup +c + if (btest(irest(ivx,ip),0)) then +c +c Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK +c + nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8)) + call notex(notexq,lnote) +c +c Re-zero so next note does not get confused +c + nodur(ivx,ip) = 0 + return + end if + if (.not.drawbm(ivx)) then +c +c Xtuplet with no beam, just put in the right kind of note +c + if (btest(islur(ivx,ip),30)) then +c +c Forced stem direction +c + ndsav = nodur(ivx,ip) + nodur(ivx,ip) = 2**(4-multip) + if (btest(nacc(ivx,ip),19) .or. + * btest(nacc(ivx,ip),27)) then + nodur(ivx,ip)=3*nodur(ivx,ip)/2 + else if (btest(nacc(ivx,ip-1),27)) then + nodur(ivx,ip)=nodur(ivx,ip)/2 + end if + call notex(notexq,lnote) + nodur(ivx,ip) = ndsav + else +c +c Use ulq for stem direction +c + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) call addblank(noteq,lnoten) + lnote = 3 + if (.not.btest(nacc(ivx,ip-1),27)) then +c +c Prior note of xtup is not regular-dotted +c + if (multip .eq. 0) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -1) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. 1) then + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. 2) then + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) + lnote = 4 + else if (multip .eq. 3) then + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) + lnote = 5 + else if (multip .eq. -2) then + notexq = sq//'wh' + end if + if (btest(nacc(ivx,ip),27)) then +c +c This xtup note is regular dotted non-beamed xtup +c +c notexq = notexq(1:3)//'p' +c lnote = 4 + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if + else +c +c Prior note of xtup is regular-dotted so this one is halved +c + if (multip .eq. 2) then + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) + lnote = 5 + else if (multip .eq. 1) then + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) + lnote = 4 + else if (multip .eq. 0) then + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -1) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -2) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + end if + end if + notexq = notexq(1:lnote)//noteq + lnote = lnote+lnoten + end if + return + else if (nodur(ivx,ip).eq.0) then +c +c In the beamed xtup but not the last note +c + if (nodur(ivx,ip-1).gt.0) then +c +c Embedded Xtup, mult>0, starts here. Put in number if needed +c + nxtinbm(ivx) = nxtinbm(ivx)+1 + iud = 1 + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1 +c +c Get ip#, notelevel of middle note (or gap) in xtup +c + ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2 + xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud, + * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8) + if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+ + * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud, + * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2 + iflop = 0 + if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud + iup = iud+2*iflop + if (btest(irest(ivx,ip),14)) then + iup = -iup + iflop = 0 + if (iud*iup .lt. 0) iflop = iup + end if +c +c Place number if needed +c + if (.not.btest(islur(ivx,ip),31)) then + mprint = igetbits(nacc(ivx,ip),5,22) + if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) + call putxtn(mprint,iflop,multip,iud,wheadpt,poenom, + * nolev1(ivx),islope(ivx),slfac, + * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum, + * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip), + * mult(ivx,ip),.false.) + end if + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + else +c +c Intermediate note of xtup +c + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if + else +c +c Last note of xtup (but not last note of beam!) +c + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if + else if (btest(irest(ivx,ip),0)) then + call notex(notexq,lnote) + return + else + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if +c +c Check for string of rests up to and including last note in xtup. +c +c Replace next 2 lines to keep from doing this block +c when in second part of staff-jumping chordal xtup. This fix could +c break some unaccounted non-chordal staff-jum xtup situations. +c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. +c * .not.btest(irest(ivx,ip),0)) then + if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. + * .not.btest(irest(ivx,ip),0) .and. + * .not.(isbjmp.and.ivx.eq.ivbj2)) then +c +c This note is not a rest but next is a rest. Do rests continue to +c end of xtup, where nodur>0 +c + do 3 ipnow = ip+1 , ip+24 + if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup + if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest +c +c If I don't go to 5, know next note IS a rest! +c +3 continue +4 continue + call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) + notexq = notexq(1:lnote)//sq//'qb' + lnote = lnote+3 + call istring(ivx,tempq,len) + notexq = notexq(1:lnote)//tempq(1:len) + lnote = lnote+len + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + return +5 continue +c +c Check if multiplicity changes in a way requiring action, +c unless (160211) it's blank rest on start of 2nd seg of joined beam +c + else if(.not.btest(irest(ivx,ip-1),24) + * .or..not.btest(islur(ivx,ip-1),29)) then + ipleft = ip-1 + if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1 + if (.not.btest(islur(ivx,ipleft),20)) then + multl = iand(15,mult(ivx,ipleft))-8 + else + multl = 1 + end if + mub = multip - multl + ipright = ip+1 + if (btest(irest(ivx,ipright),0)) ipright = ipright+1 + if (.not.btest(islur(ivx,ip),20)) then + multr = iand(15,mult(ivx,ipright))-8 + else + multr = 1 + end if + mua = multr-multip + if (mub.gt.0 .or. mua .lt. 0) then +c +c Multiplicity has increased from left or will decrease to right. Need action. +c + if (isbjmp .and. ivx.eq.ivbj2) then + ivb = ivbj1 + ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + else + ivb = ivx + ulqq = ulq(ivx,ibmcnt(ivx)) + end if + if (mua .ge. 0) then + call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote) +c +c Test for next note being blank rest, assuming staff-crossing +c xtup chord +c + else if (multl .ge. multr .and. + * .not.btest(islur(ivx,ip+1),29)) then + do 1 im = multip , 1+multr, -1 + call ntrbbb(im,'t',ulqq,ivb,notexq,lnote) +1 continue +c else +c Test for next note being blank rest, assuming staff-crossing +c xtup chord +c + else if (.not.btest(islur(ivx,ip+1),29)) then + do 2 im = 1+multr, multip + call ntrbbb(im,'r',ulqq,ivb,notexq,lnote) +2 continue + call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote) + end if + else if (ip .gt. 1) then +c +c Check for 2nd member of dotted xtup +c + if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', + * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) + end if + end if +c +c Now put in the note +c + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + lnote = lnote+3 + isdotm = .false. + if (isdotted(nodur,ivx,ip)) then +c +c rule out ')' +c + if (.not.btest(iornq(ivx,ip),13)) then + if (.not.btest(islur(ivx,ip),3)) then + notexq = notexq(1:lnote)//'p' + else +c +c Double dot +c + notexq = notexq(1:lnote)//'pp' + lnote = lnote+1 + end if + else + notexq = notexq(1:lnote)//'m' + isdotm = .true. + end if + lnote = lnote+1 + else if (btest(nacc(ivx,ip),19) + * .or. btest(nacc(ivx,ip),27)) then +c +c Special dotted notation for 2:1 xtup, or normal dot in xtup +c + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if +c +c 5/25/08 Allow >12 +c + if (.not.(isbjmp.and.ivx.eq.ivbj2)) then +c call istring(mod(ivx,12),tempq,len) + call istring(mod(ivx,24),tempq,len) + else +c call istring(mod(ivbj1,12),tempq,len) + call istring(mod(ivbj1,24),tempq,len) + end if + notexq = notexq(1:lnote)//tempq(1:len) + lnote = lnote+len + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + if (isdotm) then + if (lnoten .eq. 2) then + notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}' + lnote = lnote+3 + else + notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) + lnote = lnote+1 + end if + end if + return + end + subroutine beamn1(notexq,lnote) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,btest, + * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm + logical gotnote + common /comoct/ noctup + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + character*8 noteq,tempq,numq + character*79 notexq + gotnote = .false. + lnoten = 0 + ip1 = ipo(jn) + multip = iand(15,mult(ivx,ip1))-8 + if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then + lnote = 0 +c +c The rest was already written in beamstrt, so just get out of here +c + return + end if + nole = nolev(ivx,ipo(jn)) +c +c Check for special situations with 2nds (see precrd) +c + if (btest(nacc(ivx,ipo(jn)),30)) then + nole = nole - 1 + else if (btest(nacc(ivx,ipo(jn)),31)) then + nole = nole + 1 + end if + if (vxtup(ivx) .and. .not.drawbm(ivx)) then +c +c Xtuplet with no beam, just put in the right kind of note +c + if (btest(islur(ivx,ip1),30)) then +c +c Forced stem direction +c + ndsav = nodur(ivx,ip1) + nodur(ivx,ip1) = 2**(4-multip) + if (btest(nacc(ivx,ip1),19) .or. + * btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2 + call notex(notexq,lnote) + nodur(ivx,ip1) = ndsav + else + call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) + gotnote = .true. + if (lnoten .eq. 1) call addblank(noteq,lnoten) + lnote = 3 + if (multip .le. 0) then + if ((btest(irest(ivx,ip1),2) .and. + * nodur(ivx,ip1+1).ge.32) + * .or. multip .eq. -1) then +c +c 1st note of unbeamed half-note trem; make open +c + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -2) then + notexq = sq//'wh' + else + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + end if +c +c Check for dot +c + if (btest(irest(ivx,ip1),2) .and. + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then +c +c Need a dot. already called addblank for noteq +c + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + lnote = 3+lnoten + else + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if + end if +c +c Insert the stemlength calcs here for dotted, unbeamed. +c Later may combine with below to avoid repeat. +c + if (btest(irest(ivx,ip1),2)) then + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * notexq(1:lnote) + lnote = lnote+10 + end if + else if (btest(irest(ivx,ip1),2)) then +c +c 1st note of unbeamed quarter or 8th trem, make a quarter note +c +c Stem length calcs here. The .2 factor is empirical, but +c slfac accounts for musicsize. +c + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * sq//'q'//ulq(ivx,ibmcnt(ivx)) + lnote = 13 +c +c Check for dotted 2-note trem; prepend dot to notexq if needed +c + if (nodur(ivx,ip1+1).eq.12 .or. + * nodur(ivx,ip1+1).eq.24) then + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) + gotnote = .true. + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if + else if (multip .eq. -1) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. 1) then + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. 2) then + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx)) + lnote = 4 + else if (multip .eq. 3) then + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx)) + lnote = 5 + else if (multip .eq. -2) then + notexq = sq//'wh' + else if (multip .eq. -3) then + notexq = sq//'breve' + lnote = 6 + else + print* + print*,'(Error in beamn1, send source to Dr. Don)' + call stop1() + end if + if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then +c notexq = notexq(1:3)//'p' +c lnote = 4 + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if + notexq = notexq(1:lnote)//noteq + lnote = lnote+lnoten + end if + return + end if +c +c Check if mult. decreases from 1st note to 2nd +c + if (ibm2(ivx,ibmcnt(ivx)).gt.ip1 + * .or. btest(islur(ivx,ip1),20)) then +c +c More than one note or single-note before a multiplicity-down-up "][" +c + if (btest(islur(ivx,ip1),20)) then + multr = 1 + else if (.not.btest(irest(ivx,ip1+1),0)) then + multr = iand(15,mult(ivx,ip1+1))-8 + else + multr = iand(15,mult(ivx,ip1+2))-8 + end if + lnote = 0 +c +c Check if staff-jumper +c + if (isbjmp .and. ivbj2.gt.0) then + ivxp = ivbj1 + else + ivxp = ivx + end if + if (multr .lt. multip) then + do 1 im = multip , multr+1 , -1 +c +c Right-shifted 'termination' +c + if (isbjmp .and. ivbj2.gt.0) then +c +c Jump beam +c + call ntrbbb(im,'t',ulq(ivxp,ibmcnt(ivx)), + * ivxp,notexq,lnote) + else +c +c Same staff +c + call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivxp,notexq,lnote) + end if +1 continue + end if + end if +c +c Check for beamed, dotted 2-note tremolo +c + if (btest(irest(ivx,ip1),2) .and. + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + gotnote = .true. + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if +c +c Put in the note, but check first for open-head beamed tremolo. +c + if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then +c +c 2-note open head tremolo +c + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if + else + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + end if + lnote = lnote+3 + if (btest(irest(ivx,ip1),2) .and. + * (nodur(ivx,ip1+1).eq.24.or.nodur(ivx,ip1+1).eq.12 + * .or.nodur(ivx,ip1+1).eq.48)) then +c +c 2-note trem on dotted note +c + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if +c +c Check for dot +c + isdotm = .false. + if (.not.vxtup(ivx)) then + nd = nodur(ivx,ipo(jn)) + if (nd.ne.0) then + if (2**log2(nd).ne.nd) then + if (.not.btest(iornq(ivx,ip1),13)) then + if (.not.btest(islur(ivx,ip1),3)) then + notexq = notexq(1:lnote)//'p' + else +c +c Double dot +c + notexq = notexq(1:lnote)//'pp' + lnote = lnote+1 + end if + else + notexq = notexq(1:lnote)//'m' + isdotm = .true. + end if + lnote = lnote+1 + end if + end if + else if (btest(nacc(ivx,ip1),19) .or. + * btest(nacc(ivx,ip1),27)) then +c +c In an xtup with special 2:1 notation with a dot on 1st note, or normal dot +c + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if +c +c Do the number; 0 if 12 +c 5/25/08 allow >12 +c + if (.not.btest(irest(ivx,ip1),24)) then + call istring(mod(ivx,24),numq,len) + else +c +c 1st note of staff-jumping beam +c + call istring(mod(ivbj1,24),numq,len) + end if + notexq = notexq(1:lnote)//numq(1:len) + lnote = lnote+len + if (.not.gotnote) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) + end if + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + if (isdotm) then + if (lnoten .eq. 1) then + notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}' + lnote = lnote+3 + else + notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) + lnote = lnote+1 + end if + end if + return + end + subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq + character*40 restq + character*79 inameq + logical beamon,firstgulp,figbass,figchk,btest, + * isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm + common /comeskz2/ eskz2(nm,200) + common /comoct/ noctup + common /strtmid/ ihnum3,flipend(nm),ixrest(nm) + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 +c +c The following is just to save the outputs from SetupB for the case of +c xtups starting with a rest, where beamstrt is called twice. +c + common /comipb/ nnb,sumx,sumy,ipb(24),smed + character*1 chax + character*8 noteq + character*79 notexq,tempq + integer nornb(nm),ihornb(nm,24) + real*4 space(80),squez(80) + logical novshrinktop,cstuplet,usexnumt,writebrests + common /comnvst/ novshrinktop,cstuplet + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + character*10 figq + common /xjbeambrests/ nbrests + writebrests = .true. + ibc = ibmcnt(ivx) + ipb1 = ibm1(ivx,ibc) + multb = iand(15,mult(ivx,ipb1))-8 + ip = ipo(jn) + lnote = 0 + nvtrem = 0 ! Vertical adjustment beams for tremolo +c +c Compute slopes and note offsets from start of beam. Inside SetupB, for each +c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also +c gets islope(ivx), transferred in common. +c + if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) + * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx)) +c +c Will always come past here after entering beamstrt for 2-note tremolo, and +c slope will have been computed, even for unbeamed. So start the indented +c beams here. The indented tremolo bars will be added to the notexq output +c string, under the tacet assumption that there is no horizontal shift +c enacted by the action just before and after the call to beamstrt. +c + if (btest(irest(ivx,ipb1),2) .and. + * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ipb1),2,5) + tempq = sq//'roffset{.7}{'//sq//'ib' + ltemp = 16 + if (nindent .eq. 2) then + tempq = tempq(1:16)//'b' + ltemp = 17 + else if (nindent .eq. 3) then + tempq = tempq(1:16)//'bb' + ltemp = 18 + end if +c +c Use beam # 0 for indented beams +c + tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0' + ltemp = ltemp+2 +c +c Get adjustment to nolev1 for main beam based on nindent +c + if (ulq(ivx,ibc) .eq. 'u') then + nvtrem = nindent-1 + else + nvtrem = 1-nindent + end if +c +c Get numerical position of initiation for main beam. Will adjust height at +c closing to account for nindent +c + numinit = nolev1(ivx)-ncmid(iv,ipb1)+4 +c +c Get forced beam height tweak, apply here for indented beams +c + iadj = igetbits(ipl(ivx,ipb1),6,11)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1)') numinit + lnoten = 1 + else + write(noteq,'(a1,i2,a1)')'{',numinit,'}' + lnoten = 4 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten +c +c Now do the slope. +c 170408 Baseline is in islope(ivx). Apply slope tweak if present. +c + numinit = islope(ivx) + iadj = igetbits(ipl(ivx,ipb1),6,17)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1,a1)') numinit,'}' + lnoten = 2 + else + write(noteq,'(a1,i2,a2)')'{',numinit,'}}' + lnoten = 5 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten + notexq = tempq + lnote = ltemp + end if + if (btest(nacc(ivx,ip),21)) then +c +c This is start of later segment of single-slope beam group so use slope and +c height from prior beam. Slope is already OK. +c + issb(ivx) = issb(ivx)+1 + nolev1(ivx) = lev1ssb(ivx,issb(ivx)) + end if +c +c Move this up to before indented beams for tremolo +c lnote = 0 + drawbm(ivx) = .true. + if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then + vxtup(ivx) = .true. + nxtinbm(ivx) = nxtinbm(ivx)+1 +c +c irest(28)=>Xtup starts on this note. Set up for xtuplet. +c Number goes on notehead side at middle note (or gap) of xtup, unless that +c puts it in staff, then it flops to stem (or beam) side. +c __ __ +c | | | O | | +c O | | O +c |___| O |__| | +c +c iud -1 -1 1 1 ...stem direction +c iflop 0 1 -1 0 ...direction of flop +c iup -1 1 -1 1 ...direction of number and bracket +c + iud = 1 + if (ulq(ivx,ibc) .eq. 'u') iud = -1 +c +c Get ip#, note level of middle note (or gap) in xtup +c + ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2 +c +c 130129 If middle note is a rest, go to next note. Note last note cannot +c be a rest +c +14 continue + if (btest(irest(ivx,ipmid),0)) then + ipmid = ipmid+1 + go to 14 + end if + xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud, + * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8) + if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+ + * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud, + * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2 + iflop = 0 + if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud + iup = iud+2*iflop + if (btest(irest(ivx,ipb1),14)) then +c +c Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) +c + iup = -iup + iflop = 0 + if (iud*iup .lt. 0) iflop = iup + end if +c +c Determine if a beam is to be drawn. +c Had problem w/ half-note 2-note xtups always F, so add a test +c + if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then + drawbm(ivx) = .true. + go to 6 + end if + do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc) + if (iand(15,mult(ivx,ipp))-8 .le. 0) then + drawbm(ivx) = .false. + go to 6 + end if +5 continue + drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18) +6 continue +c +c Are we using tuplet.tex? +c + usexnumt = cstuplet .and. .not.drawbm(ivx) +c +c Check for single note xtup 171217 +c + if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then + drawbm(ivx) = .false. + end if +c +c Place xtup number if needed +c + if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then + mprint = igetbits(nacc(ivx,ip),5,22) + if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) +c Stab in the dark! Note: tried setting unbeam flag islur18 but no go. + if (nnb .eq. 1) then + xnlmid = nolev1(ivx) + islope(ivx) = 0 +c +c Move up, outside number check block, so all 1-note xtups ar unbeamed +c drawbm(ivx) = .false. +c + end if + call putxtn(mprint,iflop,multb,iud,wheadpt, + * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1), + * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)), + * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt) + end if + if (.not.drawbm(ivx)) then +c +c Xtuplet with no beam +c + if (.not.btest(islur(ivx,ipb1),31)) then +c +c Number printing has not been suppressed, so put in the bracket. +c scale = stretch factor for bracket if there are asx's +c xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) +c + xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1) + * -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib)) + if (iup .eq. 1) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'ovbkt' + else + notexq = sq//'ovbkt' + end if + else + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'unbkt' + else +c +c Introduced 12/5/98, req'd due to possible presence of in-line TeX +c + notexq = sq//'unbkt' + end if + end if + lnote = lnote+6 + if (iline.eq.1) then + smed = smed/(1.-fracindent) + end if + xslope = 1.8*smed*slfac + islope(ivx) = nint(xslope) + nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1)) + if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1 + if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4 + levbracket = nolev1(ivx) + if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1 + call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1)) + if (lnoten .eq. 1) call addblank(noteq,lnoten) + notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' + lnote = lnote+lnoten+1 + if (xnsk .lt. 0.995) then + write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk + lnote = lnote+4 + else if (xnsk .lt. 9.995) then + write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk + lnote = lnote+4 + else + write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk + lnote = lnote+5 + end if + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + if (btest(mult(ivx,ipb1),4)) then +c +c Tweak slope of bracket +c + islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16 + end if + if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + if (islope(ivx) .lt. -9) then + write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx) + lnote = lnote+3 + else + write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx) + lnote = lnote+2 + end if + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + else + write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx) + lnote = lnote+1 + end if +c +c Done with bracket +c + end if + if (ixrest(ivx) .eq. 1) then +c +c Put in the rest. Possible problem: Rest is a spacing char, but between +c beamstrt and beamn1 some non-spacing chars. are inserted. +c +c 130126 Deal with vertical shifts of rest starting xtuplet +c + lrest = 3 + if (btest(islur(ivx,ip),29)) then + restq = sq//'sk' +c if (multb .eq. 0) then + else if (multb .eq. 0) then + restq = sq//'qp' + else if (.not.drawbm(ivx).and.multb.eq.1) then + restq = sq//'ds' + else if (.not.drawbm(ivx).and.multb.eq.2) then + restq = sq//'qs' + else if (.not.drawbm(ivx).and.multb.eq.3) then + restq = sq//'hs' + else + restq = sq//'hpause' + lrest = 7 + end if + if (btest(nacc(ivx,ipb1),18) .and. + * btest(nacc(ivx,ipb1),19)) then +c +c VERY special case of rest at start of F-tuplet, needs dot +c + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if + + nole = mod(nolev(ivx,ip)+20,100)-20 +c if (nole .eq. 0) then + if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then +c +c Rest blank or is not raised +c + notexq = notexq(1:lnote)//restq + lnote = lnote+lrest + else + if (abs(nole) .lt. 10) then + tempq = chax(48+abs(nole)) + ltemp = 1 + else + write(tempq(1:2),'(i2)')abs(nole) + ltemp = 2 + end if + if (nole .gt. 0) then + tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote' + else + tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote' + end if + ltemp = 16+ltemp + notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest) + lnote = lnote+ltemp+lrest + end if +c +c No need to come back through this subroutine (as would if rest starts bar +c & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. +c + ixrest(ivx) = 0 + end if + return + end if +c +c End if block for non-beamed xtup start...note we returned +c + if (ixrest(ivx) .eq. 1) then +c +c Insert rest at start of beamed xtup. See above note for possible problem. +c But first check if blank rest and if in forced beam (assuming xtuplet), +c and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*' +c + if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then + nbrests = nbrests+1 + writebrests = .false. + else + nodur(ivx,ipb1) = 2**(4-multb) + call notex(tempq,ltemp) + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//tempq(1:ltemp) + else + notexq = tempq(1:ltemp) + end if + lnote = lnote+ltemp + end if +c +c Re-zero just in case! +c + nodur(ivx,ipb1) = 0 + ibm1(ivx,ibc) = ibm1(ivx,ibc)+1 +c +c See if next note is a non-rest +c + if (.not.btest(irest(ivx,ipb1+1),0)) then + ixrest(ivx) = 2 + else +c +c Suppress reprinting xtup number next time through beamstrt +c + islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31) +c +c Set new xtup start flag +c + irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28) + end if + return + end if + end if +c +c Just ended if block for xtups +c + if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then +c +c Move actual note writing to beamend +c + ixrest(ivx) = 4 + return + end if + if (issb(ivx) .eq. 0) then +c +c 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed +c + iadj = igetbits(ipl(ivx,ipb1),6,11)-30 + if (iadj .ne. -30) then + nolev1(ivx) = nolev1(ivx)+iadj + do 2 isssb = 1 , nssb(ivx) + lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj +2 continue + end if + iadj = igetbits(ipl(ivx,ipb1),6,17)-30 + if (iadj .ne. -30) then + islope(ivx) = islope(ivx)+iadj + if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx)) + if (nssb(ivx) .gt. 0) then +c +c Cycle thru non-rest notes in SSBG, looking for bmstrts. +c + isssb = 0 + do 4 inb = 2, nnb + if (btest(nacc(ivx,ipb(inb)),21)) then +c +c Beam segment start. New start level + isssb = isssb+1 + lev1ssb(ivx,isssb) = + * lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac + end if +4 continue + end if + end if + end if + iadj = igetbits(islur(ivx,ipb1),2,27) + addbrack = .false. + if (btest(ipl(ivx,ipb1),30)) then +c +c Check for altered starting polarity. Only in forced beams. Nominal start +c level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). +c + if (ulq(ivx,ibc).eq.'u' .and. + * nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then + if (lnote .eq. 0) then + notexq = sq//'loff{' + else + notexq = notexq(1:lnote)//sq//'loff{' + end if + lnote = lnote+6 + addbrack = .true. + else if (ulq(ivx,ibc).eq.'l' .and. + * nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then + if (lnote .eq. 0) then + notexq = sq//'roff{' + else + notexq = notexq(1:lnote)//sq//'roff{' + end if + lnote = lnote+6 + addbrack = .true. + end if +c +c Check end level for possible flipping in forced beam. Have to do it +c here since with multiple voices, xelsk will not be preserved. +c + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac + flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc)) + else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then + bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac + flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc)) + end if + end if + multbb = multb+iadj +c +c Tremolo starting? +c + if (btest(irest(ivx,ipb1),2)) multbb = + * igetbits(irest(ivx,ipb1),2,3) + call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote) +c +c Put in name of start level and slope, after correcting nolev1 if xtup +c started with a rest. +c + if (ixrest(ivx).eq.2) nolev1(ivx) = + * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac) +c +c Add adjustment nvtrem to main beam to account for tremolo indented beams +c + call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1)) + if (islope(ivx) .lt. 0) then + notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' + lnote = lnote+4+lnoten + write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}' + else + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+1+lnoten + write(notexq(lnote:lnote),'(i1)')islope(ivx) + end if +c +c Check for beam-thk fine-tuning +c + if (iadj .gt. 0) then + do 1 imp = multb+iadj , multb+1 , -1 + call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote) +1 continue + end if +c +c If we shifted, must close with right bracket +c + if (addbrack) then + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if +c +c Add in \sk's for very special case of staff-crossing xtup chords +c Assumes we are in lower (first) voice of up-to-both beamed xtup +c that starts with blank rests (notes in upper voice here). +c + if (nbrests.gt.0 .and. writebrests) then + do 7 isk = 1 , nbrests + notexq = notexq(1:lnote)//chax(92)//'sk' + lnote = lnote+3 +7 continue + nbrests = 0 + end if +c +c Get 'floor' zmin for figures +c Note: Will not come thru here on 1st note of unbeamed xtup, so figure height +c won't be adjusted. If anyone ever needs that, need to duplicate this +c functionality up above, before exiting. +c + if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then + if (ivx .eq. 1) then + ivf = 1 + else + ivf = ivxfig2 + end if + zmult = 1.2*(multb-1) + ymin = 100. + do 3 inb = 1, nnb + if (isfig(ivf,ipb(inb))) then + if (ulq(iv,ibc) .eq. 'u') then + ybot = nolev(iv,ipb(inb)) + else + ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx) + * -stemlen-zmult + end if + ymin = min(ymin,ybot) + end if +3 continue + maxdrop = ncmid(iv,ipb1)-4-ymin+5.01 + ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop) + end if +c +c Compute ornament levels if needed +c + NomOrnLev = ncmid(iv,ipb1)+5 + iorn = 0 + do 8 inb = 1 , nnb + ip = ipb(inb) + if (.not.btest(iornq(ivx,ip),23)) go to 8 + if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then +c +c letter-dynamic or hairpin ending under down-beamed +c + iorn = iorn+1 + ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1 + * -1.2*(multb-1) + ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10) + else if (.not.btest(ipl(ivx,ip),10)) then +c +c Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F +c 15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD +c +c Non-chord. There IS an ornament. Need ihornb only if upbeam, and if +c ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) +c + if (ulq(ivx,ibc).eq.'u' .and. + * iand(iornq(ivx,ipb(inb)),4163566).gt.0) then + iorn = iorn+1 + iornq(ivx,ip) = ibset(iornq(ivx,ip),22) + ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1 + * +1.2*(multb-1) + ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev) + end if + else +c +c In a chord. Orn may be on main note or non-main or both. Set ihornb if +c upbeam and highest note has orn, or down beam and lowest. Find 1st chord note +c + do 10 icrd1 = 1 , ncrd + if (iand(255,icrdat(icrd1)) .eq. ip .and. + * iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11 +10 continue +11 continue +c +c Find outermost note, min or max depending on beam direction ulq. xto is true +c if there's an ornament on that note. Expand orn list to include ._, since if +c on extreme chord note in beam, will move. +c So ornaments are all except 0,4,13 (,g,) +c + levx = nolev(ivx,ip) + xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0 + icrdx = 0 + do 12 icrd = icrd1 , ncrd + if (iand(255,icrdat(icrd)) .ne. ip .or. + * iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13 + levc = iand(127,ishft(icrdat(icrd),-12)) + if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or. + * (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then + levx = levc + icrdx = icrd + xto = iand(icrdorn(icrd),4186094).gt.0 + end if +12 continue +13 continue +c +c If there's orn on extreme note, do stuff +c + if (xto) then + iorn = iorn+1 + if (ulq(ivx,ibc) .eq. 'u') then + ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1 + * +1.2*(multb-1) + ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev) + else + ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1 + * -1.2*(multb-1) + ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10) + end if + if (icrdx .eq. 0) then +c +c Affected ornament is on main note +c + iornq(ivx,ip) = ibset(iornq(ivx,ip),22) + else + icrdorn(icrdx) = ibset(icrdorn(icrdx),22) + end if + end if + end if +8 continue +c +c Henceforth nornb will be a counter. +c + if (iorn .gt. 0) nornb(ivx)=1 + if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0 + return + end + block data + parameter (nm=24) + common /comtol/ tol + common /comtrans/ cheadq + common /compage/ widthpt,ptheight,hoffpt,voffpt, + * nsyst,nflb,ibarflb(0:40), + * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), + * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), + * nistaff(0:40) + common /cblock/ + * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, + * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh + common /cominbot/ inbothd + logical usefig + common /comstart/ facmtr + character*60 cheadq + character*120 instrq,titleq,compoq + logical headlog + common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, + * inhead + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac + common /combmh/ bmhgt,clefend + common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), + * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), + * idynda2(99),levhssav(nm),listcresc,listdecresc + character*128 txtdynq + logical kbdrests + common /comkbdrests/ levbotr(8),levtopr(8),kbdrests + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /comsize/ isize(nm) +c + data tol /.001/ + data cheadq + * /' '/ + data gslfac /9./ + data instrq,titleq,compoq,headlog /3*' ',.false./ +c +c meter space (pts) = xb4mbr = musicsize*facmtr +c + data facmtr /0.55/ + data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt + * / 1.3333,.4 , .7 , .3 , 0.2 , 2.0 , 1.0 , + * .7,.7 ,.9 ,.5 ,2.3 ,1.1 / + data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac + * / 1.32 , 2.25 , 0.47 , 0.83 , 0.17 , 0.5 , 1.7 / + data rtshfac / 1.0 / + data isize /nm*0/ +c +c From other +c + data ptheight,widthpt,hoffpt,voffpt, + * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, + * xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh + * / 740. , 524. , 0., 0., + * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12., + * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 / + data fracsys /30*0./ + data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, +c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, + * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, + * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3, + * -0.3,0.3 / + data kbdrests /.false./, + * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/ + data EarlyTransOn, LaterInstTrans /2*.false./ + data iInstTrans /nm*0/ + data iTransAmt /nm*0/ + end + subroutine catspace(space,squez,nnsk) + parameter (nkb=3999,maxblks=9600) + common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), + * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) + common /comtol/ tol + do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1 + if (abs(space-durb(iptr)) .lt. tol) then + if (abs(squez-sqzb(iptr)) .lt. tol) then +c +c Increment pre-existing entry +c + nnpd(iptr) = nnpd(iptr)+nnsk + return + end if + end if +16 continue +c +c Didn't find current duration & squez, so add a new entry. +c No particular reason to keep in order, so add at the end. +c + nnpd(nptr(ibarcnt+1)) = nnsk + durb(nptr(ibarcnt+1)) = space + sqzb(nptr(ibarcnt+1)) = squez + nptr(ibarcnt+1) = nptr(ibarcnt+1)+1 + return + end + character*1 function chax(n) +c +c The only reason for this seemingly do-nothing function is to get around an +c apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! +c + chax = char(n) + return + end + subroutine checkdyn(lineq,iccount,ibar) + character*128 lineq + character*1 durq,chax + character*4 dynsymq + logical txtdyn + txtdyn = .false. +c +c On entry, iccount is on "D" +c + if (lineq(iccount+1:iccount+1) .eq. chax(34)) then +c +c Dynamic text +c + + istart = iccount+2 ! 1 past 1st quote +3 continue + iend = index(lineq(istart:128),chax(34)) + if (lineq(istart+iend-2:istart+iend-2) .eq. chax(92)) then + istart = iccount+iend+2 + go to 3 + end if + if (iend .eq. 0) then + call errmsg(lineq,iccount+1,ibar, + * 'Dynamic text must be terminated with double quote!') + call stop1() + end if +c +c Set iccount to character after 2nd ", and set ipm +c +c iccount = iccount+iend+2 + iccount = istart+iend + ipm = index('- +',lineq(iccount:iccount)) + if (ipm .eq. 0) then + call errmsg(lineq,iccount,ibar, + * 'Expected "-", "+", or blank here!') + call stop1() + end if + else +c +c Expect ordinary dynamic +c + do 1 iend = iccount+2 , 128 + ipm = index('- +',lineq(iend:iend)) + if (ipm .gt. 0) go to 2 +1 continue +2 continue + if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then + call errmsg(lineq,iend-1,ibar, + * 'Wrong length for dynamic mark!') + call stop1() + end if + read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')') + * dynsymq + idno = (index( + * 'ppppppp pp p mp mf f fp sfz ff fff ffff< > ', + * dynsymq)+3)/4 + if (idno .eq. 0) then + call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!') + call stop1() + end if + iccount = iend + end if + if (ipm .ne. 2) then +c +c There is a vertical shift, have "+" or "-" +c + iccount = iccount+1 + if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then + call errmsg(lineq,iccount,ibar, + * 'Expected integer here for vertical offset!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + idno = nint(fnum) + if (idno .gt. 63) then + call errmsg(lineq,iccount-1,ibar, + * 'Vertical offset for dynamic mark must be (-63,63)!') + call stop1() + end if + ipm = index('- +',durq) + if (ipm .eq. 0) then + call errmsg(lineq,iccount,ibar, + * 'Expected "+", "-", or blank here!') + call stop1() + end if + if (ipm .ne. 2) then +c +c There is a horizontal shift +c + iccount = iccount+1 + if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then + call errmsg(lineq,iccount,ibar, + * 'Expected number here for horizontal offset!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + idno = nint(10*fnum) + if (idno .gt. 255) then + call errmsg(lineq,iccount-1,ibar, + * 'Horizontal offset for dynamic mark must be (-25.5,25.5)!') + call stop1() + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibar, + * 'There should be a blank here!') + call stop1() + end if + end if +c +c iccount should be on the blank at the end of the entire symbol +c + end if + return + end + subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp) +c subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, +c * icashft) + logical found1,iscacc,isarp,btest + integer icrdat(193) + found1 = .false. +c +c icashft will be max left shift of accid's in chord notes. +c Used only for spacing checks. +c Will include left shift of chord note itself. +c Rezero after use. +c + do 18 icrd = 1 , ncrd +c +c This if block cycles thru all chord notes on ivx,ip; then returns. +c + if (iand(255,icrdat(icrd)) .eq. ip .and. + * iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then + found1 = .true. + iscacc = iscacc .or. + * (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) +c +c Accid on this chord note, and it's not midi-only. +c +c irshft = igetbits(icrdot(icrd),7,20) +cc +cc Include increment for notehead shift +cc +c if (btest(icrdat(icrd),23)) then +c if (irshft .eq. 0) then +c irshft = 44 +c else +c irshft=irshft-20 +c end if +c end if +c if (irshft .ne. 0) then +cc +cc Accid on chord note is shifted. Include only left shift, in 20ths. +cc +c if (irshft .lt. 64) icashft = max(icashft,64-irshft) +c end if +c end if + isarp = isarp .or. btest(icrdat(icrd),25) + else if (found1) then + return + end if +18 continue + return + end + subroutine chkimidi(icm) + parameter (nm=24,mv=24576) + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + if (imidi(icm) .ge. mv) then + print* + print*,'Midi file is too long! It will be corrupted or worse' + write(*,'(a6,2x,4i8)') + * 'imidi:',imidi(0),imidi(1),imidi(2),imidi(3) + end if + return + end + subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx, +c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) + * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl) + parameter (nm=24) + integer*4 nn(nm),islur(nm,200),irest(nm,200), + * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8), + * ivmx(nm,2),mult(nm,200),ipl(nm,200) +c +c On 130127 put this code, formerly in make2bar right before calling notex for +c a single note/rest, into this subroutine, so the same logic could also be +c with the calls to beamstrt/mid/end to adjust height of rests in xtups if the +c keyboard rest option is selected +c +c mode=1 if called as before, 2 if for an xtup. Only affects check for +c quarter rests, which will fix later. +c +c Get reference level: next following note if no intervening blank rests, +c otherwise next prior note. Relative to bottom line. +c +c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then + if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then +c +c Not the last note and not "look-left" for level +c + do 8 kkp = ip+1 , nn(ivx) + if (btest(islur(ivx,kkp),29)) go to 4 + if (.not.btest(irest(ivx,kkp),0)) then + levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line + go to 9 + end if +8 continue + end if +4 continue +c +c If here, there were no following notes or came to a blank rest, or +c "look-left" option set. So look before +c +c if (ip .eq. 1) go to 2 ! Get out if this is the first note. + if (ip .eq. 1) return ! Get out if this is the first note. + do 3 kkp = ip-1, 1, -1 + if (.not.btest(irest(ivx,kkp),0)) then + levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line + go to 9 + end if +3 continue +c go to 2 ! Pretty odd, should never be here, but get out if so. + return ! Pretty odd, should never be here, but get out if so. +9 continue +c +c Find note in other voice at same time +c + iupdown = sign(1,ivx-nv-1) + ivother = ivmx(iv,(3-iupdown)/2) + tother = 0. + do 5 kkp = 1 , nib(ivother,ibar) + if (abs(tother-tnow) .lt. tol) go to 6 + tother = tother+nodur(ivother,kkp) +5 continue +c +c If here, then no note starts in other voice at same time, so set default +c + levother = -iupdown*50 + go to 7 +6 continue +c +c If here, have just identified a simultaneous note or rest in other voice +c + if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it + levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 + else + if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then +c +c Rest in other voice has same duration, get out (so defualt spacing is used) +c +c go to 2 + return + end if + levother = -iupdown*50 + end if +7 continue + if (mode.eq.1) then + indxr = log2(nodur(ivx,ip))+1 + else +c nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) + indxr = 4-(iand(mult(ivx,ip),15)-8)+1 + end if + if (iupdown .lt. 0) then + levtop = levtopr(indxr) + iraise1 = levother-levtop-3 ! Based on other note + iraise2 = levnext-levtop ! Based on following note + if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 + iraise = min(iraise1,iraise2) + if (mod(iraise+50,2).eq.1 .and. + * iraise+levtop.gt.-1) iraise = iraise-1 + else + levbot = levbotr(indxr) + iraise1 = levother-levbot+3 + iraise2 = levnext-levbot + if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 + iraise = max(iraise1,iraise2) + if (mod(iraise+50,2).eq.1 .and. + * iraise+levbot.le.9) iraise = iraise-1 + end if + nolev(ivx,ip) = 100+iraise + return + end + subroutine chklit(lineq,iccount,literr) + character*128 lineq + character*1 charq,chax + literr = 0 + itype = 1 +17 call g1etchar(lineq,iccount,charq) + if (charq .eq. chax(92)) then + itype = itype+1 + if (itype .gt. 3) then + literr = 1 + return + end if + go to 17 + end if + lenlit = itype +18 call g1etchar(lineq,iccount,charq) + if (charq.eq.chax(92)) then + call g1etchar(lineq,iccount,charq) + if (charq .ne. ' ') then +c +c Starting a new tex command withing the string +c + lenlit = lenlit+2 + if (lenlit .gt. 128) then + literr = 2 + return + end if + go to 18 + end if + else + lenlit = lenlit+1 + if (lenlit .gt. 128) then + literr = 2 + return + end if + go to 18 + end if + return + end + subroutine chkpm4ac(lineq,iccount,nacc,moved) +c +c Called after getting +/-/ in a note (not rest). iccount is on the +-<>. +c Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits +c 10-16) if < or >, horiz and vert (bits 4-9) if two consecutive signed +c numbers. If moved=.true., iccount on exit is on end of last number. +c If moved=.false., iccount still on +/- +c + logical moved,ishorz + character*128 lineq + character*1 durq + if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and. + * index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then +c +c Prior char was accid & next is #; this may be start of accidental shift. +c Must test for "." above in case we get "<" or ">" +c + ipm = index('- +< >',lineq(iccount:iccount))-2 + if (lineq(iccount+1:iccount+1).eq.'.' .and. + * index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then +c +c Rare case of [accid][+/-].[letter]. Bail out +c + moved = .false. + return + end if + ishorz = ipm .gt. 1 +c +c Save iccount in case it's not accid shift and we have to reset. +c + icsav = iccount + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (ishorz .or. index('+-',durq).gt.0) then +c +c This has to be accidental shift. Set vert. shift. +c + if (.not.ishorz) then +c +c +/- syntax, both shifts set, vertical first +c + call setbits(nacc,6,4,int(ipm*fnum+32.5)) + ipm = index('- +',durq)-2 + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + else +c +c syntax, only horiz set +c + ipm = ipm-3 + end if +c +c Set horiz. shift +c + call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35))) + iccount = iccount-1 + moved = .true. + else +c +c False alarm. Reset everything and flow onward +c + moved = .false. + iccount = icsav + end if + else +c +c Either prior char was not 'sfn' or next was not digit, so take no action +c + moved = .false. + end if + return + end + subroutine clefsym(isl,notexq,lnote,nclef) +c +c Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. +c + character*(*) notexq + character*1 chax + nclef = iand(ishft(isl,-12),7) + if (nclef .eq. 0) then +c +c treble +c + nlev = 2 + else if (nclef .gt. 6) then +c +c French violin +c + nlev = 0 + else if (nclef .lt. 5) then +c +c C-clef +c + nlev = 2*nclef-2 + else +c +c F-clef +c + nlev = 2*nclef-6 + end if + notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7)) + * //chax(48+nlev) + lnote = 10 + return + end + subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime, + * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) +c +c nacc = accidental bitmap for main note +c naccid = # of accid's in chord +c micrd = array with icrd #'s for notes w/ acc's, 0=>main note +c nolevm = level of main note +c segrb(1|2,.) x|y-coord of right-bdry segment +c ksegrb(.) internal use; tells what defined this segment +c -2: Left-shifted notehead +c -1: Original right boundary +c 0: Main note accidental +c icrd: Chord-note accidental +c isetshft(i),i=1,naccid: what set shift for this accid, same codes +c icrdot0 = top-down level-rank of main note among accid-notes +c icrdot(icrd)(27-29) = level rank of chord-note among accid-notes +c twooftwo will be true 2nd time thru; signal to store shifts w/ notes +c + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50) + integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50), + * isetshft(10),ksegrb0(50) + logical lasttime,mainnote,twooftwo + data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 / + data segar / +c +c Fancy sharp boundary. fl,sh,na,dfl,dsh +c + * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2, +c * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. , +c meas value for y, natural is 1.6 + * -0.75,-0.20,-0.80,-.75, 0. , .96,-1.04,1.48, .96, 1.2, + * 0.00,-0.38, 0.00, 0. , 0. ,3.15, 1.64,3.0, 3.15, 0. , + * 0. , 0.00, 0. , 0. , 0. , 0. , 2.90, 0. , 0. , 0. , + * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , + * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / + data segal / +c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , +cc (meas. value is 3.08) ^^^^ +cc Raise top of flat so it interferes with bottom of sharp + * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2, + * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2, + * 0. ,-1.02, 0.00, 0. , 0. , 0. , 1.04, 3.0, 0. , 0. , + * 0. , 0.00, 0. , 0. , 0. , 0. , 2.9 , 0. , 0. , 0. , + * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , + * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / +c +c iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6) +c + data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 / +c +c Set up barrier segrb(iseg,ipoint) to define coords of corner points +c on stem+notes +c + do 11 iseg = 1 , nsegrb0 + segrb(1,iseg) = segrb0(1,iseg) + segrb(2,iseg) = segrb0(2,iseg) + ksegrb(iseg) = ksegrb0(iseg) +11 continue + nsegrb = nsegrb0 + rmsshift = 0. + shiftmin = 1000. + do 1 iwa = 1 , naccid +c +c Initialize shift for this note +c + shift = 0. + mainnote = micrd(iwa).eq.0 + isetshft(iwa) = -1 +c +c Get note level and accidental type +c + if (mainnote) then + nolev = nolevm + iacctype = iacctbl(igetbits(nacc,3,0)) + else + nolev = igetbits(icrdat(micrd(iwa)),7,12) + iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20)) + end if +c +c Cycle thru segments on right edge of this accidental +c + do 2 isega = 1 , nsegar(iacctype)-1 + ybotaseg = nolev+segar(iacctype,2,isega) + ytopaseg = nolev+segar(iacctype,2,isega+1) +c +c Cycle thru segments of right-hand barrier +c + do 3 isegrb = 1 , nsegrb-1 +c +c Must find all barrier segments that start below ytopseg & end above ybotseg +c + if (segrb(2,isegrb) .lt. ytopaseg) then +c +c Barrier seg starts below top of accid +c Check if barrier seg ends above bottom of accid +c + if (segrb(2,isegrb+1) .gt. ybotaseg) then + if (shift .gt. + * segrb(1,isegrb)-segar(iacctype,1,isega)) then + shift = segrb(1,isegrb)-segar(iacctype,1,isega) +c +c Record the cause of the shift +c + isetshft(iwa) = ksegrb(isegrb) + end if + end if +c +c Does barrier segment end above top of accid seg? +c + if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4 + end if +3 continue +4 continue +2 continue + if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001 + * .and. .not.lasttime) then +c if (nolev .eq. levmaxacc) then + if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then + rmsshift = 1000. + return + end if +c +c Does the following properly account for left-shifted noteheads? +c +c Top-down rank of this note we just shifted +c + if (mainnote) then + irank = icrdot0 + else + irank = igetbits(icrdot(micrd(iwa)),3,27) + end if +c +c Compare level-rank of this note vs. that of note that caused the shift. +c This has effect of checking for basic interferences from top down. +c +c ksegrb(.) internal use; tells what defined this segment +c -2: Left-shifted notehead +c -1: Original right boundary +c 0: Main note accidental +c icrd: Chord-note accidental +c isetshft(i),i=1,naccid: what set shift for this accid, same codes +c + if (isetshft(iwa) .lt. 0) then + iranksetter = 0 + else if (isetshft(iwa) .eq. 0) then + iranksetter = icrdot0 + else + iranksetter = igetbits(icrdot(isetshft(iwa)),3,27) + end if + if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then + rmsshift = 1000. + return + end if + end if + rmsshift = rmsshift+shift**2 + if (lasttime .and. abs(shift).gt..0001) then + if (mainnote) then + if (.not.btest(nacc,29)) go to 10 + else + if (.not.btest(icrdat(micrd(iwa)),29)) go to 10 + end if +c +c If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there +c was a manual shift but auto-shift was zero, will not come thru here, but shift value +c will be left intact. +c + if (mainnote) then + shift = shift+.05*(igetbits(nacc,7,10)-107) + else + shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107) + end if +10 continue + if (twooftwo) then +c +c Record the shift for this accidental +c + if (shift .lt. -5.35) then + call printl(' ') + call printl('WARNING: auto-generated accidental '// + * 'shift too big for PMX, ignoring') + else + ishift = nint(20*(shift+5.35)) + if (mainnote) then + call setbits(nacc,7,10,ishift) + else + call setbits(icrdot(micrd(iwa)),7,20,ishift) + end if + end if + else +c +c This is the earlier call to precrd, so need minimum shift +c + shiftmin = min(shiftmin,shift) + end if + end if +c +c Bail out if this is the last accidental to check +c + if (iwa .eq. naccid) go to 1 +c +c Add this accidental to the right barrier! Count down from highest barrier segment, +c find 1st one starting below top of accid, and first one starting below bot. +c + do 5 ibelowtop = nsegrb , 1 , -1 + if (segrb(2,ibelowtop) .lt. + * nolev+segal(iacctype,2,nsegal(iacctype))) then + do 9 ibelowbot = ibelowtop , 1 , -1 + if (segrb(2,ibelowbot) .lt. + * nolev+segal(iacctype,2,1)) go to 6 +9 continue + print*,'Oops2!' + call stop1() + end if +5 continue + print*,'Ugh0! in crdaccs' + call stop1() +6 continue + netgain = nsegal(iacctype)-ibelowtop+ibelowbot +c +c Shift high segments up +c + if (netgain .ge. 0) then + do 7 isegrb = nsegrb , ibelowtop+1 , -1 + segrb(1,isegrb+netgain) = segrb(1,isegrb) + segrb(2,isegrb+netgain) = segrb(2,isegrb) + ksegrb(isegrb+netgain) = ksegrb(isegrb) +7 continue +c +c Set up 1st segment above accid +c + segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop) + segrb(2,ibelowtop+netgain) = + * nolev+segal(iacctype,2,nsegal(iacctype)) + ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop) + else +c +c netgain<0, must remove segments. Use same coding but reverse order, +c work from bottom up +c + segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop) + segrb(2,ibelowtop+netgain) = + * nolev+segal(iacctype,2,nsegal(iacctype)) + ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop) + do 12 isegrb = ibelowtop+1 , nsegrb + segrb(1,isegrb+netgain) = segrb(1,isegrb) + segrb(2,isegrb+netgain) = segrb(2,isegrb) + ksegrb(isegrb+netgain) = ksegrb(isegrb) +12 continue + end if +c +c Insert new segments +c + do 8 isega = 1 , nsegal(iacctype)-1 + segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega) + segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega) + if (mainnote) then + ksegrb(ibelowbot+isega) = 0 + else + ksegrb(ibelowbot+isega) = micrd(iwa) + end if +8 continue +c +c Update number of barrier segments +c + nsegrb = nsegrb+netgain +cc +cc Temporary printout for boundary segments as built up +cc +c write(15,'()') +c write(15,'(a/(2f8.2,i5))')' y x kseg', +c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) +c write(15,'(a/(2i5))')' micrd isetshft', +c * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) +cc +1 continue ! next accidental + if (lasttime .and. .not.twooftwo) then +c +c This is the final call on the pre-ask pass, so compute left-shift rqmt. +c + icashft = nint(-20*shiftmin) + end if +cc +cc Temporary printout for boundary segments +cc +c if (twooftwo) then +c write(15,'()') +c write(15,'(a/(2f8.2,i5))')' y x kseg', +c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) +c write(15,'(a/(2i5))')' micrd isetshft', +c * (micrd(iwa),isetshft(iwa),iwa=1,naccid) +c end if +cc + return + end + subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm, + * levmaxacc,levminacc,icrdot0,twooftwo,icashft) +c +c nacc = accidental bitmap for main note +c naccid = # of accid's in chord +c kicrd = array with icrd #'s for notes w/ acc's, 0=>main note +c nolevm = level of main note +c +c This is called once per multi-accidental chord. In here, loop over all +c permutations of the order of accidental as stored in kicrd. Each time thru +c loop, call crdacc once, get rms shift. Only save permutation and rms value +c if it is less than old value. +c + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 +c +c Make consistent? 120106 +c integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) + integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) + real*4 segrb0(2,50) + logical btest,tagged,manual,lshift,twooftwo +cc +cc Temporary printout of level-rankings +cc +c write(15,'()') +c do 98 iacc = 1 , naccid +c if (kicrd(iacc) .eq. 0) then +c write(15,'(3i5)')nolevm,icrdot0 +c else +c write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12), +c * igetbits(icrdot(kicrd(iacc)),3,27) +c end if +c98 continue +cc +c +c Initialize right-barrier +c + segrb0(1,1) = 0. + segrb0(2,1) = -1000. + segrb0(1,2) = 0. + segrb0(2,2) = 1000. + nsegrb0 = 2 + ksegrb0(1) = -1 + ksegrb0(2) = -1 +c +c Search for left-shifted notes, Make up the initial right-barrier, which +c will be good for all permutations. +c irest()(27) is set if any notes are left-shifted +c Must use ALL chord notes, not just ones w/ accid's. +c + if (btest(irest,27)) then + do 15 icrd = icrd1-1, icrd2 + if (icrd .eq. icrd1-1) then +c +c Main note +c +c lshift = btest(ipl,8) + lshift = btest(ipl,8) .or. btest(nacc,31) + if (lshift) nolev = nolevm + else +c +c Chord note +c + lshift = btest(icrdat(icrd),23) +c if (lshift) nolev = igetbits(icrdat(icrd),7,12) + if (lshift) then + nolev = igetbits(icrdat(icrd),7,12) + if (btest(nacc,31) .and. nolev.eq.nolevm+1) then +c +c This note is not really shifted, It is the upper of a 2nd with the main +c note on an upstem, and Main note must be shifted. +c nacc(31) signals the real truth. +c + lshift = .false. + end if + end if + end if + if (lshift) then + do 16 isegrb = 1 , nsegrb0-1 + if (segrb0(2,isegrb+1) .gt. nolev-1) then +c +c Add this notehead to the right boundary here. Move all higher segs up 2. +c + do 17 iiseg = nsegrb0 , isegrb+1 , -1 + segrb0(1,iiseg+2) = segrb0(1,iiseg) + segrb0(2,iiseg+2) = segrb0(2,iiseg) + ksegrb0(iiseg+2) = ksegrb0(iiseg) +17 continue + go to 18 + end if +16 continue +18 continue +c +c Insert notehead into list. Set kseg=-2 to signal notehead shift. +c + iiseg = isegrb+1 + segrb0(1,iiseg) = -1.2 + segrb0(2,iiseg) = nolev-1. + ksegrb0(iiseg) = -2 + segrb0(1,iiseg+1) = 0. + segrb0(2,iiseg+1) = nolev+1. + ksegrb0(iiseg+1) = -1 + nsegrb0 = nsegrb0+2 + end if +15 continue + end if +c +c Done setting right barrier for left-shifted noteheads +c + tagged = .false. + manual = .false. +c +c Preprocess to check for manual shifts. +c If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then +c If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then +c 1. Auto-shifting proceeds +c 2. "A"-shifts add to autoshifts +c 3. non-"A" shifts are ignored! +c Else (>0 man shifts, none has "A") +c No auto-ordering, No autoshifts, Observe all manual shifts. +c End if +c End if +c + maxmanshft = 0 + do 13 i = 1 , naccid + if (kicrd(i) .eq. 0) then +c +c Main note +c + manshft = igetbits(nacc,7,10) + if (manshft .ne. 0) then + manual = .true. + if (btest(nacc,29)) then + tagged = .true. + else +c maxmanshft = max(maxmanshft,64-manshft) + maxmanshft = max(maxmanshft,107-manshft) + end if + end if + else +c +c Chord note +c + manshft = igetbits(icrdot(kicrd(i)),7,20) + if (manshft .ne. 0) then + manual = .true. + if (btest(icrdat(kicrd(i)),29)) then + tagged = .true. + else +c maxmanshft = max(maxmanshft,64-manshft) + maxmanshft = max(maxmanshft,107-manshft) + end if + end if + end if +13 continue + if (manual) then + if (tagged) then +c +c zero out all untagged shifts +c + do 14 i = 1 , naccid + if (kicrd(i) .eq. 0) then + if (.not.btest(nacc,29)) call setbits (nacc,7,10,0) + else + if (.not.btest(icrdat(kicrd(i)),29)) + * call setbits (icrdot(kicrd(i)),7,20,0) + end if +14 continue + else +c +c There are manual shifts but none tagged. Only proceed if "Ao" was entered +c + if (.not.btest(nacc,28)) then + icashft = maxmanshft + return + end if + end if + end if + if (btest(nacc,28)) then +c +c Take the accidentals in order as originally input, then exit. +c + call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true., + * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) + return +c end if + else if (naccid .eq. 3) then +c +c Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd +c then place in order top, bottom, middle. +c + do 20 i = 1 , 3 + if (kicrd(i) .eq. 0) then + irank = icrdot0 + nolev = nolevm + else + irank = igetbits(icrdot(kicrd(i)),3,27) + nolev = igetbits(icrdat(kicrd(i)),7,12) + end if + if (irank .eq. 1 ) then + micrd(1) = kicrd(i) + else + micrd(5-irank) = kicrd(i) + end if + if (irank .eq. 2) then + levmidacc = nolev + end if +20 continue + if (levmaxacc.ne.levmidacc+1 .and. + * levmidacc.ne.levminacc+1) then + call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true., + * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) + return + end if + end if + rmsmin = 100000. +c +c Initialize permutation array +c + do 7 i = 1 , naccid + iperm(i) = i +7 continue +c +c Start looping over permutations +c + do 8 ip = 1 , 5041 + if (ip .ne. 1) then +c +c Work the magic algorithm to get the next permutation +c + do 1 k = naccid-1 , 1 , -1 + if (iperm(k) .le. iperm(k+1)) go to 2 +1 continue +c +c If here, we just got the last permutation, so exit the loop over permutations +c + go to 10 +2 continue + do 3 j = naccid , 1 , -1 + if (iperm(k) .le. iperm(j)) go to 4 +3 continue +4 continue + it = iperm(j) + iperm(j) = iperm(k) + iperm(k) = it + is = k+1 + do 5 ir = naccid , 1 , -1 + if (ir .le. is) go to 6 + it = iperm(ir) + iperm(ir) = iperm(is) + iperm(is) = it + is = is+1 +5 continue +6 continue + end if +c +c New we have a permutation. Take icrd values out of kicrd and put them into +c micrd in the order of the permutation +c + do 9 i = 1 , naccid + micrd(i) = kicrd(iperm(i)) +9 continue +cc +cc Temporary printout +cc +c write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) +cc + call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false., + * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) +cc +cc Temporary printout +cc +c write(15,*)'perm done, rmsshift:',rmsshift +cc + if (rmsshift .lt. rmsmin) then +c +c Save this permutation, reset minrms +c + do 11 i = 1 , naccid + ipermsav(i) = iperm(i) + rmsmin = rmsshift +11 continue + end if +8 continue + print*,'Should not BEEEEEE here!' + call stop1() +10 continue +c +c Done looping, get info for the final choice +c + do 12 i = 1 , naccid + micrd(i) = kicrd(ipermsav(i)) +12 continue +cc +cc Temporary printout +cc +c write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) +cc + call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true., + * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft) + return + end + subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut) + character*1 sq,chax + character*3 acsymq + character*8 noteq + character*79 notexq + logical btest,caut + sq = chax(92) + if (ihshft .eq. -107) ihshft=0 +cc +cc If main note shifted left, so shift accid. Terminate below, when acc. is done. +cc + if (ihshft .ne. 0) then +c +c Accid must be shifted horizontally +c + if (ihshft .lt. 0) then + notexq = sq//'loffset{' + ihshft = -ihshft + else + notexq = sq//'roffset{' + end if + hshft = .05*ihshft + if (hshft .lt. 1.) then + write(notexq(10:12),'(f3.2)')hshft + lnote = 12 + else + write(notexq(10:13),'(f4.2)')hshft + lnote = 13 + end if + notexq = notexq(1:lnote)//'}{'//sq + lnote = lnote+3 + else + notexq = sq + lnote = 1 + end if + if (btest(nacc,3)) then + notexq = notexq(1:lnote)//'big' + lnote = lnote+3 + end if + if (caut) then +c +c Cautionary accidental. Need to define bigcna,... in pmx.tex +c + notexq = notexq(1:lnote)//'c' + lnote = lnote+1 + end if + call accsym(nacc,acsymq,lacc) + notexq = notexq(1:lnote)//acsymq(1:lacc) + lnote = lnote+lacc + noleva = nolev + if (ivshft .ne. 0) noleva = noleva+ivshft-32 + call notefq(noteq,lnoten,noleva,ncm) + if (lnoten .eq. 1) call addblank(noteq,lnoten) + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + if (ihshft .ne. 0) then +c +c Terminate horizontal shift +c + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + return + end + subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt, + * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen, + * dotxtup,nacc,irest) + parameter (nm=24,mv=24576) + integer*4 irest(nm,24) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac + integer*2 mmidi,iinsiv + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + logical lowdot,dotxtup + integer*4 ihornb(nm,24),nornb(nm) + character*1 ulq(nm,9),chax + character*7 nosymq + character*8 noteq + character*79 notexq,outq + character*80 soutq + logical btest,isleft,isright,beamon + character*79 inameq + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /commidisig/ midisig + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) +c +c This subr. once produced notexq for entire chord. 10/18/97 altered to write +c chord notes as we go. 10/22/97 find range of icrd first. +c 2/25/98 moved rangefinding to precrd so done before slurs, so now +c on entry, icrd1, icrd2 define range of icrd for this chord. +c +c Set counter (for this note) for chord notes present. Set notmain=T. +c Will test for notmain=.true. in addmidi to tell whether to save pitch. +c + nmidcrd = 0 + notmain = .true. + crdacc = .false. + do 5 icrd = icrd1 , icrd2 + lnote = 0 + nolev = igetbits(icrdat(icrd),7,12) +c +c 3/8/03 save original pitch to use in midi, in case 2nds alter things. +c + nolevo = nolev +c +c Check for special situations with 2nds (see precrd). +c + if (btest(nacc,30) .and. nolev.eq.nolevm-1) then +c +c Upstem, 2nd with upper as main, interchange pitches, +c rt-shift upper (now chord note). Lower (orig chord, now main) +c if dotted, probably had shifted dot, dot parameters must be moved +c from chord to main +c + nolev = nolevm + if (btest(icrdat(icrd),26)) then +c +c Orig. chord note dot shift, must transfer to main. +c + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + if (btest(irest(ivx,ip),19)) then +c +c Main note (upper) had a dot shift, must move it to chord +c + call setbits(icrdat(icrd),1,26,1) + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c May need to worry about other chord params (accid shefts etc) later +c + else + icrdat(icrd) = ibclr(icrdat(icrd),26) + end if +c +c We are adding a main note dot shift, so push any later ones back +c + + if (.not.btest(irest(ivx,ip),19)) then + maxdotmv(ivx) = maxdotmv(ivx)+1 + do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1 + updot(ivx,indm) = updot(ivx,indm-1) + rtdot(ivx,indm) = rtdot(ivx,indm-1) +1 continue + end if + irest(ivx,ip) = ibset(irest(ivx,ip),19) + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + end if + else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then +c +c Downstem, 2nd with lower as main, interchange pitches, +c left-shift lower (now chord note). Lower (orig main, now chord) +c probably had shifted dot, dot parameters must be moved from +c main to chord +c + nolev = nolevm + if (btest(irest(ivx,ip),19)) then + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + icrdat(icrd) = ibset(icrdat(icrd),26) +c bits in icrdot +c 0-6 10*abs(vertical dot shift in \internote) + 64 +c 7-13 10*abs(horizontal dot shift in \internote) + 64 +c Assuming >0 for now! + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c Must also set dot shift for (now) main note (orig. chord note). +c + if (btest(icrdatsav,26)) then + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + else +c +c No dot move on original chord (now main) note, +c + updot(ivx,ndotmv(ivx)+1) = 0. + rtdot(ivx,ndotmv(ivx)+1) = 0. + end if + end if + end if +c +c Lower dot for lower-voice notes?. Conditions are: +c 1. Dotted time value +c 2. Lower voice of two +c 3. Note is on a line +c 4. Not a rest (cannot be a rest in a chord!) +c. 5. Flag (lowdot) is set to true +c + if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then + if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then + if (btest(icrdat(icrd),26)) then +c +c Note already in movdot list. Drop by 2. +c + call setbits(icrdot(icrd),7,0, + * igetbits(icrdot(icrd),7,0)-20) + else +c +c Not in list so just move it right now +c + call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) + end if + end if + end if + if (btest(icrdat(icrd),26)) then +c +c Move the dot. Basic call for chord notes, not main note. +c + updotc = 0.1*(iand(127,icrdot(icrd))-64) + rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) + call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) + end if + isleft = btest(icrdat(icrd),23) + isright = btest(icrdat(icrd),24) +c +c Check for ornament in chord. +c + if (icrdorn(icrd) .gt. 0) then + call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, + * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, + * ip,0,beamon,.true.) + call addstr(outq,lout,soutq,lsout) + end if +c +c Chord-note symbol. First check for breve +c + if (nodu .eq. 128) then + nosymq = chax(92)//'zbreve' + lsym = 7 + else +c +c Not a breve chord. Get first letters in chord-note symbol +c + if (isleft) then + nosymq = chax(92)//'l' + else if (isright) then + nosymq = chax(92)//'r' + else + nosymq = chax(92)//'z' + end if + if (nodu .ge. 64) then + nosymq = nosymq(1:2)//'w' + else if (nodu .ge. 32) then + nosymq = nosymq(1:2)//'h' + else + nosymq = nosymq(1:2)//'q' + end if + if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then + lsym = 3 + else if (.not.btest(islur,3) .or. dotxtup) then +c +c Single dot +c + nosymq = nosymq(1:3)//'p' + lsym = 4 + else +c +c Double dot +c + nosymq = nosymq(1:3)//'pp' + lsym = 5 + end if + end if + if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then +c +c Accidental and not MIDI-only. Build up bits 0-3 of nacc +c + nactmp = igetbits(icrdat(icrd),3,20) +c +c Kluge for bigness. Only means 'As' has not been issued +c + if (bacfac .ne. 1.e6) nactmp = nactmp+8 + call doacc(igetbits(icrdot(icrd),7,20)-107, + * igetbits(icrdot(icrd),6,14), +c * notexq,lnote,nactmp,nolev,ncmid(iv,ip)) +c Get original nolev, not altered to deal with 2nds + * notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12), +c * ncmid(iv,ip)) + * ncmid(iv,ip),btest(icrdat(icrd),31)) + notexq = notexq(1:lnote)//nosymq + crdacc = .true. + else + notexq = nosymq + end if + lnote = lnote+lsym +c +c Get note name (again if accid, due to possible octave jump) +c + call notefq(noteq,lnoten,nolev,ncm) + if (lnoten.eq.1) call addblank(noteq,lnoten) +c +c Put in note name +c + notexq = notexq(1:lnote)//noteq + lnote = lnote+lnoten + if (btest(icrdat(icrd),25)) then +c +c Arpeggio signal +c + call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout) + end if + call addstr(notexq,lnote,soutq,lsout) + if (ismidi) then +c +c Here is where we collect MIDI pitch info for the chord note. By checking +c notmain, addmidi(...) knows to just compute the +c pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() +c for MAIN note, will put in note codes for all chord notes + main note. +c + kv = 1 + if (ivx .gt. iv) kv=2 + nmidcrd = nmidcrd+1 + if (nmidcrd .gt. 20) then + print* + print*,'21 chord notes is too many for midi processor' + call stop1() + end if +c +c Use original saved pitch level, unaltered by 2nds logic. +c + call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)), + * igetbits(icrdat(icrd),3,20),midisig,1., + * .false.,.false.) + end if +5 continue + notmain = .false. + return + end + subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv, + * beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout) + parameter (nm=24) +c +c Inputs are array *elements* except ihornb,nornb,ulq +c + common /commus/ musize,whead20 + common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), + * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), + * idynda2(99),levhssav(nm),listcresc,listdecresc + character*128 txtdynq + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + logical btest,beamon,upstem,nostem + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + logical fontslur,upslur,WrotePsslurDefaults + character*1 udqq,chax,ulq(nm,9) + character*4 dynstrq + character*5 numpq + character*48 dyntablq,tempq + character*79 notexq + character*80 soutq + integer*4 ihornb(nm,24),nornb(nm),idynn(10) + common /comhair/ ihairuse,idhair(nm) + data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/ + numdyn = 0 +c +c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values +c in idynn(1...4) +c + do 1 idyn = 1 , ndyn + ivxtent = iand(idyndat(idyn),15) + * +16*igetbits(idynda2(idyn),1,10) + if (ivxtent .eq. ivx) then + iptent = igetbits(idyndat(idyn),8,4) + if (iptent .eq. ip) then + numdyn = numdyn+1 + idynn(numdyn) = idyn + else if (iptent .gt. ip) then +c +c I don't think there are any more possible for this ivx,ip, so exit loop +c + go to 2 + end if + end if +1 continue +2 continue +c +c At this point there is a list of idyn's in idynn(1...numdyn) +c Compute level, and stem-dir'n-based horizontal tweaks +c + hoffsd = 0. +c +c Set upstem to false as default +c + upstem = .false. + if (btest(irest,0)) then +c +c It's a rest. Assume it doesn't go below the staff +c + lbot = ncm-4 + else if (.not.beamon) then + if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then + upstem = .true. + if (.not.btest(ipl,10)) then + lbot = min(nolev-1,ncm-4) + else + lbot = min(minlev-1,ncm-4) + end if + else + hoffsd = -.5 + if (.not.btest(ipl,10)) then + lbot = min(nolev-7,ncm-4) + else + lbot = min(minlev-7,ncm-4) + end if + end if + else + if (ulq(ivx,ibmcnt) .eq. 'u') then + upstem = .true. + if (.not.btest(ipl,10)) then + lbot = min(nolev-1,ncm-4) + else + lbot = min(minlev-1,ncm-4) + end if + else + hoffsd = -.5 +c +c 171230 Desperation +c lbot = ihornb(ivx,nornb(ivx))+1 + if (nornb(ivx).eq.0) then + lbot = 1 + else + lbot = ihornb(ivx,nornb(ivx))+1 + end if + if (lbot .eq. 1) then +c +c Kluge for non-beamed, down xtup, for which ihorb was never set. +c Assumes stem is shortened. +c + lbot = nolev-5 + end if + nornb(ivx) = nornb(ivx)+1 + end if + end if + lbot = lbot-5 + jtxtdyn1 = 1 +c +c Now ready to loop over current dyn's +c + do 3 icntdyn = 1 , numdyn + idynd = idyndat(idynn(icntdyn)) + idynd2 = idynda2(idynn(icntdyn)) + idno = igetbits(idynd,4,12) +c ivx = iand(15,idynd) + ivx = iand(15,idynd)+16*igetbits(idynd2,1,10) +c +c Build the command into notex in stages. Insert name & rq'd args in order: +c +c Command name +c hpstrt, hpcend, hpdend, pmxdyn +c ivx +c X X X +c level +c X X X +c hoff +c X X X X +c d-mark +c X +c + if (idno .eq. 0) then +c +c Text-dynamic +c + notexq = chax(92)//'txtdyn' + lnote = 7 + else if (idno .le. 12) then +c +c Letter-group +c + notexq = chax(92)//'pmxdyn' + lnote = 7 + else if (fontslur) then + lnote = 7 + if (idno .eq. 13) then +c +c Start a font-based hairpin +c + notexq = chax(92)//'hpstrt' + else if (idno .eq. 14) then +c +c End crescendo +c + notexq = chax(92)//'hpcend' + else +c +c End decrescendo +c + notexq = chax(92)//'hpdend' + end if +c +c Put in voice number as ID for font-based hairpin +c + if (ivx .le. 9) then + notexq = notexq(1:lnote)//char(48+ivx) + lnote = lnote+1 + else if (ivx .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' + lnote = lnote+4 + end if + else +c +c Postscript hairpins +c + lnote = 7 + if (idno .eq. 13) then + notexq = chax(92)//'Icresc' + else if (idno .eq.14) then + notexq = chax(92)//'Idecresc' + lnote = 9 + else + notexq = chax(92)//'Tcresc' + end if + if (idno .le. 14) then +c +c Get and record ID no for start of ps hairpin +c Find first unused ID +c + do 8 idh = 1 , 24 + if (.not.btest(ihairuse,idh)) go to 9 +8 continue + call printl('Bad place in putdyn, call Dr. Don') + call stop1() +9 continue + ihairuse = ibset(ihairuse,idh) + idhair(ivx) = idh + else +c +c Unrecord ID no for end of ps hairpin +c + call setbits(ihairuse,1,idhair(ivx),0) + end if +c +c Write ID # for start or end of ps hairpin +c + idh = idhair(ivx) + if (idh .le. 9) then + notexq = notexq(1:lnote)//char(48+idh) + lnote = lnote+1 + else if (idh .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}' + lnote = lnote+4 + end if + end if +c +c Begin setting level +c + lbot1 = lbot + if (idno.gt.0 .and. idno.le.5) then +c +c All letters are short so raise a bit. +c + lbot1 = lbot1+1 + else if (idno .ge. 13) then + lbot1 = lbot1+2 + end if +c +c Convert so reference is bottom line +c + lbot1 = lbot1-ncm+4 + if ((fontslur.and.idno.eq.13) .or. + * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then +c +c Hairpin start. Save level and user-tweak before applying user tweak. +c + levdsav(ivx) = lbot1 + levhssav(ivx) = 0 + if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17) + else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then +c +c Hairpin end; Compare level with saved start level before user-tweaks +c + lbot1 = min(lbot1,levdsav(ivx)) +c +c Save pre-tweak level +c + lpretweak = lbot1 + end if +c +c Check for user-defined vertical tweak +c + if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17) +c +c Now horizontal stuff +c + hoff = hoffsd +c +c Some special horizontal tweaks +c + if (upstem .and. idno.gt.0 .and. + * (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4 +c +c User-defined tweaks +c + if (btest(idynd2,0)) + * hoff = hoff+(igetbits(idynd2,9,1)-256)*.1 + if (numdyn .gt. 1) then +c +c Horizontal-interaction-based tweaks. +c +c Cases: +c numdyn type1 type2 type3 data used +c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12) +c 2 hrpnend wrd-grp - ivowg,hoh2 +c 2 hrpnend hrpnstrt - hoh2h1(1...2) +c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 +c + if (idno.gt.0 .and. idno.le.12) then +c +c Word-group, may need vertical tweak to line up. +c + lbot1 = lbot1+ivowg(idno) +c +c Protecting against hp start-stop on same note +c + else if (((fontslur.and.idno.ge.14).or.idno.eq.15) + * .and. icntdyn.lt.numdyn) then +c +c Hairpin ending, check next type +c + if ((fontslur .and. + * igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) + * .or. (.not.fontslur .and. + * ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13) + * .or. + * (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14)))) + * then +c +c Hairpin end then hairpin start, no words, (remember dealing with end now) +c + hoff = hoff+hoh2h1(1) + else +c +c Hairpin end then word-group, need idno for w-g to set hp offset +c + hoff = hoff + + * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12)) + end if +c +c Protecting against hp start-stop on same note +c + else if (icntdyn.gt.1 .and. idno.gt.0 .and. + * ((fontslur.and.idno.lt.14).or. + * (.not.fontslur.and.idno.lt.15))) then +c +c Hairpin start, check prior type +c + if ((fontslur.and. + * igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14) + * .or. + * (.not.fontslur.and. + * igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15)) + * then +c +c Hairpin end then hairpin start, (remember dealing with start now) +c + hoff = hoff+hoh2h1(2) + else +c +c Hairpin start after word-group, need idno for w-g to set hp offset +c + hoff = hoff+ + * hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12)) + end if + end if + end if +c +c End of if-block for 2- or 3-way interactions. +c + if ((.not.fontslur) .and. idno.ge.13) +c +c Slur font and hairpin. Add hoff, and change from \interneote to \qn@width +c + * hoff = (hoff+.5)*6./2.5 +c +c Position corrections all done now. Put in the level. +c + if ((fontslur.and.idno.eq.13) .or. + * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then +c +c Hairpin start. +c + if (.not.fontslur) then +c +c Postscript hairpin start...inset placeholder for start level. + + notexq = notexq(1:lnote)//'{ }' + lnote = lnote+5 + end if + else +c +c Insert actual level in all cases except hairpin start +c Create string with level in it +c + if (lbot1 .gt. 9) then + numpq = '{' + write(numpq(2:3),'(i2)')lbot1 + numpq = numpq(1:3)//'}' + lnumpq = 4 + else if (lbot1 .gt. -1) then + numpq = char(48+lbot1) + lnumpq = 1 + else if (lbot1 .gt. -10) then + numpq = '{' + write(numpq(2:3),'(i2)')lbot1 + numpq = numpq(1:3)//'}' + lnumpq = 4 + else + numpq = '{' + write(numpq(2:4),'(i3)')lbot1 + numpq = numpq(1:4)//'}' + lnumpq = 5 + end if +c +c Level has now been computed and stored in numpq +c Append the level +c + notexq = notexq(1:lnote)//numpq(1:lnumpq) + lnote = lnote+lnumpq + end if + if (abs(hoff) .lt. .001) then +c +c No horiz offset +c + notexq = notexq(1:lnote)//'0' + lnote = lnote+1 + else +c +c Horizontal tweak +c + lform = lfmt1(hoff) + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + write(notexq(lnote+1:lnote+lform), + * '(f'//chax(48+lform)//'.1)')hoff + lnote = lnote+lform + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + if (idno .eq. 0) then +c +c text-dynamic. Find the string and append it +c + do 4 jtxtdyn = jtxtdyn1 , ntxtdyn +c ivxip = ivx+16*ip + ivxip = ivx+32*ip + if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5 +4 continue + call printl('Abnormal stop in putdyn') + call stop1() +5 continue + ltxtdyn = lenstr(txtdynq(jtxtdyn),128) +c +c Font size based on musicsize +c +c if (musize .eq. 20) then +c notexq = notexq(1:lnote)//'{'//char(92)//'medtype' +c * //char(92)//'it ' +c lnote = lnote+13 +c else if (musize .eq. 16) then +c notexq = notexq(1:lnote)//'{'//char(92)//'normtype' +c * //char(92)//'it ' +c lnote = lnote+14 +c else if (musize .eq. 24) then +c notexq = notexq(1:lnote)//'{'//char(92)//'bigtype' +c * //char(92)//'it ' +c lnote = lnote+13 +c else if (musize .eq. 29) then +c notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype' +c * //char(92)//'it ' +c lnote = lnote+13 +c end if +c +c Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) +c + call addstr(notexq(1:lnote),lnote,soutq,lsout) + if (musize .eq. 20) then + notexq = '{'//char(92)//'medtype'//char(92)//'it ' + lnote = 13 + else if (musize .eq. 16) then + notexq = '{'//char(92)//'normtype'//char(92)//'it ' + lnote = 14 + else if (musize .eq. 24) then + notexq = '{'//char(92)//'bigtype'//char(92)//'it ' + lnote = 13 + else if (musize .eq. 29) then + notexq = '{'//char(92)//'Bigtype'//char(92)//'it ' + lnote = 13 + end if +c + notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)//'}' + lnote = lnote+ltxtdyn+1 +c +c Reset jtxtdyn1 just in case >1 txtdyn on same note. +c + jtxtdyn1 = jtxtdyn+1 + else if (idno .le. 12) then +c +c Letter-group dynamic. Append the letter-group command +c + id = 4*idno + dynstrq = dyntablq(id-3:id) + id = lenstr(dynstrq,4) + notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id) + lnote = lnote+1+id + end if + call addstr(notexq(1:lnote),lnote,soutq,lsout) + if ((.not.fontslur).and.idno.eq.15) then +c +c PS slurs on, hairpin is ending. Go back and set height at beginning. +c Add user-defined tweak to default level +c + lbot1 = lpretweak+levhssav(ivx) + if (lbot1 .gt. 9) then + numpq = '{' + write(numpq(2:3),'(i2)')lbot1 + numpq = numpq(1:3)//'}' + lnumpq = 4 + else if (lbot1 .gt. -1) then + numpq = char(48+lbot1) + lnumpq = 1 + else if (lbot1 .gt. -10) then + numpq = '{' + write(numpq(2:3),'(i2)')lbot1 + numpq = numpq(1:3)//'}' + lnumpq = 4 + else + numpq = '{' + write(numpq(2:4),'(i3)')lbot1 + numpq = numpq(1:4)//'}' + lnumpq = 5 + end if +c +c Construct string to search backwards for placeholder +c + if (idh .le. 9) then + tempq = 'cresc'//char(48+idh)//'{ }' + ltemp = 11 + else if (idh .le. 19) then + tempq = 'cresc'//'{1'//char(38+idh)//'}{ }' + ltemp = 14 + else + tempq = 'cresc'//'{2'//char(28+idh)//'}{ }' + ltemp = 14 + end if + write(11,'(a)')soutq(1:lsout)//'%' + lsout = 0 + call backfill(11,tempq,ltemp, + * tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq) + end if +3 continue +c +c Shrink arrays, decrease ndyn 111109 +c + do 6 icntdyn = numdyn, 1 , -1 + do 7 jdyn = idynn(icntdyn) , ndyn-1 + idyndat(jdyn) = idyndat(jdyn+1) + idynda2(jdyn) = idynda2(jdyn+1) +7 continue + ndyn = ndyn-1 +6 continue + end + subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl, + * farend, + * beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno) +c +c ip will be one LESS than current note, for way-after's before bar-end, +c It is only used to find ig. +c ig is returned to makeabar in case there's a slur that needs to be ended +c + parameter (nm=24) + logical beamon,stemup + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /comoct/ noctup + logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft, + * normsp,farend,fontslur,WrotePsslurDefaults + real*4 ptgr(37) + character*80 soutq + character*128 litq + character*79 notexq + character*20 voltxtq + character*10 figq + character*8 noteq,noteqGA + character*3 acsymq + character*1 sq,chax,udqq,ulq(nm,9) + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + sq = chax(92) + isgaft = btest(ipl,29) + iswaft = btest(ipl,31) + normsp = .not. isgaft +c +c Find ig. +c + do 120 ig = 1 , ngrace + if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121 +120 continue + print*,'Problem finding grace index in dograce' + stop +121 continue + ngs = ngstrt(ig) + mg = multg(ig) +c wheadpt1 = wheadpt*fullsize(ivx) + wheadpt1 = wheadpt*fullsize(instno) +c +c For way-after-graces at end of bar, must set the octave. +c + if (farend) then + noctup = 0 + if (ncm .eq.23) noctup = -2 + end if + if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then + if (listslur .eq. 16777215) then + print* + print*,'You defined the twentyfifth slur, one too many!' + write(15,'(/,a)') + * 'You defined the twentyfifth slur, one too many!' + call stop1() + end if +c +c Slur on fore-grace. Get index of next slur not in use, from 23 down. +c + ndxslur = log2(16777215-listslur) + + end if + if (nng(ig) .eq. 1) then +c +c Single grace. +c + if (normsp) then +c +c Anything but GA +c + call addstr(sq//'shlft',6,soutq,lsout) + niptgr = nint(ptgr(ig)) +c +c Empirical tweak for postscript. +c +C if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) +c++ + if (niptgr .lt. 10) then + call addstr(chax(48+niptgr)//'{',2,soutq,lsout) + else if (niptgr .lt. 100) then + write(notexq(1:2),'(i2)')niptgr + call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout) + else + print*, + * 'Call Dr. Don if you really want grace note group > 99 pt' + stop + end if + else + call addstr(sq//'gaft{1.5}{',11,soutq,lsout) +c +c GA. Compute aftshft, for later use. +c + aftshft = grafac + if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac + aftshft = aftshft*wheadpt + end if + if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then +c +c Start slur on pre-grace. No accounting needed since will be ended very soon. +c + call notefq(noteq,lnoten,nolevg(ngs),ncm) + if (fontslur) then + if (upg(ig)) then + call addstr(sq//'islurd',7,soutq,lsout) + else + call addstr(sq//'isluru',7,soutq,lsout) + end if + else +c +c Start Postscript slur. +c + if (upg(ig)) then + call addstr(sq//'isd',4,soutq,lsout) + else + call addstr(sq//'isu',4,soutq,lsout) + end if + end if +c +c Print slur number, 23-ndxslur +c + lnote = 0 + if (23-ndxslur .lt. 10) then +c notexq = notexq(1:lnote)//chax(59-ndxslur) + notexq = chax(71-ndxslur) + lnote = 1 + else if (23-ndxslur .lt. 20) then +c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' + notexq = '{1'//chax(61-ndxslur)//'}' + lnote = 4 + else + notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' + lnote = 4 + end if + call addstr(notexq(1:lnote)//noteq(1:lnoten), + * lnote+lnoten,soutq,lsout) + if (.not.fontslur) then +c +c Horizontal tweaks for postscript slur on single grace +c + stemup = .true. + if (upg(ig)) then +c +c Check for up-grace + down stem. Get stem direction +c + if (.not.beamon) then +c +c Separate note. Get stem direction. +c + stemup = udqq(nolev,ncmidx, + * islur,nvmx,ivx,nv) .eq. 'u' + else +c +c In a beam +c + stemup = ulq(ivx,ibmcnt) .eq. 'u' + end if +c +c Stop the shift if whole note +c + stemup = stemup .or. tnote.gt.63 + end if + if (stemup) then + call addstr('{-.3}',5,soutq,lsout) + else + call addstr('{-.8}',5,soutq,lsout) + end if + end if + end if + if (naccg(ngs) .gt. 0) then + call notefq(noteq,lnoten,nolevg(ngs),ncm) +c +c Save for checking octave shifts in GA +c + if (isgaft) then + lnotenGA = lnoten + noteqGA = noteq + end if +c + if (lnoten .eq. 1) call addblank(noteq,lnoten) + call accsym(naccg(ngs),acsymq,lacc) + call addstr(sq//'big'//acsymq(1:lacc)// + * noteq(1:lnoten),4+lacc+lnoten,soutq,lsout) + end if + if (slashg(ig)) then + notexq = sq//'grc' + lnote = 4 + else if (mg .eq. 0) then + notexq = sq//'zq' + lnote = 3 + else + notexq = sq//'zc' + do 61 i = 2 , mg + notexq = notexq(1:i+1)//'c' +61 continue + lnote = mg+2 + end if + if (upg(ig)) then + notexq = notexq(1:lnote)//'u' + else + notexq = notexq(1:lnote)//'l' + end if + call addstr(notexq,lnote+1,soutq,lsout) + call notefq(noteq,lnoten,nolevg(ngs),ncm) +c + if (isgaft .and. naccg(ngs).eq.0) then + lnotenGA = lnoten + noteqGA = noteq + end if +c + if (lnoten .eq. 1) call addblank(noteq,lnoten) + call addstr(noteq,lnoten,soutq,lsout) + if (slashg(ig)) call addstr(sq//'off{-'//sq// + * 'noteskip}',16,soutq,lsout) +c +c Above code needed since slashg causes spacing +c + if (slurg(ig) .and. (iswaft.or.isgaft)) then +c +c Terminate slur on single after-grace +c + ndxslur = igetbits(ipl,5,23) + call notefq(noteq,lnoten,nolevg(ngs),ncm) + call addstr(sq//'tslur',6,soutq,lsout) +c +c Print 24-ndxslur +c +c if (11-ndxslur .lt. 10) then + if (23-ndxslur .lt. 10) then +c call addstr(chax(59-ndxslur)//noteq(1:lnoten), + call addstr(chax(71-ndxslur)//noteq(1:lnoten), + * 1+lnoten,soutq,lsout) + else if (23-ndxslur .lt. 20) then + call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten), + * 4+lnoten,soutq,lsout) + else +c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), + call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten), + * 4+lnoten,soutq,lsout) + end if + slurg(ig) = .false. + listslur = ibclr(listslur,ndxslur) + end if + call addstr('}',1,soutq,lsout) +c +c+++ Try to fix loss of octave with single gaft +c + if (isgaft) then + itrans = 0 + do 1 i = 1 , lnotenGA + if (noteqGA(i:i) .eq. chax(39)) then + itrans = itrans+7 + else if (noteqGA(i:i) .eq. chax(96)) then + itrans = itrans-7 + end if +1 continue + if (itrans. eq. -14) then + call addstr(sq//'advance'//sq//'transpose-14',21, + * soutq,lsout) + else if (itrans .eq. -7) then + call addstr(sq//'advance'//sq//'transpose-7',20, + * soutq,lsout) + else if (itrans .eq. 7) then + call addstr(sq//'advance'//sq//'transpose7',19, + * soutq,lsout) + else if (itrans .eq. 14) then + call addstr(sq//'advance'//sq//'transpose14',20, + * soutq,lsout) + end if + end if + else +c +c Multiple grace. Put in literally. Compute beam stuff +c + sumx = 0. + sumy = 0. + sumxy = 0. + sumxx = 0. + sumyy = 0. + x = 0. + do 118 ing = ngs , ngs+nng(ig)-1 + if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac + y = nolevg(ing) + sumx = sumx + x + sumy = sumy + y + sumxy = sumxy + x*y + sumxx = sumxx + x*x + sumyy = sumyy + y*y + x = x+emgfac +118 continue + delta = nng(ig)*sumxx-sumx*sumx + em = (nng(ig)*sumxy-sumx*sumy)/delta + islope = nint(0.5*em*gslfac) + if (iabs(islope) .gt. 9) islope = isign(9,islope) + beta = (sumy-islope/gslfac*sumx)/nng(ig) + nolev1 = nint(beta) +c +c Back up +c + notexq = sq//'settiny'//sq//'off{' + if (normsp) then + write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig) + call addstr(notexq(1:18)//'pt}',21,soutq,lsout) + finalshift = ptgr(ig) + else + aftshft = wheadpt*1.33 + if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5 + write(notexq(14:17),'(f4.1)')aftshft + call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout) + end if +c +c Start the beam +c + notexq = sq//'ib' + do 119 ing = 2 , mg + notexq = notexq(1:ing+1)//'b' +119 continue + if (upg(ig)) then + notexq = notexq(1:mg+2)//'u' + else + notexq = notexq(1:mg+2)//'l' + end if + notexq = notexq(1:mg+3)//'0' +c +c Get starting note for beam +c + call notefq(noteq,lnoten,nolev1,ncm) + call addstr(notexq(1:mg+4)//noteq(1:lnoten), + * mg+4+lnoten,soutq,lsout) +c +c Put in the slope +c + if (islope .ge. 0) then + call addstr(chax(48+islope),1,soutq,lsout) + else + call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout) + end if +c +c Start a slur on multiple fore-grace +c + if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then + call notefq(noteq,lnoten,nolevg(ngs),ncm) + if (fontslur) then + if (upg(ig)) then + call addstr(sq//'islurd',7,soutq,lsout) + else + call addstr(sq//'isluru',7,soutq,lsout) + end if + else +c +c Need a tweak for postscript slur +c + if (upg(ig)) then + call addstr(sq//'isd',4,soutq,lsout) + else + call addstr(sq//'isu',4,soutq,lsout) + end if + end if +c +c Print 23-ndxslur +c + if (23-ndxslur .lt. 10) then + call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten, + * soutq,lsout) + else if (23-ndxslur .lt. 2) then + call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten), + * 4+lnoten,soutq,lsout) + else + call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten), + * 4+lnoten,soutq,lsout) + end if +c +c Put in tweak for postscript slur +c + if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout) + end if +c +c Put in first note. Call notefq again in case octave changed +c + call notefq(noteq,lnoten,nolevg(ngs),ncm) + if (naccg(ngs) .eq. 0) then + notexq = sq//'zqb0'//noteq(1:lnoten) + lnote = 5+lnoten + else + if (lnoten .eq. 1) call addblank(noteq,lnoten) + call accsym(naccg(ngs),acsymq,lacc) + notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten) + lnote = 4+lacc+lnoten + call notefq(noteq,lnoten,nolevg(ngs),ncm) + notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten) + lnote = lnote+5+lnoten + end if + call addstr(notexq,lnote,soutq,lsout) + do 127 ing = ngs+1 , ngs+nng(ig)-1 +c +c Skip +c + ptoff = wheadpt1*emgfac + if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac + if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff + notexq = sq//'off{' + write(notexq(6:8),'(f3.1)')ptoff + if (normsp) finalshift = finalshift-ptoff + call addstr(notexq(1:8)//'pt}',11,soutq,lsout) + if (ing .eq. ngs+nng(ig)-1) then +c +c Terminate beam if needed +c + if (upg(ig)) then + call addstr(sq//'tbu0',5,soutq,lsout) + else + call addstr(sq//'tbl0',5,soutq,lsout) + end if +c +c Terminate after slur if needed +c + if ((isgaft.or.iswaft) .and. slurg(ig)) then +c if (iswaft) ndxslur = igetbits(ipl,4,23) + if (iswaft) ndxslur = igetbits(ipl,5,23) + call notefq(noteq,lnoten,nolevg(ing),ncm) + call addstr(sq//'tslur',6,soutq,lsout) +c +c Print 11-ndxslur +cc Print 23-ndxslur +c + if (23-ndxslur .lt. 10) then + call addstr(chax(71-ndxslur)//noteq(1:lnoten), + * 1+lnoten,soutq,lsout) + else if (23-ndxslur .lt. 20) then + call addstr('{2'//chax(61-ndxslur)//'}' + * //noteq(1:lnoten),4+lnoten,soutq,lsout) + else + call addstr('{1'//chax(51-ndxslur)//'}' + * //noteq(1:lnoten),4+lnoten,soutq,lsout) + end if +c +c Stop slur terminator after exit from this subroutine +c + listslur = ibclr(listslur,ndxslur) + slurg(ig) = .false. + end if + end if +c +c Accidental if needed +c + if (naccg(ing).gt.0) then + call notefq(noteq,lnoten,nolevg(ing),ncm) + if (lnoten .eq. 1) call addblank(noteq,lnoten) + call accsym(naccg(ing),acsymq,lacc) + call addstr(sq//'big'//acsymq(1:lacc) + * //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout) + end if +c +c Put in the (beamed) grace note +c + call notefq(noteq,lnoten,nolevg(ing),ncm) + call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten, + * soutq,lsout) +127 continue +c +c Terminate the grace +c +c notexq = sq//'normalnotesize'//sq//'off{' +c lnote = 20 +c notexq = '}'//sq//'off{' +c lnote = 6 + notexq = sq//'off{' + lnote = 5 + ptoff = wheadpt*emgfac + if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17)) + * ptoff = ptoff+wheadpt*accfac + if (isgaft .and. .not.iswaft) then + notexq = notexq(1:5)//'-' + lnote = 6 + ptoff = aftshft + end if + if (normsp) ptoff = finalshift + if (ptoff .lt. 9.95) then + write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff + lnote = lnote+3 + else if (ptoff .lt. 99.95) then + write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff + lnote = lnote+4 + else + write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff + lnote = lnote+5 + end if + call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout) + if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout) + call addstr(sq//'resetsize',10,soutq,lsout) + end if + return + end + subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip, + * iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur, + * ipl,iornq,islhgt,tno,nacc) +c +c Called once per main note. +c 12 May 2002 Create this subroutine to isolate postscript slurs/ties. +c Always set \Nosluradjust\Notieadjust +c + parameter (nm=24,mv=24576) + integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /comsln/ is1n1,is2n1,irzbnd,isnx + character*1 ulq,slurudq,udfq,udqq,chax + character*79 notexq + character*8 noteq + character*80 soutq + logical upslur,beamon,btest,stemup,iscrd, + * settie,fontslur,pstie,WrotePsslurDefaults + logical slmon,dbltie + common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), + * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, + * slmon(0:nm),dbltie + integer*2 mmidi,iinsiv + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans +c 130316 + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) +c +c Bits in isdat1: +c 13-17 iv +c 3-10 ip +c 11 start/stop switch +c 12 kv-1 +c 19-25 ichar(code$) +c 26 force direction? + +c 27 forced dir'n = up if on, set in sslur; also +c final direction, set in doslur when beam is started, used on term. +c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. +c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. +c 2 stem slur flag +c 1 flag for "x" slur (voice-independent) +c +c Bits in isdat2 +c 0 Chord switch. Not set on main note. +c 1-2 left/right notehead shift. Set only for chord note. +c 3 tie positioning +c 4 dotted flag +c 6-11 voff1 1-63 => -31...+31 +c 12-18 hoff1 1-127 => -6.3...+6.3 +c 19-25 nolev +c 26 \sluradjust (p+s) +c 27 \nosluradjust (p-s) +c 28 \tieadjust (p+t) +c 29 \notieadjust (p-t) +c +c Bits in isdat3: Only used for slur endings +c 0 set if midslur (at least one argument) +c 1 set if curve (2 more args) +c 2-7 32+first arg (height correction) (1st arg may be negative) +c 8-10 second arg (initial slope) +c 11-13 third arg (closing slope) +c 14-21 tie level for use in LineBreakTies +c 22-29 ncm for use in LineBreakTies +c +c Bits in isdat4 Only used for linebreak slurs +c 0-5 Linebreak seg 1 voff 1-63 => -31...+31 +c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 +c 16-21 Linebreak seg 2 voff 1-63 => -31...+31 +c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 +c +c In listslur bit ib is on if slur index ib is in use, ib=0-13. +c ndxslur = slur index +c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, +c s-slur is blank (idcode=32), t-slur is idcode=1. +c ivoff is user-defined shift or shift due to . or _ , or chord adjustment. +c Ivoff will be set for ./_ only if no user-defined shift is specified. +c If highest note has upslur, save slur height in islhgt in case +c ornament must be moved. +c + islhgt = 0 + if (beamon) then + stemup = ulq .eq. 'u' + else if (nvmx(iv) .eq. 2) then + if (.not.btest(islur,30)) then +c +c Single note, 2 lines of music, stem direction not forced +c + stemup = ivx .gt. nv + else + stemup = btest(islur,17) + end if + else + stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u' + end if + iscrd = btest(ipl,10) + if (ismidi) then + settie = .false. + dbltie = .false. + end if + do 1 isdat = 1 , nsdat + isdata = isdat1(isdat) + if (iv .eq. igetbits(isdata,5,13) .and. + * ip .eq. igetbits(isdata,8,3) .and. +c * kv .eq. igetbits(isdata,1,12)+1) then + * (kv .eq. igetbits(isdata,1,12)+1 .or. + * btest(isdata,1))) then +c +c Since iv and kv match, ivx will be correct +c + idcode = igetbits(isdata,7,19) + ivoff = igetbits(isdat2(isdat),6,6)-32 + ihoff = igetbits(isdat2(isdat),7,12)-64 + iupdn = 0 + slurudq = 'd' + nolevs = igetbits(isdat2(isdat),7,19) + pstie = btest(isdat2(isdat),3) .or. idcode.eq.1 + if (btest(isdata,11)) then +c +c Turnon +c Get slur direction +c + if (btest(isdata,26)) then +c +c Force slur direction +c + if (btest(isdata,27)) slurudq = 'u' + else if (nvmx(iv) .eq. 1) then +c +c Only one voice per line +c + if (.not.beamon) then +c +c Separate note. +c + slurudq = udfq(nolev,ncm) + else +c +c In a beam +c + if (ulq .ne. 'u') slurudq = 'u' + end if + if (iscrd) then + if (nolevs .gt. ncm) then + slurudq = 'u' + else + slurudq = 'd' + end if + end if + else +c +c Two voices per line. Get default +c + if (ivx .gt. nv) slurudq = 'u' +c +c Upper voice of the two, so up slur +c + end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if +c +c Set level for slur starting on rest +c + if (nolevs.eq.0 .or. nolevs.gt.60) then + if (slurudq .eq. 'u') then + nolevs = ncm+2 + else + nolevs = ncm-2 + end if + end if +c +c Save up/down-ness for use at termination +c + if (slurudq .eq. 'u') isdata = ibset(isdata,27) +c +c End of section for setting slur direction, still in "Turnon" if-block. +c + if (btest(iornq,11).or.btest(iornq,12)) then +c +c Raise or lower slur by one unit provided . or _ is on same side as slur +c + ivoffinc = 0 + if ((stemup .and. slurudq.eq.'d') .or. + * (.not.stemup .and. slurudq.eq.'u')) then +c +c Must move the slur for _ or . +c + if (stemup) then + ivoffinc = -1 + else + ivoffinc = 1 + end if + if (((stemup .and. nolev.ge.ncm-2) .or. + * (.not.stemup .and. nolev.le.ncm+2)) .and. + * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc + ivoff = ivoff+ivoffinc + end if + end if + if (listslur .eq. 16777215) then + print* + print*,'You1 defined the twentyfifth slur, one too many!' + write(15,'(/,a)') + * 'You defined the twentyfifth slur, one too many!' + call stop1() + end if +c +c Get index of next slur not in use, starting from 12 down +c + ndxslur = log2(16777215-listslur) +c +c Record slur index +c + listslur = ibset(listslur,ndxslur) +c +c Save for use on termination +c +c call setbits(isdata,4,28,ndxslur) +c 080531 Allow >16 slurs + call setbits(isdata,4,28,mod(ndxslur,16)) + call setbits(isdata,1,18,ndxslur/16) +c +c Shift for stem? +c + if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then + if (.not.pstie) then + ihoff = ihoff+8 + else + ihoff = ihoff+2 + end if + end if + if (iscrd) then +c +c Additional horiz shifts for h-shifted noteheads? +c + if (btest(isdat2(isdat),1)) then +c +c Slur start on left-shifted chord notehead. ASSUME downstem. +c + if (nolevs.eq.minlev .and. slurudq.eq.'d') then + ihoff = ihoff-2 + else + ihoff = ihoff-10 + end if + else if (btest(isdat2(isdat),2)) then +c +c Right shifted chord notehead. ASSUME upstem. +c + if (nolevs.eq.maxlev .and. slurudq.eq.'u') then + ihoff = ihoff+2 + else + ihoff = ihoff+10 + end if + end if + end if + notexq = chax(92) + lnote = 1 +c +c Check for local adjustment default changes +c + if (btest(isdat2(isdat),26)) then + notexq = chax(92)//'sluradjust'//chax(92) + lnote = 12 + else if (btest(isdat2(isdat),27)) then + notexq = chax(92)//'nosluradjust'//chax(92) + lnote = 14 + else if (btest(isdat2(isdat),28)) then + notexq = chax(92)//'tieadjust'//chax(92) + lnote = 11 + else if (btest(isdat2(isdat),29)) then + notexq = chax(92)//'notieadjust'//chax(92) + lnote = 13 + end if + if (ihoff .eq. 0) then +c +c Write stuff for non-shifted start +c + notexq = notexq(1:lnote)//'islur'//slurudq + lnote = lnote+6 + else + notexq = notexq(1:lnote)//'is'//slurudq + lnote = lnote+3 + end if +c +c Prepend postscript tie switch +c + if (pstie) then + notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote) + lnote = lnote+10 + end if + if (btest(isdat2(isdat),4)) then +c +c Dotted slur +c +c noteq = notexq +c notexq = chax(92)//'dotted'//noteq + notexq = chax(92)//'dotted'//notexq(1:lnote) + lnote = lnote+7 + end if +c +c Add slur index to string +c Print 23-ndxslur +c + if (23-ndxslur .lt. 10) then +c +c 5/25/08 Allow 24 slurs +c + notexq = notexq(1:lnote)//chax(71-ndxslur) + lnote = lnote+1 + else if (23-ndxslur .lt. 20) then + notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' + lnote = lnote+4 + end if +c +c Add note name to string +c + islhgt = nolevs+iupdn+ivoff + call notefq(noteq,lnoten,islhgt,ncm) + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten +c +c Store height and staff mid level for use with LineBreakTies +c + call setbits(isdat3(isdat),8,14,islhgt) + call setbits(isdat3(isdat),8,22,ncm) +c +c Save height (for ornament and barnobox interference) if topmost slur is up +c + if (slurudq.eq.'u' .and. + * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then + islhgt = nolevs+iupdn+ivoff +c +c Save height & idcode if top voice and slur start +c + if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then + is1n1 = islhgt + is2n1 = idcode + end if + end if + if (ihoff .ne. 0.) then + shift = ihoff*0.1 + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + lform = lfmt1(shift) + write(notexq(lnote+1:lnote+lform),'(f'// + * chax(48+lform)//'.1)') shift + lnote = lnote+lform + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + call addstr(notexq,lnote,soutq,lsout) +c +c Zero out ip1 to avoid problems if slur goes to next input blk. +c + call setbits(isdata,8,3,0) +c +c Set slur-on data for midi. Only treat null-index slurs and ps ties for now. +c + if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then +c levson(midchan(iv,kv)) = nolevs +c 130316 + levson(midchan(iv,kv)) = nolevs+miditran(instno(iv)) + if (settie) dbltie = .true. +c +c Only way settie=T is if we just set a tie ending. So there's also a slur +c start here, so set a flag telling addmidi not to zero out levson +c + end if + else +c +c Slur is ending. Back thru list to find starting slur +c + do 3 j = isdat-1 , 1 , -1 + if (iv.eq.igetbits(isdat1(j),5,13) .and. +c * kv.eq.igetbits(isdat1(j),1,12)+1) then + * (kv.eq.igetbits(isdat1(j),1,12)+1 + * .or. btest(isdat1(j),1))) then + if (idcode .eq. igetbits(isdat1(j),7,19)) then + ndxslur = igetbits(isdat1(j),4,28) +c +c 080531 Allow >16 slurs +c + * +16*igetbits(isdat1(j),1,18) + if (btest(isdat1(j),27)) slurudq = 'u' + go to 4 + end if + end if +3 continue + print*,'Bad place in doslur' + call stop1() +4 continue +c +c Bugfix 070901 for slur ending on rest in 2-voice staff +c + if (nolevs.le.2 .or. nolevs.gt.60) then +c +c Ending is on a rest, reset nolevs to default starting height +c + nolevs = igetbits(isdat2(j),7,19) + end if + if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then +c +c Deal with \curve or \midslur. isdat is ending, j is start. +c + if (btest(isdat3(isdat),0)) then + imid = igetbits(isdat3(isdat),6,2)-32 + else + imid = igetbits(isdat3(j),6,2)-32 + end if +c +c Postscript slurs, and \midslur adjustment is needed. Invoke macro +c (from pmx.tex) that redefines \tslur as r'qd. Tentative mapping: +c Abs(imid) Postscript slur type +c 1 f +c 2-3 default +c 4 h +c 5 H +c 6+ HH +c + call addstr(chax(92)//'psforts'// + * chax(48+min(abs(imid),6)),9,soutq,lsout) + end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if +c +c Shift slur ending for stem on any note? +c + if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then + if (.not.pstie) then + ihoff = ihoff-8 + else + ihoff = ihoff-3 + end if + end if + if (iscrd) then +c +c Shift termination for shifted notehead? +c + if (btest(isdat2(isdat),1)) then +c +c Left-shifted chord notehead. ASSUME downstem. +c + if (nolevs.eq.minlev .and. slurudq.eq.'d') then + ihoff = ihoff-2 + else + ihoff = ihoff-10 + end if + else if (btest(isdat2(isdat),2)) then +c +c Right shifted chord notehead. ASSUME upstem. +c + if (nolevs.eq.maxlev .and. slurudq.eq.'u') then + ihoff = ihoff+2 + else + ihoff = ihoff+10 + end if + end if + end if + if (ihoff .eq. 0) then + notexq = chax(92)//'tslur' + lnote = 6 + else +c +c Shift needed +c + notexq = chax(92)//'ts' + lnote = 3 + end if +c +c Switch to postscript tie +c + if (pstie) then + notexq = chax(92)//'tieforts'//notexq(1:lnote) + lnote = lnote+9 + end if +c +c Print 13-ndxslur +c 5/25/08 Allow 14 slurs +c + if (23-ndxslur .lt. 10) then + notexq = notexq(1:lnote)//chax(71-ndxslur) + lnote = lnote+1 + else if (23-ndxslur .lt. 20) then + notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' + lnote = lnote+4 + end if + if (btest(iornq,11).or.btest(iornq,12)) then +c +c Raise or lower slur by one unit provided . or _ is on same side as slur +c + ivoffinc = 0 + if ((stemup .and. slurudq.eq.'d') .or. + * (.not.stemup .and. slurudq.eq.'u')) then + if (stemup) then + ivoffinc = -1 + else + ivoffinc = 1 + end if + if (((stemup .and. nolev.ge.ncm-2) .or. + * (.not.stemup .and. nolev.le.ncm+2)) .and. + * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc + end if + ivoff = ivoff+ivoffinc + end if + call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) + if (slurudq.eq.'u' .and. + * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then + islhgt = nolevs+iupdn+ivoff +c +c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. +c + if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then + if (idcode .eq. is2n1) is1n1=0 + end if + end if + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + if (ihoff .ne. 0) then + shift = ihoff*0.1 + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + lform = lfmt1(shift) + write(notexq(lnote+1:lnote+lform), + * '(f'//chax(48+lform)//'.1)')shift + lnote = lnote+lform + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + call addstr(notexq,lnote,soutq,lsout) +c +c Clear the bit from list of slurs in use +c + listslur = ibclr(listslur,ndxslur) +c +c Zero out the entire strings for start and stop +c + isdata = 0 + isdat2(isdat) = 0 + isdat3(isdat) = 0 + isdat4(isdat) = 0 + isdat1(j) = 0 + isdat2(j) = 0 + isdat3(j) = 0 + isdat4(j) = 0 +c +c Set midi info for slur ending +c + if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then + icm = midchan(iv,kv) + if (slmon(icm)) then + if (nolevs+miditran(instno(iv)).eq.levson(icm) .and. + * iand(7,nacc).eq.0) then +c +c There is a tie here. NB!!! assumed no accidental on 2nd member of tie. +c + levsoff(icm) = nolevs+miditran(instno(iv)) + settie = .true. + else + levsoff(icm) = 0 + levson(icm) = 0 + slmon(icm) = .false. + end if + end if + end if + end if + isdat1(isdat) = isdata + end if +1 continue +c +c Clear and collapse the slur data list +c + numdrop = 0 + do 2 isdat = 1 , nsdat + if (isdat1(isdat) .eq. 0) then + numdrop = numdrop+1 + else if (numdrop .gt. 0) then + isdat1(isdat-numdrop) = isdat1(isdat) + isdat2(isdat-numdrop) = isdat2(isdat) + isdat3(isdat-numdrop) = isdat3(isdat) + isdat4(isdat-numdrop) = isdat4(isdat) + isdat1(isdat) = 0 + isdat2(isdat) = 0 + isdat3(isdat) = 0 + isdat4(isdat) = 0 + end if +2 continue + nsdat = nsdat-numdrop +c call report(nsdat,isdat1,isdat2) + return + end + subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv, + * beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc) +c +c Called once per main note. (5/26/02) for non-ps slurs only +c + parameter (nm=24,mv=24576) + integer*4 isdat1(202),isdat2(202),isdat3(202) + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /comsln/ is1n1,is2n1,irzbnd,isnx + character*1 ulq,slurudq,udfq,udqq,chax + character*79 notexq + character*8 noteq + character*80 soutq + logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove, + * settie,fontslur,WrotePsslurDefaults + logical slmon,dbltie + common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), + * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, + * slmon(0:nm),dbltie + integer*2 mmidi,iinsiv + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans +c 130316 + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) +c +c Bits in isdat1: +c 13-17 iv +c 3-10 ip +c 11 start/stop switch +c 12 kv-1 +c 19-25 ichar(code$) +c 26 force direction? +c 27 forced dir'n = up if on, set in sslur; also +c final direction, set in doslur when beam is started, used on term. +c 28-31 ndxslur, set in doslur when beam is started, used on term. +c +c Bits in isdat2 +c 0 Chord switch. Not set on main note. +c 1-2 left/right notehead shift. Set only for chord note. +c 3 tie positioning +c 4 dotted flag +c 6-11 voff1 1-63 => -31...+31 +c 12-18 hoff1 1-127 => -6.3...+6.3 +c 19-25 nolev +c +c Bits in isdat3: Only used for slur endings +c 0 set if midslur (at least one argument) +c 1 set if curve (2 more args) +c 2-7 32+first arg (height correction) (1st arg may be negative) +c 8-10 second arg (initial slope) +c 11-13 third arg (closing slope) +c +c In listslur bit ib is on if slur index ib is in use, ib=0-23. +c ndxslur = slur index +c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, +c s-slur is blank (idcode=32), t-slur is idcode=1. +c ivoff is user-defined shift or shift due to . or _ , or chord adjustment. +c Ivoff will be set for ./_ only if no user-defined shift is specified. +c If highest note has upslur, save slur height in islhgt in case +c ornament must be moved. +c + islhgt = 0 + if (beamon) then + stemup = ulq .eq. 'u' + else if (nvmx(iv) .eq. 2) then + if (.not.btest(islur,30)) then +c +c Single note, 2 lines of music, stem direction not forced +c + stemup = ivx .gt. nv + else + stemup = btest(islur,17) + end if + else + stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u' + end if + iscrd = btest(ipl,10) + if (btest(islur,1)) then +c +c 't'-slur (idcode=1) somewhere on this note. Find it, check height against +c 's'-slur (idcode=32) +c + sfound = .false. + tfound = .false. + tmove = .false. + do 5 isdat = 1 , nsdat + if (iv .eq. igetbits(isdat1(isdat),5,13) .and. + * ip .eq. igetbits(isdat1(isdat),8,3) .and. + * kv .eq. igetbits(isdat1(isdat),1,12)+1) then + if (.not.tfound) then + tfound = igetbits(isdat1(isdat),7,19).eq.1 + if (tfound) then + nolevt = igetbits(isdat2(isdat),7,19) + isdatt = isdat + if (sfound) go to 6 + end if + end if + if (.not.sfound) then + sfound = igetbits(isdat1(isdat),7,19).eq.32 + if (sfound) then + nolevs = igetbits(isdat2(isdat),7,19) + isdats = isdat + if (tfound) go to 6 + end if + end if + end if +5 continue +c +c Will come thru here if there is a t with no s, so comment out the following +c print*,'Did not find s+t-slurs in doslur' +c +6 continue + if (sfound .and. tfound) + * tmove = nolevs.eq.nolevt .and. +c +c Check if 2 starts or two stops +c + * ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or. + * (.not.btest(isdat1(isdats),11).and. + * .not.btest(isdat1(isdatt),11)) ) +c +c This is a flag for later changing slur level, after we know slur dir'n. +c + end if + if (ismidi) then + settie = .false. + dbltie = .false. + end if + do 1 isdat = 1 , nsdat + isdata = isdat1(isdat) + if (iv .eq. igetbits(isdata,5,13) .and. + * ip .eq. igetbits(isdata,8,3) .and. + * kv .eq. igetbits(isdata,1,12)+1) then +c +c Since iv and kv match, ivx will be correct +c + idcode = igetbits(isdata,7,19) + ivoff = igetbits(isdat2(isdat),6,6)-32 + ihoff = igetbits(isdat2(isdat),7,12)-64 + iupdn = 0 + slurudq = 'd' + nolevs = igetbits(isdat2(isdat),7,19) + if (btest(isdata,11)) then +c +c Turnon, +c + if (nolevs.eq.0 .or. nolevs.gt.60) then +c +c Note was a rest, cannot start slur on rest. +c + print* + call printl('Cannot start slur on a rest') + call stop1() + end if +c +c Get slur direction +c + if (btest(isdata,26)) then +c +c Force slur direction +c + if (btest(isdata,27)) slurudq = 'u' + else if (nvmx(iv) .eq. 1) then +c +c Only one voice per line +c + if (.not.beamon) then +c +c Separate note. +c + slurudq = udfq(nolev,ncm) + else +c +c In a beam +c + if (ulq .ne. 'u') slurudq = 'u' + end if + if (iscrd) then + if (nolevs .gt. ncm) then + slurudq = 'u' + else + slurudq = 'd' + end if + end if + else +c +c Two voices per line. Get default +c + if (ivx .gt. nv) slurudq = 'u' +c +c Upper voice of the two, so up slur +c + end if +c +c Save up/down-ness for use at termination +c + if (slurudq .eq. 'u') isdata = ibset(isdata,27) +c +c End of section for setting slur direction, still in "Turnon" if-block. +c + if (idcode.eq.1 .and. tmove) then + iupdn = 1 + if (slurudq .eq. 'd') iupdn = -1 + end if + if (btest(iornq,11).or.btest(iornq,12)) then +c +c Raise or lower slur by one unit provided . or _ is on same side as slur +c + ivoffinc = 0 + if ((stemup .and. slurudq.eq.'d') .or. + * (.not.stemup .and. slurudq.eq.'u')) then +c +c Must move the slur for _ or . +c + if (stemup) then + ivoffinc = -1 + else + ivoffinc = 1 + end if + if (((stemup .and. nolev.ge.ncm-2) .or. + * (.not.stemup .and. nolev.le.ncm+2)) .and. + * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc + ivoff = ivoff+ivoffinc + end if + end if + if (listslur .eq. 16777215) then + print* + print*,'You1 defined the twenty-fifth slur, one too many!' + write(15,'(/,a)') + * 'You2 defined the twenty-fifth slur, one too many!' + call stop1() + end if +c +c Get index of next slur not in use, starting from ? down +c + ndxslur = log2(16777215-listslur) +c +c Record slur index +c + listslur = ibset(listslur,ndxslur) +c +c Save for use on termination +c +c call setbits(isdata,4,28,ndxslur) +c 080531 Allow >16 slurs + call setbits(isdata,4,28,mod(ndxslur,16)) + call setbits(isdata,1,18,ndxslur/16) +c +c Shift for stem? +c + if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) + * ihoff = ihoff+8 + if (btest(isdat2(isdat),3)) then +c +c Tie spacing, (slur start) +c + if (slurudq.eq.'d') then + ivoff = ivoff+1 + ihoff = ihoff+8 + else if (slurudq.eq.'u') then + ivoff = ivoff-1 + if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8 +c +c (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') +c + end if + end if + if (iscrd) then +c +c Additional horiz shifts for h-shifted noteheads? +c + if (btest(isdat2(isdat),1)) then +c +c Slur start on left-shifted chord notehead. ASSUME downstem. +c + if (nolevs.eq.minlev .and. slurudq.eq.'d') then + ihoff = ihoff-2 + else + ihoff = ihoff-10 + end if + else if (btest(isdat2(isdat),2)) then +c +c Right shifted chord notehead. ASSUME upstem. +c + if (nolevs.eq.maxlev .and. slurudq.eq.'u') then + ihoff = ihoff+2 + else + ihoff = ihoff+10 + end if + end if + end if + if (ihoff .eq. 0) then +c +c Write stuff for non-shifted start +c + notexq = chax(92)//'islur'//slurudq + lnote = 7 + else + notexq = chax(92)//'is'//slurudq + lnote = 4 + end if + if (btest(isdat2(isdat),4)) then +c +c Dotted slur +c + noteq(1:8) = notexq + notexq = chax(92)//'dotted'//noteq + lnote = lnote+7 + end if +c +c Add slur index to string +cc Print 11-ndxslur +c Print 23-ndxslur +c +c if (11-ndxslur .lt. 10) then + if (23-ndxslur .lt. 10) then +c +c 5/25/08 Allow 24 slurs +c +c notexq = notexq(1:lnote)//chax(59-ndxslur) + notexq = notexq(1:lnote)//chax(71-ndxslur) + lnote = lnote+1 + else if (23-ndxslur .lt. 20) then +c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' + notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' + lnote = lnote+4 + end if +c +c Add note name to string +c + call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten +c +c Save height (for ornament and barnobox interference) if topmost slur is up +c + if (slurudq.eq.'u' .and. + * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then + islhgt = nolevs+iupdn+ivoff +c +c Save height & idcode if top voice and slur start +c + if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then + is1n1 = islhgt + is2n1 = idcode + end if + end if + if (ihoff .ne. 0.) then + shift = ihoff*0.1 + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + lform = lfmt1(shift) + write(notexq(lnote+1:lnote+lform),'(f'// + * chax(48+lform)//'.1)') shift + lnote = lnote+lform + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + call addstr(notexq,lnote,soutq,lsout) +c +c Zero out ip1 to avoid problems if slur goes to next input blk. +c + call setbits(isdata,8,3,0) +c +c Set slur-on data for midi. Only treat null-index slurs and ps ties for now. +c + if (ismidi .and. idcode.eq.32) then + levson(midchan(iv,kv)) = nolevs+miditran(instno(iv)) + if (settie) dbltie = .true. +c +c Only way settie=T is if we just set a tie ending. So there's also a slur +c start here, so set a flag telling addmidi not to zero out levson +c + end if + else +c +c Slur is ending. Back thru list to find starting slur +c + do 3 j = isdat-1 , 1 , -1 + if (iv.eq.igetbits(isdat1(j),5,13) .and. + * kv.eq.igetbits(isdat1(j),1,12)+1) then + if (idcode .eq. igetbits(isdat1(j),7,19)) then + ndxslur = igetbits(isdat1(j),4,28) +c +c 080531 Allow >16 slurs +c + * +16*igetbits(isdat1(j),1,18) + if (btest(isdat1(j),27)) slurudq = 'u' + go to 4 + end if + end if +3 continue + print*,'Bad place in doslur' + call stop1() +4 continue + if (nolevs.eq.0 .or. nolevs.gt.60) then +c +c Ending is on a rest, reset nolevs to default starting height +c + nolevs = igetbits(isdat2(j),7,19) + end if + if (btest(isdat3(isdat),0)) then +c +c Deal with \curve or \midslur +c + imid = igetbits(isdat3(isdat),6,2)-32 +c +c Remember, only dealing with non-ps slurs +c +c Who knows where the following line came from. Removed it 6/30/02 to +c restore behavior of non-ps slurs to old way +c if (slurudq .eq. 'd') imid = -imid +c 3/8/03 added the following +c + if (slurudq .eq. 'd') imid = -abs(imid) +c + if (btest(isdat3(isdat),1)) then + notexq = chax(92)//'curve' + lnote = 6 + else + notexq = chax(92)//'midslur' + lnote = 8 + end if + if (imid.lt.0 .or. imid.gt.9) then +c +c Need brackets +c + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + if (imid .lt. -9) then + write(notexq(lnote+1:lnote+3),'(i3)')imid + lnote = lnote+3 + else if (imid.lt.0 .or. imid.gt.9) then + write(notexq(lnote+1:lnote+2),'(i2)')imid + lnote = lnote+2 + else + write(notexq(lnote+1:lnote+1),'(i1)')imid + lnote = lnote+1 + end if + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + else +c +c 1= 0 . +c Xtups are irrelevant here since they are already all in forced beams. +c Will update itnow by nodur at the END of this loop +c + ip = ip+1 + go to 11 + end if + nreal = nreal+1 + nodue(nreal) = nodur(ivx,ip) + short(nreal) = nodue(nreal).lt.16 .and. + * .not.btest(irest(ivx,ip),0) +c +c Rule out notes that have 'alone'-flag set +c + * .and..not.btest(islur(ivx,ip),18) + ipr(nreal) = ip + itr(nreal) = itnow + if (nodue(nreal) .eq. 1) then +c +c 64th gap +c + if (mod(itnow,2) .eq. 0) then +c +c Start of 32nd gap, lump with following note +c + ip = ip+1 + nodue(nreal) = 1+nodur(ivx,ip) + itnow = itnow+nodue(nreal) + else +c +c End of 32nd gap, lump with preceeding note +c + nreal = nreal-1 + nodue(nreal) = 1+nodue(nreal) + itnow = itnow+1 + end if + else + itnow = itnow+nodur(ivx,ip) + end if + go to 1 +9 continue + ir1 = 1 + itseg = lenbar/ibmrep + do 13 irep = 1 , ibmrep +c +c Set bitmaps for all shorts neighbored by a short. Each bit represents a +c span of 32nd note. maps, mapm, mape record start, full duration, and end +c of consecutive span of beamable (<1/4) notes. +c + maps = 0 + mapm = 0 + mape = 0 + itend = itseg*irep + itoff = itend-itseg + do 2 ir = ir1 , nreal + it2 = itr(ir)+nodue(ir)-2 + if (it2 .ge. itend) then + ir1 = ir + go to 14 + end if +c if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal + if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or. + * (ir.lt.nreal.and.short(ir+1)))) then + ib1 = (itr(ir)-itoff)/2 + ib2 = (it2-itoff)/2 + if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or. + * min(ib1,ib2).lt.0) return +c if (max(ib1,ib2).gt.247 .or. ir.gt.248 .or. +c * min(ib1,ib2).lt.0) return +c +c Must have an odd number obe beats in a long bar. Auto-beam won't work +c + nip1(ib1) = ipr(ir) + nip2(ib2) = ipr(ir) +c +c nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip +c + maps = ibset(maps,ib1) + mape = ibset(mape,ib2) + do 3 ib = ib1 , ib2 + mapm = ibset(mapm,ib) +3 continue + end if +2 continue +14 continue + if (mapm .eq. 0) go to 13 +c +c Zero out bits from forced beams +c + maps = iand(maps,not(mapfb(irep))) + mapm = iand(mapm,not(mapfb(irep))) + mape = iand(mape,not(mapfb(irep))) +c +c Compare map with template. +c + do 4 it = 1 , nummask(ibmtyp) + masknow = mask(it,ibmtyp) + if (iand(masknow,mapm) .eq. masknow) then +c +c Find least significant bit in the mask to check start time +c + mtemp = masknow + maskm = masknow + do 5 is1 = 0 , 47 +c do 5 is1 = 0 , 247 + if (iand(1,mtemp) .eq. 1) go to 6 + mtemp = ishft(mtemp,-1) +5 continue +6 continue + if (iand(ishft(1,is1),maps) .eq. 0) go to 4 +c +c is1 is the bit where the beam starts. Continue shifting to +c find most significant bit in the mask to check ending time +c + do 7 is2 = is1 , 47 +c do 7 is2 = is1 , 247 + mtemp = ishft(mtemp,-1) + if (iand(1,not(mtemp)) .eq. 1) go to 8 +7 continue +8 continue +c +c is2 is now the bit on which the beam ends. +c + if (iand(ishft(1,is2),mape) .eq. 0) go to 4 +c +c Did we pick out a single note from the middle of a longer sequence? +c + if (nip1(is1) .eq. nip2(is2)) go to 4 +c +c We almost have a beam. Check equality of notes if needed. +c + if (eqonly(it,ibmtyp)) then + do 10 ip = nip1(is1) , nip2(is2) + if (nodur(ivx,ip) .ne. 8) then +c +c There is a non-1/8th note in this beam. Exit if not 2 quarters +c + if (is2-is1 .ne. 15) go to 4 +c +c Beam is 2 quarters long. Check if can split in half. +c + ithalf = 0 + do 20 iip = nip1(is1) , nip2(is2) + ithalf = ithalf+nodur(ivx,iip) + if (ithalf .gt. 16) go to 4 + if (ithalf .eq. 16) go to 21 +20 continue + print*,'Problem in findbeam, please call Dr. Don' + go to 4 +21 continue +c +c Otherwise, split in half by keeping only the first half. Other half will +c be picked up later, assuming masks are listed longest first. +c + is2 = is1+7 +c +c Reset maskm (since only used part of mask), used later to zero out +c bits that contain beams +c + maskm = 0 + do 15 is = is1 , is2 + maskm = ibset(maskm,is) +15 continue + go to 16 + end if +10 continue + end if +16 continue +c +c This is a beam. If last "effective" ends on odd 64th, add 1 more +c +c if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) +c * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then + if (abs(amod(to(ipl2(ivx,nip2(is2))) + * +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then + nip2(is2) = nip2(is2)+1 + end if + numbms(ivx) = numbms(ivx)+1 + numnew = numbms(ivx) + call logbeam(numnew,nip1(is1),nip2(is2)) +c +c Zero out the appropriate bits so these notes don't get used again +c + mapm = iand(mapm,not(maskm)) + if (mapm.eq.0) go to 13 + maps = iand(maps,not(maskm)) + mape = iand(mape,not(maskm)) + end if +4 continue +13 continue + return + end + subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0) + parameter (nkb=3999,maxblks=9600) +c +c Compute an exponent eonk for use in the "flattened" formula for elemskips +c vs time. We must solve the eqution f = 0. Initial quess is eonk0. +c + common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), + * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) + common /comtol/ tol + common /comeon/ eonk,ewmxk + eonk = eonk0 + niter = 0 +1 continue + ewmxk = f1eon(dtmax)**eonk + niter = niter+1 + esum = 0. + desum = 0. + do 2 iptr = nptr1 , nptr2 + targ = durb(iptr)/sqzb(iptr) + esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ) + detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ) + desum = desum+nnpd(iptr)*sqzb(iptr)*detarg +2 continue + f = wovera*feon(dtmin)-xelsk-esum + fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin) + * -desum + if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then + call printl( + * 'Error in findeonk. Please send source to Dr. Don') + eonk = 0. + ewmxk = 1. + return + end if + dsoln = -f/fp + if (abs(dsoln) .lt. .1*tol) return +c +c Not converged yet, try again +c + eonk = eonk+dsoln + go to 1 + end + function fnote(nodur,ivx,ip,nacc) +c +c This return the real duration of a note +c + parameter (nm=24) + integer*4 nodur(nm,200),nacc(nm,200) + logical btest + ipback = ip + if (nodur(ivx,ip) .gt. 0) then + if (ip .gt. 1) then +c +c Check if this is last note of xtup +c + if (nodur(ivx,ip-1).eq.0) then + ipback = ip-1 + go to 2 + end if + end if + fnote = nodur(ivx,ip) + return + end if +2 continue +c +c Count back to prior non zero note. Start at ip to avoid neg index if ip=1. +c Count how many doubled xtups notes there are from ip-1 to first note. +c + ndoub = 0 + do 1 ip1m1 = ipback , 1 , -1 + if (nodur(ivx,ip1m1) .gt. 0) go to 4 + if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1 +1 continue +4 continue +c +c count forward to next non-0 nodur. Start at ip in case last note of xtup. +c + do 3 iip = ip , 200 +c +c Count doubled xtup notes from ip to end. +c + if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1 + if (nodur(ivx,iip) .gt. 0) then +c fnote = nodur(ivx,iip)/float(iip-ip1m1) + fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub) + if (btest(nacc(ivx,ip),18)) then + fnote = 2*fnote + else if (btest(nacc(ivx,ip),27)) then + fnote = 1.5*fnote + else if (ip .gt. 1) then + if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote + end if + return + end if +3 continue + print*,' ' + call printl + * ('Probable misplaced barline or incorrect meter, stopping') + print*,'ivx,ip:',ivx,ip + call stop1() + end + subroutine g1etchar(lineq,iccount,charq) + parameter(nm=24) + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + logical lastchar,issegno,isheadr,isvolt,fbon + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + logical mrecord,mplay,endmac + character*1 charq + character*128 lineq,lnholdq +c +c Gets the next character out of lineq*128. If pointer iccount=128 on entry, +c then reads in a new line. Resets iccount. Ends program if no more input. +c + if (iccount .eq. 128) then + call read10(lineq,lastchar) + if (lastchar) return + if (.not.endmac) then + iccount = 0 + if (.not.mplay) nline = nline+1 + else + endmac = .false. + iccount = icchold + lineq = lnholdq + end if + if (mrecord) then + call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) + end if + end if + iccount = iccount+1 + charq = lineq(iccount:iccount) + return + end + subroutine g1etnote(loop,ifig,optimize,fulltrans) + parameter (nm=24,nkb=3999,mv=24576,maxblks=9600) + character*1 chax + logical twotrem + common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), + * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, + * nbars,itsofar(nm),nib(nm,15),nn(nm), + * rest(nm,200),lenbr0,lenbr1,firstline,newmeter + common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), + * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + common /compage/ widthpt,ptheight,hoffpt,voffpt, + * nsyst,nflb,ibarflb(0:40), + * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), + * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), + * nistaff(0:40) + common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) + common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1, + * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS + logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend, + * isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt, + * stickyS + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + common /commus/ musize,whead20 + logical mrecord,mplay,endmac,shifton,optimize + character*128 lineq,lnholdq + character*1 charq,dotq,dumq,durq,charlq + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + logical novshrinktop,upslur,fontslur,ztrans, + * WrotePsslurDefaults,cstuplet + common /comnvst/ novshrinktop,cstuplet + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + character*51 literq(3),lyrerq(5) + common /comligfont/ isligfont + logical isligfont + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + logical fulltrans + common /comsize/ isize(nm) + common /commidisig/ midisig + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, + * poefa + real*4 poefa(125) + logical nocodabn + data literq + * /'Literal TeX string cannot start with 4 backslashes!', + * 'TeX string must have <129 char, end with backslash!', + * 'Type 2 or 3 TeX string can only start in column 1!'/ + data lyrerq + * /'pmxlyr string must end with " followed by blank!', + * 'pmxlyr string cannot extend past position 120!', + * 'There must be "a" or "b" here!', + * 'There must be "+" or "-" here!', + * 'There must be an integer here!'/ + cdot = .false. + twotrem = .false. +1 call g1etchar(lineq,iccount,charq) + if (charq .ne. ' ') charlq = charq + if (lastchar) then + if (index('/%',charlq) .eq. 0) then + print* + print*,'WARNING:' + print*,'Last non-blank character is "',charlq,'", not "/,%"' + print*,'ASCII code:',ichar(charlq) + write(15,'(/a)')'Last non-blank character is "'//charlq// + * '", not "/,%"' + write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq) +c +c Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. +c + ilbuf = ilbuf-1 + lbuf(ilbuf) = lbuf(ilbuf)+2 + bufq = bufq(1:ipbuf)//' /' + write(15,*)'appending /' + print*,'appending /' + lineq = lineq(1:iccount)//' /' + lastchar = .false. + go to 1 + end if + return + end if + if (charq .eq. ' ') then + go to 1 + else if (charq.eq.'%' .and. iccount.eq.1) then + iccount = 128 + go to 1 +c +c Replacement 1/22/12 since gfortran 4.7 with -O was choking here! +c +c else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. + else if (index('abcdefg',charq).gt.0 .or. + * charq.eq.'r') then +c +c This is a note/rest. +c + if (cdot) go to 28 + idotform = 0 + numnum = 0 + plusmin = .false. +28 nnl(ivx) = nnl(ivx)+1 + if (nnl(ivx) .gt. 200) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '>200 notes in line of music. Use smaller blocks!') + call stop1() + end if + dotq = 'x' +c +c Check if this is 'r ' and previous note was full-bar-pause +c + fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' ' + * .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and. + * nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar +2 call g1etchar(lineq,iccount,durq) + ic = ichar(durq) + if (ic.le.57 .and. ic.ge.48) then +c +c Digit +c + if (numnum .eq. 0) then + nnodur = ic-48 + numnum = 1 + go to 2 + else if (numnum .eq. 1) then + if (charq .eq. 'r') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only one digit allowed after rest symbol "r"!') + call stop1() + end if + numnum = 2 + if (plusmin) then + print* + print*,'*********WARNING*********' + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Before version 1.2, +/- was ignored if octave was!') + print*, + * 'explicitly specified. May need to edit old editions' + end if + go to 2 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '>2 digits in note symbol!') + call stop1() + end if + else if (durq.eq.'d') then + dotq = durq + if (lineq(iccount+1:iccount+1) .eq. 'd') then + iddot = 1 + iccount = iccount+1 +c +c Since we flow out, double dots won't work with other dot options +c + end if + if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then +c +c move a dot, provided a number follows. +c + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,durq) + if (index('0123456789-.',durq) .eq. 0) then +c +c Backup, exit the loop normally +c + iccount = iccount-2 + go to 2 + end if + call readnum(lineq,iccount,dumq,fnum) + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift also +c + call g1etchar(lineq,iccount,durq) + if (index('0123456789-.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected number after 2nd +/- (shift dot)!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + end if + iccount = iccount-1 + end if + go to 2 + else if (index('<>',durq) .gt. 0) then +c +c Accidental shift +c +c if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then + if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, +c * 'Expected "f", "s", or "n" before "<" or ">"!') + * 'Expected "f", "s", "n" or "A" before "<" or ">"!') + call stop1() + end if + ipm = 1 + if (durq .eq. '<') ipm=-1 + call g1etchar(lineq,iccount,durq) + if (index('123456789.0',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected number after (accidental shift)!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + fnum = ipm*fnum + if (fnum.lt.-5.35 .or. fnum.gt.1.0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Horizontal accidental shift must be >-5.35 and <1.0!') + call stop1() + end if + iccount = iccount-1 + go to 2 + else if (index('+-',durq) .gt. 0) then + if (charq .ne. 'r') then + if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then + ipm = 1 + if (durq .eq. '-') ipm=-1 + if (index('0123456789',lineq(iccount+1:iccount+1)) + * .gt.0) then +c +c This may be start of accidental shift, but may be octave jump; then duration +c + icsav = iccount + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (index('+-',durq) .gt. 0) then +c +c This is an accid shift since there's a 2nd consecutive signed number. +c Check size of 1st number. +c + if (fnum .gt. 30.5) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Vertical accidental shift must be less than 31!') + call stop1() + end if + ipm = 1 + if (durq .eq. '-') ipm = -1 + call g1etchar(lineq,iccount,durq) + if (index('1234567890.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected 2nd number of accidental shift)!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + fnum = ipm*fnum + if (fnum.lt.-5.35 .or. fnum.gt.1.0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Horiz. accidental shift must be >-5.35 and <1.0!') + call stop1() + end if + iccount = iccount-1 + go to 2 + else +c +c Not accid shift, reset, then flow out +c + iccount = icsav + end if + end if + end if + plusmin = .true. + if (numnum .eq. 2) then + print* + print*,'*********WARNING*********' + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Before version 1.2, +/- was ignored if octave was!') + print*, + * 'explicitly specified. May need to edit old editions' + end if + go to 2 +c +c It's a rest containing +|- . Must refer to a vertical shift. Read past. +c + else + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,dum) + if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1 + iccount = iccount-1 + go to 2 + end if +c else if (index('ulare',durq) .gt. 0) then + else if (index('ularec',durq) .gt. 0) then + go to 2 + else if (index('LS',durq) .gt. 0) then +c +c Stemlength change +c + call g1etchar(lineq,iccount,durq) + if (index('.0123456789:',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be a number or colon here!') + call stop1() + end if + if (durq .eq. ':') then + if (.not.stickyS) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Turned off sticky stemlegth changes without turning on!') + call stop1() + end if + stickyS = .false. + go to 2 + end if + call readnum(lineq,iccount,durq,dum) +c if (dum.lt..5 .or. dum.gt.4.) then + if ((durq.eq.'L'.and.dum.gt.20.).or. + * (durq.eq.'S'.and.dum.gt.4.)) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Stemlength change amount too big!') + call stop1() + end if + if (durq .ne. ':') then + iccount = iccount-1 + else + if (stickyS) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Turned on sticky stemshrinks when already on!') + call stop1() + end if + stickyS = .true. + end if + go to 2 + else if (index('fsn',durq) .gt. 0) then +c +c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so +c MUST come right after "f,s,n" +c + if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 + go to 2 + else if (durq .eq. 'p') then + fulbrp = charq.eq.'r' + if (.not. fulbrp) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'The option "p" only works with "r" (rest)!') + call stop1() + end if + go to 2 + else if (durq .eq. 'b') then + if (charq .ne. 'r') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'You entered "b"; I expected "rb"!') + call stop1() + else if (numnum .eq. 2) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'You entered "r" & "b" with two numbers!') + end if + go to 2 + else if (durq .eq. 'x') then +c +c Xtuplet. Count number of doubled notes (for unequal xtups) +c + if (btest(nacc(ivx,nnl(ivx)),18)) then + ndoub = 1 + else + ndoub = 0 + end if +c +c Will set all durations to 0 except last one. +c + call g1etchar(lineq,iccount,durq) + if (index('123456789T',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'First char after "x" in xtuplet must be "1"-"9" or "T"!') + call stop1() + end if + if (durq .eq. 'T') then +c +c Set a flag for checking 2nd note inputs if dot is moved +c + twotrem = .true. +c +c Check all x-tremolo inputs here; set fnum=2 +c + fnum = 2 + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'First char after "T" in xtuplet must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This char must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) +c +c Probably blank unles other options entered +c + end if + end if + else +c +c durq is digit, normal xtup +c + call readnum(lineq,iccount,durq,fnum) +c +c Leaves durq at next char after number +c + if (fnum .gt. 99) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Xtuplet cannot have more than 99 notes!') + call stop1() + else if (index(' DFnd',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only legal characters here are " ","D","F","n"!') + call stop1() + end if + end if +c +c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. +c + if (index('DF',durq) .gt. 0) then +c +c Double xtup note to make an un= xtup. Here, number already set, but may also +c have used this before number was set. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + ndoub = 1 + call g1etchar(lineq,iccount,durq) + else if (durq .eq. 'd') then + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) + call g1etchar(lineq,iccount,durq) + end if + if (durq .eq. 'n') then +c +c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. +c + numshft = 0 +30 call g1etchar(lineq,iccount,durq) + if (durq .eq. 'f') then + go to 30 + else if (index('+-',durq) .gt. 0) then + numshft = numshft+1 + if (numshft .eq. 3) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only 2 shifts are allowed after "n" in xtup!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This character should be a digit or "."!') + call stop1() + end if + call readnum(lineq,iccount,durq,snum) + iccount = iccount-1 +c if ((numshft.eq.1 .and. snum.gt.15.1) .or. + if ((numshft.eq.1 .and. snum.gt.64.) .or. + * (numshft.eq.2 .and. snum.gt.1.51)) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Shift number after "n" in xtup is out of range!') + call stop1() + end if + go to 30 + else if (durq .eq. 's') then +c +c Slope alteration for bracket +c + call getchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'For slope adjustment, this character must be "+" or "-"!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This character should be a digit!') + call stop1() + end if + call readnum(lineq,iccount,durq,snum) + iccount = iccount-1 + if (nint(snum) .gt. 15) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slope adjustment cannot exceed 15!') + call stop1() + end if + go to 30 + else if (index('123456789',durq) .gt. 0) then +c +c Unsigned integer => alternate printed number +c + call readnum(lineq,iccount,durq,snum) + if (snum .gt. 15.1) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Alternate xtup number after "n" must be <16!') + call stop1() + end if + iccount = iccount-1 + go to 30 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "n" in xtup!') + call stop1() + end if + end if + ntup = nint(fnum) + do 6 itup = 2 , ntup + nodur(ivx,nnl(ivx)) = 0 + nnl(ivx) = nnl(ivx)+1 +110 call g1etchar(lineq,iccount,durq) + if (durq.eq.' ') then + go to 110 + else if (durq .eq. 'o') then +c +c Ornament in xtup. "o" symbol must come AFTER the affected note +c + call g1etchar(lineq,iccount,dumq) + if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then + if (index('fg',dumq) .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Fermata or segno not allowed in xtuplet!') + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal ornament!') + end if + call stop1() + end if + if (dumq .eq. 'T') then +c +c Trill. may be followed by 't' and/or number. read 'til blank +c +29 call g1etchar(lineq,iccount,dumq) + if (dumq .ne. ' ') go to 29 + else if (dumq .eq. 'e') then + call g1etchar(lineq,iccount,dumq) + if (index('sfn?',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "e" in edit. accid. symbol!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq) + else if (dumq .eq. ':') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '":" must be followed by blank in "o: "!') + call stop1() + else if (.not.ornrpt) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Turned off repeated ornaments before they were on!') + call stop1() + end if + ornrpt = .false. + else + call g1etchar(lineq,iccount,dumq) + end if + if (index('+- :',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in ornament symbol!') + call stop1() + end if + if (dumq .eq. ':') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '":" must be followed by blank in "o: "!') + call stop1() + else if (ornrpt) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Turned on repeated ornaments but already on!') + call stop1() + end if + ornrpt = .true. + end if + if (index('+-',dumq) .gt. 0) then + if (index('0123456789',lineq(iccount+1:iccount+1)) + * .eq. 0) then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'There should be an integer here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (durq .eq. ':') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot shift AND repeat an ornament!') + call stop1() + end if +c +c 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. +c + if (index('+-',durq) .gt. 0) then + if (index('.0123456789',lineq(iccount+1:iccount+1)) + * .eq. 0) then + call errmsg(lineq,iccount+1, + * ibarcnt-ibaroff+nbars+1, + * 'There should be a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + end if + end if + go to 110 + else if (index('st(){}',durq) .gt. 0) then +c +c Slur in xtup +c + iposn = 0 + numint = 0 +15 call g1etchar(lineq,iccount,dumq) + iposn = iposn+1 + if (index('udlbfnhtv',dumq) .gt. 0) then + if (dumq.eq.'t' .and. durq.eq.'t') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot use "t" as an option on a tie!') + call stop1() + end if + go to 15 + else if (index('+-',dumq) .gt. 0) then + numint = numint+1 + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (numint .eq. 1) then + if (nint(fnum) .gt. 30) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Magnitude of slur height adjustment cannot exceed 30!') + call stop1() + end if + else if (numint .eq. 2) then + if (abs(fnum).gt.6.3) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur horiz shift must be in the range (-6.3,6.3)!') + call stop1() + end if + else +c +c Third signed integer, must be a midslur or curve spec. +c + if (abs(fnum).gt.31) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur midheight must be in the range (-31,31)!') + call stop1() + end if + if (durq .eq. ':') then +c +c Expecting curve parameters. Get two numbers +c + do 40 i = 1 , 2 + iccount = iccount+1 + fnum = ichar(lineq(iccount:iccount))-48 + if (abs(fnum-3.5) .gt. 3.6) then + call errmsg(lineq,iccount, + * ibarcnt-ibaroff+nbars+1, + * 'Slur curve parameter must be in range (0,7)!') + call stop1() + end if +40 continue + iccount = iccount+1 + end if + end if + iccount = iccount-1 + go to 15 + + else if (dumq .eq. 's') then +c +c What follows should be one or two signed numbers for adjustment of line break +c slur, end of 1st segment or start of second. +c + if (fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'May not use linebreak slur options with font-based slurs!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('+-',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This character must be "+" or "-"!') + call stop1() + end if + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (nint(fnum) .gt. 30) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Magnitude of slur height adjustment cannot exceed 30!') + call stop1() + end if + if (index('+-',dumq) .gt. 0) then + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (abs(fnum) .gt. 6.3) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur horiz shift must be in range (-6.3,6.3)!') + call stop1() + end if + end if + iccount = iccount-1 + go to 15 + else if (dumq .eq. 'H' .and. iposn.gt.1) then + if (lineq(iccount+1:iccount+1) .eq. 'H') + * iccount=iccount+1 + go to 15 + else if (dumq .eq. 'p') then +c +c local change in postscript slur/tie adjustment default +c + if (fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must use postscript slurs ("Ap") to use this option!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('+-',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected "+" or "-" here!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('st',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected "s" or "t" here!') + call stop1() + end if + go to 15 + else if (dumq .ne. ' ') then + ic = ichar(dumq) + if ((ic.ge.48.and.ic.le.57) .or. + * (ic.ge.65.and.ic.le.90)) then + if (iposn .eq. 1) then + if (durq.eq.'t' .and. fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slur ID not allowed on non-postscript tie!') + call stop1() + end if + if (lineq(iccount+1:iccount+1).eq.'x') + * iccount = iccount+1 + go to 15 + end if + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slur ID must be 2nd character in slur symbol!') + call stop1() + end if + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in slur symbol!') + call stop1() + end if + go to 110 + else if (index('0123456789#-nx_',durq) .gt. 0) then +c +c We have a figure. Only allow on 1st note of xtup +c + if (itup .ne. 2) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Figure in xtup only allowed on 1st note!') + call stop1() + else if (durq.eq.'x') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'No floating figures in xtuplets!') + call stop1() + end if + if (usefig .and. ivx.eq.1) ifig = 1 +26 call g1etchar(lineq,iccount,durq) +c if (index('0123456789#-n_.:',durq) .gt. 0) then + if (index('0123456789#-n_.:v',durq) .gt. 0) then + go to 26 + else if (durq .eq. 's') then + isligfont = .true. + go to 26 + else if (durq .eq. '+') then +c +c vertical offset, must be integer then blank +c + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .ne. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Integer for vertical offset expected here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Vertical offset must terminate figure!') + call stop1() + end if + iccount = iccount-1 + go to 26 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in figure in xtuplet!') + call stop1() + end if + go to 110 + else if (durq .eq. 'G') then + ngr = 1 +79 call g1etchar(lineq,iccount,charq) + if (index('123456789',charq) .gt. 0) then + call readnum(lineq,iccount,durq,fnum) + ngr = nint(fnum) + iccount = iccount-1 + go to 79 + else if (index('AWulxs',charq) .gt. 0) then + go to 79 + else if (charq .eq. 'm') then + call g1etchar(lineq,iccount,charq) + if (index('01234',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A digit less than 5 must follow "m" in a grace note!') + call stop1() + end if + go to 79 + else if (charq .eq. 'X') then +c +c Space before main note +c + call g1etchar(lineq,iccount,charq) + if (index('0123456789.',charq) .gt. 0) then + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 79 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number must follow "X" in a grace note!') + call stop1() + end if + end if +c +c At this point, charq is first note name in rest (grace?) +c + do 71 igr = 1 , ngr + numnum = 0 + if (igr .gt. 1) then +75 call g1etchar(lineq,iccount,charq) + if (charq .eq. ' ') go to 75 + end if + if (index('abcdefg',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'In grace, expected "a"-"g"!') + call stop1() + end if +78 call g1etchar(lineq,iccount,charq) + if (charq .ne. ' ') then + if (index('1234567',charq) .gt. 0) then + if (numnum .eq. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only one of "+-1234567" allowed here in grace!') + call stop1() + end if + numnum = 1 + go to 78 + else if (index('+-nfs',charq) .gt. 0) then + go to 78 + end if +c +c Digits are possible octave numbers +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after note name in grace!') + call stop1() + end if +71 continue + go to 110 + else if (durq .eq. chax(92)) then + call chklit(lineq,iccount,literr) + if (literr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * literq(literr)) + call stop1() + end if + go to 110 + else if (durq .eq. chax(34)) then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if + go to 110 + else if (durq .eq. 'M') then +c +c Temporary trap until I get around putting this in pmxb +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Macros not yet allowed in xtuplets!') + call stop1() + else if (durq .eq. 'X') then + call g1etx(lineq,iccount,shifton, + * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt) + go to 110 + else if (durq .eq. 'z') then +c +c Chord note in xtup. Read past for now. +c +33 call g1etchar(lineq,iccount,durq) + if (durq .ne. ' ') go to 33 + go to 110 + else if (durq .eq. 'D') then +c +c Dynamic mark +c + call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1) + go to 110 + else if (durq .eq. '%') then + if (iccount .ne. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Comment must have "%" in column 1!') + call stop1() + end if + iccount = 128 + go to 110 + else if (durq .eq. '?') then + call getchar(lineq,iccount,durq) + if (durq .eq. ' ') then + iccount = iccount-1 + go to 110 + end if + if (durq .ne. '-') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expecting "-"') + call stop1() + end if + call getchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expecting number') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 110 +c +c 140215 Allow clef change inside xtup +c + else if (durq .eq. 'C') then + call g1etchar(lineq,iccount,durq) + if (.not.(index('tsmanrbf',durq).gt.0 .or. +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') + call stop1() + end if + go to 110 +c+++ + else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'[' + * .and. lineq(iccount+2:iccount+2).eq.' ') then + iccount = iccount+2 + go to 110 +c+++ +c +c Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo +c + end if +c +c End of xtup options. At this point symbol can only be note or rest +c + if (index('abcdefgr',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'In xtup, this character is not allowed!') + call stop1() + end if +7 call g1etchar(lineq,iccount,durq) + if (index('12345678ulcb',durq) .gt. 0) then + go to 7 + else if (index('sfn',durq) .gt. 0) then +c +c Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. +c + if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 + go to 7 + else if (index('+-<>',durq) .gt. 0) then +c +c May have either octave jump or shifted accid. on main xtup note +c + if (index('+-',durq).gt.0 .and. + * index('01234567890',lineq(iccount+1:iccount+1)).eq.0) + * go to 7 + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 7 + else if (index('DF',durq) .gt. 0) then +c +c Double an xtup note to make an unequal xtup +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + ndoub = ndoub+1 + go to 7 + else if (durq .eq. 'd') then + if (twotrem) then +c +c 2-note trem, get shift +c + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected +/- for shifted dot on end of 2-note trem!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected number here!') + call stop1() + end if + call readnum(lineq,iccount,dumq,fnum) + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift also +c + call g1etchar(lineq,iccount,durq) + if (index('0123456789-.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected number after 2nd +/- (shift dot)!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + end if + iccount = iccount-1 + go to 7 + else + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) + end if + go to 7 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal option on xtuplet note!') + call stop1() + end if + if (itup .eq. ntup-ndoub) go to 3 +6 continue +3 continue +c +c 6==End of loop for xtuplet input +c + else if (durq .eq. 'm') then +c +c Multi-bar rest: next 1 or two digits are # of bars. +c + if (mod(itsofar(iv),lenbar) .ne. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Multibar rest must start at beginning of bar!') + call stop1() + else if (iv.eq.1.and.ibarmbr.gt.0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Multibar rest only OK at one time per block!') + call stop1() + end if +c +c For some purposes, pretend its one bar only +c + nodur(iv,nnl(iv)) = lenbar + ibarmbr = nbars+1 + mbrest = 0 +c20 call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected an integer after "rm"!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + mbrest = nint(fnum) +c iccount = iccount-1 + if (nv .gt. 1) then + if (iv .eq. 1) then + mbrestsav = mbrest + else + if (mbrest .ne. mbrestsav) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must enter same multi-bar rest in every voice!') + call stop1() + end if + end if +c +c Zero out mbrestsav so can check at end of input block whether +c all voices have one +c + if (iv .eq. nv) mbrestsav=0 + end if + if (durq .eq. 'n') then +c +c Get new height +c + call g1etchar(lineq,iccount,durq) + if (index('+-123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected an integer after "rm[x]n"!') + call stop1() + end if + if (index('+-',durq).ne.0) iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + end if + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "rm"!') + call stop1() + end if + else if (durq .eq. '.') then +c +c Dotted pattern. Close out note. Mult time by 3/4. +c Set time for next note to 1/4. Start the note. +c + idotform = 1 + else if (durq .eq. ',') then + idotform = 3 +c +c Now flow to duration setting, as if durq=' ' +c + else if (index('oL',durq) .gt. 0) then +c +c Suppress full bar rest, or look left for height +c + if (charq .ne. 'r') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"o","L" options only legal for rest, not note!') + call stop1() + end if + go to 2 + else if (index('DF',durq) .gt. 0) then +c +c Double note for xtup. Must check here in case "D" or "F" came before "x" or on +c last note of xtup. Need to flag it in pmxa since affects horiz. spacing. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + go to 2 + else if (durq .eq. 'A') then +c +c Main note accidental option +c + call getchar(lineq,iccount,durq) + if (index('o+-<>',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"o",+","-","<",">" are the only legal options here!') + call stop1() + end if +c +c Need more stuff here +c + if (durq .ne. "o") then +c +c Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will +c proceed to number input checking +c + iccount = iccount-1 + end if + go to 2 + else if (durq .eq. 'T') then +c +c Single stem tremolo. Only option (optional) is 1,2,3, or 4. +c + call getchar(lineq,iccount,durq) + if (index('1234',durq) .eq. 0) iccount = iccount-1 + go to 2 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character!') + print*,'ASCII code:',ichar(durq) + call stop1() + end if +c +c End of block for note options. +c +c Set the duration +c + if (idotform .gt. 0) then + if (idotform .eq. 1) then + nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2 + else if (idotform .eq. 2) then + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3 + else if (idotform .eq. 3) then + nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq) + else if (idotform .eq. 4) then + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2 + end if + else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then + nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq) +c +c Check for double dot +c + if (iddot .eq. 1) then + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6 + iddot = 0 + end if + else if (fulbrp) then + nodur(ivx,nnl(ivx)) = lenbar +c +c Use a one-line function to set nnodur. It gives inverse of ifnodur. +c + nnodur = index('62514x0x37', + * chax(48+int(log(.1+lenbar)/.69315)))-1 + fulbrp = .false. + end if + rest(ivx,nnl(ivx)) = charq.eq.'r' +c +c If inside forced beam, check if note is beamable +c + if (fbon) then + if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120 + if (nnl(ivx) .gt. 1) then + if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120 + end if + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Unbeamable thing in forced beam!') + call stop1() + end if +120 continue +c +c Get number of prior bars for later check on whether note spans bar line +c + nbb4 = itsofar(ivx)/lenbar + itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) + if (mod(itsofar(ivx),lenbar) .eq. 0) then + nbars = nbars+1 + if (shifton) barend = .true. +c +c Will check barend when 1st note of next bar is entered. +c + if (nbars .gt. 15) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot have more than 15 bars in an input block!') + call stop1() + end if + nib(ivx,nbars) = nnl(ivx) + if (firstline .and. lenbar.ne.lenbr1) then +c +c Just finished the pickup bar for this voice. +c + if (itsofar(ivx) .ne. lenbr0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Pickup bar length disagrees with mtrnum0!') + call stop1() + end if + lenbar = lenbr1 + itsofar(ivx) = 0 + end if + else if (barend) then + if (shifton) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Bar ended with user-defined shift still on!') + call stop1() + end if + barend = .false. + else if (itsofar(ivx)/lenbar .gt. nbb4) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'This note spans a bar line!') + call stop1() + end if + if (idotform.eq.1 .or. idotform.eq.3) then + call g1etchar(lineq,iccount,charq) + if (index('abcedfgr',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected note name or "r" here!') + call stop1() + end if + idotform = idotform+1 + numnum = 1 + go to 28 + end if +c +c End of sub block for note-rest +c + else if (charq .eq. 'z') then + call g1etchar(lineq,iccount,charq) + if (index('abcdefg',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected chord note name here!') + call stop1() + end if +25 call g1etchar(lineq,iccount,durq) +c if (index('dre12345678',durq) .gt. 0) then + if (index('dre12345678c',durq) .gt. 0) then + go to 25 + else if (index('fsn',durq) .gt. 0) then +c +c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so +c MUST come right after "f,s,n" +c + if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1 + go to 25 + else if (durq .eq. 'A') then + if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Must have "f,s,n" before "A" in chord note!') + call stop1() + end if + go to 25 + else if (index('<>',durq) .gt. 0) then + if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then +c if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Must have "f,s,n,A" before "<" or ">"!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('1234567890.',durq) .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Expected a number to start here for accidental shift!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 25 + else if (index('+-',durq) .gt. 0) then + if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0) + * go to 25 +c +c Number or '.' (durq) follows +/- . Get it. +c + call g1etchar(lineq,iccount,durq) + if (durq .eq. '.' .and. index('1234567890', + * lineq(iccount+1:iccount+1)) .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * '"." here must be followed by a digit!') + call stop1() + else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Number after +/- must follow "d,s,f,n,A"!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (index('+-',durq) .eq. 0) then + iccount = iccount-1 + go to 25 + end if +c +c 2nd +/- +c + call g1etchar(lineq,iccount,durq) + if (durq .eq. '.') call g1etchar(lineq,iccount,durq) + if (index('1234567890',durq) .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Expected a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 25 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in chord note!') + call stop1() + end if + else if (charq .eq. 'G') then + ngr = 1 +9 call g1etchar(lineq,iccount,charq) + if (index('123456789',charq) .gt. 0) then + call readnum(lineq,iccount,durq,fnum) + ngr = nint(fnum) + iccount = iccount-1 + go to 9 + else if (index('AWulxs',charq) .gt. 0) then + go to 9 + else if (charq .eq. 'm') then + call g1etchar(lineq,iccount,charq) + if (index('01234',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A digit less than 5 must follow "m" in a grace note!') + call stop1() + end if + go to 9 + else if (charq .eq. 'X') then +c +c Space before main note +c + call g1etchar(lineq,iccount,charq) + if (index('0123456789.',charq) .gt. 0) then + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 9 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number must follow "X" in a grace note!') + call stop1() + end if + end if +c +c At this point, charq is first note name in rest (grace?) +c + do 19 igr = 1 , ngr + numnum = 0 + if (igr .gt. 1) then +55 call g1etchar(lineq,iccount,charq) + if (charq .eq. ' ') go to 55 + end if + if (index('abcdefg',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'In grace, expected "a"-"g"!') + call stop1() + end if +18 call g1etchar(lineq,iccount,charq) + if (charq .ne. ' ') then + if (index('1234567',charq) .gt. 0) then + if (numnum .eq. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only one of "+-1234567" allowed here in grace!') + call stop1() + end if + numnum = 1 + go to 18 +c else if (index('nfs',charq) .gt. 0) then + else if (index('+-nfs',charq) .gt. 0) then + go to 18 + end if +c +c Digits are possible octave numbers +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after note name in grace!') + call stop1() + end if +19 continue + else if (charq .eq. chax(92)) then + call chklit(lineq,iccount,literr) + if (literr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * literq(literr)) + call stop1() + end if + else if (charq .eq. chax(34)) then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if + else if (charq .eq. 'o') then +c +c Ornament on non-xtup note. "o" symbol must come AFTER the affected note +c + if (nnl(ivx) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"o" must be in same input block, after affected note!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) +c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then + if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal ornament!') + call stop1() + end if + if (dumq .eq. ':') then + call g1etchar(lineq,iccount,dumq) + if (dumq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected blank after "o:"!') + call stop1() + else if (.not.ornrpt) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Turned off repeated ornaments before they were on!') + call stop1() + end if + ornrpt = .false. + else if (dumq .eq. 'g') then + if (issegno) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Sorry, only one "segno" per input block!') + call stop1() + else if (ivx .ne. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'segno can only be in voice 1!') + call stop1() + end if + issegno = .true. +12 call g1etchar(lineq,iccount,dumq) + if (dumq.eq.'-' .or. + * (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12 + if (dumq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in segno ornament symbol!') + call stop1() + end if + else if (dumq .eq. 'T') then +c +c Trill. may be followed by 't' and/or number. read 'til blank +c +22 call g1etchar(lineq,iccount,dumq) + if (dumq .eq. ':') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected blank after ":"!') + call stop1() + end if + go to 32 + else if (dumq .ne. ' ') then + go to 22 + end if + else if (dumq .eq. 'f') then + call g1etchar(lineq,iccount,dumq) + if (index(' d+-:',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "f" in fermata ornament symbol!') + call stop1() + end if + if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq) + if (dumq .eq. ':') go to 32 + else if (dumq .eq. 'e') then + call g1etchar(lineq,iccount,dumq) + if (index('sfn?',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "e" in edit. accid. symbol!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq) + else + call g1etchar(lineq,iccount,dumq) + end if + if (index('+- :',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in ornament symbol!') + call stop1() + end if + if (index('+-',dumq) .gt. 0) then + if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'There should be an integer here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (durq .eq. ':') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot shift AND repeat an ornament!') + call stop1() + end if +c +c 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. +c + if (index('+-',durq) .gt. 0) then + if (index('.0123456789',lineq(iccount+1:iccount+1)) + * .eq. 0) then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'There should be a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + end if + end if +32 continue + if (dumq .eq. ':') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '":" must be followed by blank in "o: "!') + call stop1() + else if (ornrpt) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Turned on repeated ornaments but already on!') + call stop1() + end if + ornrpt = .true. + end if + else if (index('st(){}',charq) .gt. 0) then + numint = 0 + iposn = 0 +8 call g1etchar(lineq,iccount,dumq) + iposn = iposn+1 + if (charq.eq.'t' .and. dumq.eq.'t') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot use "t" as an option on a tie!') + call stop1() + end if + if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then +c +c Check for explicit ID code. +c + ic = ichar(dumq) + if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or. + * ic.gt.90) then +c +c Not 0-9 or A-Z, so exit +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in slur symbol!') + call stop1() + else +c +c It is a possible ID code. Right place? +c + if (iposn .ne. 1) then +c +c Slur ID is not 2nd! +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slur ID must be second character in slur symbol!') + call stop1() + else if (charq.eq.'t' .and. fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slur ID not allowed on non-postscript tie!') + call stop1() + else if (lineq(iccount+1:iccount+1).eq.'x') then + iccount = iccount+1 + end if + end if +c +c Slur ID is OK. Note it cannot be "H" at this point.. +c + go to 8 + else if (dumq .eq. 'H') then + if (iposn .eq. 1) go to 8 +c +c "H" is NOT an ID code. +c + if (.not.fontslur .and. charq.eq.'t') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot reshape postscript ties this way!') + call stop1() + end if + if (lineq(iccount+1:iccount+1) .eq. 'H') then + iccount=iccount+1 + iposn = iposn+1 + end if + go to 8 + else if (index('fh',dumq).gt.0 .and. .not.fontslur + * .and. charq.eq.'t') then +c +c 3/9/03 Can't reshape postscript tie. +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot reshape postscript ties this way!') + call stop1() + else if (dumq .eq. 'p') then +c +c local change in postscript slur/tie adjustment default +c + if (fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must use postscript slurs ("Ap") to use this option!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('+-',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected "+" or "-" here!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('st',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected "s" or "t" here!') + call stop1() + end if + iposn = iposn+2 + go to 8 + end if + if (index('udltbfnh',dumq) .gt. 0) then + go to 8 + else if (index('+-',dumq) .gt. 0) then + numint = numint+1 + if (fontslur .and. charq.eq.'t') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"+|-" for slur height only allowed in "s"-slurs!') + call stop1() + end if + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (numint .eq. 1) then + if (nint(fnum) .gt. 30) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Magnitude of slur height adjustment cannot exceed 30!') + call stop1() + end if + else if (numint .eq. 2) then + if (abs(fnum) .gt. 6.3) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur horiz shift must be in range (-6.3,6.3)!') + call stop1() + end if + else +c +c Third signed integer, must be a midslur or curve spec. +c + if (abs(fnum).gt.31) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur midheight must be in the range (-31,31)!') + call stop1() + end if + if (durq .eq. ':') then +c +c Expecting curve parameters. Get two numbers +c + do 41 i = 1 , 2 + iccount = iccount+1 + fnum = ichar(lineq(iccount:iccount))-48 + if (abs(fnum-3.5) .gt. 3.6) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Slur curve parameter must be in range (0,7)!') + call stop1() + end if +41 continue + iccount = iccount+1 + end if + end if + iccount = iccount-1 + go to 8 + else if (dumq .eq. 's') then +c +c What follows should be one or two signed numbers for adjustment of line break +c slur, end of 1st segment or start of second. +c + if (fontslur) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'May not use linebreak slur options with font-based slurs!') + call stop1() + end if + call g1etchar(lineq,iccount,dumq) + if (index('+-',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This character must be "+" or "-"!') + call stop1() + end if + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (nint(fnum) .gt. 30) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Magnitude of slur height adjustment cannot exceed 30!') + call stop1() + end if + if (index('+-',dumq) .gt. 0) then + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (abs(fnum) .gt. 6.3) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Slur horiz shift must be in range (-6.3,6.3)!') + call stop1() + end if + end if + iccount = iccount-1 + go to 8 + else if (dumq .eq. 'H' .and. iposn.gt.1) then + if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1 + go to 8 + end if + else if (charq .eq. '?') then + call getchar(lineq,iccount,durq) + if (durq .eq. ' ') then + iccount = iccount-1 + else + if (durq .ne. '-') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expecting "-"!') + call stop1() + end if + call getchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expecting number!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + end if + else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or. + * index('#-nx_',charq) .gt. 0) then +c +c We have a figure. Must come AFTER the note it goes under +c + if (itsofar(ivx).eq.0 .and. + * (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then +c +c Figure before first note in block +c + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot put figure before first note in block!') + call stop1() + end if + if (charq.eq.'x') then + indxb = index(lineq(iccount:128),' ') + if (indxb .lt. 5) then + call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1, + * 'Cannot have a blank here in floating figure!') + call stop1() + end if + end if + if (usefig) ifig = 1 +5 call g1etchar(lineq,iccount,charq) + if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in figure!') + call stop1() + else if (charq .eq. '+') then +c +c vertical offset, must be integer, then blank +c + call g1etchar(lineq,iccount,charq) + if (index('123456789',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Integer for vertical offset expected here!') + call stop1() + end if + call readnum(lineq,iccount,charq,fnum) + if (charq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Vertical offset must terminate figure!') + call stop1() + end if + iccount = iccount-1 + go to 5 + else if (charq .eq. 's') then + isligfont = .true. + end if + if (charq .ne. ' ') go to 5 + else if (charq .eq. '[') then + if (fbon) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Started forced beam while another was open!') + call stop1() + end if + fbon = .true. +17 call g1etchar(lineq,iccount,charq) + if (index('uljhf:',charq) .gt. 0) then + go to 17 + else if (index('+-',charq) .gt. 0) then + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 17 + else if (charq .eq. 'm') then +c +c Forced multiplicity, next char should be 1-4 +c + call g1etchar(lineq,iccount,charq) + if (index('1234',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Forced multiplicity for a beam must be 1, 2, 3, or 4!') + call stop1() + end if + go to 17 + else if (charq .ne. ' ') then + if (index('0123456789',charq) .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'After "[", digits must now be preceeded by "+" or "-"!') + print*,'You will have to edit older sources to meet this rqmt,' + print*,'but it was needed to allow 2-digit height adjustments.' + print*,'Sorry for the inconvenience. --The Management' + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after [!') + end if + call stop1() + end if + else if (charq .eq. ']') then + if (.not.fbon) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Forced beam stop with no corresponding start!') + call stop1() + end if + call g1etchar(lineq,iccount,charq) + if (charq .eq. '-') then + if (lineq(iccount+1:iccount+2) .ne. '[ ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'Only sequence allowed here is "[ "!') + call stop1() + else + iccount = iccount+2 + end if + else if (charq .eq. '[') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'This character must be a blank!') + call stop1() + end if + else +c +c Forced beam is really ending +c + fbon = .false. + if (charq .eq. 'j') then + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'This character must be a blank!') + call stop1() + end if + else if (charq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"]" must be followed by blank, "j", "-", or "["!') + call stop1() + end if + end if + else if (charq .eq. 'D') then +c +c Dynamic mark +c + if (nnl(ivx) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"D" must not come before any notes have been entered!') + call stop1() + end if + call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1) + else if (index('lhw',charq) .gt. 0) then +c +c Save position for later check +c + icclhw = iccount + call g1etchar(lineq,iccount,durq) + if (index('0123456789.+- ',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "l", "w", or "h"!') + call stop1() + end if + isheadr = isheadr .or. charq .eq. 'h' + if (index(' +-',durq) .gt. 0) then +c +c There is a header (or lower string?) +c + if (index('+-',durq) .gt. 0) then +c +c User-defined vert offset (\internote). +c + if (charq .ne. 'h') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"+" or "-" not permitted here!') + call stop1() + end if +c +c Have "h" followed by +/- . Check for digit. +c Can blow durq since not using fnum for now, but... +c + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be a digit here!') + call stop1() + end if +c +c Have "h" followed by +/- followed by a digit. No need to get the number. +c +c call readnum(lineq,iccount,durq,fnum) + end if + if (charq .ne. 'w') then +c +c Header or lower string. +c + if (icclhw .ne. 1) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * '"h" or "l" must be first character in line!') + call stop1() + end if +c +c Read past the next line, which has the string. +c + call read10(charq,lastchar) + nline = nline+1 + iccount = 128 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Symbol "w" (width) must be followed by a digit!') + call stop1() + end if + else +c +c Height or width change spec. Check if at start of piece. +c + if (ibarcnt .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Symbol must go at top of first input block!') + call stop1() + end if + call readnum(lineq,iccount,durq,dimen) +c +c Check units. Convert to points +c + if (durq .eq. ' ' .or. durq .eq. 'p') then + dimen = dimen+.5 + else if (durq .eq. 'i') then + dimen = dimen*72+.5 + else if (durq .eq. 'm') then + dimen = dimen/25.4*72+.5 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal unit; must be "p","i",or"m"!') + call stop1() + end if +c +c 151211 fix. May have extra character. +c + if (index('pim',durq) .gt. 0) then +c +c Get another character, see if it's blank +c + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'This character should be a blank!') + call stop1() + end if + end if + if (charq .eq. 'h') then + ptheight = int(dimen) + else + widthpt = int(dimen) + end if + end if + else if (charq .eq. 'm') then +c +c Time signature change. Only allow at beginning of block. +c mtrnuml, mtrdenl (logical) and p (printable) will be input. +c mtrnuml=0 initially. (In common) +c +c Check whether at beginning of a block +c + if (ivx.ne.1 .or. nnl(1).ne.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Meter change only OK in voice 1, at start of block!') + print*,'voice number is',ivx + call stop1() + end if + newmeter = .true. + if (index('o0123456789',lineq(iccount+1:iccount+1)).eq.0) then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in "m" command for meter change!') + call stop1() + end if + call readmeter(lineq,iccount,mtrnuml,mtrdenl) + if (mtrnuml .eq. 0) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Digit 0 not allowed here!') + call stop1() + end if + call readmeter(lineq,iccount,mtrnmp,mtrdnp) +c +c Read past printed time signature; not used in pmxa. +c + lenbeat = i1fnodur(mtrdenl,'x') + lenmult = 1 + if (mtrdenl .eq. 2) then + lenbeat = 16 + lenmult = 2 + end if + lenbar = lenmult*mtrnuml*lenbeat + mtrnuml = 0 + else if (charq .eq. 'C') then + call g1etchar(lineq,iccount,durq) + if (.not.(index('tsmanrbf',durq).gt.0 .or. + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') + call stop1() + end if + else if (charq .eq. 'R') then + if (ivx .ne. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Repeats can only go in voice 1!') + call stop1() + end if +c10 call g1etchar(lineq,iccount,durq) +c if (index('lrdDbz',durq) .gt. 0) go to 10 +c if (durq .ne. ' ') then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'Illegal character after "R" (repeat/double bar)!') +c call stop1() +c end if + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,dumq) + if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "R*" (repeat/double bar)!') + call stop1() + end if + if (dumq .ne. ' ') then + call g1etchar(lineq,iccount,durq) + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have blank after "R**" (repeat/double bar)!') + call stop1() + end if + end if + else if (charq .eq. 'V') then +c +c Ending +c + if (iv .ne. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Voltas are only allowed in voice #1!') + call stop1() + else if (isvolt) then + print* + print*,'*******WARNING********' + write(15,'(/,a)')'*******WARNING********' + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There is more than one volta in this input block.!') + print*,'This may work in a score, but WILL NOT work in parts.' + print*, + *'Safest to have only 1 volta per block, at the start of the block' + write(15,'(a)') + * 'This may work in a score, but WILL NOT work in parts.' + write(15,'(a)') + *'Safest to have only 1 volta per block, at the start of the block' + end if + isvolt = .true. + lvoltxt = 0 +11 call g1etchar(lineq,iccount,durq) + if (durq .ne.' ') then + go to 11 + end if + else if (charq .eq. 'B') then + continue + else if (charq .eq. 'P') then + if (ivx.ne.1 .or. nnl(1).ne.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only allowed at beginning of block!') + call stop1() + end if +16 call g1etchar(lineq,iccount,durq) + if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and. + * ichar(durq).le.57)) go to 16 + if (durq .eq. 'c') then +c +c Expect a centered name, and it has to be last option +c + call g1etchar(lineq,iccount,durq) + if (durq .eq. chax(34)) then +c +c Quoted name, go to next quote mark +c + do 35 iccount = iccount+1 , 127 + if (lineq(iccount:iccount).eq.chax(34) .and. + * lineq(iccount-1:iccount-1).ne.chax(92)) go to 36 +35 continue + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Missing close quote after page number command (P)!') + call stop1() +36 continue + else if (durq .ne. ' ') then +c +c Space-delimited name, look for next blank +c + do 37 iccount = iccount+1 , 127 + if (lineq(iccount:iccount) .eq. ' ') go to 38 +37 continue +38 continue + end if + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "l","r","c" or digit allowed after "P"!') + call stop1() + end if + else if (charq .eq. 'W') then + call g1etchar(lineq,iccount,durq) + if (index('.0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a number to start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1)) + else if (charq .eq. 'T') then +c +c Titles +c + call g1etchar(lineq,iccount,durq) + if (index('itc',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must put "i", "t", or "c" after "T"!') + call stop1() + end if + ihead = ihead+2**(index('itc',durq)-1) +c +c Maybe a number after 'Tt', but ignore here. Read past string on next line. +c + call read10(charq,lastchar) + nline = nline+1 + iccount = 128 + else if (charq .eq. 'A') then +27 call g1etchar(lineq,iccount,durq) + if (index('rbsdK',durq) .gt. 0) then + go to 27 + else if (durq .eq. 'e') then +c +c Check for is4bignv. Must do here to catch first \internote, written in topfile +c before ever calling getnote. Initialize as .false. in pmxa. Make it true only +c if nv>7, AI not set, Ai not set. +c + is4bignv = nv.gt.7 .and. .not.AIset + go to 27 + else if (durq .eq. 'v') then + if (ibarcnt .eq. 0) novshrinktop = .true. + go to 27 + else if (durq .eq. 'a') then + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'After "Aa", need decimal number!') + call stop1() + end if + call readnum(lineq,iccount,durq,fbar) + iccount = iccount-1 + go to 27 + else if (durq .eq. 'i') then + is4bignv = .false. + AIset = .true. + call g1etchar(lineq,iccount,durq) +c +c Local interstaff correction. Set to -1. if not specifiec, or after use, +c or anytime except at top, since pmxb handles all times except at top. +c + call readnum(lineq,iccount,durq,tintstf) + if (ibarcnt .eq. 0) fintstf = tintstf + iccount = iccount-1 + go to 27 + else if (durq .eq. 'I') then +c +c Global interstaff correction. Use in place of fintstf if fintstf<0 +c + is4bignv = .false. + AIset = .true. + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,gintstf) + iccount = iccount-1 + go to 27 + else if (durq .eq. 'o') then + optimize = .true. + go to 27 + else if (durq .eq. 'S') then + do 50 iiv = 1 , noinst + call g1etchar(lineq,iccount,durq) + if (index('-0st',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'After "AS", need nv instances of "s,t,-,0"!') + call stop1() + end if + if (durq.eq.'-'.or.durq.eq.'s') then + isize(iiv) = 1 + else if (durq.eq.'t') then + isize(iiv) = 2 + end if +50 continue + go to 27 + else if (durq .eq. 'p') then + fontslur = .false. +42 continue + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .gt. 0) then +c +c Characters to change defaults for ps slurs +c + call g1etchar(lineq,iccount,durq) + if (index('shtc',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only letters allowed here are "s","h","t","c"!') + call stop1() + end if +c +c Now check for another default modifier +c + go to 42 + else if (index('lh',durq) .gt. 0) then +c +c Flags for optional linebreak ties or header specials +c + go to 42 + else + iccount = iccount-1 + end if + go to 27 + else if (durq .eq. 'N') then +c +c Override default name for a part file. Must have part number, then +c partname in quotes. Must be on line by itself, and start in column 1. +c Will only be passed thru to scor2prt. +c + if (iccount .ne. 2) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"AN" must start in column 1!') + call stop1() + end if + ndxquote = index(lineq,chax(34)) + if (ndxquote.lt.4 .or. ndxquote.gt.5 .or. + * index('123456789',lineq(3:3)).eq.0 .or. + * (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"AN" must be followed by inst. #, then quote!') + call stop1() + end if + ndxquote = index(lineq(ndxquote+1:128),chax(34)) + if (ndxquote .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'In "AN", file name must be in quotes!') + call stop1() + end if + iccount = 128 + else if (durq .eq. 'T') then + cstuplet = .true. + else if (durq .eq. 'R') then +c +c Get full name of normal include file; must occupy remainder of line +c + call getpmxmod(.false.,lineq(iccount+1:128)) + iccount = 128 + else if (durq .eq. 'c') then + call g1etchar(lineq,iccount,durq) + if (index('l4',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "l" or "4" is allowed here!') + call stop1() + end if + if (durq .eq. 'l' ) then + hoffpt = -25 + voffpt = -45 + else if (durq .eq. '4') then + ptheight = 745 + widthpt = 499 + hoffpt = -24 + voffpt = -24 + end if + go to 27 + else if (durq .eq. 'V') then + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift before \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift after \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 27 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'After "A" must follow one of the letters abcdeiINprRsST!') + * 'After "A" must follow one of abcdeiILNprRsSTvV!') + print*,'For AS, since ver. 2.7, must only have noinst args.' + write(15,'(a)') + * 'For AS, since ver. 2.7, must only have noinst args.' + call stop1() + end if + else if (charq .eq. 'K') then +c +c Rules and function of K command +c +c Only 1 K +/-n +/-m allowed per block if n.ne.0 (transposition). isig1 is +c initial sig, and must be passed to pmxb because it is needed when topfile +c is called, which is before the K+n+m command is read in pmxb. Also, we +c compute and save ibrkch and newkey for each syst, accounting for key changes, +c then adjust fbar to make poenom much more accurate. +c Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. +c +77 continue + call g1etchar(lineq,iccount,durq) +c if (index('+-i',durq) .eq. 0) then + if (index('+-in',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"K" (transpose or key change) must be followed by "+,-,i,n"!') + call stop1() + end if + if (durq .eq. 'n') go to 77 + if (durq .ne. 'i') then +c +c Normal key change and/or transposition) +c +c iccount = iccount+1 + num1 = 44-ichar(durq) +c +c num1= +1 or -1 +c + ztrans = num1.eq.-1 + call g1etchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '1st +/- must be followed by a number!') + call stop1() + end if +c iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + num1 = nint(fnum)*num1 + ztrans = ztrans .and. num1.eq.0 + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '1st number after "K" must be followed by "+,-"!') + call stop1() + end if + iccount = iccount+1 + num2 = 44-ichar(durq) + call readnum(lineq,iccount,durq,fnum) + num2 = num2*int(fnum+.1) + if (num1.eq.0 .and. .not.ztrans) then +c +c Key change, only one per block allowed +c + if (iskchb) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only one key change allowed per input block!') + call stop1() + end if + iskchb = .true. + nkeys = nkeys+1 + kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0 +c +c Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. +c + ibrkch(nkeys) = ibarcnt+nbars + if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1 + newkey(nkeys) = num2+idsig +c 130316 +c do 43 iinst = 1 , noinst + midisig = newkey(nkeys) +c43 continue + else +c +c Transposition +c + fulltrans = .true. + if (ibarcnt .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Transposition must be at top of first input block!') + call stop1() + end if + isig1 = num2 + idsig = isig1-newkey(1) +c +c idsig is the difference between sig after transposition, and sig in setup. +c It may alter # of accid's in key changes if there is transposition. +c + end if + else ! durq='i' +c +c 110522/110529 +c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] +c and repeat i[...] for multiple instruments. Store info here if ibarcnt=0 +c so can pass to topfile (via comInstTrans), which is called before getnote. +c Otherwise, will store info from getnote. Initialize EarlyTransOn and +c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; +c LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really +c only needed for instrument-signatures, not transpositions. iTransAmt is +c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for +c each staff. +c + call GetiTransInfo(.true.,ibarcnt,lineq,iccount, + * ibaroff,nbars,noinst) + end if + else if (charq .eq. '|') then +c +c Optional bar symbol +c + if (mod(itsofar(ivx),lenbar).ne.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Bar line marker out of place!') + call stop1() + else if (shifton) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Bar ended with user-defined shift still on!') + call stop1() + end if + else if (charq .eq. chax(47)) then + if (ornrpt) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'WARNING: Block ended with repeated ornament still on!') + ornrpt = .false. + end if + if (stickyS) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'WARNING: Block ended with sticky stemshrink still on!') + stickyS = .false. + end if + if (fbon) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Block ended with forced beam open!') + call stop1() + else if (shifton) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Bar ended with user-defined shift still on!') + call stop1() + end if + barend = .false. +c +c Perform time checks +c + if (mod(itsofar(ivx),lenbar).ne.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Block duration not divisible by lenbar!') + print*,'lenbar, timesofar are ',lenbar,itsofar(ivx) + call stop1() + else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then + print* + print*,'No of bars in voice 1, current voice:', + * itsofar(1)/lenbar,itsofar(ivx)/lenbar + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Block duration not equal to voice 1!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (durq .eq. ' ' .and. iv.eq.nv) then +c +c End of input block +c + loop = .false. + else +c +c Start a new voice +c + if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0 + nbars = 0 + if (durq .eq. ' ') then +c +c New voice is on next staff +c + iv = iv+1 + ivx = iv + else +c +c New voice is on same staff. Set up for it +c + ivx = nv+1 + do 23 iiv = 1 , nv + if (nvmx(iiv) .eq. 2) ivx = ivx+1 +23 continue + if (ivx .gt. nm) then + write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm, + * ' lines of music at once' + call stop1() + end if + nvmx(iv) = 2 + ivmx(iv,2) = ivx + itsofar(ivx) = 0 + nnl(ivx) = 0 + do 24 j = 1 , 200 + rest(ivx,j) = .false. + nacc(ivx,j) = 0 +24 continue +c +c For midi stuff, record that there is a 2nd line of music in this voice +c + if (ismidi) twoline(iv) = .true. + end if + end if + iccount = 128 + else if (charq .eq. 'S') then +c +c New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. +c + if (ibarcnt .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"S" can only be in first input block!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('123456789 ',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A digit must follow "S"!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnsyst) + nsyst = nint(fnsyst) +14 continue + if (durq .eq. 'P') then +c +c New npages for parts. +c + call g1etchar(lineq,iccount,durq) + if (index('123456789 ',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnsyst) + npages = nint(fnsyst) + go to 14 + else if (durq .eq. 'm') then +c +c Reset musize (musicsize). +c + call g1etchar(lineq,iccount,durq) + if (index('123456789 ',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnsyst) + musize = nint(fnsyst) + wheadpt = whead20*musize + go to 14 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in "S" symbol!') + call stop1() + end if + else if (charq .eq. 'L') then +c +c Force line break +c + call g1etchar(lineq,iccount,durq) + if (durq .eq. 'C') then +c +c Coda, no real line break, just get coda length +c + if (ishort .ne. 1) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot use "LC" without first using "L[n]S"!') + call stop1() + end if + ishort = 0 + call g1etchar(lineq,iccount,durq) + if (index('1234567890.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need number to define coda length!') + call stop1() + end if + call readnum(lineq,iccount,durq,codafrac) + poefa(isysflb(nflb)) = poefa(isysflb(nflb))+codafrac + if (index(' n',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need blank or "n" here!') + call stop1() + end if + return + end if + nflb = nflb+1 + ibarflb(nflb) = ibarcnt+nbars+1 + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need integer to define forced line break!') + call stop1() + end if + call readnum(lineq,iccount,durq,sysflb) + isysflb(nflb) = nint(sysflb) + if (isysflb(nflb) .eq. 1) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'For now, "L1" not allowed!') + call stop1() + end if + if (nflb .gt. 1) then +c +c Check if new number is > prior one +c + if (isysflb(nflb) .le. isysflb(nflb-1)) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'You already forced a line break at a later line!') + call stop1() + end if + end if + if (npages .eq. 0) then + print* + print*,'WARNING! You forced a line break at line ', + * isysflb(nflb),' but npage = 0. Continue?' +c read(*,'(a)') charq +c if (index('yY',charq) .eq. 0) call stop1() + else if (isysflb(nflb) .gt. nsyst) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Forced line break at line num > nsyst!') + call stop1() + else if (index(' PMS',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have " ", "P", "M", or "S" here!') + call stop1() + end if +49 continue ! Transfer up from below to allow S after M + if (durq .eq. 'S') then +c +c Shortened line, get shortening fraction +c + ishort = 1 + call g1etchar(lineq,iccount,durq) + if (index('1234567890.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need number to define line shortening fraction!') + call stop1() + end if + call readnum(lineq,iccount,durq,shortfrac) + poefa(isysflb(nflb)) = shortfrac + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need blank here!') + end if + end if + if (durq .eq. 'P') then +c +c Forced page break here, get page number. +c + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Need integer to define forced page break!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + nfpb = nfpb+1 + ipagfpb(nfpb) = nint(fnum) + isysfpb(nfpb) = isysflb(nflb) + if (ipagfpb(nfpb) .gt. npages) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Forced page break at page num > npages!') + call stop1() + else if (nfpb .gt. 1) then + if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Forced page break numbers must increase!') + call stop1() + end if + end if + end if + if (index(' M',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in linebreak symbol!') + call stop1() + else if (durq .eq. 'M') then + nmovbrk = nmovbrk+1 + isysmb(nmovbrk) = isysflb(nflb) + call g1etchar(lineq,iccount,durq) +31 if (durq .eq. '+') then +c +c Vertical spacing, read past number. +c + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Integer required here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + go to 31 + else if (durq .eq. 'i') then +c +c Change indentation, +c + call g1etchar(lineq,iccount,durq) + if (index('.123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Decimal number required here!') + call stop1() + end if +c +c fracsys was initialized in block data to all 0.'s +c + call readnum(lineq,iccount,durq,fracsys(nmovbrk)) + go to 31 + else if (durq .eq. 'c') then + call g1etchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'r') then + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have "+" or "-" after "r" as movement break option!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'n') then +c +c Change # of voices. Input ninow, iorig(1...ninow). Will use names, +c staves per inst. and clefs corr. to iorig in original list of instruments. +c + nv = 0 + call g1etchar(lineq,iccount,durq) + if (durq .eq. ':') then +c +c Signals a 2-digit number, get next two characters +c + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,dumq) + if (index('12',durq).eq.0 + * .or.index('0123456789',dumq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal new number of instruments '//durq//dumq// + * ' at movement break!') + call stop1() + end if + read(lineq(iccount-1:iccount),'(i2)')ninow + else +c +c durq is a single digit number for noinow +c + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal new number of instruments '//durq// + * ' at movement break!') + call stop1() + end if + ninow = ichar(durq)-48 + end if + if (ninow.gt.noinst) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'New number of instruments must be <= original!') + call stop1() + end if + do 63 iinow = 1 , ninow + call g1etchar(lineq,iccount,durq) + if (durq .eq. ':') then +c +c Signals a 2-digit number +c + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,dumq) + if (index('12',durq).eq.0 + * .or.index('0123456789',dumq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal 2-digit instrument number '//durq//dumq// + * ' at movement break!') + call stop1() + end if + read(lineq(iccount-1:iccount),'(i2)')iorig + else +c +c durq is a single digit number for iorig +c + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal instrument number '//durq// + * ' at movement break!') + call stop1() + end if + iorig = ichar(durq)-48 + end if + if (iorig .gt. noinst) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'New instrument number must be <= original noinst!') + call stop1() + end if + nv = nv+nsperi(iorig) +63 continue + do 61 iiv = 1 , nv +c +c Get clef names +c + call g1etchar(lineq,iccount,durq) + if (.not.(index('tsmanrbf',durq).gt.0 .or. +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!') + call stop1() + end if +c +c Initialize new voices +c + nvmx(iiv) = 1 + ivmx(iiv,1) = iiv + itsofar(iiv) = 0 + nnl(iiv) = 0 + do 62 j = 1 , 200 + rest(iiv,j) = .false. +62 continue +61 continue +c +c Loop back up, this might not be last option in M +c + call g1etchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'S') then + go to 49 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after Movement break symbol!') + call stop1() + end if + if (fracsys(nmovbrk) .lt. 0.001) then +c +c Since fracsys was not explicitly set, set it to prior value. +c + if (nmovbrk .eq. 1) then + fracsys(nmovbrk) = fracindent + else + fracsys(nmovbrk) = fracsys(nmovbrk-1) + end if + end if + end if +c +c Just before exiting if-block for forced line breaks, set counter to use when +c dealing with vertical space calcs +c + nistaff(nflb) = nv-1 + else if (charq .eq. 'F') then + usefig = .false. + else if (charq .eq. 'X') then + call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1, + * udsp(ibarcnt+nbars+1),wheadpt) + else if (charq .eq. 'I') then +c +c MIDI settings. +c + if (ivx.ne.1 .or. nnl(1).ne.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'MIDI stuff only allowed at start of block!') + call stop1() + end if + if (nv .gt. 15) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Sorry but MIDI does not work with more than 15 voices!') + call stop1() + end if + ismidi = .true. + call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, + * mtrdenl,nv,.true.) + else if (charq .eq. 'M') then + call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx, + * nline) + else if (index(',.',charq) .gt. 0) then +c +c Continued rhythmic shortcut +c + idotform = index('. ,',charq) + if (idotform .eq. 1) then +c +c Change duration of prior note +c + itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 + itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) + end if + idotform = idotform+1 + numnum = 1 + cdot = .true. + go to 1 + else + print*,'ASCII code:',ichar(charq) + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This character is not allowed here!') + print*,'ASCII code:',ichar(charq) + call stop1() + end if + return + end + subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, + * xmtrnum0,newkey,npages,nsyst,musize,bottreb) + parameter(nm=24,maxblks=9600) + character*131072 bufq + character*1 chax + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + character*128 lineq + logical lastchar,issegno,isheadr,isvolt,fbon,bottreb, + * newway + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + common /commidisig/ midisig +c +c Get the first line +c + iccount = 0 + nline = 1 +9 call getbuf(lineq) + if (lineq(1:1) .eq. '%') then + nline = nline+1 + go to 9 + end if + if (lineq(1:3) .eq. '---') then +c +c Have TeX input until next line that starts with '---' +c +3 nline = nline+1 + call getbuf(lineq) + if (ilbuf .gt. nlbuf) go to 1 + go to 2 +1 print*,'You did not terminate type 0 TeX input with "---"' + call stop1() +2 continue + if (lineq(1:3) .ne. '---') go to 3 +c +c Force a new line read on first call to readin +c + iccount = 128 + end if +c +c Here, lineq and nline are first non-TeX lines. +c + nv = nint(readin(lineq,iccount,nline)) + if (nv .gt. nm) then + write(*,'(1x,a46,i3)') + * 'In setup data, number of voices cannot exceed',nm + call stop1() + end if + noinst = nint(readin(lineq,iccount,nline)) + if (noinst .gt. nv) then + write(*,'(a)') + * 'In setup data, cannot have more instruments than staves' + call stop1() + end if + newway = noinst.le.0 + if (newway) noinst = -noinst + do 10 iinst = 1 , noinst +c +c Seve # of staves per inst in case later drop some inst's. +c + if (newway) then + nsperi(iinst) = nint(readin(lineq,iccount,nline)) + else if (iinst .gt. 1 ) then + nsperi(iinst) = 1 + else + nsperi(iinst) = nv-noinst+1 + end if +10 continue + mtrnuml = nint(readin(lineq,iccount,nline)) + mtrdenl = nint(readin(lineq,iccount,nline)) +cc +cc Kluge!!! +cc +c if (mtrdenl .eq. 1) then +c mtrdenl = 2 +c mtrnuml = mtrnuml*2 +c end if + mtrnmp = nint(readin(lineq,iccount,nline)) + mtrdnp = nint(readin(lineq,iccount,nline)) + if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then + write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8' + call stop1() + end if + xmtrnum0 = readin(lineq,iccount,nline) + newkey = nint(readin(lineq,iccount,nline)) +c 130316 +c do 11 iinst = 1 , noinst + midisig = newkey +c11 continue + npages = nint(readin(lineq,iccount,nline)) + nsyst = nint(readin(lineq,iccount,nline)) + musize = nint(readin(lineq,iccount,nline)) + fracindent = readin(lineq,iccount,nline) + if (fracindent .ge. 1.) then + write(*,'(a)')'In setup data, fracindent must be <1' + call stop1() + end if + if (npages .gt. nsyst) then + print*,'Error in input file: npages > nsyst' + call stop1() + else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then + call printl('Musicsize must be 16, 20, 24, or 29') + call stop1() + end if +c +c Next noinst non-comment lines are names of instruments. +c + do 4 i = 1 , abs(noinst) +5 call getbuf(lineq) + nline = nline+1 + if (lineq(1:1) .eq. '%') go to 5 +4 continue +c +c Mext non-comment line has nv clef names +c +6 call getbuf(lineq) + nline = nline+1 + if (lineq(1:1) .eq. '%') go to 6 + do 7 iv = 1 , nv +c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then + if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then + call errmsg(lineq,iv,0, + * 'There should be a clef symbol here!') + call stop1() + end if +7 continue + if (lineq(nv+1:nv+1) .ne. ' ') then + call errmsg(lineq,nv+1,0, + * 'There should be a blank here!') + call stop1() + end if +c +c Set flag if voice 1 is treble, since it affects vertical spacing +c +c bottreb = lineq(1:1).eq.'t' + bottreb = index('t08',lineq(1:1)).gt.0 +c +c Next non-comment line has path name +c +8 call getbuf(lineq) + nline = nline+1 + if (lineq(1:1) .eq. '%') go to 8 + lpath = index(lineq,' ')-1 + if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then + call errmsg(lineq,lpath,0, + * 'Last character of pathname is not "/",":", or "' + * //chax(92)//'"!') + call stop1() + end if + return + end + subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt) +c +c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. +c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. +c + logical shifton,number,btest + character*128 lineq + character*1 charq,dumq + number = .false. + nPBSc = 0 +1 call g1etchar(lineq,iccount,charq) + if (index('PBS:',charq) .gt. 0) then +c +c Continue checking here even if "P". +c + ipbsc = index('PBS:',charq) + if (btest(nPBSc,ipbsc)) then + call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!') + call stop1() + end if + nPBSc = ibset(nPBSc,ipbsc) + go to 1 + else if (index('+-.0123456789',charq) .gt. 0) then + number = .true. + if (index('+-',charq) .gt. 0) then + call g1etchar(lineq,iccount,dumq) + if (index('.0123456789',dumq) .eq. 0) then + call errmsg(lineq,iccount,ibar,'Expected a number here!') + call stop1() + end if + end if + call readnum(lineq,iccount,dumq,fnum) + if (charq.eq.'-') fnum = -fnum + if (dumq .ne. 'p') then + iccount = iccount-1 + fnum = fnum*wheadpt + end if + go to 1 + else if (charq .ne. ' ') then + call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!') + call stop1() + end if +c +c Done with parsing. Other checks +c + if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then + call errmsg(lineq,iccount-1,ibar, + * 'Cannot have both "P" and "B" or "S" and ":"!') + call stop1() + end if + if (btest(nPBSc,4)) then + if (number) then + if (shifton) then + call errmsg(lineq,iccount-1,ibar, + * 'Started a group shift without stopping prior one!') + call stop1() + else + shifton = .true. + end if + else + if (.not. shifton) then + call errmsg(lineq,iccount-1,ibar, + * 'Ended a group shift without starting one!') + call stop1() + else + shifton = .false. + end if + end if + end if +c +c P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) +c + if (iand(nPBSc,26).eq.0) udsp = udsp+fnum + if (.not.number .and. .not.btest(nPBSc,4)) then + call errmsg(lineq,iccount-1,ibar, + * 'Must have either a number or a colon in "X" symbol!') + call stop1() + end if + return + end +c integer*4 function mytime() +c CHARACTER(10) tq +c CALL DATE_AND_TIME(TIME=tq) +c read(tq,'(2i2,f6.3)')ih,im,ts +c mytime = 1000*(ts+60*(im+60*ih)) +c return +c end + subroutine getbuf(lineq) + parameter (maxblks=9600) + character*(*) lineq + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) + ipbuf = ipbuf+lbuf(ilbuf) + ilbuf = ilbuf+1 + return + end + subroutine getchar(lineq,iccount,charq) + parameter (nm=24) +c +c Gets the next character out of lineq*128. If pointer iccount=128 on entry, +c then reads in a new line. Resets iccount. Ends program if no more input. +c + common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, + * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, + * rptprev,equalize,rptfq1,rptfq2 + logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + logical mrecord,mplay,endmac,equalize,stickyS + character*1 charq,rptfq1,rptfq2 + character*128 lineq,lnholdq + if (iccount .eq. 128) then + call read10(lineq,lastchar) + if (lastchar) return + if (.not. endmac) then + iccount = 0 + else + endmac = .false. + iccount = icchold + lineq = lnholdq + end if + if (mrecord) then + call mrec1(lineq,iccount,ndxm) + end if + end if + iccount = iccount+1 + charq = lineq(iccount:iccount) + return + end + subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount) + parameter (nm=24) + common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), + * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), + * idynda2(99),levhssav(nm),listcresc,listdecresc + character*128 txtdynq + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + logical fontslur,upslur,WrotePsslurDefaults + character*1 durq,chax + character*4 dynsymq + character*128 lineq +c +c Get info for dynamic mark. Enter after getting "D", iccount sits on "D" +c Bits in idyndat are as follows +c 00-03 ivx +c 04-11 ip +c 12-15 code for type of mark +c 0 => arbitrary text +c 1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff +c If (.not. fontslur) +c 13 => hairpin start, 14,15 => <,> (ending) +c else +c 13 < start, 14 > start, 15 ending +c end if +c 16 flag for vertical offset +c 17-23 vertical offset + 64 , \internote +c 31 Hairpin start (0), stop (1) +c +c idynda2 +c +c 00 flag for horizontal offset +c 01-09 (horizontal offset)/10 + 25.6 notehead widths +c 10 5th bit for ivx (5/15/10) +c + irest = ibset(irest,26) + ndyn = ndyn+1 + idyn = ivx + idynda2(ndyn) = 0 + if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1) + call setbits(idyn,8,4,ip) + if (lineq(iccount+1:iccount+1) .eq. chax(34)) then +c +c text-dynamic +c + ntxtdyn = ntxtdyn+1 + iccountt = iccount +3 continue + iend = iccountt+index(lineq(iccountt+2:128),chax(34))+2 + if (lineq(iend-2:iend-2) .eq. chax(92)) then + iccountt = iend-2 + go to 3 + end if + txtdynq(ntxtdyn) = lineq(iccount+2:iend-2) +c +c Store ivx, ip in bits 0-12 +c + ivxiptxt(ntxtdyn) = ivx+32*ip + ipm = index('- +',lineq(iend:iend)) + idno = 0 + else +c +c Word-group or hairpin +c + do 1 iend = iccount+2 , 128 + ipm = index('- +',lineq(iend:iend)) +c +c Exit the loop at first blank, "+", or "-" +c + if (ipm .gt. 0) go to 2 +1 continue +2 continue + read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')') + * dynsymq + idno = (index( + * 'ppppppp pp p mp mf f fp sfz ff fff ffff < > ', + * dynsymq)+3)/4 +c +c Save for later down +c + idno1 = idno + end if +c +c Set flag to check level later if in beam +c + iornq = ibset(iornq,23) + if (idno.ge.14) then +c +c Hairpin here. Check if opposite type from one that's already on +c + if (idno.eq.14.and.btest(listdecresc,ivx) .or. + * idno.eq.15.and.btest(listcresc,ivx)) then + call printl(' ') + call printl('Started one kind of hairpin while other is on') + call stop1() + end if +c +c Start or stop? +c + if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then +c +c Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. +c + if (.not.fontslur) idno = 15 + else if (fontslur) then +c +c Start of font slur +c + idno = 13 + else +c +c Start of postscript slur +c + idno = idno-1 + end if + end if +c +c Now that we used list[de]cresc, update +c + if (idno .ge.13) then + if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then +c +c Something's ending +c + if (btest(listcresc,ivx)) then +c +c It's a cresc! +c + listcresc = ibclr(listcresc,ivx) + else + listdecresc = ibclr(listdecresc,ivx) + end if + else +c +c Something's starting +c + if (idno1 .eq. 14) then +c +c It's a cresc! +c + listcresc = ibset(listcresc,ivx) + else + listdecresc = ibset(listdecresc,ivx) + end if + end if + end if + call setbits(idyn,4,12,idno) + iccount = iend + if (ipm .ne. 2) then +c +c There is a vertical shift +c + idyn = ibset(idyn,16) + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + idno = nint(fnum) + call setbits(idyn,7,17,(ipm-2)*idno+64) + ipm = index('- +',durq) + if (ipm .ne. 2) then +c +c There is a horizontal shift +c +c idynda2(ndyn) = ibset(idyn,23) + idynda2(ndyn) = ibset(idynda2(ndyn),0) + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + idno = nint(10*fnum) + call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256) + end if +c +c iccount should be on the blank at the end of the entire symbol +c + end if + idyndat(ndyn) = idyn + return + end + subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig, +c * itsofar,nodur,figq,ivupfig,nfigs) + * itsofar,nodur,figq,ivupfig,ivvfig,nfigs) + logical isfig + character*1 charq + character*10 figq + character*128 lineq + nfigs = nfigs+1 + ivupfig = 0 + ivvfig = 0 + itoff = 0 + if (charq .eq. 'x') then +c +c Floating figure. +c + call getchar(lineq,iccount,charq) + read(charq,'(i1)')noff + call getchar(lineq,iccount,charq) + read(charq,'(i1)')loff + itoff = noff*ifnodur(loff,'x') + call getchar(lineq,iccount,charq) + else +c +c Figure on a note +c + isfig = .true. + end if + itfig = itsofar+itoff-nodur + lfig = 1 + figq = charq +5 call getchar(lineq,iccount,charq) +c if (index(' +',charq) .eq. 0) then + if (index(' +v',charq) .eq. 0) then + figq = figq(1:lfig)//charq + lfig = lfig+1 + go to 5 + else if (charq .eq. '+') then +c +c Get vertical offset for figure. Next character after number has to be blank. +c + iccount = iccount+1 + call readnum(lineq,iccount,charq,fnum) + ivupfig = nint(fnum) + else if (charq .eq. 'v') then +c +c Get vertical change in figdrop. Must be last item in figure word. +c + isign = 1 + call getchar(lineq,iccount,charq) + if (charq .eq. '-') then + isign=-1 + call getchar(lineq,iccount,charq) + end if + ivvfig = isign*(ichar(charq)-48) + end if + return + end + subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, + * lastlev,iv,nv) + parameter (nm=24) + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg + character*1 charq,durq + character*20 voltxtq + character*128 lineq,litq + integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm), + * ndlev(nm,2) + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans +c +c Grace, comes *before* main note: +c UNLESS there's an 'A' or 'W' after the 'G' +c ngrace = # of grace note groups so far in block +c ivg(ngrace), ipg(ngrace) +c nng(ngrace) = # of notes in this group: default = 1 +c ngstrt(ngrace) = starting position in nolevg of levels for this grace +c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' +c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' +c slurg(ngrace) = logical for slur; default F, input 's' +c slashg(ngrace) = T if slash; default is F, input 'x' +c These data MUST precede note name of first note +c nolevg, naccg: lists of levels and accid's, indexed as described above. +c + ngrace = ngrace+1 + ivg(ngrace) = ivx + ipg(ngrace) = nnl(ivx)+1 + if (ngrace .eq. 1) then + ngstrt(ngrace) = 1 + else + ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) + end if + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) + nng(ngrace) = 1 + multg(ngrace) = 1 + upg(ngrace) = .true. + slurg(ngrace) = .false. + slashg(ngrace) = .false. +18 call getchar(lineq,iccount,charq) + if (index('WA',charq) .gt. 0) then +c +c Grace is on note that was already done, so shift flags forward one note. +c This puts flag on actual note with grace; later for W will go ahead one more. +c + ipg(ngrace) = nnl(ivx) + islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) + if (slurg(ngrace)) + * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) + if (charq .eq. 'A') then +c +c close After, clear way-after bit, to ensure priority of most recent A/W +c + ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) + else +c +c Way after; later assign to following note, and position like normal grace. +c + ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) + end if + else if (charq .eq. 'm') then + call getchar(lineq,iccount,charq) + multg(ngrace) = ichar(charq)-48 + else if (index('123456789',charq) .gt. 0) then + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + nng(ngrace) = nint(fnum) + else if (charq .eq. 'l') then + upg(ngrace) = .false. + else if (charq .eq. 's') then + slurg(ngrace) = .true. + if (nnl(ivx) .gt. 0) then +c +c If A- or W-grace, set signal to start slur on main note. +c + if(btest(ipl(ivx,nnl(ivx)),31) .or. + * btest(ipl(ivx,nnl(ivx)),29)) + * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) + end if + else if (charq .eq. 'x') then + slashg(ngrace) = .true. + else if (charq .eq. 'u') then + else if (charq .eq. 'X') then +c +c Space before main note of grace. Number will come next. +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,graspace(ngrace)) + iccount = iccount-1 + end if + if (index('abcdefg',charq) .eq. 0) go to 18 +c +c At this point, charq is first note name in grace +c + do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 + naccg(ing) = 0 + ioct = 0 + if (ing .gt. ngstrt(ngrace)) then +55 call getchar(lineq,iccount,charq) + if (charq .eq. ' ') go to 55 + endif + iclastlev = 0 +9 call getchar(lineq,iccount,durq) + if (durq .ne. ' ') then + if (durq.eq.'+') then + lastlev = lastlev+7 + iclastlev = iclastlev+7 + else if (durq.eq.'-') then + lastlev = lastlev-7 + iclastlev = iclastlev-7 + else if (index('fsn',durq) .gt. 0) then + if (naccg(ing) .eq. 0) then + naccg(ing) = index('fsn',durq) + else +c +c Double accidental +c + naccg(ing) = ibset(naccg(ing),2) + end if + else + ioct = ichar(durq)-48 + end if + go to 9 + end if + if (ioct .gt. 0) then + lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) + else + if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then + if (ivx .le. nv) then + kv = 1 + else + kv = 2 + end if + lastlev = ndlev(iv,kv)+iclastlev + end if + lastlev = lastlev-3 + * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) + end if + nolevg(ing) = lastlev +19 continue +c +c Grace could come before first note of block, so reset end level. +c + if (nnl(ivx).eq.0) then + if (ivx .le. nv) then + kv = 1 + else + kv = 2 + end if + ndlev(iv,kv) = lastlev + end if + return + end + subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount, + * ibaroff,nbars,noinst) +cccccccccccccccccccccccc +cc +cc GetiTransInfo.for +cc +cccccccccccccccccccccccc +c +c Called from both g1etnote and getnote, after first 'i' in Ki[...] +c On entry, iccount points to last char retrieved, which is 'i' +c +c From1: locgical, true if called from g1etnote +c ibarcnt: tells whether to set EarlyTransOn to true. +c EarlyTransOn set false in blkdata, true here, back to false in topfile. +c +c 110522/110529 +c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] +c and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0 +c so can pass to topfile (via comInstTrans), which is called before getnote. +c Otherwise, will store info from getnote. Initialize EarlyTransOn and +c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; +c LaterInstTrans from getnote. Zero both out after use. nInstTrans really +c only needed for instrument-signatures, not transpositions. iTransAmt is +c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for +c each staff. +c +c iTransAmt stored as fn of instrument #, not like iTransKey which is +c fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This +c simplifies use of iTransAmt for all calls to ifnolev. +c + parameter (nm=24) + logical From1 + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans,store + character*128 lineq + character*1 durq + durq = 'x' ! Can't initialize in declaration stmt, only works once. + if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0 + store = (EarlyTransOn.and.ibarcnt.eq.0) .or. + * (ibarcnt.gt.0.and..not.From1) + LaterInstTrans = .not.From1 .and. ibarcnt.gt.0 + if (store) nInstTrans = 0 +1 continue + if (durq .eq. ' ') return + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be an instrument number here!') + call stop1() + end if + if (store) nInstTrans = nInstTrans+1 + call readnum(lineq,iccount,durq,fnum) + instn = nint(fnum) + if (instn.gt.noinst) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Instrument number out of range!') + call stop1() + end if + if (store) iInstTrans(nInstTrans) = instn +c +c durq is +/- following inst # (for iTransAmt), iccount is on it. +c + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '1st character after instrument number must be "+,-"!') + call stop1() + end if + itramt = 44-ichar(durq) ! +1/-1 for itramt + call g1etchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be a transposition amount here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (store) iTransAmt(instn) = nint(fnum)*itramt +c +c durq is +/- following iTransAmt (for iTransKey), iccount is on it. +c + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '1st character after transposition amount must be "+,-"!') + call stop1() + end if + ikey = 44-ichar(durq) ! +1/-1 + call g1etchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be a key indicator here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (store) iTransKey(nInstTrans) = nint(fnum)*ikey +c +c durq is now 1st character after iTransKey, should be either 'i' or ' ' +c + if (durq.ne.'i'.and.durq.ne.' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'There must be blank or "i" here!') + call stop1() + end if + go to 1 + end + subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars, + * lenbar,mtrdenl,nv,first) +c +c Use this from both pmxa and pmxb to input and check midi data. "first" tells +c whether pmxa or pmxb. If .not.first, then tempo and pause commands cause +c things to be written immediately into the midi storage buffers. +c + parameter (nm=24,mv=24576) + common /comevent/ miditime,lasttime + logical mmacrec,gottempo + common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, + * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), + * mmacrec,gottempo +c +c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing +c nmidsec section starts and stops based on PLAYING macros (not recording). +c + integer*2 mmidi,midinum(26) + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm) + integer*2 iinsiv + character*1 durq + character*2 instq + character*128 lineq + logical first + common /comdiag/ n69(0:nm),n34(0:nm) +c +c Instrument codes +c + data midinum + * / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67, +c XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX +c + * 68,69,71,72,74,75, 8,55 / +c bsXobXbaXclXflXreXctXvo +c +1 call getchar(lineq,iccount,durq) + if (durq .eq. 't') then +c +c Tempo in beats ber minute +c + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected an integer here for the pause!') + call stop1() + end if + call readnum(lineq,iccount,durq,qpm) + iccount = iccount-1 + if (.not.first) then + call midievent('t',nint(qpm),0) + gottempo = .true. + end if + go to 1 + else if (durq .eq. 'p') then +c +c Insert a pause. pausemid = pause in 1/4's +c + call getchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a number here for the pause!') + call stop1() + end if + call readnum(lineq,iccount,durq,pausemid) + iccount = iccount-1 + if (.not.first) then +c +c Compute a meter for the pause. This is only to keep MidiNotate on track. +c Round pause to nearest 16th. Let denominator always be 16. +c + numb16 = nint(pausemid*4) + call midievent('m',numb16,16) +c +c Put in pausemid beats of rest +c + do 3 icm = 0 , numchan-1 + call addmidi(icm,0,0,0,4.*numb16,.true.,.false.) +3 continue + miditime = miditime+nint(240*pausemid) +c +c Restore meter +c + call midievent('m',mtrdenl*lenbar/64,mtrdenl) + end if + go to 1 + else if (durq .eq. 'i') then +c +c Instrument numbers or letters. Expect noinst of them. +c + do 2 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (ichar(durq) .gt. 96) then +c +c It's a lowercase letter. Get another, find corr. instrument #. +c + instq(1:1) = durq + call getchar(lineq,iccount,durq) + instq = instq(1:1)//durq + iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'// + * 'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3 + if (iname .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Unrecognized 2-letter midi instrument name!') + call stop1() + end if + midinst(ivx) = midinum(iname)-1 + else +c +c Expect a number, followed by ":" if that is followed by another number. +c I.e., if after call to readnum, durq is not ":", it must be either blank +c or next instrument letter. +c + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a midi instrument number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + midinst(ivx) = nint(fnum)-1 + if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Midi instrument number must be in range 1-128!') + call stop1() + end if + if (durq .ne. ':') iccount = iccount-1 + end if +2 continue + go to 1 + else if (durq .eq. 'v') then +c +c Get volumes for each instrument. Expect noinst of them. +c Follow same pattern as for insttrument numbers above. +c + do 7 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a midi velocity number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + midivel(ivx) = nint(fnum)-1 + if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Midi velocity must be in range 1-128!') + call stop1() + end if + if (durq .ne. ':') iccount = iccount-1 +7 continue + if (.not. first) then + call inst2chan(midvelc,midivel,midchan,nv,iinsiv,twoline) + end if + go to 1 + else if (durq .eq. 'b') then +c +c Get balance for each instrument. Expect noinst of them. +c Follow same pattern as for instrument numbers above. +c + do 8 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a balance number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + midibal(ivx) = nint(fnum)-1 + if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Midi balance must be in range 1-128!') + call stop1() + end if + if (durq .ne. ':') iccount = iccount-1 +8 continue + if (.not. first) then + call inst2chan(midbc,midibal,midchan,nv,iinsiv,twoline) + end if + go to 1 + else if (durq .eq. 'T') then +c +c Get transposition for each instrument. Expect noinst of them. +c Follow similar pattern as above, but separator is +|-. +c + do 9 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + ipm = index('-+',durq) + if (ipm .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected "+" or "-" for midi transposition here!') + call stop1() + end if + ipm = 2*ipm-3 + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected a number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + miditran(ivx) = ipm*nint(fnum) +c if (mod(miditran(ivx),12).ne. 0) then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'Midi transposition limited to multiples of 12!') +c call stop1() +c end if + iccount = iccount-1 +9 continue + if (.not. first) then + call inst2chan(midtc,miditran,midchan,nv,iinsiv,twoline) + end if + go to 1 + else if (durq .eq. 'g') then + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected an integer here for the midi gap!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + mgap = nint(fnum) + iccount = iccount-1 + go to 1 + else if (durq .eq. 'M') then +c +c MidiMacros +c + call getchar(lineq,iccount,durq) + if (durq .eq. 'R') then +c +c Start recording +c + if (mmacrec) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'You tried to record a MidiMacro while already recording!') + call stop1() + end if + mmacrec = .true. + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected MidiMacro ID number here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + if (.not.first) then + immac = nint(fnum) + if (immac .gt. 20) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'MidiMacro ID cannot exceed 20!') + call stop1() + end if +c +c Save the start time +c + mmactime(immac) = miditime + do 4 icm = 0 , numchan + if (icm .lt. numchan) then + if (restpend(icm)) then +c +c Adjust if there's a rest at end of prior section. Insert dummy turnoff. +c (This causes two turn-offs in a row, which testmidi sees as an error). +c +c Before: section1 ------rest------- section2(to be recorded) +c After: section1 rest1 now rest2 section2(recorded) +c + call addmidi(icm,30,0,0,trest(icm),.false.,.true.) + trest(icm) = 0 + restpend(icm) = .false. + end if + else + if (miditime .gt. lasttime) then +c +c Insert a dummy turnoff in conductor track +c + call addmidi(icm,30,0,0,(miditime-lasttime)/15., + * .false.,.true.) + lasttime = miditime + end if + end if + mmacstrt(icm,immac) = imidi(icm)+1 +4 continue + end if + go to 1 + else if (index('123456789P',durq) .eq. 0) then +c +c End recording; close the open macro. Get immac from common. +c + if (.not.mmacrec) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'You tried to end a MidiMacro before starting one!') + call stop1() + end if + mmacrec = .false. + iccount = iccount-1 + if (.not.first) then +c +c Save the macro duration +c + mmactime(immac) = miditime-mmactime(immac) + do 5 icm = 0 , numchan + if (icm .lt. numchan) then + if (restpend(icm)) then + call addmidi(icm,30,0,0,trest(icm),.false.,.true.) + trest(icm) = 0 + restpend(icm) = .false. + end if + else + if (miditime .gt. lasttime) then +c +c Insert a dummy turnoff in conductor track if needed. +c + call addmidi(icm,30,0,0,(miditime-lasttime)/15., + * .false.,.true.) + lasttime = miditime + end if + end if + mmacend(icm,immac) = imidi(icm) +5 continue + end if + if (durq .ne. ' ')go to 1 + else if (durq .eq. 'P') then +c +c Play Back a Macro +c + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Expected MidiMacro ID number here!') + call stop1() + end if + if (mmacrec) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'You tried to play a MidiMacro before ending recording!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + if (.not.first) then + immac = nint(fnum) + if (mmactime(immac) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Cannot play a MIDI macro before recording it!') + call stop1() + end if + do 6 icm = 0 , numchan + if (icm .lt. numchan) then + if (restpend(icm)) then + call addmidi(icm,30,0,0,trest(icm),.false.,.true.) + trest(icm) = 0. + restpend(icm) = .false. + end if + else + if (miditime .gt. lasttime) then +c +c Insert a dummy turnoff in conductor track +c + call addmidi(icm,30,0,0,(miditime-lasttime)/15., + * .false.,.true.) + end if + end if + msecend(icm,nmidsec) = imidi(icm) + msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac) + msecend(icm,nmidsec+1) = mmacend(icm,immac) + msecstrt(icm,nmidsec+2) = imidi(icm)+1 +6 continue + nmidsec = nmidsec+2 +c +c Update running time +c + miditime = miditime+mmactime(immac) + lasttime = miditime + end if + go to 1 + else + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in MidiMacro sub-command!') + call stop1() + end if + else if (durq .eq. 'd') then + debugmidi = .true. + go to 1 + else if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character in MIDI input data!') + write(*,'(a)') + * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '// + * 'should be noinst, not nv' + write(15,'(a)') + * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '// + * 'should be noinst, not nv' + call stop1() + end if + if (.not.gottempo .and. .not.first) then +c +c If no tempo is set on first call on the pmxb pass, then set it +c + call midievent('t',96,0) + gottempo = .true. + end if + return + end + subroutine getnote(loop) + parameter (nm=24,mv=24576) + common /comlast/ islast,usevshrink + logical islast,usevshrink,ignorenats,newmbrhgt + common /comignorenats/ mbrhgt,newmbrhgt,ignorenats + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*10 figq + character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax + logical beamon,firstgulp,figbass,figchk,isfig + character*60 cheadq + character*120 instrq,titleq,compoq + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, + * inhead + common /cominbot/ inbothd + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, + * OptLineBreakTies,HeaderSpecial + common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, + * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, + * rptprev,equalize,rptfq1,rptfq2 + common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg,fbon,ornrpt,shifton,setis,notcrd,isbjmp, + * was2,nobar1,quoted,isbj2,stickyS, + * OptLineBreakTies,HeaderSpecial + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + character*128 litq + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + common /combc/ bcspec + common /comas3/ ask(2500),iask,topmods +c +c nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined +c ivx is current ivmx, and is the index for all notes, acc's etc. +c + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac + common /comtrans/ cheadq + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), + * ic1mac(20),ilmac,iplmac + common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), + * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), + * idynda2(99),levhssav(nm),listcresc,listdecresc + common /comclefq/ clefq(nm) + common /comtol/ tol + common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), + * ArpShift(20) + character*128 txtdynq + logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur, + * fontslur,WrotePsslurDefaults + character*128 lineq,lnholdq,lineqt + character*80 headrq, lowerq + character*79 inameq + character*59 hdlndq + character*20 voltxtq + character*1 charq,dotq,durq,ulfbq,dumq + logical loop,lastchar,lower,rptnd1,rptprev,bcspec,moved, + * topmods,headlog,btest,sluron,cdot,equalize + character*24 tempq + logical novshrinktop,cstuplet + common /comnvst/ novshrinktop,cstuplet + logical kbdrests + common /comkbdrests/ levbotr(8),levtopr(8),kbdrests + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idumm1,isig1, + * mbrestsav,kchmid(18),logdumm1,logdumm2,barend,noinst,logdumm3 + logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3 + common /combibarcnt/ ibarcnt + common /commidisig/ midisig + common /comlyr/ inputmlyr + logical inputmlyr + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + logical inxtup + common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, + * poefa + real*4 poefa(125) + logical nocodabn + cdot = .false. + inxtup = .false. +1 call getchar(lineq,iccount,charq) + if (lastchar) return + if (charq .eq. ' ') go to 1 + if (charq .eq. '%') then +c +c Check for a bar number format: +c + if (iccount.eq.1 .and. lineq(2:2).eq.' ' .and. + * index('bB1234567890',lineq(3:3)).gt.0) then + if (islast) write(11,'(a)')lineq(1:lenstr(lineq,128)) + end if + iccount = 128 + go to 1 + end if +c +c Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' +c + if (rptprev) then + rptnd1 = charq .eq. chax(47) + rptprev = .false. + end if +c +c Repeat at end of a piece +c + if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. + * charq.eq.'r') then + if (cdot) go to 28 +c +c This is a note/rest. +c + idotform = 0 + numnum = 0 +c +c If start of line of music, set pitch from previous +c + if (ivx .le. nv) then + kv = 1 + else + kv = 2 + end if + if (nnl(ivx).eq.0) lastlev = ndlev(iv,kv) +c +c notcrd is used to tell if orn. goes on main note or chord note +c +c notcrd = .true. !Move dow. Was not observed if dotted shortcut. +c +c Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. +c +28 continue +c +c Moved this from just above, 2 Feb 02 +c + notcrd = .true. + nnl(ivx) = nnl(ivx)+1 + if (ornrpt) then +c +c Replicate ornament bits, also bit 23 for beam handling if chord. +c + iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),iornq(ivx,0)) + if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then +c +c This is a trill (bit 7 or 15) so must dup the parameters +c + ntrill = ntrill + 1 + ivtrill(ntrill) = ivx + iptrill(ntrill) = nnl(ivx) + xnsktr(ntrill) = xnsktr(ntrill-1) + end if + end if + if (stickyS) then +c +c Grab stemlength shortening parameters from prior note +c + mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27) +c call setbits (mult(ivx,nnl(ivx)),3,28, +c * igetbits(mult(ivx,nnl(ivx)-1),3,28)) + call setbits (mult(ivx,nnl(ivx)),6,10, + * igetbits(mult(ivx,nnl(ivx)-1),6,10)) + end if + if (autofbon .and. tautofb.gt.tol .and. .not.fbon) then +c +c Doing auto forced beams, and period has been set, so check if this note +c starts a period. +c +c if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then + if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then +c +c Start a forced beam here +c + nfb(ivx) = nfb(ivx)+1 + fbon = .true. + ulfbq(ivx,nfb(ivx)) = 'x' + t1fb(ivx,nfb(ivx)) = itsofar(ivx) + end if + end if + if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30) + dotq = 'x' + if (charq.eq.'r') + * irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0) + if (btest(irest(ivx,nnl(ivx)),0)) then +c +c Rest stuff. First check if previous note was full-bar-pause +c + if (lineq(iccount+1:iccount+1) .eq.' ' + * .and. nnl(ivx).gt.1) then + if (btest(islur(ivx,nnl(ivx)-1),19)) + * islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19) + end if +c +c Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 +c for voice a or b. Set a-types at 0 as encountered and adjust later +c after '//'. (Override heights will be set to 100+offset) +c + if (ivx .le. nv) then + nolev(ivx,nnl(ivx)) = 0 + else + nolev(ivx,nnl(ivx)) = 2 + end if + end if +2 call getchar(lineq,iccount,durq) + ic = ichar(durq) + if (ic.le.57 .and. ic.ge.48) then +c +c Digit +c + if (numnum .eq. 0) then + nnodur = ic-48 + numnum = 1 + go to 2 + else if (numnum .eq. 1) then + ioct = ic-48 + numnum = 2 + go to 2 + else + print*,'>2 digits in note sym., ivx,nn:',ivx,nnl(ivx) + call stop1() + end if + else if (durq .eq. 'd') then + dotq = durq + if (lineq(iccount+1:iccount+1) .eq. 'd') then +c +c Double dot. +c + iccount = iccount+1 + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),3) + end if + if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then +c +c move a dot, unless next char is not part of a number +c + if (index('0123456789.',lineq(iccount+2:iccount+2)) .eq. 0) + * go to 2 + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19) + call getchar(lineq,iccount,durq) + ndotmv(ivx) = ndotmv(ivx)+1 + iccount=iccount+1 + call readnum(lineq,iccount,dumq,updot(ivx,ndotmv(ivx))) + if (durq .eq. '-') + * updot(ivx,ndotmv(ivx)) = -updot(ivx,ndotmv(ivx)) + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift also +c + iccount=iccount+1 + call readnum(lineq,iccount,durq,rtdot(ivx,ndotmv(ivx))) + if (dumq .eq. '-') + * rtdot(ivx,ndotmv(ivx)) = -rtdot(ivx,ndotmv(ivx)) + else + rtdot(ivx,ndotmv(ivx)) = 0. + end if + iccount = iccount-1 + end if + go to 2 + else if (durq .eq. 'p') then +c +c Full-bar rest as pause +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19) + go to 2 + else if (durq .eq. 'b') then +c +c Blank rest +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29) + go to 2 + else if (index('fsn',durq) .gt. 0) then +c +c Accidental +c +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c 171209 May have set bit 18 earlier if D or F preceded accidental + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then +c +c No accidental has been set yet +c +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) + else +c +c Repeated accid, so must be double +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2) + end if + go to 2 + else if (durq .eq. 'i') then +c +c Set flag for MIDI-only accidental. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17) + go to 2 + else if (durq .eq. 'c') then +c +c Set flags for cautionary accidental +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31) + iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) + go to 2 + else if (index('+-<>',durq) .gt. 0) then + ipm = index('- +',durq)-2 + if (.not.btest(irest(ivx,nnl(ivx)),0)) then +c +c A note, not a rest. +c + call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved) + if (moved) go to 2 +c +c Octave jump with a note +c + if (numnum .lt. 2) then + lastlev = lastlev+ipm*7 + else + ioct = ioct+ipm*1 + end if + go to 2 + else +c +c Override default height of a rest +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (lineq(iccount-1:iccount-1) .eq. '.') then +c +c Kluge in case there is a shortcut ".". It will have been sucked up by +c readnum. (Same doesn't hold for ",") +c + iccount = iccount-1 +c go to 2 + end if + nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) +c +c There may be more characters for this rest +c + iccount = iccount-1 + go to 2 + end if + else if (durq .eq. 'x') then +c +c Xtuplet. Count number of doubled notes (for unequal xtups) +c + if (btest(nacc(ivx,nnl(ivx)),18)) then + ndoub = 1 + else + ndoub = 0 + end if +c +c Initialize counter for # of non-rests, so can later unbeam if = 1. +c + inxtup = .true. + note1xtup = nnl(ivx) + nnb = 0 + if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1 +c +c Will set all durations to 0 except last one. Set flag on this note. +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28) +c +c Next input will be digit unless its a "T" +c + iccount = iccount+1 + if (lineq(iccount:iccount) .eq. 'T') then +c +c Set up tremolo +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2) + ntup = 2 +c +c Set default beaming, based on Wikipedia article +c May be a problem here is nnodur is inherited +c + if (nnodur .eq. 4) then + nsolid = 0 + nindent = 3 + else if (nnodur .eq. 2) then + nsolid = 3 + nindent = 0 + else if (nnodur .eq. 8) then + nsolid = 1 + nindent = 2 + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nsolid = index('0123456789',durq)-1 + if (nsolid.eq.0 .and. nnodur.eq.2) then + print*,'' + print*,'Unbeamed half-note 2-note tremolo forbidden.' + call stop1() + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nindent = index('0123456789',durq)-1 + end if + end if + call setbits(irest(ivx,nnl(ivx)),2,3,nsolid) + call setbits(irest(ivx,nnl(ivx)),2,5,nindent) + if (nsolid .eq. 0) then + islur(ivx,nnl(ivx)) = + * ibset(islur(ivx,nnl(ivx)),18) + end if + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) + call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid) +c +c Set some force-beam parameters for the tremolo +c +c Need to check if there's already a forced beam explicitly set here. +c If there was, shouldn't do any harm resetting parameters. +c + if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx)) + * nfb(ivx) = nfb(ivx)+1 + fbon = .true. + ulfbq(ivx,nfb(ivx)) = 'x' + t1fb(ivx,nfb(ivx)) = itsofar(ivx) + t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq) + nadj = 0 +c +c Set open beamed notehead flag for half-note tremolo +c Just gave 2 quarters with or without flag set. Need to fix +c + else + call readnum(lineq,iccount,durq,fnum) + ntup = nint(fnum) + end if + if (index('DF',durq) .gt. 0) then +c +c +c Double xtup note to make an un= xtup. Here xtup number already set but may also +c have this command before. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = + * ibset(nacc(ivx,nnl(ivx)),19) + ndoub = 1 + call getchar(lineq,iccount,durq) + else if (durq .eq. 'd') then + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) + call getchar(lineq,iccount,durq) + end if +c +c Only other possibilities here are ' ' or 'n' +c + if (durq .eq. 'n') then +c +c Alter xtup number +c + if (lineq(iccount+1:iccount+1) .eq. ' ') then +c +c If the only modifier is 'n', cancel the number +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) + else + numshft = 0 +30 call getchar(lineq,iccount,durq) + if (durq .eq. 'f') then +c +c Flip up-down-ness +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),14) + go to 30 + else if (index('+-',durq) .gt. 0) then +c +c Vertical or horiz shift +c + numshft = numshft+1 + iofforn = 1 + if (durq .eq. '-') iofforn = -1 + iccount = iccount+1 + call readnum(lineq,iccount,durq,xofforn) + iccount = iccount-1 + if (numshft .eq. 1) then +c +c Vertical shift +c 160214 Allow (-64,64) +c iofforn = iofforn*nint(xofforn) + 16 + iofforn = iofforn*nint(xofforn) + 64 +c +cc Turn on bit 1; set bits 2-6 to iofforn +c Turn on bit 1 of irest; set bits 16-22 of mult to iofforn +c +c irest(ivx,nnl(ivx)) = +c * ior(irest(ivx,nnl(ivx)),2+4*iofforn) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),1) + call setbits(mult(ivx,nnl(ivx)),8,16,iofforn) + else +c +c Horizontal shift +c + iofforn = iofforn*nint(xofforn*10)+16 + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),7) + call setbits(irest(ivx,nnl(ivx)),5,9,iofforn) + end if + go to 30 + else if (durq .eq. 's') then +c +c Slope adjustment for bracket +c + mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),4) + call getchar(lineq,iccount,durq) + iofforn = index('- +',durq)-2 + iccount = iccount+1 + call readnum(lineq,iccount,durq,xofforn) + iccount = iccount-1 + iofforn = nint(iofforn*xofforn+16) + call setbits(mult(ivx,nnl(ivx)),5,5,iofforn) + else if (index('123456789',durq) .gt. 0) then +c +c Replacement printed number +c + call readnum(lineq,iccount,durq,xofforn) + call setbits(nacc(ivx,nnl(ivx)),5,22,nint(xofforn)) + iccount = iccount-1 + go to 30 + end if + end if + end if +c +c Set note level of 1st note of xtup, provided not a rest +c + if (.not.btest(irest(ivx,nnl(ivx)),0)) then + if (numnum .eq. 2) then + lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) + nolev(ivx,nnl(ivx)) = lastlev + else + lastlev = lastlev-3 + * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) + nolev(ivx,nnl(ivx)) = lastlev + end if + end if + do 40 npreslur = npreslur , 1 , -1 +c +c Set note level for preslur on starting note of xtuplet +c + call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) +40 continue + numnum = 0 + nodur(ivx,nnl(ivx)) = 0 + do 6 itup = 2 , ntup + if (ornrpt) then + iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)), + * iand(iornq(ivx,nnl(ivx)-1),10026991)) + if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then +c +c This is a trill (bit 7 or 15) so must dup the parameters +c + ntrill = ntrill + 1 + ivtrill(ntrill) = ivx + iptrill(ntrill) = nnl(ivx) + xnsktr(ntrill) = xnsktr(ntrill-1) + end if + end if + nnl(ivx) = nnl(ivx)+1 + if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30) +7 call getchar(lineq,iccount,charq) + if (charq .eq. ' ') then + go to 7 + else if (charq .eq. '%') then + iccount = 128 + go to 7 + else if (charq .eq. 'o') then +c +c Ornament in xtuplet. "o" symbol must come AFTER the affected note +c + if (notcrd) then + nole = nolev(ivx,nnl(ivx)-1) + else + nole = iand(127,ishft(icrdat(ncrd),-12)) + end if + call getorn(lineq,iccount,iornq(ivx,nnl(ivx)-1), + * iornq(ivx,0),ornrpt,noffseg, + * nnl(ivx)-1,ivx,.false.,notcrd,nole) + go to 7 + else if (index('st(){}',charq) .gt. 0) then + nnlivx = nnl(ivx)-1 + if (charq.eq.'(' .or. charq.eq.'{') then +c +c Detected preslur in xtuplet loop, non-chord note +c + nnlivx = nnlivx+1 + npreslur = npreslur+1 + end if + islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0) + if (charq.eq.'t') islur(ivx,nnlivx) = + * ibset(islur(ivx,nnlivx),1) + if (ivx .le. nv) then + kv = 1 + else + kv = 2 + end if + if (fontslur) then + call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2, + * isdat3,nsdat,notcrd,nolev(ivx,nnlivx),charq) + else + call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2, + * isdat3,isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq) + end if + go to 7 + else if (charq .eq. 'G') then +c +c Kluge to get grace in xtup at right location +c + nnl(ivx) = nnl(ivx)-1 + call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, + * lastlev,iv,nv) + nnl(ivx) = nnl(ivx)+1 + go to 7 + else if (charq .eq. sq) then + call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) + go to 7 + else if (charq .eq. chax(34)) then +c +c pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ +c + if (.not. inputmlyr) then + ictemp = 0 + lineqt = sq//sq//sq//'input musixlyr '//sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) + inputmlyr = .true. + end if + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) + go to 7 + else if (index('0123456789#-nx_',charq) .gt. 0) then +c +c Figure. Must come AFTER the first note of xtup +c + ivf = 1 + if (ivx .gt. 1) then + if (ivxfig2 .eq. 0) then + ivxfig2 = ivx + else if (ivx .ne. ivxfig2) then + print* + print*,'Figures not allowed in >1 voice above first' + stop + end if + ivf = 2 + end if + nfig1 = nfigs(ivf)+1 + call getfig(itoff(ivf,nfig1),charq,lineq,iccount, + * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx), +c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) + * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1), + * nfigs(ivf)) + go to 7 + else if (charq .eq. 'X') then + call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)), + * shifton,wheadpt,iornq(ivx,nnl(ivx)),ivx, + * irest(ivx,nnl(ivx)),itsofar(ivx),ntup,itup,nnodur, + * dotq,ndoub) + go to 7 + else if (charq .eq. 'z') then +c +c Chord note in xtup. Goes with *prior* note. +c + notcrd = .false. + ncrd = ncrd+1 + ipl(ivx,nnl(ivx)-1) = ibset(ipl(ivx,nnl(ivx)-1),10) + numnum = 0 +c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) + icrdat(ncrd) = nnl(ivx)-1 + call setbits(icrdat(ncrd),4,8,mod(ivx,16)) + if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) + icrdorn(ncrd) = 0 +c +c Get note name +c + call getchar(lineq,iccount,charq) +c +c Get optional inputs +c +34 call getchar(lineq,iccount,durq) +c +c When chord note is done, will get ' ', making ndx=0, so go past this block +c + ndx = index('fsn+-<>12345678reicd',durq) + if (ndx .gt. 0) then + if (ndx .le. 3) then + if (.not.btest(icrdat(ncrd),19)) then + icrdat(ncrd) = ibset(icrdat(ncrd),19) + icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20)) + else + icrdat(ncrd) = ibset(icrdat(ncrd),22) + end if + else if (durq .eq. 'd') then +c +c Get dot on chord note in xtup. Assume +n+n +c + icrdat(ncrd) = ibset(icrdat(ncrd),26) + call getchar(lineq,iccount,durq) + iccount=iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (durq .eq. '+') then + icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64) + else + icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64) + end if + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift specified also +c + iccount=iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (dumq .eq. '+') then + ifnum = nint(fnum*10)+64 + else + ifnum = -nint(fnum*10)+64 + end if + else + ifnum = 64 + end if + icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7)) + iccount = iccount-1 +c iccount = iccount+4 +c +c +c + else if (ndx .eq. 19) then +c +c Set flags for cautionary accidental +c + icrdat(ncrd) = ibset(icrdat(ncrd),31) + iornq(ivx,nnl(ivx)-1) = + * ibset(iornq(ivx,nnl(ivx)-1),31) + else if (ndx .le. 7) then +c +c +/-/ Check whether octave or accidental shift +c + nactmp = 0 + call chkpm4ac(lineq,iccount,nactmp,moved) + if (moved) then +c +c Transfer accidental shift values +c + call setbits(icrdot(ncrd),6,14, + * igetbits(nactmp,6,4)) + call setbits(icrdot(ncrd),7,20, + * igetbits(nactmp,7,10)) + else + if (durq .eq. '+') then + lastlev = lastlev+7 + else if (durq .eq. '-') then + lastlev = lastlev-7 + end if + end if + else if (durq .eq. 'e') then + icrdat(ncrd) = ibset(icrdat(ncrd),23) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) + else if (durq .eq. 'r') then + icrdat(ncrd) = ibset(icrdat(ncrd),24) + irest(ivx,nnl(ivx)-1) = + * ibset(irest(ivx,nnl(ivx)-1),20) + else if (durq .eq. 'i') then +c +c Midi-only accidental +c + icrdat(ncrd) = ibset(icrdat(ncrd),27) + else +c +c must be a number, save it in ioct +c + numnum = 1 + ioct = ndx-7 + end if + go to 34 + end if + if (numnum .eq. 1) then + lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) + else + lastlev = lastlev-3 + * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) + end if + icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12)) + do 41 npreslur = npreslur , 1 , -1 +c +c Set note level for preslur on chord note in xtup +c + call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) +c +c Following lines copied from loop for non-xtup, chord note, preslur +c Initially I assigned the slur(s) to next note, so fix. +c + islur(ivx,nnl(ivx)) = ibclr(islur(ivx,nnl(ivx)),0) + islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),0) + isdat2(nsdat-npreslur+1) = + * ibset(isdat2(nsdat-npreslur+1),0) + call setbits(isdat1(nsdat-npreslur+1),8,3, + * igetbits(isdat1(nsdat-npreslur+1),8,3)-1) +41 continue + go to 7 + else if (charq .eq. '?') then +c +c Arpeggio +c + if (btest(ipl(ivx,nnl(ivx)-1),10)) then +c +c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note +c of chord, will not set icrdat(25), but iornq(27) +c + icrdat(ncrd) = ibset(icrdat(ncrd),25) + else + iornq(ivx,nnl(ivx)-1) = ibset(iornq(ivx,nnl(ivx)-1),27) + end if +c +c Check for shift +c + call getchar(lineq,iccount,durq) + if (durq .eq. ' ') then + iccount = iccount-1 + else +c +c durq must be "-" +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 +c +c record the shift +c + NumArpShift = NumArpShift+1 + IvArpShift(NumArpShift) = ivx + IpArpShift(NumArpShift) = nnl(ivx)-1 + ArpShift(NumArpShift) = fnum + end if + go to 7 + else if (charq .eq. 'D') then + call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1), + * iornq(ivx,nnl(ivx)-1),lineq,iccount) + go to 7 +c +c 140215 Allow clef change inside xtuplet. With normal code, came out one +c note too late, so try making it come earlier. +c + else if (charq .eq. 'C') then +c +c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. +c + if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1 +c +c 140218 Need to get time differently inside xtup, since itsofar doesn't get +c updated until after xtup is done +c + nodurt = ifnodur(nnodur,dotq) + tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) + isl = ibset(islur(iv,nnl(iv)),11) + call getchar(lineq,iccount,durq) +c +c Store clef number, or 7 if clef number = 9 (French violin clef) +c + isl = ior(isl,ishft(min(numclef(durq),7),12)) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) + end if +c +c Set marker on note with lowest voice # starting at same time. +c + if (iv .eq. 1) then + isl = ibset(isl,15) + else + do 70 iiv = 1 , iv +c nnliiv = nnl(iiv) + nnliiv = nnl(iiv)-1 + if (iiv .eq. iv) nnliiv = nnliiv+1 + itother = 0 + do 71 iip = 1 , nnliiv + if (itother .lt. itsofar(iv)) then + itother = itother+nodur(iiv,iip) + go to 71 + else if (itother .eq. itsofar(iv)) then + islur(iiv,iip) = ibset(islur(iiv,iip),15) + go to 72 + end if +71 continue +70 continue +72 continue + end if +c +c Need 'or' since may have set bit 15 in the above loop +c +c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) + islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv))) + go to 7 +c+++ + else if (charq .eq. ']') then +c +c Multiplicity up-down, must have '][ ' +c + islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),20) + iccount = iccount+2 + go to 7 +cc+++ + end if +c +c End of loop for xtup options. If here, charq must be a (non-crd) note name. +c or rest +c + if (charq .eq. 'r') then +c +c Rest in xtup +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0) + if (index('+-b',lineq(iccount+1:iccount+1)) .gt. 0) then + call getchar(lineq,iccount,durq) + if (durq .eq. 'b') then +c +c Blank rest in middle of xtup +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29) + else +c +c Override height of embedded xtup rest +c + ipm = index('- +',durq)-2 + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) + iccount = iccount-1 + end if + else if (ivx .le. nv) then + nolev(ivx,nnl(ivx)) = 0 + else + nolev(ivx,nnl(ivx)) = 2 + end if + else +c +c Counter for non-rests +c + nnb = nnb+1 + end if + notcrd = .true. +8 call getchar(lineq,iccount,durq) + if (durq .ne. ' ') then + if (index('+-<>',durq) .gt. 0) then +c +c Accidental horizontal shift +c + call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved) + if (.not.moved) then + if (durq.eq.'+') then + lastlev = lastlev+7 + else if (durq.eq.'-') then + lastlev = lastlev-7 + end if + end if + else if (index('fsn',durq) .gt. 0) then +c +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c May have set other bits earlier + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then +c +c No accid set yet +c +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) + else +c +c Symbol must be repeated, so it's a double +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2) + end if + else if (durq .eq. 'i') then +c +c Set flag for midi-only accidental +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17) + + else if (durq .eq. 'c') then +c +c Set flags for cautionary accidental +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31) + iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) + else if (index('ul',durq) .gt. 0) then +c +c Force stem direction for non-beamed xtup note +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30) + if (durq .eq. 'u') islur(ivx,nnl(ivx)) = + * ibset(islur(ivx,nnl(ivx)),17) + else if (durq .eq. 'e') then +c +c Left-shift main xtup note +c + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) + else if (durq .eq. 'r') then +c +c Right-shift main xtup note +c + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) + else if (index('DF',durq) .gt. 0) then +c +c Double an xtup note to make an unequal xtup +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = + * ibset(nacc(ivx,nnl(ivx)),19) + ndoub = ndoub+1 + else if (durq .eq. 'd') then +c +c Dotted xtup note +c +c if (btest(irest(ivx,nnl(ivx))-1,2)) then + if (btest(irest(ivx,nnl(ivx)-1),2)) then +c +c Move dot on 2nd note of 2-note tremolo +c + ndotmv(ivx) = ndotmv(ivx)+1 + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19) + call g1etchar(lineq,iccount,durq) ! Will be + or - + iccount = iccount+1 + call readnum(lineq,iccount,dumq, + * updot(ivx,ndotmv(ivx))) + if (durq .eq. '-') updot(ivx,ndotmv(ivx)) = + * -updot(ivx,ndotmv(ivx)) + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift also +c + call readnum(lineq,iccount,durq, + * rtdot(ivx,ndotmv(ivx))) + if (durq .eq. '-') rtdot(ivx,ndotmv(ivx)) + * = -rtdot(ivx,ndotmv(ivx)) + end if + iccount = iccount-1 + else +c +c Dot for 3:1 pair of xtup notes +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) + end if + else +c +c Must be an octave number +c + lastlev = ifnolev(charq,ichar(durq)-48 + * ,iTransAmt(instno(iv))) + end if + go to 8 + end if + if (itup .lt. ntup) then +c +c Last note is handled *after* flowing out of the xtup if block, but still +c within block for a note-rest. Set note level now (rest already done). +c Could have problem here if rests & doubled notes are combined in xtup, +c since might exit the loop at the wrong place. Worry about it later. +c + if (.not.btest(irest(ivx,nnl(ivx)),0)) then + lastlev = lastlev-3+mod(ifnolev(charq,10, + * iTransAmt(instno(iv)))-lastlev+3,7) + nolev(ivx,nnl(ivx)) = lastlev + end if + nodur(ivx,nnl(ivx)) = 0 + do 42 npreslur = npreslur , 1 , -1 +c +c Set note level for preslur on internal xtup note +c + call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) +42 continue + end if + if (itup .eq. ntup-ndoub) go to 12 +6 continue +12 continue + if (ornrpt) then + iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)), + * iand(iornq(ivx,nnl(ivx)-1),10026991)) + if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then +c +c This is a trill (bit 7 or 15) so must dup the parameters +c + ntrill = ntrill + 1 + ivtrill(ntrill) = ivx + iptrill(ntrill) = nnl(ivx) + xnsktr(ntrill) = xnsktr(ntrill-1) + end if + end if +c +c End of if-block for xtuplet input +c + else if (durq .eq. 'm') then +c +c Multi-bar rest: next 1 or two digits are # of bars. +c For some purposes, pretend its one bar only +c + nodur(ivx,nnl(ivx)) = lenbar + ibarmbr = nbars+1 + mbrest = 0 + xb4mbr = 0. +20 call getchar(lineq,iccount,durq) + if (ichar(durq).ge.48.and.ichar(durq).le.57) then + mbrest = 10*mbrest+ichar(durq)-48 + go to 20 + end if +c +c durq will either be blank or 'n' + if (durq .eq. 'n') then +c +c Get new height +c + iplmi = 1 + call g1etchar(lineq,iccount,durq) + if (durq .eq. '-') then + iplmi = -1 + iccount = iccount+1 + end if + call readnum(lineq,iccount,durq,hgt) + mbrhgt = nint(iplmi*hgt) + newmbrhgt = .true. + end if + else if (index('ul',durq) .gt. 0) then +c +c Set stem flipper +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30) + if (durq .eq. 'u') islur(ivx,nnl(ivx)) = + * ibset(islur(ivx,nnl(ivx)),17) + go to 2 + else if (durq .eq. 'a') then +c +c "Alone", i.e., prohibit beam +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),18) + go to 2 + else if (durq .eq. 'r') then +c +c Right offset by one notehead +c + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) + go to 2 + else if (durq .eq. 'e') then +c +c Left offset by one notehead +c + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) + go to 2 + else if (index('LS',durq) .gt. 0) then +c +c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 +c Set mult(27). Map value to 0 to 63, store in mult(10-15). Later convert to +c interbeams = internotes*2/3. +c +c + isign = 1 + if (durq .eq. 'S') isign = -1 + mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27) + call getchar(lineq,iccount,durq) + if (durq .eq. ':') then +c +c End stickyS. Grab data now from prior note, since we have to shut off stickyS. +c + call setbits (mult(ivx,nnl(ivx)),6,10, + * igetbits(mult(ivx,nnl(ivx)-1),6,10)) + stickyS = .false. + go to 2 + end if +c +c If durq .ne. ':' then iccount is now on the start of the number +c + call readnum(lineq,iccount,durq,dum) + dum = isign*dum + call setbits (mult(ivx,nnl(ivx)),6,10,nint((dum+4.)*2)) + if (durq .eq. ':') then + stickyS = .true. + else + iccount = iccount-1 + end if + go to 2 + else if (durq .eq. ',') then +c +c 2:1 pattern +c + idotform = 3 +c +c Now flow to duration setting, as if durq=' ' +c + else if (durq .eq. '.') then +c +c Dotted pattern. Close out note. Mult time by 3/4. +c Set time for next note to 1/4. Start the note. +c + idotform = 1 + else if (durq .eq. 'o') then +c +c Suppress rest centering +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),25) + go to 2 + else if (durq .eq.'L') then +c +c With keyboard rest option, look left +c +c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1) + go to 2 + else if (index('DF',durq) .gt. 0) then +c +c Double note for xtup. Must check here in case "D" came before "x" or on +c last note of xtup. Need to flag it in pmxa since affects horiz. spacing. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18) + if (durq .eq. 'F') nacc(ivx,nnl(ivx)) = + * ibset(nacc(ivx,nnl(ivx)),19) + go to 2 + else if (durq .eq. 'A') then +c +c Accidental option +c + call getchar(lineq,iccount,durq) +c + if (durq .eq. 'o') then +c +c Ordered accidentals in a chord. Mark the main note. +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),28) + else +c +c Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),29) + iccount = iccount-1 + end if + go to 2 + else if (durq .eq. 'T') then + call getchar(lineq,iccount,durq) + multtrem = index('1234',durq) + if (multtrem .eq. 0) then + iccount = iccount-1 + multtrem = 1 + end if + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4) + call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1) + go to 2 + else if (durq .ne. ' ') then + print*,'Illegal character in note: ',durq,', ivx,nn:', + * ivx,nnl(ivx) + call stop1() + end if +c +c Done with note/rest options. Set level and duration. +c + if (.not.btest(irest(ivx,nnl(ivx)),0)) then + if (numnum .eq. 2) then + lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) + nolev(ivx,nnl(ivx)) = lastlev + else + lastlev = lastlev-3 + * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) + nolev(ivx,nnl(ivx)) = lastlev + end if + do 43 npreslur = npreslur , 1 , -1 +c +c Set level for preslur on normal note, non-chord +c + call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) +43 continue +c +c Only matters if last note, non-rest of xtuplet +c + nnb = nnb+1 + end if +c +c Set flag for unbeamed xtup if it just has 1 note +c + if (inxtup .and. nnb.eq.1) then + islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18) + end if + if (idotform .gt. 0) then + if (idotform .eq. 1) then + nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)*3/2 + else if (idotform .eq. 2) then + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3 + else if (idotform .eq. 3) then + nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq) + else if (idotform .eq. 4) then + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2 + end if + else if (btest(islur(ivx,nnl(ivx)),19)) then +c +c Set duration of full-bar rest as pause +c + nodur(ivx,nnl(ivx)) = lenbar +c +c Use a one-line function to set nnodur. It gives inverse of ifnodur. +c + nnodur = index('62514x0x37', + * chax(48+int(log(.1+lenbar)/.69315)))-1 + else if (ibarmbr.ne.nbars+1) then + nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq) + if (btest(islur(ivx,nnl(ivx)),3)) + * nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6 + end if + if (shifton .and. .not.btest(irest(ivx,nnl(ivx)),16)) then +c +c Shift is on, and this is not first shifted note. Check for duration change +c + if (nodur(ivx,nnl(ivx)) .ne. nodur(ivx,nnl(ivx)-1)) then +c +c Must stop and restart the offset. +c + irest(ivx,nnl(ivx)-1) = ibset(irest(ivx,nnl(ivx)-1),17) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),16) + nudoff(ivx) = nudoff(ivx)+1 + udoff(ivx,nudoff(ivx)) = udoff(ivx,nudoff(ivx)-1) + end if + end if + itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) + if (autofbon .and. tautofb.gt.tol .and. fbon) then +c +c Check to see if need to terminate auto forced beam +c + if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then +c +c Terminate autofb +c + t2fb(ivx,nfb(ivx)) = itsofar(ivx) + fbon = .false. + end if + end if + if (mod(itsofar(ivx)-lenb0,lenbar) .eq. 0) then +c +c Finished a bar +c + nbars = nbars+1 + nib(ivx,nbars) = nnl(ivx) + if (firstgulp.and.lenb0.ne.0.and.nbars.eq.1) then +c +c Just finished the pickup bar for this voice. +c + lenbar = lenb1 + end if + end if + if (idotform .eq. 1) then + call getchar(lineq,iccount,charq) + idotform = 2 + numnum = 1 + go to 28 + else if (idotform .eq. 3) then + call getchar(lineq,iccount,charq) + idotform = 4 + numnum = 1 + go to 28 + end if +c +c End of sub block for note-rest +c + else if (charq .eq. 'z') then +c +c Chord note. Must have note name, may have octave#,+,-,s,f,n,d +c Actually the 'd' is not used, since time value comes from +c basic note. Unless dot is to be shifted! +c Doesn't increase # of notes, so must handle separately +c ncrd: index of crd +c Set bit 10 of ipl on main note as flag +c Bits in icrdat: +c 0-7 ip within voice +c 8-11 ivx +c 12-18 note level +c 19 accidental? +c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) +c 23 shift left +c 24 shift right +c 25 arpeggio start or stop +c 26 flag for moved dot (here, not icrdot, since this is always reset!) +c 27 Midi-only accidental +c 29 Tag for accidental shift...means add to autoshifts. +c 31 Cautionary accidental +c +c Bits in icrdot: +c 0-6 10*abs(vertical dot shift in \internote) + 64 +c 7-13 10*abs(horizontal dot shift in \internote) + 64 +c 14-19 vert accidental shift-32 +c 20-26 20*(horiz accidental shift+3.2) +c 27-29 top-down level rank of chord note w/accid. Set in crdaccs. +c +c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. +c + ncrd = ncrd+1 + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),10) + numnum = 0 +c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) + icrdat(ncrd) = nnl(ivx) + call setbits(icrdat(ncrd),4,8,mod(ivx,16)) + if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) + icrdot(ncrd) = 0 + icrdorn(ncrd) = 0 +c +c Get note name +c + call getchar(lineq,iccount,charq) +c +c Get optional inputs +c +25 call getchar(lineq,iccount,durq) +c ndx = index('fsn+-<>12345678rediA',durq) + ndx = index('fsn+-<>12345678rediAc',durq) + if (ndx .eq. 20) then +c +c Expect +|-|<|> , set tag, loop +c + icrdat(ncrd) = ibset(icrdat(ncrd),29) + go to 25 + else if (ndx .gt. 0) then + if (ndx .le. 3) then + if (.not.btest(icrdat(ncrd),19)) then + icrdat(ncrd) = ibset(icrdat(ncrd),19) + icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20)) + else + icrdat(ncrd) = ibset(icrdat(ncrd),22) + end if + else if (ndx .eq. 21) then +c +c Set flags for cautionary accidental +c + icrdat(ncrd) = ibset(icrdat(ncrd),31) + iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31) + else if (ndx .le. 7) then +c +c +/-/ Check whether octave or accidental shift +c + nactmp = 0 + call chkpm4ac(lineq,iccount,nactmp,moved) + if (moved) then +c +c Transfer accidental shift values +c + call setbits(icrdot(ncrd),6,14,igetbits(nactmp,6,4)) + call setbits(icrdot(ncrd),7,20,igetbits(nactmp,7,10)) + else + if (durq .eq. '+') then + lastlev = lastlev+7 + else if (durq .eq. '-') then + lastlev = lastlev-7 + end if + end if + else if (durq .eq. 'e') then + icrdat(ncrd) = ibset(icrdat(ncrd),23) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) + else if (durq .eq. 'r') then + icrdat(ncrd) = ibset(icrdat(ncrd),24) + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20) + else if (durq .eq. 'i') then +c +c Midi-only accidental on chord note +c + icrdat(ncrd) = ibset(icrdat(ncrd),27) + else if (durq .eq. 'd') then +c +c Must keep 'd' optional (backward compatibility), unless it is moved! +c + if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then +c +c move a dot, unless next char is not part of a number +c + if (index('0123456789.',lineq(iccount+2:iccount+2)) + * .eq. 0) go to 25 + icrdat(ncrd) = ibset(icrdat(ncrd),26) + call getchar(lineq,iccount,durq) + iccount=iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (durq .eq. '+') then + icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64) + else + icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64) + end if + if (index('+-',dumq) .gt. 0) then +c +c Vertical shift specified also +c + iccount=iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (dumq .eq. '+') then + ifnum = nint(fnum*10)+64 + else + ifnum = -nint(fnum*10)+64 + end if + else + ifnum = 64 + end if + icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7)) + iccount = iccount-1 + end if + else +c +c must be a single digit, save it in ioct +c + numnum = 1 + ioct = ndx-7 + end if + go to 25 + end if + if (numnum .eq. 1) then + lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv))) + else + lastlev = lastlev-3 + * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7) + end if + icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12)) + do 44 npreslur = npreslur , 1 , -1 + call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev) +c +c Set level for chord note. +c Initially I assigned the slur(s) to next note, so fix. +c + islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),0) + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),0) + isdat2(nsdat-npreslur+1) = ibset(isdat2(nsdat-npreslur+1),0) + call setbits(isdat1(nsdat-npreslur+1),8,3, + * igetbits(isdat1(nsdat-npreslur+1),8,3)-1) +44 continue + if (notcrd) then +c +c This is the first chord note in this chord. +c + minlev = min(nolev(ivx,nnl(ivx)),lastlev) + maxlev = max(nolev(ivx,nnl(ivx)),lastlev) + else + minlev = min(minlev,lastlev) + maxlev = max(maxlev,lastlev) + end if + notcrd = .false. + else if (charq .eq. 'G') then + call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, + * lastlev,iv,nv) +c +c Grace, comes *before* main note: +c UNLESS there's an 'A' or 'W' after the 'G' +c ngrace = # of grace note groups so far in block +c ivg(ngrace), ipg(ngrace) +c nng(ngrace) = # of notes in this group: default = 1 +c ngstrt(ngrace) = starting position in nolevg of levels for this grace +c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' +c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' +c slurg(ngrace) = logical for slur; default F, input 's' +c slashg(ngrace) = T if slash; default is F, input 'x' +c These data MUST precede note name of first note +c nolevg, naccg: lists of levels and accid's, indexed as described above. +c + else if (charq .eq. sq) then +c +c Literal TeX string +c + call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) + else if (charq .eq. chax(34)) then +c +c pmxlyr string. Expand "..." to \pmxlyr{...}\ +c + if (.not. inputmlyr) then + ictemp = 0 + lineqt = sq//sq//sq//'input musixlyr '//sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) + inputmlyr = .true. + end if + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) + else if (charq .eq. 'o') then +c +c Ornament on non-xtup note. Symbol must come AFTER the affected note +c + if (notcrd) then + nole = nolev(ivx,nnl(ivx)) + else + nole = iand(127,ishft(icrdat(ncrd),-12)) + end if + call getorn(lineq,iccount,iornq(ivx,nnl(ivx)), + * iornq(ivx,0),ornrpt,noffseg,nnl(ivx),ivx, + * .true.,notcrd,nole) + else if (index('st(){}',charq) .gt. 0) then + nnlivx = nnl(ivx) + if (charq.eq.'(' .or. charq.eq.'{') then +c +c Detect preslur on normal non-chord note +c + nnlivx = nnlivx+1 + npreslur = npreslur+1 + end if + islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0) + if (charq.eq.'t') + * islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),1) + if (ivx .le. nv) then + kv = 1 + else + kv = 2 + end if + if (fontslur) then + call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3, + * nsdat,notcrd,nolev(ivx,nnlivx),charq) + else + call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3, + * isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq) + end if + else if (charq .eq. '?') then +c +c Arpeggio +c + if (btest(ipl(ivx,nnl(ivx)),10)) then +c +c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note +c of chord, will not set icrdat(25), but iornq(27) +c + icrdat(ncrd) = ibset(icrdat(ncrd),25) + else + iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),27) + end if +c +c Check for shift +c + call getchar(lineq,iccount,durq) + if (durq .eq. ' ') then + iccount = iccount-1 + else +c +c durq must be "-" +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 +c +c record the shift +c + NumArpShift = NumArpShift+1 + IvArpShift(NumArpShift) = ivx + IpArpShift(NumArpShift) = nnl(ivx) + ArpShift(NumArpShift) = fnum + end if + else if (index('0123456789#-nx_',charq) .gt. 0) then +c +c We have a figure. Must come AFTER the note it goes under +c + + ivf = 1 + if (ivx .gt. 1) then + if (ivxfig2 .eq. 0) then + ivxfig2 = ivx + else if (ivx .ne. ivxfig2) then + print* + print*,'Figures not allowed in >1 voice above first' + stop + end if + ivf = 2 + end if + nfig1 = nfigs(ivf)+1 + call getfig(itoff(ivf,nfig1),charq,lineq,iccount, + * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx), + * nodur(ivx,nnl(ivx)),figq(ivf,nfig1), +c * ivupfig(ivf,nfig1),nfigs(ivf)) + * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf)) + else if (charq .eq. '[') then +c +c Start forced beam. Record barno & time since start of inp. blk. Set signal +c + nfb(ivx) = nfb(ivx)+1 + fbon = .true. + ulfbq(ivx,nfb(ivx)) = 'x' + t1fb(ivx,nfb(ivx)) = itsofar(ivx) + nadj = 0 + if (autofbon) then + autofbon = .false. + end if +17 call getchar(lineq,iccount,charq) + if (index('ulf',charq) .gt. 0) then + ulfbq(ivx,nfb(ivx)) = charq + go to 17 + else if (charq .eq. 'j') then +c +c Continuing a jumped beam here +c + irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),24) +c +c Set flag to watch for END of this forced beam, so can set flag rest(30) on +c NEXT note as signal to start a new notes group there. +c + isbj2 = .true. + go to 17 + else if (charq .eq. 'h') then + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),2) + go to 17 + else if (charq .eq. 'm') then +c +c Force multiplicity. Next input is digit +c + call getchar(lineq,iccount,charq) + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) + call setbits(islur(ivx,nnl(ivx)+1),3,22,ichar(charq)-48) + go to 17 + else if (charq .eq. ':') then +c +c Start auto forced beam pattern +c + autofbon = .true. +c +c When forced later beam ends, check whether tautofv <=0; if so set it. +c + tautofb = -itsofar(ivx) + t1autofb = itsofar(ivx) + go to 17 + else if (charq .ne. ' ') then +c +c Must be '+/-' for height or slope shift +c + nadj = nadj+1 +c +c nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + iadj = nint(fnum) + if (charq .eq. '-') iadj = -iadj + if (nadj .eq. 1) then +c +c This is a level shift. Note if 0 was entered, iadj = 30 +c + call setbits(ipl(ivx,nnl(ivx)+1),6,11,iadj+30) + else if (nadj .eq. 2) then +c +c Must be a slope shift +c + call setbits(ipl(ivx,nnl(ivx)+1),6,17,iadj+30) + else +c +c Beam-thk fine tune +c + call setbits(islur(ivx,nnl(ivx)+1),2,27,iadj) + end if + go to 17 + end if + else if (charq .eq. ']') then + if (autofbon .and. tautofb.lt.tol) then + tautofb=itsofar(ivx)+tautofb + end if + call getchar(lineq,iccount,charq) + if (index('j ',charq) .gt. 0) then +c +c Since ']' comes AFTER note, itsofar has been updated. Set ending signal. +c + t2fb(ivx,nfb(ivx)) = itsofar(ivx) + fbon = .false. + if (charq .eq. 'j') then + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),23) + end if + if (isbj2) then +c +c This is the end of a fb segment of a jump beam. Set flag on NEXT note to +c force start of new notes group, provided this is not last note in bar. +c + if (mod(itsofar(ivx),lenbar) .ne. 0) + * irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),30) + isbj2 = .false. + end if + else if (charq .eq. '[') then +c +c Multiplicity down-up signal +c + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),20) + else if (charq .eq. '-') then +c +c Set signals for gap in single-slope beam [...]-[...] +c + nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),20) + nacc(ivx,nnl(ivx)+1) = ibset(nacc(ivx,nnl(ivx)+1),21) +c +c Next two characters must be "[ ". Skip over them. +c + iccount = iccount+2 + end if + else if (charq .eq. 'D') then + call getdyn(ivx,nnl(ivx),irest(ivx,nnl(ivx)), + * iornq(ivx,nnl(ivx)),lineq,iccount) + else if (charq .eq. 'h') then +c +c Heading or height. For heading, only OK if at start of block +c Check whether at beginning of a block +c + if (iv.ne.1 .or. nnl(1).ne.0) then + print*,'You entered "h" not at beginning of block' + call stop1() + end if + call getchar(lineq,iccount,durq) + ihdvrt = 0 + if (index('+-',durq) .gt. 0) then +c +c Vertical offset +c + iccount = iccount+1 + call readnum(lineq,iccount,charq,fnum) + ihdvrt = fnum+.1 + if (durq .eq. '-') ihdvrt = -ihdvrt + durq = charq + end if + if (durq .ne. ' ') then +c +c Height symbol. Read past (until next blank) +c +3 call getchar(lineq,iccount,durq) + if (durq .ne. ' ') go to 3 + else +c +c Set flag for header & read it in +c + ihdht = 16 + call getbuf(headrq) + iccount = 128 + end if + else if (charq .eq. 'L') then +c +c Linebreak, already handled some in pmxa, but need to get data for +c shortened line or coda lengths +c + iccount = iccount+1 + if (lineq(iccount:iccount) .eq. 'C') then +c +c Coda, get length +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,codafrac) + ishort = 3 + if (durq .eq. 'n') nocodabn = .true. + return + end if +c +c Get line number +c + call readnum(lineq,iccount,durq,fmovbrk) +48 continue ! Allow transfer up from below if S follows M + if (durq .eq. 'S') then +c +c Shortened line, get shortening fraction +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,shortfrac) + ishort = 1 + codafrac = 0. + end if +c +c Begin check for movement break +c + if (durq .eq. 'P') then + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + end if + if (durq .eq. 'M') then + movbrk = nint(fmovbrk) + movgap = 0 + parmov = -1. + call getchar(lineq,iccount,durq) +31 if (durq .eq. '+') then +c +c Get vertical space (\internotes) +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + movgap = nint(fnum) + go to 31 + else if (durq .eq. 'i') then + iccount = iccount+1 + call readnum(lineq,iccount,durq,parmov) + go to 31 + else if (durq .eq. 'c') then + nobar1 = .true. + call getchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'r') then +c +c "rename" can be set on or off. +c + call getchar(lineq,iccount,durq) + rename = durq.eq.'+' + call getchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'n') then +c +c Change # of voices. Input ninow, iiorig(1...ninow). Will use names, +c staves per inst. and clefs corr. to iiorig in original list of instruments. +c + nvold = nv + nv = 0 + rename = .true. + call getchar(lineq,iccount,durq) + if (durq .eq. ':') then + iccount = iccount+2 + read(lineq(iccount-1:iccount),'(i2)')ninow + else + ninow = ichar(durq)-48 + end if + iiv = 0 + do 63 iinow = 1 , ninow + call getchar(lineq,iccount,durq) + if (durq .eq. ':') then + iccount = iccount+2 + read(lineq(iccount-1:iccount),'(i2)')iiorig(iinow) + else + iiorig(iinow) = ichar(durq)-48 + end if + nspern(iinow) = nsperi(iiorig(iinow)) + nv = nv+nspern(iinow) + sepsymq(iiv+nspern(iinow)) = '&' + if (nspern(iinow) .gt. 1) then + do 64 iis = 1 , nspern(iinow)-1 + sepsymq(iiv+iis) = '|' +64 continue + end if + iiv = iiv+nspern(iinow) +63 continue +c +c 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement +c +c if (islast) then +c if (ninow .lt. 10) then +c write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' +c else +c write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' +c end if +c end if + if (nv.eq.1 .and. nvold.gt.1) then + if (islast) write(11,'(a)')sq//'nostartrule' + else if (nv.gt.1 .and. nvold.eq.1) then + if (islast) write(11,'(a)')sq//'startrule' + end if + iiv = 0 + do 60 iinow = 1 , ninow + do 61 iis = 1 , nspern(iinow) + iiv = iiv+1 +c +c May not really need to re-enter clefs, but it's easier to program since +c clef names are not saved but are needed in newvoice to set ncmidcc. +c + call getchar(lineq,iccount,clefq(iiv)) + call newvoice(iiv,clefq(iiv),.true.) + if (nspern(iinow) .eq. 1) then + hdlndq = chax(48+numclef(clefq(iiv))) + lclf = 1 + else if (iis .eq. 1) then + hdlndq = '{'//chax(48+numclef(clefq(iiv))) + lclf = 2 + else if (iis .lt. nspern(iinow)) then + hdlndq = hdlndq(1:lclf)//chax(48+numclef(clefq(iiv))) + lclf = lclf+1 + else + hdlndq = + * hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))//'}' + lclf = lclf+2 + end if +61 continue +c +c setstaffs & setclef go by instrument, not voice +c + if (islast) then + if (iinow .lt. 10) then + write(11,'(a)')sq//'setstaffs' + * //chax(48+iinow)//chax(48+nspern(iinow))//'%' + write(11,'(a)')sq//'setclef'//chax(48+iinow) + * //hdlndq(1:lclf)//'%' + if (fullsize(iiorig(iinow)).gt.0.9) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'normalvalue%' +c +c 140526 Account for staff size specs when noinst changes. May be confusion +c here if more than one staff per instrument +c + else if (fullsize(iiorig(iinow)).gt..7) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'smallvalue%' + else + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'tinyvalue%' + end if + else + write(11,'(a11,i2,a)')sq//'setstaffs{',iinow, + * '}'//chax(48+nspern(iinow))//'%' + write(11,'(a9,i2,a)')sq//'setclef{',iinow, + * '}'//hdlndq(1:lclf)//'%' + end if + end if +60 continue +c +c Loop back up, this may not be last option in M. Note flow out if durq=' ' +c + call getchar(lineq,iccount,durq) + go to 31 + else if (durq .eq. 'S') then + go to 48 + end if +c +c Write instrument names +c + if (.not.rename) then + do 62 iinst = 1 , ninow + if (islast) then + if (iinst .lt. 10) then + write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%' + else + write(11,'(a9,i2,a4)')sq//'setname{',iinst,'}{}%' + end if + end if +62 continue + else + do 65 iinst = 1 , ninow + if (islast) then + if (iinst .lt. 10) then + write(11,'(a8,i1,a)')sq//'setname',iinst,'{'// + * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%' + else + write(11,'(a9,i2,a)')sq//'setname{',iinst,'}{'// + * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%' + end if + end if +65 continue + if (ishort.ne.4.and.ishort.ne.2) rename = .false. +c +c Reset later and rewrite setname{} in shortening case mcm, since if +c written here it will be inside {{...}} and will be ignored +c + end if + end if + else if (charq .eq.'|' ) then +c +c End of bar symbol. Check about end of bar hardspace. +c + if (btest(iornq(ivx,nnl(ivx)+1),26)) then +c +c There was a hardspace followed by a bar line. Remove it from the hardspace +c list, store with shifts instead, set special bit. Need to repeat this code +c at '/'. +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18) + nudoff(ivx) = nudoff(ivx)+1 + udoff(ivx,nudoff(ivx)) = udsp(nudsp) + nudsp = nudsp-1 + iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26) + end if + else if (index('wS',charq) .gt. 0) then +c +c Width symbol or new nsyst. Read past (until blank) +c +4 call getchar(lineq,iccount,durq) + if (durq .ne. ' ') go to 4 + else if (charq .eq. 'l') then +c +c Lower string. Only OK if at start of block +c Check whether at beginning of a block +c + if (iv.ne.1 .or. nnl(1).ne.0) then + print*,'You entered "l" not at beginning of block' + call stop1() + end if +c +c Set flag for lower string & read it in +c + lower = .true. + call getbuf(lowerq) + iccount = 128 + else if (charq .eq. 'm') then +c +c Meter change. Only allow at beginning of block. +c mtrnuml, mtrdenl (logical) and p (printable) will be input. +c mtrnuml=0 initially. (In common) +c +c Check whether at beginning of a block +c + if (iv.ne.1 .or. nnl(1).ne.0) then + print*,'You entered "m" not at beginning of block' + call stop1() + end if + call readmeter(lineq,iccount,mtrnuml,mtrdenl) + call readmeter(lineq,iccount,mtrnmp,mtrdnp) + lenbeat = ifnodur(mtrdenl,'x') + if (mtrdenl .eq. 2) lenbeat = 16 + lenbar = mtrnuml*lenbeat + if (mtrdenl .eq. 2) lenbar = lenbar*2 + lenb1 = lenbar + lenb0 = 0 + if (ismidi) call midievent('m',mtrnuml,mtrdenl) + else if (charq .eq. 'C') then +c +c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. +c + if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 + tcc(iv,ncc(iv)) = itsofar(iv) + isl = ibset(islur(iv,nnl(iv)+1),11) + call getchar(lineq,iccount,durq) +c +c Store clef number, or 7 if clef number = 9 (French violin clef) +c + isl = ior(isl,ishft(min(numclef(durq),7),12)) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) + lastlev = lastlev+7 + if (nnl(iv).eq.0) then + ndlev(iv,1) = ndlev(iv,1)+7 + ndlev(iv,2) = ndlev(iv,2)+7 + end if + else +c +c This won't work if you really had an octave transposition with some +c other clef. Need a check on whether prior clef was an octave clef. +c + if (iTransAmt(instno(iv)).eq.7) then + iTransAmt(instno(iv))=iTransAmt(instno(iv))-7 + lastlev = lastlev-7 + if (nnl(iv).eq.0) then + ndlev(iv,1) = ndlev(iv,1)-7 + ndlev(iv,2) = ndlev(iv,2)-7 + end if + end if + end if +c +c Set marker on note with lowest voice # starting at same time. +c + if (iv .eq. 1) then + isl = ibset(isl,15) + else + do 13 iiv = 1 , iv + nnliiv = nnl(iiv) + if (iiv .eq. iv) nnliiv = nnliiv+1 + itother = 0 + do 14 iip = 1 , nnliiv + if (itother .lt. itsofar(iv)) then + itother = itother+nodur(iiv,iip) + go to 14 + else if (itother .eq. itsofar(iv)) then + islur(iiv,iip) = ibset(islur(iiv,iip),15) + go to 15 + end if +14 continue +13 continue +15 continue + end if +c +c Need 'or' since may have set bit 15 in the above loop +c + islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) + else if (charq .eq. 'R') then +c +c Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) +c +10 call getchar(lineq,iccount,durq) +c +c Save designator in case it's a terminal Rr or Rd +c + if (durq .eq. 'l') then + islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),5) + go to 10 + else if (index('rdDbz',durq) .gt. 0) then + if (durq .eq. 'r') then + islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),6) + else if (durq .eq. 'd') then + islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),8) + else if (durq .eq. 'D') then + islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),26) + else if (durq .eq. 'b') then + islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25) + else if (durq .eq. 'z') then +c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) + ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0) + end if + rptprev = .true. + rptfq1 = durq + go to 10 + end if + else if (charq .eq. 'V') then +c +c Ending +c + nnnl = nnl(1)+1 + lvoltxt = 0 +11 call getchar(lineq,iccount,durq) + if (durq.eq.'b' .or. durq .eq.'x') then +c +c End Volta, set bit9, and bit10 on if 'b' (end w/ box) +c + islur(1,nnnl) = ibset(islur(1,nnnl),9) + if (durq .eq. 'b') islur(1,nnnl) = ibset(islur(1,nnnl),10) + go to 11 + else if (durq .ne. ' ') then +c +c Start volta; Get text +c + if (lvoltxt .eq. 0) then +c +c First character for text +c + lvoltxt = 1 + islur(1,nnnl) = ibset(islur(1,nnnl),7) + nvolt = nvolt+1 + voltxtq(nvolt) = durq + else + voltxtq(nvolt) = voltxtq(nvolt)(1:lvoltxt)//durq + lvoltxt = lvoltxt+1 + end if + go to 11 + end if + else if (charq .eq. 'B') then + bcspec = .not.bcspec + else if (charq .eq. 'P') then +c +c Page numbers. Print stuff right now. +c + npg1 = 0 +c +c Will use ltopnam to signal whether there's a centered heading +c + ltopnam = 0 + ipg1r = 0 +16 call getchar(lineq,iccount,durq) + if (ichar(durq).ge.48 .and. ichar(durq).le.57) then + npg1 = npg1*10+ichar(durq)-48 + go to 16 + else if (durq .eq. 'l') then + if (npg1.eq.0 .or. mod(npg1,2).eq.1) ipg1r = 1 + go to 16 + else if (durq .eq. 'r') then + if (npg1.gt.0 .and. mod(npg1,2).eq.0) ipg1r = 1 + go to 16 + else if (durq .eq. 'c') then +c +c Top-centered name. Assume this is last option. Read the name. +c May surround name in double quotes (to allow blanks). +c + call getchar(lineq,iccount,durq) + if (durq .eq. ' ') then + ltopnam = lenstr(cheadq,60) + else + namstrt = iccount + if (durq .eq. chax(34)) then +c +c Using quote delimiters. +c + quoted = .true. + namstrt = namstrt+1 + else + quoted = .false. + end if + do 35 iccount = namstrt+1, 128 + if ((quoted .and. lineq(iccount:iccount).eq.chax(34) .and. + * lineq(iccount-1:iccount-1).ne.chax(92)) .or. + * (.not.quoted .and. lineq(iccount:iccount) .eq. ' ')) + * go to 36 +c +c On exit, iccount is OK, and name is in (namstrt:iccount-1) +c +35 continue + print*,'Awww, cmon, should not be here.' + call stop1() +36 continue + ltopnam = iccount-namstrt + cheadq = lineq(namstrt:iccount-1) + end if + end if +c +c Done getting data, now assemble the command +c + if (npg1.eq.0) npg1=1 +c +c 2/23/03 Don't use \atnextline if on first page and only one system +c +c if (ipage.gt.1 .or. nsystp(1).gt.1) then + hdlndq = sq//'def'//sq//'atnextline{'//sq//'toppageno{' + lhead = 27 +c else +c hdlndq = sq//'toppageno{' +c lhead = 11 +c end if + if (npg1 .lt. 10) then +c +c Note we are overwriting the last "{" +c + write(hdlndq(lhead:lhead),'(i1)')npg1 + else if (npg1 .lt. 100) then + lhead = lhead+3 + write(hdlndq(lhead-2:lhead),'(i2,a1)')npg1,'}' + else + lhead = lhead+4 + write(hdlndq(lhead-3:lhead),'(i3,a1)')npg1,'}' + end if + hdlndq = hdlndq(1:lhead)//chax(ipg1r+48)//'{' + lhead = lhead+2 +c if (ipage.gt.1 .or. nsystp(1).gt.1) then + if (ltopnam .eq. 0) then + if (islast) write(11,'(a)')hdlndq(1:lhead)//'}}%' + else + if (islast) + * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}}%' + end if +c else +c if (ltopnam .eq. 0) then +c if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' +c else +c if (islast) +c * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' +c end if +c end if + else if (charq .eq. 'W') then +c +c Just eat the number that must follow, it was used in pmxa +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + else if (charq .eq. 'T') then + headlog = .true. + inhead = 0 + call getchar(lineq,iccount,durq) + if (durq .eq. 'i') then + call getbuf(instrq) +c +c A kluge for parts from separate score file for later movements. +c + if (instrq(1:1) .eq. ' ') headlog = .false. + cheadq = instrq(1:60) + else if (durq .eq. 't') then + call getchar(lineq,iccount,durq) +c +c Optionally can include extra vertical \internotes above inbothd +c + if (index('-+0123456789',durq) .gt. 0) then + ipm = 1 + if (index('+-',durq) .gt. 0) then +c +c Don't trust readnum to round this negative integer properly +c + iccount = iccount+1 + if (durq .eq. '-') ipm = -1 + end if + call readnum(lineq,iccount,durq,fnum) + inhead = ipm*nint(fnum) + end if + call getbuf(titleq) + else + call getbuf(compoq) + end if + inhead = inhead+inbothd + iccount = 128 + else if (charq .eq. 'A') then +c +c Accidental handling etc. +c +27 call getchar(lineq,iccount,durq) + if (durq .eq. 'r') then + if (islast) then + relacc = .true. + write(11,'(a)')sq//'relativeaccid%' + end if + else if (durq .eq. 's') then + bacfac = 1.e6 + else if (durq .eq. 'b') then + if (islast) write(11,'(a)')sq//'bigaccid%' + accfac = bacfac + else if (durq .eq. 'a') then + call getchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + else if (durq .eq. 'i') then + call getchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,tintstf) + if (.not.firstgulp) fintstf = tintstf +c +c Local corrections for first page were handled by pmxa +c + iccount = iccount-1 + else if (durq .eq. 'I') then + call getchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,gintstf) + iccount = iccount-1 + else if (durq .eq. 'd') then + lowdot = .true. + else if (durq .eq. 'o') then + continue + else if (durq .eq. 'S') then + do 50 iiv = 1 , noinst + call getchar(lineq,iccount,durq) + if (index('-s',durq) .gt. 0) then + fullsize(iiv) = 0.8 + else if (durq .eq. 't') then + fullsize(iiv) = 0.64 + else +c fullsize(ivx) = 1.0 + fullsize(iiv) = 1.0 + end if +50 continue + else if (durq .eq. 'e') then +c +c Line-spacing equalization +c + equalize = .true. +c +c The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. +c But it causes problems with some older scores and when excerpts are combined +c with LaTeX. So as of 2.352 we write it here. +c + write(11,'(a)')sq//'global'//sq//'parskip 0pt plus 12'//sq + * //'Interligne minus 99'//sq//'Interligne%' + tempq = sepsymq(1) + lentemp = 1 + do 51 iiv = 2 , nv-1 + tempq = tempq(1:lentemp)//sepsymq(iiv) + lentemp = lentemp+1 +51 continue + write(11,'(a)')sq//'def'//sq//'upstrut{'//sq//'znotes' + * //tempq(1:lentemp)//sq//'zcharnote{'//sq//'upamt}{~}' + * //sq//'en}%' + else if (durq .eq. 'v') then +c +c Toggle usevshrink +c + usevshrink = .not.usevshrink + else if (durq .eq.'p') then +c +c Postscript slurs. fontslur is already false (set in g1etnote) +c + if (.not.WrotePsslurDefaults) then +c +c Set postscrirpt slur adjustment defaults +c + write(11,'(a)')sq//'Nosluradjust'//sq//'Notieadjust' + * //sq//'nohalfties' + WrotePsslurDefaults = .true. + end if +52 continue + call g1etchar(lineq,iccount,durq) ! might be "+", "-", "h" or "l" + if (index('+-',durq) .gt. 0) then +c +c Characters to change defaults for ps slurs +c + call g1etchar(lineq,iccount,charq) ! charq will be "s,t,h,c" + if (durq .eq. '+') then + if (charq .eq. 's') then + write(11,'(a)')sq//'Sluradjust' + else if (charq .eq. 't') then + write(11,'(a)')sq//'Tieadjust' + else if (charq .eq. 'h') then + write(11,'(a)')sq//'halfties' + else + SlurCurve = SlurCurve + 1 + if (SlurCurve .gt. 3.1) then + call printl('WARNING!') + call printl + * ('Default slur curvature advanced past HH, resetting') + SlurCurve = 3 + end if + end if + else + if (charq .eq. 's') then + write(11,'(a)')sq//'Nosluradjust' + else if (charq .eq. 't') then + write(11,'(a)')sq//'Notieadjust' + else if (charq .eq. 'h') then + write(11,'(a)')sq//'nohalfties' + else + SlurCurve = SlurCurve - 1 + if (SlurCurve .lt. -1.1) then + call printl('WARNING!') + call printl( + * 'Default slur curvature decremented below f, resetting') + SlurCurve = -1 + end if + end if + end if + go to 52 ! Check for another set of default changes + else if (durq .eq. 'l') then +c +c Set optional linebreak ties +c + OptLineBreakTies = .true. + go to 52 + else if (durq .eq. 'h') then +c +c Set flag to write header special on every page +c + HeaderSpecial = .true. + go to 52 + else + iccount = iccount-1 + end if + else if (durq .eq. 'K') then +c +c Toggle keyboard rest placement flag +c + kbdrests = .not.kbdrests + else if (durq .eq. 'c') then + call g1etchar(lineq,iccount,durq) +c +c Just eat the input; it was used in pmxa +c + go to 27 + else if (durq .eq. 'V') then + bottopgap = .true. + topamt = 0. + call getchar(lineq,iccount,durq) + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,botamt) + botamt = botamt*pmfac + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,topamt) + topamt = topamt*pmfac + iccount = iccount-1 + go to 27 + end if + if (index('NR',durq) .gt. 0) then +c +c Override default part names for scor2prt, or normal include file. +c Just bypass rest of input line +c + iccount = 128 + else if (durq .ne. ' ') then + go to 27 + end if + else if (charq .eq. 'K') then +77 continue + call getchar(lineq,iccount,durq) + if (durq .eq. 'n') then + ignorenats = .true. + go to 77 + end if + if (durq .ne. 'i') then +c +c Normal, full-score key change and/or transposition +c + num1 = 44-ichar(durq) + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + num1 = num1*nint(fnum) +c +c On exit, durq='+','-'. But only need isig if after start, else done in pmxa +c + iccount = iccount+1 + call readnum(lineq,iccount,charq,fnum) + if (ismidi) then + midisig = nint(fnum) + if (durq.eq.'-') midisig = -midisig +c 130317 + midisig = midisig+idsig + call midievent('k',midisig,0) + + end if +c70 continue + if (num1 .eq. 0) then +c +c Key change, not transposition. +c + ipl(ivx,nnl(ivx)+1) = ibset(ipl(ivx,nnl(ivx)+1),28) + lastisig = isig + isig = nint(fnum) + if (durq .eq. '-') isig = -isig + isig = isig+idsig + if (ismidi) call midievent('k',isig,0) + else +c +c num1 .ne. 0, so transposition, so must be at beginning. isig came with K... +c but was passed to pmxb through pmxtex.dat. isig0 comes from setup data +c (signature before transposition). idsig must be added to future key changes. +c + jv = 0 + do while (jv .lt. nm) + jv = jv+1 + iTransAmt(jv) = num1 + end do + idsig = isig-isig0 + end if + else +c +c Instrument specific transposition. +c + call GetiTransInfo(.false.,ibarcnt,lineq,iccount, + * ibaroff,nbars,noinst) +c +c The sig parameters will have been set 1st time but that's OK +c + end if + else if (charq .eq. chax(47)) then + if (btest(iornq(ivx,nnl(ivx)+1),26)) then +c +c There was a hardspace followed by end of block. Remove it from the hardspace +c list, store with shifts instead, set special bit. This code also at '|' +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18) + nudoff(ivx) = nudoff(ivx)+1 + udoff(ivx,nudoff(ivx)) = udsp(nudsp) + nudsp = nudsp-1 + iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26) + end if + call getchar(lineq,iccount,durq) +c +c Save ending note level: +c + if (ivx .le. nv) then +c +c This is the first line of music on this staff. If previous block had only 1 +c voice, save last pitch from line 1 of prev. block to line 2, in case a +c 2nd line is started just below +c + if (.not.was2(iv)) ndlev(iv,2) = ndlev(iv,1) + was2(iv) = .false. + ndlev(iv,1) = lastlev + else +c +c This is the 2nd line of music on this staff. +c + was2(iv) = .true. + ndlev(iv,2) = lastlev + end if + if (durq .eq. ' ' .and. iv.eq.nv) then +c +c End of input block +c + loop = .false. + else +c +c Start a new line of music +c + if (lenb0.ne.0 .and. firstgulp) lenbar = lenb0 + nbars = 0 + if (durq .eq. ' ') then +c +c New line of music is on next staff +c + iv = iv+1 + ivx = iv + else +c +c durq must be 2nd '/'. New line of music is on same staff. Set up for it +c + ivx = nv+1 + do 23 iiv = 1 , nv + if (nvmx(iiv) .eq. 2) ivx = ivx+1 +23 continue + nvmx(iv) = 2 + ivmx(iv,2) = ivx + itsofar(ivx) = 0 + nnl(ivx) = 0 + nfb(ivx) = 0 + nudoff(ivx) = 0 + ndotmv(ivx) = 0 + do 24 j = 1 , 200 + irest(ivx,j) = 0 + islur(ivx,j) = 0 + nacc(ivx,j) = 0 + iornq(ivx,j) = 0 + ipl(ivx,j) = 0 + mult(ivx,j) = 0 +24 continue +c +c Go back and lower the rests in voice "a" that don't have over-ridden heights +c + do 26 j = 1 , nnl(iv) + if (btest(irest(iv,j),0) .and. nolev(iv,j).eq.0) + * nolev(iv,j) = -4 +26 continue + end if + end if + iccount = 128 + else if (charq .eq. 'X') then +c +c 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, +c which only happens for normal X at block start, and we took special measures to +c keep group shifts for crossing block boundaries. +c + call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx))), + * shifton,wheadpt,iornq(ivx,nnl(ivx)+1),ivx, + * irest(ivx,nnl(ivx)+1),itsofar(ivx),0,0,0,' ',ndoub) + else if (charq .eq. 'I') then +c +c Midi controls. +c + call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, + * mtrdenl,nv,.false.) + else if (charq .eq. 'M') then +c +c Macro action +c + call getchar(lineq,iccount,charq) + if (index('RS',charq) .gt. 0) then +c +c Record or save a macro. Get the number of the macro. +c + call getchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,fnum) + macnum = nint(fnum) + macuse = ibset(macuse,macnum) + if (charq .eq. 'R') then + call mrec1(lineq,iccount,ndxm) + else +c +c Save (Record but don't activate) +c +5 call mrec1(lineq,iccount,ndxm) + if (mrecord) then + call getbuf(lineq) + iccount = 0 + go to 5 + end if + iccount = iccount+ndxm+1 + end if + else if (charq .eq. 'P') then +c +c Playback the macro +c + call getchar(lineq,iccount,charq) + call readnum(lineq,iccount,durq,fnum) + macnum = nint(fnum) + icchold = iccount + lnholdq = lineq + iccount = 128 + ilmac = il1mac(macnum) + mplay = .true. + end if + else if (index(',.',charq) .gt. 0) then +c +c Continued rhythmic shortcut +c + idotform = index('. ,',charq) + if (idotform .eq. 1) then +c +c Check for start of forced beam on 2nd member of dotform=1 shortcut +c + if (fbon) then + if (t1fb(ivx,nfb(ivx)).eq.itsofar(ivx)) + * t1fb(ivx,nfb(ivx)) = + * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2 + end if +c +c Change duration of prior note +c + itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) + nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2 + itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx)) + end if + idotform = idotform+1 + numnum = 1 + cdot = .true. + go to 1 + end if + return + end + subroutine getorn(lineq,iccount,iornq,iornq0,ornrpt,noffseg, + * ip,ivx,noxtup,notcrd,nole) +c +c iornq: Main note. Do not alter if chord note, except turn on bit 23 +c iornq0: Store iorni + bit 23, in case of repeated ornaments +c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. +c noffseg: horiz. offset for segno +c nole: level of note w/ orn, used to ID the note/orn if there's a level shift. +c + + common /comivxudorn/ivxudorn(63) + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /comcb/ nbc,ibcdata(36) + character*1 charq,durq + character*128 lineq + logical ornrpt,negseg,noxtup,notcrd +c +c Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U +c 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. +c + call getchar(lineq,iccount,charq) + if (index('bc',charq) .gt. 0) then +c +c caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) +c ivx(0-3,28), ip(4-12), +c vshift (vshift+32 in bits 13-18), +c hshift (nint(10*vshift)+128 in bits 19-26) +c bit 27 = 0 if caesura, 1 if breath +c bit 28: 5th bit of ivx +c + iornq = ibset(iornq,28) + nbc = nbc+1 +c ibcdata(nbc) = ivx+16*ip + ibcdata(nbc) = mod(ivx,16)+16*ip + if (ivx.ge.16) ibcdata(nbc) = ibset(ibcdata(nbc),28) + if (charq .eq. 'b') ibcdata(nbc) = ibset(ibcdata(nbc),27) + call getchar(lineq,iccount,durq) + if (index('+-',durq) .gt. 0) then +c +c We have a vertical shift, get it +c + iccount = iccount+1 + call readnum(lineq,iccount,charq,fnum) + if (durq .eq. '-') fnum=-fnum + call setbits(ibcdata(nbc),6,13,nint(32+fnum)) + if (index('+-',charq) .gt. 0) then +c +c Horizontal shift, get it +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (charq .eq. '-') fnum=-fnum + call setbits(ibcdata(nbc),8,19,nint(10*fnum)+128) + end if + end if + return + end if +c +c Set signal on main note that some note at this time has ornament. ONLY used +c in beamstrt to activate further tests for whether ihornb is needed. +c + iornq = ibset(iornq,23) +c +c Isolate 21 bits defining exisiting ornaments +c + if (notcrd) then +c iorni = iand(4194303,iornq) +c iorni = iand(541065215,iornq) + iorni = iand(1614807039,iornq) + else + iorni = iand(4194303,icrdorn(ncrd)) + end if +c korn = index('stmgx+Tupf._)e:XXX>^',charq) + korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq) + if (korn .ne. 15) iorni = ibset(iorni,korn) +c +c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later +c as follows: korn=16-18 for sfn, and or 21 for bare ?. +c When this if-block is done, korn will = bit# of actual ornament (unless "?"). +c + if (korn .eq. 15) then +c +cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq +cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq +c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq +c +c iorni = ior(iorni,iand(iornq0,1638383)) +c iorni = ior(iorni,iand(iornq0,3735535)) +c iorni = ior(iorni,iand(iornq0,540606447)) + iorni = ior(iorni,iand(iornq0,1614348271)) + ornrpt = .false. + call getchar(lineq,iccount,durq) +c +c durq will be ' ' +c + else if (korn .eq. 14) then +c +c Editorial accidental +c + call getchar(lineq,iccount,durq) +c korn = 15+index('sfn',durq) + korn = 15+index('sfn?',durq) + if (korn .eq. 19) korn=21 + iorni = ibset(ibclr(iorni,14),korn) + call getchar(lineq,iccount,durq) + if (durq .eq. '?') then +c +c This is "oe[s|f|n]?". Set 21st bit also. +c + iorni = ibset(iorni,21) + korn = korn+6 + call getchar(lineq,iccount,durq) + end if +c iorni = ibset(ibclr(iorni,14),korn) + else if (korn.eq.4 .and. noxtup) then +c +c segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points +c + noffseg = 0 + negseg = .false. + call getchar(lineq,iccount,durq) + if (durq .ne. ' ') then +c +c Segno shift is specified +c + if (durq .eq. '-') then + negseg = .true. + call getchar(lineq,iccount,durq) + end if + call readnum(lineq,iccount,durq,fnum) + noffseg = int(fnum) + if (negseg) noffseg = -noffseg + end if + else if (korn .eq. 7) then +c +c Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" +c + ntrill = ntrill + 1 + ivtrill(ntrill) = ivx + iptrill(ntrill) = ip + xnsktr(ntrill) = 1. + call getchar(lineq,iccount,durq) + if (durq .eq. 't') then +c +c Convert to new internal symbol for non-'"tr" trill +c + korn = 15 + iorni = ibset(ibclr(iorni,7),15) + call getchar(lineq,iccount,durq) + end if + if (index('0123456789.',durq) .gt. 0) then +c +c We have a number for the length +c + call readnum(lineq,iccount,durq,xnsktr(ntrill)) + end if + else if (korn.eq.10 .and. noxtup) then +c +c Fermata +c + call getchar(lineq,iccount,durq) + if (durq .eq. 'd') then + korn = 14 + iorni = ibset(ibclr(iorni,10),14) + call getchar(lineq,iccount,durq) + end if + else + call getchar(lineq,iccount,durq) + end if + if (index('+- :',durq) .eq. 0) then + print*,'Unexpected character at end of ornament: ',durq + call stop1() + end if + if (index('+-',durq) .gt. 0) then +c +c Shift ornament up or down +c + nudorn = nudorn+1 +c +c Set bit 25 in iorni as a signal. This may not really be necessary. +c + iorni = ibset(iorni,25) +c +c Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, +c 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present +c + xofforn = 44-ichar(durq) + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + iofforn = nint(xofforn*fnum) + kudorn(nudorn) = ip+ishft(mod(ivx,16),8)+ishft(nole,12) + * +ishft(korn,19)+ishft(iofforn+32,25) + ivxudorn(nudorn) = ivx + if (index('+-',durq) .gt. 0) then +c +c Horizontal shift +c + kudorn(nudorn) = ibset(kudorn(nudorn),31) + xofforn = 44-ichar(durq) + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) +c 141226 ornhshft(nudorn) = nint(xofforn*fnum) + ornhshft(nudorn) = xofforn*fnum + end if + else if (durq .eq. ':') then +c +c Turn on repeated ornaments +c + ornrpt = .true. +c +c Save the ornament value just set +c + iornq0 = iorni + end if + if (notcrd) then + iornq = ior(iornq,iorni) + else + icrdorn(ncrd) = ior(icrdorn(ncrd),iorni) + end if + return + end + subroutine getpmxmod(global,includeq) +c +c If global=.true., checks for environment variable with path to pmx.mod. +c Then, if variable exists and points to pmx.mod, insert lines from +c pmx.mod into buffer +c If global=.false., checks for existence of includeq and uses it. +c +c lenbuf0 = total length of bufq on entry +c lbuf(i) = length of line (i) +c nlbuf = number of lines stored in bufq +c ilbuf = index of first line after setup stuff (on entry). In general, index of +c next line to be sucked from buffer. +c ilbufmod = counter for lines in pmx.mod as they are grabbed. +c Starts at ilbuf. Points to position of next line after +c pmx.mod stuff in bufq on exiting loop 1 +c ilbuff = transient counter for shifting operations +c ipbuf = on entry, points to last character in setup stuff. In general, points +c to last character of most recent line sucked from buffer. +c ipbufmod = points to last character of most recent inserted line +c from pmx.mod +c + parameter (maxblks=9600,nm=24) + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + logical lastchar,fbon,issegno,isheadr,isvolt + character*(*)includeq + character*80 pmxmoddirq + character*128 lnholdq + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + logical fexist,global + line1pmxmod = ilbuf + if (.not.global) then + inquire(file=includeq,EXIST=fexist) +c +c Transfer includeq to temporary char variable with known length +c + pmxmoddirq = includeq + lpmxmoddirq = lenstr(pmxmoddirq,80) + print* + write(15,'()') + if (.not.fexist) then + call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq) + * //', checking further.') +c +c File named includeq doesn't not exist. Get directory from PMXMODDIR and +c see if it's there +c + call getenv('PMXMODDIR',pmxmoddirq) + lpmxmoddirq = lenstr(pmxmoddirq,80) + if (lpmxmoddirq. gt. 0) then + pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//includeq + lpmxmoddirq = lenstr(pmxmoddirq,80) + else + call printl( + * 'No other directory defined by PMXMODDIR, stopping') + call stop1() + end if + inquire(file=pmxmoddirq,EXIST=fexist) + if (.not.fexist) then + call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq) + * //', stopping.') + call stop1() + end if + end if + call printl('Opening normal include file ' + * //pmxmoddirq(1:lpmxmoddirq)) + open(18,file=pmxmoddirq) + else +c +c Check for existence of pmx.mod +c + call getenv('PMXMODDIR',pmxmoddirq) + lpmxmoddirq = lenstr(pmxmoddirq,80) + if (lpmxmoddirq .eq. 0) return + pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//'pmx.mod' + lpmxmoddirq = lpmxmoddirq+7 + inquire(file=pmxmoddirq,EXIST=fexist) + if (.not.fexist) return + call printl('Opening global include file ' + * //pmxmoddirq(1:lpmxmoddirq)) + open(18,file=pmxmoddirq(1:lpmxmoddirq)) + end if + call printl('Adding include data') +c +c Read lines in from pmx.mod one at a time +c + ipbufmod = ipbuf + lenbufmod = lenbuf0 + do 1 ilbufmod = ilbuf , maxblks + read(18,'(a)',end=3)lnholdq +c +c A line was read. Slide all existing lengths from here forward ahead by 1 +c + do 2 ilbuff = nlbuf , ilbufmod , -1 + lbuf(ilbuff+1) = lbuf(ilbuff) +2 continue +c +c Get length of line from include file +c + lenmodline = lenstr(lnholdq,128) + if (lenmodline .eq. 0) then +c +c Blank line. Make it a single blank with length 1 +c + lenmodline = 1 + lnholdq = ' ' + end if + lbuf(ilbufmod) = lenmodline + call printl(lnholdq(1:lenmodline)) +c +c Insert new stuff into bufq +c + bufq = bufq(1:ipbufmod)//lnholdq(1:lenmodline)// + * bufq(ipbufmod+1:lenbufmod) +c +c Update internal parameters +c + ipbufmod = ipbufmod+lbuf(ilbufmod) + lenbufmod = lenbufmod+lbuf(ilbufmod) + nlbuf = nlbuf+1 +1 continue +3 continue + call printl('Closing '//pmxmoddirq(1:lpmxmoddirq)) + close(18) + linesinpmxmod = linesinpmxmod+ilbufmod-ilbuf + lenbuf0 = lenbufmod +c +c Fix Andre's error reporting problem 101211 leading to log(neg#) due +c to nline being 2 bigger than it should be +c + nline=nline-2 +c + return + end + subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, + * xmtrnum0,npages,nsyst,musicsize,fracindent,istype0, + * inameq,clefq,sepsymq,pathnameq,lpath,isig0) + parameter (nm=24) + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + character*1 clefq(nm),sepsymq(nm),chax + character*40 pathnameq + character*79 inameq(nm) + character*128 lineq + logical istype0,newway,rename + common /commidisig/ midisig +c +c Get the first line +c + iccount = 0 +9 call getbuf(lineq) + if (lineq(1:1) .eq. '%') go to 9 + istype0 = lineq(1:3).eq.'---' + if (istype0) then +c +c Have TeX input until next line that starts with '---'. Save in scratch. +c + open(17,status='SCRATCH') +3 call getbuf(lineq) + if (lineq(1:3) .ne. '---') then + write(17,'(a)')lineq + go to 3 + end if +c +c Force a new line read on first call to readin +c + iccount = 128 + end if +c +c Here, lineq is first line w/ numerical setup data. +c + nv = nint(readin(lineq,iccount,nline)) + noinst = nint(readin(lineq,iccount,nline)) + newway = noinst.le.0 + if (newway) noinst = -noinst + do 2 iinst = 1 , noinst +c +c Seve # of staves per inst in case later drop some inst's. +c + if (newway) then +c +c Read in nvi for each instrument +c + nsperi(iinst) = nint(readin(lineq,iccount,nline)) + else if (iinst .gt. 1 ) then + nsperi(iinst) = 1 + else + nsperi(iinst) = nv-noinst+1 + end if + iiorig(iinst) = iinst + nspern(iinst) = nsperi(iinst) +2 continue + mtrnuml = nint(readin(lineq,iccount,nline)) + mtrdenl = nint(readin(lineq,iccount,nline)) +cc +cc Kluge to make mtrdenl work +cc +c if (mtrdenl .eq. 1) then +c mtrdenl = 2 +c mtrnuml = mtrnuml*2 +c end if + mtrnmp = nint(readin(lineq,iccount,nline)) + mtrdnp = nint(readin(lineq,iccount,nline)) + xmtrnum0 = readin(lineq,iccount,nline) +c +c Original key sig (before any trnasposition) in next position. Transposed +c sig for topfile was transferred thru pmxtex.dat. Need isig0 for key +c changes if transposed. +c + isig0 = nint(readin(lineq,iccount,nline)) +c 130316 +c do 11 iinst = 1 , noinst +c midisig(iinst) = isig0 + midisig = isig0 +c11 continue + npages = nint(readin(lineq,iccount,nline)) + nsyst = nint(readin(lineq,iccount,nline)) + musicsize = nint(readin(lineq,iccount,nline)) + fracindent = readin(lineq,iccount,nline) +c +c Next noinst non-comment lines are names of instruments. +c + do 4 i = 1 , noinst +5 call getbuf(inameq(i)) + if (inameq(i)(1:1) .eq. '%') go to 5 +4 continue +c +c Next non-comment line has nv clef names +c +6 call getbuf(lineq) + if (lineq(1:1) .eq. '%') go to 6 + iv = 0 + nvsofar = 0 + do 1 jinst = 1 , noinst + nvsofar = nvsofar+nsperi(jinst) + do 10 ivi = 1 , nsperi(jinst) + iv = iv+1 + clefq(iv) = lineq(iv:iv) + if (iv .eq. nvsofar) then + sepsymq(iv) = '&' + else + sepsymq(iv) = '|' + end if +10 continue +1 continue +c +c Mext non-comment line has path name +c +8 call getbuf(pathnameq) + if (pathnameq(1:1) .eq. '%') go to 8 + lpath = index(pathnameq,' ')-1 +12 ipos = index(pathnameq,chax(92)) + if (ipos .gt. 0) then + pathnameq(ipos:ipos)=chax(47) + go to 12 + end if + return + end + function getsquez(n,ntot,space,tnote,to) + real*4 tnote(600),to(600) + common /comtol/ tol +c +c Get the squez factor by checking space against tgovern=minimum duration +c of all notes sounding at time of n-th note in the list. +c The starting time of base increment is to(n) and ending time is to(n)+space +c Sounding notes are those that start at or before to(n) .and. end at or +c after tend=to(n)+space +c Since notes are ordered by increasing start times, as soon as we find one +c that starts too late, we are done checking. +c + tgovern = 1000. + tend = to(n)+space + do 1 in = 1 , ntot +c +c Since to() is ordered by start times, exit loop after first note that +c starts later than note of interest. +c + if (to(in) .gt. to(n)+tol) go to 2 + if (to(in)+tnote(in) .gt. tend-tol) then +c +c If here, this note overlaps and must be tested. +c + tgovern = min(tgovern,tnote(in)) + end if +1 continue +2 continue + getsquez = space/tgovern + return + end + subroutine getx(lineq,iccount,irest,shifton,wheadpt,iornq1,ivx, + * irest1,itsofar,ntup,itup,nnodur,dotq,ndoub) + parameter(nm=24) +c +c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. +c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. +c Since during getnote phase time is integer itsofar, which is not updated +c during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if +c not in xtup. +c + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + logical shifton,colon,ess,number + character*128 lineq + character*1 charq,durq,dotq + colon = .false. + ess = .false. + number = .false. + nextbl = iccount+index(lineq(iccount:128),' ')-1 + if (index(lineq(iccount:nextbl),'P') .gt. 0) then +c +c "Parts only", ignore entire symbol +c + iccount = nextbl + return + end if +1 call getchar(lineq,iccount,charq) + if (charq.eq.'B') then +c +c "Both parts and score," ignore character +c + go to 1 + else if (charq .eq. ':') then + colon = .true. + go to 1 + else if (charq .eq. 'S') then + ess = .true. + go to 1 + else if (index('+-.0123456789',charq) .gt. 0) then + number = .true. + if (charq.eq.'-') iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (charq .eq. '-') fnum = -fnum + if (durq .ne. 'p') then + fnum = fnum*wheadpt + iccount = iccount-1 + end if + go to 1 + end if +c +c charq must be blank, so done parsing +c + if (.not.ess .and. .not.colon) then +c +c Ordinary hardspace. Goes before next note. +c (Later, at "|" or "/", check for presence and switch to udoff if there!) +c + nudsp = nudsp+1 + iornq1 = ibset(iornq1,26) + udsp(nudsp) = fnum + tudsp(nudsp) = itsofar + if (ntup .gt. 0) tudsp(nudsp) = tudsp(nudsp) +c * +float(itup-1)/ntup*ifnodur(nnodur,dotq) + * +float(itup-1+ndoub)/ntup*ifnodur(nnodur,dotq) + else if (.not.number) then +c +c Must be "X:" End a group offset. +c + irest = ibset(irest,17) + shifton = .false. + return + else +c +c Only other possibility is start offset, "S" for single, ':' for multiple +c + nudoff(ivx) = nudoff(ivx)+1 + udoff(ivx,nudoff(ivx)) = fnum + if (ess) then + irest1 = ibset(irest1,15) + else + irest1 = ibset(irest1,16) + shifton = .true. + end if + end if + return + end + function i1fnodur(idur,dotq) + character*1 dotq + if (idur .eq. 6) then + i1fnodur=1 + else if (idur .eq. 3) then + i1fnodur=2 + else if (idur .eq. 1) then + i1fnodur=4 + else if (idur .eq. 8) then + i1fnodur=8 + else if (idur .eq. 4) then + i1fnodur=16 + else if (idur .eq. 2) then + i1fnodur=32 + else if (idur .eq. 0) then + i1fnodur=64 + else if (idur .eq. 16) then +c +c Only used for denominator of time signatures, not for notes +c + i1fnodur=4 + else if (idur .eq. 9) then + i1fnodur = 128 + else + print* + print*,'You entered an invalid note-length value:',idur + call stop1() + end if + if (dotq .eq. 'd') i1fnodur = i1fnodur*3/2 + return + end +c integer*4 function longi(ishort) +c integer*2 ishort +c longi = ishort +c return +c end + function iashft(nacc) + integer*4 ias(6) + data ias /-1,1,0,0,-2,2/ + iashft = ias(nacc) + return + end + function ifnodur(idur,dotq) + character*1 dotq + if (idur .eq. 6) then + ifnodur=1 + else if (idur .eq. 3)then + ifnodur=2 + else if(idur .eq. 1) then + ifnodur=4 + else if(idur .eq. 8) then + ifnodur=8 + else if(idur .eq. 4) then + ifnodur=16 + else if(idur .eq. 2) then + ifnodur=32 + else if(idur .eq. 0) then + ifnodur=64 + else if(idur .eq. 9) then + ifnodur=128 + else if (idur .eq. 16) then +c +c Only used for denominator of time signatures, not for notes +c + ifnodur=4 + else + print*,'You entered an invalid note value' + stop + end if + if (dotq .eq. 'd') ifnodur = ifnodur*3/2 + return + end + function ifnolev(noq,oct,ntrans) + character*1 noq + integer oct + ifnolev = 7*oct+mod(ichar(noq)-92,7)+1+ntrans + return + end +c subroutine report(nsdat,isdat1,isdat2) +c integer*4 isdat1(202),isdat2(202) +c write(*,'(a)') +c * ' isd on? iv kv ip id ud1 ud2 ndx ivo iho lev crd lhd rhd' +c do 1 isdat = 1 , nsdat +c isdata = isdat1(isdat) +c ionoff = igetbits(isdata,1,11) +cc iv = iand(7,isdata) +c iv = igetbits(isdata,5,13) +c kv = igetbits(isdata,1,12)+1 +c ip = igetbits(isdata,8,3) +c idcode = igetbits(isdata,7,19) +c iud1 = igetbits(isdata,1,26) +c iud2 = igetbits(isdata,1,27) +c ndxslur = igetbits(isdata,4,28) +c isdatb = isdat2(isdat) +c ivo = igetbits(isdatb,6,6)-32 +c iho = igetbits(isdatb,7,12)-64 +c lev = igetbits(isdatb,7,19) +c icrd = igetbits(isdatb,1,0) +c lhd = igetbits(isdatb,1,1) +c irhd = igetbits(isdatb,7,2) +c write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur, +c * ivo,iho,lev,icrd,lhd,irhd +c1 continue +c print* +c return +c end + function igetbits(isdata,iwidbit,ishift) +c +c Extracts integer given by iwidbit bits of isdata, shifted by ishift, and +c then added to ioff +c + igetbits = iand(2**iwidbit-1,ishft(isdata,-ishift)) + return + end + function igetvarlen(mmidi,icm,imidi,nbytes) +c +c Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. +c + parameter (nm=24,mv=24576) + integer*2 mmidi(0:nm,mv) + igetvarlen = 0 + do 1 nbytes = 1 , 4 + mmidi4 = mmidi(icm,imidi+nbytes) + igetvarlen = 128*igetvarlen +c * +iand(127,mmidi(icm,imidi+nbytes)) + * +iand(127,mmidi4) +c if (.not.btest(mmidi(icm,imidi+nbytes),7)) return + if (.not.btest(mmidi4,7)) return +1 continue + print*,'Messup in igetvarlen' + call stop1() + end + logical function isdotted(nodur,ivx,ip) + parameter (nm=24) +c +c Function returns true if note is dotted or double-dotted. +c Return false for any xtuplet. +c + common /comtol/ tol + integer*4 nodur(nm,200) + if (nodur(ivx,ip) .eq. 0) then + isdotted = .false. + return + else if (ip .gt. 1) then + if (nodur(ivx,ip-1) .eq. 0) then + isdotted = .false. + return + end if + end if +c +c Ruled out all xtups, so is dotted or double-dotted if not a power of 2. +c + isdotted = + * mod(alog(float(nodur(ivx,ip)))/.69314718+.5*tol,1.) .gt. tol + return + end + function isetvarlen(idur,nbytes) + isetvarlen = 0 + itemp = idur + do 1 nbytes = 1 , 4 + isetvarlen = isetvarlen + iand(itemp,127)*256**(nbytes-1) + itemp = ishft(itemp,-7) + if (itemp .gt. 0) then + isetvarlen = isetvarlen+2**(8*nbytes+7) + else + return + end if +1 continue + print*,'Problem in fn. isetvarlen' + call stop1() + end + subroutine istring(i,string,len) +c +c Returns string with integer only if length is 1, otherwise enclosed in +c brackets. +c + character*(*) string + if (i .ne. 0) then + len = alog10(abs(i)*1.0001)+1 + if (i .lt. 0) len = len+1 + else + string = '0' + len = 1 + return + end if + if (len .eq. 1) then + string = char(48+i) + else + string = '{' + write(string(2:1+len),'(i'//char(48+len)//')')i + string = string(1:len+1)//'}' + len = len+2 + end if + return + end + function lenstr(string,n) + character*(*) string + do 1 lenstr = n , 1 , -1 + if (string(lenstr:lenstr) .ne. ' ') return +1 continue + lenstr = 0 + return + end + function levrn(nolev,irest,iud,ncm,mult) +c +c Used for placing numbers in xtups. Returns note level if not a rest, +c else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. +c + logical btest + if (.not.btest(irest,0)) then + levrn = nolev + else +c +c Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. +c + if (mult .gt. 0) then + if (mult .eq. 2) then + ioff = -1+2*iud + else if (mult .ne. 4) then + ioff = iud*mult + else + ioff = 1+4*iud + end if + else +c +c May need to futz with this later for non-beamed xtups (quarter, half rests) +c + ioff = iud*2 + end if + levrn = mod(nolev+20,100)-20+ncm+ioff + endif + return + end + function lfmt1(x) +c +c Computes total length of an "f" format with one decimal place. +c First round to nearest 0.1 +c + if (abs(x) .lt. .001) then + lfmt1 = 2 + else + y = sign(.1*int(10*abs(x)+.5),x) + lfmt1 = int(log10(1000*abs(y)+.001)) + if (y .lt. 0) lfmt1 = lfmt1+1 + end if + return + end + subroutine LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat, + * ispstie,sepsymq) + parameter (nm=24) + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /comoct/ noctup + integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) + logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie + character*1 udq,chax,sepsymq(nm) + character*8 noteq + character*128 notexq +c +c This is called twice from pmxb after having input an entire block, before +c making a bar that starts a new system. So nsdat reflects all slur starts +c and stops in new block, while listslur, which is only set when bars are +c made, reflects only open slurs from the old block. So we must check +c listslur to find open ties, not all nsdat. +c First of two calls (ispstie=.false. on entry) terminates tie at end of line. +c Second (ispstie=.true. on entry) restarts tie at start of new line. Only +c need data from original tie-start for both of these. Tie/slur data from +c closing of full tie are not used except for shape alterations. +c +c do 1 ndx = 0 , 11 + do 1 ndx = 0 , 23 + if (btest(listslur,ndx)) then +c +c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie +c + do 2 isdat = 1 , nsdat +c if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index + if (igetbits(isdat1(isdat),4,28) + * +16*igetbits(isdat1(isdat),1,18) .ne. ndx) go to 2 ! Wrong index + if (.not.btest(isdat1(isdat),11)) go to 2 ! Bypass if stop + if (btest(isdat2(isdat),3)) go to 3 ! "st" + idcode = igetbits(isdat1(isdat),7,19) + if (idcode.eq.1) go to 3 ! "t" + tie = .false. + go to 5 +2 continue + end if + go to 1 +3 continue + tie = .true. +5 continue +c +c A slur or tie is open, with index ndx +c + iv = igetbits(isdat1(isdat),5,13) + kv = igetbits(isdat1(isdat),1,12)+1 + udq = 'd' + if (btest(isdat1(isdat),27)) udq='u' + notexq = chax(92)//'znotes' + lnote = 7 + do 4 iiv = 1 , iv-1 + notexq = notexq(1:lnote)//sepsymq(iiv) + lnote = lnote+1 +4 continue + if (kv .eq. 2) then + notexq = notexq(1:lnote)//chax(92)//'nextvoice' + lnote = lnote+10 + end if +c +c Compute horiz and vert offsets +c +c nolev = igetbits(isdat2(isdat),7,19) + islhgt = igetbits(isdat3(isdat),8,14) + ilb12 = 0 + if (ispstie) ilb12 = 1 + ivoff = igetbits(isdat4(isdat),6,ilb12*16)-32 + if (ivoff .eq. -32) ivoff = 0 +C nolev = nolev+ivoff + islhgt = islhgt+ivoff + ihoff = (igetbits(isdat4(isdat),7,ilb12*16+6)-64) ! This is 10X hoff + if (ihoff .eq. -64) ihoff = 0 +c +c Add starting stuff for command +c + if (.not.ispstie) then ! End 1st segment + notexq = notexq(1:lnote)//chax(92)//'roffset{' + lnote = lnote+9 +c hoff = ihoff*.1-.5 +c hoff = ihoff*.1-.8 + hoff = ihoff*.1-.4 + if (hoff .lt. 0) then + hoff = -hoff + notexq = notexq(1:lnote)//'-' + lnote = lnote+1 + end if + call writflot(hoff,notexq,lnote) + notexq = notexq(1:lnote)//'}{' + lnote = lnote+2 + else + notexq = notexq(1:lnote)//chax(92)//'off{-' + * //chax(92)//'afterruleskip}' + lnote = lnote+21 +c +c 091025 add dotting for 2nd segment if needed +c + if (btest(isdat2(isdat),4)) then + notexq = chax(92)//'dotted'//notexq(1:lnote) + lnote = lnote+7 + end if + end if + if (ispstie .and. tie) then + notexq = notexq(1:lnote)//chax(92)//'tieforis'//udq + lnote = lnote+10 + end if + if (btest(isdat3(isdat),0)) then +c +c Curvature tweak on termination of 1st seg +c + imid = igetbits(isdat3(isdat),6,2)-32 +c +c Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: +c Abs(imid) Postscript slur type +c 1 f +c 4 h +c 5 H +c 6 HH +c + notexq = notexq(1:lnote)//chax(92)//'psforts'//chax(48+imid) + lnote = lnote+9 +c +c Zero out the flag in case there's a different curv on term of 2nd, +c + isdat3(isdat) = ibclr(isdat3(isdat),0) + end if +c +c Add the command name +c + if (ispstie) then + notexq = notexq(1:lnote)//chax(92)//'is'//udq + lnote = lnote+4 + else if (tie) then + notexq = notexq(1:lnote)//chax(92)//'ttie' + lnote = lnote+5 + else + notexq = notexq(1:lnote)//chax(92)//'tslur' + lnote = lnote+6 + end if +c +c Add index +c +c if (11-ndx .lt. 10) then +c notexq = notexq(1:lnote)//chax(59-ndx) +c lnote = lnote+1 +c else +c notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' +c lnote = lnote+4 +c end if + if (23-ndx .lt. 10) then + notexq = notexq(1:lnote)//chax(71-ndx) + lnote = lnote+1 + else if (23-ndx .lt. 20) then + notexq = notexq(1:lnote)//'{1'//chax(61-ndx)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//chax(51-ndx)//'}' + lnote = lnote+4 + end if + if (ispstie .or. .not.tie) then +c +c Add note name for slur height +c + noctup = 0 + ncm = igetbits(isdat3(isdat),8,22) + if (ncm .eq. 23) noctup = -2 +c call notefq(noteq,lnoten,nolev,ncm) + call notefq(noteq,lnoten,islhgt,ncm) + notexq = notexq(1:lnote)//'{'//noteq(1:lnoten)//'}' + lnote = lnote+1+lnoten+1 + end if + if (ispstie) then +c +c Horizontal shift start of new thing +c + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 +c ihoff = ihoff-13 + if (tie) then + ihoff = ihoff-12 + else + ihoff = ihoff-7 + end if + if (ihoff .lt. 0) then + ihoff = -ihoff + notexq = notexq(1:lnote)//'-' + lnote = lnote+1 + end if + call writflot(ihoff*.1,notexq,lnote) + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if +c +c Add closing stuff +c + if (ispstie) then + notexq = notexq(1:lnote)//chax(92)//'off{' + * //chax(92)//'afterruleskip}' + lnote = lnote+20 + else + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + notexq = notexq(1:lnote)//chax(92)//'en%' + lnote = lnote+4 + write(11,'(a)')notexq(1:lnote) +1 continue + ispstie = .not.ispstie + return + end + subroutine littex(islur,nnl,iv,topmods,lineq,iccount) + parameter (nm=24) + common /comlast/ islast,usevshrink + logical islast,usevshrink + integer islur(nm,200) + logical topmods + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg,merge + character*128 lineq,litq + character*20 voltxtq + character*1 durq,chax + merge = .false. + if (nlit .gt. 0) then + merge = iv.eq.ivlit(nlit) .and. nnl.eq.iplit(nlit) + end if + nlit = nlit+1 + ivlit(nlit) = iv + iplit(nlit) = nnl + itype = 1 +17 call getchar(lineq,iccount,durq) + if (durq .eq. chax(92)) then + itype=itype+1 + go to 17 + end if + litq(nlit) = chax(92)//durq + lenlit(nlit) = 2 +18 call getchar(lineq,iccount,durq) + if (durq.eq.chax(92)) then + call getchar(lineq,iccount,durq) + if (durq .ne. ' ') then +c +c Starting a new tex command within the string +c + litq(nlit) = litq(nlit)(1:lenlit(nlit))//chax(92)//durq + lenlit(nlit) = lenlit(nlit)+2 + go to 18 + end if + else + litq(nlit) = litq(nlit)(1:lenlit(nlit))//durq + lenlit(nlit) = lenlit(nlit)+1 + go to 18 + end if +c +c If here, just read backslash-blank so string is done +c + if (itype .eq. 1) then + islur(iv,nnl) = ibset(islur(iv,nnl),16) + if (merge) then +c +c There are 2 separate strings on the same note, so merge them. +c + nlit = nlit-1 + litq(nlit) = litq(nlit)(1:lenlit(nlit)) + * //litq(nlit+1)(1:lenlit(nlit+1)) + lenlit(nlit) = lenlit(nlit)+lenlit(nlit+1) + if (lenlit(nlit) .gt. 128) then + print* + print*, + * 'Merged type-1 TeX strings longer than 128 characters' + write(15,'(/,a)') + * 'Merged type-1 TeX strings longer than 128 characters' + call stop1() + end if + end if + else +c +c Type 2 or 3. +c + if (itype .eq. 3) then +c +c Write the string NOW +c + if (islast) + * write(11,'(a)')litq(nlit)(1:lenlit(nlit))//'%' + else +c +c Must go at top +c + if (.not.topmods) then + topmods = .true. + open(16,status='SCRATCH') + end if +c +c Must write '%' here rather than later, in case string ends with blank. +c + write(16,'(a)')litq(nlit)(1:lenlit(nlit))//'%' + end if + nlit = nlit-1 + end if + return + end + function llen(strq,n) + character*129 strq + do 1 llen = n , 0 , -1 + if (strq(llen:llen) .ne. ' ') return +1 continue + end + function log2(n) +c +c 5/25/08 Modify to allow more slurs +c +c log2 = alog(1.*n)/0.6931472+.0001 +c log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 + log2 = dlog(1.d0*n)/0.693147181d0+.00000002d0 + return + end + subroutine logbeam(numnew,nip1,nip2) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + character*1 ulq,sepsymq,sq,ulfq,ulfbq + logical beamon,firstgulp,figbass,figchk,isfig,isxtup,btest, + * autofbon + ibm1(ivx,numnew) = nip1 + ibm2(ivx,numnew) = nip2 + numnow = numnew + if (numnew .gt. 1) then +c +c If it starts before any others, must put it in order +c + do 11 ib = numnew-1 , 1 , -1 + if (ibm1(ivx,ib) .lt. nip1) go to 12 + ibm1(ivx,ib+1) = ibm1(ivx,ib) + ibm2(ivx,ib+1) = ibm2(ivx,ib) + ulq(ivx,ib+1) = ulq(ivx,ib) + ibm1(ivx,ib) = nip1 + ibm2(ivx,ib) = nip2 + numnow = ib +11 continue +12 continue + end if + sum = 0. +c +c Beam has non-xtup within +c + nrests = 0 + isxtup = .false. + do 9 iip = nip1 , nip2 + if (btest(islur(ivx,nip1),21)) then +c +c Forced multiplicity +c + call setbits(mult(ivx,iip),4,0, + * igetbits(islur(ivx,nip1),3,22)+8) + else if (.not.isxtup) then + if (nodur(ivx,iip) .gt. 0) then + call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8) + else +c +c Start xtup within forced beam +c + isxtup = .true. + iip1 = iip + end if + else if (isxtup .and. nodur(ivx,iip).gt.0) then +c +c End of xtup within forced beam. Must count doubled notes +c + ndoub = 0 + do 1 iiip = iip1 , iip + if (btest(nacc(ivx,iiip),18)) ndoub = ndoub+1 +1 continue + multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)- + * alog(nodur(ivx,iip)/2.))/0.69315)-10 + do 74 iiip = iip1 , iip + call setbits(mult(ivx,iiip),4,0,multx+8) +c +c Note the following still works after making mult only the 1st 4 bits. +c + if (btest(nacc(ivx,iiip),18)) + * mult(ivx,iiip) = mult(ivx,iiip)-1 + if (btest(nacc(ivx,iiip),19)) then + mult(ivx,iiip) = mult(ivx,iiip)+1 + else if (iiip .gt. 1) then + if (btest(nacc(ivx,iiip-1),19)) + * mult(ivx,iiip) = mult(ivx,iiip)+1 + end if +74 continue + isxtup = .false. + end if + if (btest(irest(ivx,iip),0)) then + nrests = nrests+1 + else + sum = sum+nolev(ivx,iip) + end if +9 continue +c +c Set beam up-down-ness +c + if (ifb.gt.0 .and. ulfbq(ivx,max(1,ifb)).ne.'x') then + if (ulfbq(ivx,ifb) .eq. 'f') then +c +c Get default, then trade "l" and "u" +c + ulq(ivx,numnow) = char(225-ichar( + * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1)))) + else + ulq(ivx,ifb) = ulfbq(ivx,ifb) + end if +c +c This probably works only because forced beams are done first, so they +c don't have to be re-sorted within each voice. ???? +c + else if (nvmx(iv) .eq. 2) then +c +c Multi-voice per staff +c + if (ivx .le. nv) then + ulq(ivx,numnow) = 'l' + else + ulq(ivx,numnow) = 'u' + end if + else +c +c Defaults +c + ulq(ivx,numnow) = + * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1)) + end if + return + end + subroutine m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) +c +c This is called when (a) macro recording is just starting and +c (b) at the start of a new line, if recording is on +c + parameter (maxblks=9600) + character*128 lineq,lnholdq + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), + * ic1mac(20),ilmac,iplmac + logical mrecord,mplay,endmac + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + lbuf(1) = lbuf(1) + if (.not.mrecord) then +c +c Starting the macro +c + ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount + il1mac(macnum) = ilbuf-1 + ic1mac(macnum) = iccount + mrecord = .true. + end if + if (iccount .lt. 128) then + ndxm = index(lineq(iccount+1:128),'M') + if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M', + * 128-iccount) + if (ndxm .gt. 0) then +c +c This line ends the macro. +c + if (lineq(iccount+ndxm+1:iccount+ndxm+1) .ne. ' ') then + call errmsg(lineq,iccount+ndxm+1,ibarcnt-ibaroff+nbars+1, + * 'Improper macro termination!') + call stop1() + end if + ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm + il2mac(macnum) = ilbuf-1 + mrecord = .false. + end if + end if + return + end + subroutine make1bar(ibmrep,tglp1,tstart,cwrest,squez, + * istop,numbms,istart) + parameter (nm=24,mv=24576) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comipl2/ ipl2(nm,200) + character*10 figq + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,isfig,bar1syst + common /comeskz2/ eskz2(nm,200) + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + common /combeam/ ibmtyp + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comas2/ nasksys,wasksys(800),elasksys(800) + common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + common /comsln/ is1n1,is2n1,irzbnd,isnx + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg,autofbon + character*128 litq + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm), + * numbms(nm),mapfb(24) + real*4 xit(nm),t1xtup(20),tstart(80),squez(80) + character*1 ulfbq + character*79 inameq + character*20 voltxtq + common /comoct/ noctup + character*80 headrq,lowerq + logical cwrferm + common /comcwrf/ cwrferm(nm) + common /comnsp/ space(80),nb,prevtn(nm), + * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) + logical lower,cwrest(nm),vxtup,flgndb,btest,upslur, + * infbmx(nm),lowdot,inxtup(nm),drawbm + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /comstart/ facmtr + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac +c +c Above are factors for grace note, clef spacing. (fraction of wheadpt) +c In 1.04, moved to block data subprogram +c + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /comtol/ tol + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur, + * WrotePsslurDefaults + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /comntot/ ntot + if (ismidi) then +c +c Initialize for this bar the accidental counter for the midi file. +c naccim(icm) = # of accidentals from earlier in the bar +c + do 45 iv = 1 , nv + do 4599 kv = 1 , nvmx(iv) + naccim(midchan(iv,kv)) = 0 +4599 continue +45 continue + end if +c +c Time from start of gulp to end of bar, used with forced beams +c + tglp2 = lenb0+ibar*lenb1 + if (lenb0 .gt. 0) tglp2 = tglp2-lenb1 + tglp1 = tglp2-lenbar +c +c infbmx will only be true if in xtup that is NOT in explicit forced beam. +c + do 1 iv = 1 , nv + do 1999 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + cwrest(ivx) = .false. + infbmx(ivx) = .false. + inxtup(ivx) = .false. + if (ibar .gt. 1) then + nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1) + else + nn(ivx) = nib(ivx,ibar) + end if +1999 continue +1 continue +c +c initialize list note counter, time(iv), curr. note(iv). The loop to 4 +c ONLY initializes each voice. +c + in = 1 + nxtup = 0 + narp = 0 + do 4 iv = 1 , nv + do 4999 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + cwrferm(ivx) = .false. + cnn(ivx) = 1 + ivxo(in) = ivx + ipo(in) = cnn(ivx) + tnote(in) = fnote(nodur,ivx,1,nacc) + to(in) = 0. + xit(ivx) = tnote(in) +c +c Note that xit(ivx) is to END of note in voice, but it1xtup is start time. +c + if (nodur(ivx,ipo(in)) .eq. 0) then +c +c First note of xtuplet at start of bar in voice ivx. +c + nxtup = nxtup+1 + nxtnow(ivx) = nxtup + inxtup(ivx) = .true. + t1xtup(nxtup) = 0. +c +c Xtup at start of bar. If no explicit forced beam, start one, set +c signal infbmx, and save number ifbnow for use at termination. +c + if (nfb(ivx) .gt. 0) then + do 60 ifb = 1 , nfb(ivx) + if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then +c +c No explicit fb here; so exit loop and insert one. +c + go to 61 + else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and. + * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then +c +c IS explicit fb here; must NOT insert one +c + go to 62 + end if +60 continue + end if +61 continue +c +c If here, xtup isn't in explicit fb, so must insert one +c + infbmx(ivx) = .true. + call addfb(nfb,ivx,t1xtup(nxtup)+ + * tglp1,t1fb,t2fb,ulfbq,ifbadd) + ifbnow(ivx) = ifbadd + end if +62 continue + if (abs(xit(ivx)-lenbar) .lt. tol) xit(ivx) = 1000. + in = in+1 +4999 continue +4 continue +c +c Build the list: This is a manual loop starting at 5 +c +5 continue +c +c Determine which voice comes next from end of notes done so far. +c tmin is the earliest ending time of notes done so far +c + tmin = 1000. + do 6 iiv = 1 , nv + do 6999 kv = 1 , nvmx(iiv) + iivx = ivmx(iiv,kv) + tminn = min(tmin,xit(iivx)) + if(tminn .lt. tmin-tol) then + tmin = tminn + ivx = iivx + end if +6999 continue +6 continue + if (abs(tmin-1000.) .lt. tol) go to 7 + ivxo(in) = ivx + cnn(ivx) = cnn(ivx)+1 + ipo(in) = cnn(ivx) + to(in) = tmin +c +c Check if this voice is done +c + tnote(in) = fnote(nodur,ivx,cnn(ivx),nacc) + if (cnn(ivx) .eq. nn(ivx)) then + xit(ivx) = 1000. + else + xit(ivx) = xit(ivx)+tnote(in) + end if +c +c Flag xtups +c + if (nodur(ivx,cnn(ivx)) .eq. 0) then + if (.not.inxtup(ivx)) then +c +c First note of xtup, not at start of bar. +c + nxtup = nxtup+1 + nxtnow(ivx) = nxtup + inxtup(ivx) = .true. + t1xtup(nxtup) = xit(ivx)-tnote(in) +c +c (Note: can't be on last note in voice, so xit(ivx) <> 1000) +c Put xtuplet in a forced beam if not already in forced beam +c + if (nfb(ivx) .gt. 0) then + do 70 ifb = 1 , nfb(ivx) + if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then +c +c NO explicit bm; put one in +c + go to 71 + else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and. + * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then +c +c IS explicit bm. Don't put one +c + go to 72 + end if +70 continue + end if +71 continue +c +c If here, no explicit bm, so put one in +c + infbmx(ivx) = .true. + call addfb(nfb,ivx,t1xtup(nxtup)+tglp1, + * t1fb,t2fb,ulfbq,ifbadd) + ifbnow(ivx) = ifbadd + end if +72 continue + else if (inxtup(ivx)) then +c +c This test is sufficient because already know nodur>0 +c + inxtup(ivx) = .false. + if (infbmx(ivx)) then +c +c Xtup is in auto-forced beam, so end it +c + t2fb(ivx,ifbnow(ivx)) = + * t1xtup(nxtnow(ivx))+nodur(ivx,cnn(ivx))+tglp1 + infbmx(ivx) = .false. + end if + end if + if (btest(irest(ivxo(in),ipo(in)),24) .or. + * btest(irest(ivxo(in),ipo(in)),30)) then +c +c For staff jumped beam, flag the first note (lowest voice) at same time. +c Later will start new notes group here. +c + inj = in + if (ivxo(in) .gt. 1) then + do 40 iin = in-1 , 1 , -1 + if (to(iin)+tol .lt. to(in)) go to 41 + if (abs(to(iin)-to(in)) .lt. tol) then + inj = iin + go to 40 + end if +40 continue + end if +41 continue + irest(ivxo(inj),ipo(inj)) = ibset(irest(ivxo(inj),ipo(inj)),29) + end if + in = in+1 + go to 5 +7 continue + ntot = in-1 + do 8 in = 1 , ntot-1 + tno(in) = to(in+1)-to(in) +8 continue + tno(ntot) = tnote(ntot) +c +c Debug writes +c +c write(*,'()') +c write(*,'(a)')' Greetings from PMXB' +c write(*,'(16i5)')(ivxo(in),in=1,ntot) +c write(*,'(16i5)')(ipo(in),in=1,ntot) +c write(*,'(16f5.1)')(to(in),in=1,ntot) +c write(*,'(16f5.1)')(tno(in),in=1,ntot) +c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) +c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) +c +c Done w/ list. Loop for parsing into note blocks: +c + ib = 1 + istart(1) = 1 + space(1) = 0. + in = 1 +c +c A manual loop to set space(ib) and istop(ib) +c +9 continue + + ivx = ivxo(min(in+1,ntot)) + ip = ipo(min(in+1,ntot)) + isl = islur(ivx,ip) + if (in.eq.ntot .or. ((ivx.eq.1 .and. + * (iand(isl,67109216).gt.0 .or. btest(ipl(1,ip),28) +c * .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then +c Bits 1-13: stmgx+Tupf._) +c 14: Down fermata, was F +c 15: Trill w/o "tr", was U + * .or. btest(iornq(1,ip),4))) .or. btest(isl,15) ) +c +c Checking for start of 2nd part of jumped beam +c + * .or. btest(irest(ivx,ip),29) ) then +c +c Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam; +c flow out of if-loop and into block-wrapup +c +c 10/18/97: Problem with clef alignment. Got isl{15} set on lowest-numbered +c voice, but it wasn't first in the list at the same time. So check if +c prior notes in list have same time +c 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef +c changes on last note in the list? +c + if (btest(isl,15) .and. in.lt.ntot) then + do 50 iin = in , 1 , -1 + if (tno(iin) .gt. tol) then + in = iin + islur(ivx,ip) = ibclr(islur(ivx,ip),15) + islur(ivxo(in+1),ipo(in+1)) = + * ibset(islur(ivxo(in+1),ipo(in+1)),15) + go to 51 + end if +50 continue +51 continue + end if + if (space(ib) .lt. tol) then + space(ib) = tno(in) + squez(ib) = 1. + end if + istop(ib) = in + else if (space(ib) .lt. tol) then +c +c space hasn't been set yet, so tentatively set: +c + space(ib) = tno(in) + if (space(ib) .lt. tol) then + in=in+1 + else + squez(ib) = getsquez(in,ntot,space(ib),tnote,to) + istop(ib) = in + end if + go to 9 + else if (tno(in+1) .lt. tol) then +c +c This is not the last note in the group, so +c + in = in+1 + go to 9 + else if (abs(tno(in+1)-space(ib)) .lt. tol) then + xsquez = getsquez(in+1,ntot,space(ib),tnote,to) + if (abs(xsquez-squez(ib)) .lt. tol) then +c +c Keep spacing the same, update tentative stop point +c + in = in+1 + istop(ib) = in + go to 9 + end if + end if +c +c At this point istart and istop are good, so finalize block +c + tstart(ib) = to(istart(ib)) + if (istop(ib) .eq. ntot) go to 15 + ib = ib+1 + istart(ib) = istop(ib-1)+1 + in = istart(ib) +c +c Set tentative block space and squeeze-factor for upcoming block +c + space(ib) = tno(in) + if (space(ib).gt.tol) + * squez(ib)= getsquez(in,ntot,space(ib),tnote,to) + istop(ib) = in + go to 9 +15 continue + nb = ib +c +c Invert the list of places into ipl(0-7), making it easier to analyze a voice +c + do 13 in = 1 , ntot +c +c ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. +c +c ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) + ipl2(ivxo(in),ipo(in)) = in +13 continue +c +c Compute elemskips from start of bar to each note in the bar, for beam slopes +c + eskzb = 0. + ib = 1 + do 30 in = 1 , ntot + if (in .eq. istart(ib)) then + deskb = squez(ib)*feon(space(ib)/squez(ib)) + else if (tno(in-1) .gt. tol) then + eskzb = eskzb+deskb + end if + eskz(ivxo(in),ipo(in)) = eskzb + eskz2(ivxo(in),ipo(in)) = eskzb + if (in .eq. istop(ib)) then + eskzb = eskzb+deskb + ib = ib+1 + end if +30 continue +c +c Analyze for beams. +c + do 20 iv = 1 , nv + do 2099 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + numbms(ivx) = 0 + mapfb(1) = 0 + mapfb(2) = 0 + mapfb(3) = 0 + mapfb(4) = 0 + mapfb(5) = 0 + mapfb(6) = 0 +c +c First forced beams. +c + if (nfb(ivx) .gt. 0) then +c +c tglp2 is time from start of gulp to end of current bar. +c + nfbbar = 0 + do 80 ifb = 1 , nfb(ivx) + if (t1fb(ivx,ifb).gt.tglp2-tol) go to 81 + nfbbar = nfbbar+1 + numbms(ivx) = numbms(ivx)+1 + numnew = numbms(ivx) +c +c Times from beginning of bar +c + itbb1 = int(t1fb(ivx,ifb)-tglp1+tol) + itbb2 = int(t2fb(ivx,ifb)-tglp1+tol) + do 83 ip = 1 , nn(ivx) + if (int(to(ipl2(ivx,ip))+tol) .eq. itbb1) then + nip1fb = ip + do 84 ip1 = ip , nn(ivx) + inip1 = ipl2(ivx,ip1) + if (abs(to(inip1)+tnote(inip1)-itbb2) .lt. tol) then + nip2fb = ip1 + itbb3 = itbb2-2 + go to 85 + end if +84 continue + end if +83 continue + print* + print*,'Timing problem w/ forced beams' + write(15,'(/a)')'Timing problem w/ forced beams' +85 continue + call logbeam(numnew,nip1fb,nip2fb) +c +c Set up mapfb for forced beam just logged: +c + ib1 = itbb1/2 + ib2 = itbb3/2 + ibrep = lenbar/ibmrep/2 + do 86 irep = 1 , ibmrep + ib1now = max(0,ib1-(irep-1)*ibrep) + ib2now = min(irep*ibrep-1,ib2-(irep-1)*ibrep) + mapnow = 0 + do 87 ib = ib1now , ib2now + mapnow = ibset(mapnow,ib) +87 continue + mapfb(irep) = ior(mapfb(irep),mapnow) +86 continue +c +c Since we are cycling thru forced beams, for those that start with a rest and +c have height & slope adjustments, move adjustments to next note. +c 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at +c start of beam +c + if (btest(irest(ivx,nip1fb),0)) then + do 88 kp = nip1fb+1 , nip2fb + call setbits(ipl(ivx,kp),6,11, + * igetbits(ipl(ivx,nip1fb),6,11)) + call setbits(ipl(ivx,kp),6,17, + * igetbits(ipl(ivx,nip1fb),6,17)) + call setbits(islur(ivx,kp),2,27, + * igetbits(islur(ivx,nip1fb),2,27)) +88 continue + end if +80 continue +81 continue +c +c Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar. +c Remember, makeabar is called 1/bar, and it calls findbeam once per voice. +c + if (nfbbar .gt. 0) then + nfb(ivx) = nfb(ivx)-nfbbar + do 82 ifb = 1 , nfb(ivx) + t1fb(ivx,ifb) = t1fb(ivx,ifb+nfbbar) + t2fb(ivx,ifb) = t2fb(ivx,ifb+nfbbar) + ulfbq(ivx,ifb) = ulfbq(ivx,ifb+nfbbar) +82 continue + end if + end if + ifb = 0 +c +c Done with forced beam masks for this bar and voice. Now get normal beams. +c + call findbeam(ibmrep,numbms,mapfb) +2099 continue +20 continue + return + end + subroutine make2bar(ninow,tglp1,tstart,cwrest,squez, + * istop,numbms,istart,clefq) + parameter (nm=24,mv=24576) + common /comlast/ islast,usevshrink + logical islast,usevshrink + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comipl2/ ipl2(nm,200) + character*10 figq + character*1 ulq,sepsymq,sq,chax + logical beamon,firstgulp,figbass,figchk,isfig,bar1syst,isbjmp, + * isbj2 + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + common /combeam/ ibmtyp + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comas2/ nasksys,wasksys(800),elasksys(800) + common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + common /comsln/ is1n1,is2n1,irzbnd,isnx + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg,issig,rpndot,autofbon + character*128 litq + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + integer istart(80),istop(80),iaskb(nm),numbms(nm), + * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2) + character*1 ulfbq,udqq,clefq(nm),slurudq,udq + character*8 noteq + character*79 cwrq(nm),notexq,inameq + character*20 voltxtq + common /comoct/ noctup + character*80 soutq,headrq,lowerq + common /comnsp/ space(80),nb,prevtn(nm), + * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) + logical bspend,lower,cwrest(nm),vxtup, + * isgrace,isclef,nofirst,iscln,isdot,isflag, + * isacc,isfirst,flgndb,btest,stemup,upslur, + * isgaft,isarp,isrshft,isaccs,iscacc, + * lowdot,flipend,iscwr,isdotted,beamon1(nm) + real*4 ptgr(37),ptclef(nm),ptsndg(nm),eskndg(nm),tstart(80), + * squez(80) + logical cwrferm,drawbm + common /comcwrf/ cwrferm(nm) + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xelsk(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /comstart/ facmtr + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac +c +c Factors for grace note, clef spacing. (fraction of wheadpt) +c In 1.04, moved to block data subprogram +c + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + common /strtmid/ ihnum3,flipend(nm),ixrest(nm) + common /comtol/ tol + common /comignorenats/ mbrhgt,newmbrhgt,ignorenats + logical ignorenats,newmbrhgt + integer*2 mmidi,iinsiv + logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur + * ,WrotePsslurDefaults + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + logical slmon,dbltie + common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm), + * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl, + * slmon(0:nm),dbltie + common /comevent/ miditime,lasttime + logical kbdrests + common /comkbdrests/ levbotr(8),levtopr(8),kbdrests + logical secondgrace + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /commidisig/ midisig +c 130316 + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + common /comclefrests/ centrests + logical centrests + common /xjbeambrests/ nbrests + common /comc8flag/ c8flag(nm) + logical c8flag + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + character*4 ivxq + logical rename + common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, + * poefa + real*4 poefa(125) + logical nocodabn + nbrests = 0 +c +c Set up main ib loop within which a block (notes group) is written +c + do 25 iv = 1 , nv + do 2599 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + ibmcnt(ivx) = 1 + ibmcnt1(ivx) = 1 + beamon(ivx) = .false. + beamon1(ivx) = .false. + nornb(ivx) = 0 + iaskb(ivx) = 1 + vxtup(ivx) = .false. + drawbm(ivx) = .true. +2599 continue +25 continue + naskb = 0 + ifig(1) = 1 + ifig(2) = 1 + ixtup = 0 + bspend = .false. + iscwr = .false. + rpndot = .false. + do 16 ib = 1 , nb +c +c Check for segno +c + if (btest(iornq(1,ipo(istart(ib))),4) .and. + * ivxo(istart(ib)).eq.1) then + if (noffseg.le.-10) then + write(noteq(1:5),'(1H{,i3,1H})')noffseg + lnoten = 5 + else if (noffseg.lt.0 .or. noffseg.ge.10) then + write(noteq(1:4),'(1H{,i2,1H})')noffseg + lnoten = 4 + else + write(noteq(1:1),'(i1)')noffseg + lnoten = 1 + end if + notexq = sq//'znotes'//sq//'segnoo'//noteq(1:lnoten)//'9' + lnote = 15+lnoten + do 130 iv = 2 , nv + if (lnote .gt. 60) then + if (islast) write(11,'(a)')notexq(1:lnote)//'%' + notexq = sepsymq(iv-1)//sq//'segnoo' + * //noteq(1:lnoten)//'9' + lnote = lnoten+9 + else + notexq = notexq(1:lnote)//sepsymq(iv-1)//sq//'segnoo' + * //noteq(1:lnoten)//'9' + lnote = lnote+lnoten+9 + end if +130 continue + if (islast) write(11,'(a)')notexq(1:lnote)//sq//'en' + lnote = 0 + end if +c +c Check for new clefs +c + isclef = .false. + if (btest(islur(ivxo(istart(ib)),ipo(istart(ib))),15)) + * then +c +c In preceding line, fl32 gave wrong result for ... .gt.0 !!! +c + do 140 in = istart(ib) , istop(ib) + if (btest(islur(ivxo(in),ipo(in)),11)) then + call wsclef(ivxo(in),ninow, + * iand(ishft(islur(ivxo(in),ipo(in)),-12),7)) +c +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c +c if (clefq(ivxo(in)) .eq. '8') then + if (btest(ipl(ivxo(in),ipo(in)),2)) then +c +c Find instrument number for voice ivso(in) +c + iv1 = 1 + do 1111 iinst = 1 , ninow + if (ivxo(in) .lt. iv1+nspern(iinst)) go to 2222 + iv1 = iv1+nspern(iinst) +1111 continue + print* + print*,'Should not be here in make2bar!' + call stop1() +2222 continue + if (iinst .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol', + * iinst,sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol', + * iinst,sq//'treblelowoct%' + end if + c8flag(ivxo(in)) = .true. + end if + end if +140 continue + if (islast) write(11,'(a)')sq//'pmxnewclefs' + isclef = .true. + end if +c +c Start a notes group. We're just gonna define every one using pnotes{n}, +c where \def\pnotes#1{\vnotes#1\elemskip} +c + soutq = sq//'pnotes{' + eonsqz = squez(ib)*feon(space(ib)/squez(ib)) + if (eonsqz .gt. 9.995) then + write(soutq(9:12),'(f4.1)')eonsqz + else if (eonsqz .gt. 0.995) then + write(soutq(9:12),'(f4.2)')eonsqz + else if (eonsqz .gt. 0.095) then + soutq = soutq(1:8)//'0.' + write(soutq(11:12),'(i2)')nint(100*eonsqz) + else + soutq = soutq(1:8)//'0.0' + write(soutq(12:12),'(i1)')nint(100*eonsqz) + end if + soutq = soutq(1:12)//'}' + lsout = 13 +c +c Check whole block, flag accidentals etc that are too close, one per *time*. +c Note about bar starts and after rpt's/boublebars: There is an afterruleskip +c (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so +c (dotsfac*wheadpt) is presumed to be filled up. +c + in = istart(ib)-1 + itrpt = -1 + itsig = -1 +c +c Begin big manual loop over notes in this block; ends at 112 +c +111 in = in+1 + if (in .gt. istop(ib)) go to 112 + ip = ipo(in) + ivx = ivxo(in) + if (ivx .le. nv) then + iv = ivx + else + do 128 iv = 1 , nv + if (nvmx(iv) .eq. 2 .and. ivmx(iv,2).eq. ivx) go to 129 +128 continue + print*,'Trouble finding iv!, ivx,nvmx,ivmx:',ivx,nvmx(1),nvmx(2) + print*,ivmx(1,1),ivmx(1,2),ivmx(2,1),ivmx(2,2) + stop + end if +129 continue +c +c Call precrd here so we know how much space to add for accid's in chords +c After calling precrd, icashft>0 means there is a shifted chordal accid (incl. +c main note. +c +c To call precrd, need up-downness, so must track if in beam. +c +c Deal w/ staff-jumping beams later +c if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) +c * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. +c * btest(nacc(ivx,ip),21)) then +c if (.not.btest(irest(ivx,ip),24)) then + if ((numbms(ivx).gt.0 .and. ibmcnt1(ivx).le.numbms(ivx) + * .and. ibm1(ivx,ibmcnt1(ivx)) .eq. ip)) then + beamon1(ivx)=.true. + end if + icashft = 0 + if (btest(ipl(ivx,ip),10)) then +c +c There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. +c + if (beamon1(ivx)) then + call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), + * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt1(ivx)), + * .false.,icashft) + else + call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), + * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip), + * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv), + * .false.,icashft) + end if + end if +c +c Turn beam off? +c + if (beamon1(ivx) .and. ibm2(ivx,ibmcnt1(ivx)).eq.ip) then + beamon1(ivx) = .false. + ibmcnt1(ivx) = ibmcnt1(ivx)+1 + end if +c +c Remember, rpts & internal sigs can only come at start of (internal) block +c + isacc = iand(nacc(ivx,ip),3).gt.0 + * .and. .not.btest(nacc(ivx,ip),17) + * .and. .not.btest(ipl(ivx,ip),10) +c +c i.e., do not set for chord. Now check for "(" as ornament on main note, +c +c!!! Need to do this for chord notes too. Maybe in chkarp? +c + isaccs = isacc .or. btest(iornq(ivx,ip),0) +c +c 5/15/02 Add check for ) ornament of prior note. +c 5/16 Nope...fails when grace intervenes. +c if (ip .gt. 1) then +c isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) +c end if + isarp = btest(iornq(ivx,ip),27) + iscacc = .false. + if (btest(ipl(ivx,ip),10)) then +c +c There is a chord here; check for arpeggios and accidentals. Note accid shifts are +c not of concern here, only whether there's an accid, whick causes iscacc=.true. +c + iscacc = igetbits(nacc(ivx,ip),3,0).gt.0 .and. + * .not.btest(nacc(ivx,ip),17) + call chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp) + end if +c +c When we get motivated, will do spacing for arpeggios here. +c + if (ivx.eq.1 .and. iand(islur(ivx,ip),96).gt.0) + * itrpt = nint(to(in)) + issig = btest(ipl(ivx,ip),28) + if (ivx.eq.1 .and. issig) itsig = nint(to(in)) + isgrace = btest(islur(ivx,ip),4) .and. + * .not.btest(ipl(ivx,ip),29) .and. .not.btest(ipl(ivx,ip),31) + isgaft = .false. + if (ip .gt. 1) then + xnd = tnote(ipl2(ivx,ip-1)) + isgaft = btest(ipl(ivx,ip-1),29) .or. btest(ipl(ivx,ip-1),31) + isgrace = isgrace .or. isgaft + end if + iscln = isclef .and. btest(islur(ivx,ip),11) +c +c Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd +c + isflag = ip.gt.1 .and. xnd.gt.tol .and. xnd.lt.16.-tol + if (isflag) + * isflag = .not.btest(irest(ivx,ip-1),0) + * .and. udqq(nolev(ivx,ip-1), + * ncmid(iv,ip-1),islur(ivx,ip-1),nvmx(iv),ivx,nv).eq.'u' + if (isflag) then + do 116 ibmchk = 1 , numbms(ivx) + if (ip-1 .lt. ibm1(ivx,ibmchk)) then + go to 117 +c +c Add check for non-beamed xtuplets. May be problem with stem direction. +c + else if (ip-1.le.ibm2(ivx,ibmchk) .and. + * .not.btest(islur(ivx,ibm1(ivx,ibmchk)),18)) then + isflag = .false. + go to 117 + end if +116 continue + end if +117 continue +c +c If isflag, then won't need to check for dot on prev. note. +c +c 5/16/02 ??? Try using this for ) ornament. +c + isflag = isflag .or. btest(iornq(ivx,ip-1),13) + isdot = ip.gt.1 + if (isdot) isdot = isdotted(nodur,ivx,ip-1) + isrshft = ip .gt. 1 + if (isrshft) isrshft = btest(irest(ivx,ip-1),20) + if (.not.(isaccs.or.isgrace.or.iscln.or.isflag.or.isrshft.or. + * isdot.or.btest(iornq(ivx,ip),26).or. + * btest(irest(ivx,ip),21).or.isarp.or. + * btest(irest(ivx,ip),27).or.iscacc)) go to 111 +c +c Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. +c Compute pts, the total occupied space including prior notehead. +c +c 130324 +c wheadpt1 = wheadpt*fullsize(iv) + wheadpt1 = wheadpt*fullsize(instno(iv)) + pts = wheadpt1 +c +c Set up for possible cautionary accidental here +c + if (isaccs .or. iscacc) then + if (.not.btest(iornq(ivx,ip),31)) then + taccfac = accfac + else + taccfac = 1.4*accfac ! cautionary accidental + end if + end if + if (isgrace) then + secondgrace = .false. + do 122 ig = 1 , ngrace + if (.not. isgaft) then + if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 123 + else if (ip .gt. 1) then + if (ipg(ig).eq.ip-1 .and. ivg(ig).eq.ivx) go to 123 + end if +122 continue + print*,'Problem finding grace index in makeabar' + stop +123 continue +c +c wgr = distance to backspace (in headwidths), less main acc. +c ptgr = same in pts,+ main acc. Not used for after-grace. Distance to backspace. +c spgr = total space needed (w/o main acc). +c Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. +c + if (nng(ig) .eq. 1) then + wgr = grafac + if (multg(ig) .eq. 0) wgr = wgr-.4 + else + wgr = nng(ig)*emgfac + do 126 ing = 2 , nng(ig) + if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac +126 continue + end if + if (graspace(ig) .gt. 0.) then +c +c User-defined space before grace +c + wgr = wgr+graspace(ig) + end if + ptgr(ig) = wgr*wheadpt1 + spgr = ptgr(ig)+xb4fac*wheadpt1 +c +c!!! May need to mod for chord accid's +c + if (isaccs .or. iscacc) ptgr(ig) = ptgr(ig) + taccfac*wheadpt1 + if (naccg(ngstrt(ig)) .gt. 0) spgr = spgr+wheadpt1*agc1fac + pts = pts+spgr +c +c Special check for after-grace on ip-1 and normal on ip. Must go back thru +c loop again for the normal grace. +c + if (isgaft .and. ig.lt.ngrace .and. .not.secondgrace) then + if (ipg(ig+1).eq.ip) then + secondgrace = .true. + ig = ig+1 + go to 123 + end if + end if + end if + if (iscln) then + pts = pts+clefac*wheadpt1 +c +c How far to backspace when printing the clef +c + ptclef(ivx) = 0. +c +c!!! May need to mod for chord accid's +c + if (isaccs .or. iscacc) + * ptclef(ivx) = ptclef(ivx)+taccfac*wheadpt1 + if (isgrace) ptclef(ivx) = ptclef(ivx)+spgr + end if + if (isrshft) then + pts = pts+rtshfac*wheadpt1 + else if (isflag) then + pts = pts+flagfac*wheadpt1 + else if (isdot) then + pts = pts+dotfac*wheadpt1 + end if + if (abs(to(in)-itrpt) .lt. tol) then +c +c Repeat, need a little extra space +c + pts = pts+dotsfac*wheadpt1 + end if + if (isarp) then + pts = pts+arpfac*wheadpt1 + end if +c +c Add in padding space +c + pts = pts+xspfac*wheadpt1 +c +c Now done with all items needing space except accidentals, +c accidental shifts, and left-notehead-shifts, and will later +c subtract a notehead if at start of bar. +c +c Get available space in elemskips (esk) +c + isfirst = ip.eq.1 .or. abs(to(in)-itrpt).lt.tol .or. + * abs(to(in)-itsig).lt.tol + if (isfirst) then +c +c At start of bar or after repeat sign or new signature +c + if (abs(to(in)-itsig).lt.tol) then + esk = 0. + else + esk = fbar + end if + else +c +c Not 1st note of bar +c + esk = eskz(ivx,ip)-eskz(ivx,ip-1) + end if + if (isgrace) then +c +c Since graces can be very long, cannot assume no interference if prior +c note uses >1 noteskip. So must get elsk's back to prior note, whether or +c not it used only one noteskip. +c <>???? +c +c 10/8/05 Kluge to not zero out esk if in xtup +c + esksav = esk + if ((ip.le.2 .or. nodur(ivx,max(1,ip-2)).gt.0) .and. +c * to(in).ne.itsig) + * abs(to(in)-itsig).gt.tol) + * call eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk) + if (abs(esk) .lt. tol) esk = esksav + end if +c +c Done getting available elemskips. Remove headwidth if first. Must do here +c rather than earlier since check uses isfirst +c + if (isfirst) pts = pts-wheadpt1 +c +c Deal with accidental shifts and left-notehead shifts +c + if (btest(ipl(ivx,ip),10)) then +c +c In a chord +c + ptsl = 0. + if (btest(irest(ivx,ip),27)) ptsl = wheadpt1 + ptsadd = max(ptsl,icashft*.05*wheadpt1) +c +c Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK +c + else +c +c Not in a chord +c + ihshft = 0 + if (isaccs) then + ihshft = igetbits(nacc(ivx,ip),7,10) +c if (ihshft .ne. 0) ihshft = max(0,64-ihshft) + if (ihshft .ne. 0) ihshft = max(0,107-ihshft) + end if +c +c Check for left-shifted main note +c + if (btest(ipl(ivx,ip),8)) ihshft = max(20,ihshft) + ptsadd = ihshft*.05*wheadpt1 + end if + pts = pts+ptsadd + if (isgrace) ptgr(ig) = ptgr(ig)+ptsadd + if (iscln) ptclef(ivx) = ptclef(ivx)+ptsadd +c +c Left-shifted, non-chord note before? +c + if (ip .gt. 1) then + if (.not.btest(ipl(ivx,ip-1),10) .and. + * btest(irest(ivx,ip-1),27)) pts = pts-wheadpt1 + end if +c +c Try big accidentals first +c + ptbneed = pts + if (isaccs .or. iscacc) then + ptbneed = ptbneed+wheadpt1*bacfac + end if + if (poefa(iline)*poenom*esk .gt. ptbneed) then +c +c Set flag for big accidental +c + if (isacc) nacc(ivx,ip) = ibset(nacc(ivx,ip),3) + go to 99 + end if +c +c Cannot use big, so try small +c + ptsneed = pts + if (isaccs .or. iscacc) then + ptsneed = ptsneed+taccfac*wheadpt1 + end if + if (poefa(iline)*poenom*esk .lt. ptsneed) then + call addask(to(in),ptsneed,poefa(iline)*esk, + * fixednew,scaldold,0.,poefa(iline),.false.) + end if +99 continue + if (btest(iornq(ivx,ip),26)) then +c +c User-defined space. Warning, "zero" may change value in addask! +c + zero = 0. + call addask(to(in),ptsneed,zero, + * fixednew,scaldold,tglp1,1.,.true.) + end if +c +c End of big manual loop over "in" for accidental checking +c + go to 111 +112 continue +c +c End of ask analysis for this block. +c +c Adjust eskz if there are added spaces. Corrects length of xtup brackets. +c + if (naskb.gt.0) call adjusteskz(ib,istart,poenom) +c +c Check for internal repeat or sig change. +c + if (ib.gt.1 .and. ivxo(istart(ib)).eq.1) then + iirpt = iand(islur(1,ipo(istart(ib))),67109216) + if (iirpt .gt. 0) then +c +c Internal repeat +c + if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%' + if (iirpt .eq. 96) then + if (islast) write(11,'(a)')sq//'leftrightrepeat' + fixednew = fixednew+lrrptfac*wheadpt + else if (btest(iirpt,5)) then + if (islast) write(11,'(a)')sq//'leftrepeat' + fixednew = fixednew+rptfac*wheadpt + else if (btest(iirpt,6)) then + if (islast) write(11,'(a)')sq//'rightrepeat' + fixednew = fixednew+rptfac*wheadpt + else if (btest(iirpt,8)) then + if (islast) write(11,'(a)')sq//'doublebar' + else + print*,'Unexpected mid-bar repeat command R*' + call stop1() + end if + scaldold = scaldold-fbar + end if + if (btest(ipl(1,ipo(istart(ib))),28)) then +c +c Internal signature change. +c + notexq = sq//'generalsignature{' + lnote = 18 + if (isig .lt. 0) then + notexq = notexq(1:lnote)//'-' + lnote = lnote+1 + end if + if (islast) write(11,'(a)')notexq(1:lnote) + * //chax(48+abs(isig))//'}%' + if (islast .and. ignorenats) + * write(11,'(a)')sq//'ignorenats%' + if (islast) write(11,'(a)')sq//'zchangecontext'//sq + * //'addspace{-.5'//sq//'afterruleskip}%' + lnote = 0 + end if + end if + flgndb = .false. +c +c Done with start-of-block stuff. Begin main loop over voices. +c + do 11 iv = 1 , nv + do 1199 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + icm = midchan(iv,kv) +c +c A rather klugey way to set flag for figure in this voice +c Must always check figbass before figchk. +c + if (figbass) then + ivf = 0 + if (ivx .eq. 1) then + ivf = 1 + else if (ivx .eq. ivxfig2) then + ivf = 2 + end if + if (ivf.gt.0) figchk(ivf) = nfigs(ivf).gt.0 + end if + if (ivx .gt. 1) then + if (ivx .le. nv) then + call addstr(sepsymq(iv-1),1,soutq,lsout) + else + call addstr(sq//'nextvoice',10,soutq,lsout) + end if + end if + if (ihdht.gt.0 .and. ivx.eq.nv) then +c +c Write header. First adjust height if needed to miss barno. +c + if (bar1syst .and. iline.ne.1) then + ihdht = 15+irzbnd+isnx + end if +c +c Add user-defined vertical shift +c + ihdht = ihdht+ihdvrt + lchead = lenstr(headrq,80) + notexq = sq//'zcharnote{' + write(notexq(12:13),'(i2)')ihdht + notexq = notexq(1:13)//'}{'//sq//'bigfont'//sq//'kern-30pt ' + call addstr(notexq,34,soutq,lsout) + call addstr(headrq(1:lchead)//'}',1+lchead,soutq,lsout) + ihdht = 0 + end if + if (lower .and. ivx.eq.nv) then + lclow = lenstr(lowerq,80) + call addstr(sq//'zcharnote{-6}{'// + * sq//'tempo'//sq//'kern-10pt '// + * lowerq(1:lclow)//'}',33+lclow,soutq,lsout) + lower=.false. + end if + tnow = tstart(ib) + nofirst = .true. +c +c Done setting up voice ivx for start of block ib. Loop over notes in voice. +c + do 10 jn = istart(ib), istop(ib) + if (ivxo(jn) .ne. ivx) go to 10 + ip = ipo(jn) +c +c May have problem with not initializing islhgt, so do it here +c + islhgt = 0 +c + if (nofirst) then + noctup = 0 + if (ncmid(iv,ip) .eq. 23) noctup = -2 + nofirst = .false. + end if +c +c Check for internal floating figure (before last note of group). +c +12 if (figbass) then + if (ivx.eq.1 .or. ivx.eq.ivxfig2) then + ivf = 1 + if (ivx .gt. 1) ivf = 2 + if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.tnow-tol) + * then +c +c Bypassed figure location. Backup, place fig, return. +c + offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib) + call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq, + * lsout) + go to 12 + end if + end if + end if +c +c Put in \sk if needed +c + if (to(jn) .gt. tnow+tol) then + call addstr(sq//'sk',3,soutq,lsout) + tnow = tnow+space(ib) + go to 12 + end if +c +c Check for user-defined shifts +c + if (btest(irest(ivx,ip),15).or.btest(irest(ivx,ip),16)) + * call putshft(ivx,.true.,soutq,lsout) +21 if (iaskb(ivx).le.naskb .and. + * tnow.gt.task(iaskb(ivx))-tol) then + if (task(iaskb(ivx)) .gt. tstart(ib)-tol) then +c +c Insert placeholder for accidental skip +c + call addstr(sq//'ask ',9,soutq,lsout) + nasksys = nasksys+1 + wasksys(nasksys) = wask(iaskb(ivx)) + if (wask(iaskb(ivx)) .gt. 0.) then + elasksys(nasksys) = elask(iaskb(ivx)) + else +c +c This is a signal to permit negative ask's. Should really have elask>=0. +c + elasksys(nasksys) = -elask(iaskb(ivx)) + end if + end if +c +c May have skipped some task's in earlier blocks (due to void voice) +c + iaskb(ivx) = iaskb(ivx)+1 + go to 21 + end if + if (figbass) then + if (ivx.eq.1 .or. ivx.eq.ivxfig2) then + ivf = 1 + if (ivx .gt. 1) ivf = 2 + if (figchk(ivf) .and. + * abs(itfig(ivf,ifig(ivf))-tnow).lt.tol) then +c +c Figure on a note. NB: later special check for late figs. +c + call putfig(ivf,ifig(ivf),0.,figchk(ivf),soutq,lsout) + end if + end if + end if +c +c Check for new clef here. +c + if (isclef .and. btest(islur(ivx,ip),11)) then + if (ptclef(iv) .gt. 0.) then + notexq = sq//'off{-' + if (ptclef(iv) .lt. 9.95) then + write(notexq(7:9),'(f3.1)')ptclef(iv) + lnote = 9 + else + write(notexq(7:10),'(f4.1)')ptclef(iv) + lnote = 10 + end if + notexq = notexq(1:lnote)//'pt}' + lnote = lnote+3 + call addstr(notexq,lnote,soutq,lsout) + end if + call clefsym(islur(iv,ip),notexq,lnote,nclef) +c +c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' +c + if (btest(ipl(ivx,ip),2)) notexq = + * notexq(1:8)//'8'//notexq(10:10) + call addstr(notexq,lnote,soutq,lsout) + if (ptclef(iv) .gt. 0.) then + notexq = sq//'off{' + if (ptclef(iv) .lt. 9.95) then + write(notexq(6:8),'(f3.1)')ptclef(iv) + lnote = 8 + else + write(notexq(6:9),'(f4.1)')ptclef(iv) + lnote = 9 + end if + notexq = notexq(1:lnote)//'pt}' + lnote = lnote+3 + call addstr(notexq,lnote,soutq,lsout) + end if + end if +c +c Checking for literal TeX string BEFORE starting beams!! +c + if (btest(islur(ivx,ip),16)) then + do 124 il = 1 , nlit + if (iplit(il).eq.ip .and. ivlit(il).eq.ivx) go to 125 +124 continue + print*,'Problem finding index for literal string' + call stop1() +125 continue +c +c Write a type 1 tex string. +c + if (lenlit(il) .lt. 71) then +c +c Add normally +c + call addstr(litq(il),lenlit(il),soutq,lsout) + else +c +c Longer than 71. Write souq, Write string, start new soutq. +c + if (islast) write(11,'(a)')soutq(1:lsout)//'%' + if (islast) write(11,'(a)')litq(il)(1:lenlit(il))//'%' + lsout = 0 + end if + end if +c +c Arpeggio on a main (non-chordal) note? +c + if (btest(iornq(ivx,ip),27)) then +c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), + call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip), + * soutq,lsout) + end if +c +c See if a beam starts here +c + if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) + * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. + * btest(nacc(ivx,ip),21)) then + if (.not.btest(irest(ivx,ip),24)) then +c +c Not a jump start +c + if (kbdrests .and. btest(irest(ivx,ip),0) .and. + * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. + * nolev(ivx,ip).le.50) + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, + * mult,ipl) + call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) +c +c Shift beam start if notehead was shifted +c + if (btest(ipl(ivx,ip),8)) then + call addstr(sq//'loff{',6,soutq,lsout) + else if (btest(ipl(ivx,ip),9)) then + call addstr(sq//'roff{',6,soutq,lsout) + end if + if (lnote .gt. 0) call addstr(notexq,lnote,soutq,lsout) + if (btest(ipl(ivx,ip),8) .or. + * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) + else +c +c Jump start. Set marker for second part of a jump beam. Note ivbj2 was set +c to 0 at end of first part of jump beam +c + ivbj2 = ivx +c +c Check for xtup since we bypassed beamstrt wherein vxtup is normally set +c + if (btest(irest(ivx,ip),28) .and. ixrest(ivx).ne.2) + * vxtup(ivx) = .true. +c +c Since beamstrt is not called, and drawbm is normally set there, need to set +c it here. This could cause problems if someone tries a staff-jumping, +c unbarred beam, which I'll deal with when it comes up. +c + drawbm(ivx) = .true. + end if + if (ixrest(ivx) .eq. 0) then + beamon(ivx) = .true. + bspend = .true. + if (.not.btest(irest(ivx,ip),24))bspend = .true. + end if + end if +c +c Setup for chords and possible slurs in chords +c + if (btest(ipl(ivx,ip),10)) then +c +c There is a chord on this note. Just rerun precrd. Klunky, but saves +c me from tracking down errors instroduced when I moved 1st call +c forward for accidental spacing analysis. +c + if (beamon(ivx)) then + call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), + * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt(ivx)), + * .true.,icashft) + else + call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip), + * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip), + * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv), + * .true.,icashft) + end if + end if +c +c Is there slur or grace activity? +c + isgrace = btest(islur(ivx,ip),4) + if (ip .gt. 1) isgrace = isgrace.or.btest(ipl(ivx,ip-1),31) +c +c isgrace if not 1st note in bar and previous note has Way-after grace. +c + if (btest(islur(ivx,ip),0) .or. isgrace) then + if (btest(islur(ivx,ip),0)) then + if (fontslur) then +c +c Call routine for non-postscript slurs +c + call doslur(nolev(ivx,ip),isdat1,isdat2,isdat3,nsdat, + * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout, + * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip), + * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), + * nacc(ivx,ip)) + else +c +c Postscript slurs +c + call dopsslur(nolev(ivx,ip),isdat1,isdat2,isdat3, + * isdat4,nsdat, + * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout, + * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip), + * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), + * nacc(ivx,ip)) + end if + end if + if (isgrace) then +c +c Grace note. +c + iphold = ip + isgrace = .false. + if (ip .gt. 1) isgrace = btest(ipl(ivx,ip-1),31) + if (isgrace) iphold = iphold-1 + isgrace = isgrace .or. (.not.btest(ipl(ivx,ip),31) + * .and..not.btest(ipl(ivx,ip),29)) +c +c Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace +c on current note. Do A-grace on current note, and W-grace at barend, later. +c + if (isgrace) then + call dograce(ivx,iphold,ptgr,soutq,lsout,ncmid(iv,ip), + * nacc(ivx,ip),ig,ipl(ivx,iphold),.false., + * beamon(ivx),nolev(ivx,ip),ncmid(iv,ip), + * islur(ivx,ip),nvmx(iv),nv,ibmcnt(ivx), +c 130324 +c * tnote(ipl2(ivx,ip)),ulq) + * tnote(ipl2(ivx,ip)),ulq,instno(iv)) + if (slurg(ig)) then +c +c Terminate slur started in dograce. Get direction of main note stem +c + if (.not.beamon(ivx)) then +c +c Separate note. Get stem direction. +c + stemup = udqq(nolev(ivx,ip),ncmid(iv,ip), + * islur(ivx,ip),nvmx(iv),ivx,nv) .eq. 'u' + else +c +c In a beam +c + stemup = ulq(ivx,ibmcnt(ivx)) .eq. 'u' + end if +c +c Stop the shift if whole note +c + stemup = stemup .or. + * tnote(ipl2(ivx,ip)).gt.63 + call endslur(stemup,.not.upg(ig),nolev(ivx,ip),0, + * ndxslur,0,ncmid(iv,ip),soutq,lsout,fontslur) + end if + end if + end if + if (btest(iornq(ivx,ip),24)) then +c +c Start slur on main note for After- or Way-after-grace. +c +c???? ndxslur = log2(33554431-listslur) + ndxslur = log2(16777215-listslur) +c +c Get note name +c + call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) +c +c Get slur direction +c + slurudq = 'u' + if (.not.beamon(ivx)) then + if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv) .eq. 'u') slurudq = 'd' + else + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') slurudq = 'd' + end if +c +cc Replace ndxslur by 11-ndxslur when printing only. +c Replace ndxslur by 23-ndxslur when printing only. +c +c if (11-ndxslur .lt. 10) then + if (23-ndxslur .lt. 10) then +c notexq = sq//'islur'//slurudq//chax(59-ndxslur) + notexq = sq//'islur'//slurudq//chax(71-ndxslur) + * //noteq(1:lnoten) + call addstr(notexq,8+lnoten,soutq,lsout) + else if (23-ndxslur .lt. 20) then + notexq = sq//'islur'//slurudq//'{1'//chax(61-ndxslur) + * //'}'//noteq(1:lnoten) + call addstr(notexq,11+lnoten,soutq,lsout) + else + notexq = sq//'islur'//slurudq//'{2'//chax(51-ndxslur) + * //'}'//noteq(1:lnoten) + call addstr(notexq,11+lnoten,soutq,lsout) + end if +c call setbits(ipl(ivx,ip),4,23,ndxslur) + call setbits(ipl(ivx,ip),5,23,ndxslur) + if (btest(ipl(ivx,ip),31)) +c +c Starting slur on W-grace on THIS note. Record ndxslur. +c + * listslur = ibset(listslur,ndxslur) + end if + end if +c +c Process dynamic marks +c + if (btest(irest(ivx,ip),26)) then + call dodyn(ivx,ip, + * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip), + * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq, + * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout) + end if +c +c Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. +c + if (btest(ipl(ivx,ip),10)) then +c +c Need a duration to set type of note head +c +c Clumsy test, but vxtup is not set until main note is processed. +c + if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then + nodu = nodur(ivx,ip) + else if (btest(irest(ivx,ip),2) .or. + * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then +c +c In a 2-note tremolo +c + if (btest(irest(ivx,ip),2)) then +c +c First note of tremolo, duration is on next note +c + nodu = nodur(ivx,ip+1) + else + nodu = nodur(ivx,ip) + end if + else if (iand(mult(ivx,ip),15)-8 .lt. 0) then + nodu = 32 + else + nodu = 16 + end if + call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout, + * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv, + * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen, + * btest(nacc(ivx,ip),27),nacc(ivx,ip), + * irest) + end if +c +c Now that chords are done, add stuff to midi file +c + if (ismidi) call addmidi(icm, +c 130316 + * nolev(ivx,ip)+miditran(instno(iv)), + * iand(nacc(ivx,ip),7),midisig, + * tnote(ipl2(ivx,ip)), + * btest(irest(ivx,ip),0),.false.) +c +c Check for breath or caesura +c + if (btest(iornq(ivx,ip),28)) then + call putcb(ivx,ip,notexq,lnote) + call addstr(notexq,lnote,soutq,lsout) + end if +c +c Check for main-note ornaments. ')' on dotted notes go in with note, not here. +c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F +c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD +c +c isacc = iand(iornq(ivx,ip),4194287) .gt. 0 +c isacc = iand(iornq(ivx,ip),541065199) .gt. 0 + isacc = iand(iornq(ivx,ip),1614807023) .gt. 0 +c +c isacc=.true. if any ornament except segno +c + if (btest(iornq(ivx,ip),13) .and. nodur(ivx,ip).gt.0) then +c +c If ). is only ornament, bypass. If with others, temporarirly zero the bit. +c + if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then + if (iand(iornq(ivx,ip),516079) .eq. 0) then +c +c ). is the only non-segno ornament +c + isacc = .false. + else +c +c There are other ornaments in addition +c + rpndot = .true. + iornq(ivx,ip) = ibclr(iornq(ivx,ip),13) + end if + end if + end if + if (isacc .and. .not.cwrferm(ivx)) then +c +c Check for centered whole-bar rest with fermata (bits 10 or 14). +c + if (iand(iornq(ivx,ip),17408).gt.0 + * .and. btest(irest(ivx,ip),0) .and. + * nodur(ivx,ip).eq.lenbar .and. + * .not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)) then + cwrferm(ivx) = .true. + go to 30 + end if + call putorn(iornq(ivx,ip),nolev(ivx,ip),nolev(ivx,ip), + * nodur(ivx,ip),nornb,ulq,ibmcnt(ivx),ivx,ncmid(iv,ip), + * islur(ivx,ip),nvmx(iv),nv,ihornb,stemlen, + * notexq,lnote,ip,islhgt,beamon(ivx), + * btest(ipl(ivx,ip),10)) + call addstr(notexq,lnote,soutq,lsout) + end if + if (rpndot) then + iornq(ivx,ip) = ibset(iornq(ivx,ip),13) + rpndot = .false. + end if +30 continue +c +c Check for main note accidental +c + if (iand(nacc(ivx,ip),3).gt.0 .and. + * .not.btest(nacc(ivx,ip),17)) then + ihshft = igetbits(nacc(ivx,ip),7,10) + if (ihshft .ne. 0) ihshft=ihshft-107 + if (.not.btest(ipl(ivx,ip),10) .and. btest(ipl(ivx,ip),8)) +c +c Not a chord, and left-shifted main note, so left-shift accid +c + * ihshft = ihshft-20 + call doacc(ihshft,igetbits(nacc(ivx,ip),6,4), + * notexq,lnote,nacc(ivx,ip),nolev(ivx,ip),ncmid(iv,ip), + * btest(irest(ivx,ip),31)) + call addstr(notexq,lnote,soutq,lsout) + end if +c +c Lower dot for lower-voice notes. Conditions are: +c 1. Dotted time value +c 2. Lower voice of two +c 3. Note is on a line +c 4. Not a rest +c. 5. Flag (lowdot) is set to true +c 6. Not in an xtuplet +c + if (lowdot .and. nvmx(iv).eq.2 .and. ivx.le.nv + * .and. nodur(ivx,ip).ne.0) then + if (.not.btest(irest(ivx,ip),0) .and. + * 2**log2(nodur(ivx,ip)).ne.nodur(ivx,ip) .and. + * mod(nolev(ivx,ip)-ncmid(ivx,ip),2).eq.0) then + if (btest(irest(ivx,ip),19)) then +c +c Note already in movdot list. Drop by 2. +c + updot(ivx,ndotmv(ivx)+1) = + * updot(ivx,ndotmv(ivx)+1)-2. + else +c +c Not in list so just move it right now +c + call dotmov(-2.,0.,soutq,lsout, + * igetbits(islur(ivx,ip),1,3)) + end if + end if + end if +c +c Check for dotted main notes with moved dots. Chord notes done elsewhere. +c Added check rules out special chordal 2nds, but later must check +c substituted chord note for dot shift that now applies to main note. +c + if (btest(irest(ivx,ip),19)) then + ndotmv(ivx) = ndotmv(ivx)+1 + call dotmov(updot(ivx,ndotmv(ivx)),rtdot(ivx,ndotmv(ivx)), + * soutq,lsout,igetbits(islur(ivx,ip),1,3)) + end if +c +c Stemlength changes +c + if (btest(mult(ivx,ip),27)) then + dstemlen = igetbits(mult(ivx,ip),6,10)*.5-4. + call addstr(sq//'stdstemfalse',13,soutq,lsout) + stemshort = 4.66+.667*dstemlen + call addstr(sq//'stemlength{',12,soutq,lsout) + write(notexq,'(f4.1)')stemshort + call addstr(notexq(1:4)//'}',5,soutq,lsout) + else if (ip .gt. 1) then + if (btest(mult(ivx,ip-1),27)) +c +c Cancel shortening. Looks like it gets automatically restored if new inst. or +c new line, so no need to worry about affecting other lines +c + * call addstr(sq//'stemlength{4.66}',17,soutq,lsout) + end if +c +c Zero out slur-height marker for raising ornaments +c + islhgt = 0 +c +c Now start with spacing notes. Is a beam start pending? +c + if (bspend .and. + * ibm2(ivx,ibmcnt(ivx)).gt.ibm1(ivx,ibmcnt(ivx))) then + if (ixrest(ivx) .eq. 4) then +c +c Special path for single note at end of otherwise beamed xtup +c + ixrest(ivx) = 0 + else + if (kbdrests .and. btest(irest(ivx,ip),0) .and. + * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. + * nolev(ivx,ip).le.50) + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, + * mult,ipl) + if (btest(islur(ivx,ip),29) + * .and.btest(irest(ivx,ip),24)) then + notexq = chax(92)//'sk' + lnote = 3 + else + call beamn1(notexq,lnote) +c if (isbjmp .and. + if (isbjmp .and. ivbj2.ne.0 .and. + * iand(mult(ivx,ip),15)-8 .gt. multbj1) then +c +c Need to increase multiplicity at the beam jump +c +c ibmcnt was increased by 1 at the end of first seg of jump beam!? +c Try adding e.g. \nbbu1 if needed to increase multiplicity. Add +c character in reverse order to start of notexq. +c + if (ivbj1 .lt. 9) then + notexq = char(48+ivbj1)//notexq(1:lnote) + lnote = lnote+1 + else + notexq = '{1'//char(38+ivbj1)//'}' + * //notexq(1:lnote) + lnote = lnote+4 + end if + notexq = 'bb'//ulq(ivbj1,ibmcnt(ivbj1)-1) + * //notexq(1:lnote) + lnote = lnote+3 + if (iand(15,mult(ivx,ip))-8 .eq. 3) then + notexq = 'b'//notexq(1:lnote) + lnote = lnote+1 + end if + notexq = sq//'n'//notexq(1:lnote) + lnote = lnote+2 + end if + end if + end if + bspend = .false. +c +c Is a beam ending? +c + else if (numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) + * .and. (ibm2(ivx,ibmcnt(ivx)).eq.ip .or. + * btest(nacc(ivx,ip),20))) then + if (bspend) then +c +c Must be a single-note ending of a jump-beam +c + bspend = .false. + end if + call beamend(notexq,lnote) + if (isbjmp .and. ivx.eq.ivbj1) then +c +c Jump beam segment is ending, check if multiplicity DECREASES +c + if (space(ib+1) .gt. space(ib)) then +c +c Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8. +c + if (ivx .lt. 10) then + ivxq = char(ivx+48) + livx = 1 + else + ivxq = '{1'//char(ivx-10)//'}' + livx = 4 + end if +c Changes to get staffcrossall.pmx to work. Not clear how. +c if (nint(space(ib+1)-space(ib)) .eq. 6) then + if (space(ib+1).eq.8..and.space(ib).eq.2.) then + notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))// + * ivxq(1:livx)//sq//'tbb'// + * ulq(ivx,ibmcnt(ivx))//ivxq(1:livx)//notexq(1:lnote) + lnote = lnote+11+2*livx +c else if (nint(space(ib+1)-space(ib)) .eq. 4) then + else if (space(ib+1).eq.8..and.space(ib).eq.4.) then + notexq = sq//'tbb'//ulq(ivx,ibmcnt(ivx))// + * ivxq(1:livx)//notexq(1:lnote) + lnote = lnote+5+livx +c else + else if (space(ib+1).eq.4..and.space(ib).eq.2.) then + notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))// + * ivxq(1:livx)//notexq(1:lnote) + lnote = lnote+6+livx + end if + end if + end if + if (.not.btest(nacc(ivx,ip),20)) then + vxtup(ivx) = .false. + nornb(ivx) = 0 + ibmcnt(ivx) = ibmcnt(ivx)+1 + beamon(ivx) = .false. + end if +c +c Or if we're in the middle of a beam +c + else if (numbms(ivx).gt.0 .and. beamon(ivx)) then +c +c Added 130127 +c + if (kbdrests .and. btest(irest(ivx,ip),0) .and. + * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. + * nolev(ivx,ip).le.50) + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, + * mult,ipl) + call beamid(notexq,lnote) +c +c Or whole-bar rest +c + else if (btest(irest(ivx,ip),0) + * .and. nodur(ivx,ip).eq.lenbar + * .and..not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0) + * .and..not.btest(irest(ivx,ip),25) + * .and..not.btest(islur(ivx,ip),29)) then +c +c Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp +c + cwrest(ivx) = .true. + iscwr = .true. + call notex(cwrq(ivx),lcwr(ivx)) + tnow = tnow+lenbar + go to 10 + else if (ixrest(ivx) .eq. 0) then +c +c Before writing note or rest, check for keyboard rest height adjustment. +c Conditions are 0. This is a non-blank rest +c 1. kbdrests = .true. +c 2. There are two voices on the staff +c 3. No user-def height adjustments have been applied (nolev<50) +c + if (kbdrests .and. btest(irest(ivx,ip),0) .and. + * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. + * nolev(ivx,ip).le.50) then + call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, + * mult,ipl) + end if + if (btest(ipl(ivx,ip),4)) then +c +c Deal with single stem tremolo +c Get up-downness, borrowed from notex +c + if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv).eq.'u') then + udq = 'u' + else + udq = 'l' + end if + multtrem = igetbits(ipl(ivx,ip),2,5)+1 + if (nodur(ivx,ip) .lt. 64) then + notexq = sq//'tr' + else + notexq = sq//'Tr' + end if + lnote = 3 + if (multtrem .eq. 2) then + notexq = notexq(1:3)//'r' + lnote = 4 + else if (multtrem .eq.3) then + notexq = notexq(1:3)//'rr' + lnote = 5 + end if +c +c Get a numerical pitch argument +c + lineno = nolev(ivx,ip)-ncmid(iv,ip)+4 + if (lineno .lt.0 .or. lineno .gt.9) then + write(noteq,'(a1,i2,a1)')'{',lineno,'}' + lnoten = 4 + else + noteq = char(lineno+48) + lnoten = 1 + end if + notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten) + lnote = lnote+2+lnoten + call addstr(notexq,lnote,soutq,lsout) + end if +c +c Get code for a separate note or rest +c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), +c pitch will be shifted +/-1 inside notex. +c + call notex(notexq,lnote) + end if +c +c Right offset? This may cause trouble +c + if (btest(ipl(ivx,ip),8)) then + call addstr(sq//'loff{',6,soutq,lsout) + else if (btest(ipl(ivx,ip),9)) then + call addstr(sq//'roff{',6,soutq,lsout) + end if + if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then + call addstr(notexq,lnote,soutq,lsout) + end if + if (btest(ipl(ivx,ip),8) .or. + * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) +c +c Terminate user-defined offsets. Fix format +c + if (btest(irest(ivx,ip),15) .or. btest(irest(ivx,ip),17)) + * call putshft(ivx,.false.,soutq,lsout) +c +c Deal with After- and Way-after-graces. First, if end of bar, compute space +c needed since it wasn't done during general ask-checks. If extra space is +c rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. +c But will still need to add extra space as hardspace. +c + if (ip.eq.nn(ivx) .and. (btest(ipl(ivx,ip),31).or. + * btest(ipl(ivx,ip),29))) then + do 77 ig = 1 , ngrace + if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 78 +77 continue + print*,'Problem finding grace index at "do 77"' + call stop1() +78 continue +c +c Get elemskip to end of bar. WON'T WORK IF XTUPS !! +c + esk = 0. + do 40 iib = ib , nb + if (iib .eq. ib) then + itleft = nint(to(ipl2(ivx,ip))) + else + itleft = nint(tstart(ib)) + end if + if (iib .lt. nb) then + itright = nint(tstart(iib+1)) + else + itright = lenbar + end if + esk = esk+feon(space(ib))* + * (itright-itleft)/space(ib) +40 continue + ptsavail = poenom*esk-wheadpt + if (nng(ig) .eq. 1) then + wgr = grafac + else + wgr = nng(ig)*emgfac + do 41 ing = 1 , nng(ig) + if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac +41 continue + end if + ptgr(ig) = wgr*wheadpt + ptsneed = (wgr+0.5)*wheadpt + ptsndg(ivx) = 0. + if (ptsavail .lt. ptsneed) then + ptsndg(ivx) = ptsneed + eskndg(ivx) = esk + if (btest(ipl(ivx,ip),31)) then +c +c Convert GW to GA +c + ipl(ivx,ip) = ibset(ibclr(ipl(ivx,ip),31),29) + end if + end if + end if +c +c Check for GA +c + if (btest(ipl(ivx,ip),29)) + * call dograce(ivx,ip,ptgr,soutq,lsout,ncmid(iv,ip), + * nacc(ivx,ip),ig,ipl(ivx,ip),.false., +c 130324 +c * .false.,0,0,0,0,0,0,0.,ulq) + * .false.,0,0,0,0,0,0,0.,ulq,instno(iv)) +c +c Update running time +c + tnow = tnow+space(ib) +10 continue +c +c Have finished last note in this voice and block +c + itendb = nint(to(istop(ib))+space(ib)) + if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then + ivf = 1 + if (ivx .gt. 1) ivf = 2 +17 if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.itendb) then +c +c There's at least one figure left. offnsk could be <0 +c + offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib) + call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,lsout) + go to 17 + end if + end if +c +c Check for flag, dot, or upstem on last note of bar. +c + if (ib .eq. nb) then + ip = ipo(ipl2(ivx,nn(ivx))) + flgndv(ivx) = 0. + if (abs(tnote(ipl2(ivx,ip))-space(ib)).lt.tol) then + if (space(ib) .lt. 16.-tol) then +c +c Note in last space, smaller than a quarter note. +c + if ((.not.btest(irest(ivx,ip),0) .and. + * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv).eq.'u') + * .or. isdotted(nodur,ivx,ip)) then +c +c Upstem non-rest, or dotted +c + if (numbms(ivx).gt.0 + * .and. ip.eq.ibm2(ivx,max(1,numbms(ivx))) + * .and. .not.isdotted(nodur,ivx,ip)) + * then +c +c In beam and not dotted, so use smaller space +c + flgndv(ivx) = upstmfac + else + flgndv(ivx) = flagfac + end if + end if + else +c +c Last space, nonflagged (no beam) only worry dot or up +c + if (isdotted(nodur,ivx,ip)) then + flgndv(ivx) = flagfac + else if (tnote(ipl2(ivx,ip)).lt.64 .and. + * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv).eq.'u') then +c +c Upstem on last note , non-flagged +c + flgndv(ivx) = upstmfac + end if + end if + end if +c +c Check for right-shifted chordal note +c + if (btest(irest(ivx,ip),20)) flgndv(ivx) = rtshfac + flgndb = flgndb .or. flgndv(ivx).gt.0. + if (ismidi) then +c +c For midi, set flags for accidentals on last note of bar. Assume they affect +c first note of next bar whether or not tied. +c Note has already been done, so next entry into addmidi is 1st in new bar. +c First do main note, then chord notes +c +c Gyrations needed to account for multi-bar tied full-bar notes? +cc Old old lbacc(icm) = iand(nacc(ivx,ip),7) +c New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) +c + if (iand(nacc(ivx,ip),7) .gt. 0) then +c +c Explicit accidental on last main note in bar +c + do 55 kacc = 1 , naccbl(icm) + if (laccbl(icm,kacc) .eq. nolev(ivx,ip)) go to 56 +55 continue + naccbl(icm) = naccbl(icm)+1 + laccbl(icm,naccbl(icm)) = nolev(ivx,ip) + jaccbl(icm,naccbl(icm)) = iashft(iand(nacc(ivx,ip),7)) + end if +56 continue + if (btest(ipl(ivx,ip),10) .and. crdacc) then + do 57 icrd = icrd1 , icrd2 + iacc = igetbits(icrdat(icrd),3,20) + if (iacc .gt. 0) then +c +c Explicit accidental on chord note at end of bar +c + nolevc = igetbits(icrdat(icrd),7,12) + do 58 kacc = 1 , naccbl(icm) + if (laccbl(icm,kacc) .eq. nolevc) go to 59 +58 continue + naccbl(icm) = naccbl(icm)+1 + laccbl(icm,naccbl(icm)) = nolevc + jaccbl(icm,naccbl(icm)) = iashft(iacc) + end if +59 continue +57 continue + end if +c if (lbacc(icm).eq.0 .and. accb4(icm)) then + do 65 kacc = 1 , naccim(icm) +c +c If naccim(icm)>0, +c possible implicit accidental from earlier in the bar. Check for prior accid +c in this bar at relevant note levels, main and chord notes. Only act if no +c explicit action from just above. Assuming any accid on last note in bar, +c either explicit or implicit, has same effect on 1st note of next bar. +c + if (nolev(ivx,ip) .eq. laccim(icm,kacc)) go to 66 + if (btest(ipl(ivx,ip),10)) then + do 67 icrd = icrd1 , icrd2 + if (iand(ishft(icrdat(icrd),-12),127) .eq. + * laccim(icm,kacc)) go to 66 +67 continue + end if + go to 65 +66 continue +c +c So far we know there is a main or chord note at level laccim(icm,kacc). So +c it will get a bl-accid if it didn't just already get one. +c + do 68 macc = 1 , naccbl(icm) + if (laccbl(icm,macc) .eq. laccim(icm,kacc)) go to 65 +68 continue + naccbl(icm) = naccbl(icm)+1 + laccbl(icm,naccbl(icm)) = laccim(icm,kacc) + jaccbl(icm,naccbl(icm)) = jaccim(icm,kacc) +65 continue + end if + end if +1199 continue +11 continue +c +c Close out the notes group +c + call addstr(sq//'en',3,soutq,lsout) + if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%' +16 continue +c +c Check for way-after graces at end of bar. We could not link these to notes +c as in midbar since there is no note following grace! Also, set flag if +c hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. +c + isgrace = .false. + do 75 iv = 1 , nv + nvmxsav(iv) = nvmx(iv) + do 7599 kv = 1 , nvmx(iv) + ivmxsav(iv,kv) = ivmx(iv,kv) + ivx = ivmx(iv,kv) + ptsgnd = 0. + if ((btest(ipl(ivx,nn(ivx)),29).or.btest(ipl(ivx,nn(ivx)),31)) + * .and. ptsndg(ivx).gt.0.) then + flgndb = .true. + if (ptsndg(ivx) .gt. ptsgnd) then + ptsgnd = ptsndg(ivx) + eskgnd = eskndg(ivx) + end if + end if + if (btest(ipl(ivx,nn(ivx)),31)) then +c +c This voice has a way-after grace here at end of bar +c + if (.not.isgrace) then +c +c This is the first one, so set up the string +c + isgrace = .true. + ivlast = 1 + soutq = sq//'znotes' + lsout = 7 + end if + do 76 iiv = ivlast , iv-1 + call addstr(sepsymq(iiv),1,soutq,lsout) +76 continue + ivlast = iv +c +c No need to put in 'nextvoice', even if 2 lines/staff +c + call dograce(ivx,nn(ivx),ptgr,soutq,lsout,ncmid(iv,nn(ivx)), + * nacc(ivx,nn(ivx)),ig,ipl(ivx,nn(ivx)),.true., +c 130324 +c * .false.,0,0,0,0,0,0,0.,ulq) + * .false.,0,0,0,0,0,0,0.,ulq,instno(iv)) + end if +7599 continue +75 continue + if (isgrace) then + call addstr(sq//'en%',4,soutq,lsout) + if (islast .and. lsout .gt. 0) write(11,'(a)')soutq(1:lsout) + end if + lsout = 0 +c +c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest +c This has to be the only use of atnextbar +c + if (ibar.eq.ibarmbr .and. islast) then + if (newmbrhgt) then + soutq = sq//'def'//sq//'mbrhgt{' + if (mbrhgt .le. -10) then + write(soutq(13:15),'(i3)')mbrhgt + lsout = 15 + else if (mbrhgt.ge.10.or.mbrhgt.le.-1) then + write(soutq(13:14),'(i2)')mbrhgt + lsout = 14 + else + soutq = soutq(1:12)//char(48+mbrhgt) + lsout = 13 + end if + soutq = soutq(1:lsout)//'}%' + write(11,'(a)')soutq(1:lsout+2) + newmbrhgt = .false. + end if + soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes' + lsout = 22 + notexq = sq//'mbrest' + lnote = 7 + call istring(mbrest,noteq,len) + notexq = notexq(1:lnote)//noteq(1:len) + lnote = lnote+len + mtrspc = nint(xb4mbr) + xb4mbr = 0. + call istring(mtrspc,noteq,len) + notexq = notexq(1:lnote)//noteq(1:len)//'0' + lnote = lnote+len+1 + do 62 iv = 1 , nv + call addstr(notexq,lnote,soutq,lsout) + if (iv .lt. nv) call addstr(sepsymq(iv),1,soutq,lsout) +62 continue + call addstr(sq//'en}%',5,soutq,lsout) + write(11,'(a)')soutq(1:lsout) + lsout = 0 + if (ishort .gt. 0) then + mbrsum = mbrsum+mbrest + nmbr = nmbr+1 + end if + if (mbrest .gt. 1) then + ndig = int(alog10(mbrest-1+.01))+1 + write(11,'(a14,i'//chax(48+ndig)//',a1)') + * sq//'advance'//sq//'barno',mbrest-1,'%' + end if + else if (iscwr) then +c +c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar +c to check for new clef and add space by redefining \CenterBar +c + centrests = .true. + call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout) + call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22, + * soutq,lsout) + do 60 iv = 1 , nv +c added + lnote = 0 +c + do 61 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + if (cwrest(ivx)) then + call addstr(sq//'CenterBar{',11,soutq,lsout) + if (.not.cwrferm(ivx)) then + if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then +c +c Kluge to use new definitions for centered, stacked rests +c + if (cwrq(ivx)(2:10).eq.'liftpause' .or. + * cwrq(ivx)(2:10).eq.'liftPAuse') + * cwrq(ivx)(10:10) = 'c' + end if + call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq, + * lsout) + call addstr('}{-2}{'//sq//'value}',13,soutq,lsout) + else +c +c Fermata on centered rest. Will need to fix up level. +c 12/6/07 shift it left so it's centered over rest +c + notexq = notexq(1:lnote)//sq//'loffset{.33}{' + * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx)) + * //'}{-2}{'//sq//'value}' + lnote = lnote+26+lcwr(ivx)+13 + call addstr(notexq,lnote,soutq,lsout) + cwrferm(ivx) = .false. + end if + end if +61 continue + if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout) +60 continue + if (islast) then + call addstr(sq//'en}%',5,soutq,lsout) + if (lsout.gt.0)write(11,'(a)')soutq(1:lsout) + end if + end if +c +c End of block for centered whole-bar rests and multi-bar rests +c +c If at end of block, save durations of last notes in bar, for possible use +c if clef changes at start of next bar +c + if (ibar .eq. nbars) then + do 63 iv = 1 , nv + do 6399 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + prevtn(ivx) = tnote(ipl2(ivx,nn(ivx))) +6399 continue +63 continue + end if +c +c Update time for midi. This is only used for the event track +c + if (ismidi) then + miditime = miditime+15*lenbar +c +c If pickup, write the real time signature to the event track. Cannot use +c mtrnuml since it was reset to 0, have to recompute it +c + if (lenb0 .eq. lenbar) + * call midievent('m',mtrdenl*lenb1/64,mtrdenl) + end if + return + end + subroutine makeabar() +c +c On input, have pseudo-durations in nodur(ivx,ip). Not real durations for +c xtups, since only last note of xtup gets non-zero nodur, which +c corresponds to single note of full length of xtup. +c In this subroutine we make an ordered list of all notes in all voices. +c ilnc = list note counter +c ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note. +c to(ilnc) = real start time of note in PMX-units (64=whole note) +c tno(ilnc) = time to next event in the bar. +c tnote(ilnc) = actual duration of note +c Then run thru list, grouping consecutive notes into \notes groups ib. +c space(ib) = real time unit for the \notes group +c squez(ib) = factor on space to get effective space. This will be 1 if +c there is a note exactly spanning each interval of space, and +c <1 if not. +c Details: let eon = elemskips per noteskip (like length). Basic formula is +c eon = sqrt(space/2.) +c If tgovern >= space, then +c eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern). +c Time needed to give this eon using basic formula is +c teq = space**2/tgovern +c Factor on space to get teq is +c squez(ib) = space/tgovern +c The eon for each ib can then be computed based on time of space*squez. +c Iff squez = 1, there is a note spanning every increment in the \notes group. +c +c tnminb = minimum time span in the bar for increments spanned by notes, +c i.e., with squez=1. Use after parsing into line to decide if +c spacing needs to be "flattened" among notes groups. +c + common /comtol/ tol + parameter (nm=24,nkb=3999,maxblks=9600) + common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), + * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, + * nbars,itsofar(nm),nib(nm,15),nn(nm), + * rest(nm,200),lenbr0,lenbr1,firstline,newmeter + common /linecom/ elskb,tnminb(nkb) + common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), + * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) + common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) + logical rest,firstline,newmeter + integer cnn(nm),istart(80),istop(80) + real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600) + elskb = 0. + tnminb(ibarcnt) = 1000. + do 1 iv = 1 , nv + do 1999 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + if (ibar .gt. 1) then + nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1) + else + nn(ivx) = nib(ivx,ibar) + end if +1999 continue +1 continue +c +c initialize list note counter, time(iv), curr. note(iv) +c + ilnc = 1 + do 4 iv = 1 , nv + do 4999 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + cnn(ivx) = 1 + ivxo(ilnc) = ivx + ipo(ilnc) = 1 + to(ilnc) = 0. + tnote(ilnc) = fnote(nodur,ivx,1,nacc) + xit(ivx) = tnote(ilnc) + if (abs(xit(ivx)-lenbar).lt.tol) xit(ivx) = 1000. + ilnc = ilnc+1 +4999 continue +4 continue +c +c Build the list +c +5 continue +c +c Determine which voice comes next from end of notes done so far. +c tmin is the earliest ending time of notes done so far +c + tmin = 1000. + do 6 iv = 1 , nv + do 6999 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + tminn = min(tmin,xit(ivx)) + if(tminn .lt. tmin) then + tmin = tminn + ivnext = ivx + end if +6999 continue +6 continue + if (tmin .gt. 999.) go to 7 + ivxo(ilnc) = ivnext + cnn(ivnext) = cnn(ivnext)+1 + ipo(ilnc) = cnn(ivnext) + to(ilnc) = tmin +c +c Check if this voice is done +c + tnote(ilnc) = fnote(nodur,ivnext,cnn(ivnext),nacc) + if (cnn(ivnext) .eq. nn(ivnext)) then + xit(ivnext) = 1000. + else + xit(ivnext) = xit(ivnext)+tnote(ilnc) + end if + ilnc = ilnc+1 + go to 5 +7 continue + ntot = ilnc-1 + if (ntot .gt. 600) then + call printl(' ') + call printl('Cannot have more than 600 notes per bar, stopping') + call stop1() + end if + do 8 in = 1 , ntot-1 + tno(in) = to(in+1)-to(in) +8 continue + tno(ntot) = fnote(nodur,ivxo(ntot),ipo(ntot),nacc) + tnote(ntot) = tno(ntot) +c +c Debug writes +c +c write(*,'()') +c write(*,'(16i5)')(ivxo(in),in=1,ntot) +c write(*,'(16i5)')(ipo(in),in=1,ntot) +c write(*,'(16f5.1)')(to(in),in=1,ntot) +c write(*,'(16f5.1)')(tno(in),in=1,ntot) +c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) +c write(*,'(16f5.1)')(tnote(in),in=1,ntot) +c +c Done w/ list. Initialize loop for building note blocks: +c + ib = 1 + istart(1) = 1 + space(1) = 0. + in = 1 +c +c Start the loop +c +9 continue + if (in .eq. ntot) then + if (space(ib) .lt. tol) then + space(ib) = tno(in) +c +c Last gap in bar is spanned by a note, so cannot need a squeeze. +c + squez(ib) = 1. + end if + istop(ib) = ntot +c +c From here flow out of this if block and into block-setup +c + else if (space(ib) .lt. tol) then +c +c space hasn't been set yet, so tentatively set: +c + space(ib) = tno(in) + if (space(ib) .lt. tol) then + in=in+1 + else +c +c Tentative space tno(in) is non-zero. Set squez, which will be kept (since +c it is a unique property of the particular increment starting here) : +c + squez(ib) = getsquez(in,ntot,space(ib),tnote,to) + istop(ib) = in + end if + go to 9 + else if (tno(in+1) .lt. tol) then +c +c This is not the last note in the space, so +c + in = in+1 + go to 9 + else if (abs(tno(in+1)-space(ib)) .lt. tol) then +c +c Next increment has same space. Does it have same squez? +c + xsquez = getsquez(in+1,ntot,space(ib),tnote,to) +c +c If it does have the same squez, loop, otherwise flow out +c + if (abs(xsquez-squez(ib)) .lt. tol) then +c +c Keep spacing the same, update tentative stop point +c + in = in+1 + istop(ib) = in + go to 9 + end if + end if +c +c At this point istart, istop, space, and squez are good, so close out block +c + tstart(ib) = to(istart(ib)) +c +c Compute elemskips assuming no flattening to increase min space. The formula +c is only correct if f1eon(t) = sqrt(t/2); more generally (after possible +c flattening in pmxb), elsperns = squez*feon(space/squez) +c + elsperns = f1eon(space(ib)*squez(ib)) + if (istop(ib) .eq. ntot) then + nnsk = nint((lenbar-tstart(ib))/space(ib)) + else + nnsk = nint((to(istop(ib)+1)-tstart(ib))/space(ib)) + end if + elskb = elskb+elsperns*nnsk + if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then + call catspace(space(ib),squez(ib),nnsk) + else +c +c This is the first entry for this bar +c + nnpd(nptr(ibarcnt)) = nnsk + durb(nptr(ibarcnt)) = space(ib) + sqzb(nptr(ibarcnt)) = squez(ib) + nptr(ibarcnt+1) = nptr(ibarcnt+1)+1 + end if +c +c Update minimum space spanned by a note +c + if (abs(squez(ib)-1) .lt. tol) + * tnminb(ibarcnt) = min(tnminb(ibarcnt),space(ib)) + if (istop(ib) .eq. ntot) go to 15 +c +c End of spatial accounting for now +c + ib = ib+1 + istart(ib) = istop(ib-1)+1 + in = istart(ib) +c +c Set tentative block space for new block +c + space(ib) = tno(in) + if (space(ib).gt.tol) + * squez(ib)= getsquez(in,ntot,space(ib),tnote,to) + istop(ib) = in + go to 9 +15 continue +c nb = ib +c +c Debug writes +c +c write(*,'(16i5)')(istart(ib),ib=1,nb) +c write(*,'(16i5)')(istop(ib),ib=1,nb) +c write(*,'(16f5.1)')(space(ib),ib=1,nb) +c write(*,'(16f5.1)')(squez(ib),ib=1,nb) +c + return + end + subroutine midievent(typeq,in1,in2) +c +c We now store "conductor" events in mmidi(numchan,.), and count bytes +c with imidi(numchan) +c + parameter (nm=24,mv=24576) + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /comevent/ miditime,lasttime + character*1 typeq + idur = isetvarlen(miditime-lasttime,nbytes) + imidi(numchan) = imidi(numchan)+nbytes+1 + do 1 i = 1 , nbytes + mmidi(numchan,imidi(numchan)-i) = mod(idur,256) + idur = ishft(idur,-8) +1 continue + mmidi(numchan,imidi(numchan)) = 255 + if (typeq .eq. 't') then +c +c Tempo event. in1 = quarters per minute (integer) +c + mmidi(numchan,imidi(numchan)+1) = 5*16+1 + mmidi(numchan,imidi(numchan)+2) = 3 + misperq = nint(60000000./in1) + do 2 i = 1 , 3 + mmidi(numchan,imidi(numchan)+6-i) = mod(misperq,256) + misperq = ishft(misperq,-8) +2 continue + imidi(numchan) = imidi(numchan)+5 + else if (typeq .eq. 'm') then +c +c Meter event. in1=numerator, in2=denom (power of 2) +c + mmidi(numchan,imidi(numchan)+1) = 5*16+8 + mmidi(numchan,imidi(numchan)+2) = 4 + mmidi(numchan,imidi(numchan)+3) = in1 + if (in2 .gt. 0) then + mmidi(numchan,imidi(numchan)+4) = log2(in2) + else + mmidi(numchan,imidi(numchan)+4) = 0 + end if + mmidi(numchan,imidi(numchan)+5) = 24 + mmidi(numchan,imidi(numchan)+6) = 8 + imidi(numchan) = imidi(numchan)+6 + else if (typeq .eq. 'k') then +c +c Keychange event. in1 = isig +c + mmidi(numchan,imidi(numchan)+1) = 5*16+9 + mmidi(numchan,imidi(numchan)+2) = 2 + mmidi(numchan,imidi(numchan)+3) = mod(256+in1,256) + mmidi(numchan,imidi(numchan)+4) = 0 + imidi(numchan) = imidi(numchan)+4 + else + print*,'Program flameout in midievent' + call stop1() + end if + lasttime = miditime + return + end + subroutine moveln(iuin,iuout,done) + logical done + character*129 outq + done = .false. + read(iuin,'(a)',end=1) outq + lenout = llen(outq,129) + write(iuout,'(a)') outq(1:lenout) + return +1 done = .true. + return + end + subroutine mrec1(lineq,iccount,ndxm) +c +c This is called when (a) macro recording is just starting and +c (b) at the start of a new line, if recording is on +c + parameter (maxblks=9600) + character*128 lineq,lnholdq + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + logical mrecord,mplay,endmac + common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), + * ic1mac(20),ilmac,iplmac + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + if (.not.mrecord) then +c +c Starting the macro +c + ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount + il1mac(macnum) = ilbuf-1 + ic1mac(macnum) = iccount + mrecord = .true. + end if + if (iccount .lt. 128) then + ndxm = index(lineq(iccount+1:128),'M') + if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M', + * 128-iccount) + if (ndxm .gt. 0) then +c +c This line ends the macro. +c + ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm + il2mac(macnum) = ilbuf-1 + mrecord = .false. + end if + end if + return + end + function ncmid(iv,ip) + parameter (nm=24) + common /all/ mult(nm,200),jv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comipl2/ ipl2(nm,200) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,isfig + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtol/ tol + if (ncc(iv) .eq. 1) then + ncmid = ncmidcc(iv,1) + else + xtime = to(ipl2(ivx,ip)) + do 1 icc = ncc(iv) , 1 , -1 + if (xtime .gt. tcc(iv,icc)-tol) then + ncmid = ncmidcc(iv,icc) + return + end if +1 continue + print*,'Problem in ncmid()' + stop + end if + end + function ncmidf(clefq) +c +c Return middle line of a clef +c + character*1 clefq + if (clefq .eq. '8') then +c +c treblelowoct; will treat as treble for this purpose +c + ncmidf = 35 + else + ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 + end if + return + end + subroutine newvoice(jv,clefq,change) + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,isfig + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + character*1 ulfbq,clefq + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + logical change,autofbon + nvmx(jv) = 1 + ivmx(jv,1) = jv + itsofar(jv) = 0 + nnl(jv) = 0 + nfb(jv) = 0 + if (firstgulp .or. change) then + ncmidcc(jv,1) = ncmidf(clefq) + else + ncmidcc(jv,1) = ncmidcc(jv,ncc(jv)) + end if + tcc(jv,1) = 0. + ncc(jv) = 1 + nudoff(jv) = 0 + ndotmv(jv) = 0 + do 5 j = 1 , 200 + irest(jv,j) = 0 + islur(jv,j) = 0 + ipl(jv,j) = 0 + nacc(jv,j) = 0 + iornq(jv,j) = 0 + mult(jv,j) = 0 + if (jv.le.2) isfig(jv,j) = .false. +5 continue + return + end + subroutine notefq(noteq,lnote,nolev,ncmid) +c +c Returns name of note level with octave transpositions, updates noctup. +c + common /comoct/ noctup + character*8 noteq + character*1 upcaseq,noteqt,chax + nupfroma = mod(nolev+1,7) + iname = 97+nupfroma + ioctup = (nolev+1)/7-4 + noteqt = chax(iname) + if (ncmid .eq. 23) noteqt = upcaseq(noteqt) + if (ioctup .eq. noctup) then + noteq = noteqt + lnote = 1 +c +c Must ALWAYS check if lnote=1 for use with functions requiring a blank +c + else if (ioctup .gt. noctup) then +c +c Raise octave. Encase in {} +c + write(noteq,'(8a1)')'{',(chax(39),i=noctup,ioctup-1), + * noteqt,'}' + lnote = 3+ioctup-noctup + noctup = ioctup + else +c +c Lower octave +c + write(noteq,'(8a1)')'{',(chax(96),i=ioctup,noctup-1), + * noteqt,'}' + lnote = 3+noctup-ioctup + noctup = ioctup + end if + return + end + subroutine notex(notexq,lnote) +c +c Returns non-beamed full note name +c + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk, + * isfig,ispoi,btest,even + character*1 udq,udqq,chax + character*4 dotq + character*2 numq + character*79 notexq + character*8 noteq + character*40 restq + common /compoi/ ispoi + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + character*10 figq + ip = ipo(jn) + nole = nolev(ivx,ip) +c +c Check for special situations with 2nds (see precrd) +c + if (btest(nacc(ivx,ip),30)) then + nole = nole - 1 + else if (btest(nacc(ivx,ip),31)) then + nole = nole + 1 + end if + nodu = nodur(ivx,ip) + if (.not.btest(irest(ivx,ip),0)) then + udq = udqq(nole,ncmid(iv,ip), + * islur(ivx,ip),nvmx(iv),ivx,nv) + end if +c +c Check figure level +c +c if (figbass .and. isfig(ivx,ip) +c * .and. .not.btest(irest(ivx,ip),0)) then + if (figbass .and. .not.btest(irest(ivx,ip),0) .and. + * ((ivx.eq.1.and.isfig(1,ip)) + * .or.(ivx.eq.ivxfig2.and.isfig(2,ip)))) then + if (udq .eq. 'u' .or. nodu.ge.64) then +c +c Upper or no stem, fnole (in noleunits) set by notehead +c + fnole = nole + else +c +c Lower stem, fnole set by bottom of stem +c + fnole = nole-stemlen + end if + zmin = fnole-ncmid(ivx,ip)+4 + if (ivx .eq. 1) then + ifigdr(1,iline) = max(ifigdr(1,iline),nint(4-zmin)) + else + ifigdr(2,iline) = max(ifigdr(2,iline),nint(4-zmin)) + end if + end if + if (.not.btest(irest(ivx,ip),0)) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) call addblank(noteq,lnoten) + if (nodu .eq. 1) then + notexq =sq//'cccc'//udq//noteq(1:lnoten) + lnote = lnoten+6 + else if (nodu .eq. 2) then + notexq =sq//'ccc'//udq//noteq(1:lnoten) + lnote = lnoten+5 + else if (nodu .eq. 4) then + notexq =sq//'cc'//udq//noteq(1:lnoten) + lnote = lnoten+4 + else if (nodu .eq. 8) then + notexq =sq//'c'//udq//noteq(1:lnoten) + lnote = lnoten+3 + else if (nodu .eq. 16) then + notexq =sq//'q'//udq//noteq(1:lnoten) + lnote = lnoten+3 + else if (nodu .eq. 32) then + notexq =sq//'h'//udq//noteq(1:lnoten) + lnote = lnoten+3 + else if (nodu .eq. 64) then + notexq =sq//'wh'//noteq(1:lnoten) + lnote = lnoten+3 + else if (nodu .eq. 128) then +c notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' +c lnote = lnoten+10 + notexq =sq//'breve'//noteq(1:lnoten) + lnote = lnoten+6 + else + dotq = 'p' + ldot = 1 + if (btest(iornq(ivx,ip),13)) then +c +c Dotted note with ')' ornament +c + dotq='m' + else if (btest(islur(ivx,ip),3)) then +c +c Double dot +c + dotq = 'pp' + ldot = 2 + end if + if (nodu .ge. 192) then + notexq =sq//'breve'//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+6+ldot + else if (nodu .ge. 96) then + notexq =sq//'wh'//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+3+ldot + else if (nodu .ge. 48) then + notexq =sq//'h'//udq//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+3+ldot + else if (nodu .ge. 24) then + notexq =sq//'q'//udq//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+3+ldot + else if (nodu .ge. 12) then + notexq =sq//'c'//udq//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+3+ldot + else if (nodu .ge. 6) then + notexq =sq//'cc'//udq//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+4+ldot + ispoi = .true. + else + notexq =sq//'ccc'//udq//dotq(1:ldot)//noteq(1:lnoten) + lnote = lnoten+5+ldot + ispoi = .true. + end if + if (dotq(1:1) .eq. 'm') then +c +c Need another call to the note, in case the first one has octave shifts +c + if (lnoten .eq. 2) then + notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}' + lnote = lnote+3 + else + notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1) + lnote = lnote+1 + end if + end if + end if + else if (btest(islur(ivx,ip),29)) then +c +c Blank rest +c + notexq = sq//'sk' + lnote = 3 + else +c +c Non-blank rest +c + lnote = 0 + nole = mod(nole+20,100)-20 +c +c Kluge to get pause symbol for rp: +c + if (btest(islur(ivx,ip),19)) nodu = 64 + if (nodu .le. 28) then +c +c Normal rest < or = double-dotted quarter +c + lrest = 3 + if (nodu .gt. 14) then + restq =sq//'qp' + else if (nodu .gt. 7) then + restq =sq//'ds' + else if (nodu .gt. 3) then + restq =sq//'qs' + else if (nodu .gt. 1) then + restq =sq//'hs' + else + restq =sq//'qqs' + lrest = 4 + end if +c +c Special case for rest at start of F-tuplet inside a forced beam +c + if (btest(nacc(ivx,ip),18) .and. + * btest(nacc(ivx,ip),19)) then + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if + notexq = restq + lnote = lrest +c +c At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. +c + if (nole .ne. 0) then + if (abs(nole) .lt. 10) then + noteq = chax(48+abs(nole)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole) + lnoten = 2 + end if + if (nole .gt. 0) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + end if + lnote = 16+lnoten + notexq = notexq(1:lnote)//restq(1:lrest) + lnote = lnote+lrest + end if + if (2**log2(nodu) .ne. nodu) then +c +c Deal with dots (on rests shorter than half rest) +c + restq = sq//'pt' + lrest = 3 + if (2*nodu .gt. 3*2**log2(nodu)) then + restq = sq//'ppt' + lrest = 4 + end if + nole = nole+4 + raisedot = 0 +c +c Tweak dot positions for special cases +c + even = (mod(100+nole,2).eq.0) +c if (.not.even.and.nodu.gt.8.and. +c * (nole.lt.0.or.nole.gt.8)) then + if (.not.even .and. (nole.lt.0.or.nole.gt.8)) then + raisedot = 1 + end if + if (nole.ge.10 .or. nole.le.-1) then + write(numq,'(i2)')nole + restq = restq(1:lrest)//'{'//numq//'}' + lrest = lrest+4 + else + restq = restq(1:lrest)//chax(nole+48) + lrest = lrest+1 + end if + if (raisedot.gt.0) then + restq = sq//'raise'//sq//'internote'// + * sq//'hbox{'//restq(1:lrest)//'}' + lrest = lrest+23 + end if + notexq = restq(1:lrest)//notexq(1:lnote) + lnote = lnote+lrest + end if + else +c +c Half rest or longer +c + if (nole .eq. 0) then +c +c Half or longer rest is not raised or lowered +c + if (nodu .le. 56) then + notexq =sq//'hpause' + lnote = 7 + else if (nodu .le. 112) then + if (.not.btest(islur(ivx,ip),19) .or. + * btest(irest(ivx,ip),25)) then + notexq = sq//'pause' + else + notexq = sq//'pausc' + end if + lnote = 6 + else + notexq =sq//'PAuse' + lnote = 6 + end if + if (2**log2(nodu) .ne. nodu) then +c +c Dotted rest, hpause or longer +c + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + if (2*nodu .gt. 3*2**log2(nodu)) then +c +c Double dotted long rest +c + notexq = notexq(1:lnote)//'p' + lnote = lnote+1 + end if + end if + else +c +c Raised or lowered half or whole rest +c + if (nodu .eq. 32) then + notexq = sq//'lifthpause' + lnote = 11 + else if (nodu .eq. 48) then + notexq = sq//'lifthpausep' + lnote = 12 + else if (nodu .eq. 56) then + notexq = sq//'lifthpausepp' + lnote = 13 + else if (nodu .eq. 64) then + notexq = sq//'liftpause' + lnote = 10 + else if (nodu .eq. 96) then + notexq = sq//'liftpausep' + lnote = 11 + else if (nodu .eq. 112) then + notexq = sq//'liftpausepp' + lnote = 12 + else if (nodu .eq. 128) then + notexq = sq//'liftPAuse' + lnote = 10 + else +c +c Assume dotted double whole rest +c + notexq = sq//'liftPAusep' + lnote = 11 + end if +c +c Set up height spec +c + nole = sign(abs(nole)/2,nole) + if (nole.le.9 .and. nole.ge.0) then + noteq = chax(48+nole) + lnoten = 1 + else + noteq = '{' + if (nole .ge. -9) then + write(noteq(2:3),'(i2)')nole + lnoten = 3 + else + write(noteq(2:4),'(i3)')nole + lnoten = 4 + end if + noteq = noteq(1:lnoten)//'}' + lnoten = lnoten+1 + end if + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + end if + end if + end if + return + end + function ntindex(line,s2q,lenline) +c +c Returns index(line,s2q) if NOT in TeX string, 0 otherwise +c + character*(*) s2q,line + character*1 chax + logical intex + ndxs2 = index(line,s2q) + ndxbs = index(line,chax(92)) + if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then + ntindex = ndxs2 + else +c +c There are both bs and s2q, and bs is to the left of sq2. So check bs's to +c right of first: End is '\ ', start is ' \' +c + len = lenstr(line,lenline) + intex = .true. + do 1 ic = ndxbs+1 , len + if (ic .eq. ndxs2) then + if (intex) then + ntindex = 0 + ndxs2 = index(line(ic+1:len),s2q)+ic + else + ntindex = ndxs2 + return + end if + else if (intex .and. line(ic+1:ic+2).eq.chax(92)//' ') then + intex = .false. + else if (.not.intex .and. line(ic+1:ic+2).eq.' '//chax(92)) + * then + intex = .true. + end if +1 continue + end if + return + end + subroutine ntrbbb(n,char1q,ulqq,iv,notexq,lnote) +c +c This appends to notexq e.g. '\ibbbu1' +c + common /combbm/ isbbm + logical isbbm + character*79 notexq + character*1 char1q,ulqq,chax + character*4 tempq + if (n .ge. 5) isbbm = .true. + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//chax(92)//char1q + else + notexq = chax(92)//char1q + end if + lnote = lnote+2 + do 3 im = 1 , n + notexq = notexq(1:lnote)//'b' + lnote = lnote+1 +3 continue +c +c add the number, 0 if 12 +c +c 5/25/08 Allow >12 +c +c call istring(mod(iv,12),tempq,len) + if (iv .lt. 24) then + call istring(iv,tempq,len) + else if (iv .eq. 24) then + tempq(1:1) = '0' + len = 1 + else + call printl('Sorry, too man open beams') + call stop1() + end if + notexq = notexq(1:lnote)//ulqq//tempq(1:len) + lnote = lnote+1+len + return + end + function numclef(clefq) +c +c Returns the number to be used as argument of \setclef for MusiXTeX +c For input 0-6 or tsmanrb return 0-7 +c 7 f 9 +c 8 0 +c + character*1 clefq + if (ichar(clefq) .lt. 55) then +c if (ichar(clefq) .le. 55) then + numclef = ichar(clefq)-48 +c if (numclef .eq. 7) numclef = 9 + else if (clefq .eq. '7') then + numclef = 9 + else if (clefq .eq. '8') then + numclef = 0 + else + numclef = index('tsmanrbxxf',clefq)-1 + end if + return + end + subroutine outbar(i,jlast) + character*1 chax + nfmt = log10(i+.5)+2 + if (jlast+5+nfmt .lt. 80) then + write(*,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i + write(15,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i + jlast = jlast+5+nfmt + else + write(*,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i + write(15,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i + jlast = 5+nfmt + end if + return + end + subroutine pmxa(basenameq,lbase,isfirst,nsyout,nbarss,optimize) +cccccccccccccccccccccccccccccccccccccccccccccccc +cc cc +cc Subroutine, combine with pmxb.for +cc +cccccccccccccccccccccccccccccccccccccccccccccccc +cc +cc Need to consider X spaces in xtuplets when getting poenom, and +cc maybe fbar? +cc mx06a +cc ID numbers for voices when number of voices is reduced. +cc +cc mx03a +cc account for new fracindent for new movements. +cc +cc Known changes since pmxa. Version 1.1b (see pmxb for longer list) +cc +cc Check ID codes for slurs. +cc Version 1.24 still does not have details for spacing/positioning +cc arpeggios if there are accidentals or shifted notes or crowded scores. +cc Fix problem in 1.22 with arpeggios across multi-line staves +cc Fix problem in 1.22 with flat key signatures +cc Read setup data as strings +cc Warning for octave designation plus +/- +cc Don't pause for volta warning, +cc Macros +cc Correct fsyst to account for transposition and key changes. +cc Check for nbars > nsyst +cc +ccccccccccccccccccccccccccccccccccc + parameter (nm=24,nkb=3999,nks=125,maxblks=9600) + logical loop,usefig,isfirst,optimize + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + integer nn(nm),nodur(nm,200),ivxo(600),ipo(600), + * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks) + common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), + * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) + common /compage/ widthpt,ptheight,hoffpt,voffpt, + * nsyst,nflb,ibarflb(0:40), + * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), + * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30), + * nistaff(0:40) + common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1, + * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS + real*4 elsk(nkb),celsk(0:nkb),elss(nks),to(600),tno(600) + character*128 lnholdq + character*44 basenameq + logical rest(nm,200),firstline,fbon,isvolt,iskchb,kchmid,ornrpt, + * stickyS + common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, + * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 + logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr, + * shifton,barend + common /a1ll/ iv,ivxo,ipo,to,tno,nnl,nv,ibar,mtrnuml, + * nodur,lenbar,iccount,nbars,itsofar,nib,nn, + * rest,lenbr0,lenbr1,firstline,newmeter + common /linecom/ elskb,tnminb(nkb) + common /cblock/ + * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco, + * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh + common /cominbot/ inbothd + common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + common /commus/ musize,whead20 + common /comeon/ eonk,ewmxk + logical mrecord,mplay,endmac,cstuplet + logical novshrinktop,upslur,fontslur,WrotePsslurDefaults + common /comnvst/ novshrinktop,cstuplte + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /comligfont/ isligfont + logical isligfont + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + logical fulltrans + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, + * poefa + real*4 poefa(125) + logical nocodabn + data wtimesig,wclef,wkeysig + * / 0.72 , 0.8 , 0.28 / +c data poefa /125*1./ +c This corrected a problem in Bob Tennent's compilation of pmx2.94 +c + do 97 i = 1 , 125 + poefa(i) = 1. +97 continue + is4bignv = .false. + AIset = .false. + whead20 = 0.3 + ishort = 0 + if (.not.optimize) then + print* + print*,'Starting first PMX pass' + write(15,'(a)') ' Starting first PMX pass' + end if + if (isfirst) then + open(19,file='pmxaerr.dat') + write(19,'(i6)') 0 + close(19) + end if + if (.not.optimize) jprntb = 81 + macuse = 0 + ornrpt = .false. + stickyS = .false. + mrecord = .false. + mplay = .false. + lastchar = .false. + novshrinktop = .false. + cstuplet = .false. + fontslur = .true. + isligfont = .false. + fulltrans = .false. + do 42 ibarcnt = 1 , nkb + udsp(ibarcnt) = 0. + wminnh(ibarcnt) = -1. +42 continue +c +c Initialize input buffer +c + lenbuf0 = ipbuf + ipbuf = 0 + ilbuf = 1 + call g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, + * xmtrnum0,newkey(1),npages,nsyst,musize,bottreb) +c +c Set up list of instrument numbers (iv) +c + ivnow = 0 + do 13 instnow = 1 , noinst + do 14 iscount = 1 , nsperi(instnow) + ivnow = ivnow+1 + instno(ivnow) = instnow +14 continue +13 continue +c +c Save initial meter for midi +c + if (.not.isfirst .and. npages.eq.0) then + print*,'Sorry, must have npages>0 for optimization.' + call stop1() + end if + nsyout = nsyst +c +c isig1 will be changed in getnote if there is a transposition +c + isig1 = newkey(1) + if (npages .gt. nsyst) then + call printl('npages > nsyst in input. Please fix the input.') + call stop1() + end if +c +c fbar = afterruleskip/elemskip +c apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt +c + fbar = 1. + wheadpt = whead20*musize + ifig = 0 + usefig = .true. + lenbeat = i1fnodur(mtrdenl,'x') + lenmult = 1 + if (mtrdenl .eq. 2) then + lenbeat = 16 + lenmult = 2 + end if + lenbr1 = lenmult*mtrnuml*lenbeat + lenbr0 = nint(lenmult*xmtrnum0*lenbeat) + mtrnuml = 0 + if (lenbr0 .ne. 0) then + ibaroff = 1 + lenbar = lenbr0 + else + ibaroff = 0 + lenbar = lenbr1 + end if + ibarcnt = 0 + nptr(1) = 1 + iccount = 128 + nmovbrk = 0 + nflb = 0 + nfpb = 0 + ipagfpb(0) = 1 + isysfpb(0) = 1 + ibarflb(0) = 1 + isysflb(0) = 1 + nistaff(0) = nv-1 +c +c Check for pmx.mod +c + linesinpmxmod = 0 +c line1pmxmod = ilbuf + call getpmxmod(.true.,' ') + if (.not.isfirst .and. linesinpmxmod .gt. 0) then + print*,'Sorry, cannot optimize if there is a pmx.mod file' + call stop1() + end if +c +c Initialize for loop over lines +c + nkeys = 1 + ibrkch(1) = 1 + mbrestsav = 0 + shifton = .false. + firstline = .true. + newmeter = .false. + ihead = 0 + isheadr = .false. + idsig = 0 + iddot = 0 + fintstf = -1. + gintstf = 1.0 + listcresc = 0 + listdecresc = 0 +30 loop = .true. + iskchb = .false. + issegno = .false. + nbars = 0 + ibarmbr = 0 + do 4 iv = 1 , nv + nvmx(iv) = 1 + ivmx(iv,1) = iv + itsofar(iv) = 0 + nnl(iv) = 0 + do 5 j = 1 , 200 + rest(iv,j) = .false. + nacc(iv,j) = 0. +5 continue +4 continue + iv = 1 + ivx = 1 + fbon = .false. + barend = .false. + isvolt = .false. +2 if (loop) then +c +c Within this short loop, nv voices are filled up for the duration of a block. +c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) +c nodur(..),rest(..). nnl will later be +c increased and things slid around as accidental skips are added. +c + call g1etnote(loop,ifig,optimize,fulltrans) + if (lastchar) go to 20 + go to 2 + end if + if (mbrestsav .gt. 0) then + call printl(' ') + call printl( + * 'You must enter the same multibar rest in ALL parts') + call stop1() + end if + do 10 ibar = 1 , nbars + ibarcnt = ibarcnt+1 +c +c The following is just a signal to start a new bar when cataloging spaces +c for catspace(...) +c + nptr(ibarcnt+1) = nptr(ibarcnt) + newmb(ibarcnt) = .false. + if (newmeter.and.ibar.eq.1) newmb(ibarcnt) = .true. +c +c Above is only for spacing calcs later on. Remember new meter can only occur +c at START of a new input line (ibar = 1) +c + if (ibar .ne. ibarmbr) then + if (.not.optimize) call outbar(ibarcnt-ibaroff,jprntb) + else + if (.not.optimize) then + write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars', + * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1 + write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars', + * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1 + jprntb = 0 + end if + ibaroff = ibaroff-mbrest+1 + end if + if (firstline .and. lenbr0.ne.0) then + if (ibar .eq. 1) then + lenbar = lenbr0 + else + lenbar = lenbr1 + end if + end if + if (ibar .gt. 1) then +c +c For bars after first, slide all stuff down to beginning of arrays +c + do 11 iv = 1 , nv + do 1199 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + ioff = nib(ivx,ibar-1) + do 12 ip = 1 , nib(ivx,ibar)-ioff + nodur(ivx,ip) = nodur(ivx,ip+ioff) + rest(ivx,ip) = rest(ivx,ip+ioff) + nacc(ivx,ip) = nacc(ivx,ip+ioff) +12 continue +1199 continue +11 continue + end if + do 67 iv = 1 , nv + do 6799 kv = 1 , nvmx(iv) + ioff= 0 + if(ibar.gt.1)ioff = nib(ivmx(iv,kv),ibar-1) +6799 continue +67 continue + call makeabar() + elsk(ibarcnt) = elskb+fbar +10 continue + newmeter = .false. + firstline = .false. + go to 30 +20 continue +c +c Vertical analysis. +c + if (npages .eq. 0) then + if (nsyst .eq. 0) then + print*,'When npages=0, must set nsyst=bars/syst, not 0' + call stop1() + end if + nsyst = (ibarcnt-1)/nsyst+1 + if (nv .eq. 1) then + nsystpp = 12 + else if (nv .eq. 2) then + nsystpp = 7 + else if (nv .eq. 3) then + nsystpp = 5 + else if (nv .eq. 4) then + nsystpp = 3 + else if (nv .le. 7) then + nsystpp = 2 + else + nsystpp = 1 + end if + npages = (nsyst-1)/nsystpp+1 + end if +c +c Check nsyst vs ibarcnt +c + if (nsyst .gt. ibarcnt) then + print* + print*,'nsyst,ibarcnt:',nsyst,ibarcnt + print*,'There are more systems than bars.' + write(15,'(a,2i5)')' nsyst,ibarcnt:',nsyst,ibarcnt + write(15,'(a)')' There are more systems than bars.' + call stop1() + end if +c +c Set up dummy forced line & page breaks after last real one +c + nflb = nflb+1 + ibarflb(nflb) = ibarcnt+1 + isysflb(nflb) = nsyst+1 + nfpb = nfpb+1 + ipagfpb(nfpb) = npages+1 + isysfpb(nfpb) = nsyst+1 + heightil = ptheight*4./musize + open(12,status='SCRATCH') + write(12,'(a)')basenameq(1:lbase) + write(12,*)lbase +c +c Pass to pmxb the initial signature, including effect of transposition. +c + write(12,'(6f10.5/f10.5,3i5)')fbar,wheadpt,etait, + * etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1 + write(12,*)npages,widthpt,ptheight,hoffpt,voffpt,nsyst + iflbnow = -1 + isysb4 = 0 + do 8 ifpb = 1 , nfpb +c +c Each time thru this loop is like a single score with several pages +c + npages = ipagfpb(ifpb)-ipagfpb(ifpb-1) + nsyst = isysfpb(ifpb)-isysfpb(ifpb-1) + nomnsystp = (nsyst-1)/npages+1 + nshort = nomnsystp*npages-nsyst + do 7 ipage = 1 , npages + nsystp = nomnsystp + if (ipage .le. nshort) nsystp = nsystp-1 +c +c Last system number on this page: + isysendpg = isysb4+nsystp + nintpg = 0 + do 15 isy = isysb4+1, isysendpg + if (isysflb(iflbnow+1) .eq. isy) iflbnow = iflbnow+1 + nintpg = nintpg+nistaff(iflbnow) +15 continue + xilfrac = 0. + xiltxt = 0. + if (ipage.eq.1 .and. ihead.gt.0) then +c +c Needn't zero out ihead after printing titles if we only allow titles at top? +c + if (iand(ihead,1) .eq. 1) then + xiltxt = xiltxt+hgtin*4/musize + xilfrac = xilfrac+etait + end if + if (iand(ihead,2) .eq. 2) then + xiltxt = xiltxt+hgtti*4/musize + xilfrac = xilfrac+etatc + end if + if (iand(ihead,4) .eq. 4) then + xiltxt = xiltxt+hgtco*4/musize + xilfrac = xilfrac+etacs1 + else +c +c Use double the title-composer space if there is no composer +c + xilfrac = xilfrac+etatc + end if + end if + D = xilfrac+nsystp-1+etatop+etabot +c C = nsystp*(nv-1) + C = nintpg +c xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn + xN = heightil - xiltxt - 4*(nintpg+nsystp) - (nsystp-1)*xilbn + if (bottreb) xN = xN-(nsystp-1)*xilbtc + if (ihead.eq.0 .and. isheadr) xN = xN - xilhdr + if (ifig .eq. 1) then + xN = xN - nsystp*xilfig + end if + glueil = (xN-b*C)/(D+a*C) + omegaG = (b*D+a*xN)/(D+a*C) +c +c G = \interlines between systems +c omega*G = \interlines between staves of the same system +c \interstaff = 4+omega*G +c C = total number of interstaff spaces in the page +c D = omega-indep factors for scalable height = nsy-1 (intersystem glue) +c + etatop + etabot + etatxt + +c N = scaleable height (\interlignes) = height - htext - staff heights - xil +c xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles +c + (nsy-1)*xiltcb for treble clef bottoms +c + nsy*xilfig for figures +c G = N/(D + omega * C) = glueil, (1) +c But (empirically) omega*G = a*G + b (2) +c with a=1.071 and b=2.714 +c Solving (1) and (2) gives +c G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C) +c Pass to pmxb omega*G (=\interstaff-4) +c (etatop,bot,it,tc,cx)*G as inputs to \titles +c +c glueil = (heightil-xiltxt-nsystp*(xil+4*nv)) +c * /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac) +c xnsttop = glueil*etatop +c xintstaff = 4+gfact*glueil +c +c Only the first page will get local adjustment now if needed, others in pmxb +c + if (ifpb.eq.1 .and. ipage.eq.1 .and. fintstf.gt.0.) then + facins = fintstf + fintstf = -1. + else +c +c gintstf = 1.0 by default, but may be changed with AI +c + facins = gintstf + end if + write(12,*)nsystp,max(0.,etatop*glueil),facins*(omegaG+4) + ihead = 0 + isheadr = .false. + isysb4 = isysendpg +7 continue +8 continue +c +c Done with vertical, now do horizontals +c + celsk(1) = elsk(1) + do 21 ibar = 2 , ibarcnt + celsk(ibar) = celsk(ibar-1)+elsk(ibar) +21 continue + lastbar(0) = 0 + ibar1 = 1 + wmins = -1. + iflb = 1 + imovbrk = 0 + ikey = 1 +c +c Return nsyst to its *total* value +c + nsyst = isysfpb(nfpb)-1 + do 22 isyst = 1 , nsyst + if (isyst .eq. isysflb(iflb)) iflb = iflb+1 + if (nmovbrk.gt.0 .and. imovbrk.lt.nmovbrk) then + if (isyst .eq. isysmb(imovbrk+1)) imovbrk = imovbrk+1 + end if + ibarb4 = lastbar(isyst-1) + if (isyst .eq. 1) then + if (isfirst) elsstarg = celsk(ibarflb(1)-1)/ + * (isysflb(1)-1-fracindent)*(1-fracindent) + celskb4 = 0. + else + celskb4 = celsk(ibarb4) +c +c Must dimension isysmb(0:*) just so I can execute this test! +c + if (isfirst) then + if (nmovbrk.gt.0 .and. isyst.eq.isysmb(imovbrk)) then +c +c First syst after forced line break. There may be indentation. +c + elsstarg = (celsk(ibarflb(iflb)-1)-celskb4) + * /(isysflb(iflb)-isyst-fracsys(imovbrk)) + * *(1-fracsys(imovbrk)) + else +c +c There is no indentation to deal with +c + elsstarg = (celsk(ibarflb(iflb)-1)-celskb4) + * /(isysflb(iflb)-isyst) + end if + end if + end if + if (isfirst) then + diff1 = abs(elsstarg-elsk(ibarb4+1)) + do 23 ibar = ibarb4+2 , ibarcnt + diff = elsstarg-(celsk(ibar)-celskb4) + if (abs(diff) .ge. diff1) go to 24 + diff1 = abs(diff) +23 continue +24 ibar = ibar-1 + lastbar(isyst) = ibar + nbarss(isyst) = ibar-ibarb4 + else +c +c nbarss is given as an input, must compute lastbar and ibar +c + lastbar(isyst) = nbarss(isyst)+ibarb4 + ibar = lastbar(isyst) + end if +c +c elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. +c + elss(isyst) = celsk(ibar)-celskb4 + write(12,'(i5)')lastbar(isyst-1)+1 +c +c Transposed sigs are isig1, newkey(2,3,...). +c + if (ikey .eq. 1) then + key1 = isig1 + else + key1 = newkey(ikey) + end if + fsyst = wclef+abs(key1)*wkeysig+2./musize + xelsk = 0. +1 if (ikey.lt.nkeys) then + if (ibrkch(ikey+1).le.lastbar(isyst)) then +c +c Add space for all key changes +c + ikey = ikey+1 + key2 = newkey(ikey) + naccs = max(abs(key2-key1),max(abs(key1),abs(key2))) + fsyst = fsyst+naccs*wkeysig +c +c Account for afterruleskips (fbar) +c + xelsk = xelsk+fbar/2 + if (ibrkch(ikey).lt.lastbar(isyst) .and. .not.kchmid(ikey)) + * xelsk = xelsk-1. + key1 = key2 + go to 1 + end if + end if +c +c Add extra fixed space for double bar +c + if (isyst .eq. nsyst) then + fsyst = fsyst+4.5/musize + end if +c +c Add extra fixed space for initial time signature +c + if (isyst .eq. 1) then + fsyst = fsyst+wtimesig + end if +c +c Add extra fixed space for time signature changes & user-defined spaces +c + do 26 ibars = ibarb4+1 , lastbar(isyst) + if (newmb(ibars)) fsyst = fsyst+wtimesig + fsyst = fsyst+udsp(ibars)/musize +26 continue + if (isyst .eq. 1) then + wdpt = widthpt*(1-fracindent) + else + if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and. + * isyst.eq.isysmb(imovbrk)) then + wdpt = widthpt*(1-fracsys(imovbrk)) + else + wdpt = widthpt + end if + end if + wsyspt = wdpt-fsyst*musize-0.4*nbarss(isyst) +c +c Checks for min spacing +c Get min allowable space +c + dtmin = 1000. + do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1 + dtmin = min(dtmin,tnminb(ibar)) + if (wminnh(ibar).ge.0.) wmins = wminnh(ibar) +45 continue + if (wmins .lt. 0) wmins = 0.3 + wminpt = (1+wmins)*0.3*musize +c +c Find max duration & # of notes for this system +c + dtmax = 0. + nns = 0 + do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1 + dtmax = max(dtmax,durb(iptr)) + nns = nns + nnpd(iptr) +43 continue + elmin0 = wsyspt*f1eon(dtmin)/(elss(isyst)+xelsk) + if (elmin0 .ge. wminpt) then +c +c Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; +c there is no need to "flatten" +c + sumelsk = elss(isyst)-fbar*nbarss(isyst) + eonk = 0. + ewmxk = 1. + else + elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/f1eon(dtmax)+nns) + if (elmin1 .le. wminpt) then +c print* +c print*,'In system #',isyst,' cannot meet min. space rqmt' +c write(15,'(/a,i5,a)') +c * 'In system #',isyst,' cannot meet min. space rqmt' + eonk = 0.9 + else +c +c Find eonk by Newton method +c + call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1, + * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax, + * (wminpt-elmin0)/(elmin1-elmin0)) + eonk = min(.9,eonk) + end if + ewmxk = f1eon(dtmax)**eonk +c +c Recompute poenom! +c + sumelsk = 0 + do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1 + sumelsk = sumelsk + * + nnpd(iptr)*sqzb(iptr)*feon(durb(iptr)/sqzb(iptr)) +44 continue + end if + poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk) +c +c Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 +c + if (isyst .gt. 0) then + if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and. + * isyst.eq.isysmb(imovbrk)) then + fracindent = fracsys(imovbrk) + else + fracindent = 0. + end if + end if + write(12,'(1pe12.5/i5,5e12.3)') poenom,nbarss(isyst), + * sumelsk,fsyst,fracindent,eonk,ewmxk + ibar1 = ibar1+nbarss(isyst) +22 continue + rewind(12) + open(13,status='SCRATCH') + write(13,'(i5)')ifig + rewind(13) + ilbuf = 1 + ipbuf = 0 + if (.not.optimize) then + write(*,'(/,a)')' Done with first pass' + print* + write(15,'(/,a)')' Done with first pass' + write(15,'()') + end if +c +c Following syntax is needed since pmxa is called with literal argument .false. +c + if (isfirst) isfirst = .false. + return + end + subroutine pmxb(inlast,poevec,ncalls,optimize) +cccccccccccccccccccccccccc +cc +cc To Do +cc +cc Resolve disagreement in final poe for 1st system, compared with *.mx2 +cc Shift slurs on right- or left-shifted main notes (2/7/99) +cc Various end-of-input-block repeat problems (ick142.pmx). +cc Force multiplicity for un-beamed xtups. +cc Clef change at end of piece +cc Global "A" option to maximize "X" at a given time tick. +cc Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted +cc note. See trubl18.pmx +cc Tab character as space. +cc Clef interference with second line of music. +cc Add space for interferences between *different* lines of music? +cc Shift arpeggios, both automatic and manual. +cc Different musicsize for different instruments. +cc Spacing checks for accid's on left-shifted chord notes +cc Spacing checks for double dots +cc Allow forced line breaks w/o setting nsyst. +cc Cresc-Decresc. (Enhance MusiXTeX first?) +cc Dynamic Marks. +cc Bug with Voltas at line end (MusiXTeX problem?). +cc Subtle bug w/ slur hgt over line brk, see trubl15.pmx +cc Stem-end slurs. +cc Allow units in indentation. +cc Make inline TeX more context sensitive. +cc Werner's 4/2/98 problem with "o?" +cc Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong. +cc converts e.g. "r2db" into "r2d", which might be wrong. +cc Werner's generalsignature problem with Key change and new transposition. +cc (wibug8.pmx) +cc Unequal xtuplets +cc Print both sets of bar #'s in tex file. +cc Make barlines invisible \def\xbar{\empty} , fix fbar. +cc Auto-tie slurs 'At' +cc Forced line break anywhere (e.g. at a mid-bar repeat). +cc Clef change at very start of file. +cc Tighten test for M as macro terminator. +cc Fix title so not separate limit on author length + composer length. +cc Arpeggios in xtups. +cc +cc mx10b +cc Option for instrument name at top center. Last item in P command: +cc P[n]c text is instrument name (use in parts) +cc P[n]cstuff text is stuff (up to 1st blank) +cc P[n]c"stuff with spaces" text is stuff with spaces +cc +cc Post version 1.43 +cc Reduced space rqmt for multiplicity-0 graces (no flag) +cc Removed last sepsym in centered whole-bar rests, fixes volta height bug. +cc +cc Version 1.43 +cc Fix spacing for end-of-line signature change. +cc Adjust left-shift of grace group for shifted accidentals. +cc Put in extra space for left-shifted accidentals. +cc Fix bug with dot-shift before accid-shift on chord note. +cc Space-check for right-shifted main notes. +cc Enable forcing stem direction of single notes in non-beamed xtups. +cc Disallow clef change after last note before end of input block (pmxa) +cc Print meter change before page break +cc increase length of strings for \titles macro +cc version 1.42 +cc Loosen up input syntax for "X" commands. Subroutine getx() +cc "B" and "P" in "X" commands +cc mx09b +cc Allow multiple rests at start of xtup +cc Add 64th rest +cc Fix xtup numbers over rests. (subroutine levrn) +cc Initialize notcrd=.false. every gulp. Avoids undefined state with e.g. +cc c za / ( c a ... +cc Allow double dots to be shifted. +cc Fix spacing with double dotted notes; permit splitting small note. +cc Fix \dotted printout so it works with old compiler +cc mx08b +cc Automatic spaces if needed for shifted accidentals. +cc Some Dynamics +cc Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc) +cc version 1.41 +cc Allow ":" as last char of path name +cc Dotted slurs "sb" +cc Continue bar numbering at movement break "L[integer]Mc" +cc mx07b +cc Whole-bar rests with double lines of music. Fixed all options ? +cc Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number]. +cc Option to suppress centering full-bar rests. "o" +cc mx06b +cc Shift accid on left-shifted chord note. +cc Rest as first note of xtup. +cc Wrong slopes with small widths. Scale slfac1 by widthpt_default/widthpt +cc Allow Rb for single bar at movemnet break or end of piece. (islur(25)) +cc Change # of inst at a movement break. noinst is total # and must be used +cc in 1st movement. ninow is current. nspern(1,...,ninow) is current +cc staves/inst, nsperi(1,...,noinst) is original. rename tells whether to +cc reprint names in parindent at a movement break. Default is .false. +cc unless ninow changes, then .true. But can force either with r+/- as +cc option in 'M' +cc mx04b +cc Double-dotted notes, separate+beamed, main+chord, still no extra space. +cc ??? Don't shift slur ends on whole notes. +cc (pmxa) Write line number of error in pmxaerr.dat +cc mx02b +cc Admit "RD" before "/" (search for "rptfq2:" ) +cc In doslur, for multi-line staves, single notes, check forced stem dir'n +cc before setting stemup (used to set horiz offset). +ccccccccccccccccccccccccccccccc + parameter (nm=24,nks=125,mv=24576,maxblks=9600) +c +c FYI /all/ differs in appearance in function ncmid +c + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comipl2/ ipl2(nm,200) +ccccccccccccc +cc islur cc +ccccccccccccc +c bit meaning +c 0 slur activity on this note +c 1 t-slur here. +c 2 force 0-slope beam starting on this note +c 3 Double dotted note! +c 4 grace before main note +c 5 left repeat +c 6 right repeat +c 7 start Volta +c 8 doublebar +c 9 end Volta +c 10 on=>endvoltabox +c 11 on=>clefchange +c 12-14 0=>treble, ... , 6=>bass +c 15 on=> start new block for clef change (maybe diff. voice) +c 16 literal TeX string +c 17 1=up, 0=down stem for single note (override) See bit 30! +c 18 if on, prohibit beaming +c 19 if on, full bar rest as pause +c 20 Beam multiplicity down-up +c 21 Forced multiplicity for any beam including xtups +c 22-24 Value of forced multiplicity +c 25 single barline at movement break +c 26 doubleBAR (see bits 5,6,8) +c 27-28 Forced beam fine-tune height (1 to 3) +c 29 Blank rest +c 30 If on, get stem dir'n from bit 17 +c 31 If on, suppress printing number with xtuplet starting here +ccccccccccccc +cc ipl cc +ccccccccccccc +c 0 blank barline (must be iv=1) (would have used islur but no room) +c 1 look left for K rests, moved here from iornq(30) +c 2 treblelowoct +c 3 Open notehead in forced beam xtup +c 4 Set if single stem tremolo +c 5-6 termulo multiplicity - 1 +c 7 unused +c 8 left offset main note one headwidth +c 9 right offset main note one headwidth +c 10 chord present? +c 11-16 Forced beam height adjustment (-30 to +30) +c 17-22 Forced beam slope adjustment (-30 to +30) +c 23-26 Slur index for Way-after grace. Inserted when slur is started. +c 27 5th bit for slur index for Way-after grace (100712) +c 28 key change: only in voice 1 +c 29 Grace after main note. (Type A) +c 30 In forced beam. Signals need to check beam heights +c 31 Grace way after main note. (stretch to next note, type W) +ccccccccccccc +cc iornq cc +ccccccccccccc +c 0 Ornament "(". Was user-defined horizontal slur shift on this note +c until 9/24/97; changed that to irest(21) +c 1-13 stmgx+Tupf._) +c 14 Down fermata, was F +c 15 Trill w/o "tr", was U +c 16-18 Editorial s,f,n +c 19-20 >^ +c 21 "?" for editorial accid, w/ or w/o s,f,n +c 22 Set if ihornb governs ornament height. Same in icrdorn. +c 23 Set in getorn if ANY note at time of this main note has ornament. +c This is ONLY used in beamstrt to signal whether to do more +c tests for whether ihornb is needed. (ihornb is only needed +c if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note) +c (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm. +c 24 Slur on after or way-after grace. Use as signal to START slur. +c 25 Tweak orn ht. Same in icrdorn for chord note +c 26 Insert user-defined space before this note (was 22) +c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord +c 28 caesura or breath +cc 29 blank barline (must be iv=1) (would have used islur but no room) +c 29 coda +cc 30 "Look-left" option for keyboard rest +c 30 Part-by-part segno oG +c 31 Set if any note (main or chord) has cautionary accid, for space checks +ccccccccccccc +cc irest cc +ccccccccccccc +c 0 rest=1, no rest = 0 +c 1 There will be a vertical shift for number of this xtup +c 2 Set if 2-note tremolo starts here +c 3-4 nsolid, # of solid beams in 2-note tremolo +c 5-6 nindent, # of indented beams in 2-note tremolo +c 7 There is a horizontal shift for xtup number +c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 +c 14 Flip up/down-ness of xtup number +c 15 Single-voice, single note shift X(...)[p]S +c 16 Start single-voice, multinote shift with this note X(...)[p]: +c 17 End single-voice, multinote shift after this note. Enter symbol +c after note. X: +c 18 User-defined hardspace after last note of bar, *after* this note. +c Value still stored in udoff(ivx,nudoff(ivx)), not with other +c hardspaces in udsp, to avoid confusion with time checks. +c 19 Move the dot. Data stored in ndotmv,updot,rtdot +c 20 Set if right-shifted main or chord note here. Use for space checks. +c 21 User-defined hardspace in xtup +c 22 User-defined slur shift horizontal slur shift. +c 23 Set on last note before staff-jumping a beam. +c 24 Set on first note after staff-jumping a beam +c 25 Suppress rest centering. "ro" +c 26 Dynamic on this note +c 27 Set if left-shifted main or chord note here. Use for space checks. +c 28 Set if xtup starts on this note. +c 29 Set on lowest-voice note at same time as 1st note after jump-beam. +c 30 Set on note after end of jump-beam segment, to force new note group +c 31 Flag for cautionary accidental +ccccccccccccc +cc nacc cc +ccccccccccccc +c 0-1 0=no accid, 1=fl, 2=sh, 3=na +c 2 double +c 3 big +c 4-9 vertshift-32 +c 10-16 20*(horiz. shift + 5.35) (Recentered ver 2.32) +c 17 Midi-only accidental +c 18 2:1 xtup +c 19 Together with nacc(18), increase multiplicity by 1 and dot 1st note. +c 20 Set on last note of each seg except last seg of single-slope beam. +c 21 Set on 1st note of each seg except 1st seg of single-slope beam. +c 22-26 If .ne.0, printed xtup number for xtup starting on this note. +c 27 Set for dotted xtup note. Mult dur by 1.5, mult next by .5 & increase +c multiplicity by 1 +c 28 Set on main note of chord if accidentals are ordered. +c 29 Tag for chordal accidental shift...means add to autoshifts. +c 30-31 Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted. +c If upstem|downstem, main is upper|lower member of 2nd +c Action is to interchange pitches only when notes are placed. +ccccccccccccc +cc mult cc +ccccccccccccc +c 0-3 Multiplicity+8 (mult= # of flags) +c 4 Set if slope adjustment for xtup bracket +c 5-9 16+slope adjustment +c 10-15 New stem length, [0-63] => (-4,0,+27.5) +c 16-22 64+Vertical offset of xtup # +c 27 Stemlength override +cc 28-30 New stem length. +ccccccccccccc +cc isdat1 cc +ccccccccccccc +c 13-17 iv +c 3-10 ip +c 11 start/stop switch +c 12 kv-1 +c 19-25 ichar(code$) +c 26 force direction? +c 27 forced dir'n = up if on, set in sslur; also +c final direction, set in doslur when beam is started, used on term. +c 28-31 ndxslur, set in doslur when beam is started, used on term. +ccccccccccccc +cc isdat2 cc +ccccccccccccc +c 0 Chord switch. Not set on main note. +c 1-2 left/right notehead shift. Set only for chord note. +c 3 tie positioning +c 4 dotted slur +c 6-11 voff1 1-63 => -31...+31 +c 12-18 hoff1 1-127 => -6.3...+6.3 +c 19-25 nolev +c 26 \sluradjust (p+s) +c 27 \nosluradjust (p-s) +c 28 \tieadjust (p+t) +c 29 \notieadjust (p-t) +ccccccccccccc +cc isdat3 cc +ccccccccccccc +c 0 set if midslur (at least one argument) +c 1 set if curve (2 more args) +c 2-7 32+first arg (height correction) (1st arg may be negative) +c 8-10 second arg (initial slope) +c 11-13 third arg (closing slope) +c 14-21 tie level for use in LineBreakTies +c 22-29 ncm for use in LineBreakTies +ccccccccccccc +cc isdat4 cc Set these all at turn-on using s option +ccccccccccccc +c 0-5 Linebreak seg 1 voff 1-63 => -31...+31 +c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 +c 16-21 Linebreak seg 2 voff 1-63 => -31...+31 +c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 +ccccccccccccc +c icrdat c +ccccccccccccc +c 0-7 ip within voice +c 8-11 ivx (together with 28th bit) +c 12-18 note level +c 19 accidental? +c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) +c 23 shift left +c 24 shift right +c 25 arpeggio start or stop +c 26 flag for moved dot (here, not icrdot, since this is always reset!) +c 27 Midi-only accidental +c 28 (6/27/10) 5th bit for ivx, to allow up to 24 voices +c 29 Tag for accidental shift...means add to autoshifts. +c 31 Flag for cautionary accidental on chord note +ccccccccccccc +c icrdot c: +ccccccccccccc +c 0-6 10*abs(vertical dot shift in \internote) + 64 +c 7-13 10*abs(horizontal dot shift in \internote) + 64 +c 14-19 vert accidental shift-32 +c 20-26 20*(horiz accidental shift+3.2) +c 27-29 top-down level rank of chord note w/accid. Set in crdaccs. +c +c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. +c +cccccccccccccccccccccccccccccccc + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + character*10 figq + common /comignorenats/ mbrhgt,newmbrhgt,ignorenats + logical ignorenats,newmbrhgt + character*1 ulq,sepsymq,sq,chax + logical beamon,firstgulp,figbass,figchk, + * isfig,rptnd1,rptprev + logical loop,lastchar,slint,svolta,evolta,onvolt, + * cwrest(nm),islast,inlast,optimize + integer istop(80),numbms(nm),istart(80) + real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks), + * tstart(80),squez(80) + character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq + character*79 notexq,inameq + character*40 pathnameq + character*44 basenameq + character*24 fmtq + character*20 voltxtq + character*120 instrq,titleq,compoq + common /comlast/ islast,usevshrink + logical usevshrink,stickyS,OptLineBreakTies,autofbon + common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1 + common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, + * inhead + common /cominbot/ inbothd + common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), + * fullsize(nm),ivxfig2,ivvfig(2,74) + common /comnsp/ space(80),nb,prevtn(nm), + * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) + common /comstart/ facmtr + common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb, + * tautofb,autofbon,t1autofb + common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, + * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, + * rptprev,equalize,rptfq1,rptfq2 + common /combeam/ ibmtyp + common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, + * OptLineBreakTies,HeaderSpecial + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comas2/ nasksys,wasksys(800),elasksys(800) + common /comas3/ ask(2500),iask,topmods + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + common /comsln/ is1n1,is2n1,irzbnd,isnx + common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft, + * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr, + * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit, + * graspace(37), + * lenlit(83),multg(37),upg(37),slurg(37),slashg(37), + * naccg(74),voltxtq(6),litq(83) + logical upg,slurg,slashg,fbon,ornrpt,shifton,isbjmp,notcrd,was2, + * isbj2,fontslur,WrotePsslurDefaults,HeaderSpecial + common /comivxudorn/ivxudorn(63) + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + character*128 litq,lnholdq + logical upslur,bar1syst,vshrink,lrpt,rrpt,lrptpend, + * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb, + * btest,sluron,setis,nobar1 + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) + common /compoi/ ispoi + common /combc/ bcspec + common /comeon/ eonk,ewmxk + common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac, + * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac, + * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac, + * rtshfac + common /comhsp/ hpttot(176) + common /combmh/ bmhgt,clefend + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + common /strtmid/ ihnum3,flipend(nm),ixrest(nm) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + common /commus/ musize,whead20 + common /comtol/ tol + common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12), + * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41), + * idynda2(99),levhssav(nm),listcresc,listdecresc + character*128 txtdynq + logical mrecord,mplay,endmac,flipend,istype0,lowdot,rename,ispstie + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc,equalize, + * ismbr,putmbr + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /comcb/ nbc,ibcdata(36) + common /comclefq/ clefq + common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), + * ArpShift(20) + common /comligfont/ isligfont + logical isligfont + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /combibarcnt/ ibarcnt + character*40 nmq + common /commidisig/ midisig + common /comclefrests/ centrests + logical newclef, centrests + common /comlyr/ inputmlyr + logical inputmlyr + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comhair/ idhairuse,idhair(nm) + common /comc8flag/ c8flag(nm) + logical c8flag + common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn, + * poefa + real*4 poefa(125) + logical nocodabn + character*3 shortfraq,rendq + bottopgap = .false. + inputmlyr = .false. + idhairuse = 0 + if (.not.optimize) then + print* + print*,'Starting second PMX pass' + print* + write(15,'(a)')'Starting second PMX pass' + end if + newclef = .false. + centrests = .false. + ncalls = ncalls+1 + islast = inlast + macuse = 0 + isyscnt = 0 + stemmax = 8.2 + stemmin = 3.9 + stemlen = 6.0 + sq = chax(92) + ignorenats = .false. + newmbrhgt = .false. + bcspec = .true. + topmods = .false. + ismbr = .false. + read(12,'(a)')basenameq + read(12,*)lbase + read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop, + * etabot,inbothd,inhnoh,isig + ilbuf = 1 + ipbuf = 0 + call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,xmtrnum0, + * npages,nsyst,musicsize,fracindent,istype0,inameq, + * clefq,sepsymq,pathnameq,lpath,isig0) + if (ismidi) then +c +c Initial key signature and meter for pickup bar +c 130313 Unless explicit miditranspose for all parts (to be dealt with later), +c want concert sig (isig0) here. K+n+m will have changed sig to isig +c call midievent('k',isig,0) +c 130316 +c call midievent('k',isig0,0) +c call midievent('k',midisig,0) +c +c Above is probably cosmetic +c call midievent('k',midisig,0) + if (xmtrnum0 .gt. tol) then +c +c We have a pickup. Some tricky stuff to get a meter: +c + xntrial = xmtrnum0 + do 5 ip2 = 0 , 5 + if (abs(mod(xntrial,1.)) .lt. tol) go to 6 + xntrial = xntrial*2 +5 continue + print*,'Problem finding meter for pickup bar' + xntrial = 1. + ip2 = 0 +6 continue + call midievent('m',nint(xntrial),2**ip2*mtrdenl) + else +c +c No pickup, enter the starting meter +c + call midievent('m',mtrnuml,mtrdenl) + end if + end if +c +c Set musicsize from value passed in common, due to possible reset by S[n]m16 +c + musicsize = musize + read(12,*)npages,widthpt,height,hoffpt,voffpt,nsyst, + * (nsystp(ipa),xnsttop(ipa),xintstaff(ipa),ipa=1,npages),iauto +c +c If default width ever changes, must adjust this stmt. +c + slfac1 = 0.00569*524./widthpt + figbass = .false. + read(13,*)ifig + if (ifig .eq. 1) then + figbass = .true. + open(14,status='SCRATCH') + write(14,'(a)')sq//'def'//sq//'fixdrop{'//sq//'advance'//sq// + * 'sysno by 1'//sq//'ifcase'//sq//'sysno%' + end if + lastchar = .false. + ibcoff = 0 + if (xmtrnum0 .gt. 0.) ibcoff = -1 + open(11,status='SCRATCH') +c +c vshrink for the first page is calculated in topfile, +c and if true set interstaff=10. vshrink affects Titles. +c Must also save vshrink for page ending. +c + call topfile(basenameq,lbase,nv,clefq,noinst,musicsize, + * xintstaff(1),mtrnmp,mtrdnp,vshrink,fbar,fontslur) +c +c ninow is working value of # of instruments. noinst is max #, and # at start. +c + ninow = noinst +c +c Save original printed meter in case movement breaks +c + movnmp = mtrnmp + movdnp = mtrdnp +c + if (islast .and. figbass .and. musicsize.eq.16) + * write(11,'(a)')sq//'def'//sq//'figfont{'//sq//'eightrm}%' +c + if (islast .and. isligfont) then + if (musicsize .eq. 16) then + write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 8pt%' + else + write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 10pt%' + end if + end if + lenbeat = ifnodur(mtrdenl,'x') + if (mtrdenl .eq. 2) lenbeat = 16 + lenb1 = mtrnuml*lenbeat + if (mtrdenl .eq. 2) lenb1 = lenb1*2 + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + lenb0 = nint(xmtrnum0*lenbeat) + if (mtrdenl .eq. 2) lenb0 = lenb0*2 + if (lenb0 .ne. 0) then + if (islast) write(11,'(a)')sq//'advance'//sq//'barno by -1' + lenbar = lenb0 + else + lenbar = lenb1 + end if +c +c Initialize full-program variables +c + fixednew = 0. + scaldold = 0. + fintstf = -1. + gintstf = 1. + nasksys = 0 + ibarcnt = 0 + iline = 0 + movbrk = 0 + isystpg = 0 + ipage = 1 + iccount = 128 + iask = 0 + nhstot = 0 + nb = 1 + if (.not.optimize) jprntb = 81 + idsig = 0 + iflagbot = 0 +c +c Next 5 are raise-barno parameters. irzbnd is integer part of default level. +c + irzbnd = 3 + if (isig.eq.3 .and. clefq(nv).eq.'t') irzbnd = 4 + is1n1 = 0 + isnx = 0 + SlurCurve = 0. + ishort = 0 + nocodabn = .false. + mbrsum = 0 + nmbr = 0 +c +c 111109 Made global rather than per gulp +c + ndyn = 0 + ispoi = .false. + slint = .false. + lrptpend = .false. + rptnd1 = .false. + rptfq2 = 'E' + rptprev = .false. + onvolt = .false. + flgndb = .false. + fbon = .false. + shifton = .false. + ornrpt = .false. + setis = .false. + lowdot = .false. + rename = .false. + nobar1 = .false. + equalize = .false. + usevshrink = .true. + WrotePsslurDefaults = .false. + OptLineBreakTies = .false. + HeaderSpecial = .false. +c +c vshrink is initialized in topfile +c + stickyS = .false. +c +c ixrest = 1 or 2 if xtup has started with a rest +c + do 1 ivx = 1 , nm + ixrest(ivx) = 0 + fullsize(ivx) = 1. +c +c Set legacy note level to middle c as default +c + ndlev(ivx,1) = 29 + ndlev(ivx,2) = 29 +1 continue + npreslur = 0 + nhssys = 0 + listslur = 0 + do 31 i = 1 , 202 + isdat1(i) = 0 + isdat2(i) = 0 +31 continue + nsdat = 0 +c +c Initialize flag for figures in any other voice than 1 +c + ivxfig2 = 0 +c +c Initialize for loop over gulps +c + firstgulp = .true. +c +c Start a gulp +c +30 loop = .true. + notcrd = .true. + isbjmp = .false. + isbj2 = .false. + autofbon = .false. + tautofb = 0. + nbars = 0 + nfigs(1) = 0 + nfigs(2) = 0 + ngrace = 0 + ntrill = 0 + ncrd = 0 + nudorn = 0 + nlit = 0 + nvolt = 0 + ibarmbr = 0 + nudsp = 0 +c ndyn = 0 ! 111109 + ntxtdyn = 0 + nbc = 0 + NumArpShift = 0 + do 3 i = 1 , 37 + graspace(i) = 0. +3 continue +c +c Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst. +c and also if nv increases in an 'M' directive. +c + do 4 iv = 1 , nv + call newvoice(iv,clefq(iv),.false.) +4 continue +c +c Check if endsymbol was set earlier +c + if (rptnd1) then + rptnd1 = .false. + rptfq2 = rptfq1 + else +c +c Only use if movbrk>0, to signal default ('RD') +c + rptfq2 = 'E' + end if + iv = 1 + ivx = 1 +2 if (loop) then +c +c Within this loop, nv voices are filled up for the duration of the block. +c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) +c nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..). +c nbars is for this input block. +c Only at the beginning of an input block will there be a possible mtr change, +c signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) +c + call getnote(loop) + if (lastchar) go to 40 + go to 2 + end if +c +c Finished an input block (gulp). +c + if (ismidi) then +c +c Put rests into midi array for 2nd lines that were not used in this gulp. +c + do 60 iv = 1 , nv + if (twoline(iv) .and. nvmx(iv).eq.1) then + if (firstgulp .and. lenb0.ne.0) then + call addmidi(midchan(iv,2),0,0,0, + * (nbars-1.)*lenbar+lenb0,.true.,.false.) + else + call addmidi(midchan(iv,2),0,0,0,1.*nbars*lenbar,.true., + * .false.) + end if + end if +60 continue + end if + nvolt = 0 + do 28 iv = 1 , nm + nudoff(iv) = 0 + maxdotmv(iv) = ndotmv(iv) + ndotmv(iv) = 0 +28 continue +c +c Put stuff at top of p.1. Must wait until now to have read title info. +c + if (ibarcnt .eq. 0) then + call puttitle(inhnoh,xnsttop(ipage), + * etatop,sq,etait,etatc,etacs1,nv,vshrink,sepsymq) + if (HeaderSpecial) +c +c Write special header for first page +c + * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%' + end if + do 10 ibar = 1 , nbars + ibarcnt = ibarcnt+1 + bar1syst = ibarcnt .eq. iauto + ndig = max(0,int(log10(.001+ibarcnt+ibcoff))) + if (islast) + * write(11,'(a11,i'//chax(50+ndig)//')') + * '% Bar count',ibarcnt+ibcoff + if (ibar .ne. ibarmbr) then + if (.not.optimize) call outbar(ibarcnt+ibcoff,jprntb) + else + if (.not.optimize) then + write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars', + * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1 + write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars', + * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1 + jprntb = 0 + end if + ibcoff = ibcoff+mbrest-1 +c if (ibar.eq.1 .and. firstgulp .and. +c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize + if (ibar.eq.1 .and. firstgulp .and. + * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize + end if +c +c Move the read to after end-of-bar hardspace checks, so we get right poenom +c at end of a line. +c if (bar1syst) read(12,*) poenom +c +c Check for clef at start of bar. No slide yet. Also flags at end of prev. +c bar. This block is run at the start of every bar. May fail for flag at +c end of last bar. To account for necc. hardspaces, compute and store +c nhssys = # of hard spaces for this system +c hesk(nhssys) = elemskips avialable +c hpts(nhssys) = hard points needed, including notehead +c Here, merely insert placeholder into output. Later, when poe is computed, +c compute additional pts and store them in hpttot(1...nhstot). Finally in +c subroutine askfig, write true pts where placeholders are. +c + ioff = 0 + if (ibar .gt. 1) ioff = nib(1,ibar-1) + clchb = btest(islur(1,ioff+1),15) + putmbr = .false. + if (ismbr) then + if (clchb) then +ccc +ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. +ccc + write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest' + * //sq//'def'//sq//'mbrest#1#2#3{%' + write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55, + * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%' +cc +cc RDT suggestion is inset blank barline - 160103 Abandoned +cc +c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' +c * //sq//'advance'//sq//'barno-1' + end if + ismbr = .false. + putmbr = .true. + end if + if (ibar .eq. ibarmbr) ismbr = .true. +c +c Set flag here so at start of next bar, if there's a clef change, can add space +c after the mbr with the above kluge +c + if (.not.(clchb .or. flgndb)) go to 23 +c +c Must check available space +c + ptsndb = 0. +c +c Zero out block signal +c + if (clchb) islur(1,ioff+1) = ibclr(islur(1,ioff+1),15) +c +c In this loop, we determine how much hardspace is needed (if any) +c 9/7/97 Note that for last bar in input block, if number of lines of +c music decreases in new block, highest numbered ones won't be checked +c since the loop below covers the new nvmx(iv), not necessarily the old +c one. +c 4/18/98 Apparently nmxsav was a solution to the above problem +c + do 16 iv = 1 , nv + do 1699 kv = 1 , nvmxsav(iv) + ivx = ivmxsav(iv,kv) + ptsndv = flgndv(ivx)*wheadpt + ioff = 0 + if (ibar .gt. 1) then + ioff = nib(ivx,ibar-1) + ip = ioff + if (ibar.gt.2) ip = ioff-nib(ivx,ibar-2) +c prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) + prevtn(ivx) = tnote(ipl2(ivx,ip)) +c +c If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. +c + end if +c +c Only allow clef changes when ivx <= nv +c + if (ivx .le. nv) then + clchv(iv) = clchb .and. btest(islur(iv,ioff+1),11) + if (clchv(iv)) then +c +c Clef change in this voice. Turn off signal. Get space avail. +c + islur(iv,ioff+1) = ibclr(islur(iv,ioff+1),11) + if (abs(prevtn(iv)-space(nb)).lt.tol) ptsndv = + * ptsndv+clefend*wheadpt + end if + end if + ptsndb = max(ptsndb,ptsndv+wheadpt*xspfac) +1699 continue +16 continue +c +c ???? where is nb set??? nb probably in left over from makeabar +c + esk = feon(space(nb)*squez(nb)) + ptsdflt = esk*poenom-wheadpt +c if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then + if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0 + * .and. .not.putmbr) then +c +c Must ADD hardspace! So put in a placeholder, and store params for later. +c + if (islast) write(11,'(a)')sq//'xardspace{ pt}%' + nhssys = nhssys+1 + if (ptsndb-ptsdflt .gt. ptsgnd-poenom*eskgnd) then + hesk(nhssys) = esk + hpts(nhssys) = ptsndb+wheadpt + else + hesk(nhssys) = eskgnd + hpts(nhssys) = ptsgnd+wheadpt + end if + fixednew = fixednew+hpts(nhssys) + scaldold = scaldold+hesk(nhssys) + end if + if (clchb) then + do 17 iv = 1 , nv + if (clchv(iv)) then + notexq = sq//'znotes' + lnote = 7 + do 24 iiv = 2 , iv + notexq = notexq(1:lnote)//sepsymq(iiv-1) + lnote = lnote+1 +24 continue +c +c Recompute ioff since it will vary from voice to voice +c + if (ibar .eq. 1) then + ioff = 0 + else + ioff = nib(iv,ibar-1) + end if +c +c Must call clefsym to get nclef, even if there is a movement break +c + call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef) +c +c If clefq = '8', must change '0' in pos'n 9 to '8' +c + if (btest(ipl(iv,ioff+1),2)) fmtq = + * fmtq(1:8)//'8'//fmtq(10:10) + if (movbrk.eq.0 .and. + * islast) + * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%' + call wsclef(iv,ninow,nclef) +c +c Set new flag to be used just outside this loop, to kluge +c any calls to \CenterBar for full-bar rests, to make room for clef. +c + newclef = .true. +c +c 151220 +c wrong test: +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c Replaced with right one. But also, clefq(iv) seems to stay at 8 here, +c and if we change from TLO to normal clef, need to resetclefsymbols +c +c if (clefq(iv) .eq. '8') then + if (btest(ipl(iv,ioff+1),2)) then +c +c Find instrument number for voice iv +c + iv1 = 1 + do 1111 iinst = 1 , ninow + if (iv .lt. iv1+nspern(iinst)) go to 2222 + iv1 = iv1+nspern(iinst) +1111 continue + print* + print*,'Should not be here in pmxb!' + call stop1() +2222 continue + if (iinst .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iinst, + * sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iinst, + * sq//'treblelowoct%' + end if + c8flag(iv) = .true. + else + if (clefq(iv) .eq. '8') then + write(11,'(a20)')sq//'resetclefsymbols' + end if + end if + end if +17 continue + if (islast) write(11,'(a)')sq//'pmxnewclefs' + end if +23 continue +c +c Kluge \CenterBar for whole bar rests if necessary +c + if (newclef .and. centrests) then +c write(11,'(a)')sq//'def'//sq//'value{11}%' + nvalue = nint(.55*musicsize) + if (nvalue .gt. 10) then + write(11,'(a11,i2,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + else + write(11,'(a11,i1,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + end if + end if + newclef = .false. + centrests = .false. +c +c End of loop for end-of-bar hardspaces and non-movbrk clef symbol. +c + if (bar1syst) then + read(12,*) poenom + end if +c +c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) +c + if (ibar .eq. 1) then + islnow = islur(1,1) +c iornqnow = iornq(1,1) + iplnow = ipl(1,1) + else + islnow = islur(1,nib(1,ibar-1)+1) +c iornqnow = iornq(1,nib(1,ibar-1)+1) + iplnow = ipl(1,nib(1,ibar-1)+1) + end if +c +c Check for R-symbols set at end of prior input block +c + if (movbrk.eq.0 .and. rptfq2.ne.'E') then + if (rptfq2 .eq. 'D') then + islnow = ibset(islnow,26) + else if (rptfq2 .eq. 'r') then + islnow = ibset(islnow,6) + else if (rptfq2 .eq. 'd') then + islnow = ibset(islnow,8) + else if (rptfq2 .eq. 'b') then + islnow = ibset(islnow,25) + else + print* + print*,'Illegal symbol with "R" at end of input block:', + * rptfq2 + call stop1() + end if + rptfq2 = 'E' + end if + if (iand(islnow,352) .ne. 0) then +c +c Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set +c + lrpt = btest(islnow,5) + rrpt = btest(islnow,6) + lrptpend = lrpt.and.bar1syst + if (lrpt .and. .not.lrptpend) then + if (rrpt) then + if (islast) write(11,'(a)')sq//'setleftrightrepeat' + fixednew = fixednew+wheadpt*lrrptfac-0.4 + else + if (islast) write(11,'(a)')sq//'setleftrepeat' + fixednew = fixednew+wheadpt*rptfac-0.4 + end if + else if (rrpt) then + if (islast) write(11,'(a)')sq//'setrightrepeat' + fixednew = fixednew+wheadpt*rptfac-0.4 + else if (btest(islnow,8)) then + if (islast) write(11,'(a)')sq//'setdoublebar' + fixednew = fixednew+wheadpt*dbarfac-0.4 + end if + else if (btest(islnow,26)) then +c +c doubleBAR +c + if (islast) write(11,'(a)')sq//'setdoubleBAR' + fixednew = fixednew+wheadpt*ddbarfac-0.4 +c else if (btest(iornqnow,29)) then + else if (btest(iplnow,0)) then +c +c no bar line +c +c-- if (islast) write(11,'(a)')sq//'setzalaligne' +c++ + if (islast) then + if (movbrk .eq. 0) then + write(11,'(a)')sq//'setzalaligne' + else +c +c Encountered "Rz" at start of input block at start of new movement, Must +c use newmovement macro with arg 4 rather than setzalaligne, since former +c already redefines stoppiece. +c + rptfq2 = 'z' + end if + end if +c++ + fixednew = fixednew-0.4 + end if +c +c 1st and 2nd endings +c + svolta = btest(islnow,7) + evolta = btest(islnow,9) + if (evolta) then + if (btest(islnow,10)) then + if (islast) write(11,'(a)')sq//'endvoltabox' + else + if (islast) write(11,'(a)')sq//'endvolta' + end if + onvolt = .false. + end if + if (svolta) then + nvolt = nvolt+1 + lvoltxt = index(voltxtq(nvolt),' ')-1 + if (lvoltxt .eq. 1) then + if (islast) write(11,'(a)')sq//'Setvolta' + * //voltxtq(nvolt)(1:1)//'%' + else + if (islast) write(11,'(a)')sq//'Setvolta'//'{'// + * voltxtq(nvolt)(1:lvoltxt)//'}%' + end if + onvolt = .true. + end if + if (ibar .gt. 1) then + ipnow = nib(1,ibar-1)+1 + else + ipnow = 1 + end if + iplnow = ipl(1,ipnow) + if (bar1syst) then +c +c If listslur>0, then there is at least one slur or tie carried over the break +c + ispstie = .false. + if (OptLineBreakTies .and. .not.fontslur .and. listslur.ne.0 + * .and. islast) + * call LineBreakTies(isdat1,isdat2,isdat3,isdat4, nsdat, + * ispstie,sepsymq) + iline = iline+1 +c +c End an old system, Start a new system +c +c Reduce space before mbrest at start of system +c Need this even if no accidentals in key signature +c + if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize +c + if (iline .ne. 1) then +c +c Not first line. +c Get corrected poe = points/elemskip for *previous* system +c + wdpt = widthpt*(1-fracindent) + poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/ + * (elsktot+fbar*nbarss-scaldold) + isyscnt = isyscnt+1 + poevec(isyscnt) = poe +c +c Transfer data for system into global arrays to hold until very end +c + do 9 ia = 1 , nasksys + iask = iask+1 + ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia))) + * /poefa(iline-1) +c +c Only admit negative ask if it was user-defined space, signalled by elask<=0. +c + if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.) +9 continue + do 25 ia = 1 , nhssys + nhstot = nhstot+1 + hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.) +25 continue +c +c Reset counters for new system +c + scaldold = 0. + fixednew = 0. + nasksys = 0 + nhssys = 0 + end if +c +c End of if block for first bar of non-first system. Still 1st bar, any system +c + if (islast.and.figbass) write(11,'(a)')sq//'fixdrop%' + isystpg = isystpg+1 +c +c Try moving the next stmt way down, to fix a bug and get \eject printed at +c end of single-system page. +c if (isystpg .eq. nsystp(ipage)) isystpg = 0 + read(12,*)nbarss,elsktot,fsyst,frac,eonk,ewmxk + if (iline .gt. 1) fracindent=frac + if (figbass) then + ifigdr(1,iline) = 4 + ifigdr(2,iline) = 4 + end if + slfac = slfac1*musicsize*elsktot + if (iline .ne. 1) then +c +c For the line just _finished_, put figdrop in separate file. +c + if (figbass) write(14,'(a9,i2,a10,i2,1x,a4)') + * sq//'figdrop=',ifigdr(1,iline-1), + * ' '//sq//'figdtwo=',ifigdr(2,iline-1),sq//'or%' +c +c Check slurs in top staff for interference w/ barno. Only check when +c # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS +c keep track of ons and offs when |isig|<=3. +c + ndigbn = int(alog10(ibarcnt+ibcoff+.01))+1 + isnx = 0 + if (ndigbn.ge.iabs(isig) .and. is1n1.gt.0) then +c +c There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 +c Look for termination in remainder of this input block. If not found, +c just use is1n1. Remember, haven't slid down yet. +c + ioff = 0 + if (ibar .gt. 1) ioff = nib(ivmx(nv,nvmx(nv)),ibar-1) + do 50 isdat = 1 , nsdat + if (igetbits(isdat1(isdat),5,13).eq.ivmx(nv,nvmx(nv)) + * .and. .not.btest(isdat1(isdat),11) + * .and. igetbits(isdat1(isdat),7,19).eq.is2n1) then +c +c Found slur ending. Just check note height, can't do fine adjustments. +c +c is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) + is1n1 = max(is1n1,igetbits(isdat2(isdat),7,19)) + go to 51 + end if +50 continue +c +c If exiting loop normally, did not find end of slur. c'est la vie. +c +51 continue + isnx = idim(is1n1,ncmid(nv,1)+1+irzbnd) + if (isnx .gt. 0) then +c +c AHA! Slur likely to interfere with barno. +c +c Modified 090525 to use \bnrs +c + slint = .true. + fmtq = '(a16,i1,a14)' + if (irzbnd+isnx .gt. 9) fmtq = '(a16,i2,a14)' + if (islast) write(11,fmtq)sq//'def'//sq//'raisebarno{', + * irzbnd+isnx,'.5'//sq//'internote}%' +c if (islast) then +c if (isnx .le. 9) then +c write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%' +c else +c write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%' +c end if +c end if +c + end if + end if + if (movbrk .gt. 0) then +c +c movbrk = 0 +c Move the reset down, so can use movbrk>0 to stop extra meter prints. +c +c New movement. Redefine stoppiece, contpiece. These will be called either +c explicitly or as part of alaligne. +c indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. +c This is passed to \newmovement. +c + if (rptfq2 .eq. 'E') rptfq2 = 'D' + indsym = index('Ddrbz',rptfq2)-1 + rptfq2 = 'E' +c +c Also check for Rd or Rr set the normal way +c + if (btest(islnow,8)) then + indsym = 1 + else if (btest(islnow,6)) then + indsym = 2 + end if + if (indsym .lt. 0) then + print* + print*,'Illegal end symbol before "/"' + call stop1() + end if +c +c Check for continuation (no bar number reset) +c + if (islast.and.nobar1) then + write(11,'(a)')sq//'advance'//sq//'barno1' + * //sq//'global'//sq//'startbarno'//sq//'barno%' +c +c Need above for shortening case mcm with Mc +c + end if +c +c Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement +c +c if (movgap .lt. 10) then +c if (islast) write(11,'(a12,2i1,a1)') +c * sq//'newmovement',movgap,indsym,'%' +c else +c if (islast) write(11,'(a13,i2,a1,i1,a1)') +c * sq//'newmovement{',movgap,'}',indsym,'%' +c end if + if (islast) then + nmq = sq//'newmovement' + lnmq = 12 + if (movgap .lt. 10) then + lnmq = 14 + write(nmq(13:14),'(2i1)')movgap,indsym + else + lnmq = 17 + write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym + end if + if (ninow .lt. 10) then + lnmq = lnmq+1 + write(nmq(lnmq:lnmq),'(i1)')ninow + else + lnmq = lnmq+4 + write(nmq(lnmq-3:lnmq),'(a1,i2,a1)')'{',ninow,'}' + end if + lnmq = lnmq+1 + write(nmq(lnmq:lnmq),'(a1)')'%' + if (ishort .eq. 4) then +c +c Ending Short-blank-coda +c + write(11,'(a)')sq//'Endpiece}}%' + end if + write(11,'(a)')nmq(1:lnmq) + if (ishort .eq. 2) then + write(11,'(a)')sq//'stoppiece}}%' + ishort = 5 + else if (ishort .eq. 4) then + write(11,'(a)')sq//'let'//sq//'stoppiece'//sq// + * 'holdstop%' +c +c Since we bypass newmovement, need to set the vertical gap. +c + if (movgap .gt. 10) then + write(11,'(a6,i2,a11)') + * sq//'vskip',movgap,sq//'internote%' + else if (movgap .gt. 0) then + write(11,'(a6,i1,a11)') + * sq//'vskip',movgap,sq//'internote%' + end if + ishort = 6 + end if + if ((ishort.eq.5.or.ishort.eq.6).and..not.rename) then + do 62 iinst = 1 , ninow + if (islast) then + if (iinst .lt. 10) then + write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%' + else + write(11,'(a9,i2,a4)')sq//'setname{',iinst, + * '}{}%' + end if + end if +62 continue + end if + rename = .false. + end if +c +c Change generalmeter if necessary +c + if (islast) then + call wgmeter(mtrnmp,mtrdnp) + end if +c Removed next line 211207 to fix beaming problem at new movement+meter change. +c mtrnuml = 0 +c +c (Moved all name-writing to getnote, right when 'M' is detected) +c + if (btest(iplnow,28)) then +c +c Key signature at movement break +c + iplnow = ibclr(iplnow,28) + if (isig .gt. 0) then + if (islast) write(11,'(a18,i1,a2)') + * sq//'generalsignature{',isig,'}%' + else + if (islast) write(11,'(a18,i2,a2)') + * sq//'generalsignature{',isig,'}%' + end if + if (islast .and. LaterInstTrans) then + call Writesetsign(nInstTrans,iInstTrans,iTransKey, + * LaterInstTrans) + end if + end if + if (parmov .ge. -.1) then +c +c Resent paragraph indentation +c + ipi = parmov*widthpt+.1 + if (ipi .lt. 10) then + if (islast) write(11,'(a11,i1,a2)') + * sq//'parindent ',ipi,'pt' + else if (ipi .lt. 100) then + if (islast) + * write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt' + else + if (islast) + * write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt' + end if + end if + if (ishort .eq. 6) then + if (iflagbot .eq. 1) then + write(11,'(a)')sq//'vfill'//sq//'eject' +c iflagbot = 0 +c ishort = 0 + else + write(11,'(a)')sq//'contpiece' + end if +c +c Zero ishort later trying to write alaligne +c + end if + end if ! End of movement break stuff + if (isystpg .eq. 1) then +c +c First line on a page (not 1st page, still first bar). Tidy up old page +c then eject. +c +c Removed this 5/13/01 as it was causing double endvoltas. This probably +c is only needed at the end in case there is no endvolta specified. +c if (onvolt) then +cc if (islast) write(11,'(a)')sq//'endvoltabox%' +cc onvolt = .false. +c end if +c +c +c Check for meter change at start of a new PAGE +c + if (mtrnuml .gt. 0) then +c +c Meter change at start of a new page. Ugly repeated coding here. +c + mtrnms = mtrnuml + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + mtrnuml = mtrnms + if (movbrk .eq. 0 .and. islast) then + call wgmeter(mtrnmp,mtrdnp) + end if + end if +c +c Key signature change? +c + if (btest(iplnow,28) .and. movbrk.eq.0) then + notexq = sq//'xbar'//sq//'addspace{-'//sq// + * 'afterruleskip}'//sq//'generalsignature{' + lnote = 49 + if (isig .lt. 0) then + notexq = notexq(1:49)//'-' + lnote = 50 + end if + if (islast) write(11,'(a)') + * notexq(1:lnote)//chax(48+abs(isig))//'}%' + if (islast .and. LaterInstTrans) then + call Writesetsign(nInstTrans,iInstTrans,iTransKey, + * LaterInstTrans) + end if + if (islast .and. ignorenats) + * write(11,'(a)')sq//'ignorenats%' + if (islast) write(11,'(a)')sq//'zchangecontext'//sq + * //'addspace{-'//sq//'afterruleskip}' + * //sq//'zstoppiece'//sq//'PMXbarnotrue%' + else if (mtrnuml.gt.0 .and. movbrk.eq.0) then +c +c Meter change but no signature change +c + if (islast) + * write(11,'(a)')sq//'xchangecontext'//sq//'addspace{-'// + * sq//'afterruleskip}'//sq//'let'//sq//'bnat'//sq// + * 'barnoadd%' + if (islast) + * write(11,'(a)')sq//'def'//sq//'barnoadd{'//sq//'let'// + * sq//'barnoadd'//sq//'bnat}'//sq//'zstoppiece%' + else + if (islast) then + if ((ishort.eq.4.or.ishort.eq.2) + * .and. iflagbot.eq.1) then + ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum + if (ntmp .le. 9) then + shortfraq(1:1) = char(48+ntmp) + lntmp = 1 + else + write(shortfraq(1:2),'(i2)')ntmp + lntmp = 2 + end if + write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq + * //'barno'//shortfraq(1:lntmp) +c +c Move down so can insert fil@begin +c iflagbot = 0 +c ishort = 0 +c + else if ((ishort.ne.6.and.ishort.ne.2) .or. + * iflagbot.ne.1) then + write(11,'(a)')sq//'stoppiece%' + end if + end if + end if +c +c This is the key spot when vshrink is used. Value of vshrink here comes from +c just after the prior pagebreak, i.e., it is not affected by "Av" +c that may have been entered at this pagebreak, since that only affects usevshrink. +c So choose page *ending* (with or without \vfill) depending on old vshrink. Then +c check value of usevshrink to reset vshrink if necessary for the new page, where +c we have to set \interstaff and later call puttitle. +c Top of first page needs special treatment. For this we use +c novshrinktop, which was set in g1etnote on the first pass, since on +c second pass, vshrink at top of page one is dealt with in topfile, which is called +c *before* any reading in any "Av" at the top of the first input block. +c + if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if + xnstbot = xnsttop(ipage)*etabot/etatop + if (xnstbot .lt. 9.95) then + fmtq = '(a,f3.1,a)' + else + fmtq = '(a,f4.1,a)' + end if + if (islast) write(11,fmtq)sq//'vskip',xnstbot, + * sq//'Interligne'//sq//'eject%' + if (islast .and. bottopgap) then + if (abs(topamt) .gt. 1.e-6) then + if (topamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (topamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (topamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',topamt, + * sq//'Internote%' + end if + bottopgap = .false. + end if + else + if (islast) then + if (iflagbot.eq.1.and.ishort.eq.6)then +c +c cleanup for case bcm only +c + iflagbot = 0 + ishort = 0 + else + write(11,'(a)') sq//'vfill'//sq//'eject%' + if (iflagbot.eq.1.and.ishort.eq.2) then +c Clean up case bsl only + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + iflagbot = 0 + ishort = 0 + end if + end if + end if + end if + ipage = ipage+1 +c +c Now that page is ejected, compute new vshrink +c + vshrink = xintstaff(ipage).gt.20 .and. usevshrink + if (vshrink) then + xinsnow = 10 + else + xinsnow = xintstaff(ipage) + end if + if (fintstf.gt.0 .and. ipage.gt.1) then + xinsnow = xinsnow*fintstf/gintstf + fintstf = -1. + end if + if (xinsnow .lt. 9.95) then + fmtq = '(a,f3.1,a)' + else if (xinsnow .lt. 99.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if +c +c Vertical spacing parameters, then restart +c + if (is4bignv) xinsnow = .95*xinsnow + if (islast) then + write(11,fmtq)sq//'interstaff{',xinsnow, + * '}'//sq//'contpiece' + end if +c +c Check for meter change at start of a new PAGE +c + if (mtrnuml .gt. 0) then +c +c Meter change at start of a new page +c + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + if (movbrk .eq. 0) then + if (islast) then + call wgmeter(mtrnmp,mtrdnp) + end if + if (mtrdnp .gt. 0) then + if (islast) write(11,'(a)')sq//'newtimes2%' + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize + end if + end if + end if +c +c If no real titles here, which there probably will never be, make vertical +c space at page top with \titles{...}. headlog=.false.<=>no real titles +c + if (ishort.eq.4 .and. iflagbot.eq.1) then + ishort = 0 + iflagbot = 0 + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'//sq// + * 'makeatother' + end if + call puttitle(inhnoh,xnsttop(ipage),etatop, + * sq,etait,etatc,etacs1,nv,vshrink,sepsymq) + if (HeaderSpecial) +c +c Write special header for first page +c + * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%' + else +c +c First bar of system, not a new page, force line break +c + if (btest(iplnow,28)) then +c +c Signature change +c + notexq = sq//'xbar'//sq//'addspace{-'//sq// + * 'afterruleskip}'//sq//'generalsignature{' + lnote = 49 + if (isig .lt. 0) then + notexq = notexq(1:49)//'-' + lnote = 50 + end if + if (islast) write(11,'(a)')notexq(1:lnote) + * //chax(48+abs(isig))//'}%' + if (islast .and. LaterInstTrans) then + call Writesetsign(nInstTrans,iInstTrans,iTransKey, + * LaterInstTrans) + end if + if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%' + if (mtrnuml .ne. 0) then +c +c Meter+sig change, new line, may need mods if movement break here. +c + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + if (islast) then + call wgmeter(mtrnmp,mtrdnp) + if (ignorenats) write(11,'(a)')sq//'ignorenats%' + write(11,'(a)')sq//'xchangecontext'//sq// + * 'addspace{-'//sq//'afterruleskip}' + * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%' + write(11,'(a)')sq//'addspace{-'//sq + * //'afterruleskip}%' + call wgmeter(mtrnmp,mtrdnp) + if (ignorenats) write(11,'(a)')sq//'ignorenats%' + write(11,'(a)')sq//'zchangecontext' + end if + else + if (islast .and. ignorenats) + * write(11,'(a)')sq//'ignorenats%' + if (islast) write(11,'(a)')sq//'xchangecontext'//sq// + * 'addspace{-'//sq//'afterruleskip}' + * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%' + end if + else if (mtrnuml.eq.0.and.(ishort.eq.0.or.ishort.eq.6)) + * then +c +c No meter change +c + if (islast) then + if (ishort .ne. 6) then + write(11,'(a)')sq//'alaligne' + else + ishort = 0 + end if + end if + else if (ishort .ne. 0) then + if (ishort .eq. 1) then ! Start short line + write(shortfraq,'(f3.2)')shortfrac + write(11,'(a)')sq//'stoppiece'//sq//'parindent 0pt' + write(11,'(a)')sq//'vskip'//sq//'parskip' + write(11,'(a)')sq//'hbox to'//sq// + * 'hsize{'//sq//'vbox{'// + * sq//'hsize='//shortfraq//sq//'hsize%' + write(11,'(a)')sq//'contpiece' + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + ibarcnt0 = ibarcnt + mbrsum = 0 + ishort = 2 + nmbr = 0 + else if (ishort .eq. 2) then ! End short line, no new mvt + ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum + if (ntmp .le. 9) then + shortfraq(1:1) = char(48+ntmp) + lntmp = 1 + else + write(shortfraq(1:2),'(i2)')ntmp + lntmp = 2 + end if + write(11,'(a)')sq//'stoppiece}}'//sq//'advance'//sq + * //'barno'//shortfraq(1:lntmp) +c +c Not clear why we needed this +c //sq//'startbarno'//sq//'barno%' + write(11,'(a)')sq//'contpiece' + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + ishort = 0 + else if (ishort .eq. 5) then ! End short line, new mvt + if (nobar1) then ! Continue bar numbering + write(11,'(a)')sq//'advance'//sq + * //'barno'//char(ibarcnt-ibarcnt0+48) + * //sq//'startbarno'//sq//'barno%' +c +c Must leave in \startbarno to get msm with LMc to work. +c + end if + write(11,'(a)')sq//'startpiece'//sq//'addspace'//sq + * //'afterruleskip%' + ishort = 0 + else if (ishort .eq. 3) then ! Mid line gap, start coda +c May never come thru here. Stuff is done later at least for mcl.pmx + write(shortfraq,'(f3.2)')codafrac + write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq + * //'barno'//char(ibarcnt-ibarcnt0+48)//sq// + * 'startbarno'//sq//'barno%' + write(11,'(a)')sq//'hfill'//sq// + * 'vbox{'//sq//'hsize='//shortfraq//'%' + write(11,'(a)')sq//'contpiece' + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + ishort = 4 + else if (ishort .eq. 4) then ! End coda + ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum + if (ntmp .le. 9) then + shortfraq(1:1) = char(48+ntmp) + lntmp = 1 + else + write(shortfraq(1:2),'(i2)')ntmp + lntmp = 2 + end if + write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq + * //'barno'//shortfraq(1:lntmp) + write(11,'(a)')sq//'contpiece' + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + ishort = 0 + mbrsum = 0 + nmbr = 0 + end if + else if (mtrnuml .ne. 0) then + +c +c New meter, no new sig, end of line, not new page. +c +c \generalmeter{\meterfrac{3}{4}}% +c \xchangecontext\addspace{-\afterruleskip}% +c \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% +c \zchangecontext +c + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + if (movbrk .eq. 0) then + if (islast) then + call wgmeter(mtrnmp,mtrdnp) + end if + if (mtrdnp .gt. 0) then + if (islast) then + write(11,'(a)') + * sq//'let'//sq//'bnat'//sq//'barnoadd' + * //sq//'def'//sq//'barnoadd{'//sq//'empty}%' + write(11,'(a)')sq//'xchangecontext'//sq// + * 'addspace{-'//sq//'afterruleskip}'//sq// + * 'zalaligne'//sq//'let'//sq//'barnoadd'//sq//'bnat' + call wgmeter(mtrnmp,mtrdnp) + write(11,'(a)')sq//'addspace{-'//sq// + * 'afterruleskip}'//sq//'zchangecontext' + end if + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize + else + if (islast) write(11,'(a)')sq//'alaligne' + end if + else + if (islast) write(11,'(a)')sq//'alaligne' + end if + end if + end if +c +c Modified 090525 to use \bnrs +c + if (slint) then + slint = .false. + if (islast) write(11,'(a16,i1,a14)')sq//'def'//sq// + * 'raisebarno{',irzbnd,'.5'//sq//'internote}%' + end if + movbrk = 0 + end if +c +c Clean up if we squelched bar number reset at movement break +c + if (nobar1) then + if (islast) write(11,'(a)')sq//'startbarno1' + nobar1 = .false. + end if + read(12,*,end=14)iauto +14 continue +c +c We come thru here for the 1st bar of every system, so initialize is1n1 +c + is1n1 = 0 +c +c Brought down from above +c + if (isystpg .eq. nsystp(ipage)) then + isystpg = 0 +c +c The following is to avoid moving this reset of isystpg, but still send a signal +c down below for last system shortening events +c + if (ishort.eq.2) iflagbot = 1 + end if +c +c Check for linebreak ties +c + if (ispstie) + * call LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat, + * ispstie,sepsymq) + else +c +c Not first bar of system +c + if (btest(iplnow,28)) then +c +c Signature change +c + if (mtrnuml .ne. 0) then +c +c Meter+signature change mid line, assume no movement break +c + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + if (islast) call wgmeter(mtrnmp,mtrdnp) + notexq = sq//'generalsignature{' + lnote = 18 + if (isig .lt. 0) then + notexq = notexq(1:18)//'-' + lnote = 19 + end if + if (islast) then + iptemp = 48+abs(isig) + charq = chax(iptemp) + notexq = notexq(1:lnote)//charq//'}%' + lnote = lnote+3 + write(11,'(a)')notexq(1:lnote) + if (islast .and. LaterInstTrans) then + call Writesetsign(nInstTrans,iInstTrans,iTransKey, + * LaterInstTrans) + end if + if (ignorenats) write(11,'(a)')sq//'ignorenats%' + write(11,'(a)')sq//'xchangecontext%' + end if + if (ibar .eq. ibarmbr) then +c +c Compute space for multibar rest +c + if (lastisig*isig .ge. 0) then + naccs = max(abs(lastisig),abs(isig)) + else + naccs = abs(lastisig-isig) + end if +c xb4mbr = (facmtr+naccs*.24)*musicsize + xb4mbr = -.2*musicsize + end if + else +c +c Signature change only +c + notexq = sq//'xbar'//sq//'addspace{-'//sq// + * 'afterruleskip}'//sq//'generalsignature{' + lnote = 49 + if (isig .lt. 0) then + notexq = notexq(1:49)//'-' + lnote = 50 + end if + if (islast) + * write(11,'(a)')notexq(1:lnote)//chax(48+abs(isig))//'}%' + if (islast .and. LaterInstTrans) then + call Writesetsign(nInstTrans,iInstTrans,iTransKey, + * LaterInstTrans) + end if + if (islast .and. ignorenats) + * write(11,'(a)')sq//'ignorenats%' + if (islast) write(11,'(a)')sq//'zchangecontext'//sq + * //'addspace{-.5'// sq//'afterruleskip}%' + if (ibar .eq. ibarmbr) then +c +c Compute space for multibar rest +c + if (lastisig*isig .ge. 0) then + naccs = max(abs(lastisig),abs(isig)) + else + naccs = abs(lastisig-isig) + end if +c xb4mbr = naccs*.24*musicsize + xb4mbr = -.2*musicsize + end if + end if + else if (ishort .eq. 3) then +c +c Gap before coda, assumed no signature change! +c + ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum + if (ntmp .le. 9) then + shortfraq(1:1) = char(48+ntmp) + lntmp = 1 + else + write(shortfraq(1:2),'(i2)')ntmp + lntmp = 2 + end if + write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq + * //'barno'//shortfraq(1:lntmp) + if (nocodabn) then + write(11,'(a)')sq//'nobarno' + nocodabn = .false. + end if + write(shortfraq,'(f3.2)')codafrac + write(11,'(a)')sq//'hfill'//sq// + * 'vbox{'//sq//'hsize='//shortfraq//sq//'hsize%' + write(11,'(a)')sq//'contpiece' + write(11,'(a)')sq//'makeatletter'//sq//'fil@begin' + * //sq//'makeatother' + ishort = 4 + else if (mtrnuml .eq. 0) then +c +c No meter change +c + if (islast) write(11,'(a)')sq//'xbar' + else +c +c Change meter midline +c + call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) + if (movbrk .eq. 0) then + if (islast) then + call wgmeter(mtrnmp,mtrdnp) + end if + if (mtrdnp .gt. 0) then + if (islast) then + write(11,'(a,2i1,a)')sq//'newtimes0%' + end if +c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize + else + if (islast) write(11,'(a)')sq//'xbar' + end if + end if + end if + end if +c +c Now that xbar's are written, can put in left-repeats at line beginnings +c + if (lrptpend) then + if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1' + * //sq//'leftrepeat' + lrptpend = .false. + end if + if (ibar .gt. 1) then +c +c For bars after first, slide all stuff down to beginning of arrays +c + do 11 iv = 1 , nv + do 1199 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + ioff = nib(ivx,ibar-1) + do 12 ip = 1 , nib(ivx,ibar)-ioff + nolev(ivx,ip) = nolev(ivx,ip+ioff) + nodur(ivx,ip) = nodur(ivx,ip+ioff) + nacc(ivx,ip) = nacc(ivx,ip+ioff) + irest(ivx,ip) = irest(ivx,ip+ioff) + islur(ivx,ip) = islur(ivx,ip+ioff) + ipl(ivx,ip) = ipl(ivx,ip+ioff) + iornq(ivx,ip) = iornq(ivx,ip+ioff) + mult(ivx,ip) = mult(ivx,ip+ioff) + if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then + if (ivx.eq.1) then + isfig(1,ip) = isfig(1,ip+ioff) + else + isfig(2,ip) = isfig(2,ip+ioff) + end if + end if +12 continue + if (ivx.le.nv .and. ncc(iv).gt.1) then + islide = 0 + do 13 icc = 1 , ncc(iv) + if (tcc(iv,icc) .le. lenbar) then +c +c This time will drop <=0 when slid. +c + islide = icc-1 + ncmidcc(iv,1) = ncmidcc(iv,icc) + else + tcc(iv,icc-islide) = tcc(iv,icc)-lenbar + ncmidcc(iv,icc-islide) = ncmidcc(iv,icc) + end if +13 continue + ncc(iv) = ncc(iv)-islide + tcc(iv,1) = 0. + end if +1199 continue +11 continue + do 15 ig = 1 , ngrace + ipg(ig) = ipg(ig)-nib(ivg(ig),ibar-1) + if (ibar .gt. 2) ipg(ig) = ipg(ig)+nib(ivg(ig),ibar-2) +15 continue + do 21 il = 1 , nlit + iplit(il) = iplit(il)-nib(ivlit(il),ibar-1) + if (ibar .gt. 2) iplit(il) = iplit(il)+nib(ivlit(il),ibar-2) +21 continue + do 22 it = 1 , ntrill + iptrill(it) = iptrill(it)-nib(ivtrill(it),ibar-1) + if (ibar .gt. 2) iptrill(it) = + * iptrill(it)+nib(ivtrill(it),ibar-2) +22 continue + do 27 icrd = 1 , ncrd + ivx = iand(15,ishft(icrdat(icrd),-8)) + * +16*igetbits(icrdat(icrd),1,28) + ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1) + if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) + icrdat(icrd) = iand(not(255),icrdat(icrd)) + icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd)) +27 continue + do 29 iudorn = 1 , nudorn + ivx = ivxudorn(iudorn) + ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1) + if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) + kudorn(iudorn) = iand(not(255),kudorn(iudorn)) + kudorn(iudorn) = ior(max(0,ipnew),kudorn(iudorn)) +29 continue + do 42 idyn = 1 , ndyn + idynd = idyndat(idyn) + ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10) + ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) +c +c The following construction avoids array bound errors in some compilers +c + if (ibar .gt. 2) then + ipnew = ipnew+nib(ivx,ibar-2) + end if + ipnew = dim(ipnew,0) + call setbits(idynd,8,4,ipnew) + idyndat(idyn) = idynd +42 continue + do 43 itxtdyn = 1 , ntxtdyn + idynd = ivxiptxt(itxtdyn) + ivx = iand(31,idynd) + ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1) + if (ibar .gt. 2) then + ipnew = ipnew+nib(ivx,ibar-2) + end if + ipnew = dim(ipnew,0) +c call setbits(idynd,8,4,ipnew) + call setbits(idynd,8,5,ipnew) + ivxiptxt(itxtdyn) = idynd +43 continue + do 41 isdat = 1 , nsdat + isdata = isdat1(isdat) + ivx = ivmx(igetbits(isdata,5,13),igetbits(isdata,1,12)+1) + ipnew = igetbits(isdata,8,3)-nib(ivx,ibar-1) + if (ibar .gt. 2) then + ipnew = ipnew+nib(ivx,ibar-2) + end if + ipnew = dim(ipnew,0) + call setbits(isdata,8,3,ipnew) + isdat1(isdat) = isdata +41 continue + do 44 ibc = 1 , nbc + ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) + ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1) + if (ibar .gt. 2) then + ipnew = ipnew+nib(ivx,ibar-2) + end if + ipnew = dim(ipnew,0) + call setbits(ibcdata(ibc),8,4,ipnew) +44 continue + do 45 iarps = 1 , NumArpShift + IpArpShift(iarps) = + * IpArpShift(iarps)-nib(IvArpShift(iarps),ibar-1) + if (ibar .gt. 2) then + IpArpShift(iarps) = + * IpArpShift(iarps)+nib(IvArpShift(iarps),ibar-2) + end if +45 continue +c +c Bookkeeping for figures. This will set nfigs = 0 if there are no figs left. +c If there are figs left, it will reset all times relative to start of +c current bar. +c + do 46 ivx = 1 , 2 + if (figbass) then + islide = 0 + do 20 jfig = 1 , nfigs(ivx) + if (itfig(ivx,jfig) .lt. lenbar) then +c +c This figure was already used +c + islide = jfig + else + itfig(ivx,jfig-islide) = itfig(ivx,jfig)-lenbar + figq(ivx,jfig-islide) = figq(ivx,jfig) + itoff(ivx,jfig-islide) = itoff(ivx,jfig) + ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig) + ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig) + end if +20 continue + nfigs(ivx) = nfigs(ivx)-islide + end if + if (nfigs(2) .eq. 0) go to 47 +46 continue +47 continue + end if +c +c End of sliding down for bars after first in gulp. +c +c The following may not be needed by makeabar, but just in case... +c + if (firstgulp .and. lenb0.ne.0) then + if (ibar .eq. 1) then + lenbar = lenb0 + else + lenbar = lenb1 + end if + end if +c +c Equal line spacing stuff +c + if (equalize .and. bar1syst) then + if (isystpg .eq. 1) then + write(11,'(a)')sq//'starteq%' + else if (isystpg .eq. nsystp(ipage)-1) then + write(11,'(a)')sq//'endeq%' + end if + end if + call make1bar(ibmrep,tglp1,tstart,cwrest,squez, + * istop,numbms,istart) + call make2bar(ninow,tglp1,tstart,cwrest,squez, + * istop,numbms,istart,clefq) +c +c Hardspace before barline? +c + hardb4 = 0. + do 35 iv = 1 , nv + do 3599 kv = 1 , nvmx(iv) + ivx = ivmx(iv,kv) + if (btest(irest(ivx,nn(ivx)),18)) then + nudoff(ivx) = nudoff(ivx)+1 + hardb4 = max(hardb4,udoff(ivx,nudoff(ivx))) + end if +3599 continue +35 continue + if (hardb4 .gt. 0.) then + if (islast) write(11,'(a11,f5.1,a4)')sq + * //'hardspace{',hardb4,'pt}%' +c +c This was causing an incorrect poe in an example, which did not affect main +c spacing, but did cause an extra accidental space to be too small +c + fixednew = fixednew-hardb4 + end if +10 continue + firstgulp = .false. + lenb0 = 0 + go to 30 +40 close(12) + close(13) + ilbuf = 1 + ipbuf = 0 + wdpt = widthpt + if (iline .eq. 1) wdpt = widthpt*(1-fracindent) + poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/ + * (elsktot+fbar*nbarss-scaldold) + poevec(nsyst) = poe + if (.not.islast) then + close(11) + close(16) + if (figbass) close(14) + return + end if + do 19 ia = 1 , nasksys + iask = iask+1 + ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))/poefa(iline) + if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.) +19 continue + do 26 ia = 1 , nhssys + nhstot = nhstot+1 + hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.) +26 continue + if (islast .and. + * onvolt) write(11,'(a)')sq//'endvoltabox' + rendq = '% ' + if (ishort .ne. 0) rendq = '}}%' + if (rptfq2 .ne. 'E') then +c +c Terminal repeat. Right or double? +c + if (rptfq2 .eq. 'r') then + if (islast) write(11,'(a)')sq//'setrightrepeat' + * //sq//'endpiece'//rendq + else if (rptfq2 .eq. 'd') then + if (islast) write(11,'(a)')sq//'setdoublebar'//sq//'endpiece' + * //rendq + else if (rptfq2 .eq. 'b') then + if (islast) write(11,'(a)')sq//'endpiece'//rendq + else if (rptfq2 .eq. 'z') then + if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece' + * //rendq + else + print* + print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 + write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 + if (islast) write(11,'(a)')sq//'Endpiece' + end if + else + write(11,'(a)')sq//'Endpiece'//rendq + end if + if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if + xnstbot = xnsttop(ipage)*etabot/etatop + if (xnstbot .lt. 9.95) then + fmtq = '(a,f3.1,a)' + else + fmtq = '(a,f4.1,a)' + end if + if (islast) write(11,fmtq)sq//'vskip',xnstbot, + * sq//'Interligne'//sq//'eject'//sq//'endmuflex' + if (islast) write(11,'(a)')sq//'bye' + else + if (islast) write(11,'(a)') + * sq//'vfill'//sq//'eject'//sq//'endmuflex' + if (islast) write(11,'(a)')sq//'bye' + end if + rewind(11) + if (figbass) then + write(14,'(a9,i2,a10,i2,1x,a5)') + * sq//'figdrop=',ifigdr(1,iline), + * ' '//sq//'figdtwo=',ifigdr(2,iline),sq//'fi}%' + rewind(14) + end if + call askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0) + if (.not.optimize) then + print* + print*,'Writing ' + * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex' + print*,'Done with second PMX pass.' + write(15,'(/,a)')'Writing ' + * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex' + write(15,'(a)')' Done with second PMX pass. Now run TeX' + end if + return + end + subroutine poestats(nsyst,poe,poebar,devnorm) + parameter (nks=125) +c +c Compute avg. & norm. std. dev. of poe. +c + real*4 poe(nks) + sumx = 0. + sumxx = 0. + do 1 isyst = 1 , nsyst + sumx = sumx+poe(isyst) + sumxx = sumxx+poe(isyst)**2 +1 continue + devnorm = sqrt(nsyst*sumxx/sumx**2-1) + poebar = sumx/nsyst + return + end + subroutine precrd(ivx,ip,nolevm,nacc,ipl,irest,udq, + * twooftwo,icashft) +c +c Analyzes chords, data to be used with slurs on chords and plain chords. +c Check for 2nds, shift notes if neccesary. +c ipl(10) chord present +c irest(20) set if any note is right shifted +c irest(27) set if any note is left shifted +c ipl(8|9) left|right shift main note +c icrdat(23|24) ditto chord note +c udq is updown-ness, needed to analyze 2nds. +c levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. +c icrdot(icrd)(27-29) sequence order of chord note if accid, top down +c + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + logical btest,is2nd,twooftwo + integer*4 kicrd(10),levtabl(88) + character*1 udq + do 11 i = 1 , 88 + levtabl(i) = 0 +11 continue + do 1 icrd1 = 1 , ncrd + ivx1 = iand(15,ishft(icrdat(icrd1),-8)) + * +16*igetbits(icrdat(icrd1),1,28) + ip1 = iand(255,icrdat(icrd1)) + if (ip1.eq.ip .and. ivx1.eq.ivx) go to 2 +1 continue + print* + print*, + * 'Cannot find first chord note in precrd. Send source to Dr. Don!' + call stop1() +2 continue + maxlev = nolevm + minlev = nolevm + levtabl(nolevm) = -1 + is2nd = .false. + naccid = 0 + levmaxacc = -100 + levminacc = 1000 +c +c Check 1st 3 bits of nacc for accid on main note of chord. +c + if (iand(7,nacc) .gt. 0) then + naccid = 1 +c +c Start list of notes with accid's. There will be naccid of them. kicrd=0 if main, +c otherwise icrd value for note with accidental. +c + kicrd(1) = 0 + levmaxacc = nolevm + levminacc = nolevm +c +c Start the level-ranking +c + icrdot0 = 1 + end if + do 3 icrd2 = icrd1 , ncrd + nolev = igetbits(icrdat(icrd2),7,12) + levtabl(nolev) = icrd2 + maxlev = max(maxlev,nolev) + minlev = min(minlev,nolev) +c +c Check for accidental +c + if (btest(icrdat(icrd2),19)) then + naccid = naccid+1 + levmaxacc = max(levmaxacc,nolev) + levminacc = min(levminacc,nolev) +c +c Add this icrd to list of values for notes with accid's. +c + kicrd(naccid) = icrd2 + if (.not.btest(nacc,28)) then +c +c Order not forced, so get the level-ranking, top down +c + iorder = 1 + do 12 iaccid = 1 , naccid-1 + if (kicrd(iaccid) .eq. 0) then + if (nolevm .gt. nolev) then + iorder = iorder+1 + else + icrdot0 = icrdot0+1 + end if + else + if (igetbits(icrdat(kicrd(iaccid)),7,12) + * .gt. nolev) then + iorder = iorder+1 + else + iold = igetbits(icrdot(kicrd(iaccid)),3,27) + call setbits(icrdot(kicrd(iaccid)),3,27,iold+1) + end if + end if +12 continue + call setbits(icrdot(icrd2),3,27,iorder) + end if + end if +c +c Exit loop if last note in this chord +c + if (icrd2 .eq. ncrd) go to 4 + if (igetbits(icrdat(icrd2+1),8,0) .ne. ip .or. +c * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 + * igetbits(icrdat(icrd2+1),4,8) + * +16*igetbits(icrdat(icrd2+1),1,28) .ne. ivx) go to 4 +3 continue + print* + print*,'Failed to find last chord note. Send source to Dr. Don!' + call stop1() +4 continue +c +c Now icrd1, icrd2 define range of icrd for this chord. +c +c Bypass autos-shifting if any manual shifts are present +c + if (btest(irest,20) .or. btest(irest,27)) go to 10 +c +c Check for 2nds +c + do 5 ilev = 1 , 87 + if (levtabl(ilev).ne.0 .and. levtabl(ilev+1).ne.0) then +c +c There is at least one 2nd.. +c + if (udq .eq. 'u') then +c +c Upstem. Start with 2nd just found and go up, rt-shifting upper +c member of each pair +c + ile = ilev +c +c Set main-note flag for ANY right-shift +c + irest = ibset(irest,20) +7 continue + if (levtabl(ile+1) .lt. 0) then +c +c Upstem, & upper member is main so must be rt-shifted. This would move +c stem too, so we rt-shift the OTHER note, and set flag that signals +c to interchange pitches just when these two notes are placed. +c + nacc = ibset(nacc,30) + icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),24) + else +c +c Upper member is chord note, must be rt-shifted +c + icrdat(levtabl(ile+1)) = ibset(icrdat(levtabl(ile+1)),24) + end if + ile = ile+1 +8 continue + ile = ile+1 + if (ile .lt. 87) then + if (levtabl(ile).ne.0 .and. levtabl(ile+1).ne.0) then + go to 7 + else + go to 8 + end if + end if + go to 10 + else +c +c Downstem. Start at top and work down, left-shifting lower member of each pair. +c We know that lowest pair is at (ilev,ilev+1). +c + ile = 88 +c +c Set main-note flag for ANY right-shift +c + irest = ibset(irest,27) +9 continue + if (levtabl(ile).ne.0 .and. levtabl(ile-1).ne.0) then + if (levtabl(ile-1) .lt. 0) then +c ipl = ibset(ipl,8) +c +c Dnstem, & lower member is main so must be left-shifted. This would move +c stem too, so we left-shift the OTHER note, and set flag that signals +c to interchange pitches just when these two notes are placed. +c + nacc = ibset(nacc,31) + icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),23) + else +c +c Lower member is chord note, must be shifted +c + icrdat(levtabl(ile-1)) = + * ibset(icrdat(levtabl(ile-1)),23) + end if + ile = ile-1 + end if + ile = ile-1 + if (ile .ge. ilev+1) go to 9 + go to 10 + end if + end if +5 continue +10 continue +c +c Done with 2nds, now do accid's. Call even if just one, in case left shifts. +c +c if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, + if (naccid .ge. 1) call crdaccs(nacc,ipl,irest,naccid, + * kicrd,nolevm,levmaxacc,levminacc,icrdot0,twooftwo,icashft) + return + end + subroutine printl(string) + character*(*) string +c +c Send string to console and to log file +c + print*,string + write(15,'(a)')string + return + end + subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) + parameter (nm=24) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comtol/ tol + common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), + * ArpShift(20) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + logical lowdot,IsArpShift + character*80 soutq + character*79 notexq + character*8 symq(2) + character*1 chax + data symq /'raisearp','arpeggio'/ +c +c NOTE iv in arg list is really ivx, referring to voice rather than staff. +c +c Find which iarp, if any +c + do 1 iarp = 1 , narp + if (abs(tnow-tar(iarp)).lt.tol) go to 2 +1 continue +c +c If here, this is the *first* call for this arp. +c + narp = narp+1 + tar(narp) = tnow+tol*.5 + ivar1(narp) = iv + ipar1(narp) = ip + levar1(narp) = nolev + ncmar1(narp) = ncm + return +2 continue +c +c If here, this is *second* call at this time, narp points to values from 1st. +c +c Check for shift. Set IsArpShift and iarps +c + do 3 iarps = 1 , NumArpShift + if (IvArpShift(iarps) .eq. ivar1(iarp) .and. + * IpArpShift(iarps) .eq. ipar1(iarp)) then + IsArpShift = .true. + notexq = chax(92)//'loffset{' + write(notexq(10:14),'(f3.1,a2)') Arpshift(iarps),'}{' + lnote = 14 + go to 4 + end if +3 continue + IsArpShift = .false. + lnote = 0 +4 continue + if (iv .eq. ivar1(iarp)) then +c +c Arp is in a single voice. +c + levbot = min(levar1(iarp),nolev)-ncm+3 + invert = abs(levar1(iarp)-nolev)+1 + else +c +c Arp covers >1 voice. Lower voice has to be the first, upper is current and +c is where the symbol will be written. +c Check whether ivx's ivar1(iarp) & iv are in same staff +c + do 5 iiv = 1 , nm + if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.ivar1(iarp))) then + iivivx1 = iiv + go to 6 + end if +5 continue + print*,'Screwup#1 in putarp' + stop +6 continue + do 7 iiv = 1 , nm + if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.iv)) go to 8 +c +c Found iv for both voices (iivivx1, iiv), done looking +c +7 continue + print*,'Screwup#2 in putarp' + stop +8 continue + if (iivivx1 .eq. iiv) then + nstaffshift = 0 + else + nstaffshift = -nint(2*xinsnow) + end if +c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) + levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) + invert = -levbot+4+nolev-ncm + end if +c +c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote +c + isym = mod(invert,2)+1 + ilvert = (invert+1)/2 + if (levbot .ge. 0 .and. levbot .le. 9) then +c +c Single digit +c + if (.not.IsArpShift) then + notexq = chax(92)//symq(isym)//chax(48+levbot) + else + notexq = notexq(1:lnote)// + * chax(92)//symq(isym)//chax(48+levbot) + end if + lnote = lnote+10 + else + if (.not.IsArpShift) then + notexq = chax(92)//symq(isym)//'{' + else + notexq = notexq(1:lnote)//chax(92)//symq(isym)//'{' + end if + lnote = lnote+10 + if (levbot .ge. -9) then +c +c Need two spaces for number +c + write(notexq(lnote+1:lnote+3),'(i2,a1)')levbot,'}' + lnote = lnote+3 + else + write(notexq(lnote+1:lnote+4),'(i3,a1)')levbot,'}' + lnote = lnote+4 + end if + end if +c if (ilvert .le. 9) then +c call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, +c * soutq,lsout) +c else +c write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' +c call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) +c end if + + if (ilvert .gt. 9) then + write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//chax(48+ilvert) + lnote = lnote+1 + end if + if (IsArpShift) then + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + end if + call addstr(notexq(1:lnote),lnote,soutq,lsout) +c +c cancel out the stored time, to permit two arps at same time! +c + tar(iarp) = -1. + return + end + subroutine putast(elask,indxask,outq) + character*129 outq,tag + character*9 fmtq + if (elask .ge. 0.) then + if (elask.lt.0.995) then + lp = 3 + else if (elask .lt. 9.995) then + lp = 4 + else + lp = 5 + end if + write(fmtq,'(a5,i1,a3)')'(a2,f',lp,'.2)' + else + lp = 5 + fmtq = '(a2,f5.1)' + end if +c +c Overwrite as follows: ...xyz*ask *lmnop... -> +c ...xyz*ast{.nn}*lmnop... +c ...xyz*ast{n.nn}*lmnop... +c ...xyz*ast{nn.nn}*lmnop... +c or for negative, ...xyz*ast{-nn.n}*lmnop... + tag = outq(indxask+9:) + write(outq(indxask+3:),fmtq)'t{',elask + outq = outq(1:indxask+4+lp)//'}'//tag + return + end + subroutine putcb(ivx,ip,notexq,lnote) + common /comcb/ nbc,ibcdata(36) + character*79 notexq + logical btest +c ivxip = ivx+16*ip + do 1 ibc = 1 , nbc +c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 +c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) +c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 + ivxbc = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) + ipbc = igetbits(ibcdata(ibc),8,4) + if (ivx .eq. ivxbc .and. ip .eq.ipbc) go to 2 +1 continue + call printl('Error in putbc, Call Dr. Don') + stop +2 continue + if (btest(ibcdata(ibc),27)) then + lnote = 8 + notexq = char(92)//'pbreath' + else + lnote = 9 + notexq = char(92)//'pcaesura' + end if + ivshft = igetbits(ibcdata(ibc),6,13) +c?? ivshft = igetbits(ibcdata(ibc),6,13)-32 + if (ivshft .gt. 0) ivshft = ivshft-32 + if (ivshft.lt.0 .or. ivshft.gt.9) then + notexq = notexq(1:lnote)//'{' + lnote = lnote+1 + if (ivshft .lt. -9) then + write(notexq(lnote+1:lnote+3),'(i3)')ivshft + lnote = lnote+3 + else + write(notexq(lnote+1:lnote+2),'(i2)')ivshft + lnote = lnote+2 + end if + notexq = notexq(1:lnote)//'}' + lnote = lnote+1 + else + notexq = notexq(1:lnote)//char(48+ivshft) + lnote = lnote+1 + end if + ihshft = igetbits(ibcdata(ibc),8,19) + if (ihshft .eq. 0) then + notexq = notexq(1:lnote)//'0' + lnote = lnote+1 + else + hshft = .1*(ihshft-128) +c +c -12.81 ornament on a note, next line is top of manual loop. +c +2 continue +c +cc Bit # of last ornament (last of bits 0-21) +cc Bit # of last ornament (last of bits 0-24) +c Bit # of last ornament (last of bits 0-24,29-30) + if (btest(iornq,29)) then + ibit = 29 + else if (btest(iornq,30)) then + ibit = 30 + else + ibit = log2(iand(iornq,4194303)) +c ibit = log2(iand(iornq,33554431)) + end if + iornt = 2**ibit +c +c Begin routine to set height. Bits 0-13: (stmgx+Tupf._) +c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n +c 19-20: >^, 21: ? (with or w/o 16-18) +c and 29-30: C (coda), G (new segno) +c +c Do not use beam height for . or _ +c + if (btest(iornq,22) .and. iand(iornt,6144).eq.0) then +c +c Height is set by special beam stuff. +c Do not leave ihorn set, do separately for every ornament +c + ihorn = ihornb(ivx,nornb(ivx)) + if (ulpzq .eq. 'u') ihorn = ihorn-2 +c +c Following flag tells whether to increment nornb when exiting the subroutine. +c + usehornb = .true. + else if (ibit .eq. 14) then +c +c Down fermata. Don't worry about upper chord notes. +c + if (ulpzq .eq. 'l') then + ihorn = min(nolev,ncm-3) + else + ihorn = min(nolev-stemlen,ncm-3.) + end if + else if (btest(iornt,13) .or. btest(iornt,0)) then +c +c ( or ) +c + ihorn = nolev + else if (iand(iornt,6144) .gt. 0) then +c +cc Staccato . or tenuto _ , but not special beam stuff. Need up-down info +c NOTE: removed .&_ from special beam treatment. +c Staccato . or tenuto _ Need up-down info +c + if (.not.iscrd .or. (maxlev.ne.nolev.and.ulpzq.eq.'l') .or. + * (minlev.ne.nolev.and.ulpzq.eq.'u')) then + ihorn = nolev + else if (maxlev .eq. nolev) then + ulpzq = 'u' + ihorn = max(nolev+stemlen,ncm+3.) + else + ulpzq = 'l' + ihorn = min(nolev-stemlen,ncm-3.) + end if + else if (iscrd .and. nolev .eq. minlev) then + if (ulpzq .eq. 'l') then + ihorn = min(nolev-3,ncm-6) + else + ihorn = min(nolev-nint(stemlen)-3,ncm-6) + end if + else if (ibit.eq.10 .and. nolev.gt.90) then +c +c Special treatment for fermata on a shifted rest +c + ihorn = ncm+5 + else if (ulpzq.eq.'l') then +c +c (iscrd and nolev=maxlev) or (.not.iscrd) +c + ihorn = max(nolev+stemlen+2,ncm+5.) + else if (ibit.eq.29 .or. ibit.eq.30) then +c +c coda or new segno, no height tweak +c + ihorn = ncm+5 + else + ihorn = max(nolev+2,ncm+5) + end if + ioff = 0 + iclracc = 0 +c +c Begin routine to set name. Bits 0-13: (stmgx+Tupf._) +c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n +c + if (btest(iornt,2)) then + notexq = sq//'shake' + lnote = 6 + else if (btest(iornt,3)) then + notexq = sq//'mordent' + lnote = 8 + else if (btest(iornt,1)) then + notexq = sq//'mtr' + lnote = 4 + else if (btest(iornt,5)) then + notexq = sq//'xtr' + lnote = 4 + else if (btest(iornt,6)) then + notexq = sq//'ptr' + lnote = 4 + else if (btest(iornt,13)) then + notexq = sq//'rpn' + lnote = 4 + else if (btest(iornt,0)) then + notexq = sq//'lpn' + lnote = 4 + else if (btest(iornt,12)) then + notexq = sq//ulpzq//'st' + lnote = 4 + else if (btest(iornt,11)) then + notexq = sq//ulpzq//'pz' + lnote = 4 + else if (btest(iornt,8)) then + notexq = sq//'upz' + lnote = 4 + ioff = -2 + else if (btest(iornt,9)) then + notexq = sq//'uppz' + lnote = 5 + ioff = -2 + else if (btest(iornt,10)) then + if (nodur .lt. 48) then + notexq = sq//'fermataup' + else + notexq = sq//'Fermataup' + end if + lnote = 10 + ioff = -2 + else if (btest(iornt,14)) then + if (nodur .lt. 48) then + notexq = sq//'fermatadown' + else + notexq = sq//'Fermatadown' + end if + lnote = 12 + else if (btest(iornt,21)) then +c +c "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 +c + if (btest(iornq,16)) then + notexq = sq//'qsharp' + lnote = 7 + ioff = 2 + iornq = ibclr(iornq,16) + iclracc = 16 + else if (btest(iornq,17)) then + notexq = sq//'qflat' + lnote = 6 + ioff = 1 + iornq = ibclr(iornq,17) + iclracc = 17 + else if (btest(iornq,18)) then + notexq = sq//'qnat' + lnote = 5 + ioff = 2 + iornq = ibclr(iornq,18) + iclracc = 18 + else + notexq = sq//'qedit' + lnote = 6 + ioff = 0 + end if + else if (btest(iornt,16)) then + notexq = sq//'esharp' + lnote = 7 + ioff = 2 + else if (btest(iornt,17)) then + notexq = sq//'eflat' + lnote = 6 + ioff = 1 + else if (btest(iornt,18)) then + notexq = sq//'enat' + lnote = 5 + ioff = 2 + else if (btest(iornt,19)) then + notexq = sq//'usf' + lnote = 4 + ioff = -2 + else if (btest(iornt,20)) then + notexq = sq//'usfz' + lnote = 5 + ioff = -2 + else if (btest(iornt,29)) then + notexq = sq//'ccoda' + lnote = 6 + else if (btest(iornt,30)) then + notexq = sq//'ssegno' + lnote = 7 + end if + iudorn = 0 +c +c User-defined level shift of ornament from default? +c + if (btest(iornq,25)) then +c +c Find which (if any) element of kudorn has the shift. +c + do 3 iudorn = 1 , nudorn +c if (ibit .lt. 21) then +c if (ibit.lt.21 .or. ibit.eq.29) then + if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then + ibitt = ibit +c +c Could have oes, but not oe? or oes? +c + else if (iclracc .gt. 0) then +c +c Earlier cleared edit. accid, meaning it was oes? +c + ibitt = iclracc+6 + else + ibitt = 21 + end if + ibitt=ip+ishft(mod(ivx,16),8)+ishft(nolev,12)+ishft(ibitt,19) +c if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 + if (ibitt .eq. iand(33554431,kudorn(iudorn)) + * .and. ivx.eq.ivxudorn(iudorn)) go to 4 +3 continue +c +c Nothing shifted on this note; exit this if block +c + iudorn = 0 + go to 5 +4 continue + ioffinc = iand(63,ishft(kudorn(iudorn),-25))-32 + if (ibit.eq.19 .and. ioffinc .lt. -7) then +c +c Convert usf to lsf. The reason has to do with positioning being impossile +c for some mysterious reason when you drop \usf below the staff +c + notexq = sq//'lsf' + ioffinc = ioffinc+6 + end if + ioff = ioff+ioffinc + end if +5 continue +c +c Shift level to avoid slur. Conditions are +c 1. There is a slur +c 2. No user-defined orn height shift (btest(iornq,25)) +c 3. upslur (islhgt>0) +c 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 +c 5. islhgt+3 >= height already computed. +c + if (.not.btest(iornq,25) .and. + * islhgt.gt.0 .and. iand(iornt,30737).eq.0) + * ioff = ioff+dim(islhgt+3,ihorn ) + call notefq(noteq,lnoten,ihorn+ioff,ncm) + if (lnoten.eq.1) call addblank(noteq,lnoten) + if (iand(iornt,32896) .gt. 0) then +c +c T-trill or trill w/o "tr" +c + call dotrill(ivx,ip,iornt,noteq,lnoten,notexq,lnote) + else + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + end if + if (iudorn .gt. 0) then + if (btest(kudorn(iudorn),31)) then +c +c Horizontal shift +c + lform = lfmt1(ornhshft(iudorn)) + write(noteq(1:lform),'(f'//chax(48+lform)//'.1)') + * ornhshft(iudorn) + notexq = sq//'roffset{'//noteq(1:lform)//'}{' + * //notexq(1:lnote)//'}' + lnote = lnote+lform+12 + ornhshft(iudorn) = 0. + kudorn(iudorn) = ibclr(kudorn(iudorn),31) + end if + end if +c +c Zero out the bit for ornament just dealt with. +c + iornq = ibclr(iornq,ibit) + if (lout .eq. 0) then + outq = notexq(1:lnote) + else + outq = outq(1:lout)//notexq(1:lnote) + end if + lout = lout+lnote +c +c Check bits 0-21, go back if any are still set +c If bit 29 or 30 had been set, would have been used first time thru, +c and you wouldn't use both coda and segno on same note +c + if (iand(iornq,4194303) .gt. 0) go to 2 + if (usehornb) nornb(ivx) = nornb(ivx)+1 + return + end + subroutine putshft(ivx,onoff,soutq,lsout) + parameter (nm=24) + common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) + character*80 soutq,notexq + character*1 sq,chax + logical onoff + sq = chax(92) +c +c Start user-defined offsets X(...): or X(...)S +c + if (onoff) nudoff(ivx) = nudoff(ivx)+1 +c +c Xoff is in pts. Round off to nearest .1. Will use at end of shift. +c + xoff = udoff(ivx,nudoff(ivx)) + xoff = sign(int(10.*abs(xoff)+.5)/10.,xoff) + if (.not.onoff) xoff = -xoff + if (xoff .lt. -9.95) then + ifmt = 5 + else if (xoff.lt.-.95 .or. xoff.gt.9.95) then + ifmt = 4 + else + ifmt = 3 + end if + write(notexq,'(f'//chax(48+ifmt)//'.1)')xoff + call addstr(sq//'off{'//notexq(1:ifmt)//'pt}',8+ifmt, + * soutq,lsout) + return + end + subroutine puttitle(inhnoh,xnsttop,etatop,sq,etait,etatc, + * etacs1,nv,vshrink,sepsymq) +c +c Called once per page, at top of page! If vshrink, only called for p.1. +c Actual titles only allowed on p.1. (set by headlog). +c 3/18/01: The above comment is probably bogus...can use Tt on later pages. +c + common /comlast/ islast,usevshrink + logical islast,usevshrink + common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip, + * inhead + common /cominbot/ inbothd + character*127 notexq + character*120 instrq,titleq,compoq + parameter (nm=24) + character*1 sq,sepsymq(nm),chax + logical headlog,vshrink + notexq = sq//'znotes' + lenline = 7 + do 22 iv = 1 , nv-1 + notexq = notexq(1:lenline)//sepsymq(iv) + lenline = lenline+1 +22 continue + notexq = notexq(1:lenline)//sq//'zcharnote{' + lenline = lenline+11 + if (.not.headlog) then + inhead = inhnoh + end if + if (vshrink .and. usevshrink) then + inhead = 16 + end if + ndig = int(alog10(inhead+.01))+1 + write(notexq(lenline+1:lenline+ndig+10),'(i'//chax(48+ndig)// + * ',a10)')inhead,'}{'//sq//'titles{' + lenline = lenline+ndig+10 +c +c Vertical skip at top of page (\Il) = etatop*glueil. Needed whether +c headers are present or not. +c + glueil = xnsttop/etatop + vskil = etatop*glueil + if (vshrink .and. usevshrink) vskil = 2 + call writflot(vskil,notexq,lenline) + if (.not.headlog) then + if (islast) write(11,'(a)')notexq(1:lenline) + * //'}{}{0}{}{0}{}{0}}'//sq//'en%' + else + notexq = notexq(1:lenline)//'}{' + lenline = lenline+2 + lcq = lenstr(instrq,120) + if (lcq .gt. 0) then + xitil = etait*glueil + if (vshrink .and. usevshrink) xitil = 2 + notexq = notexq(1:lenline)//instrq(1:lcq)//'}{' +c +c Null out instrument once used +c + instrq = ' ' + lenline = lenline+lcq+2 + call writflot(xitil,notexq,lenline) + else + notexq = notexq(1:lenline)//'}{0' + lenline = lenline+3 + end if + if (islast) write(11,'(a)')notexq(1:lenline)//'}%' + notexq = '{' + lenline = 1 + lcq = lenstr(titleq,120) + if (lcq .gt. 0) then + notexq = notexq(1:lenline)//titleq(1:lcq) + lenline = lenline+lcq + else + call printl(' ') + call printl('WARNING') + call printl( + * ' In a title block, you have specified instrument and/or') + call printl( + * ' composer but no title for the piece.') + end if + notexq = notexq(1:lenline)//'}{' + lenline = lenline+2 + xtcil = etatc*glueil + lcq = lenstr(compoq,120) + if (lcq .eq. 0) xtcil = 2*xtcil + if (vshrink .and. usevshrink) xtcil = 2 + call writflot(xtcil,notexq,lenline) + notexq = notexq(1:lenline)//'}{' + lenline = lenline+2 + if (lcq .gt. 0) then + notexq = notexq(1:lenline)//compoq(1:lcq)//'}{' + lenline = lenline+2+lcq +c +c Null out compoq so it does not get written later +c + compoq = ' ' + xcsil = etacs1*glueil + if (vshrink .and. usevshrink) xcsil = 2 + call writflot(xcsil,notexq,lenline) + else + notexq = notexq(1:lenline)//'}{0' + lenline = lenline+3 + end if + if (islast) write(11,'(a)')notexq(1:lenline)//'}}'//sq//'en%' + headlog = .false. + end if + return + end + subroutine putxtn(ntupv,iflop,multb,iud,wheadpt,poenom, + * nolev1,islope,slfac,xnlmid,islur,lnote,notexq,ncmid,nlnum, +c * eloff,iup,irest,usexnumt) + * eloff,iup,irest,mult,usexnumt) +c +c Places digit for xtuplet. +c + character*1 chax + character*8 noteq + character*79 notexq + logical btest,usexnumt + if (iflop.ne.0 .and. multb.gt.0) then +c +c Number goes on beam side, move R/L by .5 wheadpt for upper/lower +c + eloff = eloff-0.5*iud*wheadpt/poenom +c +c Number goes on beam side, must use beam parameters to set pos'n +c + nlnum = nolev1+islope/slfac*eloff+iup*(multb+8) + if (multb .ge. 2) nlnum = nlnum+iup + else + nlnum = nint(xnlmid-1+3*iud+iflop*11) + end if + if (.not.btest(islur,31)) then +c +c Only print number when wanted. First check vert, horiz offset +c + if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64 + if (btest(irest,7)) eloff = eloff+ + * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom + if (.not.usexnumt) then + notexq = chax(92)//'xnum{' + lnote = 10 + istrtn = 7 + else + notexq = chax(92)//'xnumt{' + lnote = 11 + istrtn = 8 + end if + if (eloff .lt. 0.995) then + write(notexq(istrtn:istrtn+3),'(i1,f3.2)')0,eloff + else if (eloff .lt. 9.995) then + write(notexq(istrtn:istrtn+3),'(f4.2)')eloff + else + write(notexq(istrtn:istrtn+4),'(f5.2)')eloff + lnote = lnote+1 + end if + call notefq(noteq,lnoten,nlnum,ncmid) + notexq = notexq(1:lnote)//'}'//noteq(1:lnoten) + lnote = lnote+1+lnoten + if (ntupv .lt. 10) then + write(notexq(lnote+1:lnote+1),'(i1)')ntupv + lnote = lnote+1 + else + notexq = notexq(1:lnote)//'{' + write(notexq(lnote+2:lnote+3),'(i2)')ntupv + notexq = notexq(1:lnote+3)//'}' + lnote = lnote+4 + end if + end if + return + end + subroutine read10(string,lastchar) + parameter (maxblks=9600) + character*131072 bufq + integer*2 lbuf(maxblks) + common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq + character*(*) string + character*128 lnholdq + logical lastchar + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + logical mrecord,mplay,endmac + common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), + * ic1mac(20),ilmac,iplmac + if (.not.mplay) then + if (ilbuf .gt. nlbuf) go to 999 + call getbuf(string) + return +999 lastchar = .true. + return + else +c +c Play a macro. Set pointer to first character needed in buffer +c + if (ilmac .eq. il1mac(macnum)) then +c +c Getting first line of macro +c + ip1 = ip1mac(macnum) + iplmac = ip1-ic1mac(macnum) + else if (ilmac .le. il2mac(macnum)) then +c +c Beyond first line of macro. Advance line-start pointer. +c + iplmac = iplmac+lbuf(ilmac-1) + ip1 = iplmac+1 + else +c +c Beyond last line of macro. Terminate it! +c + mplay = .false. + endmac = .true. + return + end if + if (ilmac .eq. il2mac(macnum)) then +c +c Getting last line of macro. +c + ip2 = ip2mac(macnum) + else +c +c Getting line before last line of macro. +c + ip2 = iplmac+lbuf(ilmac) + end if + if (ip2 .ge. ip1) then + string = bufq(ip1:ip2) + else +c +c Kluge for when macro start is on a line by itself +c + string = ' ' + end if + ilmac = ilmac+1 + return + end if + end + function readin(lineq,iccount,nline) +c +c Reads a piece of setup data from file lineq, gets a new lineq from +c file 10 (jobname.pmx) and increments nline if needed, passes over +c comment lines +c + character*128 lineq + character*1 durq,chax +4 if (iccount .eq. 128) then +1 call getbuf(lineq) + nline = nline+1 + if (lineq(1:1) .eq. '%') go to 1 + iccount = 0 + end if + iccount = iccount+1 +c +c Find next non-blank or end of line +c + do 2 iccount = iccount , 127 + if (lineq(iccount:iccount) .ne. ' ') go to 3 +2 continue +c +c If here, need to get a new line +c + iccount = 128 + go to 4 +3 continue +c +c iccount now points to start of number to read +c + i1 = iccount +5 call getchar(lineq,iccount,durq) +c +c Remember that getchar increments iccount, then reads a character. +c + if (index('0123456789.-',durq) .gt. 0) go to 5 + i2 = iccount-1 + if (i2 .lt. i1) then + print*,'Found "'//durq//'" instead of number' + call stop1() + end if + icf = i2-i1+49 + read(lineq(i1:i2),'(f'//chax(icf)//'.0)')readin + return + end + subroutine readmeter(lineq,iccount,mtrnum,mtrden) + character*128 lineq + character*1 durq,chax + if (index(lineq(iccount+1:iccount+3),chax(47)) .eq. 0) then +c +c No slashes, so use old method +c + call getchar(lineq,iccount,durq) + if (durq .eq. '-') then +c +c Negative numerator is used only to printed; signals vertical slash +c + call getchar(lineq,iccount,durq) + mtrnum = -(ichar(durq)-48) + else if (durq .eq. 'o') then +c +c Numerator is EXACTLY 1 +c + mtrnum = 1 + else + mtrnum = ichar(durq)-48 + if (mtrnum .eq. 1) then +c +c Numerator is >9 +c + call getchar(lineq,iccount,durq) + mtrnum = 10+ichar(durq)-48 + end if + end if + call getchar(lineq,iccount,durq) + if (durq .eq. 'o') then + mtrden = 1 + else + mtrden = ichar(durq)-48 + if (mtrden .eq. 1) then + call getchar(lineq,iccount,durq) + mtrden = 10+ichar(durq)-48 + end if + end if + else +c +c Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' +c + iccount = iccount+1 + ns = index(lineq(iccount:128),chax(47)) + read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrnum +c +c Reset iccount to start of second integer +c + iccount = iccount+ns +c +c There must be either a slash or a blank at pos'n 2 or 3 +c + ns = index(lineq(iccount:iccount+2),chax(47)) + if (ns .eq. 0) ns = index(lineq(iccount:iccount+2),' ') + read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrden +c +c Set iccount to last character used +c + iccount = iccount+ns-1 + end if + return + end + subroutine readnum(lineq,iccount,durq,fnum) +c +c This reads a number starting at position iccount. Remember that on exit, +c getchar leaves iccount at the last character retrieved. So must only +c call this routine *after* detecting a number or decimal. +c On exit, durq is next character after end of number. +c + character*128 lineq + character*1 durq,chax + i1 = iccount +1 call getchar(lineq,iccount,durq) + if (index('0123456789.',durq) .gt. 0) go to 1 + i2 = iccount-1 + if (i2 .lt. i1) then + print*,'Found "'//durq//'" instead of number' + call stop1() + else if (lineq(i1:i1).eq.'.'.and.lineq(i2:i2).eq.'.') then + i2 = i2-1 + iccount = iccount-1 + end if + icf = i2-i1+49 + read(lineq(i1:i2),'(f'//chax(icf)//'.0)')fnum + return + end + subroutine setbits(isdata,iwidbit,ishift,ivalue) +c +c Sets iwidbits of isdata, shifted by ishift, to ivalue +c + ibase = 2**iwidbit-1 + isdata = iand(not(ishft(ibase,ishift)),isdata) + isdata = ior(isdata,ishft(ivalue,ishift)) + return + end + subroutine setbm2(xelsk,nnb,sumx,sumy,ipb,islope,nolev1) +c +c The MEAN SQUARE slope algorithm +c + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk, + * isfig + real*4 xelsk(24) + integer ipb(24) + ibc = ibmcnt(ivx) + sumxx = 0. + sumxy = 0. + do 2 inb = 1 , nnb + sumxx = sumxx+xelsk(inb)**2 + sumxy = sumxy+xelsk(inb)*nolev(ivx,ipb(inb)) +2 continue + delta = nnb*sumxx-sumx*sumx + em = (nnb*sumxy-sumx*sumy)/delta + islope = nint(0.5*em*slfac) + if (iabs(islope) .gt. 9) islope = isign(9,islope) + beta = (sumy-islope/slfac*sumx)/nnb + nolev1 = nint(beta) +c +c Check if any stems are too short +c + smin = 100. + iul = -1 + if (ulq(ivx,ibc) .eq. 'u') iul = 1 + do 4 inb = 1 , nnb + ybeam = nolev1+iul*stemlen+islope*xelsk(inb)/slfac + ynote = nolev(ivx,ipb(inb)) + smin = min(smin,iul*(ybeam-ynote)) +4 continue + if (smin .lt. stemmin) then + deficit = stemmin-smin + nolev1 = nint(nolev1+iul*deficit) + end if + return + end + subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq, + * ivx,nline) + character*1 charq,durq + common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac + logical mrecord,mplay,endmac,btest + character*128 lnholdq,lineq + common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), + * ic1mac(20),ilmac,iplmac +c +c Macro action +c + call g1etchar(lineq,iccount,charq) + if (charq.eq.'S' .and. ivx.ne.1) then + print* + print* + print*,'*********WARNING*********' + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * '"MS..." only put in parts by scor2prt if in voice #1!') + end if + if (index('RSP ',charq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Illegal character after "M" (macro)!') + call stop1() + else if (charq .ne. ' ') then +c +c Record or playback a macro. Get the number of the macro. +c + call g1etchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must input number after "MR","MP", or "MS"!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + macnum = nint(fnum) + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Macro number must be followed by a blank!') + call stop1() + end if + if (index('RS',charq ).gt. 0) then +c +c Record or save a macro +c + if (macnum.lt.1 .or. macnum.gt.20) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Macro number not in range 1-20!') + call stop1() + end if + macuse = ibset(macuse,macnum) + if (charq .eq. 'R') then + call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) + else if (charq .eq. 'S') then +c +c Save (Record but don't activate) +c +1 call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm) + if (mrecord) then + call getbuf(lineq) + nline = nline+1 + iccount = 0 + go to 1 + end if + iccount = iccount+ndxm+1 + end if + else +c +c Playback the macro +c + if (.not.btest(macuse,macnum)) then + call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, + * 'Cannot play a macro that has not been recorded!') + call stop1() + end if + icchold = iccount + lnholdq = lineq + iccount = 128 + mplay = .true. + ilmac = il1mac(macnum) + end if + end if + return + end + subroutine setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep) +c +c Sets last 2 args depending on 1st 2, (logical) num, denom. +c ibmtyp = 1, 2, or 3 defines set of masks for beam groupings. +c 1: all duple meters +c 2: triple w/ denom=4, subdivide in groups of 2 8ths +c 3: triple w/ denom=8, subdivide in groups of 3 8ths +c Note that lenbar is set at top or when 'm' symbol is read in getnote +c + if (mtrdenl .eq. 4) then + if (mod(mtrnuml,3) .eq. 0) then + ibmtyp = 2 + ibmrep = mtrnuml/3 + else + ibmtyp = 1 + ibmrep = mtrnuml/2 + end if + else if (mtrdenl .eq. 2) then + ibmtyp = 1 + if (mtrnuml .eq. 3) then + ibmrep = 3 + else + ibmrep = 2*mtrnuml/mtrdenl + end if + else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then +c +c Added 170726 +c + ibmtyp = 1 + ibmrep = mtrnuml/4 + else +c +c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 +c + ibmtyp = 3 + ibmrep = mtrnuml/3 + end if +c +c Reset so we don't keep writing new meters +c + mtrnuml = 0 +c +c Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter +c + ibmrep = max(ibmrep,1) + return + end + subroutine SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest) +c +c The outer combo algorithm +c + parameter (nm=24) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + common /comipl2/ ipl2(nm,200) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,btest, + * isfig,vxtup,l1ng,l2ng,bar1syst,drawbm + common /comeskz2/ eskz2(nm,200) + real*4 slope(800),xelsk(24) + integer ipb(24) + common /comask/ bar1syst,fixednew,scaldold, + * wheadpt,fbar,poenom + common /comas1/ naskb,task(40),wask(40),elask(40) + common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm), + * mtupv(nm,9),nxtinbm(nm), + * islope(nm),xels11(24),eloff(nm,9), + * nssb(nm),issb(nm),lev1ssb(nm,20) + common /comdraw/ drawbm(nm) + common /combmh/ bmhgt,clefend + common /commvl/ nvmx(nm),ivmx(nm,2),ivx + common /comtol/ tol + ibc = ibmcnt(ivx) + nxtinbm(ivx) = 0 + n1 = ipl2(ivx,ibm1(ivx,ibc)) +c +c Initialize counters used in this subroutine, and then later during actual +c beam drawing, to count later segments of single-slope beam groups +c + nssb(ivx) = 0 + issb(ivx) = 0 +c +c Set flag for xtup beam starting with rest (no others can start with rest) +c + if (btest(irest(ivx,ipo(n1)),0)) ixrest = 1 +c +c Figure how many elemskips to each note. Use the list, counting only non-rests. +c + eskz0 = eskz(ivx,ibm1(ivx,ibc)) + nnb = 0 + sumx = 0. + sumy = 0. + ipxt1 = 0 + iplast = ibm2(ivx,ibc) + do 2 ip = ibm1(ivx,ibc) , iplast + if (.not.btest(irest(ivx,ip),0)) then + nnb = nnb+1 + ipb(nnb) = ip + xelsk(nnb) = eskz(ivx,ip)-eskz0 + sumx = sumx+xelsk(nnb) + sumy = sumy+nolev(ivx,ipb(nnb)) + if (btest(nacc(ivx,ip),21)) then +c +c This is the starting note of later segment of single-slope beam group +c Temporarily store ip here. +c + nssb(ivx) = nssb(ivx)+1 + lev1ssb(ivx,nssb(ivx)) = nnb + end if + end if +c +c New xtup stuff here. Final object is to get distance from start of xtup +c to number. xtinbm counts xtups in this beam only. mtupv is the printed +c number. ntupv is number of notes in xtup, and is only used to get +c eloff, the distance from start of xtup to the number. +c + if (btest(nacc(ivx,ip),18)) ndoub = ndoub+1 + if (ipxt1.eq.0 .and. nodur(ivx,ip).eq.0) then +c +c Xtup is starting here +c + nxtinbm(ivx) = nxtinbm(ivx)+1 + ipxt1 = ip + if (btest(nacc(ivx,ip),18)) then + ndoub = 1 + else + ndoub = 0 + end if + else if (ipxt1.gt.0 .and. nodur(ivx,ip).gt.0) then +c +c Xtup ends here. Set total number of notes in xtup. +c + ntupv(ivx,nxtinbm(ivx)) = ip+1-ipxt1 +c +c Set printed number for embedded xtup. +c + mtupv(ivx,nxtinbm(ivx)) = ntupv(ivx,nxtinbm(ivx))+ndoub +c +c Middle note of xtup if ntupv odd, note to left of gap if even. +c + ipxtmid = (ip+ipxt1)/2 + eloff(ivx,nxtinbm(ivx)) = eskz2(ivx,ipxtmid)-eskz2(ivx,ipxt1) + if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) + * eloff(ivx,nxtinbm(ivx)) = eloff(ivx,nxtinbm(ivx))+ + * .5*(eskz2(ivx,ipxtmid+1)-eskz2(ivx,ipxtmid)) + ipxt1 = 0 + end if +2 continue +c +c Reset nxtinbm for use as counter as #'s are posted by putxtn(..) +c + nxtinbm(ivx) = 0 + smed = 0. +c if (.not.btest(islur(ivx,ipb(1)),2)) then + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then +c +c No forced 0 slope +c +c if (nnb .eq. 1) go to 6 + nsc = 0 + do 5 inb = 1 , nnb-1 + do 5999 jnb = inb+1 , nnb + nsc = nsc+1 + slope(nsc) = (nolev(ivx,ipb(jnb))-nolev(ivx,ipb(inb)))/ + * (xelsk(jnb)-xelsk(inb)) + if (abs(slope(nsc)) .lt. 1.e-4) then + nsc = nsc+1 + slope(nsc) = slope(nsc-1) + nsc = nsc+1 + slope(nsc) = slope(nsc-1) + end if +5999 continue +5 continue + if (nsc .eq. 1) then + smed = slope(1) + go to 6 + end if + nscmid = nsc/2+1 + do 7 i = 1 , nscmid + do 7999 j = i+1 , nsc + if (slope(j) .lt. slope(i)) then + t = slope(j) + slope(j) = slope(i) + slope(i) = t + end if +7999 continue +7 continue + smed = slope(nscmid) + if (nsc .eq. 2*(nsc/2)) then +c +c Even number of slopes in the list, so median is ambiguous +c + if (abs(slope(nscmid-1)) .lt. abs(slope(nscmid))-tol) then +c +c Lower-numbered one is truly less in absolute value, so use it +c + smed=slope(nscmid-1) + else if (abs(slope(nscmid-1)+slope(nscmid)) .lt. tol) then +c +c Two slopes are effectively equal. Take the one with sign of the average +c + sum = 0. + do 1 i = 1 , nsc + sum = sum+slope(i) +1 continue + smed = sign(smed,sum) + end if + end if +6 continue + islope(ivx) = nint(0.5*smed*slfac) + if (iabs(islope(ivx)) .gt. 9) + * islope(ivx) = isign(9,islope(ivx)) + else +c +c Forced horizontal beam +c + islope(ivx) = 0 + end if + beta = (sumy-islope(ivx)/slfac*sumx)/nnb +c +c If ixrest>0, this is a virtual nolev1 at location of rest. Will first use +c as is for placing xtup number and/or bracket, then reset it for start of +c actual beam +c + nolev1(ivx) = nint(beta) +c +c Check if any stems are too short +c + smin = 100. + iul = -1 + if (ulq(ivx,ibc) .eq. 'u') iul = 1 + ssq = 0. + syb = 0. + yb1 = nolev1(ivx) + * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)) + do 4 inb = 1 , nnb + ybeam = yb1+islope(ivx)*xelsk(inb)/slfac + * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1) + syb = syb+ybeam + ynote = nolev(ivx,ipb(inb)) + off = ybeam-ynote + if (inb .eq. 1) then + off1 = off + else if (inb .eq. nnb) then + off2 = off + end if + ssq = ssq+off*off + smin = min(smin,iul*off) +4 continue + dnolev = 0. + if (smin .lt. stemmin) then + deficit = stemmin-smin + nolevo = nolev1(ivx) + nolev1(ivx) = nint(nolev1(ivx)+iul*deficit) + dnolev = nolev1(ivx)-nolevo + off1 = off1+dnolev + off2 = off2+dnolev + end if + ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2 + if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and. + * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax) +c * .and. .not.btest(islur(ivx,ipb(1)),2)) then + * .and. .not.btest(islur(ivx,ipb(1)),2) + * .and. nnb.ne.1) then +c +c The first check is to save trouble of putting xtup's in setbm2. +c The penultimate check is that first and last stems aren't both excessive. +c The last check is that a 0 slope has not been forced +c + call setbm2(xelsk,nnb,sumx,sumy,ipb,islope(ivx),nolev1(ivx)) + end if +c +c Check if beam starts or ends too high or low. +c + xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1) + l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0. + xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb) + l2ng = iul*(xnolev2-ncmid(iv,ipb(nnb)))+xboff+7 .lt. 0 + if (l1ng .or. l2ng) then +c +c Need to correct start or stop, also slope +c + if (l1ng) then + nolev1(ivx) = nint(ncmid(iv,ipb(1))-(7.+xboff)*iul) + end if + if (l2ng) then + xnolev2 = nint(ncmid(iv,ipb(nnb))-(7.+xboff)*iul) + end if +c +c Since one or the other end has changed, need to change slope +c +c if (.not.btest(islur(ivx,ipb(1)),2)) + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1) + * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb)) + end if + if (nssb(ivx) .gt. 0) then +c +c This is a single-slope beam group. Store start heights for later segs. +c + do 3 issbs = 1 , nssb(ivx) + lev1ssb(ivx,issbs) = nolev1(ivx)+islope(ivx)/slfac* + * xelsk(lev1ssb(ivx,issbs)) +3 continue + end if + return + end + subroutine sortpoe(nsyst,poe,ipoe) + parameter (nks=125) + real*4 poe(nks) + integer*4 ipoe(nks) +c +c Initialize ipoe: +c + do 3 iord = 1 , nsyst + ipoe(iord) = iord +3 continue +c +c Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will +c be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. +c + do 4 io1 = 1 , nsyst-1 + do 5 io2 = io1+1 , nsyst + if (poe(ipoe(io1)) .gt. poe(ipoe(io2))) then +c +c Interchange the indices +c + itemp = ipoe(io1) + ipoe(io1) = ipoe(io2) + ipoe(io2) = itemp + end if +5 continue +4 continue + return + end + subroutine spsslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3, + * isdat4,nsdat,notcrd,nolev,starter) + parameter (nm=24) +c +c Reads in slur data. Record all h/v-shifts for non-chords, user-specified +c ones for chords. +c 5/26/02 This subr is called ONLY for postscript slurs. +c +c See subroutine doslur for bit values in isdat1,2,3 +c + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202) + logical notcrd,btest + character*128 lineq + character*1 durq,dumq,starter + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + logical upslur,fontslur,WrotePsslurDefaults +c +c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve +c + numint = 0 + ivoff = 0 + ihoff = 0 + nsdat = nsdat+1 + if (starter.eq.'{' .or. starter.eq.'}') + * isdat2(nsdat)=ibset(isdat2(nsdat),3) + call setbits(isdat1(nsdat),5,13,iv) + call setbits(isdat1(nsdat),1,12,kv-1) + call setbits(isdat1(nsdat),8,3,ip) + isdat3(nsdat) = 0 + isdat4(nsdat) = 0 + ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur +c +c Get ID code +c + call getchar(lineq,iccount,durq) +c if (index('uldtb+-hfnHps ',durq) .gt. 0) then + if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then +c +c Null id. Note for ps slurs, 'H' cannot be an ID +c + iccount = iccount-1 + if (lineq(iccount:iccount) .eq. 't') then + idcode = 1 + else + idcode = 32 + end if + else +c +c Set explicit idcode +c + idcode = ichar(durq) + if (lineq(iccount-1:iccount-1) .eq. 't') then +c +c Make t[ID] look like s[ID]t +c + isdat2(nsdat) = ibset(isdat2(nsdat),3) + end if + if (lineq(iccount+1:iccount+1).eq.'x') then +c +c Flag for 2-voice, indexed slurs +c + iccount = iccount+1 + call setbits(isdat1(nsdat),1,1,1) + end if + end if + call setbits(isdat1(nsdat),7,19,idcode) +c +c Set start/stop: look thru list from end for same idcode,iv,kv +c + do 2 isdat = nsdat-1 , 1 , -1 + if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. + * iv .eq. igetbits(isdat1(isdat),5,13) .and. +c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then + * (kv-1 .eq. igetbits(isdat1(isdat),1,12) + * .or. btest(isdat1(isdat),1))) then +c +c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. +c + if (btest(isdat1(isdat),11)) go to 3 +c +c Found slur is a turnoff, so new one is a turnon. Jump down to set bit +c + go to 4 + end if +2 continue +c +c If here, this is turnon. +c +4 continue + isdat1(nsdat) = ibset(isdat1(nsdat),11) +3 continue +c +c Now done with initial turnon- or turnoff-specifics. +c + if (nint(SlurCurve).ne.0 .and. btest(isdat1(nsdat),11)) then +c +c There's a default curvature tweak +c + icurv1 = nint(SlurCurve)+3 + if (icurv1 .eq. 2) icurv1 = 1 + isdat3(nsdat) = ibset(isdat3(nsdat),0) + call setbits(isdat3(nsdat),6,2,32+icurv1) + end if +c +c Loop for rest of input +c +1 call getchar(lineq,iccount,durq) + if (index('uld',durq) .gt. 0) then +c +c Force direction +c + isdat1(nsdat) = ibset(isdat1(nsdat),26) + if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27) + go to 1 + else if (index('+-',durq) .gt. 0) then + numint = numint+1 + if (numint .eq. 1) then +c +c Vertical offset +c + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + iccount = iccount-1 + ivoff = nint(fnum) + if (durq .eq. '-') ivoff = -ivoff + else if (numint .eq. 2) then +c +c Horizontal offset +c + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + iccount = iccount-1 +c +c fnum is abs(hshift), must be 0 to 6.3 +c + ihoff = fnum*10 + .5 + if (durq .eq. '-') ihoff = -ihoff +c +c Later will set bits to 1...127 to represent -6.3,...+6.3 +c + else +c +c Must be the 3rd signed integer, so it's a curve specification +c + isdat3(nsdat) = ibset(isdat3(nsdat),0) + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + icurv1 = nint(fnum) + if (durq .eq. '-') icurv1 = -icurv1 + call setbits(isdat3(nsdat),6,2,32+icurv1) + if (dumq .ne. ':') then +c +c Back up the pointer and loop for more input +c + iccount = iccount-1 + else +c +c Expect two single digits as parameters for curve +c + isdat3(nsdat) = ibset(isdat3(nsdat),1) + call setbits(isdat3(nsdat),3,8, + * ichar(lineq(iccount+1:iccount+1))-48) + call setbits(isdat3(nsdat),3,11, + * ichar(lineq(iccount+2:iccount+2))-48) + iccount = iccount+2 + end if + end if + go to 1 + else if (durq .eq. 't') then + isdat2(nsdat) = ibset(isdat2(nsdat),3) + go to 1 + else if (durq .eq. 'b') then + isdat2(nsdat) = ibset(isdat2(nsdat),4) + go to 1 + else if (durq .eq. 's') then +c +c Endpoint tweaks for linebreak slurs. +c + call getchar(lineq,iccount,durq) ! Must be +|- +c +c Next is vertical offset +c + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + if (durq .eq. '-') fnum=-fnum + call setbits(isdat4(nsdat),6,ilb12*16,nint(fnum)+32) + if (index('+-',dumq) .gt. 0) then +c +c Also a horizontal offset +c + iccount = iccount+1 + call readnum(lineq,iccount,durq,fnum) + if (dumq .eq. '-') fnum=-fnum + call setbits(isdat4(nsdat),7,ilb12*16+6,nint(10*fnum)+64) + end if + iccount = iccount-1 + ilb12 = 1 + go to 1 + else if (index('fnhH',durq).gt.0) then +c +c Special ps slur curvatures. +c Translate to old \midslur args (1,4,5,6) +c + icurv1 = index('fnxhH',durq) + if (icurv1 .eq. 5) then +c +c check for 2nd H +c + if (lineq(iccount+1:iccount+1) .eq. 'H') then + iccount = iccount+1 + icurv1 = 6 + end if + end if + isdat3(nsdat) = ibset(isdat3(nsdat),0) + call setbits(isdat3(nsdat),6,2,32+icurv1) + go to 1 + else if (durq .eq. 'p') then ! Local adjustment + call getchar(lineq,iccount,durq) ! +|- + call getchar(lineq,iccount,dumq) ! s|t +c 26 \sluradjust (p+s) +c 27 \nosluradjust (p-s) +c 28 \tieadjust (p+t) +c 29 \notieadjust (p-t) + if (durq .eq. '+') then + if (dumq .eq. 's') then + isdat2(nsdat) = ibset(isdat2(nsdat),26) + else + isdat2(nsdat) = ibset(isdat2(nsdat),28) + end if + else + if (dumq .eq. 's') then + isdat2(nsdat) = ibset(isdat2(nsdat),27) + else + isdat2(nsdat) = ibset(isdat2(nsdat),29) + end if + end if + go to 1 + else if (durq .eq. 'v') then ! Stem slur + isdat1(nsdat) = ibset(isdat1(nsdat),2) + go to 1 + end if +c +c Record shifts +c + call setbits(isdat2(nsdat),6, 6,ivoff+32) + call setbits(isdat2(nsdat),7,12,ihoff+64) +c +c Record chord flag, note level, notehead shift +c + if (notcrd) then + call setbits(isdat2(nsdat),7,19,nolev) + else + nolevc = igetbits(icrdat(ncrd),7,12) + call setbits(isdat2(nsdat),7,19,nolevc) + isdat2(nsdat) = ibset(isdat2(nsdat),0) + call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23)) + end if + return + end + subroutine sslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3, + * nsdat,notcrd,nolev,starter) + parameter (nm=24) +c +c Reads in slur data. Record all h/v-shifts for non-chords, user-specified +c ones for chords. +c 5/26/02 now only for non-postscript slurs, use spsslur() for postscript +c +c See subroutine doslur for bit values in isdat1,2,3 +c + common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), + * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn, + * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 + integer*4 isdat1(202),isdat2(202),isdat3(202) + logical notcrd,btest + character*128 lineq + character*1 durq,dumq,starter + common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur + * ,WrotePsslurDefaults,SlurCurve + logical upslur,fontslur,WrotePsslurDefaults +c +c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve +c + numint = 0 + ivoff = 0 + ihoff = 0 + nsdat = nsdat+1 + if (starter.eq.'{' .or. starter.eq.'}') + * isdat2(nsdat)=ibset(isdat2(nsdat),3) + call setbits(isdat1(nsdat),5,13,iv) + call setbits(isdat1(nsdat),1,12,kv-1) + call setbits(isdat1(nsdat),8,3,ip) + isdat3(nsdat) = 0 +c +c Get id letter +c + if (lineq(iccount:iccount) .eq. 't') then +c +c Old-style t-slur. Use special idcode = 1 +c + idcode = 1 + else + call getchar(lineq,iccount,durq) + if (index('uldtb+-hf ',durq) .gt. 0) then +c +c Null id +c + idcode = 32 + iccount = iccount-1 + else if (durq.eq.'H') then +c +c Postscript slur, cannot use 'H' as code, must check for 2nd 'H' +c + idcode = 32 + iccount = iccount-1 +c +c There may be another "H", but no need to deal with it yet +c + else +c +c Set explicit idcode +c + idcode = ichar(durq) + end if + end if + call setbits(isdat1(nsdat),7,19,idcode) +c +c Set start/stop: look thru list from end for same idcode,iv,kv +c + do 2 isdat = nsdat-1 , 1 , -1 + if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. + * iv .eq. igetbits(isdat1(isdat),5,13) .and. + * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then +c +c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. +c + if (btest(isdat1(isdat),11)) go to 3 +c +c Found slur is a turnoff, so new one is a turnon. Jump down to set bit +c + go to 4 + end if +2 continue +c +c If here, this is turnon. +c +4 continue + isdat1(nsdat) = ibset(isdat1(nsdat),11) +3 continue +c +c Now done with initial turnon- or turnoff-specifics. Loop for rest of input +c +1 call getchar(lineq,iccount,durq) + if (index('uld',durq) .gt. 0) then +c +c Force direction +c + isdat1(nsdat) = ibset(isdat1(nsdat),26) + if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27) + go to 1 + else if (index('+-',durq) .gt. 0) then + numint = numint+1 + if (numint .eq. 1) then +c +c Vertical offset +c + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + iccount = iccount-1 + ivoff = nint(fnum) + if (durq .eq. '-') ivoff = -ivoff + else if (numint .eq. 2) then +c +c Horizontal offset +c + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + iccount = iccount-1 +c +c fnum is abs(hshift), must be 0 to 6.3 +c + ihoff = fnum*10 + .5 + if (durq .eq. '-') ihoff = -ihoff +c +c Later will set bits to 1...127 to represent -6.3,...+6.3 +c + else +c +c Must be the 3rd signed integer, so it's a curve specification +c + isdat3(nsdat) = ibset(isdat3(nsdat),0) + iccount = iccount+1 + call readnum(lineq,iccount,dumq,fnum) + icurv1 = nint(fnum) + if (durq .eq. '-') icurv1 = -icurv1 + call setbits(isdat3(nsdat),6,2,32+icurv1) + if (dumq .ne. ':') then +c +c Back up the pointer and loop for more input +c + iccount = iccount-1 + else +c +c Expect two single digits as parameters for curve +c + isdat3(nsdat) = ibset(isdat3(nsdat),1) + call setbits(isdat3(nsdat),3,8, + * ichar(lineq(iccount+1:iccount+1))-48) + call setbits(isdat3(nsdat),3,11, + * ichar(lineq(iccount+2:iccount+2))-48) + iccount = iccount+2 + end if + end if + go to 1 + else if (durq .eq. 't') then + isdat2(nsdat) = ibset(isdat2(nsdat),3) + go to 1 + else if (durq .eq. 'b') then + isdat2(nsdat) = ibset(isdat2(nsdat),4) + go to 1 + else if (index('fhH',durq) .gt. 0) then +c +c Special ps slur curvatures. Translate to old \midslur args (1,4,5,6) +c + icurv1 = 2+index('fhH',durq) + if (icurv1 .eq. 3) then + icurv1 = 1 + else if (icurv1 .eq. 5) then +c +c check for 2nd H +c + if (lineq(iccount+1:iccount+1) .eq. 'H') then + iccount = iccount+1 + icurv1 = 6 + end if + end if + isdat3(nsdat) = ibset(isdat3(nsdat),0) +c +c Must change sign if downslur, but cannot do it now since we don't know +c slur direction for sure. +c + call setbits(isdat3(nsdat),6,2,32+icurv1) + go to 1 + end if +c +c Record shifts +c + call setbits(isdat2(nsdat),6, 6,ivoff+32) + call setbits(isdat2(nsdat),7,12,ihoff+64) +c +c Record chord flag, note level, notehead shift +c + if (notcrd) then + call setbits(isdat2(nsdat),7,19,nolev) + else + nolevc = igetbits(icrdat(ncrd),7,12) + call setbits(isdat2(nsdat),7,19,nolevc) + isdat2(nsdat) = ibset(isdat2(nsdat),0) + call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23)) + end if + return + end + subroutine stop1() + call exit(1) + end + subroutine topfile(basenameq,lbase,nv,clefq,noinst,musicsize, + * xinstf1,mtrnmp,mtrdnp,vshrink,fbar,fontslur) + parameter (nm=24) + common /comlast/ islast,usevshrink + logical islast,usevshrink,fontslur + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), + * xinsnow,lowdot + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + character*79 inameq + character*44 basenameq + character*24 fmtq + character*5 fbarq + character*1 clefq(nm),sq,chax,clefqiv + common /comstart/ facmtr + logical vshrink,lowdot,rename + logical novshrinktop,cstuplet + common /comnvst/ novshrinktop,cstuplet + common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), + * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans + logical EarlyTransOn,LaterInstTrans + common /comsize/ isize(nm) + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comc8flag/ c8flag(nm) + logical c8flag + sq = chax(92) + vshrink = xinstf1.gt.20. .and. .not.novshrinktop + if (vshrink) then + xinsnow = 10. + else + xinsnow = xinstf1 + end if + if (.not.islast) return +c +c Initialize octave treble clef tracker +c + do 6 im = 1 , nm + c8flag(im) = .false. +6 continue + write(11,'(a)')'%%%%%%%%%%%%%%%%%' + write(11,'(a)')'%' + write(11,'(a)')'% '//basenameq(1:lbase)//'.tex' + write(11,'(a)')'%' + write(11,'(a)')'%%%%%%%%%%%%%%%%' + write(11,'(a)')sq//'input musixtex' + write(11,'(a)')sq//'input pmx' + write(11,'(a)') + * sq//'setmaxslurs{24}'//sq//'setmaxinstruments{24}%' + if (.not.fontslur) write(11,'(a)')sq//'input musixps' +c +c Need to input musixmad to permit more slurs. +c + if (musicsize .eq. 20) then + write(11,'(a)')sq//'normalmusicsize%' + else if (musicsize .eq. 16) then + write(11,'(a)')sq//'smallmusicsize%' + else if (musicsize .eq. 24) then + write(11,'(a)')sq//'largemusicsize%' +c +c Eliminate, per Tennent's analysis and musixtex changes since first input +c +c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// +c * 'meterlargefont}%' + else if (musicsize .eq. 29) then + write(11,'(a)')sq//'Largemusicsize%' +c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// +c * 'meterLargefont}%' + end if +c +c Set sizes. Have sizes per staff in isize(.) and noinst per staff in +c nsperi(.) +c +c 130324 +c iiv = 1 + do 5 iinst = 1 , noinst +c if (isize(iiv) .eq. 1) then + if (isize(iinst) .eq. 1) then + if(iinst.le.9) then + write(11,'(a8,i1,a)') + * sq//'setsize',iinst,sq//'smallvalue%' + else + write(11,'(a9,i2,a)') + * sq//'setsize{',iinst,'}'//sq//'smallvalue%' + end if +c else if (isize(iiv) .eq. 2) then + else if (isize(iinst) .eq. 2) then + if(iinst.le.9) then + write(11,'(a8,i1,a)') + * sq//'setsize',iinst,sq//'tinyvalue%' + else + write(11,'(a9,i2,a)') + * sq//'setsize{',iinst,'}'//sq//'tinyvalue%' + end if + end if +c iiv = iiv+nsperi(iinst) +5 continue + write(fbarq,'(f5.3)')fbar + write(11,'(a)')sq//'nopagenumbers' + write(11,'(a)')sq//'tracingstats=2'//sq//'relax' + write(11,'(a7,i3,a2)')sq//'hsize=',nint(widthpt),'pt' + write(11,'(a6,i'//chax(49+int(log10(height+.1)))//',a2)') + * sq//'vsize',int(height+.1),'pt' + if (abs(hoffpt) .gt. 0.1) then + if (hoffpt .le. -10.) then + write(11,'(a8,i3,a2)')sq//'hoffset',nint(hoffpt),'pt' + else if (hoffpt .lt. 0.) then + write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt' + else if (hoffpt .lt. 10.) then + write(11,'(a8,i1,a2)')sq//'hoffset',nint(hoffpt),'pt' + else + write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt' + end if + end if + if (abs(voffpt) .gt. 0.1) then + if (voffpt .le. -10.) then + write(11,'(a8,i3,a2)')sq//'voffset',nint(voffpt),'pt' + else if (voffpt .lt. 0.) then + write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt' + else if (voffpt .lt. 10.) then + write(11,'(a8,i1,a2)')sq//'voffset',nint(voffpt),'pt' + else + write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt' + end if + end if +c +c The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if +c 3 sharps and treble clef, to avoid vertical clash with top space g# +c + if (isig.eq.3 .and. clefq(nv).eq.'t') write(11,'(a)') + * sq//'def'//sq//'raisebarno{4.5'//sq//'internote}' + if (noinst .lt. 10) then + write(11,'(a19,i1,a1)')sq//'def'//sq//'nbinstruments{', + * noinst,'}' + else + write(11,'(a19,i2,a1)')sq//'def'//sq//'nbinstruments{', + * noinst,'}' + end if + iv = 0 + do 1 iinst = 1 , noinst + nstaves = nsperi(iinst) + if (iinst .lt. 10) then + write(11,'(a)')sq//'setstaffs'//chax(48+iinst) + * //chax(48+nstaves) + else + write(11,'(a11,i2,a)')sq//'setstaffs{',iinst,'}' + * //chax(48+nstaves) + end if + iv = iv+1 + clefqiv = clefq(iv) + if (clefqiv.eq.'8') then + clefqiv='t' + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) + c8flag(iv) = .true. + end if + if (nstaves .eq. 1) then + fmtq = chax(48+numclef(clefq(iv))) + lfmtq = 1 + else + fmtq = '{'//chax(48+numclef(clefq(iv))) + lfmtq = 2 + do 2 k = 2 , nstaves + iv = iv+1 + fmtq = fmtq(1:lfmtq)//chax(48+numclef(clefq(iv))) + lfmtq = lfmtq+1 +2 continue + fmtq = fmtq(1:lfmtq)//'}' + lfmtq = lfmtq+1 + end if + if (iinst .lt. 10) then + write(11,'(a)')sq//'setclef'//chax(48+iinst)//fmtq(1:lfmtq) + else + write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq) + end if + if (clefq(iv) .eq. '8') then + if (iinst .lt. 10) then + write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)// + * sq//'treblelowoct%' + else + write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'// + * sq//'treblelowoct%' + end if + c8flag(iv) = .true. + end if + do 3 lname = 79 , 2 , -1 + if (inameq(iinst)(lname:lname) .ne. ' ') go to 4 +3 continue +4 continue + lnam(iinst) = lname + if (iinst .lt. 10) then + write(11,'(a8,i1,a)')sq//'setname',iinst, + * '{'//inameq(iinst)(1:lname)//'}' + else + write(11,'(a9,i2,a)')sq//'setname{',iinst, + * '}{'//inameq(iinst)(1:lname)//'}' + end if +1 continue + write(11,'(a18,i2,a2)')sq//'generalsignature{',isig,'}%' + if (EarlyTransOn) + * call Writesetsign(nInstTrans,iInstTrans,iTransKey,EarlyTransOn) + call wgmeter(mtrnmp,mtrdnp) + ipi = nint(fracindent*widthpt) + if (ipi .lt. 10) then + write(11,'(a11,i1,a2)')sq//'parindent ',ipi,'pt' + else if (ipi .lt. 100) then + write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt' + else + write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt' + end if + write(11,'(a)')sq//'elemskip1pt'//sq//'afterruleskip' + * //fbarq//'pt'//sq//'beforeruleskip0pt'//sq//'relax' + if (.not.vshrink) then + if (xinstf1 .lt. 9.95) then + fmtq = '(a,f3.1,a)' + else + fmtq = '(a,f4.1,a)' + end if + facis = 1. + if (is4bignv) facis = .95 + write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt' + * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax' + else + write(11,'(a)')sq//'stafftopmarg0pt'// + * sq//'staffbotmarg5'//sq//'Interligne'//sq// + * 'interstaff{10}'//sq//'relax' + end if + if (nv.eq.1) write(11,'(a)')sq//'nostartrule' + write(11,'(a)')sq//'readmod{'//basenameq(1:lbase)//'}' + if (cstuplet) then + write(11,'(a)')sq//'input tuplet' + * //sq//'def'//sq//'xnumt#1#2#3{'//sq//'zcharnote{#2}{~}' + * //sq//'def'//sq//'tuplettxt{'//sq//'smalltype'//sq//'it{#3}' + * //sq//chax(47)//sq//'/}}%' + write(11,'(a)')sq//'let'//sq//'ovbkt'//sq//'uptuplet' + * //sq//'let'//sq//'unbkt'//sq//'downtuplet%' + end if + write(11,'(a)')sq//'startmuflex'//sq//'startpiece'//sq// + * 'addspace'//sq//'afterruleskip%' + return + end + character*1 function udfq(nolev,ncm) +c +c Slur directions +c + common /combc/ bcspec + logical bcspec + ntest = nolev-ncm + if (ntest.lt.0 .or. + * (ntest.eq.0 .and. bcspec .and. ncm.eq.23) ) then + udfq = 'd' + else + udfq = 'u' + end if + return + end + character*1 function udqq(nole,ncm,isl,nvmx,ivx,nv) +c +c Stem direction for single notes +c + character*1 ulfq + character*1 udqqq + logical btest + if (btest(isl,30)) then +c +c Absolute override +c + if (btest(isl,17)) then + udqqq = 'u' + else + udqqq = 'l' + end if + else if (nvmx .eq. 1) then +c +c Single voice per staff, default +c + udqqq = ulfq(1.*nole,ncm) + else +c +c Multi-voice per staff, 1st is lower, 2nd upper +c + if (ivx .le. nv) then + udqqq = 'l' + else + udqqq = 'u' + end if + end if + udqq = udqqq + return + end + character*1 function ulfq(xnolev,ncm) +c +c Stem directions +c + common /combc/ bcspec + logical bcspec + test = xnolev-ncm + if (test.lt.-.001 .or. + * (test.lt..001.and.bcspec.and.ncm.eq.23) ) then + ulfq = 'u' + else + ulfq = 'l' + end if + return + end + function upcaseq(chq) + character*1 chq,upcaseq,chax + if (ichar(chq).ge.61.and.ichar(chq).lt.122) then + upcaseq = chax(ichar(chq)-32) + else + upcaseq = chq + print*,'Warning, upcaseq was called with improper argument: ' + * //chq + stop + end if + return + end + subroutine wgmeter(mtrnmp,mtrdnp) +c +c Writes meter stuff to file 11, so only called if islast=.true. +c + character*1 sq,chax + if (mtrdnp .eq. 0) return + sq=chax(92) + if (mtrnmp.gt.0 .and. mtrnmp.le.9) then + if (mtrdnp .lt. 10) then + write(11,'(a25,i1,a2,i1,a3)') + * sq//'generalmeter{'//sq//'meterfrac{', + * mtrnmp,'}{',mtrdnp,'}}%' + else + write(11,'(a25,i1,a2,i2,a3)') + * sq//'generalmeter{'//sq//'meterfrac{', + * mtrnmp,'}{',mtrdnp,'}}%' + end if + else if (mtrnmp .ge. 10) then + if (mtrdnp .lt. 10) then + write(11,'(a25,i2,a2,i1,a3)') + * sq//'generalmeter{'//sq//'meterfrac{', + * mtrnmp,'}{',mtrdnp,'}}%' + else + write(11,'(a25,i2,a2,i2,a3)') + * sq//'generalmeter{'//sq//'meterfrac{', + * mtrnmp,'}{',mtrdnp,'}}%' + end if + else if (mtrnmp .lt. 0) then + write(11,'(a26,i1,a2,i1,a3)') + * sq//'generalmeter{'//sq//'meterfracS{', + * -mtrnmp,'}{',mtrdnp,'}}%' + else if (mtrdnp .le. 4) then + write(11,'(a21,i1,a2)') + * sq//'generalmeter{'//sq//'meterN',mtrdnp,'}%' + else if (mtrdnp .eq. 5) then + write(11,'(a)')sq//'generalmeter'//sq//'allabreve%' + else if (mtrdnp .eq. 6) then + write(11,'(a)')sq//'generalmeter'//sq//'meterC%' + else if (mtrdnp .eq. 7) then + write(11,'(a)')sq//'generalmeter'//sq//'meterIIIS%' + end if + return + end + subroutine writemidi(jobname,ljob) + parameter(nm=24,mv=24576) + common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, + * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200), + * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm), + * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200), + * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax, + * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200), + * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200), + * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202), + * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9) + character*1 ulq,sepsymq,sq + logical beamon,firstgulp,figbass,figchk,isfig + character*1 byteq(4),char,chax + character*10 tempoq,instq + character*44 jobname + integer*2 mmidi + logical restpend,relacc,notmain,twoline,ismidi,crdacc + common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap, + * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm), + * nmidcrd,midchan(nm,2),numchan,naccim(0:nm), + * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain, + * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) + * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + common /comevent/ miditime,lasttime + logical mmacrec,gottempo + common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac, + * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60), + * mmacrec,gottempo + character*79 inameq + common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, + * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, + * lnam(nm),inameq(nm) + logical rename + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) +c +c Used to be icmm(0:nm); did midi fail when nv>16? +c + integer*2 iinsiv,icmm(0:15) + character*5 versionc + common /comver/ versionc +c +c These are not consecutive because channel 9 is reserved for percussion. +c + data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/ +c +c Write Header +c + write(51,'(a,$)')'MThd'//char(0)//char(0)//char(0)//char(6) + * //char(0)//char(1)//char(0)//char(numchan+1)//char(0)//char(240) + if (debugmidi) + * write(52,'(a6,10Z4)')'"MThd"',0,0,0,6, + * 0,1,0,numchan+1,0,240 +c +c Write the "conductor" track, for keys, meter, and tempos +c Get the number of bytes in the conductor event stream +c + ndata = 1+imidi(numchan)-msecstrt(numchan,nmidsec) + do 15 isec = 1 , nmidsec-1 + ndata = ndata+1+msecend(numchan,isec)-msecstrt(numchan,isec) +15 continue +c ib1 = (4+ljob+26+ndata+4)/256 +c ib0 = 4+ljob+26+ndata+4-256*ib1 + ib1 = (4+ljob+27+ndata+4)/256 + ib0 = 4+ljob+27+ndata+4-256*ib1 + write(51,'(a,$)')'MTrk'//char(0)//char(0)//char(ib1)//char(ib0) +c +c Text header +c +c * //char(0)//char(255)//char(1)//char(ljob+26) + * //char(0)//char(255)//char(1)//char(ljob+27) + if (debugmidi) + * write(52,'(a6,8z4)')'"MTrk"',0,0,ib1,ib0, + * 0,255,1,ljob+27 + write(51,'(a,$)')jobname(1:ljob) + if (debugmidi) write(52,'(a)')chax(34)//jobname(1:ljob)//chax(34) +c +c (separate writes are needed to defeat compiler BUG!!!) +c + write(51,'(a,$)')'.mid, produced by PMX '//versionc + if (debugmidi) write(52,'(a)') + * chax(34)//'.mid, produced by PMX '//versionc//chax(34) +c +c Conductor event data: Loop over sections. +c + do 16 isec = 1 , nmidsec + if (isec .lt. nmidsec) then + mend = msecend(numchan,isec) + else + mend = imidi(numchan) + end if + do 17 i = msecstrt(numchan,isec) , mend + write(51,'(a,$)')char(mmidi(numchan,i)) + if (debugmidi) write(52,'(z4)')mmidi(numchan,i) +17 continue +16 continue +c +c And close out the time sig / tempo track. +c + write(51,'(a,$)')char(0)//char(255)//char(2*16+15)//char(0) + if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0 +c +c Loop over track for each voice: The following sets up iv. +c + iv = nv + if (twoline(nv)) then + kv = 2 + else + kv = 1 + end if +c + do 5 icm = 0 , numchan-1 +c +c Get the number of bytes in the data stream +c + ndata = 1+imidi(icm)-msecstrt(icm,nmidsec) + do 11 isec = 1 , nmidsec-1 + ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec) +11 continue +c +c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, +c + ndata = ndata+11 +c +c Add 4+lnam(iinsiv(iv)) if lnam>0 , +c + if (lnam(iinsiv(iv)).gt.0) ndata = ndata+4+lnam(iinsiv(iv)) +c +c Separate total byte counts into 4 bytes +c + do 2 ibyte = 1 , 4 + if (ndata .gt. 0) then + byteq(ibyte) = char(mod(ndata,256)) + ndata = ishft(ndata,-8) + else + byteq(ibyte) = char(0) + end if +2 continue +c +c Now write front stuff for this track +c + write(51,'(a,$)')'MTrk'//byteq(4)//byteq(3)//byteq(2)//byteq(1) + * //char(0)//char(12*16+icmm(icm))//char(midinst(iinsiv(iv))) + * //char(0)//char(11*16+icmm(icm))//char(10)//char(midbc(icm)) + if (debugmidi) write(52,'(a4,z2,a7,11z4)')'icm=',icm, + * ' "MTrk"',ichar(byteq(4)),ichar(byteq(3)),ichar(byteq(2)), + * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iinsiv(iv)), + * 0,11*16+icmm(icm),10,midbc(icm) + if (lnam(iinsiv(iv)) .gt. 0) then +c +c Add instrument name as sequence name +c + write(51,'(a,$)')char(0)//char(255)//char(3) + * //char(lnam(iinsiv(iv))) + if (debugmidi) write(52,'(4z4)')0,255,3,lnam(iinsiv(iv)) + write(51,'(a,$)') + * inameq(iinsiv(iv))(1:lnam(iinsiv(iv))) + if (debugmidi) write(52,'(a)') + * chax(34)//inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))//chax(34) + end if + write(tempoq,'(i2)')icm + write(instq,'(i3)')midinst(iinsiv(iv)) + call printl('MIDI instrument '//tempoq(1:2)//' is '//instq(1:3)) +c +c Notes: Loop over sections. +c + do 9 isec = 1 , nmidsec + if (isec .lt. nmidsec) then + mend = msecend(icm,isec) + else + mend = imidi(icm) + end if + do 10 i = msecstrt(icm,isec) , mend + write(51,'(a,$)')char(mmidi(icm,i)) + if (debugmidi) write(52,'(z4)')mmidi(icm,i) +10 continue +9 continue +c +c Closing 4 bytes +c + write(51,'(a,$)')chax(0)//char(255)//char(2*16+15)//char(0) + if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0 + if (kv .eq. 2) then + kv = 1 + else if (iv .eq. 1) then + go to 5 + else + iv = iv-1 + if (twoline(iv)) kv=2 + end if +5 continue +c write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan) +c write(15,'(1x,a12,(10i6))') +c * 'Bytes used:',(imidi(icm),icm=0,numchan) + close(51) + if (debugmidi) close(52) + return + end + subroutine Writesetsign(nInstTrans,iInstTrans,iTransKey,flag) + parameter(nm=24) + integer*4 iInstTrans(nm),iTransKey(nm) + character*79 notexq + character*1 chax + logical flag +c +c Assumes notexq is blank +c + do 1 i = 1 , nInstTrans + notexq = chax(92)//'setsign' + lnote = 8 + if (iInstTrans(i) .lt. 10) then + notexq = notexq(1:lnote)//chax(48+iInstTrans(i)) + lnote = lnote+1 + else + write(notexq(lnote+1:lnote+4),'(a1,i2,a1)') + * '{',iInstTrans(i),'}' + lnote = lnote+4 + end if + if (iTransKey(i) .lt. 0) then + write(notexq(lnote+1:lnote+4),'(a1,i2,a1)') + * '{',iTransKey(i),'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//chax(48+iTransKey(i)) + lnote = lnote+1 + end if + write(11,'(a)')notexq(1:lnote)//'%' +1 continue + flag = .false. + return + end + subroutine writflot(x,notexq,lenline) + character*(*) notexq + if (x .lt. 0.95) then + write(notexq(lenline+1:lenline+2),'(f2.1)')x + lenline = lenline+2 + else if (x .lt. 9.95) then + write(notexq(lenline+1:lenline+3),'(f3.1)')x + lenline = lenline+3 + else + write(notexq(lenline+1:lenline+4),'(f4.1)')x + lenline = lenline+4 + end if + return + end + subroutine wsclef(iv,ninow,nclef) +c subroutine wsclef(iv,ninow,clefq,nclef) +c +c Writes \setclef for instrument containing *staff* iv +c + parameter (nm=24) + common /comlast/ islast,usevshrink + logical islast,usevshrink + common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) + logical rename +c +c In pmx271, had removed clefq, so with 2 or more staves in +c an instrument, had problems. So replace in 272 +c + common /comclefq/ clefq(nm) + character*1 clefq,chax + character*40 temq + common /comc8flag/ c8flag(nm) + logical c8flag + if (nclef .lt. 7) then + clefq(iv) = chax(48+nclef) + else + clefq(iv)='9' + end if + if (.not.islast) return + iv1 = 1 + do 1 iinst = 1 , ninow + if (iv .lt. iv1+nspern(iinst)) go to 2 + iv1 = iv1+nspern(iinst) +1 continue + print* + print*,'Should not be here in wsclef!' + call stop1() +2 continue +c +c Here, iinst is the instrument number with staff of clef change +c + iv2 = iv1+nspern(iinst)-1 + if (iinst .lt. 10) then + temq = chax(92)//'setclef'//chax(48+iinst) + ltem = 9 + else + write(temq,'(a9,i2,a1)') chax(92)//'setclef{',iinst,'}' + ltem = 12 + end if + if (iv1 .eq. iv2) then +c +c Only one staff (iv) in instrument with clef change +c + write(11,'(a)')temq(1:ltem)//clefq(iv)//'%' + else + temq = temq(1:ltem)//'{' + ltem = ltem+1 +c +c Loop over staves, but clefq has only changed for one of them +c + do 3 iiv = iv1 , iv2 + temq = temq(1:ltem)//chax(48+numclef(clefq(iiv))) + ltem = ltem+1 +3 continue + write(11,'(a)')temq(1:ltem)//'}%' + end if + if (c8flag(iv)) then +c +c If we change FROM octave treble clef to some other, need the following. +c + write(11,'(a)')char(92)//'settrebleclefsymbol'//chax(48+iinst) + * //char(92)//'trebleclef%' + c8flag(iv) = .false. + end if + return + end + subroutine chkpmxlyr(lineq,iccount,lyrerr) + character*128 lineq + character*1 charq,chax + lyrerr = 0 +c +c On entry, last char was " +c +18 call g1etchar(lineq,iccount,charq) + if (iccount .eq. 121) then + lyrerr = 2 + return + else if (charq.eq.chax(34) .and. + * .not.(lineq(iccount-1:iccount-1).eq.char(92))) then + call g1etchar(lineq,iccount,charq) +c +c Check for raise/lower command +c + if (charq .eq. '@') then +c +c @ positions lyrics vertically for current voice +c [a,b] above or below of the staff +c +/- i offset, \internotes +c + call g1etchar(lineq,iccount,charq) + if (index('ab',charq).eq.0) then + lyrerr = 3 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('+-',charq).eq.0) then + lyrerr = 4 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('0123456789',charq).eq.0) then + lyrerr = 5 + return + end if + else if (charq .ne. ' ') then +c +c 2nd " must be followed by ' ' +c + lyrerr = 1 + return + end if + return + end if + go to 18 + end + subroutine dopmxlyr(lineq,iccount) +c +c lineq has " at iccount. Find end of lyrics string, replace "..." +c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', +c (unless preceded with '\'), check length +c + character*128 lineq,lineqt + character*1 sq,chax + sq = chax(92) + iend = lenstr(lineq,128) +c +c i2nd = iccount+index(lineq(iccount+1:128),'"') +c Find position of closing '"'; must bypass any \" which is used for umlaut +c + i2nd = iccount+index(lineq(iccount+1:128),chax(34)) +2 continue + if (lineq(i2nd-1:i2nd-1).eq.char(92)) then + i2nd = i2nd+index(lineq(i2nd+1:128),chax(34)) + go to 2 + end if + istart = iccount +1 itilde = istart+index(lineq(istart+1:i2nd-1),'~') + if (itilde.gt.istart.and.itilde.lt.i2nd) then +c +c Replace tilde if not preceded by \ +c + if (iend .ge. 117) then + print*,'Sorry, lyric string is too long, stopping' + call stop1() + else if (lineq(itilde-1:itilde-1) .eq. sq) then + istart = itilde + go to 1 + end if + lineqt = lineq(1:itilde-1)//sq//'lk ' + * //lineq(itilde+1:iend) + iend = lenstr(lineqt,128) + i2nd = i2nd+3 + lineq = lineqt + go to 1 + end if + if (iccount .eq. 1) then + lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq + * //lineq(i2nd+1:128) + else + lineqt = lineq(1:iccount-1)//sq//'pmxlyr{' + * //lineq(iccount+1:i2nd-1)//'}'//sq + * //lineq(i2nd+1:128) + end if + i2nd = i2nd+8 + lineq = lineqt + if (lineq(i2nd+1:i2nd+1) .eq. '@') then + lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq + * //lineq(i2nd+5:128) + lineq = lineqt + end if + return + end + subroutine inst2chan(midc,midi,midchan,nv,iinsiv,twoline) +c propagate per-instrument quantities to per-channel ones + parameter (nm=24) + integer*4 midc(0:nm),midi(nm),midchan(nm,2) + integer*2 iinsiv(nm) + logical twoline(nm) + do iv = nv, 1, -1 + if (twoline(iv)) then + midc(midchan(iv,2)) = midi(iinsiv(iv)) + end if + midc(midchan(iv,1)) = midi(iinsiv(iv)) + end do + end + + diff --git a/Build/source/utils/pmx/pmx-src/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c index 2ad12053934..0a697264a8a 100644 --- a/Build/source/utils/pmx/pmx-src/pmxab.c +++ b/Build/source/utils/pmx/pmx-src/pmxab.c @@ -906,6 +906,7 @@ static integer c__2 = 2; static integer c__4 = 4; static integer c__128 = 128; static integer c__3 = 3; +static integer c__47 = 47; static logical c_true = TRUE_; static logical c_false = FALSE_; static integer c__92 = 92; @@ -921,6 +922,7 @@ static integer c__7 = 7; static integer c__22 = 22; static integer c__0 = 0; static integer c__27 = 27; +static integer c__34 = 34; static integer c__10 = 10; static integer c__20 = 20; static integer c__26 = 26; @@ -942,18 +944,16 @@ static integer c__30 = 30; static integer c__60 = 60; static integer c__80 = 80; static integer c__256 = 256; -static integer c__34 = 34; static integer c__120 = 120; static integer c__240 = 240; static integer c__255 = 255; -static integer c__47 = 47; /* Main program */ int MAIN__(void) { /* Initialized data */ - static char date[9] = "17 Mar 20"; - static char version[5] = "2.94 "; + static char date[9] = "12 Dec 21"; + static char version[5] = "2.98 "; static integer maxit = 200; static integer ncalls = 0; static logical isfirst = TRUE_; @@ -962,7 +962,7 @@ static integer c__47 = 47; address a__1[2], a__2[4], a__3[3]; integer i__1, i__2, i__3[2], i__4[4], i__5[3], i__6; real r__1; - char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[56]; + char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[1], ch__6[56]; olist o__1; cllist cl__1; inlist ioin__1; @@ -987,6 +987,7 @@ static integer c__47 = 47; static real poe[125]; static integer ivt, ivx; static real poe0[125]; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); static integer ljob, ipoe[125]; extern /* Subroutine */ int pmxa_(char *, integer *, logical *, integer *, integer *, logical *, ftnlen), pmxb_(logical *, real *, integer * @@ -1105,6 +1106,14 @@ static integer c__47 = 47; /* Forced line break without line number */ /* Fix dot moving when 2nds in chord get flipped */ /* To do: increase length on notexq in dodyn */ +/* 2.98 */ +/* Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...) */ +/* 2.97 */ +/* Fix problem with beaming after new movement command */ +/* 2.96 and 2.95 */ +/* replace and '\','/'. and '"' with chax(); */ +/* eliminate do loops with shared last line */ +/* delete superfluous comments in source */ /* 2.94 */ /* Allow moving dots on main and chord note in 2-note termolos */ /* Add definitions of \hbp and \hbpp to pmx.tex */ @@ -1830,1018 +1839,1022 @@ static integer c__47 = 47; /* cccccccccccccccccccccccc */ /* itstart = mytime() */ -#line 838 "" +#line 847 "" s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5); /* Initialize midi parameters */ -#line 842 "" +#line 851 "" commmac_1.gottempo = FALSE_; -#line 843 "" +#line 852 "" commidi_1.ismidi = FALSE_; -#line 844 "" +#line 853 "" commidi_1.debugmidi = FALSE_; -#line 845 "" +#line 854 "" commidi_1.relacc = FALSE_; -#line 846 "" +#line 855 "" commmac_1.mmacrec = FALSE_; -#line 847 "" +#line 856 "" commmac_1.nmidsec = 1; -#line 848 "" +#line 857 "" commidi_1.mgap = 10; -#line 849 "" +#line 858 "" comevent_1.miditime = 0; -#line 850 "" +#line 859 "" comevent_1.lasttime = 0; -#line 851 "" +#line 860 "" commidi_1.nmidcrd = 0; -#line 852 "" +#line 861 "" comslm_1.nusebl = 0; -#line 853 "" +#line 862 "" commidi_1.notmain = FALSE_; -#line 854 "" +#line 863 "" for (ivx = 1; ivx <= 24; ++ivx) { -#line 855 "" +#line 864 "" commidi_1.twoline[ivx - 1] = FALSE_; -#line 856 "" +#line 865 "" commidi_1.midinst[ivx - 1] = 6; -#line 857 "" +#line 866 "" commvel_1.midivel[ivx - 1] = 127; -#line 858 "" +#line 867 "" commvel_1.midibal[ivx - 1] = 64; -#line 859 "" +#line 868 "" commvel_1.miditran[ivx - 1] = 0; -#line 860 "" +#line 869 "" /* L3: */ -#line 860 "" +#line 869 "" } -#line 861 "" +#line 870 "" for (icm = 0; icm <= 24; ++icm) { -#line 862 "" +#line 871 "" commidi_1.imidi[icm] = 0; -#line 863 "" +#line 872 "" commidi_1.restpend[icm] = FALSE_; -#line 864 "" +#line 873 "" commidi_1.trest[icm] = 0.f; -#line 865 "" +#line 874 "" comslm_1.levson[icm] = 0; -#line 866 "" +#line 875 "" comslm_1.levsoff[icm] = 0; -#line 867 "" +#line 876 "" comslm_1.slmon[icm] = FALSE_; -#line 868 "" +#line 877 "" comslm_1.naccbl[icm] = 0; -#line 869 "" +#line 878 "" comdiag_1.n69[icm] = 0; -#line 870 "" +#line 879 "" comdiag_1.n34[icm] = 0; -#line 871 "" +#line 880 "" commmac_1.msecstrt[icm] = 1; -#line 872 "" +#line 881 "" /* L12: */ -#line 872 "" +#line 881 "" } /* End of midi parameter initialization */ -#line 876 "" +#line 885 "" commus_1.musize = 0; -#line 877 "" +#line 886 "" optimize = FALSE_; -#line 878 "" +#line 887 "" numargs = iargc_(); -#line 879 "" +#line 888 "" if (numargs == 0) { -#line 880 "" +#line 889 "" s_wsle(&io___10); -#line 880 "" +#line 889 "" do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\ "d line,", (ftnlen)53); -#line 880 "" +#line 889 "" e_wsle(); -#line 881 "" +#line 890 "" s_wsle(&io___11); -#line 881 "" +#line 890 "" do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); -#line 881 "" +#line 890 "" e_wsle(); -#line 882 "" +#line 891 "" s_rsfe(&io___12); -#line 882 "" +#line 891 "" do_fio(&c__1, jobname, (ftnlen)44); -#line 882 "" +#line 891 "" e_rsfe(); -#line 883 "" +#line 892 "" numargs = 1; -#line 884 "" +#line 893 "" } else { /* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ -#line 886 "" +#line 895 "" getarg_(&c__1, jobname, (ftnlen)44); -#line 887 "" +#line 896 "" } -#line 888 "" +#line 897 "" L10: -#line 888 "" +#line 897 "" ljob = lenstr_(jobname, &c__44, (ftnlen)44); -#line 889 "" +#line 898 "" if (ljob > 44) { -#line 890 "" +#line 899 "" s_wsle(&io___15); -#line 890 "" +#line 899 "" do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31); -#line 890 "" +#line 899 "" e_wsle(); -#line 891 "" +#line 900 "" stop1_(); -#line 892 "" +#line 901 "" } else if (ljob == 0) { -#line 893 "" +#line 902 "" s_wsle(&io___16); -#line 893 "" +#line 902 "" do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34) ; -#line 893 "" +#line 902 "" e_wsle(); -#line 894 "" +#line 903 "" stop1_(); -#line 895 "" +#line 904 "" } else if (numargs == 2) { -#line 896 "" +#line 905 "" if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) { -#line 897 "" +#line 906 "" optimize = TRUE_; /* call getarg(2,jobname,idum) ! May need to replace this w/ next line */ -#line 899 "" +#line 908 "" getarg_(&c__2, jobname, (ftnlen)44); -#line 900 "" +#line 909 "" numargs = 1; -#line 901 "" +#line 910 "" goto L10; -#line 902 "" +#line 911 "" } else { -#line 903 "" +#line 912 "" s_wsle(&io___17); -#line 903 "" +#line 912 "" do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30) ; -#line 903 "" +#line 912 "" e_wsle(); -#line 904 "" +#line 913 "" stop1_(); -#line 905 "" +#line 914 "" } -#line 906 "" +#line 915 "" } /* Strip ".pmx" if necessary */ /* Computing MAX */ -#line 910 "" +#line 919 "" i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx( jobname, ".PMX", (ftnlen)44, (ftnlen)4); -#line 910 "" +#line 919 "" ndxpmx = max(i__1,i__2); -#line 911 "" +#line 920 "" if (ndxpmx > 0) { -#line 912 "" +#line 921 "" s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1); -#line 913 "" +#line 922 "" ljob += -4; -#line 914 "" +#line 923 "" } /* Check for existence of input file */ /* Writing concatenation */ -#line 918 "" +#line 927 "" i__3[0] = ljob, a__1[0] = jobname; -#line 918 "" +#line 927 "" i__3[1] = 4, a__1[1] = ".pmx"; -#line 918 "" +#line 927 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); -#line 919 "" +#line 928 "" ioin__1.inerr = 0; -#line 919 "" +#line 928 "" ioin__1.infilen = 47; -#line 919 "" +#line 928 "" ioin__1.infile = infileq; -#line 919 "" +#line 928 "" ioin__1.inex = &fexist; -#line 919 "" +#line 928 "" ioin__1.inopen = 0; -#line 919 "" +#line 928 "" ioin__1.innum = 0; -#line 919 "" +#line 928 "" ioin__1.innamed = 0; -#line 919 "" +#line 928 "" ioin__1.inname = 0; -#line 919 "" +#line 928 "" ioin__1.inacc = 0; -#line 919 "" +#line 928 "" ioin__1.inseq = 0; -#line 919 "" +#line 928 "" ioin__1.indir = 0; -#line 919 "" +#line 928 "" ioin__1.infmt = 0; -#line 919 "" +#line 928 "" ioin__1.inform = 0; -#line 919 "" +#line 928 "" ioin__1.inunf = 0; -#line 919 "" +#line 928 "" ioin__1.inrecl = 0; -#line 919 "" +#line 928 "" ioin__1.innrec = 0; -#line 919 "" +#line 928 "" ioin__1.inblank = 0; -#line 919 "" +#line 928 "" f_inqu(&ioin__1); -#line 920 "" +#line 929 "" if (! fexist) { -#line 921 "" +#line 930 "" ioin__1.inerr = 0; -#line 921 "" +#line 930 "" ioin__1.infilen = ljob + 4; /* Writing concatenation */ -#line 921 "" +#line 930 "" i__3[0] = ljob, a__1[0] = jobname; -#line 921 "" +#line 930 "" i__3[1] = 4, a__1[1] = ".PMX"; -#line 921 "" +#line 930 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); -#line 921 "" +#line 930 "" ioin__1.infile = ch__1; -#line 921 "" +#line 930 "" ioin__1.inex = &fexist; -#line 921 "" +#line 930 "" ioin__1.inopen = 0; -#line 921 "" +#line 930 "" ioin__1.innum = 0; -#line 921 "" +#line 930 "" ioin__1.innamed = 0; -#line 921 "" +#line 930 "" ioin__1.inname = 0; -#line 921 "" +#line 930 "" ioin__1.inacc = 0; -#line 921 "" +#line 930 "" ioin__1.inseq = 0; -#line 921 "" +#line 930 "" ioin__1.indir = 0; -#line 921 "" +#line 930 "" ioin__1.infmt = 0; -#line 921 "" +#line 930 "" ioin__1.inform = 0; -#line 921 "" +#line 930 "" ioin__1.inunf = 0; -#line 921 "" +#line 930 "" ioin__1.inrecl = 0; -#line 921 "" +#line 930 "" ioin__1.innrec = 0; -#line 921 "" +#line 930 "" ioin__1.inblank = 0; -#line 921 "" +#line 930 "" f_inqu(&ioin__1); -#line 922 "" +#line 931 "" if (! fexist) { -#line 923 "" +#line 932 "" s_wsle(&io___21); /* Writing concatenation */ -#line 923 "" +#line 932 "" i__3[0] = 17, a__1[0] = "Cannot find file "; -#line 923 "" +#line 932 "" i__3[1] = 47, a__1[1] = infileq; -#line 923 "" +#line 932 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64); -#line 923 "" +#line 932 "" do_lio(&c__9, &c__1, ch__2, (ftnlen)64); -#line 923 "" +#line 932 "" e_wsle(); -#line 924 "" +#line 933 "" stop1_(); -#line 925 "" +#line 934 "" } else { /* Writing concatenation */ -#line 926 "" +#line 935 "" i__3[0] = ljob, a__1[0] = jobname; -#line 926 "" +#line 935 "" i__3[1] = 4, a__1[1] = ".PMX"; -#line 926 "" +#line 935 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); -#line 927 "" +#line 936 "" } -#line 928 "" +#line 937 "" } /* Open a log file */ -#line 932 "" +#line 941 "" o__1.oerr = 0; -#line 932 "" +#line 941 "" o__1.ounit = 15; -#line 932 "" +#line 941 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ -#line 932 "" +#line 941 "" i__3[0] = ljob, a__1[0] = jobname; -#line 932 "" +#line 941 "" i__3[1] = 4, a__1[1] = ".pml"; -#line 932 "" +#line 941 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); -#line 932 "" +#line 941 "" o__1.ofnm = ch__1; -#line 932 "" +#line 941 "" o__1.orl = 0; -#line 932 "" +#line 941 "" o__1.osta = 0; -#line 932 "" +#line 941 "" o__1.oacc = 0; -#line 932 "" +#line 941 "" o__1.ofm = 0; -#line 932 "" +#line 941 "" o__1.oblnk = 0; -#line 932 "" +#line 941 "" f_open(&o__1); /* Writing concatenation */ -#line 933 "" +#line 942 "" i__4[0] = 21, a__2[0] = "This is PMX, Version "; -#line 933 "" +#line 942 "" i__4[1] = 5, a__2[1] = version; -#line 933 "" +#line 942 "" i__4[2] = 2, a__2[2] = ", "; -#line 933 "" +#line 942 "" i__4[3] = 9, a__2[3] = date; -#line 933 "" +#line 942 "" s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37); -#line 933 "" +#line 942 "" printl_(ch__3, (ftnlen)37); -#line 934 "" +#line 943 "" ljob4 = ljob; /* Writing concatenation */ -#line 935 "" +#line 944 "" i__3[0] = 8, a__1[0] = "Opening "; -#line 935 "" +#line 944 "" i__3[1] = 47, a__1[1] = infileq; -#line 935 "" +#line 944 "" s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55); -#line 935 "" +#line 944 "" printl_(ch__4, (ftnlen)55); -#line 936 "" +#line 945 "" o__1.oerr = 0; -#line 936 "" +#line 945 "" o__1.ounit = 18; -#line 936 "" +#line 945 "" o__1.ofnmlen = 47; -#line 936 "" +#line 945 "" o__1.ofnm = infileq; -#line 936 "" +#line 945 "" o__1.orl = 0; -#line 936 "" +#line 945 "" o__1.osta = 0; -#line 936 "" +#line 945 "" o__1.oacc = 0; -#line 936 "" +#line 945 "" o__1.ofm = 0; -#line 936 "" +#line 945 "" o__1.oblnk = 0; -#line 936 "" +#line 945 "" f_open(&o__1); /* Copy input file into common buffer */ -#line 940 "" +#line 949 "" inbuff_1.ipbuf = 0; -#line 941 "" +#line 950 "" truelinecount_1.linewcom[0] = 1; -#line 942 "" +#line 951 "" for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 9600; ++inbuff_1.ilbuf) { -#line 943 "" +#line 952 "" ncomments = 0; -#line 944 "" +#line 953 "" L14: -#line 944 "" +#line 953 "" i__1 = s_rsfe(&io___24); -#line 944 "" +#line 953 "" if (i__1 != 0) { -#line 944 "" +#line 953 "" goto L9; -#line 944 "" +#line 953 "" } -#line 944 "" +#line 953 "" i__1 = do_fio(&c__1, lnholdq, (ftnlen)128); -#line 944 "" +#line 953 "" if (i__1 != 0) { -#line 944 "" +#line 953 "" goto L9; -#line 944 "" +#line 953 "" } -#line 944 "" +#line 953 "" i__1 = e_rsfe(); -#line 944 "" +#line 953 "" if (i__1 != 0) { -#line 944 "" +#line 953 "" goto L9; -#line 944 "" +#line 953 "" } -#line 945 "" +#line 954 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, & c__128, (ftnlen)128); -#line 946 "" +#line 955 "" if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) { /* Blank line. Make it a single blank with length 1 */ -#line 950 "" +#line 959 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1; -#line 951 "" +#line 960 "" s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); -#line 952 "" +#line 961 "" } /* Now line has at least one non blank character. Check for comment */ /* As of Version 260, do not copy comments into bufq */ /* But need to count %'s for error messaging */ /* if (lnholdq(1:1).eq.'%') go to 14 */ -#line 958 "" +#line 967 "" if (*(unsigned char *)lnholdq == '%') { -#line 959 "" +#line 968 "" ++ncomments; -#line 960 "" +#line 969 "" goto L14; -#line 961 "" +#line 970 "" } /* When here, have counted all preceding comments and have a real line */ -#line 965 "" +#line 974 "" if (inbuff_1.ilbuf > 1) { -#line 966 "" +#line 975 "" truelinecount_1.linewcom[inbuff_1.ilbuf - 1] = truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 + ncomments; -#line 967 "" +#line 976 "" } else { -#line 968 "" +#line 977 "" truelinecount_1.linewcom[0] = ncomments + 1; -#line 969 "" +#line 978 "" } -#line 970 "" +#line 979 "" if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 131072) { -#line 971 "" +#line 980 "" s_wsle(&io___26); -#line 971 "" +#line 980 "" do_lio(&c__9, &c__1, "Too many characters in file, stopping", ( ftnlen)37); -#line 971 "" +#line 980 "" e_wsle(); -#line 972 "" +#line 981 "" stop1_(); -#line 973 "" +#line 982 "" } -#line 974 "" +#line 983 "" i__1 = inbuff_1.ipbuf; -#line 974 "" +#line 983 "" s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[ inbuff_1.ilbuf - 1] - i__1, (ftnlen)128); -#line 975 "" +#line 984 "" inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; -#line 976 "" +#line 985 "" /* L8: */ -#line 976 "" +#line 985 "" } -#line 977 "" +#line 986 "" printl_("Too many lines in input file", (ftnlen)28); -#line 978 "" +#line 987 "" stop1_(); -#line 979 "" +#line 988 "" L9: /* Insert dummy line to handle input files w/o CR-LF at end. */ -#line 983 "" +#line 992 "" inbuff_1.nlbuf = inbuff_1.ilbuf - 1; /* nlbuf = ilbuf */ /* bufq(ipbuf+1:ipbuf+3) = ' / ' */ /* lbuf(nlbuf) = 3 */ -#line 987 "" +#line 996 "" cl__1.cerr = 0; -#line 987 "" +#line 996 "" cl__1.cunit = 18; -#line 987 "" +#line 996 "" cl__1.csta = 0; -#line 987 "" +#line 996 "" f_clos(&cl__1); -#line 988 "" +#line 997 "" i__1 = maxit; -#line 988 "" +#line 997 "" for (numit = 1; numit <= i__1; ++numit) { -#line 989 "" +#line 998 "" if (optimize) { -#line 989 "" +#line 998 "" printl_("Starting an iteration", (ftnlen)21); -#line 989 "" +#line 998 "" } /* When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */ /* Otherwise, nbars0 is the input */ /* When islast=.false., pmxb only returns poe's, otherwise does whole job */ -#line 995 "" +#line 1004 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen) 44); -#line 996 "" +#line 1005 "" if (! optimize) { -#line 997 "" +#line 1006 "" if (commidi_1.ismidi) { /* This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */ /* set up here as functions of instrument rather than iv (staff). */ /* Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */ -#line 1003 "" +#line 1012 "" nstaves = 0; -#line 1004 "" +#line 1013 "" ivt = 0; -#line 1005 "" +#line 1014 "" for (iinst = 1; iinst <= 24; ++iinst) { -#line 1006 "" +#line 1015 "" nstaves += c1omget_1.nsperi[iinst - 1]; -#line 1007 "" +#line 1016 "" i__2 = c1omget_1.nsperi[iinst - 1]; -#line 1007 "" +#line 1016 "" for (ivtt = 1; ivtt <= i__2; ++ivtt) { -#line 1008 "" +#line 1017 "" ++ivt; -#line 1009 "" +#line 1018 "" commvel_1.iinsiv[ivt - 1] = (shortint) iinst; -#line 1010 "" +#line 1019 "" /* L17: */ -#line 1010 "" +#line 1019 "" } -#line 1011 "" +#line 1020 "" if (nstaves == a1ll_1.nv) { -#line 1011 "" +#line 1020 "" goto L18; -#line 1011 "" +#line 1020 "" } -#line 1012 "" +#line 1021 "" /* L16: */ -#line 1012 "" +#line 1021 "" } -#line 1013 "" +#line 1022 "" s_wsle(&io___34); -#line 1013 "" +#line 1022 "" do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8); -#line 1013 "" +#line 1022 "" e_wsle(); -#line 1014 "" +#line 1023 "" stop1_(); -#line 1015 "" +#line 1024 "" L18: /* Set up channel numbers for midi. */ -#line 1019 "" +#line 1028 "" commidi_1.numchan = 0; -#line 1020 "" +#line 1029 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { -#line 1021 "" +#line 1030 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { -#line 1022 "" +#line 1031 "" commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan; -#line 1023 "" +#line 1032 "" ++commidi_1.numchan; -#line 1024 "" +#line 1033 "" } -#line 1025 "" +#line 1034 "" commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan; -#line 1026 "" +#line 1035 "" ++commidi_1.numchan; -#line 1027 "" +#line 1036 "" /* L11: */ -#line 1027 "" +#line 1036 "" } /* numchan will now be the number of channels, but max channel # is numchan-1 */ /* Set up velocities, balances, and midi-transpositions */ -#line 1033 "" +#line 1042 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { -#line 1034 "" +#line 1043 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { /* 130302 Make these functions of instrument rather than staff (iv) */ -/* midvelc(midchan(iv,2)) = midivel(iv) */ -/* midbc(midchan(iv,2)) = midibal(iv) */ -/* midtc(midchan(iv,2)) = miditran(iv) */ -#line 1039 "" +#line 1045 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1040 "" +#line 1046 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1041 "" +#line 1047 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1042 "" +#line 1048 "" } -/* midvelc(midchan(iv,1)) = midivel(iv) */ -/* midbc(midchan(iv,1)) = midibal(iv) */ -/* midtc(midchan(iv,1)) = miditran(iv) */ -#line 1046 "" +#line 1049 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1047 "" +#line 1050 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1048 "" +#line 1051 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; -#line 1049 "" +#line 1052 "" /* L13: */ -#line 1049 "" +#line 1052 "" } -#line 1050 "" +#line 1053 "" } /* TEMPORARY!!! */ -#line 1054 "" +#line 1057 "" s_wsle(&io___35); -#line 1054 "" +#line 1057 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); -#line 1054 "" +#line 1057 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof( integer)); -#line 1054 "" +#line 1057 "" e_wsle(); -#line 1055 "" +#line 1058 "" ip1 = 1; -#line 1056 "" +#line 1059 "" i__2 = inbuff_1.nlbuf; -#line 1056 "" +#line 1059 "" for (ilb = 1; ilb <= i__2; ++ilb) { -/* write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */ -/* * bufq(ip1:ip1+lbuf(ilb)-1), */ -/* * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */ -/* * k=min(3,lbuf(ilb)),1,-1) */ -#line 1061 "" +#line 1060 "" ip1 += inbuff_1.lbuf[ilb - 1]; -#line 1062 "" +#line 1061 "" /* L10000: */ -#line 1062 "" +#line 1061 "" } -#line 1063 "" +#line 1062 "" iplast = ip1 - 1; /* Check to see if (1) last line is "/" and (2) next to last */ /* line is "/" */ -#line 1068 "" +#line 1067 "" i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; -#line 1068 "" +#line 1067 "" if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3) == 0) { -#line 1069 "" +#line 1068 "" i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; -#line 1069 "" - if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[ +#line 1068 "" + chax_(ch__5, (ftnlen)1, &c__47); +#line 1068 "" + if (s_cmp(inbuff_1.bufq + i__2, ch__5, iplast - inbuff_1.lbuf[ inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) { -#line 1070 "" +#line 1069 "" s_wsle(&io___39); -#line 1070 "" +#line 1069 "" do_lio(&c__9, &c__1, "Removing last line of \"/\"", (ftnlen)39); -#line 1070 "" +#line 1069 "" e_wsle(); -#line 1071 "" +#line 1070 "" s_wsle(&io___40); -#line 1071 "" +#line 1070 "" do_lio(&c__9, &c__1, "Removing last line of \"/\"", (ftnlen)39); -#line 1071 "" +#line 1070 "" e_wsle(); -#line 1072 "" +#line 1071 "" --inbuff_1.nlbuf; -#line 1073 "" +#line 1072 "" } -#line 1074 "" +#line 1073 "" } -#line 1076 "" +#line 1075 "" pmxb_(&c_true, poe0, &ncalls, &optimize); -#line 1077 "" +#line 1076 "" if (commidi_1.ismidi) { /* Write midi file */ -#line 1081 "" +#line 1080 "" o__1.oerr = 0; -#line 1081 "" +#line 1080 "" o__1.ounit = 51; -#line 1081 "" +#line 1080 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ -#line 1081 "" +#line 1080 "" i__3[0] = ljob, a__1[0] = jobname; -#line 1081 "" +#line 1080 "" i__3[1] = 4, a__1[1] = ".mid"; -#line 1081 "" +#line 1080 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); -#line 1081 "" +#line 1080 "" o__1.ofnm = ch__1; -#line 1081 "" +#line 1080 "" o__1.orl = 0; -#line 1081 "" +#line 1080 "" o__1.osta = 0; -#line 1081 "" +#line 1080 "" o__1.oacc = 0; -#line 1081 "" +#line 1080 "" o__1.ofm = 0; -#line 1081 "" +#line 1080 "" o__1.oblnk = 0; -#line 1081 "" +#line 1080 "" f_open(&o__1); -#line 1082 "" +#line 1081 "" if (commidi_1.debugmidi) { -#line 1082 "" +#line 1081 "" o__1.oerr = 0; -#line 1082 "" +#line 1081 "" o__1.ounit = 52; -#line 1082 "" +#line 1081 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ -#line 1082 "" +#line 1081 "" i__3[0] = ljob, a__1[0] = jobname; -#line 1082 "" +#line 1081 "" i__3[1] = 4, a__1[1] = ".dbm"; -#line 1082 "" +#line 1081 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); -#line 1082 "" +#line 1081 "" o__1.ofnm = ch__1; -#line 1082 "" +#line 1081 "" o__1.orl = 0; -#line 1082 "" +#line 1081 "" o__1.osta = 0; -#line 1082 "" +#line 1081 "" o__1.oacc = 0; -#line 1082 "" +#line 1081 "" o__1.ofm = 0; -#line 1082 "" +#line 1081 "" o__1.oblnk = 0; -#line 1082 "" +#line 1081 "" f_open(&o__1); -#line 1082 "" +#line 1081 "" } -#line 1083 "" +#line 1082 "" printl_(" ", (ftnlen)1); /* Writing concatenation */ -#line 1084 "" +#line 1083 "" i__5[0] = 8, a__3[0] = "Writing "; -#line 1084 "" +#line 1083 "" i__5[1] = ljob, a__3[1] = jobname; -#line 1084 "" +#line 1083 "" i__5[2] = 4, a__3[2] = ".mid"; +#line 1083 "" + s_cat(ch__6, a__3, i__5, &c__3, (ftnlen)56); +#line 1083 "" + printl_(ch__6, ljob + 12); #line 1084 "" - s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56); -#line 1084 "" - printl_(ch__5, ljob + 12); -#line 1085 "" writemidi_(jobname, &ljob, (ftnlen)44); -#line 1086 "" +#line 1085 "" } -#line 1087 "" +#line 1086 "" cl__1.cerr = 0; -#line 1087 "" +#line 1086 "" cl__1.cunit = 15; -#line 1087 "" +#line 1086 "" cl__1.csta = 0; -#line 1087 "" +#line 1086 "" f_clos(&cl__1); -#line 1088 "" +#line 1087 "" s_stop("", (ftnlen)0); -#line 1089 "" +#line 1088 "" } -#line 1090 "" +#line 1089 "" s_wsle(&io___42); -#line 1090 "" +#line 1089 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); -#line 1090 "" +#line 1089 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer)) ; -#line 1090 "" +#line 1089 "" e_wsle(); -#line 1091 "" +#line 1090 "" ip1 = 1; -#line 1092 "" +#line 1091 "" pmxb_(&c_false, poe0, &ncalls, &optimize); -#line 1093 "" +#line 1092 "" poestats_(&nsyst, poe0, &poebar0, &devnorm0); /* Save initial deviation and line breaks for later comparison */ -#line 1097 "" +#line 1096 "" if (numit == 1) { -#line 1098 "" +#line 1097 "" devpmx = devnorm0; -#line 1099 "" +#line 1098 "" i__2 = nsyst; -#line 1099 "" +#line 1098 "" for (isys = 1; isys <= i__2; ++isys) { -#line 1100 "" +#line 1099 "" nbari[isys - 1] = nbars0[isys - 1]; -#line 1101 "" +#line 1100 "" /* L20: */ -#line 1101 "" +#line 1100 "" } -#line 1102 "" +#line 1101 "" } -#line 1103 "" +#line 1102 "" sortpoe_(&nsyst, poe0, ipoe); -#line 1104 "" +#line 1103 "" for (iupord = nsyst; iupord >= 1; --iupord) { -#line 1105 "" +#line 1104 "" isysu = ipoe[iupord - 1]; -#line 1106 "" +#line 1105 "" s_wsle(&io___51); -#line 1106 "" +#line 1105 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); -#line 1106 "" +#line 1105 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); -#line 1106 "" +#line 1105 "" e_wsle(); -#line 1107 "" +#line 1106 "" s_wsle(&io___52); -#line 1107 "" +#line 1106 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); -#line 1107 "" +#line 1106 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); -#line 1107 "" +#line 1106 "" e_wsle(); /* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */ -#line 1111 "" +#line 1110 "" if (poe0[isysu - 1] < poebar0) { -#line 1111 "" +#line 1110 "" goto L1; -#line 1111 "" +#line 1110 "" } -#line 1112 "" +#line 1111 "" i__2 = nsyst; -#line 1112 "" +#line 1111 "" for (idnord = 1; idnord <= i__2; ++idnord) { -#line 1113 "" +#line 1112 "" isysd = ipoe[idnord - 1]; -#line 1114 "" +#line 1113 "" if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd - 1] > poebar0) { -#line 1114 "" +#line 1113 "" goto L5; -#line 1114 "" +#line 1113 "" } -#line 1116 "" +#line 1115 "" i__6 = nsyst; -#line 1116 "" +#line 1115 "" for (isyst = 1; isyst <= i__6; ++isyst) { -#line 1117 "" +#line 1116 "" nbars[isyst - 1] = nbars0[isyst - 1]; -#line 1118 "" +#line 1117 "" if (isyst == isysu) { -#line 1119 "" +#line 1118 "" ++nbars[isyst - 1]; -#line 1120 "" +#line 1119 "" } else if (isyst == isysd) { -#line 1121 "" +#line 1120 "" --nbars[isyst - 1]; -#line 1122 "" +#line 1121 "" } -#line 1123 "" +#line 1122 "" /* L2: */ -#line 1123 "" +#line 1122 "" } -#line 1124 "" +#line 1123 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, ( ftnlen)44); -#line 1125 "" +#line 1124 "" pmxb_(&c_false, poe, &ncalls, &optimize); -#line 1126 "" +#line 1125 "" poestats_(&nsyst, poe, &poebar, &devnorm); -#line 1127 "" +#line 1126 "" if (devnorm < devnorm0) { -#line 1128 "" +#line 1127 "" devnorm0 = devnorm; -#line 1129 "" +#line 1128 "" poebar0 = poebar; -#line 1130 "" +#line 1129 "" i__6 = nsyst; -#line 1130 "" +#line 1129 "" for (isys = 1; isys <= i__6; ++isys) { -#line 1131 "" +#line 1130 "" nbars0[isys - 1] = nbars[isys - 1]; -#line 1132 "" +#line 1131 "" poe0[isys - 1] = poe[isys - 1]; -#line 1133 "" +#line 1132 "" /* L4: */ -#line 1133 "" +#line 1132 "" } -#line 1134 "" +#line 1133 "" s_wsle(&io___60); -#line 1134 "" +#line 1133 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); -#line 1134 "" +#line 1133 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); -#line 1134 "" +#line 1133 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); -#line 1134 "" +#line 1133 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); -#line 1134 "" +#line 1133 "" e_wsle(); -#line 1136 "" +#line 1135 "" s_wsle(&io___61); -#line 1136 "" +#line 1135 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); -#line 1136 "" +#line 1135 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); -#line 1136 "" +#line 1135 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); -#line 1136 "" +#line 1135 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); -#line 1136 "" +#line 1135 "" e_wsle(); -#line 1138 "" +#line 1137 "" s_wsfe(&io___62); -#line 1138 "" +#line 1137 "" i__6 = nsyst; -#line 1138 "" +#line 1137 "" for (isys = 1; isys <= i__6; ++isys) { -#line 1138 "" +#line 1137 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); -#line 1138 "" +#line 1137 "" } -#line 1138 "" +#line 1137 "" e_wsfe(); -#line 1139 "" +#line 1138 "" s_wsfe(&io___63); -#line 1139 "" +#line 1138 "" i__6 = nsyst; -#line 1139 "" +#line 1138 "" for (isys = 1; isys <= i__6; ++isys) { -#line 1139 "" +#line 1138 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); -#line 1139 "" +#line 1138 "" } -#line 1139 "" +#line 1138 "" e_wsfe(); -#line 1140 "" +#line 1139 "" sortpoe_(&nsyst, poe0, ipoe); -#line 1141 "" +#line 1140 "" goto L6; -#line 1142 "" +#line 1141 "" } -#line 1143 "" +#line 1142 "" L5: -#line 1143 "" +#line 1142 "" ; -#line 1143 "" +#line 1142 "" } -#line 1144 "" +#line 1143 "" L1: -#line 1144 "" +#line 1143 "" ; -#line 1144 "" +#line 1143 "" } /* If we get here, must have gone thru all switches and found nothing better, */ /* so done! */ -#line 1149 "" +#line 1148 "" goto L7; -#line 1150 "" +#line 1149 "" L6: -#line 1150 "" +#line 1149 "" ; -#line 1150 "" +#line 1149 "" } -#line 1151 "" +#line 1150 "" L7: -#line 1152 "" +#line 1151 "" s_wsle(&io___64); +#line 1151 "" + do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1151 "" + do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1151 "" + do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1151 "" + do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1151 "" + e_wsle(); +#line 1152 "" + s_wsle(&io___65); #line 1152 "" do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); #line 1152 "" @@ -2853,19 +2866,19 @@ L7: #line 1152 "" e_wsle(); #line 1153 "" - s_wsle(&io___65); + s_wsle(&io___66); #line 1153 "" - do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); + do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); #line 1153 "" - do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); + do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); #line 1153 "" - do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); + do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); #line 1153 "" - do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); + do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); #line 1153 "" e_wsle(); #line 1154 "" - s_wsle(&io___66); + s_wsle(&io___67); #line 1154 "" do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); #line 1154 "" @@ -2877,19 +2890,17 @@ L7: #line 1154 "" e_wsle(); #line 1155 "" - s_wsle(&io___67); -#line 1155 "" - do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); + s_wsle(&io___68); #line 1155 "" - do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); + do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); #line 1155 "" - do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); + r__1 = (1 - devnorm0 / devpmx) * 100.f; #line 1155 "" - do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); + do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); #line 1155 "" e_wsle(); #line 1156 "" - s_wsle(&io___68); + s_wsle(&io___69); #line 1156 "" do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); #line 1156 "" @@ -2899,19 +2910,21 @@ L7: #line 1156 "" e_wsle(); #line 1157 "" - s_wsle(&io___69); -#line 1157 "" - do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); -#line 1157 "" - r__1 = (1 - devnorm0 / devpmx) * 100.f; -#line 1157 "" - do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 1157 "" - e_wsle(); -#line 1158 "" printl_("Initial bars/system:", (ftnlen)20); -#line 1159 "" +#line 1158 "" s_wsfe(&io___70); +#line 1158 "" + i__1 = nsyst; +#line 1158 "" + for (isys = 1; isys <= i__1; ++isys) { +#line 1158 "" + do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1158 "" + } +#line 1158 "" + e_wsfe(); +#line 1159 "" + s_wsfe(&io___71); #line 1159 "" i__1 = nsyst; #line 1159 "" @@ -2923,21 +2936,21 @@ L7: #line 1159 "" e_wsfe(); #line 1160 "" - s_wsfe(&io___71); -#line 1160 "" + printl_("Final bars/system:", (ftnlen)18); +#line 1161 "" + s_wsfe(&io___72); +#line 1161 "" i__1 = nsyst; -#line 1160 "" +#line 1161 "" for (isys = 1; isys <= i__1; ++isys) { -#line 1160 "" - do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); -#line 1160 "" +#line 1161 "" + do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1161 "" } -#line 1160 "" - e_wsfe(); #line 1161 "" - printl_("Final bars/system:", (ftnlen)18); + e_wsfe(); #line 1162 "" - s_wsfe(&io___72); + s_wsfe(&io___73); #line 1162 "" i__1 = nsyst; #line 1162 "" @@ -2949,30 +2962,18 @@ L7: #line 1162 "" e_wsfe(); #line 1163 "" - s_wsfe(&io___73); -#line 1163 "" - i__1 = nsyst; -#line 1163 "" - for (isys = 1; isys <= i__1; ++isys) { -#line 1163 "" - do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); -#line 1163 "" - } -#line 1163 "" - e_wsfe(); -#line 1164 "" pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44); -#line 1165 "" +#line 1164 "" pmxb_(&c_true, poe0, &ncalls, &optimize); -#line 1166 "" +#line 1165 "" cl__1.cerr = 0; -#line 1166 "" +#line 1165 "" cl__1.cunit = 15; -#line 1166 "" +#line 1165 "" cl__1.csta = 0; -#line 1166 "" +#line 1165 "" f_clos(&cl__1); -#line 1167 "" +#line 1166 "" return 0; } /* MAIN__ */ @@ -2991,51 +2992,51 @@ L7: static cilist io___75 = { 0, 6, 0, 0, 0 }; -#line 1170 "" +#line 1169 "" iacc = *nacc & 7; -#line 1171 "" +#line 1170 "" if (iacc == 1) { -#line 1172 "" +#line 1171 "" s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2); -#line 1173 "" +#line 1172 "" *lacc = 2; -#line 1174 "" +#line 1173 "" } else if (iacc == 2) { -#line 1175 "" +#line 1174 "" s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2); -#line 1176 "" +#line 1175 "" *lacc = 2; -#line 1177 "" +#line 1176 "" } else if (iacc == 3) { -#line 1178 "" +#line 1177 "" s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2); -#line 1179 "" +#line 1178 "" *lacc = 2; -#line 1180 "" +#line 1179 "" } else if (iacc == 5) { -#line 1181 "" +#line 1180 "" s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3); -#line 1182 "" +#line 1181 "" *lacc = 3; -#line 1183 "" +#line 1182 "" } else if (iacc == 6) { -#line 1184 "" +#line 1183 "" s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3); -#line 1185 "" +#line 1184 "" *lacc = 3; -#line 1186 "" +#line 1185 "" } else { -#line 1187 "" +#line 1186 "" s_wsle(&io___75); -#line 1187 "" +#line 1186 "" do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16); -#line 1187 "" +#line 1186 "" do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer)); -#line 1187 "" +#line 1186 "" e_wsle(); -#line 1188 "" +#line 1187 "" } -#line 1189 "" +#line 1188 "" return 0; } /* accsym_ */ @@ -3060,125 +3061,125 @@ L7: static cilist io___78 = { 0, 6, 0, 0, 0 }; -#line 1198 "" +#line 1197 "" scoarg = *scaldold * *scfac; -#line 1199 "" +#line 1198 "" if (*isudsp) { /* Find which udsp we're dealing with */ -#line 1203 "" +#line 1202 "" i__1 = comudsp_1.nudsp; -#line 1203 "" +#line 1202 "" for (iudsp = 1; iudsp <= i__1; ++iudsp) { -#line 1204 "" +#line 1203 "" if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs( r__1)) < comtol_1.tol) { -#line 1204 "" +#line 1203 "" goto L2; -#line 1204 "" +#line 1203 "" } -#line 1205 "" +#line 1204 "" /* L1: */ -#line 1205 "" +#line 1204 "" } -#line 1206 "" +#line 1205 "" s_wsle(&io___78); -#line 1206 "" +#line 1205 "" do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen) 36); -#line 1206 "" +#line 1205 "" e_wsle(); -#line 1207 "" +#line 1206 "" stop1_(); -#line 1208 "" +#line 1207 "" L2: /* Fixednew and scaldold must not be changed, since udsp's are already included */ /* in fsyst from pmxa, and udsp don't involve scaled space.. */ -#line 1213 "" +#line 1212 "" if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1, comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) { /* Must add user-defined space to what's there already. */ -#line 1217 "" +#line 1216 "" comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1]; -#line 1218 "" +#line 1217 "" } else { /* This place has no other space. */ -#line 1222 "" +#line 1221 "" ++comas1_1.naskb; -#line 1223 "" +#line 1222 "" comas1_1.task[comas1_1.naskb - 1] = *taskn; -#line 1224 "" +#line 1223 "" comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1]; -#line 1225 "" +#line 1224 "" comas1_1.elask[comas1_1.naskb - 1] = 0.f; -#line 1226 "" +#line 1225 "" } -#line 1227 "" +#line 1226 "" } else { /* 130330 start */ -#line 1229 "" +#line 1228 "" oldwask = 0.f; -#line 1230 "" +#line 1229 "" oldelask = 0.f; /* 130330 end */ /* This is a normal space, no effect if smaller than existing space */ -#line 1235 "" +#line 1234 "" if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1, comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) { /* We already put in some space at this time */ /* Check if new one needs more space than old one at same time */ -#line 1240 "" +#line 1239 "" if (*waskn > comas1_1.wask[comas1_1.naskb - 1]) { /* 130330 We were double counting the larger space when it came 2nd */ /* Need to fix but don't see how yet. Assume times came in order and */ /* that last naskb defined spaces that need updating */ -#line 1246 "" +#line 1245 "" oldwask = comas1_1.wask[comas1_1.naskb - 1]; -#line 1247 "" +#line 1246 "" oldelask = comas1_1.elask[comas1_1.naskb - 1]; /* End of 130330 insertions */ -#line 1249 "" +#line 1248 "" --comas1_1.naskb; -#line 1250 "" +#line 1249 "" } else { -#line 1251 "" +#line 1250 "" return 0; -#line 1252 "" +#line 1251 "" } -#line 1253 "" +#line 1252 "" } -#line 1254 "" +#line 1253 "" ++comas1_1.naskb; -#line 1255 "" +#line 1254 "" comas1_1.task[comas1_1.naskb - 1] = *taskn; -#line 1256 "" +#line 1255 "" comas1_1.wask[comas1_1.naskb - 1] = *waskn; -#line 1257 "" +#line 1256 "" comas1_1.elask[comas1_1.naskb - 1] = *elaskn; /* 130330 start */ /* fixednew = fixednew+waskn */ /* scaldold = scaldold+elaskn */ -#line 1261 "" +#line 1260 "" *fixednew = *fixednew + *waskn - oldwask; -#line 1262 "" +#line 1261 "" *scaldold = scoarg + *elaskn - oldelask; /* 130330 end */ -#line 1264 "" +#line 1263 "" } -#line 1265 "" +#line 1264 "" return 0; } /* addask_ */ @@ -3194,18 +3195,18 @@ L2: /* Local variables */ static char tchar[1]; -#line 1270 "" +#line 1269 "" *(unsigned char *)tchar = *(unsigned char *)noteq; /* Writing concatenation */ -#line 1271 "" +#line 1270 "" i__1[0] = 1, a__1[0] = " "; -#line 1271 "" +#line 1270 "" i__1[1] = 1, a__1[1] = tchar; -#line 1271 "" +#line 1270 "" s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8); -#line 1272 "" +#line 1271 "" *lnoten = 2; -#line 1273 "" +#line 1272 "" return 0; } /* addblank_ */ @@ -3214,54 +3215,54 @@ L2: { static integer ifb; -#line 1281 "" +#line 1280 "" /* Parameter adjustments */ -#line 1281 "" +#line 1280 "" ulfbq -= 25; -#line 1281 "" +#line 1280 "" t2fb -= 25; -#line 1281 "" +#line 1280 "" t1fb -= 25; -#line 1281 "" +#line 1280 "" --nfb; -#line 1281 "" +#line 1280 "" -#line 1281 "" +#line 1280 "" /* Function Body */ -#line 1281 "" +#line 1280 "" *ifbadd = 1; -#line 1282 "" +#line 1281 "" ++nfb[*iv]; -#line 1283 "" +#line 1282 "" for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) { -#line 1284 "" +#line 1283 "" if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) { -#line 1285 "" +#line 1284 "" t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24]; -#line 1286 "" +#line 1285 "" t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24]; -#line 1287 "" +#line 1286 "" *(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char * )&ulfbq[*iv + ifb * 24]; -#line 1288 "" +#line 1287 "" } else { -#line 1289 "" +#line 1288 "" *ifbadd = ifb + 1; -#line 1290 "" +#line 1289 "" goto L2; -#line 1291 "" +#line 1290 "" } -#line 1292 "" +#line 1291 "" /* L1: */ -#line 1292 "" +#line 1291 "" } -#line 1293 "" +#line 1292 "" L2: -#line 1294 "" +#line 1293 "" t1fb[*iv + *ifbadd * 24] = *tnew; -#line 1295 "" +#line 1294 "" *(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x'; -#line 1296 "" +#line 1295 "" return 0; } /* addfb_ */ @@ -3318,178 +3319,178 @@ L2: /* Cancel out barline accidentals if there's a rest. */ -#line 1336 "" +#line 1335 "" if (*rest) { -#line 1336 "" +#line 1335 "" comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0; -#line 1336 "" +#line 1335 "" } /* Special path to insert dummy rest at end of a section */ -#line 1340 "" +#line 1339 "" if (*endrest) { -#line 1340 "" +#line 1339 "" goto L20; -#line 1340 "" +#line 1339 "" } -#line 1342 "" +#line 1341 "" i__1 = commidi_1.nmidcrd; -#line 1342 "" +#line 1341 "" for (ion = 0; ion <= i__1; ++ion) { /* check if this is only to get pitch of a chord note */ -#line 1346 "" +#line 1345 "" if (commidi_1.notmain) { -#line 1346 "" +#line 1345 "" goto L6; -#line 1346 "" +#line 1345 "" } /* check for rest */ -#line 1350 "" +#line 1349 "" if (*rest) { /* Will not put in a note, but must update timing */ -#line 1354 "" +#line 1353 "" if (! commidi_1.restpend[*icm]) { /* First rest in sequence, save the time */ -#line 1358 "" +#line 1357 "" commidi_1.restpend[*icm] = TRUE_; -#line 1359 "" +#line 1358 "" commidi_1.trest[*icm] = *time; -#line 1360 "" +#line 1359 "" } else { -#line 1361 "" +#line 1360 "" commidi_1.trest[*icm] += *time; -#line 1362 "" +#line 1361 "" } /* Note: code checkers don't like the above due to calling addmidi(trest(icm)) */ /* but this only happens if rest at end of section (endrest=.true.) (called */ /* from getmidi(), in which case these above lines are bypassed. */ -#line 1368 "" +#line 1367 "" chkimidi_(icm); -#line 1369 "" +#line 1368 "" return 0; -#line 1370 "" +#line 1369 "" } /* time tics */ -#line 1374 "" +#line 1373 "" if (commidi_1.imidi[*icm] > 0 && ion == 0) { -#line 1375 "" +#line 1374 "" idur = commidi_1.mgap; -#line 1376 "" +#line 1375 "" } else { -#line 1377 "" +#line 1376 "" idur = 0; -#line 1378 "" +#line 1377 "" } -#line 1379 "" +#line 1378 "" if (commidi_1.restpend[*icm]) { -#line 1380 "" +#line 1379 "" commidi_1.restpend[*icm] = FALSE_; -#line 1381 "" +#line 1380 "" r__1 = commidi_1.trest[*icm] * 15; -#line 1381 "" +#line 1380 "" idur += i_nint(&r__1); -#line 1382 "" +#line 1381 "" } /* time to start of note */ -#line 1386 "" +#line 1385 "" idurvar = isetvarlen_(&idur, &nby2on); -#line 1387 "" +#line 1386 "" if (nby2on > 4) { -#line 1388 "" +#line 1387 "" s_wsle(&io___88); -#line 1388 "" +#line 1387 "" do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", ( ftnlen)37); -#line 1388 "" +#line 1387 "" e_wsle(); -#line 1389 "" +#line 1388 "" stop1_(); -#line 1390 "" +#line 1389 "" } -#line 1391 "" +#line 1390 "" ++commidi_1.imidi[*icm]; -#line 1392 "" +#line 1391 "" i__2 = nby2on; -#line 1392 "" +#line 1391 "" for (i__ = 1; i__ <= i__2; ++i__) { /* imidi points to cell before highest (leftmost) byte. Start with lowest byte */ /* at far right, fill in backwards */ -#line 1397 "" +#line 1396 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) * 25 - 25] = (shortint) (idurvar % 256); -#line 1398 "" +#line 1397 "" if (nby2on > 1) { -#line 1398 "" +#line 1397 "" idurvar /= 256; -#line 1398 "" +#line 1397 "" } -#line 1399 "" +#line 1398 "" /* L2: */ -#line 1399 "" +#line 1398 "" } -#line 1400 "" +#line 1399 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1; /* Note-on signal */ -#line 1404 "" +#line 1403 "" ++commidi_1.imidi[*icm]; -#line 1405 "" +#line 1404 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( icmm[*icm] + 144); /* Entry point for chord note pitch determination */ -#line 1409 "" +#line 1408 "" L6: /* Get midi pitch. On chord iteration, only do this first time (main note), */ /* since pitch was already computed for nonmain chord notes. */ -#line 1414 "" +#line 1413 "" if (ion == 0) { -#line 1415 "" +#line 1414 "" ipsav = *nolev * 12.f / 7 + 11; -#line 1416 "" +#line 1415 "" ipsav0 = ipsav; -#line 1417 "" +#line 1416 "" if (*midisig != 0) { /* Adjust for signature */ -#line 1421 "" +#line 1420 "" *(unsigned char *)notenumq = (char) (*nolev % 7 + 48); -#line 1422 "" +#line 1421 "" if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, ( ftnlen)1)) { -#line 1423 "" +#line 1422 "" ++ipsav; -#line 1424 "" +#line 1423 "" } else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen) 7, (ftnlen)1)) { -#line 1425 "" +#line 1424 "" --ipsav; -#line 1426 "" +#line 1425 "" } -#line 1427 "" +#line 1426 "" } /* Deal with accidentals. */ @@ -3498,440 +3499,440 @@ L6: /* effect X fl sh na X dfl dsh X */ /* iashft X -1 1 0 X -2 2 X */ -#line 1435 "" +#line 1434 "" jacc = 0; -#line 1436 "" +#line 1435 "" eximacc = FALSE_; -#line 1437 "" +#line 1436 "" if (*iacc > 0) { /* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */ -#line 1441 "" +#line 1440 "" jacc = iashft_(iacc); -#line 1442 "" +#line 1441 "" eximacc = TRUE_; -#line 1443 "" +#line 1442 "" if (! commidi_1.relacc) { -#line 1443 "" +#line 1442 "" jacc = jacc + ipsav0 - ipsav; -#line 1443 "" +#line 1442 "" } /* (Above) Shift applies to diatonic pitch but will be added to adjusted one */ -#line 1447 "" +#line 1446 "" } else if (commidi_1.naccim[*icm] > 0) { /* Possible implicit accidental from earlier in the bar */ /* Check for prior accid in this bar at this note level */ -#line 1452 "" +#line 1451 "" i__2 = commidi_1.naccim[*icm]; -#line 1452 "" +#line 1451 "" for (kacc = 1; kacc <= i__2; ++kacc) { -#line 1453 "" +#line 1452 "" if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { -#line 1454 "" +#line 1453 "" jacc = commidi_1.jaccim[*icm + kacc * 25 - 25]; -#line 1455 "" +#line 1454 "" eximacc = TRUE_; -#line 1456 "" +#line 1455 "" if (! commidi_1.relacc) { -#line 1456 "" +#line 1455 "" jacc = jacc + ipsav0 - ipsav; -#line 1456 "" +#line 1455 "" } -#line 1457 "" +#line 1456 "" goto L4; -#line 1458 "" +#line 1457 "" } -#line 1459 "" +#line 1458 "" /* L3: */ -#line 1459 "" +#line 1458 "" } -#line 1460 "" +#line 1459 "" L4: -#line 1461 "" +#line 1460 "" ; -#line 1461 "" +#line 1460 "" } /* Must split off the following if block from those above because chord */ /* notes can cause naccim>0, forcing us to miss other chord note's */ /* accross-bar-line accidental */ -#line 1467 "" +#line 1466 "" if (comslm_1.naccbl[*icm] > 0 && ! eximacc) { /* Possible carryover accid from prior bar (or prior same-pitch note). */ -#line 1471 "" +#line 1470 "" i__2 = comslm_1.naccbl[*icm]; -#line 1471 "" +#line 1470 "" for (kacc = 1; kacc <= i__2; ++kacc) { -#line 1472 "" +#line 1471 "" if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) { -#line 1473 "" +#line 1472 "" jacc = comslm_1.jaccbl[*icm + kacc * 25 - 25]; /* Since we are *using* the bar-line accid, must flag it to be saved for next. */ -#line 1477 "" +#line 1476 "" ++comslm_1.nusebl; -#line 1478 "" +#line 1477 "" comips_1.jusebl[comslm_1.nusebl - 1] = (shortint) jacc; -#line 1479 "" +#line 1478 "" comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (* nolev); -#line 1480 "" +#line 1479 "" if (! commidi_1.relacc) { -#line 1480 "" +#line 1479 "" jacc = jacc + ipsav0 - ipsav; -#line 1480 "" +#line 1479 "" } -#line 1481 "" +#line 1480 "" goto L22; -#line 1482 "" +#line 1481 "" } -#line 1483 "" +#line 1482 "" /* L21: */ -#line 1483 "" +#line 1482 "" } -#line 1484 "" +#line 1483 "" L22: -#line 1485 "" +#line 1484 "" ; -#line 1485 "" +#line 1484 "" } -#line 1486 "" +#line 1485 "" ipsav += jacc; -#line 1487 "" +#line 1486 "" } -#line 1488 "" +#line 1487 "" if (commidi_1.notmain) { -#line 1489 "" +#line 1488 "" commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav; /* Save pitch for tie checks */ -#line 1493 "" +#line 1492 "" if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) { -#line 1493 "" +#line 1492 "" comips_1.ipslon[*icm] = (shortint) ipsav; -#line 1493 "" +#line 1492 "" } -#line 1495 "" +#line 1494 "" } else { -#line 1496 "" +#line 1495 "" ++commidi_1.imidi[*icm]; -#line 1497 "" +#line 1496 "" if (ion == 0) { -#line 1498 "" +#line 1497 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) ipsav; -#line 1499 "" +#line 1498 "" if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) { -#line 1499 "" +#line 1498 "" comips_1.ipslon[*icm] = (shortint) ipsav; -#line 1499 "" +#line 1498 "" } -#line 1501 "" +#line 1500 "" } else { -#line 1502 "" +#line 1501 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) commidi_1.mcpitch[ion - 1]; -#line 1503 "" +#line 1502 "" } -#line 1504 "" +#line 1503 "" } -#line 1505 "" +#line 1504 "" if (ion == 0) { /* Only record accids for non-chords, main chord note during chord iteration */ /* and chordnotes on first call but not during iteration */ -#line 1510 "" +#line 1509 "" if (*iacc > 0) { /* Set marker for accidental for possible continuations later this bar */ /* but first check and clear earlier ones on same note. */ -#line 1515 "" +#line 1514 "" i__2 = commidi_1.naccim[*icm]; -#line 1515 "" +#line 1514 "" for (kacc = 1; kacc <= i__2; ++kacc) { -#line 1516 "" +#line 1515 "" if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { -#line 1517 "" +#line 1516 "" i__3 = commidi_1.naccim[*icm] - 1; -#line 1517 "" +#line 1516 "" for (macc = kacc; macc <= i__3; ++macc) { -#line 1518 "" +#line 1517 "" commidi_1.laccim[*icm + macc * 25 - 25] = commidi_1.laccim[*icm + (macc + 1) * 25 - 25]; -#line 1519 "" +#line 1518 "" commidi_1.jaccim[*icm + macc * 25 - 25] = commidi_1.jaccim[*icm + (macc + 1) * 25 - 25]; -#line 1520 "" +#line 1519 "" /* L24: */ -#line 1520 "" +#line 1519 "" } -#line 1521 "" +#line 1520 "" goto L25; -#line 1522 "" +#line 1521 "" } -#line 1523 "" +#line 1522 "" /* L23: */ -#line 1523 "" +#line 1522 "" } -#line 1524 "" +#line 1523 "" goto L26; -#line 1525 "" +#line 1524 "" L25: -#line 1526 "" +#line 1525 "" --commidi_1.naccim[*icm]; -#line 1527 "" +#line 1526 "" L26: /* Flag new accidental */ -#line 1531 "" +#line 1530 "" ++commidi_1.naccim[*icm]; -#line 1532 "" +#line 1531 "" commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = * nolev; -#line 1533 "" +#line 1532 "" commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = iashft_(iacc); -#line 1534 "" +#line 1533 "" } /* Bail if this is a chord note on the first call (from docrd) */ -#line 1538 "" +#line 1537 "" if (commidi_1.notmain) { -#line 1539 "" +#line 1538 "" chkimidi_(icm); -#line 1540 "" +#line 1539 "" return 0; -#line 1541 "" +#line 1540 "" } -#line 1542 "" +#line 1541 "" } /* Vel */ -#line 1546 "" +#line 1545 "" ++commidi_1.imidi[*icm]; -#line 1547 "" +#line 1546 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) commvel_1.midvelc[*icm]; -#line 1548 "" +#line 1547 "" chkimidi_(icm); -#line 1549 "" +#line 1548 "" /* L7: */ -#line 1549 "" +#line 1548 "" } /* For tie checks */ -#line 1553 "" +#line 1552 "" if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) { -#line 1553 "" +#line 1552 "" comslm_1.imidso[*icm] = commidi_1.imidi[*icm]; -#line 1553 "" +#line 1552 "" } /* Entry point for special rests at section ends (endrest=T) */ -#line 1557 "" +#line 1556 "" L20: /* Now insert all the ends */ -#line 1561 "" +#line 1560 "" i__1 = commidi_1.nmidcrd; -#line 1561 "" +#line 1560 "" for (ioff = 0; ioff <= i__1; ++ioff) { -#line 1562 "" +#line 1561 "" if (ioff == 0) { /* time to end */ -#line 1566 "" +#line 1565 "" r__1 = *time * 15; -#line 1566 "" +#line 1565 "" idur1 = i_nint(&r__1); -#line 1567 "" +#line 1566 "" r__1 = commidi_1.trest[*icm] * 15; -#line 1567 "" +#line 1566 "" if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) { -#line 1568 "" +#line 1567 "" idur = idur1 - commidi_1.mgap; -#line 1569 "" +#line 1568 "" } else { -#line 1570 "" +#line 1569 "" idur = idur1; -#line 1571 "" +#line 1570 "" } /* Deal with roundoff problems with 7-tuplets on half or quarters */ -#line 1575 "" +#line 1574 "" if (idur1 == 69) { -#line 1576 "" +#line 1575 "" ++comdiag_1.n69[*icm]; /* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */ -#line 1578 "" +#line 1577 "" if ((comdiag_1.n69[*icm] + 6) % 7 > 3) { -#line 1578 "" +#line 1577 "" idur = idur1 - commidi_1.mgap - 1; -#line 1578 "" +#line 1577 "" } -#line 1579 "" +#line 1578 "" } else if (idur1 == 34) { -#line 1580 "" +#line 1579 "" ++comdiag_1.n34[*icm]; -#line 1581 "" +#line 1580 "" if ((comdiag_1.n34[*icm] + 6) % 7 > 4) { -#line 1581 "" +#line 1580 "" idur = idur1 - commidi_1.mgap + 1; -#line 1581 "" +#line 1580 "" } -#line 1582 "" +#line 1581 "" } -#line 1583 "" +#line 1582 "" idurvar = isetvarlen_(&idur, &nby2off); -#line 1584 "" +#line 1583 "" if (nby2off > 4) { -#line 1585 "" +#line 1584 "" s_wsle(&io___100); -#line 1585 "" +#line 1584 "" do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (ftnlen)37); -#line 1585 "" +#line 1584 "" e_wsle(); -#line 1586 "" +#line 1585 "" stop1_(); -#line 1587 "" +#line 1586 "" } -#line 1588 "" +#line 1587 "" ++commidi_1.imidi[*icm]; -#line 1589 "" +#line 1588 "" chkimidi_(icm); -#line 1590 "" +#line 1589 "" i__2 = nby2off; -#line 1590 "" +#line 1589 "" for (i__ = 1; i__ <= i__2; ++i__) { -#line 1591 "" +#line 1590 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__) * 25 - 25] = (shortint) (idurvar % 256); -#line 1592 "" +#line 1591 "" if (nby2off > 1) { -#line 1592 "" +#line 1591 "" idurvar /= 256; -#line 1592 "" +#line 1591 "" } -#line 1593 "" +#line 1592 "" /* L1: */ -#line 1593 "" +#line 1592 "" } -#line 1594 "" +#line 1593 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1; -#line 1595 "" +#line 1594 "" } else { /* Inserting end of chord note, delta time is 0 */ -#line 1599 "" +#line 1598 "" ++commidi_1.imidi[*icm]; -#line 1600 "" +#line 1599 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; -#line 1601 "" +#line 1600 "" } /* Note off */ -#line 1605 "" +#line 1604 "" ++commidi_1.imidi[*icm]; -#line 1606 "" +#line 1605 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( icmm[*icm] + 128); /* Pitch */ -#line 1610 "" +#line 1609 "" ++commidi_1.imidi[*icm]; -#line 1611 "" +#line 1610 "" if (ioff == 0) { -#line 1612 "" +#line 1611 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) ipsav; -#line 1613 "" +#line 1612 "" } else { -#line 1614 "" +#line 1613 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) commidi_1.mcpitch[ioff - 1]; -#line 1615 "" +#line 1614 "" } /* Vel */ -#line 1619 "" +#line 1618 "" ++commidi_1.imidi[*icm]; -#line 1620 "" +#line 1619 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; -#line 1621 "" +#line 1620 "" chkimidi_(icm); -#line 1622 "" +#line 1621 "" if (*endrest) { -#line 1623 "" +#line 1622 "" return 0; -#line 1624 "" +#line 1623 "" } -#line 1625 "" +#line 1624 "" /* L8: */ -#line 1625 "" +#line 1624 "" } -#line 1626 "" +#line 1625 "" comslm_1.naccbl[*icm] = comslm_1.nusebl; -#line 1627 "" +#line 1626 "" if (comslm_1.nusebl > 0) { /* Fix tables of "bar-line" accids that are saved due to consecutive notes. */ -#line 1631 "" +#line 1630 "" i__1 = comslm_1.nusebl; -#line 1631 "" +#line 1630 "" for (kacc = 1; kacc <= i__1; ++kacc) { -#line 1632 "" +#line 1631 "" comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1] ; -#line 1633 "" +#line 1632 "" comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1] ; -#line 1634 "" +#line 1633 "" /* L30: */ -#line 1634 "" +#line 1633 "" } -#line 1635 "" +#line 1634 "" comslm_1.nusebl = 0; -#line 1636 "" +#line 1635 "" } /* Begin tie checks */ -#line 1640 "" +#line 1639 "" if (comslm_1.slmon[*icm]) { /* Prior note had a slur start */ -#line 1644 "" +#line 1643 "" if (comslm_1.levson[*icm] == comslm_1.levsoff[*icm] && *iacc == 0) { /* We have a tie! (Assumed there would be no accidental on tie-ending note) */ @@ -3940,198 +3941,198 @@ L20: /* comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) */ /* Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */ /* time. */ -#line 1652 "" +#line 1651 "" nsav4tie = 0; -#line 1653 "" +#line 1652 "" imidt = comslm_1.imidso[*icm]; -#line 1654 "" +#line 1653 "" L10: -#line 1654 "" +#line 1653 "" ++nsav4tie; -#line 1655 "" +#line 1654 "" itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, & imidt, &nbytes); -#line 1656 "" +#line 1655 "" imidt += nbytes; -#line 1657 "" +#line 1656 "" for (j = 1; j <= 3; ++j) { -#line 1658 "" +#line 1657 "" itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + ( imidt + j) * 25 - 25]; -#line 1659 "" +#line 1658 "" /* L11: */ -#line 1659 "" +#line 1658 "" } -#line 1660 "" +#line 1659 "" imidt += 3; -#line 1661 "" +#line 1660 "" if (nsav4tie == 1) { -#line 1662 "" +#line 1661 "" itiesav[4] = itiesav[0]; -#line 1663 "" +#line 1662 "" } else { -#line 1664 "" +#line 1663 "" itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] + itiesav[(nsav4tie - 1) * 5 - 1]; -#line 1666 "" +#line 1665 "" } -#line 1667 "" +#line 1666 "" if (imidt != commidi_1.imidi[*icm]) { -#line 1667 "" +#line 1666 "" goto L10; -#line 1667 "" +#line 1666 "" } /* Find which two pitches agree with saved slur pitch. */ -#line 1671 "" +#line 1670 "" it1found = FALSE_; -#line 1672 "" +#line 1671 "" i__1 = nsav4tie; -#line 1672 "" +#line 1671 "" for (it2 = 1; it2 <= i__1; ++it2) { -#line 1673 "" +#line 1672 "" if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) { -#line 1674 "" +#line 1673 "" if (it1found) { -#line 1674 "" +#line 1673 "" goto L13; -#line 1674 "" +#line 1673 "" } -#line 1675 "" +#line 1674 "" it1 = it2; -#line 1676 "" +#line 1675 "" it1found = TRUE_; -#line 1677 "" +#line 1676 "" } -#line 1678 "" +#line 1677 "" /* L12: */ -#line 1678 "" +#line 1677 "" } -#line 1679 "" +#line 1678 "" printl_("Program error, tied notes, send source to Dr. Don", ( ftnlen)49); -#line 1681 "" +#line 1680 "" it1 = nsav4tie + 1; -#line 1682 "" +#line 1681 "" it2 = nsav4tie + 1; -#line 1683 "" +#line 1682 "" L13: /* List the positions we want to keep */ -#line 1687 "" +#line 1686 "" jsav = 0; -#line 1688 "" +#line 1687 "" i__1 = nsav4tie; -#line 1688 "" +#line 1687 "" for (isav = 1; isav <= i__1; ++isav) { -#line 1689 "" +#line 1688 "" if (isav == it1 || isav == it2) { -#line 1689 "" +#line 1688 "" goto L14; -#line 1689 "" +#line 1688 "" } -#line 1690 "" +#line 1689 "" ++jsav; -#line 1691 "" +#line 1690 "" itk[jsav - 1] = (shortint) isav; -#line 1692 "" +#line 1691 "" L14: -#line 1692 "" +#line 1691 "" ; -#line 1692 "" +#line 1691 "" } -#line 1693 "" +#line 1692 "" nsav4tie += -2; /* Now dump events it1 & it2, recompute times, restack mmidi. */ -#line 1697 "" +#line 1696 "" commidi_1.imidi[*icm] = comslm_1.imidso[*icm]; -#line 1698 "" +#line 1697 "" i__1 = nsav4tie; -#line 1698 "" +#line 1697 "" for (isav = 1; isav <= i__1; ++isav) { -#line 1699 "" +#line 1698 "" if (isav == 1) { -#line 1700 "" +#line 1699 "" idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], & nbytes); -#line 1701 "" +#line 1700 "" } else { -#line 1702 "" +#line 1701 "" i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav - 2] * 5 - 1]; -#line 1702 "" +#line 1701 "" idurvar = isetvarlen_(&i__2, &nbytes); -#line 1704 "" +#line 1703 "" } -#line 1705 "" +#line 1704 "" ++commidi_1.imidi[*icm]; -#line 1706 "" +#line 1705 "" i__2 = nbytes; -#line 1706 "" +#line 1705 "" for (i__ = 1; i__ <= i__2; ++i__) { -#line 1707 "" +#line 1706 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes - i__) * 25 - 25] = (shortint) (idurvar % 256); -#line 1708 "" +#line 1707 "" if (nbytes > 1) { -#line 1708 "" +#line 1707 "" idurvar /= 256; -#line 1708 "" +#line 1707 "" } -#line 1709 "" +#line 1708 "" /* L16: */ -#line 1709 "" +#line 1708 "" } -#line 1710 "" +#line 1709 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1; -#line 1711 "" +#line 1710 "" for (i__ = 2; i__ <= 4; ++i__) { -#line 1712 "" +#line 1711 "" ++commidi_1.imidi[*icm]; -#line 1713 "" +#line 1712 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) itiesav[i__ + itk[isav - 1] * 5 - 6]; -#line 1714 "" +#line 1713 "" /* L17: */ -#line 1714 "" +#line 1713 "" } -#line 1715 "" +#line 1714 "" /* L15: */ -#line 1715 "" +#line 1714 "" } -#line 1716 "" +#line 1715 "" } -#line 1717 "" +#line 1716 "" comslm_1.slmon[*icm] = FALSE_; -#line 1718 "" +#line 1717 "" comslm_1.levsoff[*icm] = 0; -#line 1719 "" +#line 1718 "" if (! comslm_1.dbltie) { -#line 1719 "" +#line 1718 "" comslm_1.levson[*icm] = 0; -#line 1719 "" +#line 1718 "" } -#line 1720 "" +#line 1719 "" } -#line 1721 "" +#line 1720 "" if (comslm_1.levson[*icm] > 0) { -#line 1721 "" +#line 1720 "" comslm_1.slmon[*icm] = TRUE_; -#line 1721 "" +#line 1720 "" } -#line 1722 "" +#line 1721 "" if (commidi_1.nmidcrd > 0) { -#line 1722 "" +#line 1721 "" commidi_1.nmidcrd = 0; -#line 1722 "" +#line 1721 "" } -#line 1723 "" +#line 1722 "" chkimidi_(icm); -#line 1724 "" +#line 1723 "" return 0; } /* addmidi_ */ @@ -4153,47 +4154,47 @@ L14: static cilist io___112 = { 0, 11, 0, "(a)", 0 }; -#line 1731 "" +#line 1730 "" if (*lsout + *lnote > 72) { -#line 1732 "" +#line 1731 "" if (comlast_1.islast) { -#line 1732 "" +#line 1731 "" s_wsfe(&io___112); /* Writing concatenation */ -#line 1732 "" +#line 1731 "" i__1[0] = *lsout, a__1[0] = soutq; -#line 1732 "" +#line 1731 "" i__1[1] = 1, a__1[1] = "%"; -#line 1732 "" +#line 1731 "" s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81); -#line 1732 "" +#line 1731 "" do_fio(&c__1, ch__1, *lsout + 1); -#line 1732 "" +#line 1731 "" e_wsfe(); -#line 1732 "" +#line 1731 "" } -#line 1733 "" +#line 1732 "" *lsout = 0; -#line 1734 "" +#line 1733 "" } -#line 1735 "" +#line 1734 "" if (*lsout > 0) { /* Writing concatenation */ -#line 1736 "" +#line 1735 "" i__1[0] = *lsout, a__1[0] = soutq; -#line 1736 "" +#line 1735 "" i__1[1] = *lnote, a__1[1] = notexq; -#line 1736 "" +#line 1735 "" s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80); -#line 1737 "" +#line 1736 "" } else { -#line 1738 "" +#line 1737 "" s_copy(soutq, notexq, (ftnlen)80, (*lnote)); -#line 1739 "" +#line 1738 "" } -#line 1740 "" +#line 1739 "" *lsout += *lnote; -#line 1741 "" +#line 1740 "" return 0; } /* addstr_ */ @@ -4211,63 +4212,63 @@ L14: /* For block ib, this adds accidental spaces to eskz, for use in getting */ /* length of xtup bracket and slopes of brackets and beams. */ -#line 1767 "" +#line 1766 "" /* Parameter adjustments */ -#line 1767 "" +#line 1766 "" --istart; -#line 1767 "" +#line 1766 "" -#line 1767 "" +#line 1766 "" /* Function Body */ -#line 1767 "" +#line 1766 "" inmin = istart[*ib] + 1; -#line 1768 "" +#line 1767 "" i__1 = comas1_1.naskb; -#line 1768 "" +#line 1767 "" for (iaskb = 1; iaskb <= i__1; ++iaskb) { -#line 1769 "" +#line 1768 "" if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] - comtol_1.tol) { -#line 1769 "" +#line 1768 "" goto L10; -#line 1769 "" +#line 1768 "" } -#line 1770 "" +#line 1769 "" eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb - 1]; -#line 1771 "" +#line 1770 "" i__2 = comntot_1.ntot; -#line 1771 "" +#line 1770 "" for (in = inmin; in <= i__2; ++in) { -#line 1772 "" +#line 1771 "" if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) { -#line 1773 "" +#line 1772 "" comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] += eskadd; -#line 1774 "" +#line 1773 "" if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs( r__1)) < comtol_1.tol) { -#line 1774 "" +#line 1773 "" --inmin; -#line 1774 "" +#line 1773 "" } -#line 1775 "" +#line 1774 "" } else { -#line 1776 "" +#line 1775 "" ++inmin; -#line 1777 "" +#line 1776 "" } -#line 1778 "" +#line 1777 "" /* L11: */ -#line 1778 "" +#line 1777 "" } -#line 1779 "" +#line 1778 "" L10: -#line 1779 "" +#line 1778 "" ; -#line 1779 "" +#line 1778 "" } -#line 1780 "" +#line 1779 "" return 0; } /* adjusteskz_ */ @@ -4313,333 +4314,333 @@ L10: static cilist io___130 = { 0, 12, 0, "(a)", 0 }; -#line 1792 "" +#line 1791 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 1792 "" +#line 1791 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 1793 "" +#line 1792 "" o__1.oerr = 0; -#line 1793 "" +#line 1792 "" o__1.ounit = 12; -#line 1793 "" +#line 1792 "" o__1.ofnmlen = *lpath + *lbase + 4; /* Writing concatenation */ -#line 1793 "" +#line 1792 "" i__1[0] = *lpath, a__1[0] = pathnameq; -#line 1793 "" +#line 1792 "" i__1[1] = *lbase, a__1[1] = basenameq; -#line 1793 "" +#line 1792 "" i__1[2] = 4, a__1[2] = ".tex"; -#line 1793 "" +#line 1792 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88); -#line 1793 "" +#line 1792 "" o__1.ofnm = ch__2; -#line 1793 "" +#line 1792 "" o__1.orl = 0; -#line 1793 "" +#line 1792 "" o__1.osta = 0; -#line 1793 "" +#line 1792 "" o__1.oacc = 0; -#line 1793 "" +#line 1792 "" o__1.ofm = 0; -#line 1793 "" +#line 1792 "" o__1.oblnk = 0; -#line 1793 "" +#line 1792 "" f_open(&o__1); /* Transfer first 5 lines of main internal TeX file */ -#line 1797 "" +#line 1796 "" for (il = 1; il <= 5; ++il) { -#line 1798 "" +#line 1797 "" moveln_(&c__11, &c__12, &done); -#line 1799 "" +#line 1798 "" /* L11: */ -#line 1799 "" +#line 1798 "" } -#line 1800 "" +#line 1799 "" if (*istype0) { /* Transfer literal TeX stuff from special scratch file */ -#line 1804 "" +#line 1803 "" al__1.aerr = 0; -#line 1804 "" +#line 1803 "" al__1.aunit = 17; -#line 1804 "" +#line 1803 "" f_rew(&al__1); -#line 1805 "" +#line 1804 "" L10: -#line 1805 "" +#line 1804 "" moveln_(&c__17, &c__12, &done); -#line 1806 "" +#line 1805 "" if (! done) { -#line 1806 "" +#line 1805 "" goto L10; -#line 1806 "" +#line 1805 "" } -#line 1807 "" +#line 1806 "" cl__1.cerr = 0; -#line 1807 "" +#line 1806 "" cl__1.cunit = 17; -#line 1807 "" +#line 1806 "" cl__1.csta = 0; -#line 1807 "" +#line 1806 "" f_clos(&cl__1); -#line 1808 "" +#line 1807 "" } /* Transfer next 2 lines from main scratch file */ -#line 1812 "" +#line 1811 "" for (il = 1; il <= 2; ++il) { -#line 1813 "" +#line 1812 "" moveln_(&c__11, &c__12, &done); -#line 1814 "" +#line 1813 "" /* L3: */ -#line 1814 "" +#line 1813 "" } -#line 1815 "" +#line 1814 "" if (compoi_1.ispoi) { -#line 1815 "" +#line 1814 "" s_wsfe(&io___120); /* Writing concatenation */ -#line 1815 "" +#line 1814 "" i__2[0] = 1, a__2[0] = sq; -#line 1815 "" +#line 1814 "" i__2[1] = 14, a__2[1] = "input musixpoi"; -#line 1815 "" +#line 1814 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); -#line 1815 "" +#line 1814 "" do_fio(&c__1, ch__3, (ftnlen)15); -#line 1815 "" +#line 1814 "" e_wsfe(); -#line 1815 "" +#line 1814 "" } -#line 1816 "" +#line 1815 "" if (combbm_1.isbbm) { -#line 1816 "" +#line 1815 "" s_wsfe(&io___121); /* Writing concatenation */ -#line 1816 "" +#line 1815 "" i__2[0] = 1, a__2[0] = sq; -#line 1816 "" +#line 1815 "" i__2[1] = 14, a__2[1] = "input musixbbm"; -#line 1816 "" +#line 1815 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); -#line 1816 "" +#line 1815 "" do_fio(&c__1, ch__3, (ftnlen)15); -#line 1816 "" +#line 1815 "" e_wsfe(); -#line 1816 "" +#line 1815 "" } -#line 1817 "" +#line 1816 "" if (*figbass) { /* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */ -#line 1821 "" +#line 1820 "" L4: -#line 1821 "" +#line 1820 "" moveln_(&c__14, &c__12, &done); -#line 1822 "" +#line 1821 "" if (! done) { -#line 1822 "" +#line 1821 "" goto L4; -#line 1822 "" +#line 1821 "" } -#line 1823 "" +#line 1822 "" cl__1.cerr = 0; -#line 1823 "" +#line 1822 "" cl__1.cunit = 14; -#line 1823 "" +#line 1822 "" cl__1.csta = 0; -#line 1823 "" +#line 1822 "" f_clos(&cl__1); -#line 1824 "" +#line 1823 "" } -#line 1825 "" +#line 1824 "" comas3_1.iask = 0; -#line 1826 "" +#line 1825 "" ihs = 0; -#line 1827 "" +#line 1826 "" L1: -#line 1827 "" +#line 1826 "" i__3 = s_rsfe(&io___123); -#line 1827 "" +#line 1826 "" if (i__3 != 0) { -#line 1827 "" +#line 1826 "" goto L999; -#line 1827 "" +#line 1826 "" } -#line 1827 "" +#line 1826 "" i__3 = do_fio(&c__1, outq, (ftnlen)129); -#line 1827 "" +#line 1826 "" if (i__3 != 0) { -#line 1827 "" +#line 1826 "" goto L999; -#line 1827 "" +#line 1826 "" } -#line 1827 "" +#line 1826 "" i__3 = e_rsfe(); -#line 1827 "" +#line 1826 "" if (i__3 != 0) { -#line 1827 "" +#line 1826 "" goto L999; -#line 1827 "" +#line 1826 "" } /* Hardspaces. */ /* Writing concatenation */ -#line 1831 "" +#line 1830 "" i__2[0] = 1, a__2[0] = sq; -#line 1831 "" +#line 1830 "" i__2[1] = 4, a__2[1] = "xard"; -#line 1831 "" +#line 1830 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5); -#line 1831 "" +#line 1830 "" if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) { -#line 1832 "" +#line 1831 "" ++ihs; -#line 1833 "" +#line 1832 "" *(unsigned char *)&outq[1] = 'h'; -#line 1834 "" +#line 1833 "" s_wsfi(&io___125); -#line 1834 "" +#line 1833 "" do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real)) ; -#line 1834 "" +#line 1833 "" e_wsfi(); -#line 1835 "" +#line 1834 "" lenout = 19; -#line 1836 "" +#line 1835 "" goto L9; -#line 1837 "" +#line 1836 "" } /* This part hard-wires ask's into new .tex file as ast's */ -#line 1841 "" +#line 1840 "" L2: /* Writing concatenation */ -#line 1841 "" +#line 1840 "" i__2[0] = 1, a__2[0] = sq; -#line 1841 "" +#line 1840 "" i__2[1] = 3, a__2[1] = "ask"; -#line 1841 "" +#line 1840 "" s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4); -#line 1841 "" +#line 1840 "" indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4); -#line 1842 "" +#line 1841 "" if (indxask != 0) { -#line 1843 "" +#line 1842 "" ++comas3_1.iask; -#line 1844 "" +#line 1843 "" putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129) ; -#line 1845 "" +#line 1844 "" goto L2; -#line 1846 "" +#line 1845 "" } -#line 1847 "" +#line 1846 "" lenout = llen_(outq, &c__129, (ftnlen)129); -#line 1848 "" +#line 1847 "" L9: -#line 1849 "" +#line 1848 "" s_wsfe(&io___128); -#line 1849 "" +#line 1848 "" do_fio(&c__1, outq, lenout); -#line 1849 "" +#line 1848 "" e_wsfe(); /* If this is the line with "readmod", check for topmods. */ -#line 1853 "" +#line 1852 "" if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7) == 0) { -#line 1854 "" +#line 1853 "" comas3_1.topmods = FALSE_; -#line 1855 "" +#line 1854 "" al__1.aerr = 0; -#line 1855 "" +#line 1854 "" al__1.aunit = 16; -#line 1855 "" +#line 1854 "" f_rew(&al__1); -#line 1856 "" +#line 1855 "" for (il = 1; il <= 1000; ++il) { -#line 1857 "" +#line 1856 "" i__3 = s_rsfe(&io___129); -#line 1857 "" +#line 1856 "" if (i__3 != 0) { -#line 1857 "" +#line 1856 "" goto L8; -#line 1857 "" +#line 1856 "" } -#line 1857 "" +#line 1856 "" i__3 = do_fio(&c__1, outq, (ftnlen)129); -#line 1857 "" +#line 1856 "" if (i__3 != 0) { -#line 1857 "" +#line 1856 "" goto L8; -#line 1857 "" +#line 1856 "" } -#line 1857 "" +#line 1856 "" i__3 = e_rsfe(); -#line 1857 "" +#line 1856 "" if (i__3 != 0) { -#line 1857 "" +#line 1856 "" goto L8; -#line 1857 "" +#line 1856 "" } -#line 1858 "" +#line 1857 "" lenout = llen_(outq, &c__129, (ftnlen)129); /* We inserted the '%' in subroutine littex, to guarantee including blank. */ -#line 1862 "" +#line 1861 "" s_wsfe(&io___130); -#line 1862 "" +#line 1861 "" do_fio(&c__1, outq, lenout); -#line 1862 "" +#line 1861 "" e_wsfe(); -#line 1863 "" +#line 1862 "" /* L7: */ -#line 1863 "" +#line 1862 "" } -#line 1864 "" +#line 1863 "" L8: -#line 1865 "" +#line 1864 "" cl__1.cerr = 0; -#line 1865 "" +#line 1864 "" cl__1.cunit = 16; -#line 1865 "" +#line 1864 "" cl__1.csta = 0; -#line 1865 "" +#line 1864 "" f_clos(&cl__1); -#line 1866 "" +#line 1865 "" } -#line 1867 "" +#line 1866 "" goto L1; -#line 1868 "" +#line 1867 "" L999: -#line 1868 "" +#line 1867 "" cl__1.cerr = 0; -#line 1868 "" +#line 1867 "" cl__1.cunit = 11; -#line 1868 "" +#line 1867 "" cl__1.csta = 0; -#line 1868 "" +#line 1867 "" f_clos(&cl__1); -#line 1869 "" +#line 1868 "" cl__1.cerr = 0; -#line 1869 "" +#line 1868 "" cl__1.cunit = 12; -#line 1869 "" +#line 1868 "" cl__1.csta = 0; -#line 1869 "" +#line 1868 "" f_clos(&cl__1); -#line 1870 "" +#line 1869 "" return 0; } /* askfig_ */ @@ -4671,80 +4672,80 @@ L999: /* In iunit, looks backward for oldq, overwrites newq */ /* Safest if both are same length! */ -#line 1879 "" +#line 1878 "" linesback = 0; -#line 1880 "" +#line 1879 "" L1: -#line 1881 "" +#line 1880 "" al__1.aerr = 0; -#line 1881 "" +#line 1880 "" al__1.aunit = *iunit; -#line 1881 "" +#line 1880 "" f_back(&al__1); -#line 1882 "" +#line 1881 "" io___132.ciunit = *iunit; -#line 1882 "" +#line 1881 "" s_rsfe(&io___132); -#line 1882 "" +#line 1881 "" do_fio(&c__1, nowq, (ftnlen)128); -#line 1882 "" +#line 1881 "" e_rsfe(); -#line 1883 "" +#line 1882 "" ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold)); /* Save the line just read */ -#line 1887 "" +#line 1886 "" ++linesback; -#line 1888 "" +#line 1887 "" s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128); -#line 1889 "" +#line 1888 "" if (ndx == 0) { -#line 1890 "" +#line 1889 "" al__1.aerr = 0; -#line 1890 "" +#line 1889 "" al__1.aunit = *iunit; -#line 1890 "" +#line 1889 "" f_back(&al__1); -#line 1891 "" +#line 1890 "" goto L1; -#line 1892 "" +#line 1891 "" } /* If here, it's replacement time. */ -#line 1896 "" +#line 1895 "" i__1 = ndx + *lenold - 1; /* Writing concatenation */ -#line 1896 "" +#line 1895 "" i__2[0] = ndx - 1, a__1[0] = nowq; -#line 1896 "" +#line 1895 "" i__2[1] = *lennew, a__1[1] = newq; -#line 1896 "" +#line 1895 "" i__2[2] = 128 - i__1, a__1[2] = nowq + i__1; -#line 1896 "" +#line 1895 "" s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128); -#line 1898 "" +#line 1897 "" al__1.aerr = 0; -#line 1898 "" +#line 1897 "" al__1.aunit = *iunit; -#line 1898 "" +#line 1897 "" f_back(&al__1); -#line 1899 "" +#line 1898 "" for (line = linesback; line >= 1; --line) { -#line 1900 "" +#line 1899 "" io___137.ciunit = *iunit; -#line 1900 "" +#line 1899 "" s_wsfe(&io___137); -#line 1900 "" +#line 1899 "" do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128); -#line 1900 "" +#line 1899 "" e_wsfe(); -#line 1901 "" +#line 1900 "" /* L2: */ -#line 1901 "" +#line 1900 "" } -#line 1902 "" +#line 1901 "" return 0; } /* backfill_ */ @@ -4801,392 +4802,392 @@ L1: static icilist io___160 = { 0, noteq, 0, "(i2)", 2, 1 }; -#line 1930 "" +#line 1929 "" ip = all_1.ipo[all_1.jn - 1]; -#line 1931 "" +#line 1930 "" multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; -#line 1932 "" +#line 1931 "" *lnote = 0; -#line 1933 "" +#line 1932 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) { /* This is the LAST note in the xtup (i.e., all rests before). Make single. */ -#line 1937 "" +#line 1936 "" i__1 = 4 - multip; -#line 1937 "" +#line 1936 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); -#line 1938 "" +#line 1937 "" notex_(notexq, lnote, (ftnlen)79); -#line 1939 "" +#line 1938 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; -#line 1940 "" +#line 1939 "" return 0; -#line 1941 "" +#line 1940 "" } -#line 1942 "" +#line 1941 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ -#line 1946 "" +#line 1945 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { -#line 1947 "" +#line 1946 "" --nole; -#line 1948 "" +#line 1947 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { -#line 1949 "" +#line 1948 "" ++nole; -#line 1950 "" +#line 1949 "" } /* Terminate indented beams for 2-note tremolo if needed */ -#line 1954 "" +#line 1953 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2, &c__5) > 0) { -#line 1956 "" +#line 1955 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], & c__2, &c__5); -#line 1957 "" +#line 1956 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 1958 "" +#line 1957 "" addoff = -1 - nindent * .5f; -#line 1959 "" +#line 1958 "" } else { -#line 1960 "" +#line 1959 "" addoff = nindent * .5f + 1; -#line 1961 "" +#line 1960 "" } /* addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) */ -#line 1963 "" +#line 1962 "" addoff += comxtup_1.islope[commvl_1.ivx - 1] * .0822f; -#line 1964 "" +#line 1963 "" if (addoff < -.05f) { -#line 1965 "" +#line 1964 "" s_wsfi(&io___144); -#line 1965 "" +#line 1964 "" do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); -#line 1965 "" +#line 1964 "" e_wsfi(); -#line 1966 "" +#line 1965 "" } else { -#line 1967 "" +#line 1966 "" s_wsfi(&io___145); -#line 1967 "" +#line 1966 "" do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); -#line 1967 "" +#line 1966 "" e_wsfi(); -#line 1968 "" +#line 1967 "" } /* Writing concatenation */ -#line 1969 "" +#line 1968 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 1969 "" +#line 1968 "" i__2[1] = 5, a__1[1] = "raise"; -#line 1969 "" +#line 1968 "" i__2[2] = 4, a__1[2] = tempq; -#line 1969 "" +#line 1968 "" i__2[3] = 1, a__1[3] = all_1.sq; -#line 1969 "" +#line 1968 "" i__2[4] = 9, a__1[4] = "internote"; -#line 1969 "" +#line 1968 "" i__2[5] = 1, a__1[5] = all_1.sq; -#line 1969 "" +#line 1968 "" i__2[6] = 5, a__1[6] = "hbox{"; -#line 1969 "" +#line 1968 "" i__2[7] = 1, a__1[7] = all_1.sq; -#line 1969 "" +#line 1968 "" i__2[8] = 12, a__1[8] = "loffset{.7}{"; -#line 1969 "" +#line 1968 "" i__2[9] = 1, a__1[9] = all_1.sq; -#line 1969 "" +#line 1968 "" i__2[10] = 2, a__1[10] = "tb"; -#line 1969 "" +#line 1968 "" i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 1969 "" +#line 1968 "" i__2[12] = 3, a__1[12] = "0}}"; -#line 1969 "" +#line 1968 "" s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79); -#line 1972 "" +#line 1971 "" *lnote = 46; -#line 1973 "" +#line 1972 "" } -#line 1974 "" +#line 1973 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ -#line 1978 "" +#line 1977 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { /* Rest at end of unbeamed xtup */ -#line 1982 "" +#line 1981 "" *lnote = 3; -#line 1983 "" +#line 1982 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Writing concatenation */ -#line 1984 "" +#line 1983 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1984 "" +#line 1983 "" i__3[1] = 2, a__2[1] = "sk"; -#line 1984 "" +#line 1983 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); /* 180106 There was a problem with nolev(ivx,ip) not being set to 0 for */ /* a blank rest ending xtup, but hopefully returning from here will handle it. */ -#line 1989 "" +#line 1988 "" return 0; -#line 1990 "" +#line 1989 "" } else if (multip == 0) { /* Writing concatenation */ -#line 1991 "" +#line 1990 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1991 "" +#line 1990 "" i__3[1] = 2, a__2[1] = "qp"; -#line 1991 "" +#line 1990 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 1992 "" +#line 1991 "" } else if (multip == -1) { /* Writing concatenation */ -#line 1993 "" +#line 1992 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1993 "" +#line 1992 "" i__3[1] = 2, a__2[1] = "hp"; -#line 1993 "" +#line 1992 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 1994 "" +#line 1993 "" } else if (multip == 1) { /* Writing concatenation */ -#line 1995 "" +#line 1994 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1995 "" +#line 1994 "" i__3[1] = 2, a__2[1] = "ds"; -#line 1995 "" +#line 1994 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 1996 "" +#line 1995 "" } else if (multip == 2) { /* Writing concatenation */ -#line 1997 "" +#line 1996 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1997 "" +#line 1996 "" i__3[1] = 2, a__2[1] = "qs"; -#line 1997 "" +#line 1996 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 1998 "" +#line 1997 "" } else { /* Writing concatenation */ -#line 1999 "" +#line 1998 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 1999 "" +#line 1998 "" i__3[1] = 2, a__2[1] = "hs"; -#line 1999 "" +#line 1998 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2000 "" +#line 1999 "" } /* 180106 Deal with possible level tweak */ -#line 2004 "" +#line 2003 "" nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 50) % 100 - 50; -#line 2005 "" +#line 2004 "" if (nole != 0) { -#line 2006 "" +#line 2005 "" if (abs(nole) < 10) { -#line 2007 "" +#line 2006 "" i__1 = abs(nole) + 48; -#line 2007 "" +#line 2006 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 2007 "" +#line 2006 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); -#line 2008 "" +#line 2007 "" lnoten = 1; -#line 2009 "" +#line 2008 "" } else { -#line 2010 "" +#line 2009 "" s_wsfi(&io___148); -#line 2010 "" +#line 2009 "" i__1 = abs(nole); -#line 2010 "" +#line 2009 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 2010 "" +#line 2009 "" e_wsfi(); -#line 2011 "" +#line 2010 "" lnoten = 2; -#line 2012 "" +#line 2011 "" } -#line 2013 "" +#line 2012 "" if (nole > 0) { /* Writing concatenation */ -#line 2014 "" +#line 2013 "" i__4[0] = 1, a__3[0] = all_1.sq; -#line 2014 "" +#line 2013 "" i__4[1] = 5, a__3[1] = "raise"; -#line 2014 "" +#line 2013 "" i__4[2] = lnoten, a__3[2] = noteq; -#line 2014 "" +#line 2013 "" i__4[3] = 1, a__3[3] = all_1.sq; -#line 2014 "" +#line 2013 "" i__4[4] = 9, a__3[4] = "internote"; -#line 2014 "" +#line 2013 "" i__4[5] = *lnote, a__3[5] = notexq; -#line 2014 "" +#line 2013 "" s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); -#line 2016 "" +#line 2015 "" } else { /* Writing concatenation */ -#line 2017 "" +#line 2016 "" i__4[0] = 1, a__3[0] = all_1.sq; -#line 2017 "" +#line 2016 "" i__4[1] = 5, a__3[1] = "lower"; -#line 2017 "" +#line 2016 "" i__4[2] = lnoten, a__3[2] = noteq; -#line 2017 "" +#line 2016 "" i__4[3] = 1, a__3[3] = all_1.sq; -#line 2017 "" +#line 2016 "" i__4[4] = 9, a__3[4] = "internote"; -#line 2017 "" +#line 2016 "" i__4[5] = *lnote, a__3[5] = notexq; -#line 2017 "" +#line 2016 "" s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); -#line 2019 "" +#line 2018 "" } -#line 2020 "" +#line 2019 "" *lnote = lnoten + 16 + *lnote; -#line 2021 "" +#line 2020 "" } -#line 2022 "" +#line 2021 "" return 0; -#line 2023 "" +#line 2022 "" } -#line 2024 "" +#line 2023 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { /* Forced stem direction */ -#line 2028 "" +#line 2027 "" ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 2029 "" +#line 2028 "" i__1 = 4 - multip; -#line 2029 "" +#line 2028 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); -#line 2030 "" +#line 2029 "" if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { -#line 2030 "" +#line 2029 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; -#line 2030 "" +#line 2029 "" } -#line 2032 "" +#line 2031 "" notex_(notexq, lnote, (ftnlen)79); -#line 2033 "" +#line 2032 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; -#line 2034 "" +#line 2033 "" } else { -#line 2035 "" +#line 2034 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2035 "" +#line 2034 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2036 "" +#line 2035 "" if (lnoten == 1) { -#line 2036 "" +#line 2035 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 2036 "" +#line 2035 "" } /* To reduce confusion due to this early update of lnote, do it */ /* below, separately in each case/ */ /* lnote = lnoten+3 */ -#line 2041 "" +#line 2040 "" if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* Prior note is not regular-dotted */ -#line 2045 "" +#line 2044 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2, &c__5) > 0) { /* Unbeamed tremolo with indented beams. Put termination in right here */ -#line 2050 "" +#line 2049 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2, &c__5); -#line 2051 "" +#line 2050 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2052 "" +#line 2051 "" addoff = -1 - nindent * .5f; -#line 2053 "" +#line 2052 "" } else { -#line 2054 "" +#line 2053 "" addoff = nindent * .5f + 1; -#line 2055 "" +#line 2054 "" } /* Is there an islope here, for unbeamed? */ -#line 2059 "" +#line 2058 "" if (addoff < -.05f) { -#line 2060 "" +#line 2059 "" s_wsfi(&io___150); -#line 2060 "" +#line 2059 "" do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); -#line 2060 "" +#line 2059 "" e_wsfi(); -#line 2061 "" +#line 2060 "" } else { -#line 2062 "" +#line 2061 "" s_wsfi(&io___151); -#line 2062 "" +#line 2061 "" do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); -#line 2062 "" +#line 2061 "" e_wsfi(); -#line 2063 "" +#line 2062 "" } /* Writing concatenation */ -#line 2064 "" +#line 2063 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2064 "" +#line 2063 "" i__2[1] = 5, a__1[1] = "raise"; -#line 2064 "" +#line 2063 "" i__2[2] = 4, a__1[2] = tempq; -#line 2064 "" +#line 2063 "" i__2[3] = 1, a__1[3] = all_1.sq; -#line 2064 "" +#line 2063 "" i__2[4] = 9, a__1[4] = "internote"; -#line 2064 "" +#line 2063 "" i__2[5] = 1, a__1[5] = all_1.sq; -#line 2064 "" +#line 2063 "" i__2[6] = 5, a__1[6] = "hbox{"; -#line 2064 "" +#line 2063 "" i__2[7] = 1, a__1[7] = all_1.sq; -#line 2064 "" +#line 2063 "" i__2[8] = 12, a__1[8] = "loffset{.7}{"; -#line 2064 "" +#line 2063 "" i__2[9] = 1, a__1[9] = all_1.sq; -#line 2064 "" +#line 2063 "" i__2[10] = 2, a__1[10] = "tb"; -#line 2064 "" +#line 2063 "" i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2064 "" +#line 2063 "" i__2[12] = 3, a__1[12] = "0}}"; -#line 2064 "" +#line 2063 "" s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79); -#line 2068 "" +#line 2067 "" *lnote = 46; -#line 2069 "" +#line 2068 "" } -#line 2070 "" +#line 2069 "" if (multip == 0) { -#line 2071 "" +#line 2070 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 24) { @@ -5195,45 +5196,45 @@ L1: /* But it's not clear if unbeamed half-note tremolo is Kosher, */ /* so don't worry about stem lengths here now. */ -#line 2078 "" +#line 2077 "" if (*lnote == 0) { /* Writing concatenation */ -#line 2079 "" +#line 2078 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2079 "" +#line 2078 "" i__5[1] = 1, a__4[1] = "h"; -#line 2079 "" +#line 2078 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2079 "" +#line 2078 "" i__5[3] = 8, a__4[3] = noteq; -#line 2079 "" +#line 2078 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2080 "" +#line 2079 "" } else { /* Writing concatenation */ -#line 2081 "" +#line 2080 "" i__6[0] = 46, a__5[0] = notexq; -#line 2081 "" +#line 2080 "" i__6[1] = 1, a__5[1] = all_1.sq; -#line 2081 "" +#line 2080 "" i__6[2] = 1, a__5[2] = "h"; -#line 2081 "" +#line 2080 "" i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2081 "" +#line 2080 "" i__6[4] = 8, a__5[4] = noteq; -#line 2081 "" +#line 2080 "" s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); -#line 2083 "" +#line 2082 "" *lnote = 46; -#line 2084 "" +#line 2083 "" } -#line 2085 "" +#line 2084 "" } else { -#line 2086 "" +#line 2085 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 24 || all_1.nodur[commvl_1.ivx + @@ -5241,34 +5242,34 @@ L1: /* Need a dot. */ -#line 2091 "" +#line 2090 "" *lnote = 46; -#line 2092 "" +#line 2091 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2093 "" +#line 2092 "" i__3[0] = 1, a__2[0] = " "; -#line 2093 "" +#line 2092 "" i__3[1] = 1, a__2[1] = noteq; -#line 2093 "" +#line 2092 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 2094 "" +#line 2093 "" lnoten = 2; -#line 2095 "" +#line 2094 "" } /* Insert stemlength stuff here for unbeamed dotted tremolo. */ /* May later combine with below to avoid repeat. But need to */ /* return to normal stem length after note is set. */ -#line 2101 "" +#line 2100 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + ( ip - 1) * 24 - 25], &c__2, &c__5); -#line 2102 "" +#line 2101 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2103 "" +#line 2102 "" slen = (nindent + 4.5f + comxtup_1.nolev1[ commvl_1.ivx - 1] - nole + ( all_1.eskz[commvl_1.ivx + ip * 24 - @@ -5276,9 +5277,9 @@ L1: 1) * 24 - 25] - .7f) * 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac) * .6667f; -#line 2106 "" +#line 2105 "" } else { -#line 2107 "" +#line 2106 "" slen = (nindent + 4.5f - comxtup_1.nolev1[ commvl_1.ivx - 1] + nole - ( all_1.eskz[commvl_1.ivx + ip * 24 - @@ -5286,582 +5287,575 @@ L1: 1) * 24 - 25] - .7f) * 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac) * .6667f; -#line 2110 "" +#line 2109 "" } -#line 2111 "" +#line 2110 "" s_wsfi(&io___153); -#line 2111 "" +#line 2110 "" do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)) ; -#line 2111 "" +#line 2110 "" e_wsfi(); /* Writing concatenation */ -#line 2112 "" +#line 2111 "" i__6[0] = 1, a__5[0] = all_1.sq; -#line 2112 "" +#line 2111 "" i__6[1] = 4, a__5[1] = "slx{"; -#line 2112 "" +#line 2111 "" i__6[2] = 4, a__5[2] = tempq; -#line 2112 "" +#line 2111 "" i__6[3] = 1, a__5[3] = "}"; -#line 2112 "" +#line 2111 "" i__6[4] = *lnote, a__5[4] = notexq; -#line 2112 "" +#line 2111 "" s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); -#line 2113 "" +#line 2112 "" *lnote += 10; -#line 2114 "" +#line 2113 "" } /* Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem */ /* (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot) */ -#line 2119 "" +#line 2118 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) { -#line 2120 "" +#line 2119 "" if (*lnote == 0) { /* notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) */ /* Writing concatenation */ -#line 2122 "" +#line 2121 "" i__6[0] = 1, a__5[0] = all_1.sq; -#line 2122 "" +#line 2121 "" i__6[1] = 1, a__5[1] = "q"; -#line 2122 "" +#line 2121 "" i__6[2] = 1, a__5[2] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 2122 "" +#line 2121 "" i__6[3] = 1, a__5[3] = "p"; -#line 2122 "" +#line 2121 "" i__6[4] = lnoten, a__5[4] = noteq; -#line 2122 "" +#line 2121 "" s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); -#line 2124 "" +#line 2123 "" } else { /* Writing concatenation */ -#line 2125 "" +#line 2124 "" i__4[0] = *lnote, a__3[0] = notexq; -#line 2125 "" +#line 2124 "" i__4[1] = 1, a__3[1] = all_1.sq; -#line 2125 "" +#line 2124 "" i__4[2] = 1, a__3[2] = "q"; -#line 2125 "" +#line 2124 "" i__4[3] = 1, a__3[3] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 2125 "" +#line 2124 "" i__4[4] = 1, a__3[4] = "p"; -#line 2125 "" +#line 2124 "" i__4[5] = lnoten, a__3[5] = noteq; -#line 2125 "" +#line 2124 "" s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); /* * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) */ -#line 2128 "" +#line 2127 "" } /* lnote = lnote+3+lnoten */ -#line 2130 "" +#line 2129 "" *lnote = *lnote + 4 + lnoten; -#line 2131 "" +#line 2130 "" } else { -#line 2132 "" +#line 2131 "" if (*lnote == 0) { /* Writing concatenation */ -#line 2133 "" +#line 2132 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2133 "" +#line 2132 "" i__5[1] = 1, a__4[1] = "q"; -#line 2133 "" +#line 2132 "" i__5[2] = 1, a__4[2] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 2133 "" +#line 2132 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2133 "" +#line 2132 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2135 "" +#line 2134 "" } else { /* Writing concatenation */ -#line 2136 "" +#line 2135 "" i__6[0] = *lnote, a__5[0] = notexq; -#line 2136 "" +#line 2135 "" i__6[1] = 1, a__5[1] = all_1.sq; -#line 2136 "" +#line 2135 "" i__6[2] = 1, a__5[2] = "q"; -#line 2136 "" +#line 2135 "" i__6[3] = 1, a__5[3] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 2136 "" +#line 2135 "" i__6[4] = lnoten, a__5[4] = noteq; -#line 2136 "" +#line 2135 "" s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); -#line 2138 "" +#line 2137 "" } -#line 2139 "" +#line 2138 "" *lnote = *lnote + 3 + lnoten; -#line 2140 "" +#line 2139 "" } -#line 2141 "" +#line 2140 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 24 || all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 12) { /* Writing concatenation */ -#line 2143 "" +#line 2142 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2143 "" +#line 2142 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2143 "" +#line 2142 "" i__7[2] = 3, a__6[2] = "slz"; -#line 2143 "" +#line 2142 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2144 "" +#line 2143 "" *lnote += 4; -#line 2145 "" +#line 2144 "" } -#line 2146 "" +#line 2145 "" } -#line 2147 "" +#line 2146 "" } else if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) { /* 2nd note of unbeamed quarter or 8th trem; make quarter note */ /* Get stemlength change */ -#line 2152 "" +#line 2151 "" *lnote = 46; -#line 2153 "" +#line 2152 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2, &c__5); -#line 2154 "" +#line 2153 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2155 "" +#line 2154 "" slen = (nindent + 4.5f + comxtup_1.nolev1[ commvl_1.ivx - 1] - nole + (all_1.eskz[ commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) * 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac) * .6667f; -#line 2158 "" +#line 2157 "" } else { -#line 2159 "" +#line 2158 "" slen = (nindent + 4.5f - comxtup_1.nolev1[ commvl_1.ivx - 1] + nole - (all_1.eskz[ commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) * 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac) * .6667f; -#line 2162 "" +#line 2161 "" } -#line 2163 "" +#line 2162 "" s_wsfi(&io___154); -#line 2163 "" +#line 2162 "" do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); -#line 2163 "" +#line 2162 "" e_wsfi(); /* Writing concatenation */ -#line 2164 "" +#line 2163 "" i__6[0] = 46, a__5[0] = notexq; -#line 2164 "" +#line 2163 "" i__6[1] = 1, a__5[1] = all_1.sq; -#line 2164 "" +#line 2163 "" i__6[2] = 4, a__5[2] = "slx{"; -#line 2164 "" +#line 2163 "" i__6[3] = 4, a__5[3] = tempq; -#line 2164 "" +#line 2163 "" i__6[4] = 1, a__5[4] = "}"; -#line 2164 "" +#line 2163 "" s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); -#line 2165 "" +#line 2164 "" *lnote += 10; -/* if (lnote .eq. 0) then */ -/* notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */ -/* else */ -/* notexq = notexq(1:46)// */ -/* * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */ -/* end if */ - /* Check for dotted unbeamed tremolo */ -#line 2176 "" +#line 2168 "" if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12.f - all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12, dabs(r__1)) < .001f) { /* Need a dot */ -#line 2180 "" +#line 2172 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2181 "" +#line 2173 "" i__3[0] = 1, a__2[0] = " "; -#line 2181 "" +#line 2173 "" i__3[1] = 1, a__2[1] = noteq; -#line 2181 "" +#line 2173 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 2182 "" +#line 2174 "" lnoten = 2; -#line 2183 "" +#line 2175 "" } -#line 2184 "" +#line 2176 "" if (*lnote == 0) { /* Writing concatenation */ -#line 2185 "" +#line 2177 "" i__7[0] = 1, a__6[0] = all_1.sq; -#line 2185 "" +#line 2177 "" i__7[1] = 2, a__6[1] = "pt"; -#line 2185 "" +#line 2177 "" i__7[2] = lnoten, a__6[2] = noteq; -#line 2185 "" +#line 2177 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2186 "" +#line 2178 "" } else { /* Writing concatenation */ -#line 2187 "" +#line 2179 "" i__5[0] = *lnote, a__4[0] = notexq; -#line 2187 "" +#line 2179 "" i__5[1] = 1, a__4[1] = all_1.sq; -#line 2187 "" +#line 2179 "" i__5[2] = 2, a__4[2] = "pt"; -#line 2187 "" +#line 2179 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2187 "" +#line 2179 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2188 "" +#line 2180 "" } -#line 2189 "" +#line 2181 "" *lnote = *lnote + 3 + lnoten; -#line 2190 "" +#line 2182 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2190 "" +#line 2182 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2191 "" +#line 2183 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2192 "" +#line 2184 "" i__3[0] = 1, a__2[0] = " "; -#line 2192 "" +#line 2184 "" i__3[1] = 1, a__2[1] = noteq; -#line 2192 "" +#line 2184 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 2193 "" +#line 2185 "" lnoten = 2; -#line 2194 "" +#line 2186 "" } -#line 2195 "" +#line 2187 "" } /* Writing concatenation */ -#line 2196 "" +#line 2188 "" i__8[0] = *lnote, a__7[0] = notexq; -#line 2196 "" +#line 2188 "" i__8[1] = 1, a__7[1] = all_1.sq; -#line 2196 "" +#line 2188 "" i__8[2] = 1, a__7[2] = "q"; -#line 2196 "" +#line 2188 "" i__8[3] = 1, a__7[3] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2196 "" +#line 2188 "" i__8[4] = lnoten, a__7[4] = noteq; -#line 2196 "" +#line 2188 "" i__8[5] = 1, a__7[5] = all_1.sq; -#line 2196 "" +#line 2188 "" i__8[6] = 3, a__7[6] = "slz"; -#line 2196 "" +#line 2188 "" s_cat(notexq, a__7, i__8, &c__7, (ftnlen)79); /* * //sq//'stemcut' */ /* lnote=lnote+3+lnoten+8 */ -#line 2201 "" +#line 2193 "" *lnote = *lnote + 3 + lnoten + 4; -#line 2202 "" +#line 2194 "" } else if (multip == -1) { /* Writing concatenation */ -#line 2203 "" +#line 2195 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2203 "" +#line 2195 "" i__5[1] = 1, a__4[1] = "h"; -#line 2203 "" +#line 2195 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2203 "" +#line 2195 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2203 "" +#line 2195 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2204 "" +#line 2196 "" *lnote = lnoten + 3; -#line 2205 "" +#line 2197 "" } else if (multip == 1) { /* Writing concatenation */ -#line 2206 "" +#line 2198 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2206 "" +#line 2198 "" i__5[1] = 1, a__4[1] = "c"; -#line 2206 "" +#line 2198 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2206 "" +#line 2198 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2206 "" +#line 2198 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2207 "" +#line 2199 "" *lnote = lnoten + 3; -#line 2208 "" +#line 2200 "" } else if (multip == 2) { /* Writing concatenation */ -#line 2209 "" +#line 2201 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2209 "" +#line 2201 "" i__5[1] = 2, a__4[1] = "cc"; -#line 2209 "" +#line 2201 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2209 "" +#line 2201 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2209 "" +#line 2201 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2210 "" +#line 2202 "" *lnote = lnoten + 4; -#line 2211 "" +#line 2203 "" } else if (multip == 3) { /* Writing concatenation */ -#line 2212 "" +#line 2204 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2212 "" +#line 2204 "" i__5[1] = 3, a__4[1] = "ccc"; -#line 2212 "" +#line 2204 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2212 "" +#line 2204 "" i__5[3] = lnoten, a__4[3] = noteq; -#line 2212 "" +#line 2204 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2213 "" +#line 2205 "" *lnote = lnoten + 5; -#line 2214 "" +#line 2206 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2215 "" +#line 2207 "" i__7[0] = 1, a__6[0] = all_1.sq; -#line 2215 "" +#line 2207 "" i__7[1] = 2, a__6[1] = "wh"; -#line 2215 "" +#line 2207 "" i__7[2] = lnoten, a__6[2] = noteq; -#line 2215 "" +#line 2207 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2216 "" +#line 2208 "" *lnote = lnoten + 3; -#line 2217 "" +#line 2209 "" } else if (multip == -3) { /* Writing concatenation */ -#line 2218 "" +#line 2210 "" i__7[0] = 1, a__6[0] = all_1.sq; -#line 2218 "" +#line 2210 "" i__7[1] = 5, a__6[1] = "breve"; -#line 2218 "" +#line 2210 "" i__7[2] = lnoten, a__6[2] = noteq; -#line 2218 "" +#line 2210 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2219 "" +#line 2211 "" *lnote = lnoten + 6; -#line 2220 "" +#line 2212 "" } else { -#line 2221 "" +#line 2213 "" s_wsle(&io___155); -#line 2221 "" +#line 2213 "" e_wsle(); -#line 2222 "" +#line 2214 "" s_wsle(&io___156); -#line 2222 "" +#line 2214 "" do_lio(&c__9, &c__1, "(Error in beamend, send source to "\ "Dr. Don)", (ftnlen)42); -#line 2222 "" +#line 2214 "" e_wsle(); -#line 2223 "" +#line 2215 "" stop1_(); -#line 2224 "" +#line 2216 "" } -#line 2225 "" +#line 2217 "" } else { /* Prior note is regular-dotted so this one is halved */ -#line 2229 "" +#line 2221 "" *lnote = lnoten + 3; -#line 2230 "" +#line 2222 "" if (multip == 0) { /* Writing concatenation */ -#line 2231 "" +#line 2223 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2231 "" +#line 2223 "" i__5[1] = 1, a__4[1] = "c"; -#line 2231 "" +#line 2223 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2231 "" +#line 2223 "" i__5[3] = 8, a__4[3] = noteq; -#line 2231 "" +#line 2223 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2232 "" +#line 2224 "" } else if (multip == -1) { /* Writing concatenation */ -#line 2233 "" +#line 2225 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2233 "" +#line 2225 "" i__5[1] = 1, a__4[1] = "q"; -#line 2233 "" +#line 2225 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2233 "" +#line 2225 "" i__5[3] = 8, a__4[3] = noteq; -#line 2233 "" +#line 2225 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2234 "" +#line 2226 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2235 "" +#line 2227 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2235 "" +#line 2227 "" i__5[1] = 1, a__4[1] = "h"; -#line 2235 "" +#line 2227 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2235 "" +#line 2227 "" i__5[3] = 8, a__4[3] = noteq; -#line 2235 "" +#line 2227 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2236 "" +#line 2228 "" } else if (multip == 1) { /* Writing concatenation */ -#line 2237 "" +#line 2229 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2237 "" +#line 2229 "" i__5[1] = 2, a__4[1] = "cc"; -#line 2237 "" +#line 2229 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2237 "" +#line 2229 "" i__5[3] = 8, a__4[3] = noteq; -#line 2237 "" +#line 2229 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2238 "" +#line 2230 "" *lnote = lnoten + 4; -#line 2239 "" +#line 2231 "" } else if (multip == 2) { /* Writing concatenation */ -#line 2240 "" +#line 2232 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2240 "" +#line 2232 "" i__5[1] = 3, a__4[1] = "ccc"; -#line 2240 "" +#line 2232 "" i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2240 "" +#line 2232 "" i__5[3] = 8, a__4[3] = noteq; -#line 2240 "" +#line 2232 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2241 "" +#line 2233 "" *lnote = lnoten + 5; -#line 2242 "" +#line 2234 "" } -#line 2243 "" +#line 2235 "" } -#line 2244 "" +#line 2236 "" } -#line 2245 "" +#line 2237 "" return 0; -#line 2246 "" +#line 2238 "" } /* End of block for unbeamed. Problem if beamed but ends w/ rest. Try just */ /* skipping the call in that case. */ -#line 2251 "" +#line 2243 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 2252 "" +#line 2244 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2252 "" +#line 2244 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2253 "" +#line 2245 "" } /* call notefq(noteq,lnoten,nole,ncmid(iv,ip)) */ /* lnote = 0 */ /* New way, with flipend, which was computed in beamstrt. */ -#line 2259 "" +#line 2251 "" if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],30)) { -#line 2260 "" +#line 2252 "" i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25]; -#line 2260 "" +#line 2252 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 2260 "" +#line 2252 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)&ch__1[0]; -#line 2261 "" +#line 2253 "" strtmid_1.flipend[commvl_1.ivx - 1] = FALSE_; -#line 2262 "" +#line 2254 "" } -#line 2263 "" +#line 2255 "" if (ip > all_1.ibm1[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]) { /* This is not a one-noter from beam-jump. Check if multiplicity has increased */ -#line 2267 "" +#line 2259 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) { /* Prior note is a rest, check one before that */ -#line 2271 "" +#line 2263 "" mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8; -#line 2272 "" +#line 2264 "" } else { -#line 2273 "" +#line 2265 "" mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8; -#line 2274 "" +#line 2266 "" } -#line 2275 "" +#line 2267 "" if (multip > mp) { /* Assume 1-3, 2-3, or 1-2 */ -#line 2279 "" +#line 2271 "" i__1 = mp + 1; -#line 2279 "" +#line 2271 "" for (imp = multip; imp >= i__1; --imp) { -#line 2280 "" +#line 2272 "" ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); -#line 2281 "" +#line 2273 "" /* L2: */ -#line 2281 "" +#line 2273 "" } -#line 2282 "" +#line 2274 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* 2nd member of dotted xtup */ -#line 2286 "" +#line 2278 "" i__1 = multip + 1; -#line 2286 "" +#line 2278 "" ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); -#line 2288 "" +#line 2280 "" } -#line 2289 "" +#line 2281 "" } /* Beam termination and direction analysis */ -#line 2293 "" +#line 2285 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && ! combjmp_1.isbjmp) { @@ -5870,470 +5864,470 @@ L1: /* voice of the 2nd part of jumped beam. (May need special treatment for */ /* multi-segment jump-beams */ -#line 2300 "" +#line 2292 "" combjmp_1.isbjmp = TRUE_; -#line 2301 "" +#line 2293 "" combjmp_1.ivbj1 = commvl_1.ivx; -#line 2302 "" +#line 2294 "" combjmp_1.multbj1 = 15 & all_1.mult[commvl_1.ivx + ip * 24 - 25] - 8; -#line 2303 "" +#line 2295 "" combjmp_1.ivbj2 = 0; -#line 2304 "" +#line 2296 "" } -#line 2305 "" +#line 2297 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) { /* This is either a normal beamend or end of a sequence of jump-beam segments, */ /* (170409) or rest at end of xtup */ /* so some sort of termination is required */ -#line 2311 "" +#line 2303 "" *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; -#line 2312 "" +#line 2304 "" if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) { -#line 2313 "" +#line 2305 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { /* Xtup ends with rest */ -#line 2317 "" +#line 2309 "" if (multip == 1) { /* Writing concatenation */ -#line 2318 "" +#line 2310 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2318 "" +#line 2310 "" i__3[1] = 2, a__2[1] = "ds"; -#line 2318 "" +#line 2310 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2319 "" +#line 2311 "" *lnote = 3; -#line 2320 "" +#line 2312 "" } else if (multip == 2) { /* Writing concatenation */ -#line 2321 "" +#line 2313 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2321 "" +#line 2313 "" i__3[1] = 2, a__2[1] = "qs"; -#line 2321 "" +#line 2313 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2322 "" +#line 2314 "" *lnote = 3; -#line 2323 "" +#line 2315 "" } else if (multip == 3) { /* Writing concatenation */ -#line 2324 "" +#line 2316 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2324 "" +#line 2316 "" i__3[1] = 2, a__2[1] = "hs"; -#line 2324 "" +#line 2316 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2325 "" +#line 2317 "" *lnote = 3; -#line 2326 "" +#line 2318 "" } /* 170801 Borrowed from main rest entry way down below to get level adjustment: */ /* BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? */ /* "... Now raise if necc." */ -#line 2332 "" +#line 2324 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Blank rest */ /* Writing concatenation */ -#line 2336 "" +#line 2328 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2336 "" +#line 2328 "" i__3[1] = 2, a__2[1] = "sk"; -#line 2336 "" +#line 2328 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2337 "" +#line 2329 "" *lnote = 3; -#line 2338 "" +#line 2330 "" } else if (nole != 0) { /* Bandaid. Odd case with rests in xtups + 2 voices where came thru here with */ /* nolev=-4 but expected 100+/-. Try to fix. */ -#line 2343 "" +#line 2335 "" if (abs(nole) < 30) { -#line 2343 "" +#line 2335 "" nole += 100; -#line 2343 "" +#line 2335 "" } -#line 2345 "" +#line 2337 "" if ((i__1 = nole - 100, abs(i__1)) < 10) { -#line 2346 "" +#line 2338 "" i__9 = (i__1 = nole - 100, abs(i__1)) + 48; -#line 2346 "" +#line 2338 "" chax_(ch__1, (ftnlen)1, &i__9); -#line 2346 "" +#line 2338 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); -#line 2347 "" +#line 2339 "" lnoten = 1; -#line 2348 "" +#line 2340 "" } else { -#line 2349 "" +#line 2341 "" s_wsfi(&io___160); -#line 2349 "" +#line 2341 "" i__9 = (i__1 = nole - 100, abs(i__1)); -#line 2349 "" +#line 2341 "" do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer)); -#line 2349 "" +#line 2341 "" e_wsfi(); -#line 2350 "" +#line 2342 "" lnoten = 2; -#line 2351 "" +#line 2343 "" } /* ??? if (nole .gt. 0) then */ -#line 2353 "" +#line 2345 "" if (nole > 100) { /* Writing concatenation */ -#line 2354 "" +#line 2346 "" i__4[0] = 1, a__3[0] = all_1.sq; -#line 2354 "" +#line 2346 "" i__4[1] = 5, a__3[1] = "raise"; -#line 2354 "" +#line 2346 "" i__4[2] = lnoten, a__3[2] = noteq; -#line 2354 "" +#line 2346 "" i__4[3] = 1, a__3[3] = all_1.sq; -#line 2354 "" +#line 2346 "" i__4[4] = 9, a__3[4] = "internote"; -#line 2354 "" +#line 2346 "" i__4[5] = *lnote, a__3[5] = notexq; -#line 2354 "" +#line 2346 "" s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); -#line 2356 "" +#line 2348 "" } else { /* Writing concatenation */ -#line 2357 "" +#line 2349 "" i__4[0] = 1, a__3[0] = all_1.sq; -#line 2357 "" +#line 2349 "" i__4[1] = 5, a__3[1] = "lower"; -#line 2357 "" +#line 2349 "" i__4[2] = lnoten, a__3[2] = noteq; -#line 2357 "" +#line 2349 "" i__4[3] = 1, a__3[3] = all_1.sq; -#line 2357 "" +#line 2349 "" i__4[4] = 9, a__3[4] = "internote"; -#line 2357 "" +#line 2349 "" i__4[5] = *lnote, a__3[5] = notexq; -#line 2357 "" +#line 2349 "" s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); -#line 2359 "" +#line 2351 "" } -#line 2360 "" +#line 2352 "" *lnote = lnoten + 16 + *lnote; -#line 2361 "" +#line 2353 "" } -#line 2362 "" +#line 2354 "" return 0; -#line 2363 "" +#line 2355 "" } else { /* Normal termination */ -#line 2367 "" +#line 2359 "" i__1 = commvl_1.ivx % 24; -#line 2367 "" +#line 2359 "" ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); -#line 2368 "" +#line 2360 "" } -#line 2369 "" +#line 2361 "" } else { /* Terminate a sequence of jump-beam segments. */ -#line 2373 "" +#line 2365 "" i__1 = 225 - *(unsigned char *)ulqq; -#line 2373 "" +#line 2365 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 2373 "" +#line 2365 "" *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; -#line 2374 "" +#line 2366 "" i__1 = combjmp_1.ivbj1 % 24; -#line 2374 "" +#line 2366 "" ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); -#line 2375 "" +#line 2367 "" } -#line 2376 "" +#line 2368 "" } /* Check for end of 2nd seg of staff-jump xtup chord blank rest */ /* if (isbjmp.and.ivx.eq.ivbj2 */ -#line 2381 "" +#line 2373 "" if (combjmp_1.isbjmp && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 29)) { /* Writing concatenation */ -#line 2383 "" +#line 2375 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2383 "" +#line 2375 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2383 "" +#line 2375 "" i__7[2] = 2, a__6[2] = "sk"; -#line 2383 "" +#line 2375 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2384 "" +#line 2376 "" return 0; -#line 2385 "" +#line 2377 "" } /* And now the note, checking for open-head beamed tremolo */ -#line 2389 "" +#line 2381 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) { /* Check for dotted tremolo */ -#line 2393 "" +#line 2385 "" if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12.f - all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12, dabs(r__1)) < .001f) { /* Need a dot */ -#line 2397 "" +#line 2389 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 24 || all_1.nodur[ commvl_1.ivx + ip * 24 - 25] == 12) { /* Solid notehead */ /* Writing concatenation */ -#line 2401 "" +#line 2393 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2401 "" +#line 2393 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2401 "" +#line 2393 "" i__7[2] = 3, a__6[2] = "qbp"; -#line 2401 "" +#line 2393 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2402 "" +#line 2394 "" } else { /* Assuming open notehead and nodur = 48 */ /* Writing concatenation */ -#line 2406 "" +#line 2398 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2406 "" +#line 2398 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2406 "" +#line 2398 "" i__7[2] = 3, a__6[2] = "hbp"; -#line 2406 "" +#line 2398 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2407 "" +#line 2399 "" } -#line 2408 "" +#line 2400 "" *lnote += 4; -#line 2409 "" +#line 2401 "" } else { -#line 2410 "" +#line 2402 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 32 || all_1.nodur[ commvl_1.ivx + ip * 24 - 25] == 48) { -#line 2411 "" +#line 2403 "" if (*lnote > 0) { /* Writing concatenation */ -#line 2412 "" +#line 2404 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2412 "" +#line 2404 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2412 "" +#line 2404 "" i__7[2] = 2, a__6[2] = "hb"; -#line 2412 "" +#line 2404 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2413 "" +#line 2405 "" } else { /* Writing concatenation */ -#line 2414 "" +#line 2406 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2414 "" +#line 2406 "" i__3[1] = 2, a__2[1] = "hb"; -#line 2414 "" +#line 2406 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2415 "" +#line 2407 "" } -#line 2416 "" +#line 2408 "" } else { -#line 2417 "" +#line 2409 "" if (*lnote > 0) { /* Writing concatenation */ -#line 2418 "" +#line 2410 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2418 "" +#line 2410 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2418 "" +#line 2410 "" i__7[2] = 2, a__6[2] = "qb"; -#line 2418 "" +#line 2410 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2419 "" +#line 2411 "" } else { /* Writing concatenation */ -#line 2420 "" +#line 2412 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2420 "" +#line 2412 "" i__3[1] = 2, a__2[1] = "qb"; -#line 2420 "" +#line 2412 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2421 "" +#line 2413 "" } -#line 2422 "" +#line 2414 "" } -#line 2423 "" +#line 2415 "" *lnote += 3; -#line 2424 "" +#line 2416 "" } -#line 2425 "" +#line 2417 "" } else { /* No tremolo */ -#line 2429 "" +#line 2421 "" if (*lnote > 0) { /* Writing concatenation */ -#line 2430 "" +#line 2422 "" i__7[0] = *lnote, a__6[0] = notexq; -#line 2430 "" +#line 2422 "" i__7[1] = 1, a__6[1] = all_1.sq; -#line 2430 "" +#line 2422 "" i__7[2] = 2, a__6[2] = "qb"; -#line 2430 "" +#line 2422 "" s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); -#line 2431 "" +#line 2423 "" } else { /* Writing concatenation */ -#line 2432 "" +#line 2424 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2432 "" +#line 2424 "" i__3[1] = 2, a__2[1] = "qb"; -#line 2432 "" +#line 2424 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2433 "" +#line 2425 "" } -#line 2434 "" +#line 2426 "" *lnote += 3; -#line 2435 "" +#line 2427 "" } -#line 2436 "" +#line 2428 "" isdotm = FALSE_; -#line 2437 "" +#line 2429 "" if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { -#line 2438 "" +#line 2430 "" i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); -#line 2438 "" +#line 2430 "" if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25]) { -#line 2439 "" +#line 2431 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { /* Writing concatenation */ -#line 2440 "" +#line 2432 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2440 "" +#line 2432 "" i__3[1] = 1, a__2[1] = "p"; -#line 2440 "" +#line 2432 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2441 "" +#line 2433 "" } else { /* Writing concatenation */ -#line 2442 "" +#line 2434 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2442 "" +#line 2434 "" i__3[1] = 1, a__2[1] = "m"; -#line 2442 "" +#line 2434 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2443 "" +#line 2435 "" isdotm = TRUE_; -#line 2444 "" +#line 2436 "" } -#line 2445 "" +#line 2437 "" ++(*lnote); -#line 2446 "" +#line 2438 "" } -#line 2447 "" +#line 2439 "" } /* 5/25/08 Allow >12 */ /* 5/9/10 Up to 24; replace 24 with 0 */ -#line 2452 "" +#line 2444 "" if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { -#line 2453 "" +#line 2445 "" i__1 = commvl_1.ivx % 24; -#line 2453 "" +#line 2445 "" istring_(&i__1, tempq, &len, (ftnlen)4); -#line 2454 "" +#line 2446 "" } else { -#line 2455 "" +#line 2447 "" i__1 = combjmp_1.ivbj1 % 24; -#line 2455 "" +#line 2447 "" istring_(&i__1, tempq, &len, (ftnlen)4); -#line 2456 "" +#line 2448 "" } -#line 2457 "" +#line 2449 "" if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) { -#line 2457 "" +#line 2449 "" combjmp_1.isbjmp = FALSE_; -#line 2457 "" +#line 2449 "" } /* Writing concatenation */ -#line 2459 "" +#line 2451 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2459 "" +#line 2451 "" i__3[1] = len, a__2[1] = tempq; -#line 2459 "" +#line 2451 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2460 "" +#line 2452 "" *lnote += len; /* Writing concatenation */ -#line 2461 "" +#line 2453 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2461 "" +#line 2453 "" i__3[1] = lnoten, a__2[1] = noteq; -#line 2461 "" +#line 2453 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2462 "" +#line 2454 "" *lnote += lnoten; -#line 2463 "" +#line 2455 "" if (isdotm) { -#line 2464 "" +#line 2456 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2465 "" +#line 2457 "" i__5[0] = *lnote, a__4[0] = notexq; -#line 2465 "" +#line 2457 "" i__5[1] = 1, a__4[1] = "{"; -#line 2465 "" +#line 2457 "" i__5[2] = 1, a__4[2] = noteq; -#line 2465 "" +#line 2457 "" i__5[3] = 1, a__4[3] = "}"; -#line 2465 "" +#line 2457 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); -#line 2466 "" +#line 2458 "" *lnote += 3; -#line 2467 "" +#line 2459 "" } else { -#line 2468 "" +#line 2460 "" i__1 = lnoten - 2; /* Writing concatenation */ -#line 2468 "" +#line 2460 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2468 "" +#line 2460 "" i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; -#line 2468 "" +#line 2460 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2469 "" +#line 2461 "" ++(*lnote); -#line 2470 "" +#line 2462 "" } -#line 2471 "" +#line 2463 "" } -#line 2472 "" +#line 2464 "" return 0; } /* beamend_ */ @@ -6380,28 +6374,28 @@ L1: extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) ; -#line 2502 "" +#line 2494 "" *lnote = 0; -#line 2503 "" +#line 2495 "" ip = all_1.ipo[all_1.jn - 1]; -#line 2504 "" +#line 2496 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ -#line 2508 "" +#line 2500 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { -#line 2509 "" +#line 2501 "" --nole; -#line 2510 "" +#line 2502 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { -#line 2511 "" +#line 2503 "" ++nole; -#line 2512 "" +#line 2504 "" } -#line 2513 "" +#line 2505 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 2514 "" +#line 2506 "" multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; /* if (btest(islur(ivx,ip-1),3)) multip = multip+1 */ @@ -6411,173 +6405,173 @@ L1: /* embedded xtup with number, due to ordering/octave feature. */ /* call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */ -#line 2523 "" +#line 2515 "" } -#line 2524 "" +#line 2516 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) { -#line 2524 "" +#line 2516 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; -#line 2524 "" +#line 2516 "" } -#line 2525 "" +#line 2517 "" if (comxtup_1.vxtup[commvl_1.ivx - 1]) { /* In an xtup */ -#line 2529 "" +#line 2521 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { /* Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK */ -#line 2533 "" +#line 2525 "" i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8); -#line 2533 "" +#line 2525 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); -#line 2534 "" +#line 2526 "" notex_(notexq, lnote, (ftnlen)79); /* Re-zero so next note does not get confused */ -#line 2538 "" +#line 2530 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0; -#line 2539 "" +#line 2531 "" return 0; -#line 2540 "" +#line 2532 "" } -#line 2541 "" +#line 2533 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ -#line 2545 "" +#line 2537 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { /* Forced stem direction */ -#line 2549 "" +#line 2541 "" ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 2550 "" +#line 2542 "" i__1 = 4 - multip; -#line 2550 "" +#line 2542 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, & i__1); -#line 2551 "" +#line 2543 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { -#line 2553 "" +#line 2545 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[ commvl_1.ivx + ip * 24 - 25] * 3 / 2; -#line 2554 "" +#line 2546 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { -#line 2555 "" +#line 2547 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; -#line 2556 "" +#line 2548 "" } -#line 2557 "" +#line 2549 "" notex_(notexq, lnote, (ftnlen)79); -#line 2558 "" +#line 2550 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; -#line 2559 "" +#line 2551 "" } else { /* Use ulq for stem direction */ -#line 2563 "" +#line 2555 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2563 "" +#line 2555 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2564 "" +#line 2556 "" if (lnoten == 1) { -#line 2564 "" +#line 2556 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 2564 "" +#line 2556 "" } -#line 2565 "" +#line 2557 "" *lnote = 3; -#line 2566 "" +#line 2558 "" if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25], 27)) { /* Prior note of xtup is not regular-dotted */ -#line 2570 "" +#line 2562 "" if (multip == 0) { /* Writing concatenation */ -#line 2571 "" +#line 2563 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2571 "" +#line 2563 "" i__2[1] = 1, a__1[1] = "q"; -#line 2571 "" +#line 2563 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2571 "" +#line 2563 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2572 "" +#line 2564 "" } else if (multip == -1) { /* Writing concatenation */ -#line 2573 "" +#line 2565 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2573 "" +#line 2565 "" i__2[1] = 1, a__1[1] = "h"; -#line 2573 "" +#line 2565 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2573 "" +#line 2565 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2574 "" +#line 2566 "" } else if (multip == 1) { /* Writing concatenation */ -#line 2575 "" +#line 2567 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2575 "" +#line 2567 "" i__2[1] = 1, a__1[1] = "c"; -#line 2575 "" +#line 2567 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2575 "" +#line 2567 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2576 "" +#line 2568 "" } else if (multip == 2) { /* Writing concatenation */ -#line 2577 "" +#line 2569 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2577 "" +#line 2569 "" i__2[1] = 2, a__1[1] = "cc"; -#line 2577 "" +#line 2569 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2577 "" +#line 2569 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2578 "" +#line 2570 "" *lnote = 4; -#line 2579 "" +#line 2571 "" } else if (multip == 3) { /* Writing concatenation */ -#line 2580 "" +#line 2572 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2580 "" +#line 2572 "" i__2[1] = 3, a__1[1] = "ccc"; -#line 2580 "" +#line 2572 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2580 "" +#line 2572 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2581 "" +#line 2573 "" *lnote = 5; -#line 2582 "" +#line 2574 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2583 "" +#line 2575 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2583 "" +#line 2575 "" i__3[1] = 2, a__2[1] = "wh"; -#line 2583 "" +#line 2575 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2584 "" +#line 2576 "" } -#line 2585 "" +#line 2577 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { @@ -6586,198 +6580,198 @@ L1: /* notexq = notexq(1:3)//'p' */ /* lnote = 4 */ /* Writing concatenation */ -#line 2591 "" +#line 2583 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2591 "" +#line 2583 "" i__3[1] = 1, a__2[1] = "p"; -#line 2591 "" +#line 2583 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2592 "" +#line 2584 "" ++(*lnote); -#line 2593 "" +#line 2585 "" } -#line 2594 "" +#line 2586 "" } else { /* Prior note of xtup is regular-dotted so this one is halved */ -#line 2598 "" +#line 2590 "" if (multip == 2) { /* Writing concatenation */ -#line 2599 "" +#line 2591 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2599 "" +#line 2591 "" i__2[1] = 3, a__1[1] = "ccc"; -#line 2599 "" +#line 2591 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2599 "" +#line 2591 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2600 "" +#line 2592 "" *lnote = 5; -#line 2601 "" +#line 2593 "" } else if (multip == 1) { /* Writing concatenation */ -#line 2602 "" +#line 2594 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2602 "" +#line 2594 "" i__2[1] = 2, a__1[1] = "cc"; -#line 2602 "" +#line 2594 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2602 "" +#line 2594 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2603 "" +#line 2595 "" *lnote = 4; -#line 2604 "" +#line 2596 "" } else if (multip == 0) { /* Writing concatenation */ -#line 2605 "" +#line 2597 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2605 "" +#line 2597 "" i__2[1] = 1, a__1[1] = "c"; -#line 2605 "" +#line 2597 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2605 "" +#line 2597 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2606 "" +#line 2598 "" } else if (multip == -1) { /* Writing concatenation */ -#line 2607 "" +#line 2599 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2607 "" +#line 2599 "" i__2[1] = 1, a__1[1] = "q"; -#line 2607 "" +#line 2599 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2607 "" +#line 2599 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2608 "" +#line 2600 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2609 "" +#line 2601 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2609 "" +#line 2601 "" i__2[1] = 1, a__1[1] = "h"; -#line 2609 "" +#line 2601 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2609 "" +#line 2601 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2610 "" +#line 2602 "" } -#line 2611 "" +#line 2603 "" } /* Writing concatenation */ -#line 2612 "" +#line 2604 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2612 "" +#line 2604 "" i__3[1] = 8, a__2[1] = noteq; -#line 2612 "" +#line 2604 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2613 "" +#line 2605 "" *lnote += lnoten; -#line 2614 "" +#line 2606 "" } -#line 2615 "" +#line 2607 "" return 0; -#line 2616 "" +#line 2608 "" } else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* In the beamed xtup but not the last note */ -#line 2620 "" +#line 2612 "" if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) { /* Embedded Xtup, mult>0, starts here. Put in number if needed */ -#line 2624 "" +#line 2616 "" ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; -#line 2625 "" +#line 2617 "" iud = 1; -#line 2626 "" +#line 2618 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2626 "" +#line 2618 "" iud = -1; -#line 2626 "" +#line 2618 "" } /* Get ip#, notelevel of middle note (or gap) in xtup */ -#line 2630 "" +#line 2622 "" ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] / 2; -#line 2631 "" +#line 2623 "" i__1 = ncmid_(&all_1.iv, &ipmid); -#line 2631 "" +#line 2623 "" i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; -#line 2631 "" +#line 2623 "" xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], &all_1.irest[commvl_1.ivx + ipmid * 24 - 25], & iud, &i__1, &i__4); -#line 2633 "" +#line 2625 "" if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { -#line 2633 "" +#line 2625 "" i__4 = ipmid - 1; -#line 2633 "" +#line 2625 "" i__1 = ncmid_(&all_1.iv, &i__4); -#line 2633 "" +#line 2625 "" i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - 8; -#line 2633 "" +#line 2625 "" xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + ( ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24 - 25], &iud, &i__1, &i__5)) / 2; -#line 2633 "" +#line 2625 "" } -#line 2636 "" +#line 2628 "" iflop = 0; -#line 2637 "" +#line 2629 "" if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) < 3.f) { -#line 2637 "" +#line 2629 "" iflop = -iud; -#line 2637 "" +#line 2629 "" } -#line 2638 "" +#line 2630 "" iup = iud + (iflop << 1); -#line 2639 "" +#line 2631 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) { -#line 2640 "" +#line 2632 "" iup = -iup; -#line 2641 "" +#line 2633 "" iflop = 0; -#line 2642 "" +#line 2634 "" if (iud * iup < 0) { -#line 2642 "" +#line 2634 "" iflop = iup; -#line 2642 "" +#line 2634 "" } -#line 2643 "" +#line 2635 "" } /* Place number if needed */ -#line 2647 "" +#line 2639 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) { -#line 2648 "" +#line 2640 "" mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__5, &c__22); -#line 2649 "" +#line 2641 "" if (mprint == 0) { -#line 2649 "" +#line 2641 "" mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25] ; -#line 2649 "" +#line 2641 "" } -#line 2650 "" +#line 2642 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2650 "" +#line 2642 "" putxtn_(&mprint, &iflop, &multip, &iud, &comask_1.wheadpt, &comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], &comxtup_1.islope[commvl_1.ivx - 1], & @@ -6788,47 +6782,47 @@ L1: commvl_1.ivx + ip * 24 - 25], &all_1.mult[ commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen) 79); -#line 2655 "" +#line 2647 "" } -#line 2656 "" +#line 2648 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2656 "" +#line 2648 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2657 "" +#line 2649 "" } else { /* Intermediate note of xtup */ -#line 2661 "" +#line 2653 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2661 "" +#line 2653 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2662 "" +#line 2654 "" } -#line 2663 "" +#line 2655 "" } else { /* Last note of xtup (but not last note of beam!) */ -#line 2667 "" +#line 2659 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2667 "" +#line 2659 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2668 "" +#line 2660 "" } -#line 2669 "" +#line 2661 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 2670 "" +#line 2662 "" notex_(notexq, lnote, (ftnlen)79); -#line 2671 "" +#line 2663 "" return 0; -#line 2672 "" +#line 2664 "" } else { -#line 2673 "" +#line 2665 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 2673 "" +#line 2665 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2674 "" +#line 2666 "" } /* Check for string of rests up to and including last note in xtup. */ @@ -6838,7 +6832,7 @@ L1: /* break some unaccounted non-chordal staff-jum xtup situations. */ /* if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. */ /* * .not.btest(irest(ivx,ip),0)) then */ -#line 2683 "" +#line 2675 "" if (comxtup_1.vxtup[commvl_1.ivx - 1] && bit_test(all_1.irest[ commvl_1.ivx + (ip + 1) * 24 - 25],0) && ! bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! (combjmp_1.isbjmp && @@ -6847,379 +6841,379 @@ L1: /* This note is not a rest but next is a rest. Do rests continue to */ /* end of xtup, where nodur>0 */ -#line 2690 "" +#line 2682 "" i__1 = ip + 24; -#line 2690 "" +#line 2682 "" for (ipnow = ip + 1; ipnow <= i__1; ++ipnow) { -#line 2691 "" +#line 2683 "" if (all_1.nodur[commvl_1.ivx + ipnow * 24 - 25] > 0) { -#line 2691 "" +#line 2683 "" goto L4; -#line 2691 "" +#line 2683 "" } /* This is last of xtup */ -#line 2692 "" +#line 2684 "" if (! bit_test(all_1.irest[commvl_1.ivx + (ipnow + 1) * 24 - 25], 0)) { -#line 2692 "" +#line 2684 "" goto L5; -#line 2692 "" +#line 2684 "" } /* If I don't go to 5, know next note IS a rest! */ /* Next is not */ -#line 2696 "" +#line 2688 "" /* L3: */ -#line 2696 "" +#line 2688 "" } -#line 2697 "" +#line 2689 "" L4: -#line 2698 "" +#line 2690 "" ntrbbb_(&c__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, ( ftnlen)1, (ftnlen)1, (ftnlen)79); /* Writing concatenation */ -#line 2699 "" +#line 2691 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 2699 "" +#line 2691 "" i__2[1] = 1, a__1[1] = all_1.sq; -#line 2699 "" +#line 2691 "" i__2[2] = 2, a__1[2] = "qb"; -#line 2699 "" +#line 2691 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2700 "" +#line 2692 "" *lnote += 3; -#line 2701 "" +#line 2693 "" istring_(&commvl_1.ivx, tempq, &len, (ftnlen)4); /* Writing concatenation */ -#line 2702 "" +#line 2694 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2702 "" +#line 2694 "" i__3[1] = len, a__2[1] = tempq; -#line 2702 "" +#line 2694 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2703 "" +#line 2695 "" *lnote += len; /* Writing concatenation */ -#line 2704 "" +#line 2696 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2704 "" +#line 2696 "" i__3[1] = lnoten, a__2[1] = noteq; -#line 2704 "" +#line 2696 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2705 "" +#line 2697 "" *lnote += lnoten; -#line 2706 "" +#line 2698 "" return 0; -#line 2707 "" +#line 2699 "" L5: /* Check if multiplicity changes in a way requiring action, */ /* unless (160211) it's blank rest on start of 2nd seg of joined beam */ -#line 2712 "" +#line 2704 "" ; -#line 2712 "" +#line 2704 "" } else if (! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],24) || ! bit_test(all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25],29)) { -#line 2714 "" +#line 2706 "" ipleft = ip - 1; -#line 2715 "" +#line 2707 "" if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) { -#line 2715 "" +#line 2707 "" --ipleft; -#line 2715 "" +#line 2707 "" } -#line 2716 "" +#line 2708 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) { -#line 2717 "" +#line 2709 "" multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8; -#line 2718 "" +#line 2710 "" } else { -#line 2719 "" +#line 2711 "" multl = 1; -#line 2720 "" +#line 2712 "" } -#line 2721 "" +#line 2713 "" mub = multip - multl; -#line 2722 "" +#line 2714 "" ipright = ip + 1; -#line 2723 "" +#line 2715 "" if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) { -#line 2723 "" +#line 2715 "" ++ipright; -#line 2723 "" +#line 2715 "" } -#line 2724 "" +#line 2716 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) { -#line 2725 "" +#line 2717 "" multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8; -#line 2726 "" +#line 2718 "" } else { -#line 2727 "" +#line 2719 "" multr = 1; -#line 2728 "" +#line 2720 "" } -#line 2729 "" +#line 2721 "" mua = multr - multip; -#line 2730 "" +#line 2722 "" if (mub > 0 || mua < 0) { /* Multiplicity has increased from left or will decrease to right. Need action. */ -#line 2734 "" +#line 2726 "" if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) { -#line 2735 "" +#line 2727 "" ivb = combjmp_1.ivbj1; -#line 2736 "" +#line 2728 "" i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; -#line 2736 "" +#line 2728 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 2736 "" +#line 2728 "" *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; -#line 2737 "" +#line 2729 "" } else { -#line 2738 "" +#line 2730 "" ivb = commvl_1.ivx; -#line 2739 "" +#line 2731 "" *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; -#line 2740 "" +#line 2732 "" } -#line 2741 "" +#line 2733 "" if (mua >= 0) { -#line 2742 "" +#line 2734 "" ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); /* Test for next note being blank rest, assuming staff-crossing */ /* xtup chord */ -#line 2747 "" +#line 2739 "" } else if (multl >= multr && ! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 - 25],29)) { -#line 2749 "" +#line 2741 "" i__1 = multr + 1; -#line 2749 "" +#line 2741 "" for (im = multip; im >= i__1; --im) { -#line 2750 "" +#line 2742 "" ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); -#line 2751 "" +#line 2743 "" /* L1: */ -#line 2751 "" +#line 2743 "" } /* else */ /* Test for next note being blank rest, assuming staff-crossing */ /* xtup chord */ -#line 2756 "" +#line 2748 "" } else if (! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 - 25],29)) { -#line 2757 "" +#line 2749 "" i__1 = multip; -#line 2757 "" +#line 2749 "" for (im = multr + 1; im <= i__1; ++im) { -#line 2758 "" +#line 2750 "" ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); -#line 2759 "" +#line 2751 "" /* L2: */ -#line 2759 "" +#line 2751 "" } -#line 2760 "" +#line 2752 "" ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); -#line 2761 "" +#line 2753 "" } -#line 2762 "" +#line 2754 "" } else if (ip > 1) { /* Check for 2nd member of dotted xtup */ -#line 2766 "" +#line 2758 "" if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { -#line 2766 "" +#line 2758 "" i__1 = multip + 1; -#line 2766 "" +#line 2758 "" ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); -#line 2766 "" +#line 2758 "" } -#line 2768 "" +#line 2760 "" } -#line 2769 "" +#line 2761 "" } /* Now put in the note */ -#line 2773 "" +#line 2765 "" if (*lnote > 0) { /* Writing concatenation */ -#line 2774 "" +#line 2766 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 2774 "" +#line 2766 "" i__2[1] = 1, a__1[1] = all_1.sq; -#line 2774 "" +#line 2766 "" i__2[2] = 2, a__1[2] = "qb"; -#line 2774 "" +#line 2766 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2775 "" +#line 2767 "" } else { /* Writing concatenation */ -#line 2776 "" +#line 2768 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2776 "" +#line 2768 "" i__3[1] = 2, a__2[1] = "qb"; -#line 2776 "" +#line 2768 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2777 "" +#line 2769 "" } -#line 2778 "" +#line 2770 "" *lnote += 3; -#line 2779 "" +#line 2771 "" isdotm = FALSE_; -#line 2780 "" +#line 2772 "" if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { /* rule out ')' */ -#line 2784 "" +#line 2776 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { -#line 2785 "" +#line 2777 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { /* Writing concatenation */ -#line 2786 "" +#line 2778 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2786 "" +#line 2778 "" i__3[1] = 1, a__2[1] = "p"; -#line 2786 "" +#line 2778 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2787 "" +#line 2779 "" } else { /* Double dot */ /* Writing concatenation */ -#line 2791 "" +#line 2783 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2791 "" +#line 2783 "" i__3[1] = 2, a__2[1] = "pp"; -#line 2791 "" +#line 2783 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2792 "" +#line 2784 "" ++(*lnote); -#line 2793 "" +#line 2785 "" } -#line 2794 "" +#line 2786 "" } else { /* Writing concatenation */ -#line 2795 "" +#line 2787 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2795 "" +#line 2787 "" i__3[1] = 1, a__2[1] = "m"; -#line 2795 "" +#line 2787 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2796 "" +#line 2788 "" isdotm = TRUE_; -#line 2797 "" +#line 2789 "" } -#line 2798 "" +#line 2790 "" ++(*lnote); -#line 2799 "" +#line 2791 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { /* Special dotted notation for 2:1 xtup, or normal dot in xtup */ /* Writing concatenation */ -#line 2804 "" +#line 2796 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2804 "" +#line 2796 "" i__3[1] = 1, a__2[1] = "p"; -#line 2804 "" +#line 2796 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2805 "" +#line 2797 "" ++(*lnote); -#line 2806 "" +#line 2798 "" } /* 5/25/08 Allow >12 */ -#line 2810 "" +#line 2802 "" if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { /* call istring(mod(ivx,12),tempq,len) */ -#line 2812 "" +#line 2804 "" i__1 = commvl_1.ivx % 24; -#line 2812 "" +#line 2804 "" istring_(&i__1, tempq, &len, (ftnlen)4); -#line 2813 "" +#line 2805 "" } else { /* call istring(mod(ivbj1,12),tempq,len) */ -#line 2815 "" +#line 2807 "" i__1 = combjmp_1.ivbj1 % 24; -#line 2815 "" +#line 2807 "" istring_(&i__1, tempq, &len, (ftnlen)4); -#line 2816 "" +#line 2808 "" } /* Writing concatenation */ -#line 2817 "" +#line 2809 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2817 "" +#line 2809 "" i__3[1] = len, a__2[1] = tempq; -#line 2817 "" +#line 2809 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2818 "" +#line 2810 "" *lnote += len; /* Writing concatenation */ -#line 2819 "" +#line 2811 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2819 "" +#line 2811 "" i__3[1] = lnoten, a__2[1] = noteq; -#line 2819 "" +#line 2811 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2820 "" +#line 2812 "" *lnote += lnoten; -#line 2821 "" +#line 2813 "" if (isdotm) { -#line 2822 "" +#line 2814 "" if (lnoten == 2) { /* Writing concatenation */ -#line 2823 "" +#line 2815 "" i__6[0] = *lnote, a__3[0] = notexq; -#line 2823 "" +#line 2815 "" i__6[1] = 1, a__3[1] = "{"; -#line 2823 "" +#line 2815 "" i__6[2] = 1, a__3[2] = noteq + 1; -#line 2823 "" +#line 2815 "" i__6[3] = 1, a__3[3] = "}"; -#line 2823 "" +#line 2815 "" s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79); -#line 2824 "" +#line 2816 "" *lnote += 3; -#line 2825 "" +#line 2817 "" } else { -#line 2826 "" +#line 2818 "" i__1 = lnoten - 2; /* Writing concatenation */ -#line 2826 "" +#line 2818 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2826 "" +#line 2818 "" i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; -#line 2826 "" +#line 2818 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2827 "" +#line 2819 "" ++(*lnote); -#line 2828 "" +#line 2820 "" } -#line 2829 "" +#line 2821 "" } -#line 2830 "" +#line 2822 "" return 0; } /* beamid_ */ @@ -7268,91 +7262,91 @@ L5: static cilist io___202 = { 0, 6, 0, 0, 0 }; -#line 2857 "" +#line 2849 "" gotnote = FALSE_; -#line 2858 "" +#line 2850 "" lnoten = 0; -#line 2859 "" +#line 2851 "" ip1 = all_1.ipo[all_1.jn - 1]; -#line 2860 "" +#line 2852 "" multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8; -#line 2861 "" +#line 2853 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[ commvl_1.ivx + ip1 * 24 - 25],0)) { -#line 2862 "" +#line 2854 "" *lnote = 0; /* The rest was already written in beamstrt, so just get out of here */ -#line 2866 "" +#line 2858 "" return 0; -#line 2867 "" +#line 2859 "" } -#line 2868 "" +#line 2860 "" nole = all_1.nolev[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ -#line 2872 "" +#line 2864 "" if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25], 30)) { -#line 2873 "" +#line 2865 "" --nole; -#line 2874 "" +#line 2866 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25],31)) { -#line 2875 "" +#line 2867 "" ++nole; -#line 2876 "" +#line 2868 "" } -#line 2877 "" +#line 2869 "" if (comxtup_1.vxtup[commvl_1.ivx - 1] && ! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ -#line 2881 "" +#line 2873 "" if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) { /* Forced stem direction */ -#line 2885 "" +#line 2877 "" ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25]; -#line 2886 "" +#line 2878 "" i__1 = 4 - multip; -#line 2886 "" +#line 2878 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1); -#line 2887 "" +#line 2879 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { -#line 2887 "" +#line 2879 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[ commvl_1.ivx + ip1 * 24 - 25] * 3 / 2; -#line 2887 "" +#line 2879 "" } -#line 2889 "" +#line 2881 "" notex_(notexq, lnote, (ftnlen)79); -#line 2890 "" +#line 2882 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav; -#line 2891 "" +#line 2883 "" } else { -#line 2892 "" +#line 2884 "" i__1 = ncmid_(&all_1.iv, &ip1); -#line 2892 "" +#line 2884 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2893 "" +#line 2885 "" gotnote = TRUE_; -#line 2894 "" +#line 2886 "" if (lnoten == 1) { -#line 2894 "" +#line 2886 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 2894 "" +#line 2886 "" } -#line 2895 "" +#line 2887 "" *lnote = 3; -#line 2896 "" +#line 2888 "" if (multip <= 0) { -#line 2897 "" +#line 2889 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32 || multip == -1) { @@ -7360,42 +7354,42 @@ L5: /* 1st note of unbeamed half-note trem; make open */ /* Writing concatenation */ -#line 2903 "" +#line 2895 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2903 "" +#line 2895 "" i__2[1] = 1, a__1[1] = "h"; -#line 2903 "" +#line 2895 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2903 "" +#line 2895 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2904 "" +#line 2896 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2905 "" +#line 2897 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2905 "" +#line 2897 "" i__3[1] = 2, a__2[1] = "wh"; -#line 2905 "" +#line 2897 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2906 "" +#line 2898 "" } else { /* Writing concatenation */ -#line 2907 "" +#line 2899 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2907 "" +#line 2899 "" i__2[1] = 1, a__1[1] = "q"; -#line 2907 "" +#line 2899 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2907 "" +#line 2899 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2908 "" +#line 2900 "" } /* Check for dot */ -#line 2912 "" +#line 2904 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && ( r__1 = all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12.f - all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - @@ -7403,85 +7397,85 @@ L5: /* Need a dot. already called addblank for noteq */ -#line 2917 "" +#line 2909 "" if (*lnote == 0) { /* Writing concatenation */ -#line 2918 "" +#line 2910 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2918 "" +#line 2910 "" i__2[1] = 2, a__1[1] = "pt"; -#line 2918 "" +#line 2910 "" i__2[2] = lnoten, a__1[2] = noteq; -#line 2918 "" +#line 2910 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2919 "" +#line 2911 "" *lnote = lnoten + 3; -#line 2920 "" +#line 2912 "" } else { /* Writing concatenation */ -#line 2921 "" +#line 2913 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 2921 "" +#line 2913 "" i__3[1] = 1, a__2[1] = "p"; -#line 2921 "" +#line 2913 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2922 "" +#line 2914 "" ++(*lnote); -#line 2923 "" +#line 2915 "" } -#line 2924 "" +#line 2916 "" } /* Insert the stemlength calcs here for dotted, unbeamed. */ /* Later may combine with below to avoid repeat. */ -#line 2929 "" +#line 2921 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) { -#line 2930 "" +#line 2922 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 - 25], &c__2, &c__5); -#line 2931 "" +#line 2923 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2932 "" +#line 2924 "" slen = (nindent + 4.5f + comxtup_1.nolev1[ commvl_1.ivx - 1] - nole - comxtup_1.islope[ commvl_1.ivx - 1] * .4f / all_1.slfac) * .6667f; -#line 2934 "" +#line 2926 "" } else { -#line 2935 "" +#line 2927 "" slen = (nindent + 4.5f - comxtup_1.nolev1[ commvl_1.ivx - 1] + nole + comxtup_1.islope[ commvl_1.ivx - 1] * .4f / all_1.slfac) * .6667f; -#line 2937 "" +#line 2929 "" } -#line 2938 "" +#line 2930 "" s_wsfi(&io___199); -#line 2938 "" +#line 2930 "" do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); -#line 2938 "" +#line 2930 "" e_wsfi(); /* Writing concatenation */ -#line 2939 "" +#line 2931 "" i__4[0] = 1, a__3[0] = all_1.sq; -#line 2939 "" +#line 2931 "" i__4[1] = 4, a__3[1] = "slx{"; -#line 2939 "" +#line 2931 "" i__4[2] = 4, a__3[2] = tempq; -#line 2939 "" +#line 2931 "" i__4[3] = 1, a__3[3] = "}"; -#line 2939 "" +#line 2931 "" i__4[4] = *lnote, a__3[4] = notexq; -#line 2939 "" +#line 2931 "" s_cat(notexq, a__3, i__4, &c__5, (ftnlen)79); -#line 2941 "" +#line 2933 "" *lnote += 10; -#line 2942 "" +#line 2934 "" } -#line 2943 "" +#line 2935 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) { @@ -7490,389 +7484,389 @@ L5: /* Stem length calcs here. The .2 factor is empirical, but */ /* slfac accounts for musicsize. */ -#line 2950 "" +#line 2942 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 - 25] , &c__2, &c__5); -#line 2951 "" +#line 2943 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 2952 "" +#line 2944 "" slen = (nindent + 4.5f + comxtup_1.nolev1[commvl_1.ivx - 1] - nole - comxtup_1.islope[commvl_1.ivx - 1] * .4f / all_1.slfac) * .6667f; -#line 2954 "" +#line 2946 "" } else { -#line 2955 "" +#line 2947 "" slen = (nindent + 4.5f - comxtup_1.nolev1[commvl_1.ivx - 1] + nole + comxtup_1.islope[commvl_1.ivx - 1] * .4f / all_1.slfac) * .6667f; -#line 2957 "" +#line 2949 "" } -#line 2958 "" +#line 2950 "" s_wsfi(&io___200); -#line 2958 "" +#line 2950 "" do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); -#line 2958 "" +#line 2950 "" e_wsfi(); /* Writing concatenation */ -#line 2959 "" +#line 2951 "" i__5[0] = 1, a__4[0] = all_1.sq; -#line 2959 "" +#line 2951 "" i__5[1] = 4, a__4[1] = "slx{"; -#line 2959 "" +#line 2951 "" i__5[2] = 4, a__4[2] = tempq; -#line 2959 "" +#line 2951 "" i__5[3] = 1, a__4[3] = "}"; -#line 2959 "" +#line 2951 "" i__5[4] = 1, a__4[4] = all_1.sq; -#line 2959 "" +#line 2951 "" i__5[5] = 1, a__4[5] = "q"; -#line 2959 "" +#line 2951 "" i__5[6] = 1, a__4[6] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2959 "" +#line 2951 "" s_cat(notexq, a__4, i__5, &c__7, (ftnlen)79); -#line 2961 "" +#line 2953 "" *lnote = 13; /* Check for dotted 2-note trem; prepend dot to notexq if needed */ -#line 2965 "" +#line 2957 "" if (all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 || all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24) { -#line 2967 "" +#line 2959 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2968 "" +#line 2960 "" i__3[0] = 1, a__2[0] = " "; -#line 2968 "" +#line 2960 "" i__3[1] = 1, a__2[1] = noteq; -#line 2968 "" +#line 2960 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 2969 "" +#line 2961 "" lnoten = 2; -#line 2970 "" +#line 2962 "" } /* Writing concatenation */ -#line 2971 "" +#line 2963 "" i__6[0] = 1, a__5[0] = all_1.sq; -#line 2971 "" +#line 2963 "" i__6[1] = 2, a__5[1] = "pt"; -#line 2971 "" +#line 2963 "" i__6[2] = lnoten, a__5[2] = noteq; -#line 2971 "" +#line 2963 "" i__6[3] = *lnote, a__5[3] = notexq; -#line 2971 "" +#line 2963 "" s_cat(notexq, a__5, i__6, &c__4, (ftnlen)79); -#line 2972 "" +#line 2964 "" *lnote = *lnote + 3 + lnoten; -#line 2973 "" +#line 2965 "" i__1 = ncmid_(&all_1.iv, &ip1); -#line 2973 "" +#line 2965 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 2974 "" +#line 2966 "" gotnote = TRUE_; -#line 2975 "" +#line 2967 "" if (lnoten == 1) { /* Writing concatenation */ -#line 2976 "" +#line 2968 "" i__3[0] = 1, a__2[0] = " "; -#line 2976 "" +#line 2968 "" i__3[1] = 1, a__2[1] = noteq; -#line 2976 "" +#line 2968 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 2977 "" +#line 2969 "" lnoten = 2; -#line 2978 "" +#line 2970 "" } -#line 2979 "" +#line 2971 "" } -#line 2980 "" +#line 2972 "" } else if (multip == -1) { /* Writing concatenation */ -#line 2981 "" +#line 2973 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2981 "" +#line 2973 "" i__2[1] = 1, a__1[1] = "h"; -#line 2981 "" +#line 2973 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2981 "" +#line 2973 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2982 "" +#line 2974 "" } else if (multip == 1) { /* Writing concatenation */ -#line 2983 "" +#line 2975 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2983 "" +#line 2975 "" i__2[1] = 1, a__1[1] = "c"; -#line 2983 "" +#line 2975 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2983 "" +#line 2975 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2984 "" +#line 2976 "" } else if (multip == 2) { /* Writing concatenation */ -#line 2985 "" +#line 2977 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2985 "" +#line 2977 "" i__2[1] = 2, a__1[1] = "cc"; -#line 2985 "" +#line 2977 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2985 "" +#line 2977 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2986 "" +#line 2978 "" *lnote = 4; -#line 2987 "" +#line 2979 "" } else if (multip == 3) { /* Writing concatenation */ -#line 2988 "" +#line 2980 "" i__2[0] = 1, a__1[0] = all_1.sq; -#line 2988 "" +#line 2980 "" i__2[1] = 3, a__1[1] = "ccc"; -#line 2988 "" +#line 2980 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); -#line 2988 "" +#line 2980 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 2989 "" +#line 2981 "" *lnote = 5; -#line 2990 "" +#line 2982 "" } else if (multip == -2) { /* Writing concatenation */ -#line 2991 "" +#line 2983 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2991 "" +#line 2983 "" i__3[1] = 2, a__2[1] = "wh"; -#line 2991 "" +#line 2983 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2992 "" +#line 2984 "" } else if (multip == -3) { /* Writing concatenation */ -#line 2993 "" +#line 2985 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 2993 "" +#line 2985 "" i__3[1] = 5, a__2[1] = "breve"; -#line 2993 "" +#line 2985 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 2994 "" +#line 2986 "" *lnote = 6; -#line 2995 "" +#line 2987 "" } else { -#line 2996 "" +#line 2988 "" s_wsle(&io___201); -#line 2996 "" +#line 2988 "" e_wsle(); -#line 2997 "" +#line 2989 "" s_wsle(&io___202); -#line 2997 "" +#line 2989 "" do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"\ "on)", (ftnlen)41); -#line 2997 "" +#line 2989 "" e_wsle(); -#line 2998 "" +#line 2990 "" stop1_(); -#line 2999 "" +#line 2991 "" } -#line 3000 "" +#line 2992 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { /* notexq = notexq(1:3)//'p' */ /* lnote = 4 */ /* Writing concatenation */ -#line 3003 "" +#line 2995 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3003 "" +#line 2995 "" i__3[1] = 1, a__2[1] = "p"; -#line 3003 "" +#line 2995 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3004 "" +#line 2996 "" ++(*lnote); -#line 3005 "" +#line 2997 "" } /* Writing concatenation */ -#line 3006 "" +#line 2998 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3006 "" +#line 2998 "" i__3[1] = 8, a__2[1] = noteq; -#line 3006 "" +#line 2998 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3007 "" +#line 2999 "" *lnote += lnoten; -#line 3008 "" +#line 3000 "" } -#line 3009 "" +#line 3001 "" return 0; -#line 3010 "" +#line 3002 "" } /* Check if mult. decreases from 1st note to 2nd */ -#line 3014 "" +#line 3006 "" if (all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] > ip1 || bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) { /* More than one note or single-note before a multiplicity-down-up "][" */ -#line 3019 "" +#line 3011 "" if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) { -#line 3020 "" +#line 3012 "" multr = 1; -#line 3021 "" +#line 3013 "" } else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25], 0)) { -#line 3022 "" +#line 3014 "" multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8; -#line 3023 "" +#line 3015 "" } else { -#line 3024 "" +#line 3016 "" multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8; -#line 3025 "" +#line 3017 "" } -#line 3026 "" +#line 3018 "" *lnote = 0; /* Check if staff-jumper */ -#line 3030 "" +#line 3022 "" if (combjmp_1.isbjmp && combjmp_1.ivbj2 > 0) { -#line 3031 "" +#line 3023 "" ivxp = combjmp_1.ivbj1; -#line 3032 "" +#line 3024 "" } else { -#line 3033 "" +#line 3025 "" ivxp = commvl_1.ivx; -#line 3034 "" +#line 3026 "" } -#line 3035 "" +#line 3027 "" if (multr < multip) { -#line 3036 "" +#line 3028 "" i__1 = multr + 1; -#line 3036 "" +#line 3028 "" for (im = multip; im >= i__1; --im) { /* Right-shifted 'termination' */ -#line 3040 "" +#line 3032 "" if (combjmp_1.isbjmp && combjmp_1.ivbj2 > 0) { /* Jump beam */ -#line 3044 "" +#line 3036 "" ntrbbb_(&im, "t", all_1.ulq + (ivxp + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &ivxp, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); -#line 3046 "" +#line 3038 "" } else { /* Same staff */ -#line 3050 "" +#line 3042 "" ntrbbb_(&im, "r", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25), &ivxp, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); -#line 3051 "" +#line 3043 "" } -#line 3052 "" +#line 3044 "" /* L1: */ -#line 3052 "" +#line 3044 "" } -#line 3053 "" +#line 3045 "" } -#line 3054 "" +#line 3046 "" } /* Check for beamed, dotted 2-note tremolo */ -#line 3058 "" +#line 3050 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (r__1 = all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12.f - all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12, dabs(r__1)) < .001f) { -#line 3060 "" +#line 3052 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 3060 "" +#line 3052 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 3061 "" +#line 3053 "" gotnote = TRUE_; -#line 3062 "" +#line 3054 "" if (lnoten == 1) { /* Writing concatenation */ -#line 3063 "" +#line 3055 "" i__3[0] = 1, a__2[0] = " "; -#line 3063 "" +#line 3055 "" i__3[1] = 1, a__2[1] = noteq; -#line 3063 "" +#line 3055 "" s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); -#line 3064 "" +#line 3056 "" lnoten = 2; -#line 3065 "" +#line 3057 "" } -#line 3066 "" +#line 3058 "" } /* Put in the note, but check first for open-head beamed tremolo. */ -#line 3070 "" +#line 3062 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && all_1.nodur[ commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32) { /* 2-note open head tremolo */ -#line 3074 "" +#line 3066 "" if (*lnote > 0) { /* Writing concatenation */ -#line 3075 "" +#line 3067 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 3075 "" +#line 3067 "" i__2[1] = 1, a__1[1] = all_1.sq; -#line 3075 "" +#line 3067 "" i__2[2] = 2, a__1[2] = "hb"; -#line 3075 "" +#line 3067 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 3076 "" +#line 3068 "" } else { /* Writing concatenation */ -#line 3077 "" +#line 3069 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 3077 "" +#line 3069 "" i__3[1] = 2, a__2[1] = "hb"; -#line 3077 "" +#line 3069 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3078 "" +#line 3070 "" } -#line 3079 "" +#line 3071 "" } else { -#line 3080 "" +#line 3072 "" if (*lnote > 0) { /* Writing concatenation */ -#line 3081 "" +#line 3073 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 3081 "" +#line 3073 "" i__2[1] = 1, a__1[1] = all_1.sq; -#line 3081 "" +#line 3073 "" i__2[2] = 2, a__1[2] = "qb"; -#line 3081 "" +#line 3073 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); -#line 3082 "" +#line 3074 "" } else { /* Writing concatenation */ -#line 3083 "" +#line 3075 "" i__3[0] = 1, a__2[0] = all_1.sq; -#line 3083 "" +#line 3075 "" i__3[1] = 2, a__2[1] = "qb"; -#line 3083 "" +#line 3075 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3084 "" +#line 3076 "" } -#line 3085 "" +#line 3077 "" } -#line 3086 "" +#line 3078 "" *lnote += 3; -#line 3087 "" +#line 3079 "" if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (all_1.nodur[ commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24 || all_1.nodur[ commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 || all_1.nodur[ @@ -7881,177 +7875,177 @@ L5: /* 2-note trem on dotted note */ /* Writing concatenation */ -#line 3093 "" +#line 3085 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3093 "" +#line 3085 "" i__3[1] = 1, a__2[1] = "p"; -#line 3093 "" +#line 3085 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3094 "" +#line 3086 "" ++(*lnote); -#line 3095 "" +#line 3087 "" } /* Check for dot */ -#line 3099 "" +#line 3091 "" isdotm = FALSE_; -#line 3100 "" +#line 3092 "" if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { -#line 3101 "" +#line 3093 "" nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25]; -#line 3102 "" +#line 3094 "" if (nd != 0) { -#line 3103 "" +#line 3095 "" i__1 = log2_(&nd); -#line 3103 "" +#line 3095 "" if (pow_ii(&c__2, &i__1) != nd) { -#line 3104 "" +#line 3096 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) { -#line 3105 "" +#line 3097 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25], 3)) { /* Writing concatenation */ -#line 3106 "" +#line 3098 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3106 "" +#line 3098 "" i__3[1] = 1, a__2[1] = "p"; -#line 3106 "" +#line 3098 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3107 "" +#line 3099 "" } else { /* Double dot */ /* Writing concatenation */ -#line 3111 "" +#line 3103 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3111 "" +#line 3103 "" i__3[1] = 2, a__2[1] = "pp"; -#line 3111 "" +#line 3103 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3112 "" +#line 3104 "" ++(*lnote); -#line 3113 "" +#line 3105 "" } -#line 3114 "" +#line 3106 "" } else { /* Writing concatenation */ -#line 3115 "" +#line 3107 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3115 "" +#line 3107 "" i__3[1] = 1, a__2[1] = "m"; -#line 3115 "" +#line 3107 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3116 "" +#line 3108 "" isdotm = TRUE_; -#line 3117 "" +#line 3109 "" } -#line 3118 "" +#line 3110 "" ++(*lnote); -#line 3119 "" +#line 3111 "" } -#line 3120 "" +#line 3112 "" } -#line 3121 "" +#line 3113 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { /* In an xtup with special 2:1 notation with a dot on 1st note, or normal dot */ /* Writing concatenation */ -#line 3126 "" +#line 3118 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3126 "" +#line 3118 "" i__3[1] = 1, a__2[1] = "p"; -#line 3126 "" +#line 3118 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3127 "" +#line 3119 "" ++(*lnote); -#line 3128 "" +#line 3120 "" } /* Do the number; 0 if 12 */ /* 5/25/08 allow >12 */ -#line 3133 "" +#line 3125 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) { -#line 3134 "" +#line 3126 "" i__1 = commvl_1.ivx % 24; -#line 3134 "" +#line 3126 "" istring_(&i__1, numq, &len, (ftnlen)8); -#line 3135 "" +#line 3127 "" } else { /* 1st note of staff-jumping beam */ -#line 3139 "" +#line 3131 "" i__1 = combjmp_1.ivbj1 % 24; -#line 3139 "" +#line 3131 "" istring_(&i__1, numq, &len, (ftnlen)8); -#line 3140 "" +#line 3132 "" } /* Writing concatenation */ -#line 3141 "" +#line 3133 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3141 "" +#line 3133 "" i__3[1] = len, a__2[1] = numq; -#line 3141 "" +#line 3133 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3142 "" +#line 3134 "" *lnote += len; -#line 3143 "" +#line 3135 "" if (! gotnote) { -#line 3144 "" +#line 3136 "" i__1 = ncmid_(&all_1.iv, &ip1); -#line 3144 "" +#line 3136 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 3145 "" +#line 3137 "" } /* Writing concatenation */ -#line 3146 "" +#line 3138 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3146 "" +#line 3138 "" i__3[1] = lnoten, a__2[1] = noteq; -#line 3146 "" +#line 3138 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3147 "" +#line 3139 "" *lnote += lnoten; -#line 3148 "" +#line 3140 "" if (isdotm) { -#line 3149 "" +#line 3141 "" if (lnoten == 1) { /* Writing concatenation */ -#line 3150 "" +#line 3142 "" i__6[0] = *lnote, a__5[0] = notexq; -#line 3150 "" +#line 3142 "" i__6[1] = 1, a__5[1] = "{"; -#line 3150 "" +#line 3142 "" i__6[2] = 1, a__5[2] = noteq; -#line 3150 "" +#line 3142 "" i__6[3] = 1, a__5[3] = "}"; -#line 3150 "" +#line 3142 "" s_cat(notexq, a__5, i__6, &c__4, (ftnlen)79); -#line 3151 "" +#line 3143 "" *lnote += 3; -#line 3152 "" +#line 3144 "" } else { -#line 3153 "" +#line 3145 "" i__1 = lnoten - 2; /* Writing concatenation */ -#line 3153 "" +#line 3145 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 3153 "" +#line 3145 "" i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; -#line 3153 "" +#line 3145 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); -#line 3154 "" +#line 3146 "" ++(*lnote); -#line 3155 "" +#line 3147 "" } -#line 3156 "" +#line 3148 "" } -#line 3157 "" +#line 3149 "" return 0; } /* beamn1_ */ @@ -8132,33 +8126,33 @@ L5: /* The following is just to save the outputs from SetupB for the case of */ /* xtups starting with a rest, where beamstrt is called twice. */ -#line 3209 "" +#line 3201 "" /* Parameter adjustments */ -#line 3209 "" +#line 3201 "" --squez; -#line 3209 "" +#line 3201 "" --space; -#line 3209 "" +#line 3201 "" ihornb -= 25; -#line 3209 "" +#line 3201 "" --nornb; -#line 3209 "" +#line 3201 "" -#line 3209 "" +#line 3201 "" /* Function Body */ -#line 3209 "" +#line 3201 "" writebrests = TRUE_; -#line 3210 "" +#line 3202 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; -#line 3211 "" +#line 3203 "" ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; -#line 3212 "" +#line 3204 "" multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8; -#line 3213 "" +#line 3205 "" ip = all_1.ipo[all_1.jn - 1]; -#line 3214 "" +#line 3206 "" *lnote = 0; -#line 3215 "" +#line 3207 "" nvtrem = 0; /* Compute slopes and note offsets from start of beam. Inside SetupB, for each */ @@ -8166,14 +8160,14 @@ L5: /* gets islope(ivx), transferred in common. */ /* Vertical adjustment beams for tremolo */ -#line 3221 "" +#line 3213 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],21)) { -#line 3221 "" +#line 3213 "" setupb_(comxtup_1.xelsk, &comipb_1.nnb, &comipb_1.sumx, & comipb_1.sumy, comipb_1.ipb, &comipb_1.smed, & strtmid_1.ixrest[commvl_1.ivx - 1]); -#line 3221 "" +#line 3213 "" } /* Will always come past here after entering beamstrt for 2-note tremolo, and */ @@ -8182,213 +8176,213 @@ L5: /* string, under the tacet assumption that there is no horizontal shift */ /* enacted by the action just before and after the call to beamstrt. */ -#line 3230 "" +#line 3222 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2) && igetbits_(& all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &c__5) > 0) { -#line 3232 "" +#line 3224 "" nindent = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], & c__2, &c__5); /* Writing concatenation */ -#line 3233 "" +#line 3225 "" i__1[0] = 1, a__1[0] = all_1.sq; -#line 3233 "" +#line 3225 "" i__1[1] = 12, a__1[1] = "roffset{.7}{"; -#line 3233 "" +#line 3225 "" i__1[2] = 1, a__1[2] = all_1.sq; -#line 3233 "" +#line 3225 "" i__1[3] = 2, a__1[3] = "ib"; -#line 3233 "" +#line 3225 "" s_cat(tempq, a__1, i__1, &c__4, (ftnlen)79); -#line 3234 "" +#line 3226 "" ltemp = 16; -#line 3235 "" +#line 3227 "" if (nindent == 2) { /* Writing concatenation */ -#line 3236 "" +#line 3228 "" i__2[0] = 16, a__2[0] = tempq; -#line 3236 "" +#line 3228 "" i__2[1] = 1, a__2[1] = "b"; -#line 3236 "" +#line 3228 "" s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); -#line 3237 "" +#line 3229 "" ltemp = 17; -#line 3238 "" +#line 3230 "" } else if (nindent == 3) { /* Writing concatenation */ -#line 3239 "" +#line 3231 "" i__2[0] = 16, a__2[0] = tempq; -#line 3239 "" +#line 3231 "" i__2[1] = 2, a__2[1] = "bb"; -#line 3239 "" +#line 3231 "" s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); -#line 3240 "" +#line 3232 "" ltemp = 18; -#line 3241 "" +#line 3233 "" } /* Use beam # 0 for indented beams */ /* Writing concatenation */ -#line 3245 "" +#line 3237 "" i__3[0] = ltemp, a__3[0] = tempq; -#line 3245 "" +#line 3237 "" i__3[1] = 1, a__3[1] = all_1.ulq + (commvl_1.ivx + ibc * 24 - 25); -#line 3245 "" +#line 3237 "" i__3[2] = 1, a__3[2] = "0"; -#line 3245 "" +#line 3237 "" s_cat(tempq, a__3, i__3, &c__3, (ftnlen)79); -#line 3246 "" +#line 3238 "" ltemp += 2; /* Get adjustment to nolev1 for main beam based on nindent */ -#line 3250 "" +#line 3242 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { -#line 3251 "" +#line 3243 "" nvtrem = nindent - 1; -#line 3252 "" +#line 3244 "" } else { -#line 3253 "" +#line 3245 "" nvtrem = 1 - nindent; -#line 3254 "" +#line 3246 "" } /* Get numerical position of initiation for main beam. Will adjust height at */ /* closing to account for nindent */ -#line 3259 "" +#line 3251 "" numinit = comxtup_1.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, & ipb1) + 4; /* Get forced beam height tweak, apply here for indented beams */ -#line 3263 "" +#line 3255 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__11) - 30; -#line 3264 "" +#line 3256 "" if (iadj != -30) { -#line 3264 "" +#line 3256 "" numinit += iadj; -#line 3264 "" +#line 3256 "" } -#line 3265 "" +#line 3257 "" if (numinit >= 0 && numinit <= 9) { -#line 3266 "" +#line 3258 "" s_wsfi(&io___223); -#line 3266 "" +#line 3258 "" do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); -#line 3266 "" +#line 3258 "" e_wsfi(); -#line 3267 "" +#line 3259 "" lnoten = 1; -#line 3268 "" +#line 3260 "" } else { -#line 3269 "" +#line 3261 "" s_wsfi(&io___225); -#line 3269 "" +#line 3261 "" do_fio(&c__1, "{", (ftnlen)1); -#line 3269 "" +#line 3261 "" do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); -#line 3269 "" +#line 3261 "" do_fio(&c__1, "}", (ftnlen)1); -#line 3269 "" +#line 3261 "" e_wsfi(); -#line 3270 "" +#line 3262 "" lnoten = 4; -#line 3271 "" +#line 3263 "" } /* Writing concatenation */ -#line 3272 "" +#line 3264 "" i__2[0] = ltemp, a__2[0] = tempq; -#line 3272 "" +#line 3264 "" i__2[1] = lnoten, a__2[1] = noteq; -#line 3272 "" +#line 3264 "" s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); -#line 3273 "" +#line 3265 "" ltemp += lnoten; /* Now do the slope. */ /* 170408 Baseline is in islope(ivx). Apply slope tweak if present. */ -#line 3278 "" +#line 3270 "" numinit = comxtup_1.islope[commvl_1.ivx - 1]; -#line 3279 "" +#line 3271 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__17) - 30; -#line 3280 "" +#line 3272 "" if (iadj != -30) { -#line 3280 "" +#line 3272 "" numinit += iadj; -#line 3280 "" +#line 3272 "" } -#line 3281 "" +#line 3273 "" if (numinit >= 0 && numinit <= 9) { -#line 3282 "" +#line 3274 "" s_wsfi(&io___226); -#line 3282 "" +#line 3274 "" do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); -#line 3282 "" +#line 3274 "" do_fio(&c__1, "}", (ftnlen)1); -#line 3282 "" +#line 3274 "" e_wsfi(); -#line 3283 "" +#line 3275 "" lnoten = 2; -#line 3284 "" +#line 3276 "" } else { -#line 3285 "" +#line 3277 "" s_wsfi(&io___227); -#line 3285 "" +#line 3277 "" do_fio(&c__1, "{", (ftnlen)1); -#line 3285 "" +#line 3277 "" do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); -#line 3285 "" +#line 3277 "" do_fio(&c__1, "}}", (ftnlen)2); -#line 3285 "" +#line 3277 "" e_wsfi(); -#line 3286 "" +#line 3278 "" lnoten = 5; -#line 3287 "" +#line 3279 "" } /* Writing concatenation */ -#line 3288 "" +#line 3280 "" i__2[0] = ltemp, a__2[0] = tempq; -#line 3288 "" +#line 3280 "" i__2[1] = lnoten, a__2[1] = noteq; -#line 3288 "" +#line 3280 "" s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); -#line 3289 "" +#line 3281 "" ltemp += lnoten; -#line 3290 "" +#line 3282 "" s_copy(notexq, tempq, (ftnlen)79, (ftnlen)79); -#line 3291 "" +#line 3283 "" *lnote = ltemp; -#line 3292 "" +#line 3284 "" } -#line 3293 "" +#line 3285 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) { /* This is start of later segment of single-slope beam group so use slope and */ /* height from prior beam. Slope is already OK. */ -#line 3298 "" +#line 3290 "" ++comxtup_1.issb[commvl_1.ivx - 1]; -#line 3299 "" +#line 3291 "" comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx + comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25]; -#line 3300 "" +#line 3292 "" } /* Move this up to before indented beams for tremolo */ /* lnote = 0 */ -#line 3304 "" +#line 3296 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; -#line 3305 "" +#line 3297 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) && strtmid_1.ixrest[commvl_1.ivx - 1] != 2) { -#line 3306 "" +#line 3298 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; -#line 3307 "" +#line 3299 "" ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; /* irest(28)=>Xtup starts on this note. Set up for xtuplet. */ @@ -8403,169 +8397,169 @@ L5: /* iflop 0 1 -1 0 ...direction of flop */ /* iup -1 1 -1 1 ...direction of number and bracket */ -#line 3321 "" +#line 3313 "" iud = 1; -#line 3322 "" +#line 3314 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { -#line 3322 "" +#line 3314 "" iud = -1; -#line 3322 "" +#line 3314 "" } /* Get ip#, note level of middle note (or gap) in xtup */ -#line 3326 "" +#line 3318 "" ipmid = ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] / 2; /* 130129 If middle note is a rest, go to next note. Note last note cannot */ /* be a rest */ -#line 3331 "" +#line 3323 "" L14: -#line 3332 "" +#line 3324 "" if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) { -#line 3333 "" +#line 3325 "" ++ipmid; -#line 3334 "" +#line 3326 "" goto L14; -#line 3335 "" +#line 3327 "" } -#line 3336 "" +#line 3328 "" i__4 = ncmid_(&all_1.iv, &ipmid); -#line 3336 "" +#line 3328 "" i__5 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; -#line 3336 "" +#line 3328 "" xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], & all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__4, & i__5); -#line 3338 "" +#line 3330 "" if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { -#line 3338 "" +#line 3330 "" i__5 = ipmid - 1; -#line 3338 "" +#line 3330 "" i__4 = ncmid_(&all_1.iv, &i__5); -#line 3338 "" +#line 3330 "" i__6 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - 8; -#line 3338 "" +#line 3330 "" xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24 - 25], &iud, &i__4, &i__6)) / 2; -#line 3338 "" +#line 3330 "" } -#line 3341 "" +#line 3333 "" iflop = 0; -#line 3342 "" +#line 3334 "" if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) { -#line 3342 "" +#line 3334 "" iflop = -iud; -#line 3342 "" +#line 3334 "" } -#line 3343 "" +#line 3335 "" iup = iud + (iflop << 1); -#line 3344 "" +#line 3336 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],14)) { /* Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) */ -#line 3348 "" +#line 3340 "" iup = -iup; -#line 3349 "" +#line 3341 "" iflop = 0; -#line 3350 "" +#line 3342 "" if (iud * iup < 0) { -#line 3350 "" +#line 3342 "" iflop = iup; -#line 3350 "" +#line 3342 "" } -#line 3351 "" +#line 3343 "" } /* Determine if a beam is to be drawn. */ /* Had problem w/ half-note 2-note xtups always F, so add a test */ -#line 3356 "" +#line 3348 "" if (igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, & c__3) != 0) { -#line 3357 "" +#line 3349 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; -#line 3358 "" +#line 3350 "" goto L6; -#line 3359 "" +#line 3351 "" } -#line 3360 "" +#line 3352 "" i__4 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; -#line 3360 "" +#line 3352 "" for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__4; ++ipp) { -#line 3361 "" +#line 3353 "" if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) { -#line 3362 "" +#line 3354 "" comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_; -#line 3363 "" +#line 3355 "" goto L6; -#line 3364 "" +#line 3356 "" } -#line 3365 "" +#line 3357 "" /* L5: */ -#line 3365 "" +#line 3357 "" } -#line 3366 "" +#line 3358 "" comdraw_1.drawbm[commvl_1.ivx - 1] = ! bit_test(all_1.islur[ commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25],18); -#line 3367 "" +#line 3359 "" L6: /* Are we using tuplet.tex? */ -#line 3371 "" +#line 3363 "" usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1]; /* Check for single note xtup 171217 */ -#line 3375 "" +#line 3367 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) && comipb_1.nnb == 1) { -#line 3376 "" +#line 3368 "" comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_; -#line 3377 "" +#line 3369 "" } /* Place xtup number if needed */ -#line 3381 "" +#line 3373 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) || multb <= 0) { -#line 3382 "" +#line 3374 "" mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__5, &c__22); -#line 3383 "" +#line 3375 "" if (mprint == 0) { -#line 3383 "" +#line 3375 "" mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25]; -#line 3383 "" +#line 3375 "" } /* Stab in the dark! Note: tried setting unbeam flag islur18 but no go. */ -#line 3385 "" +#line 3377 "" if (comipb_1.nnb == 1) { -#line 3386 "" +#line 3378 "" xnlmid = (real) comxtup_1.nolev1[commvl_1.ivx - 1]; -#line 3387 "" +#line 3379 "" comxtup_1.islope[commvl_1.ivx - 1] = 0; /* Move up, outside number check block, so all 1-note xtups ar unbeamed */ /* drawbm(ivx) = .false. */ -#line 3392 "" +#line 3384 "" } -#line 3393 "" +#line 3385 "" i__4 = ncmid_(&all_1.iv, &ipb1); -#line 3393 "" +#line 3385 "" putxtn_(&mprint, &iflop, &multb, &iud, &comask_1.wheadpt, & comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], & comxtup_1.islope[commvl_1.ivx - 1], &all_1.slfac, &xnlmid, @@ -8574,329 +8568,329 @@ L6: comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25], &iup, & all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &all_1.mult[ commvl_1.ivx + ipb1 * 24 - 25], &usexnumt, (ftnlen)79); -#line 3397 "" +#line 3389 "" } -#line 3398 "" +#line 3390 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam */ -#line 3402 "" +#line 3394 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31)) { /* Number printing has not been suppressed, so put in the bracket. */ /* scale = stretch factor for bracket if there are asx's */ /* xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) */ -#line 3408 "" +#line 3400 "" r__1 = space[*ib] / squez[*ib]; -#line 3408 "" +#line 3400 "" xnsk = (comeskz2_1.eskz2[commvl_1.ivx + (ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] - 1) * 24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipb1 * 24 - 25]) / squez[*ib] / feon_(&r__1); -#line 3410 "" +#line 3402 "" if (iup == 1) { -#line 3411 "" +#line 3403 "" if (*lnote > 0) { /* Writing concatenation */ -#line 3412 "" +#line 3404 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3412 "" +#line 3404 "" i__3[1] = 1, a__3[1] = all_1.sq; -#line 3412 "" +#line 3404 "" i__3[2] = 5, a__3[2] = "ovbkt"; -#line 3412 "" +#line 3404 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3413 "" +#line 3405 "" } else { /* Writing concatenation */ -#line 3414 "" +#line 3406 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3414 "" +#line 3406 "" i__2[1] = 5, a__2[1] = "ovbkt"; -#line 3414 "" +#line 3406 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3415 "" +#line 3407 "" } -#line 3416 "" +#line 3408 "" } else { -#line 3417 "" +#line 3409 "" if (*lnote > 0) { /* Writing concatenation */ -#line 3418 "" +#line 3410 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3418 "" +#line 3410 "" i__3[1] = 1, a__3[1] = all_1.sq; -#line 3418 "" +#line 3410 "" i__3[2] = 5, a__3[2] = "unbkt"; -#line 3418 "" +#line 3410 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3419 "" +#line 3411 "" } else { /* Introduced 12/5/98, req'd due to possible presence of in-line TeX */ /* Writing concatenation */ -#line 3423 "" +#line 3415 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3423 "" +#line 3415 "" i__2[1] = 5, a__2[1] = "unbkt"; -#line 3423 "" +#line 3415 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3424 "" +#line 3416 "" } -#line 3425 "" +#line 3417 "" } -#line 3426 "" +#line 3418 "" *lnote += 6; -#line 3427 "" +#line 3419 "" if (all_1.iline == 1) { -#line 3428 "" +#line 3420 "" comipb_1.smed /= 1.f - comtop_1.fracindent; -#line 3429 "" +#line 3421 "" } -#line 3430 "" +#line 3422 "" xslope = comipb_1.smed * 1.8f * all_1.slfac; -#line 3431 "" +#line 3423 "" comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope); -#line 3432 "" +#line 3424 "" r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1]; -#line 3432 "" +#line 3424 "" comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1); -#line 3433 "" +#line 3425 "" if (comxtup_1.islope[commvl_1.ivx - 1] == 0) { -#line 3433 "" +#line 3425 "" --comxtup_1.nolev1[commvl_1.ivx - 1]; -#line 3433 "" +#line 3425 "" } -#line 3434 "" +#line 3426 "" if (iup == 1) { -#line 3434 "" +#line 3426 "" comxtup_1.nolev1[commvl_1.ivx - 1] += 4; -#line 3434 "" +#line 3426 "" } -#line 3435 "" +#line 3427 "" levbracket = comxtup_1.nolev1[commvl_1.ivx - 1]; -#line 3436 "" +#line 3428 "" if (iup == 1 && comnvst_1.cstuplet) { -#line 3436 "" +#line 3428 "" --levbracket; -#line 3436 "" +#line 3428 "" } -#line 3437 "" +#line 3429 "" i__4 = ncmid_(&all_1.iv, &ipb1); -#line 3437 "" +#line 3429 "" notefq_(noteq, &lnoten, &levbracket, &i__4, (ftnlen)8); -#line 3438 "" +#line 3430 "" if (lnoten == 1) { -#line 3438 "" +#line 3430 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 3438 "" +#line 3430 "" } /* Writing concatenation */ -#line 3439 "" +#line 3431 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3439 "" +#line 3431 "" i__3[1] = lnoten, a__3[1] = noteq; -#line 3439 "" +#line 3431 "" i__3[2] = 1, a__3[2] = "{"; -#line 3439 "" +#line 3431 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3440 "" +#line 3432 "" *lnote = *lnote + lnoten + 1; -#line 3441 "" +#line 3433 "" if (xnsk < .995f) { -#line 3442 "" +#line 3434 "" i__4 = *lnote; -#line 3442 "" +#line 3434 "" ici__1.icierr = 0; -#line 3442 "" +#line 3434 "" ici__1.icirnum = 1; -#line 3442 "" +#line 3434 "" ici__1.icirlen = *lnote + 4 - i__4; -#line 3442 "" +#line 3434 "" ici__1.iciunit = notexq + i__4; -#line 3442 "" +#line 3434 "" ici__1.icifmt = "(i1,f3.2)"; -#line 3442 "" +#line 3434 "" s_wsfi(&ici__1); -#line 3442 "" +#line 3434 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 3442 "" +#line 3434 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); -#line 3442 "" +#line 3434 "" e_wsfi(); -#line 3443 "" +#line 3435 "" *lnote += 4; -#line 3444 "" +#line 3436 "" } else if (xnsk < 9.995f) { -#line 3445 "" +#line 3437 "" i__4 = *lnote; -#line 3445 "" +#line 3437 "" ici__1.icierr = 0; -#line 3445 "" +#line 3437 "" ici__1.icirnum = 1; -#line 3445 "" +#line 3437 "" ici__1.icirlen = *lnote + 4 - i__4; -#line 3445 "" +#line 3437 "" ici__1.iciunit = notexq + i__4; -#line 3445 "" +#line 3437 "" ici__1.icifmt = "(f4.2)"; -#line 3445 "" +#line 3437 "" s_wsfi(&ici__1); -#line 3445 "" +#line 3437 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); -#line 3445 "" +#line 3437 "" e_wsfi(); -#line 3446 "" +#line 3438 "" *lnote += 4; -#line 3447 "" +#line 3439 "" } else { -#line 3448 "" +#line 3440 "" i__4 = *lnote; -#line 3448 "" +#line 3440 "" ici__1.icierr = 0; -#line 3448 "" +#line 3440 "" ici__1.icirnum = 1; -#line 3448 "" +#line 3440 "" ici__1.icirlen = *lnote + 5 - i__4; -#line 3448 "" +#line 3440 "" ici__1.iciunit = notexq + i__4; -#line 3448 "" +#line 3440 "" ici__1.icifmt = "(f5.2)"; -#line 3448 "" +#line 3440 "" s_wsfi(&ici__1); -#line 3448 "" +#line 3440 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); -#line 3448 "" +#line 3440 "" e_wsfi(); -#line 3449 "" +#line 3441 "" *lnote += 5; -#line 3450 "" +#line 3442 "" } /* Writing concatenation */ -#line 3451 "" +#line 3443 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3451 "" +#line 3443 "" i__2[1] = 1, a__2[1] = "}"; -#line 3451 "" +#line 3443 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3452 "" +#line 3444 "" ++(*lnote); -#line 3453 "" +#line 3445 "" if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) { /* Tweak slope of bracket */ -#line 3457 "" +#line 3449 "" comxtup_1.islope[commvl_1.ivx - 1] = comxtup_1.islope[ commvl_1.ivx - 1] + igetbits_(&all_1.mult[ commvl_1.ivx + ipb1 * 24 - 25], &c__5, &c__5) - 16; -#line 3458 "" +#line 3450 "" } -#line 3459 "" +#line 3451 "" if (comxtup_1.islope[commvl_1.ivx - 1] < 0 || comxtup_1.islope[commvl_1.ivx - 1] >= 10) { /* Writing concatenation */ -#line 3460 "" +#line 3452 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3460 "" +#line 3452 "" i__2[1] = 1, a__2[1] = "{"; -#line 3460 "" +#line 3452 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3461 "" +#line 3453 "" ++(*lnote); -#line 3462 "" +#line 3454 "" if (comxtup_1.islope[commvl_1.ivx - 1] < -9) { -#line 3463 "" +#line 3455 "" i__4 = *lnote; -#line 3463 "" +#line 3455 "" ici__1.icierr = 0; -#line 3463 "" +#line 3455 "" ici__1.icirnum = 1; -#line 3463 "" +#line 3455 "" ici__1.icirlen = *lnote + 3 - i__4; -#line 3463 "" +#line 3455 "" ici__1.iciunit = notexq + i__4; -#line 3463 "" +#line 3455 "" ici__1.icifmt = "(i3)"; -#line 3463 "" +#line 3455 "" s_wsfi(&ici__1); -#line 3463 "" +#line 3455 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); -#line 3463 "" +#line 3455 "" e_wsfi(); -#line 3464 "" +#line 3456 "" *lnote += 3; -#line 3465 "" +#line 3457 "" } else { -#line 3466 "" +#line 3458 "" i__4 = *lnote; -#line 3466 "" +#line 3458 "" ici__1.icierr = 0; -#line 3466 "" +#line 3458 "" ici__1.icirnum = 1; -#line 3466 "" +#line 3458 "" ici__1.icirlen = *lnote + 2 - i__4; -#line 3466 "" +#line 3458 "" ici__1.iciunit = notexq + i__4; -#line 3466 "" +#line 3458 "" ici__1.icifmt = "(i2)"; -#line 3466 "" +#line 3458 "" s_wsfi(&ici__1); -#line 3466 "" +#line 3458 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); -#line 3466 "" +#line 3458 "" e_wsfi(); -#line 3467 "" +#line 3459 "" *lnote += 2; -#line 3468 "" +#line 3460 "" } /* Writing concatenation */ -#line 3469 "" +#line 3461 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3469 "" +#line 3461 "" i__2[1] = 1, a__2[1] = "}"; -#line 3469 "" +#line 3461 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3470 "" +#line 3462 "" ++(*lnote); -#line 3471 "" +#line 3463 "" } else { -#line 3472 "" +#line 3464 "" i__4 = *lnote; -#line 3472 "" +#line 3464 "" ici__1.icierr = 0; -#line 3472 "" +#line 3464 "" ici__1.icirnum = 1; -#line 3472 "" +#line 3464 "" ici__1.icirlen = *lnote + 1 - i__4; -#line 3472 "" +#line 3464 "" ici__1.iciunit = notexq + i__4; -#line 3472 "" +#line 3464 "" ici__1.icifmt = "(i1)"; -#line 3472 "" +#line 3464 "" s_wsfi(&ici__1); -#line 3472 "" +#line 3464 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); -#line 3472 "" +#line 3464 "" e_wsfi(); -#line 3473 "" +#line 3465 "" ++(*lnote); -#line 3474 "" +#line 3466 "" } /* Done with bracket */ -#line 3478 "" +#line 3470 "" } -#line 3479 "" +#line 3471 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { /* Put in the rest. Possible problem: Rest is a spacing char, but between */ @@ -8904,71 +8898,71 @@ L6: /* 130126 Deal with vertical shifts of rest starting xtuplet */ -#line 3486 "" +#line 3478 "" lrest = 3; -#line 3487 "" +#line 3479 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Writing concatenation */ -#line 3488 "" +#line 3480 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3488 "" +#line 3480 "" i__2[1] = 2, a__2[1] = "sk"; -#line 3488 "" +#line 3480 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); /* if (multb .eq. 0) then */ -#line 3490 "" +#line 3482 "" } else if (multb == 0) { /* Writing concatenation */ -#line 3491 "" +#line 3483 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3491 "" +#line 3483 "" i__2[1] = 2, a__2[1] = "qp"; -#line 3491 "" +#line 3483 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); -#line 3492 "" +#line 3484 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1) { /* Writing concatenation */ -#line 3493 "" +#line 3485 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3493 "" +#line 3485 "" i__2[1] = 2, a__2[1] = "ds"; -#line 3493 "" +#line 3485 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); -#line 3494 "" +#line 3486 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2) { /* Writing concatenation */ -#line 3495 "" +#line 3487 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3495 "" +#line 3487 "" i__2[1] = 2, a__2[1] = "qs"; -#line 3495 "" +#line 3487 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); -#line 3496 "" +#line 3488 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3) { /* Writing concatenation */ -#line 3497 "" +#line 3489 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3497 "" +#line 3489 "" i__2[1] = 2, a__2[1] = "hs"; -#line 3497 "" +#line 3489 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); -#line 3498 "" +#line 3490 "" } else { /* Writing concatenation */ -#line 3499 "" +#line 3491 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3499 "" +#line 3491 "" i__2[1] = 6, a__2[1] = "hpause"; -#line 3499 "" +#line 3491 "" s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); -#line 3500 "" +#line 3492 "" lrest = 7; -#line 3501 "" +#line 3493 "" } -#line 3502 "" +#line 3494 "" if (bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],18) && bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],19) ) { @@ -8976,561 +8970,561 @@ L6: /* VERY special case of rest at start of F-tuplet, needs dot */ /* Writing concatenation */ -#line 3507 "" +#line 3499 "" i__3[0] = 1, a__3[0] = all_1.sq; -#line 3507 "" +#line 3499 "" i__3[1] = 3, a__3[1] = "pt4"; -#line 3507 "" +#line 3499 "" i__3[2] = lrest, a__3[2] = restq; -#line 3507 "" +#line 3499 "" s_cat(restq, a__3, i__3, &c__3, (ftnlen)40); -#line 3508 "" +#line 3500 "" lrest += 4; -#line 3509 "" +#line 3501 "" } -#line 3511 "" +#line 3503 "" nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100 - 20; /* if (nole .eq. 0) then */ -#line 3513 "" +#line 3505 "" if (nole == 0 || bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Rest blank or is not raised */ /* Writing concatenation */ -#line 3517 "" +#line 3509 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3517 "" +#line 3509 "" i__2[1] = 40, a__2[1] = restq; -#line 3517 "" +#line 3509 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3518 "" +#line 3510 "" *lnote += lrest; -#line 3519 "" +#line 3511 "" } else { -#line 3520 "" +#line 3512 "" if (abs(nole) < 10) { -#line 3521 "" +#line 3513 "" i__4 = abs(nole) + 48; -#line 3521 "" +#line 3513 "" chax_(ch__1, (ftnlen)1, &i__4); -#line 3521 "" +#line 3513 "" s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1); -#line 3522 "" +#line 3514 "" ltemp = 1; -#line 3523 "" +#line 3515 "" } else { -#line 3524 "" +#line 3516 "" s_wsfi(&io___243); -#line 3524 "" +#line 3516 "" i__4 = abs(nole); -#line 3524 "" +#line 3516 "" do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 3524 "" +#line 3516 "" e_wsfi(); -#line 3525 "" +#line 3517 "" ltemp = 2; -#line 3526 "" +#line 3518 "" } -#line 3527 "" +#line 3519 "" if (nole > 0) { /* Writing concatenation */ -#line 3528 "" +#line 3520 "" i__7[0] = 1, a__4[0] = all_1.sq; -#line 3528 "" +#line 3520 "" i__7[1] = 5, a__4[1] = "raise"; -#line 3528 "" +#line 3520 "" i__7[2] = ltemp, a__4[2] = tempq; -#line 3528 "" +#line 3520 "" i__7[3] = 1, a__4[3] = all_1.sq; -#line 3528 "" +#line 3520 "" i__7[4] = 9, a__4[4] = "internote"; -#line 3528 "" +#line 3520 "" s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79); -#line 3529 "" +#line 3521 "" } else { /* Writing concatenation */ -#line 3530 "" +#line 3522 "" i__7[0] = 1, a__4[0] = all_1.sq; -#line 3530 "" +#line 3522 "" i__7[1] = 5, a__4[1] = "lower"; -#line 3530 "" +#line 3522 "" i__7[2] = ltemp, a__4[2] = tempq; -#line 3530 "" +#line 3522 "" i__7[3] = 1, a__4[3] = all_1.sq; -#line 3530 "" +#line 3522 "" i__7[4] = 9, a__4[4] = "internote"; -#line 3530 "" +#line 3522 "" s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79); -#line 3531 "" +#line 3523 "" } -#line 3532 "" +#line 3524 "" ltemp += 16; /* Writing concatenation */ -#line 3533 "" +#line 3525 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3533 "" +#line 3525 "" i__3[1] = ltemp, a__3[1] = tempq; -#line 3533 "" +#line 3525 "" i__3[2] = lrest, a__3[2] = restq; -#line 3533 "" +#line 3525 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3534 "" +#line 3526 "" *lnote = *lnote + ltemp + lrest; -#line 3535 "" +#line 3527 "" } /* No need to come back through this subroutine (as would if rest starts bar */ /* & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. */ -#line 3540 "" +#line 3532 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; -#line 3541 "" +#line 3533 "" } -#line 3542 "" +#line 3534 "" return 0; -#line 3543 "" +#line 3535 "" } /* End if block for non-beamed xtup start...note we returned */ -#line 3547 "" +#line 3539 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { /* Insert rest at start of beamed xtup. See above note for possible problem. */ /* But first check if blank rest and if in forced beam (assuming xtuplet), */ /* and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*' */ -#line 3553 "" +#line 3545 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],30)) { -#line 3554 "" +#line 3546 "" ++xjbeambrests_1.nbrests; -#line 3555 "" +#line 3547 "" writebrests = FALSE_; -#line 3556 "" +#line 3548 "" } else { -#line 3557 "" +#line 3549 "" i__4 = 4 - multb; -#line 3557 "" +#line 3549 "" all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, & i__4); -#line 3558 "" +#line 3550 "" notex_(tempq, <emp, (ftnlen)79); -#line 3559 "" +#line 3551 "" if (*lnote > 0) { /* Writing concatenation */ -#line 3560 "" +#line 3552 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3560 "" +#line 3552 "" i__2[1] = ltemp, a__2[1] = tempq; -#line 3560 "" +#line 3552 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3561 "" +#line 3553 "" } else { -#line 3562 "" +#line 3554 "" s_copy(notexq, tempq, (ftnlen)79, ltemp); -#line 3563 "" +#line 3555 "" } -#line 3564 "" +#line 3556 "" *lnote += ltemp; -#line 3565 "" +#line 3557 "" } /* Re-zero just in case! */ -#line 3569 "" +#line 3561 "" all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0; -#line 3570 "" +#line 3562 "" ++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; /* See if next note is a non-rest */ -#line 3574 "" +#line 3566 "" if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0) ) { -#line 3575 "" +#line 3567 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 2; -#line 3576 "" +#line 3568 "" } else { /* Suppress reprinting xtup number next time through beamstrt */ -#line 3580 "" +#line 3572 "" all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25],31); /* Set new xtup start flag */ -#line 3584 "" +#line 3576 "" all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set( all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28); -#line 3585 "" +#line 3577 "" } -#line 3586 "" +#line 3578 "" return 0; -#line 3587 "" +#line 3579 "" } -#line 3588 "" +#line 3580 "" } /* Just ended if block for xtups */ -#line 3592 "" +#line 3584 "" if (comxtup_1.vxtup[commvl_1.ivx - 1] && ipb1 == all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]) { /* Move actual note writing to beamend */ -#line 3596 "" +#line 3588 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 4; -#line 3597 "" +#line 3589 "" return 0; -#line 3598 "" +#line 3590 "" } -#line 3599 "" +#line 3591 "" if (comxtup_1.issb[commvl_1.ivx - 1] == 0) { /* 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed */ -#line 3603 "" +#line 3595 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__11) - 30; -#line 3604 "" +#line 3596 "" if (iadj != -30) { -#line 3605 "" +#line 3597 "" comxtup_1.nolev1[commvl_1.ivx - 1] += iadj; -#line 3606 "" +#line 3598 "" i__4 = comxtup_1.nssb[commvl_1.ivx - 1]; -#line 3606 "" +#line 3598 "" for (isssb = 1; isssb <= i__4; ++isssb) { -#line 3607 "" +#line 3599 "" comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj; -#line 3608 "" +#line 3600 "" /* L2: */ -#line 3608 "" +#line 3600 "" } -#line 3609 "" +#line 3601 "" } -#line 3610 "" +#line 3602 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__17) - 30; -#line 3611 "" +#line 3603 "" if (iadj != -30) { -#line 3612 "" +#line 3604 "" comxtup_1.islope[commvl_1.ivx - 1] += iadj; -#line 3613 "" +#line 3605 "" if ((i__4 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__4)) > 9) { -#line 3613 "" +#line 3605 "" comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, & comxtup_1.islope[commvl_1.ivx - 1]); -#line 3613 "" +#line 3605 "" } -#line 3614 "" +#line 3606 "" if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) { /* Cycle thru non-rest notes in SSBG, looking for bmstrts. */ -#line 3618 "" +#line 3610 "" isssb = 0; -#line 3619 "" +#line 3611 "" i__4 = comipb_1.nnb; -#line 3619 "" +#line 3611 "" for (inb = 2; inb <= i__4; ++inb) { -#line 3620 "" +#line 3612 "" if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 25],21)) { /* Beam segment start. New start level */ -#line 3623 "" +#line 3615 "" ++isssb; -#line 3624 "" +#line 3616 "" comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac; -#line 3626 "" +#line 3618 "" } -#line 3627 "" +#line 3619 "" /* L4: */ -#line 3627 "" +#line 3619 "" } -#line 3628 "" +#line 3620 "" } -#line 3629 "" +#line 3621 "" } -#line 3630 "" +#line 3622 "" } -#line 3631 "" +#line 3623 "" iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, & c__27); -#line 3632 "" +#line 3624 "" addbrack = FALSE_; -#line 3633 "" +#line 3625 "" if (bit_test(all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25],30)) { /* Check for altered starting polarity. Only in forced beams. Nominal start */ /* level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). */ -#line 3638 "" +#line 3630 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && comxtup_1.nolev1[commvl_1.ivx - 1] + 6 < all_1.nolev[ commvl_1.ivx + ipb1 * 24 - 25]) { -#line 3640 "" +#line 3632 "" if (*lnote == 0) { /* Writing concatenation */ -#line 3641 "" +#line 3633 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3641 "" +#line 3633 "" i__2[1] = 5, a__2[1] = "loff{"; -#line 3641 "" +#line 3633 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3642 "" +#line 3634 "" } else { /* Writing concatenation */ -#line 3643 "" +#line 3635 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3643 "" +#line 3635 "" i__3[1] = 1, a__3[1] = all_1.sq; -#line 3643 "" +#line 3635 "" i__3[2] = 5, a__3[2] = "loff{"; -#line 3643 "" +#line 3635 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3644 "" +#line 3636 "" } -#line 3645 "" +#line 3637 "" *lnote += 6; -#line 3646 "" +#line 3638 "" addbrack = TRUE_; -#line 3647 "" +#line 3639 "" } else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' && comxtup_1.nolev1[commvl_1.ivx - 1] - 6 > all_1.nolev[commvl_1.ivx + ipb1 * 24 - 25]) { -#line 3649 "" +#line 3641 "" if (*lnote == 0) { /* Writing concatenation */ -#line 3650 "" +#line 3642 "" i__2[0] = 1, a__2[0] = all_1.sq; -#line 3650 "" +#line 3642 "" i__2[1] = 5, a__2[1] = "roff{"; -#line 3650 "" +#line 3642 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3651 "" +#line 3643 "" } else { /* Writing concatenation */ -#line 3652 "" +#line 3644 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3652 "" +#line 3644 "" i__3[1] = 1, a__3[1] = all_1.sq; -#line 3652 "" +#line 3644 "" i__3[2] = 5, a__3[2] = "roff{"; -#line 3652 "" +#line 3644 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3653 "" +#line 3645 "" } -#line 3654 "" +#line 3646 "" *lnote += 6; -#line 3655 "" +#line 3647 "" addbrack = TRUE_; -#line 3656 "" +#line 3648 "" } /* Check end level for possible flipping in forced beam. Have to do it */ /* here since with multiple voices, xelsk will not be preserved. */ -#line 3661 "" +#line 3653 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 3662 "" +#line 3654 "" bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] + 6 + comxtup_1.islope[ commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] / all_1.slfac; -#line 3663 "" +#line 3655 "" strtmid_1.flipend[commvl_1.ivx - 1] = bmlev < (real) all_1.nolev[ commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; -#line 3664 "" +#line 3656 "" } else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'l') { -#line 3665 "" +#line 3657 "" bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] - 6 + comxtup_1.islope[ commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] / all_1.slfac; -#line 3666 "" +#line 3658 "" strtmid_1.flipend[commvl_1.ivx - 1] = bmlev > (real) all_1.nolev[ commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; -#line 3667 "" +#line 3659 "" } -#line 3668 "" +#line 3660 "" } -#line 3669 "" +#line 3661 "" multbb = multb + iadj; /* Tremolo starting? */ -#line 3673 "" +#line 3665 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2)) { -#line 3673 "" +#line 3665 "" multbb = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &c__3); -#line 3673 "" +#line 3665 "" } -#line 3675 "" +#line 3667 "" ntrbbb_(&multbb, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); /* Put in name of start level and slope, after correcting nolev1 if xtup */ /* started with a rest. */ -#line 3680 "" +#line 3672 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { -#line 3680 "" +#line 3672 "" r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac; -#line 3680 "" +#line 3672 "" comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); -#line 3680 "" +#line 3672 "" } /* Add adjustment nvtrem to main beam to account for tremolo indented beams */ -#line 3685 "" +#line 3677 "" i__4 = comxtup_1.nolev1[commvl_1.ivx - 1] + nvtrem; -#line 3685 "" +#line 3677 "" i__5 = ncmid_(&all_1.iv, &ipb1); -#line 3685 "" +#line 3677 "" notefq_(noteq, &lnoten, &i__4, &i__5, (ftnlen)8); -#line 3686 "" +#line 3678 "" if (comxtup_1.islope[commvl_1.ivx - 1] < 0) { /* Writing concatenation */ -#line 3687 "" +#line 3679 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3687 "" +#line 3679 "" i__3[1] = lnoten, a__3[1] = noteq; -#line 3687 "" +#line 3679 "" i__3[2] = 1, a__3[2] = "{"; -#line 3687 "" +#line 3679 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3688 "" +#line 3680 "" *lnote = *lnote + 4 + lnoten; -#line 3689 "" +#line 3681 "" i__4 = *lnote - 3; -#line 3689 "" +#line 3681 "" ici__1.icierr = 0; -#line 3689 "" +#line 3681 "" ici__1.icirnum = 1; -#line 3689 "" +#line 3681 "" ici__1.icirlen = *lnote - i__4; -#line 3689 "" +#line 3681 "" ici__1.iciunit = notexq + i__4; -#line 3689 "" +#line 3681 "" ici__1.icifmt = "(i2,a1)"; -#line 3689 "" +#line 3681 "" s_wsfi(&ici__1); -#line 3689 "" +#line 3681 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) sizeof(integer)); -#line 3689 "" +#line 3681 "" do_fio(&c__1, "}", (ftnlen)1); -#line 3689 "" +#line 3681 "" e_wsfi(); -#line 3690 "" +#line 3682 "" } else { /* Writing concatenation */ -#line 3691 "" +#line 3683 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3691 "" +#line 3683 "" i__2[1] = lnoten, a__2[1] = noteq; -#line 3691 "" +#line 3683 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3692 "" +#line 3684 "" *lnote = *lnote + 1 + lnoten; -#line 3693 "" +#line 3685 "" ici__1.icierr = 0; -#line 3693 "" +#line 3685 "" ici__1.icirnum = 1; -#line 3693 "" +#line 3685 "" ici__1.icirlen = 1; -#line 3693 "" +#line 3685 "" ici__1.iciunit = notexq + (*lnote - 1); -#line 3693 "" +#line 3685 "" ici__1.icifmt = "(i1)"; -#line 3693 "" +#line 3685 "" s_wsfi(&ici__1); -#line 3693 "" +#line 3685 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) sizeof(integer)); -#line 3693 "" +#line 3685 "" e_wsfi(); -#line 3694 "" +#line 3686 "" } /* Check for beam-thk fine-tuning */ -#line 3698 "" +#line 3690 "" if (iadj > 0) { -#line 3699 "" +#line 3691 "" i__4 = multb + 1; -#line 3699 "" +#line 3691 "" for (imp = multb + iadj; imp >= i__4; --imp) { -#line 3700 "" +#line 3692 "" ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, ( ftnlen)79); -#line 3701 "" +#line 3693 "" /* L1: */ -#line 3701 "" +#line 3693 "" } -#line 3702 "" +#line 3694 "" } /* If we shifted, must close with right bracket */ -#line 3706 "" +#line 3698 "" if (addbrack) { /* Writing concatenation */ -#line 3707 "" +#line 3699 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 3707 "" +#line 3699 "" i__2[1] = 1, a__2[1] = "}"; -#line 3707 "" +#line 3699 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 3708 "" +#line 3700 "" ++(*lnote); -#line 3709 "" +#line 3701 "" } /* Add in \sk's for very special case of staff-crossing xtup chords */ /* Assumes we are in lower (first) voice of up-to-both beamed xtup */ /* that starts with blank rests (notes in upper voice here). */ -#line 3715 "" +#line 3707 "" if (xjbeambrests_1.nbrests > 0 && writebrests) { -#line 3716 "" +#line 3708 "" i__4 = xjbeambrests_1.nbrests; -#line 3716 "" +#line 3708 "" for (isk = 1; isk <= i__4; ++isk) { /* Writing concatenation */ -#line 3717 "" +#line 3709 "" i__3[0] = *lnote, a__3[0] = notexq; -#line 3717 "" +#line 3709 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 3717 "" +#line 3709 "" i__3[1] = 1, a__3[1] = ch__1; -#line 3717 "" +#line 3709 "" i__3[2] = 2, a__3[2] = "sk"; -#line 3717 "" +#line 3709 "" s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); -#line 3718 "" +#line 3710 "" *lnote += 3; -#line 3719 "" +#line 3711 "" /* L7: */ -#line 3719 "" +#line 3711 "" } -#line 3720 "" +#line 3712 "" xjbeambrests_1.nbrests = 0; -#line 3721 "" +#line 3713 "" } /* Get 'floor' zmin for figures */ @@ -9538,100 +9532,100 @@ L6: /* won't be adjusted. If anyone ever needs that, need to duplicate this */ /* functionality up above, before exiting. */ -#line 3728 "" +#line 3720 "" if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2)) { -#line 3729 "" +#line 3721 "" if (commvl_1.ivx == 1) { -#line 3730 "" +#line 3722 "" ivf = 1; -#line 3731 "" +#line 3723 "" } else { -#line 3732 "" +#line 3724 "" ivf = comfig_1.ivxfig2; -#line 3733 "" +#line 3725 "" } -#line 3734 "" +#line 3726 "" zmult = (multb - 1) * 1.2f; -#line 3735 "" +#line 3727 "" ymin = 100.f; -#line 3736 "" +#line 3728 "" i__4 = comipb_1.nnb; -#line 3736 "" +#line 3728 "" for (inb = 1; inb <= i__4; ++inb) { -#line 3737 "" +#line 3729 "" if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) { -#line 3738 "" +#line 3730 "" if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] == 'u') { -#line 3739 "" +#line 3731 "" ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1] * 24 - 25]; -#line 3740 "" +#line 3732 "" } else { -#line 3741 "" +#line 3733 "" ybot = comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac * comxtup_1.xelsk[inb - 1] + comxtup_1.nolev1[ commvl_1.ivx - 1] - all_1.stemlen - zmult; -#line 3743 "" +#line 3735 "" } -#line 3744 "" +#line 3736 "" ymin = dmin(ymin,ybot); -#line 3745 "" +#line 3737 "" } -#line 3746 "" +#line 3738 "" /* L3: */ -#line 3746 "" +#line 3738 "" } -#line 3747 "" +#line 3739 "" maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f; /* Computing MAX */ -#line 3748 "" +#line 3740 "" i__4 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3]; -#line 3748 "" +#line 3740 "" all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__4,maxdrop); -#line 3749 "" +#line 3741 "" } /* Compute ornament levels if needed */ -#line 3753 "" +#line 3745 "" nomornlev = ncmid_(&all_1.iv, &ipb1) + 5; -#line 3754 "" +#line 3746 "" iorn = 0; -#line 3755 "" +#line 3747 "" i__4 = comipb_1.nnb; -#line 3755 "" +#line 3747 "" for (inb = 1; inb <= i__4; ++inb) { -#line 3756 "" +#line 3748 "" ip = comipb_1.ipb[inb - 1]; -#line 3757 "" +#line 3749 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) { -#line 3757 "" +#line 3749 "" goto L8; -#line 3757 "" +#line 3749 "" } -#line 3758 "" +#line 3750 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26) && *( unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l') { /* letter-dynamic or hairpin ending under down-beamed */ -#line 3762 "" +#line 3754 "" ++iorn; -#line 3763 "" +#line 3755 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - (multb - 1) * 1.2f; /* Computing MIN */ -#line 3765 "" +#line 3757 "" r__1 = ybeam - 3.f; -#line 3765 "" +#line 3757 "" i__5 = i_nint(&r__1), i__6 = nomornlev - 10; -#line 3765 "" +#line 3757 "" ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6); -#line 3766 "" +#line 3758 "" } else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */ @@ -9640,52 +9634,52 @@ L6: /* Non-chord. There IS an ornament. Need ihornb only if upbeam, and if */ /* ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) */ -#line 3774 "" +#line 3766 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1] & 4163566) > 0) { -#line 3776 "" +#line 3768 "" ++iorn; -#line 3777 "" +#line 3769 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[ commvl_1.ivx + ip * 24 - 1],22); -#line 3778 "" +#line 3770 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[ inb - 1] / all_1.slfac - 1 + (multb - 1) * 1.2f; /* Computing MAX */ -#line 3780 "" +#line 3772 "" r__1 = ybeam + 3.f; -#line 3780 "" +#line 3772 "" i__5 = i_nint(&r__1); -#line 3780 "" +#line 3772 "" ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev); -#line 3781 "" +#line 3773 "" } -#line 3782 "" +#line 3774 "" } else { /* In a chord. Orn may be on main note or non-main or both. Set ihornb if */ /* upbeam and highest note has orn, or down beam and lowest. Find 1st chord note */ -#line 3787 "" +#line 3779 "" i__5 = comtrill_1.ncrd; -#line 3787 "" +#line 3779 "" for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__5; ++comtrill_1.icrd1) { -#line 3788 "" +#line 3780 "" if ((255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]) == ip && ( 15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], (ftnlen)-8)) == commvl_1.ivx) { -#line 3788 "" +#line 3780 "" goto L11; -#line 3788 "" +#line 3780 "" } -#line 3790 "" +#line 3782 "" /* L10: */ -#line 3790 "" +#line 3782 "" } -#line 3791 "" +#line 3783 "" L11: /* Find outermost note, min or max depending on beam direction ulq. xto is true */ @@ -9693,126 +9687,126 @@ L11: /* on extreme chord note in beam, will move. */ /* So ornaments are all except 0,4,13 (,g,) */ -#line 3798 "" +#line 3790 "" levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; -#line 3799 "" +#line 3791 "" xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1] & 4186094) > 0; -#line 3800 "" +#line 3792 "" icrdx = 0; -#line 3801 "" +#line 3793 "" i__5 = comtrill_1.ncrd; -#line 3801 "" +#line 3793 "" for (icrd = comtrill_1.icrd1; icrd <= i__5; ++icrd) { -#line 3802 "" +#line 3794 "" if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8)) != commvl_1.ivx) { -#line 3802 "" +#line 3794 "" goto L13; -#line 3802 "" +#line 3794 "" } -#line 3804 "" +#line 3796 "" levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen) -12); -#line 3805 "" +#line 3797 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && levc > levx || *(unsigned char *)& all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' && levc < levx) { -#line 3807 "" +#line 3799 "" levx = levc; -#line 3808 "" +#line 3800 "" icrdx = icrd; -#line 3809 "" +#line 3801 "" xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0; -#line 3810 "" +#line 3802 "" } -#line 3811 "" +#line 3803 "" /* L12: */ -#line 3811 "" +#line 3803 "" } -#line 3812 "" +#line 3804 "" L13: /* If there's orn on extreme note, do stuff */ -#line 3816 "" +#line 3808 "" if (xto) { -#line 3817 "" +#line 3809 "" ++iorn; -#line 3818 "" +#line 3810 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { -#line 3819 "" +#line 3811 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac - 1 + ( multb - 1) * 1.2f; /* Computing MAX */ -#line 3821 "" +#line 3813 "" r__1 = ybeam + 3.f; -#line 3821 "" +#line 3813 "" i__5 = i_nint(&r__1); -#line 3821 "" +#line 3813 "" ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev); -#line 3822 "" +#line 3814 "" } else { -#line 3823 "" +#line 3815 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - ( multb - 1) * 1.2f; /* Computing MIN */ -#line 3825 "" +#line 3817 "" r__1 = ybeam - 3.f; -#line 3825 "" +#line 3817 "" i__5 = i_nint(&r__1), i__6 = nomornlev - 10; -#line 3825 "" +#line 3817 "" ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6); -#line 3826 "" +#line 3818 "" } -#line 3827 "" +#line 3819 "" if (icrdx == 0) { /* Affected ornament is on main note */ -#line 3831 "" +#line 3823 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( all_1.iornq[commvl_1.ivx + ip * 24 - 1],22); -#line 3832 "" +#line 3824 "" } else { -#line 3833 "" +#line 3825 "" comtrill_1.icrdorn[icrdx - 1] = bit_set( comtrill_1.icrdorn[icrdx - 1],22); -#line 3834 "" +#line 3826 "" } -#line 3835 "" +#line 3827 "" } -#line 3836 "" +#line 3828 "" } -#line 3837 "" +#line 3829 "" L8: -#line 3837 "" +#line 3829 "" ; -#line 3837 "" +#line 3829 "" } /* Henceforth nornb will be a counter. */ -#line 3841 "" +#line 3833 "" if (iorn > 0) { -#line 3841 "" +#line 3833 "" nornb[commvl_1.ivx] = 1; -#line 3841 "" +#line 3833 "" } -#line 3842 "" +#line 3834 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { -#line 3842 "" +#line 3834 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; -#line 3842 "" +#line 3834 "" } -#line 3843 "" +#line 3835 "" return 0; } /* beamstrt_ */ @@ -9834,47 +9828,45 @@ L8: /* Local variables */ static integer iptr; -/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ -/* logical gotclef */ -#line 3927 "" +#line 3917 "" i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1; -#line 3927 "" +#line 3917 "" for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1; ++iptr) { -#line 3928 "" +#line 3918 "" if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) < comtol_1.tol) { -#line 3929 "" +#line 3919 "" if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) < comtol_1.tol) { /* Increment pre-existing entry */ -#line 3933 "" +#line 3923 "" c1omnotes_1.nnpd[iptr - 1] += *nnsk; -#line 3934 "" +#line 3924 "" return 0; -#line 3935 "" +#line 3925 "" } -#line 3936 "" +#line 3926 "" } -#line 3937 "" +#line 3927 "" /* L16: */ -#line 3937 "" +#line 3927 "" } /* Didn't find current duration & squez, so add a new entry. */ /* No particular reason to keep in order, so add at the end. */ -#line 3942 "" +#line 3932 "" c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk; -#line 3943 "" +#line 3933 "" c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space; -#line 3944 "" +#line 3934 "" c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez; -#line 3945 "" +#line 3935 "" ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; -#line 3946 "" +#line 3936 "" return 0; } /* catspace_ */ @@ -9884,9 +9876,9 @@ L8: /* The only reason for this seemingly do-nothing function is to get around an */ /* apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! */ -#line 3953 "" +#line 3943 "" *(unsigned char *)ret_val = (char) (*n); -#line 3954 "" +#line 3944 "" return ; } /* chax_ */ @@ -9897,7 +9889,7 @@ L8: address a__1[3]; integer i__1, i__2[3], i__3; real r__1; - char ch__1[4], ch__2[1]; + char ch__1[1], ch__2[4]; icilist ici__1; /* Builtin functions */ @@ -9921,238 +9913,244 @@ L8: ftnlen, ftnlen); static char dynsymq[4]; -#line 3961 "" +#line 3951 "" txtdyn = FALSE_; /* On entry, iccount is on "D" */ -#line 3965 "" +#line 3955 "" i__1 = *iccount; -#line 3965 "" - if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 3955 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 3955 "" + if (s_cmp(lineq + i__1, ch__1, *iccount + 1 - i__1, (ftnlen)1) == 0) { /* Dynamic text */ -#line 3970 "" +#line 3960 "" istart = *iccount + 2; /* 1 past 1st quote */ -#line 3971 "" +#line 3961 "" L3: -#line 3972 "" - iend = i_indx(lineq + (istart - 1), "\"", 128 - (istart - 1), (ftnlen) - 1); -#line 3973 "" +#line 3962 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 3962 "" + iend = i_indx(lineq + (istart - 1), ch__1, 128 - (istart - 1), ( + ftnlen)1); +#line 3963 "" i__1 = istart + iend - 3; -#line 3973 "" - if (s_cmp(lineq + i__1, "\\", istart + iend - 2 - i__1, (ftnlen)1) == - 0) { -#line 3974 "" +#line 3963 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 3963 "" + if (s_cmp(lineq + i__1, ch__1, istart + iend - 2 - i__1, (ftnlen)1) == + 0) { +#line 3964 "" istart = *iccount + iend + 2; -#line 3975 "" +#line 3965 "" goto L3; -#line 3976 "" +#line 3966 "" } -#line 3977 "" +#line 3967 "" if (iend == 0) { -#line 3978 "" +#line 3968 "" i__1 = *iccount + 1; -#line 3978 "" +#line 3968 "" errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"\ "h double quote!", (ftnlen)128, (ftnlen)50); -#line 3980 "" +#line 3970 "" stop1_(); -#line 3981 "" +#line 3971 "" } /* Set iccount to character after 2nd ", and set ipm */ /* iccount = iccount+iend+2 */ -#line 3986 "" +#line 3976 "" *iccount = istart + iend; -#line 3987 "" +#line 3977 "" ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1); -#line 3988 "" +#line 3978 "" if (ipm == 0) { -#line 3989 "" +#line 3979 "" errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"\ "ere!", (ftnlen)128, (ftnlen)33); -#line 3991 "" +#line 3981 "" stop1_(); -#line 3992 "" +#line 3982 "" } -#line 3993 "" +#line 3983 "" } else { /* Expect ordinary dynamic */ -#line 3997 "" +#line 3987 "" for (iend = *iccount + 2; iend <= 128; ++iend) { -#line 3998 "" +#line 3988 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); -#line 3999 "" +#line 3989 "" if (ipm > 0) { -#line 3999 "" +#line 3989 "" goto L2; -#line 3999 "" +#line 3989 "" } -#line 4000 "" +#line 3990 "" /* L1: */ -#line 4000 "" +#line 3990 "" } -#line 4001 "" +#line 3991 "" L2: -#line 4002 "" +#line 3992 "" if (iend - *iccount > 5 || iend - *iccount < 2) { -#line 4003 "" +#line 3993 "" i__1 = iend - 1; -#line 4003 "" +#line 3993 "" errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", ( ftnlen)128, (ftnlen)30); -#line 4005 "" +#line 3995 "" stop1_(); -#line 4006 "" +#line 3996 "" } -#line 4007 "" +#line 3997 "" i__1 = *iccount; -#line 4007 "" +#line 3997 "" ici__1.icierr = 0; -#line 4007 "" +#line 3997 "" ici__1.iciend = 0; -#line 4007 "" +#line 3997 "" ici__1.icirnum = 1; -#line 4007 "" +#line 3997 "" ici__1.icirlen = iend - 1 - i__1; -#line 4007 "" +#line 3997 "" ici__1.iciunit = lineq + i__1; /* Writing concatenation */ -#line 4007 "" +#line 3997 "" i__2[0] = 2, a__1[0] = "(a"; -#line 4007 "" +#line 3997 "" i__3 = iend + 47 - *iccount; -#line 4007 "" - chax_(ch__2, (ftnlen)1, &i__3); -#line 4007 "" - i__2[1] = 1, a__1[1] = ch__2; -#line 4007 "" +#line 3997 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 3997 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 3997 "" i__2[2] = 1, a__1[2] = ")"; -#line 4007 "" - ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); -#line 4007 "" +#line 3997 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2); +#line 3997 "" s_rsfi(&ici__1); -#line 4007 "" +#line 3997 "" do_fio(&c__1, dynsymq, (ftnlen)4); -#line 4007 "" +#line 3997 "" e_rsfi(); -#line 4009 "" +#line 3999 "" idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "\ "> ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4; -#line 4012 "" +#line 4002 "" if (idno == 0) { -#line 4013 "" +#line 4003 "" i__1 = *iccount + 1; -#line 4013 "" +#line 4003 "" errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128, (ftnlen)21); -#line 4014 "" +#line 4004 "" stop1_(); -#line 4015 "" +#line 4005 "" } -#line 4016 "" +#line 4006 "" *iccount = iend; -#line 4017 "" +#line 4007 "" } -#line 4018 "" +#line 4008 "" if (ipm != 2) { /* There is a vertical shift, have "+" or "-" */ -#line 4022 "" +#line 4012 "" ++(*iccount); -#line 4023 "" +#line 4013 "" if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen) 1) == 0) { -#line 4024 "" +#line 4014 "" errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"\ "l offset!", (ftnlen)128, (ftnlen)42); -#line 4026 "" +#line 4016 "" stop1_(); -#line 4027 "" +#line 4017 "" } -#line 4028 "" +#line 4018 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 4029 "" +#line 4019 "" idno = i_nint(&fnum); -#line 4030 "" +#line 4020 "" if (idno > 63) { -#line 4031 "" +#line 4021 "" i__1 = *iccount - 1; -#line 4031 "" +#line 4021 "" errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"\ "st be (-63,63)!", (ftnlen)128, (ftnlen)50); -#line 4033 "" +#line 4023 "" stop1_(); -#line 4034 "" +#line 4024 "" } -#line 4035 "" +#line 4025 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); -#line 4036 "" +#line 4026 "" if (ipm == 0) { -#line 4037 "" +#line 4027 "" errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"\ "ere!", (ftnlen)128, (ftnlen)33); -#line 4039 "" +#line 4029 "" stop1_(); -#line 4040 "" +#line 4030 "" } -#line 4041 "" +#line 4031 "" if (ipm != 2) { /* There is a horizontal shift */ -#line 4045 "" +#line 4035 "" ++(*iccount); -#line 4046 "" +#line 4036 "" if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, ( ftnlen)1) == 0) { -#line 4047 "" +#line 4037 "" errmsg_(lineq, iccount, ibar, "Expected number here for hori"\ "zontal offset!", (ftnlen)128, (ftnlen)43); -#line 4049 "" +#line 4039 "" stop1_(); -#line 4050 "" +#line 4040 "" } -#line 4051 "" +#line 4041 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 4052 "" +#line 4042 "" r__1 = fnum * 10; -#line 4052 "" +#line 4042 "" idno = i_nint(&r__1); -#line 4053 "" +#line 4043 "" if (idno > 255) { -#line 4054 "" +#line 4044 "" i__1 = *iccount - 1; -#line 4054 "" +#line 4044 "" errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"\ "ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56); -#line 4056 "" +#line 4046 "" stop1_(); -#line 4057 "" +#line 4047 "" } else if (*(unsigned char *)durq != ' ') { -#line 4058 "" +#line 4048 "" errmsg_(lineq, iccount, ibar, "There should be a blank here!", (ftnlen)128, (ftnlen)29); -#line 4060 "" +#line 4050 "" stop1_(); -#line 4061 "" +#line 4051 "" } -#line 4062 "" +#line 4052 "" } /* iccount should be on the blank at the end of the entire symbol */ -#line 4066 "" +#line 4056 "" } -#line 4067 "" +#line 4057 "" return 0; } /* checkdyn_ */ @@ -10171,15 +10169,15 @@ L2: /* subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */ /* * icashft) */ -#line 4074 "" +#line 4064 "" /* Parameter adjustments */ -#line 4074 "" +#line 4064 "" --icrdat; -#line 4074 "" +#line 4064 "" -#line 4074 "" +#line 4064 "" /* Function Body */ -#line 4074 "" +#line 4064 "" found1 = FALSE_; /* icashft will be max left shift of accid's in chord notes. */ @@ -10187,19 +10185,19 @@ L2: /* Will include left shift of chord note itself. */ /* Rezero after use. */ -#line 4081 "" +#line 4071 "" i__1 = *ncrd; -#line 4081 "" +#line 4071 "" for (icrd = 1; icrd <= i__1; ++icrd) { /* This if block cycles thru all chord notes on ivx,ip; then returns. */ -#line 4085 "" +#line 4075 "" if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], ( ftnlen)-8)) == *ivx) { -#line 4087 "" +#line 4077 "" found1 = TRUE_; -#line 4088 "" +#line 4078 "" *iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test( icrdat[icrd],27); @@ -10223,19 +10221,19 @@ L2: /* if (irshft .lt. 64) icashft = max(icashft,64-irshft) */ /* end if */ /* end if */ -#line 4111 "" +#line 4101 "" *isarp = *isarp || bit_test(icrdat[icrd],25); -#line 4112 "" +#line 4102 "" } else if (found1) { -#line 4113 "" +#line 4103 "" return 0; -#line 4114 "" +#line 4104 "" } -#line 4115 "" +#line 4105 "" /* L18: */ -#line 4115 "" +#line 4105 "" } -#line 4116 "" +#line 4106 "" return 0; } /* chkarp_ */ @@ -10252,36 +10250,36 @@ L2: static cilist io___277 = { 0, 6, 0, "(a6,2x,4i8)", 0 }; -#line 4129 "" +#line 4119 "" if (commidi_1.imidi[*icm] >= 24576) { -#line 4130 "" +#line 4120 "" s_wsle(&io___275); -#line 4130 "" +#line 4120 "" e_wsle(); -#line 4131 "" +#line 4121 "" s_wsle(&io___276); -#line 4131 "" +#line 4121 "" do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"\ " worse", (ftnlen)52); -#line 4131 "" +#line 4121 "" e_wsle(); -#line 4132 "" +#line 4122 "" s_wsfe(&io___277); -#line 4132 "" +#line 4122 "" do_fio(&c__1, "imidi:", (ftnlen)6); -#line 4132 "" +#line 4122 "" do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer)); -#line 4132 "" +#line 4122 "" do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer)); -#line 4132 "" +#line 4122 "" do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer)); -#line 4132 "" +#line 4122 "" do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer)); -#line 4132 "" +#line 4122 "" e_wsfe(); -#line 4134 "" +#line 4124 "" } -#line 4135 "" +#line 4125 "" return 0; } /* chkimidi_ */ @@ -10319,223 +10317,223 @@ L2: /* otherwise next prior note. Relative to bottom line. */ /* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */ -#line 4157 "" +#line 4147 "" /* Parameter adjustments */ -#line 4157 "" +#line 4147 "" ipl -= 25; -#line 4157 "" +#line 4147 "" mult -= 25; -#line 4157 "" +#line 4147 "" --levbotr; -#line 4157 "" +#line 4147 "" --levtopr; -#line 4157 "" +#line 4147 "" nodur -= 25; -#line 4157 "" +#line 4147 "" nib -= 25; -#line 4157 "" +#line 4147 "" ivmx -= 25; -#line 4157 "" +#line 4147 "" nolev -= 25; -#line 4157 "" +#line 4147 "" irest -= 25; -#line 4157 "" +#line 4147 "" islur -= 25; -#line 4157 "" +#line 4147 "" --nn; -#line 4157 "" +#line 4147 "" -#line 4157 "" +#line 4147 "" /* Function Body */ -#line 4157 "" +#line 4147 "" if (*ip != nn[*ivx] && ! bit_test(ipl[*ivx + *ip * 24],1)) { /* Not the last note and not "look-left" for level */ -#line 4161 "" +#line 4151 "" i__1 = nn[*ivx]; -#line 4161 "" +#line 4151 "" for (kkp = *ip + 1; kkp <= i__1; ++kkp) { -#line 4162 "" +#line 4152 "" if (bit_test(islur[*ivx + kkp * 24],29)) { -#line 4162 "" +#line 4152 "" goto L4; -#line 4162 "" +#line 4152 "" } -#line 4163 "" +#line 4153 "" if (! bit_test(irest[*ivx + kkp * 24],0)) { -#line 4164 "" +#line 4154 "" levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; /* Relative to botto */ -#line 4165 "" +#line 4155 "" goto L9; -#line 4166 "" +#line 4156 "" } -#line 4167 "" +#line 4157 "" /* L8: */ -#line 4167 "" +#line 4157 "" } -#line 4168 "" +#line 4158 "" } -#line 4169 "" +#line 4159 "" L4: /* If here, there were no following notes or came to a blank rest, or */ /* "look-left" option set. So look before */ /* if (ip .eq. 1) go to 2 ! Get out if this is the first note. */ -#line 4175 "" +#line 4165 "" if (*ip == 1) { -#line 4175 "" +#line 4165 "" return 0; -#line 4175 "" +#line 4165 "" } /* Get out if this is the first note. */ -#line 4176 "" +#line 4166 "" for (kkp = *ip - 1; kkp >= 1; --kkp) { -#line 4177 "" +#line 4167 "" if (! bit_test(irest[*ivx + kkp * 24],0)) { -#line 4178 "" +#line 4168 "" levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; /* Relative to bottom */ -#line 4179 "" +#line 4169 "" goto L9; -#line 4180 "" +#line 4170 "" } -#line 4181 "" +#line 4171 "" /* L3: */ -#line 4181 "" +#line 4171 "" } /* go to 2 ! Pretty odd, should never be here, but get out if so. */ -#line 4183 "" +#line 4173 "" return 0; /* Pretty odd, should never be here, but get out if so. */ -#line 4184 "" +#line 4174 "" L9: /* Find note in other voice at same time */ -#line 4188 "" +#line 4178 "" i__1 = *ivx - *nv - 1; -#line 4188 "" +#line 4178 "" iupdown = i_sign(&c__1, &i__1); -#line 4189 "" +#line 4179 "" ivother = ivmx[*iv + (3 - iupdown) / 2 * 24]; -#line 4190 "" +#line 4180 "" tother = 0.f; -#line 4191 "" +#line 4181 "" i__1 = nib[ivother + *ibar * 24]; -#line 4191 "" +#line 4181 "" for (kkp = 1; kkp <= i__1; ++kkp) { -#line 4192 "" +#line 4182 "" if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) { -#line 4192 "" +#line 4182 "" goto L6; -#line 4192 "" +#line 4182 "" } -#line 4193 "" +#line 4183 "" tother += nodur[ivother + kkp * 24]; -#line 4194 "" +#line 4184 "" /* L5: */ -#line 4194 "" +#line 4184 "" } /* If here, then no note starts in other voice at same time, so set default */ -#line 4198 "" +#line 4188 "" levother = -iupdown * 50; -#line 4199 "" +#line 4189 "" goto L7; -#line 4200 "" +#line 4190 "" L6: /* If here, have just identified a simultaneous note or rest in other voice */ -#line 4204 "" +#line 4194 "" if (! bit_test(irest[ivother + kkp * 24],0)) { /* Not a rest, use it */ -#line 4205 "" +#line 4195 "" levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4; -#line 4206 "" +#line 4196 "" } else { -#line 4207 "" +#line 4197 "" if (nodur[ivother + kkp * 24] == nodur[*ivx + *ip * 24]) { /* Rest in other voice has same duration, get out (so defualt spacing is used) */ /* go to 2 */ -#line 4212 "" +#line 4202 "" return 0; -#line 4213 "" +#line 4203 "" } -#line 4214 "" +#line 4204 "" levother = -iupdown * 50; -#line 4215 "" +#line 4205 "" } -#line 4216 "" +#line 4206 "" L7: -#line 4217 "" +#line 4207 "" if (*mode == 1) { -#line 4218 "" +#line 4208 "" indxr = log2_(&nodur[*ivx + *ip * 24]) + 1; -#line 4219 "" +#line 4209 "" } else { /* nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */ -#line 4221 "" +#line 4211 "" indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1; -#line 4222 "" +#line 4212 "" } -#line 4223 "" +#line 4213 "" if (iupdown < 0) { -#line 4224 "" +#line 4214 "" levtop = levtopr[indxr]; -#line 4225 "" +#line 4215 "" iraise1 = levother - levtop - 3; /* Based on other note */ -#line 4226 "" +#line 4216 "" iraise2 = levnext - levtop; /* Based on following note */ -#line 4227 "" +#line 4217 "" if (indxr == 5 && levnext < 1) { -#line 4227 "" +#line 4217 "" iraise2 += 2; -#line 4227 "" +#line 4217 "" } -#line 4228 "" +#line 4218 "" iraise = min(iraise1,iraise2); -#line 4229 "" +#line 4219 "" if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) { -#line 4229 "" +#line 4219 "" --iraise; -#line 4229 "" +#line 4219 "" } -#line 4231 "" +#line 4221 "" } else { -#line 4232 "" +#line 4222 "" levbot = levbotr[indxr]; -#line 4233 "" +#line 4223 "" iraise1 = levother - levbot + 3; -#line 4234 "" +#line 4224 "" iraise2 = levnext - levbot; -#line 4235 "" +#line 4225 "" if (indxr == 5 && levnext > 8) { -#line 4235 "" +#line 4225 "" --iraise2; -#line 4235 "" +#line 4225 "" } -#line 4236 "" +#line 4226 "" iraise = max(iraise1,iraise2); -#line 4237 "" +#line 4227 "" if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) { -#line 4237 "" +#line 4227 "" --iraise; -#line 4237 "" +#line 4227 "" } -#line 4239 "" +#line 4229 "" } -#line 4240 "" +#line 4230 "" nolev[*ivx + *ip * 24] = iraise + 100; -#line 4241 "" +#line 4231 "" return 0; } /* chkkbdrests_ */ @@ -10552,80 +10550,80 @@ L7: extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, ftnlen); -#line 4246 "" +#line 4236 "" *literr = 0; -#line 4247 "" +#line 4237 "" itype = 1; -#line 4248 "" +#line 4238 "" L17: -#line 4248 "" +#line 4238 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 4249 "" +#line 4239 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 4249 "" +#line 4239 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { -#line 4250 "" +#line 4240 "" ++itype; -#line 4251 "" +#line 4241 "" if (itype > 3) { -#line 4252 "" +#line 4242 "" *literr = 1; -#line 4253 "" +#line 4243 "" return 0; -#line 4254 "" +#line 4244 "" } -#line 4255 "" +#line 4245 "" goto L17; -#line 4256 "" +#line 4246 "" } -#line 4257 "" +#line 4247 "" lenlit = itype; -#line 4258 "" +#line 4248 "" L18: -#line 4258 "" +#line 4248 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 4259 "" +#line 4249 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 4259 "" +#line 4249 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { -#line 4260 "" +#line 4250 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 4261 "" +#line 4251 "" if (*(unsigned char *)charq != ' ') { /* Starting a new tex command withing the string */ -#line 4265 "" +#line 4255 "" lenlit += 2; -#line 4266 "" +#line 4256 "" if (lenlit > 128) { -#line 4267 "" +#line 4257 "" *literr = 2; -#line 4268 "" +#line 4258 "" return 0; -#line 4269 "" +#line 4259 "" } -#line 4270 "" +#line 4260 "" goto L18; -#line 4271 "" +#line 4261 "" } -#line 4272 "" +#line 4262 "" } else { -#line 4273 "" +#line 4263 "" ++lenlit; -#line 4274 "" +#line 4264 "" if (lenlit > 128) { -#line 4275 "" +#line 4265 "" *literr = 2; -#line 4276 "" +#line 4266 "" return 0; -#line 4277 "" +#line 4267 "" } -#line 4278 "" +#line 4268 "" goto L18; -#line 4279 "" +#line 4269 "" } -#line 4280 "" +#line 4270 "" return 0; } /* chklit_ */ @@ -10657,11 +10655,11 @@ L18: /* numbers. If moved=.true., iccount on exit is on end of last number. */ /* If moved=.false., iccount still on +/- */ -#line 4293 "" +#line 4283 "" i__1 = *iccount - 2; -#line 4293 "" +#line 4283 "" i__2 = *iccount; -#line 4293 "" +#line 4283 "" if (i_indx("sfnA", lineq + i__1, (ftnlen)4, *iccount - 1 - i__1) > 0 && i_indx("0123456789.", lineq + i__2, (ftnlen)11, *iccount + 1 - i__2) > 0) { @@ -10669,100 +10667,100 @@ L18: /* Prior char was accid & next is #; this may be start of accidental shift. */ /* Must test for "." above in case we get "<" or ">" */ -#line 4299 "" +#line 4289 "" ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1) - 2; -#line 4300 "" +#line 4290 "" i__1 = *iccount + 1; -#line 4300 "" +#line 4290 "" i__2 = *iccount; -#line 4300 "" +#line 4290 "" if (s_cmp(lineq + i__2, ".", *iccount + 1 - i__2, (ftnlen)1) == 0 && i_indx("0123456789", lineq + i__1, (ftnlen)10, *iccount + 2 - i__1) == 0) { /* Rare case of [accid][+/-].[letter]. Bail out */ -#line 4305 "" +#line 4295 "" *moved = FALSE_; -#line 4306 "" +#line 4296 "" return 0; -#line 4307 "" +#line 4297 "" } -#line 4308 "" +#line 4298 "" ishorz = ipm > 1; /* Save iccount in case it's not accid shift and we have to reset. */ -#line 4312 "" +#line 4302 "" icsav = *iccount; -#line 4313 "" +#line 4303 "" ++(*iccount); -#line 4314 "" +#line 4304 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 4315 "" +#line 4305 "" if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* This has to be accidental shift. Set vert. shift. */ -#line 4319 "" +#line 4309 "" if (! ishorz) { /* +/- syntax, both shifts set, vertical first */ -#line 4323 "" +#line 4313 "" i__1 = (integer) (ipm * fnum + 32.5f); -#line 4323 "" +#line 4313 "" setbits_(nacc, &c__6, &c__4, &i__1); -#line 4324 "" +#line 4314 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; -#line 4325 "" +#line 4315 "" ++(*iccount); -#line 4326 "" +#line 4316 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 4327 "" +#line 4317 "" } else { /* syntax, only horiz set */ -#line 4331 "" +#line 4321 "" ipm += -3; -#line 4332 "" +#line 4322 "" } /* Set horiz. shift */ -#line 4336 "" +#line 4326 "" r__1 = (ipm * fnum + 5.35f) * 20; -#line 4336 "" +#line 4326 "" i__1 = i_nint(&r__1); -#line 4336 "" +#line 4326 "" setbits_(nacc, &c__7, &c__10, &i__1); -#line 4337 "" +#line 4327 "" --(*iccount); -#line 4338 "" +#line 4328 "" *moved = TRUE_; -#line 4339 "" +#line 4329 "" } else { /* False alarm. Reset everything and flow onward */ -#line 4343 "" +#line 4333 "" *moved = FALSE_; -#line 4344 "" +#line 4334 "" *iccount = icsav; -#line 4345 "" +#line 4335 "" } -#line 4346 "" +#line 4336 "" } else { /* Either prior char was not 'sfn' or next was not digit, so take no action */ -#line 4350 "" +#line 4340 "" *moved = FALSE_; -#line 4351 "" +#line 4341 "" } -#line 4352 "" +#line 4342 "" return 0; } /* chkpm4ac_ */ @@ -10785,62 +10783,62 @@ L18: /* Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */ -#line 4360 "" +#line 4350 "" *nclef = lbit_shift(*isl, (ftnlen)-12) & 7; -#line 4361 "" +#line 4351 "" if (*nclef == 0) { /* treble */ -#line 4365 "" +#line 4355 "" nlev = 2; -#line 4366 "" +#line 4356 "" } else if (*nclef > 6) { /* French violin */ -#line 4370 "" +#line 4360 "" nlev = 0; -#line 4371 "" +#line 4361 "" } else if (*nclef < 5) { /* C-clef */ -#line 4375 "" +#line 4365 "" nlev = (*nclef << 1) - 2; -#line 4376 "" +#line 4366 "" } else { /* F-clef */ -#line 4380 "" +#line 4370 "" nlev = (*nclef << 1) - 6; -#line 4381 "" +#line 4371 "" } /* Writing concatenation */ -#line 4382 "" +#line 4372 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 4382 "" +#line 4372 "" i__1[0] = 1, a__1[0] = ch__1; -#line 4382 "" +#line 4372 "" i__1[1] = 7, a__1[1] = "pmxclef"; -#line 4382 "" +#line 4372 "" i__2 = min(*nclef,7) + 48; -#line 4382 "" +#line 4372 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 4382 "" +#line 4372 "" i__1[2] = 1, a__1[2] = ch__2; -#line 4382 "" +#line 4372 "" i__3 = nlev + 48; -#line 4382 "" +#line 4372 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 4382 "" +#line 4372 "" i__1[3] = 1, a__1[3] = ch__3; -#line 4382 "" +#line 4372 "" s_cat(notexq, a__1, i__1, &c__4, notexq_len); -#line 4384 "" +#line 4374 "" *lnote = 10; -#line 4385 "" +#line 4375 "" return 0; } /* clefsym_ */ @@ -10915,17 +10913,17 @@ L18: /* icrdot(icrd)(27-29) = level rank of chord-note among accid-notes */ /* twooftwo will be true 2nd time thru; signal to store shifts w/ notes */ -#line 4412 "" +#line 4402 "" /* Parameter adjustments */ -#line 4412 "" +#line 4402 "" --ksegrb0; -#line 4412 "" +#line 4402 "" segrb0 -= 3; -#line 4412 "" +#line 4402 "" --micrd; -#line 4412 "" +#line 4402 "" -#line 4412 "" +#line 4402 "" /* Function Body */ /* Fancy sharp boundary. fl,sh,na,dfl,dsh */ @@ -10942,152 +10940,152 @@ L18: /* Set up barrier segrb(iseg,ipoint) to define coords of corner points */ /* on stem+notes */ -#line 4443 "" +#line 4433 "" i__1 = *nsegrb0; -#line 4443 "" +#line 4433 "" for (iseg = 1; iseg <= i__1; ++iseg) { -#line 4444 "" +#line 4434 "" segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1]; -#line 4445 "" +#line 4435 "" segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2]; -#line 4446 "" +#line 4436 "" ksegrb[iseg - 1] = ksegrb0[iseg]; -#line 4447 "" +#line 4437 "" /* L11: */ -#line 4447 "" +#line 4437 "" } -#line 4448 "" +#line 4438 "" nsegrb = *nsegrb0; -#line 4449 "" +#line 4439 "" *rmsshift = 0.f; -#line 4450 "" +#line 4440 "" shiftmin = 1e3f; -#line 4451 "" +#line 4441 "" i__1 = *naccid; -#line 4451 "" +#line 4441 "" for (iwa = 1; iwa <= i__1; ++iwa) { /* Initialize shift for this note */ -#line 4455 "" +#line 4445 "" shift = 0.f; -#line 4456 "" +#line 4446 "" mainnote = micrd[iwa] == 0; -#line 4457 "" +#line 4447 "" isetshft[iwa - 1] = -1; /* Get note level and accidental type */ -#line 4461 "" +#line 4451 "" if (mainnote) { -#line 4462 "" +#line 4452 "" nolev = *nolevm; -#line 4463 "" +#line 4453 "" iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1]; -#line 4464 "" +#line 4454 "" } else { -#line 4465 "" +#line 4455 "" nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, & c__12); -#line 4466 "" +#line 4456 "" iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], & c__3, &c__20) - 1]; -#line 4467 "" +#line 4457 "" } /* Cycle thru segments on right edge of this accidental */ -#line 4471 "" +#line 4461 "" i__2 = nsegar[iacctype - 1] - 1; -#line 4471 "" +#line 4461 "" for (isega = 1; isega <= i__2; ++isega) { -#line 4472 "" +#line 4462 "" ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16]; -#line 4473 "" +#line 4463 "" ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 - 16]; /* Cycle thru segments of right-hand barrier */ -#line 4477 "" +#line 4467 "" i__3 = nsegrb - 1; -#line 4477 "" +#line 4467 "" for (isegrb = 1; isegrb <= i__3; ++isegrb) { /* Must find all barrier segments that start below ytopseg & end above ybotseg */ -#line 4481 "" +#line 4471 "" if (segrb[(isegrb << 1) - 1] < ytopaseg) { /* Barrier seg starts below top of accid */ /* Check if barrier seg ends above bottom of accid */ -#line 4486 "" +#line 4476 "" if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) { -#line 4487 "" +#line 4477 "" if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype + ((isega << 1) + 1) * 5 - 16]) { -#line 4489 "" +#line 4479 "" shift = segrb[(isegrb << 1) - 2] - segar[iacctype + ((isega << 1) + 1) * 5 - 16]; /* Record the cause of the shift */ -#line 4493 "" +#line 4483 "" isetshft[iwa - 1] = ksegrb[isegrb - 1]; -#line 4494 "" +#line 4484 "" } -#line 4495 "" +#line 4485 "" } /* Does barrier segment end above top of accid seg? */ -#line 4499 "" +#line 4489 "" if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) { -#line 4499 "" +#line 4489 "" goto L4; -#line 4499 "" +#line 4489 "" } -#line 4500 "" +#line 4490 "" } -#line 4501 "" +#line 4491 "" /* L3: */ -#line 4501 "" +#line 4491 "" } -#line 4502 "" +#line 4492 "" L4: -#line 4503 "" +#line 4493 "" /* L2: */ -#line 4503 "" +#line 4493 "" ; -#line 4503 "" +#line 4493 "" } -#line 4504 "" +#line 4494 "" if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) { /* if (nolev .eq. levmaxacc) then */ -#line 4507 "" +#line 4497 "" if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) { -#line 4508 "" +#line 4498 "" *rmsshift = 1e3f; -#line 4509 "" +#line 4499 "" return 0; -#line 4510 "" +#line 4500 "" } /* Does the following properly account for left-shifted noteheads? */ /* Top-down rank of this note we just shifted */ -#line 4516 "" +#line 4506 "" if (mainnote) { -#line 4517 "" +#line 4507 "" irank = *icrdot0; -#line 4518 "" +#line 4508 "" } else { -#line 4519 "" +#line 4509 "" irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, & c__27); -#line 4520 "" +#line 4510 "" } /* Compare level-rank of this note vs. that of note that caused the shift. */ @@ -11100,264 +11098,264 @@ L4: /* icrd: Chord-note accidental */ /* isetshft(i),i=1,naccid: what set shift for this accid, same codes */ -#line 4532 "" +#line 4522 "" if (isetshft[iwa - 1] < 0) { -#line 4533 "" +#line 4523 "" iranksetter = 0; -#line 4534 "" +#line 4524 "" } else if (isetshft[iwa - 1] == 0) { -#line 4535 "" +#line 4525 "" iranksetter = *icrdot0; -#line 4536 "" +#line 4526 "" } else { -#line 4537 "" +#line 4527 "" iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1] - 1], &c__3, &c__27); -#line 4538 "" +#line 4528 "" } -#line 4539 "" +#line 4529 "" if (iranksetter != 0 && irank != iranksetter + 1) { -#line 4540 "" +#line 4530 "" *rmsshift = 1e3f; -#line 4541 "" +#line 4531 "" return 0; -#line 4542 "" +#line 4532 "" } -#line 4543 "" +#line 4533 "" } /* Computing 2nd power */ -#line 4544 "" +#line 4534 "" r__1 = shift; -#line 4544 "" +#line 4534 "" *rmsshift += r__1 * r__1; -#line 4545 "" +#line 4535 "" if (*lasttime && dabs(shift) > 1e-4f) { -#line 4546 "" +#line 4536 "" if (mainnote) { -#line 4547 "" +#line 4537 "" if (! bit_test(*nacc,29)) { -#line 4547 "" +#line 4537 "" goto L10; -#line 4547 "" +#line 4537 "" } -#line 4548 "" +#line 4538 "" } else { -#line 4549 "" +#line 4539 "" if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) { -#line 4549 "" +#line 4539 "" goto L10; -#line 4549 "" +#line 4539 "" } -#line 4550 "" +#line 4540 "" } /* If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there */ /* was a manual shift but auto-shift was zero, will not come thru here, but shift value */ /* will be left intact. */ -#line 4556 "" +#line 4546 "" if (mainnote) { -#line 4557 "" +#line 4547 "" shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f; -#line 4558 "" +#line 4548 "" } else { -#line 4559 "" +#line 4549 "" shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, &c__20) - 107) * .05f; -#line 4560 "" +#line 4550 "" } -#line 4561 "" +#line 4551 "" L10: -#line 4562 "" +#line 4552 "" if (*twooftwo) { /* Record the shift for this accidental */ -#line 4566 "" +#line 4556 "" if (shift < -5.35f) { -#line 4567 "" +#line 4557 "" printl_(" ", (ftnlen)1); -#line 4568 "" +#line 4558 "" printl_("WARNING: auto-generated accidental shift too bi"\ "g for PMX, ignoring", (ftnlen)66); -#line 4570 "" +#line 4560 "" } else { -#line 4571 "" +#line 4561 "" r__1 = (shift + 5.35f) * 20; -#line 4571 "" +#line 4561 "" ishift = i_nint(&r__1); -#line 4572 "" +#line 4562 "" if (mainnote) { -#line 4573 "" +#line 4563 "" setbits_(nacc, &c__7, &c__10, &ishift); -#line 4574 "" +#line 4564 "" } else { -#line 4575 "" +#line 4565 "" setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, & c__20, &ishift); -#line 4576 "" +#line 4566 "" } -#line 4577 "" +#line 4567 "" } -#line 4578 "" +#line 4568 "" } else { /* This is the earlier call to precrd, so need minimum shift */ -#line 4582 "" +#line 4572 "" shiftmin = dmin(shiftmin,shift); -#line 4583 "" +#line 4573 "" } -#line 4584 "" +#line 4574 "" } /* Bail out if this is the last accidental to check */ -#line 4588 "" +#line 4578 "" if (iwa == *naccid) { -#line 4588 "" +#line 4578 "" goto L1; -#line 4588 "" +#line 4578 "" } /* Add this accidental to the right barrier! Count down from highest barrier segment, */ /* find 1st one starting below top of accid, and first one starting below bot. */ -#line 4593 "" +#line 4583 "" for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) { -#line 4594 "" +#line 4584 "" if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + (( nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) { -#line 4596 "" +#line 4586 "" for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) { -#line 4597 "" +#line 4587 "" if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype + 4]) { -#line 4597 "" +#line 4587 "" goto L6; -#line 4597 "" +#line 4587 "" } -#line 4599 "" +#line 4589 "" /* L9: */ -#line 4599 "" +#line 4589 "" } -#line 4600 "" +#line 4590 "" s_wsle(&io___324); -#line 4600 "" +#line 4590 "" do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6); -#line 4600 "" +#line 4590 "" e_wsle(); -#line 4601 "" +#line 4591 "" stop1_(); -#line 4602 "" +#line 4592 "" } -#line 4603 "" +#line 4593 "" /* L5: */ -#line 4603 "" +#line 4593 "" } -#line 4604 "" +#line 4594 "" s_wsle(&io___325); -#line 4604 "" +#line 4594 "" do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16); -#line 4604 "" +#line 4594 "" e_wsle(); -#line 4605 "" +#line 4595 "" stop1_(); -#line 4606 "" +#line 4596 "" L6: -#line 4607 "" +#line 4597 "" netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot; /* Shift high segments up */ -#line 4611 "" +#line 4601 "" if (netgain >= 0) { -#line 4612 "" +#line 4602 "" i__2 = ibelowtop + 1; -#line 4612 "" +#line 4602 "" for (isegrb = nsegrb; isegrb >= i__2; --isegrb) { -#line 4613 "" +#line 4603 "" segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; -#line 4614 "" +#line 4604 "" segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; -#line 4615 "" +#line 4605 "" ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; -#line 4616 "" +#line 4606 "" /* L7: */ -#line 4616 "" +#line 4606 "" } /* Set up 1st segment above accid */ -#line 4620 "" +#line 4610 "" segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - 2]; -#line 4621 "" +#line 4611 "" segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; -#line 4623 "" +#line 4613 "" ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; -#line 4624 "" +#line 4614 "" } else { /* netgain<0, must remove segments. Use same coding but reverse order, */ /* work from bottom up */ -#line 4629 "" +#line 4619 "" segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - 2]; -#line 4630 "" +#line 4620 "" segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; -#line 4632 "" +#line 4622 "" ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; -#line 4633 "" +#line 4623 "" i__2 = nsegrb; -#line 4633 "" +#line 4623 "" for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) { -#line 4634 "" +#line 4624 "" segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; -#line 4635 "" +#line 4625 "" segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; -#line 4636 "" +#line 4626 "" ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; -#line 4637 "" +#line 4627 "" /* L12: */ -#line 4637 "" +#line 4627 "" } -#line 4638 "" +#line 4628 "" } /* Insert new segments */ -#line 4642 "" +#line 4632 "" i__2 = nsegal[iacctype - 1] - 1; -#line 4642 "" +#line 4632 "" for (isega = 1; isega <= i__2; ++isega) { -#line 4643 "" +#line 4633 "" segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + (( isega << 1) + 1) * 5 - 16]; -#line 4644 "" +#line 4634 "" segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + (( isega << 1) + 2) * 5 - 16]; -#line 4645 "" +#line 4635 "" if (mainnote) { -#line 4646 "" +#line 4636 "" ksegrb[ibelowbot + isega - 1] = 0; -#line 4647 "" +#line 4637 "" } else { -#line 4648 "" +#line 4638 "" ksegrb[ibelowbot + isega - 1] = micrd[iwa]; -#line 4649 "" +#line 4639 "" } -#line 4650 "" +#line 4640 "" /* L8: */ -#line 4650 "" +#line 4640 "" } /* Update number of barrier segments */ -#line 4654 "" +#line 4644 "" nsegrb += netgain; /* c */ /* c Temporary printout for boundary segments as built up */ @@ -11368,23 +11366,23 @@ L6: /* write(15,'(a/(2i5))')' micrd isetshft', */ /* * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */ /* c */ -#line 4664 "" +#line 4654 "" L1: -#line 4664 "" +#line 4654 "" ; -#line 4664 "" +#line 4654 "" } /* next accidental */ -#line 4665 "" +#line 4655 "" if (*lasttime && ! (*twooftwo)) { /* This is the final call on the pre-ask pass, so compute left-shift rqmt. */ -#line 4669 "" +#line 4659 "" r__1 = shiftmin * -20; -#line 4669 "" +#line 4659 "" *icashft = i_nint(&r__1); -#line 4670 "" +#line 4660 "" } /* c */ /* c Temporary printout for boundary segments */ @@ -11397,7 +11395,7 @@ L1: /* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */ /* end if */ /* c */ -#line 4682 "" +#line 4672 "" return 0; } /* crdacc_ */ @@ -11467,27 +11465,27 @@ L1: /* Initialize right-barrier */ -#line 4722 "" +#line 4712 "" /* Parameter adjustments */ -#line 4722 "" +#line 4712 "" --kicrd; -#line 4722 "" +#line 4712 "" -#line 4722 "" +#line 4712 "" /* Function Body */ -#line 4722 "" +#line 4712 "" segrb0[0] = 0.f; -#line 4723 "" +#line 4713 "" segrb0[1] = -1e3f; -#line 4724 "" +#line 4714 "" segrb0[2] = 0.f; -#line 4725 "" +#line 4715 "" segrb0[3] = 1e3f; -#line 4726 "" +#line 4716 "" nsegrb0 = 2; -#line 4727 "" +#line 4717 "" ksegrb0[0] = -1; -#line 4728 "" +#line 4718 "" ksegrb0[1] = -1; /* Search for left-shifted notes, Make up the initial right-barrier, which */ @@ -11495,124 +11493,124 @@ L1: /* irest()(27) is set if any notes are left-shifted */ /* Must use ALL chord notes, not just ones w/ accid's. */ -#line 4735 "" +#line 4725 "" if (bit_test(*irest,27)) { -#line 4736 "" +#line 4726 "" i__1 = comtrill_1.icrd2; -#line 4736 "" +#line 4726 "" for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) { -#line 4737 "" +#line 4727 "" if (icrd == comtrill_1.icrd1 - 1) { /* Main note */ /* lshift = btest(ipl,8) */ -#line 4742 "" +#line 4732 "" lshift = bit_test(*ipl,8) || bit_test(*nacc,31); -#line 4743 "" +#line 4733 "" if (lshift) { -#line 4743 "" +#line 4733 "" nolev = *nolevm; -#line 4743 "" +#line 4733 "" } -#line 4744 "" +#line 4734 "" } else { /* Chord note */ -#line 4748 "" +#line 4738 "" lshift = bit_test(comtrill_1.icrdat[icrd - 1],23); /* if (lshift) nolev = igetbits(icrdat(icrd),7,12) */ -#line 4750 "" +#line 4740 "" if (lshift) { -#line 4751 "" +#line 4741 "" nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, & c__12); -#line 4752 "" +#line 4742 "" if (bit_test(*nacc,31) && nolev == *nolevm + 1) { /* This note is not really shifted, It is the upper of a 2nd with the main */ /* note on an upstem, and Main note must be shifted. */ /* nacc(31) signals the real truth. */ -#line 4758 "" +#line 4748 "" lshift = FALSE_; -#line 4759 "" +#line 4749 "" } -#line 4760 "" +#line 4750 "" } -#line 4761 "" +#line 4751 "" } -#line 4762 "" +#line 4752 "" if (lshift) { -#line 4763 "" +#line 4753 "" i__2 = nsegrb0 - 1; -#line 4763 "" +#line 4753 "" for (isegrb = 1; isegrb <= i__2; ++isegrb) { -#line 4764 "" +#line 4754 "" if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) { /* Add this notehead to the right boundary here. Move all higher segs up 2. */ -#line 4768 "" +#line 4758 "" i__3 = isegrb + 1; -#line 4768 "" +#line 4758 "" for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) { -#line 4769 "" +#line 4759 "" segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1) - 2]; -#line 4770 "" +#line 4760 "" segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1) - 1]; -#line 4771 "" +#line 4761 "" ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1]; -#line 4772 "" +#line 4762 "" /* L17: */ -#line 4772 "" +#line 4762 "" } -#line 4773 "" +#line 4763 "" goto L18; -#line 4774 "" +#line 4764 "" } -#line 4775 "" +#line 4765 "" /* L16: */ -#line 4775 "" +#line 4765 "" } -#line 4776 "" +#line 4766 "" L18: /* Insert notehead into list. Set kseg=-2 to signal notehead shift. */ -#line 4780 "" +#line 4770 "" iiseg = isegrb + 1; -#line 4781 "" +#line 4771 "" segrb0[(iiseg << 1) - 2] = -1.2f; -#line 4782 "" +#line 4772 "" segrb0[(iiseg << 1) - 1] = nolev - 1.f; -#line 4783 "" +#line 4773 "" ksegrb0[iiseg - 1] = -2; -#line 4784 "" +#line 4774 "" segrb0[(iiseg + 1 << 1) - 2] = 0.f; -#line 4785 "" +#line 4775 "" segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f; -#line 4786 "" +#line 4776 "" ksegrb0[iiseg] = -1; -#line 4787 "" +#line 4777 "" nsegrb0 += 2; -#line 4788 "" +#line 4778 "" } -#line 4789 "" +#line 4779 "" /* L15: */ -#line 4789 "" +#line 4779 "" } -#line 4790 "" +#line 4780 "" } /* Done setting right barrier for left-shifted noteheads */ -#line 4794 "" +#line 4784 "" tagged = FALSE_; -#line 4795 "" +#line 4785 "" manual = FALSE_; /* Preprocess to check for manual shifts. */ @@ -11626,302 +11624,302 @@ L18: /* End if */ /* End if */ -#line 4808 "" +#line 4798 "" maxmanshft = 0; -#line 4809 "" +#line 4799 "" i__1 = *naccid; -#line 4809 "" +#line 4799 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4810 "" +#line 4800 "" if (kicrd[i__] == 0) { /* Main note */ -#line 4814 "" +#line 4804 "" manshft = igetbits_(nacc, &c__7, &c__10); -#line 4815 "" +#line 4805 "" if (manshft != 0) { -#line 4816 "" +#line 4806 "" manual = TRUE_; -#line 4817 "" +#line 4807 "" if (bit_test(*nacc,29)) { -#line 4818 "" +#line 4808 "" tagged = TRUE_; -#line 4819 "" +#line 4809 "" } else { /* maxmanshft = max(maxmanshft,64-manshft) */ /* Computing MAX */ -#line 4821 "" +#line 4811 "" i__2 = maxmanshft, i__3 = 107 - manshft; -#line 4821 "" +#line 4811 "" maxmanshft = max(i__2,i__3); -#line 4822 "" +#line 4812 "" } -#line 4823 "" +#line 4813 "" } -#line 4824 "" +#line 4814 "" } else { /* Chord note */ -#line 4828 "" +#line 4818 "" manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & c__20); -#line 4829 "" +#line 4819 "" if (manshft != 0) { -#line 4830 "" +#line 4820 "" manual = TRUE_; -#line 4831 "" +#line 4821 "" if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { -#line 4832 "" +#line 4822 "" tagged = TRUE_; -#line 4833 "" +#line 4823 "" } else { /* maxmanshft = max(maxmanshft,64-manshft) */ /* Computing MAX */ -#line 4835 "" +#line 4825 "" i__2 = maxmanshft, i__3 = 107 - manshft; -#line 4835 "" +#line 4825 "" maxmanshft = max(i__2,i__3); -#line 4836 "" +#line 4826 "" } -#line 4837 "" +#line 4827 "" } -#line 4838 "" +#line 4828 "" } -#line 4839 "" +#line 4829 "" /* L13: */ -#line 4839 "" +#line 4829 "" } -#line 4840 "" +#line 4830 "" if (manual) { -#line 4841 "" +#line 4831 "" if (tagged) { /* zero out all untagged shifts */ -#line 4845 "" +#line 4835 "" i__1 = *naccid; -#line 4845 "" +#line 4835 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4846 "" +#line 4836 "" if (kicrd[i__] == 0) { -#line 4847 "" +#line 4837 "" if (! bit_test(*nacc,29)) { -#line 4847 "" +#line 4837 "" setbits_(nacc, &c__7, &c__10, &c__0); -#line 4847 "" +#line 4837 "" } -#line 4848 "" +#line 4838 "" } else { -#line 4849 "" +#line 4839 "" if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { -#line 4849 "" +#line 4839 "" setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & c__20, &c__0); -#line 4849 "" +#line 4839 "" } -#line 4851 "" +#line 4841 "" } -#line 4852 "" +#line 4842 "" /* L14: */ -#line 4852 "" +#line 4842 "" } -#line 4853 "" +#line 4843 "" } else { /* There are manual shifts but none tagged. Only proceed if "Ao" was entered */ -#line 4857 "" +#line 4847 "" if (! bit_test(*nacc,28)) { -#line 4858 "" +#line 4848 "" *icashft = maxmanshft; -#line 4859 "" +#line 4849 "" return 0; -#line 4860 "" +#line 4850 "" } -#line 4861 "" +#line 4851 "" } -#line 4862 "" +#line 4852 "" } -#line 4863 "" +#line 4853 "" if (bit_test(*nacc,28)) { /* Take the accidentals in order as originally input, then exit. */ -#line 4867 "" +#line 4857 "" crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); -#line 4869 "" +#line 4859 "" return 0; /* end if */ -#line 4871 "" +#line 4861 "" } else if (*naccid == 3) { /* Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd */ /* then place in order top, bottom, middle. */ -#line 4876 "" +#line 4866 "" for (i__ = 1; i__ <= 3; ++i__) { -#line 4877 "" +#line 4867 "" if (kicrd[i__] == 0) { -#line 4878 "" +#line 4868 "" irank = *icrdot0; -#line 4879 "" +#line 4869 "" nolev = *nolevm; -#line 4880 "" +#line 4870 "" } else { -#line 4881 "" +#line 4871 "" irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, & c__27); -#line 4882 "" +#line 4872 "" nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, & c__12); -#line 4883 "" +#line 4873 "" } -#line 4884 "" +#line 4874 "" if (irank == 1) { -#line 4885 "" +#line 4875 "" micrd[0] = kicrd[i__]; -#line 4886 "" +#line 4876 "" } else { -#line 4887 "" +#line 4877 "" micrd[5 - irank - 1] = kicrd[i__]; -#line 4888 "" +#line 4878 "" } -#line 4889 "" +#line 4879 "" if (irank == 2) { -#line 4890 "" +#line 4880 "" levmidacc = nolev; -#line 4891 "" +#line 4881 "" } -#line 4892 "" +#line 4882 "" /* L20: */ -#line 4892 "" +#line 4882 "" } -#line 4893 "" +#line 4883 "" if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) { -#line 4895 "" +#line 4885 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); -#line 4897 "" +#line 4887 "" return 0; -#line 4898 "" +#line 4888 "" } -#line 4899 "" +#line 4889 "" } -#line 4900 "" +#line 4890 "" rmsmin = 1e5f; /* Initialize permutation array */ -#line 4904 "" +#line 4894 "" i__1 = *naccid; -#line 4904 "" +#line 4894 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4905 "" +#line 4895 "" iperm[i__ - 1] = i__; -#line 4906 "" +#line 4896 "" /* L7: */ -#line 4906 "" +#line 4896 "" } /* Start looping over permutations */ -#line 4910 "" +#line 4900 "" for (ip = 1; ip <= 5041; ++ip) { -#line 4911 "" +#line 4901 "" if (ip != 1) { /* Work the magic algorithm to get the next permutation */ -#line 4915 "" +#line 4905 "" for (k = *naccid - 1; k >= 1; --k) { -#line 4916 "" +#line 4906 "" if (iperm[k - 1] <= iperm[k]) { -#line 4916 "" +#line 4906 "" goto L2; -#line 4916 "" +#line 4906 "" } -#line 4917 "" +#line 4907 "" /* L1: */ -#line 4917 "" +#line 4907 "" } /* If here, we just got the last permutation, so exit the loop over permutations */ -#line 4921 "" +#line 4911 "" goto L10; -#line 4922 "" +#line 4912 "" L2: -#line 4923 "" +#line 4913 "" for (j = *naccid; j >= 1; --j) { -#line 4924 "" +#line 4914 "" if (iperm[k - 1] <= iperm[j - 1]) { -#line 4924 "" +#line 4914 "" goto L4; -#line 4924 "" +#line 4914 "" } -#line 4925 "" +#line 4915 "" /* L3: */ -#line 4925 "" +#line 4915 "" } -#line 4926 "" +#line 4916 "" L4: -#line 4927 "" +#line 4917 "" it = iperm[j - 1]; -#line 4928 "" +#line 4918 "" iperm[j - 1] = iperm[k - 1]; -#line 4929 "" +#line 4919 "" iperm[k - 1] = it; -#line 4930 "" +#line 4920 "" is = k + 1; -#line 4931 "" +#line 4921 "" for (ir = *naccid; ir >= 1; --ir) { -#line 4932 "" +#line 4922 "" if (ir <= is) { -#line 4932 "" +#line 4922 "" goto L6; -#line 4932 "" +#line 4922 "" } -#line 4933 "" +#line 4923 "" it = iperm[ir - 1]; -#line 4934 "" +#line 4924 "" iperm[ir - 1] = iperm[is - 1]; -#line 4935 "" +#line 4925 "" iperm[is - 1] = it; -#line 4936 "" +#line 4926 "" ++is; -#line 4937 "" +#line 4927 "" /* L5: */ -#line 4937 "" +#line 4927 "" } -#line 4938 "" +#line 4928 "" L6: -#line 4939 "" +#line 4929 "" ; -#line 4939 "" +#line 4929 "" } /* New we have a permutation. Take icrd values out of kicrd and put them into */ /* micrd in the order of the permutation */ -#line 4944 "" +#line 4934 "" i__1 = *naccid; -#line 4944 "" +#line 4934 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4945 "" +#line 4935 "" micrd[i__ - 1] = kicrd[iperm[i__ - 1]]; -#line 4946 "" +#line 4936 "" /* L9: */ -#line 4946 "" +#line 4936 "" } /* c */ /* c Temporary printout */ /* c */ /* write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */ /* c */ -#line 4952 "" +#line 4942 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc, icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); /* c */ @@ -11929,61 +11927,61 @@ L6: /* c */ /* write(15,*)'perm done, rmsshift:',rmsshift */ /* c */ -#line 4959 "" +#line 4949 "" if (rmsshift < rmsmin) { /* Save this permutation, reset minrms */ -#line 4963 "" +#line 4953 "" i__1 = *naccid; -#line 4963 "" +#line 4953 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4964 "" +#line 4954 "" ipermsav[i__ - 1] = iperm[i__ - 1]; -#line 4965 "" +#line 4955 "" rmsmin = rmsshift; -#line 4966 "" +#line 4956 "" /* L11: */ -#line 4966 "" +#line 4956 "" } -#line 4967 "" +#line 4957 "" } -#line 4968 "" +#line 4958 "" /* L8: */ -#line 4968 "" +#line 4958 "" } -#line 4969 "" +#line 4959 "" s_wsle(&io___354); -#line 4969 "" +#line 4959 "" do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24); -#line 4969 "" +#line 4959 "" e_wsle(); -#line 4970 "" +#line 4960 "" stop1_(); -#line 4971 "" +#line 4961 "" L10: /* Done looping, get info for the final choice */ -#line 4975 "" +#line 4965 "" i__1 = *naccid; -#line 4975 "" +#line 4965 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 4976 "" +#line 4966 "" micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]]; -#line 4977 "" +#line 4967 "" /* L12: */ -#line 4977 "" +#line 4967 "" } /* c */ /* c Temporary printout */ /* c */ /* write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */ /* c */ -#line 4983 "" +#line 4973 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); -#line 4985 "" +#line 4975 "" return 0; } /* crdaccs_ */ @@ -12017,191 +12015,191 @@ L10: static char acsymq[3]; static integer lnoten; -#line 4993 "" +#line 4983 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 4993 "" +#line 4983 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 4994 "" +#line 4984 "" if (*ihshft == -107) { -#line 4994 "" +#line 4984 "" *ihshft = 0; -#line 4994 "" +#line 4984 "" } /* c */ /* c If main note shifted left, so shift accid. Terminate below, when acc. is done. */ /* c */ -#line 4998 "" +#line 4988 "" if (*ihshft != 0) { /* Accid must be shifted horizontally */ -#line 5002 "" +#line 4992 "" if (*ihshft < 0) { /* Writing concatenation */ -#line 5003 "" +#line 4993 "" i__1[0] = 1, a__1[0] = sq; -#line 5003 "" +#line 4993 "" i__1[1] = 8, a__1[1] = "loffset{"; -#line 5003 "" +#line 4993 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5004 "" +#line 4994 "" *ihshft = -(*ihshft); -#line 5005 "" +#line 4995 "" } else { /* Writing concatenation */ -#line 5006 "" +#line 4996 "" i__1[0] = 1, a__1[0] = sq; -#line 5006 "" +#line 4996 "" i__1[1] = 8, a__1[1] = "roffset{"; -#line 5006 "" +#line 4996 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5007 "" +#line 4997 "" } -#line 5008 "" +#line 4998 "" hshft = *ihshft * .05f; -#line 5009 "" +#line 4999 "" if (hshft < 1.f) { -#line 5010 "" +#line 5000 "" ici__1.icierr = 0; -#line 5010 "" +#line 5000 "" ici__1.icirnum = 1; -#line 5010 "" +#line 5000 "" ici__1.icirlen = 3; -#line 5010 "" +#line 5000 "" ici__1.iciunit = notexq + 9; -#line 5010 "" +#line 5000 "" ici__1.icifmt = "(f3.2)"; -#line 5010 "" +#line 5000 "" s_wsfi(&ici__1); -#line 5010 "" +#line 5000 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); -#line 5010 "" +#line 5000 "" e_wsfi(); -#line 5011 "" +#line 5001 "" *lnote = 12; -#line 5012 "" +#line 5002 "" } else { -#line 5013 "" +#line 5003 "" ici__1.icierr = 0; -#line 5013 "" +#line 5003 "" ici__1.icirnum = 1; -#line 5013 "" +#line 5003 "" ici__1.icirlen = 4; -#line 5013 "" +#line 5003 "" ici__1.iciunit = notexq + 9; -#line 5013 "" +#line 5003 "" ici__1.icifmt = "(f4.2)"; -#line 5013 "" +#line 5003 "" s_wsfi(&ici__1); -#line 5013 "" +#line 5003 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); -#line 5013 "" +#line 5003 "" e_wsfi(); -#line 5014 "" +#line 5004 "" *lnote = 13; -#line 5015 "" +#line 5005 "" } /* Writing concatenation */ -#line 5016 "" +#line 5006 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 5016 "" +#line 5006 "" i__2[1] = 2, a__2[1] = "}{"; -#line 5016 "" +#line 5006 "" i__2[2] = 1, a__2[2] = sq; -#line 5016 "" +#line 5006 "" s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); -#line 5017 "" +#line 5007 "" *lnote += 3; -#line 5018 "" +#line 5008 "" } else { -#line 5019 "" +#line 5009 "" s_copy(notexq, sq, (ftnlen)79, (ftnlen)1); -#line 5020 "" +#line 5010 "" *lnote = 1; -#line 5021 "" +#line 5011 "" } -#line 5022 "" +#line 5012 "" if (bit_test(*nacc,3)) { /* Writing concatenation */ -#line 5023 "" +#line 5013 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 5023 "" +#line 5013 "" i__1[1] = 3, a__1[1] = "big"; -#line 5023 "" +#line 5013 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5024 "" +#line 5014 "" *lnote += 3; -#line 5025 "" +#line 5015 "" } -#line 5026 "" +#line 5016 "" if (*caut) { /* Cautionary accidental. Need to define bigcna,... in pmx.tex */ /* Writing concatenation */ -#line 5030 "" +#line 5020 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 5030 "" +#line 5020 "" i__1[1] = 1, a__1[1] = "c"; -#line 5030 "" +#line 5020 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5031 "" +#line 5021 "" ++(*lnote); -#line 5032 "" +#line 5022 "" } -#line 5033 "" +#line 5023 "" accsym_(nacc, acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ -#line 5034 "" +#line 5024 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 5034 "" +#line 5024 "" i__1[1] = lacc, a__1[1] = acsymq; -#line 5034 "" +#line 5024 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5035 "" +#line 5025 "" *lnote += lacc; -#line 5036 "" +#line 5026 "" noleva = *nolev; -#line 5037 "" +#line 5027 "" if (*ivshft != 0) { -#line 5037 "" +#line 5027 "" noleva = noleva + *ivshft - 32; -#line 5037 "" +#line 5027 "" } -#line 5038 "" +#line 5028 "" notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8); -#line 5039 "" +#line 5029 "" if (lnoten == 1) { -#line 5039 "" +#line 5029 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 5039 "" +#line 5029 "" } /* Writing concatenation */ -#line 5040 "" +#line 5030 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 5040 "" +#line 5030 "" i__1[1] = lnoten, a__1[1] = noteq; -#line 5040 "" +#line 5030 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5041 "" +#line 5031 "" *lnote += lnoten; -#line 5042 "" +#line 5032 "" if (*ihshft != 0) { /* Terminate horizontal shift */ /* Writing concatenation */ -#line 5046 "" +#line 5036 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 5046 "" +#line 5036 "" i__1[1] = 1, a__1[1] = "}"; -#line 5046 "" +#line 5036 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 5047 "" +#line 5037 "" ++(*lnote); -#line 5048 "" +#line 5038 "" } -#line 5049 "" +#line 5039 "" return 0; } /* doacc_ */ @@ -12280,43 +12278,43 @@ L10: /* Set counter (for this note) for chord notes present. Set notmain=T. */ /* Will test for notmain=.true. in addmidi to tell whether to save pitch. */ -#line 5103 "" +#line 5093 "" /* Parameter adjustments */ -#line 5103 "" +#line 5093 "" irest -= 25; -#line 5103 "" +#line 5093 "" --nornb; -#line 5103 "" +#line 5093 "" ihornb -= 25; -#line 5103 "" +#line 5093 "" ulq -= 25; -#line 5103 "" +#line 5093 "" -#line 5103 "" +#line 5093 "" /* Function Body */ -#line 5103 "" +#line 5093 "" commidi_1.nmidcrd = 0; -#line 5104 "" +#line 5094 "" commidi_1.notmain = TRUE_; -#line 5105 "" +#line 5095 "" commidi_1.crdacc = FALSE_; -#line 5106 "" +#line 5096 "" i__1 = comtrill_1.icrd2; -#line 5106 "" +#line 5096 "" for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) { -#line 5107 "" +#line 5097 "" lnote = 0; -#line 5108 "" +#line 5098 "" nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12); /* 3/8/03 save original pitch to use in midi, in case 2nds alter things. */ -#line 5112 "" +#line 5102 "" nolevo = nolev; /* Check for special situations with 2nds (see precrd). */ -#line 5116 "" +#line 5106 "" if (bit_test(*nacc,30) && nolev == *nolevm - 1) { /* Upstem, 2nd with upper as main, interchange pitches, */ @@ -12324,87 +12322,87 @@ L10: /* if dotted, probably had shifted dot, dot parameters must be moved */ /* from chord to main */ -#line 5123 "" +#line 5113 "" nolev = *nolevm; -#line 5124 "" +#line 5114 "" if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { /* Orig. chord note dot shift, must transfer to main. */ -#line 5128 "" +#line 5118 "" icrdotsav = comtrill_1.icrdot[icrd - 1]; -#line 5129 "" +#line 5119 "" icrdatsav = comtrill_1.icrdat[icrd - 1]; -#line 5130 "" +#line 5120 "" if (bit_test(irest[*ivx + *ip * 24],19)) { /* Main note (upper) had a dot shift, must move it to chord */ -#line 5134 "" +#line 5124 "" setbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__26, & c__1); -#line 5135 "" +#line 5125 "" r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] * 10; -#line 5135 "" +#line 5125 "" i__2 = i_nint(&r__1) + 64; -#line 5135 "" +#line 5125 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, & i__2); -#line 5137 "" +#line 5127 "" r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] * 10; -#line 5137 "" +#line 5127 "" i__2 = i_nint(&r__1) + 64; -#line 5137 "" +#line 5127 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, & i__2); /* May need to worry about other chord params (accid shefts etc) later */ -#line 5142 "" +#line 5132 "" } else { -#line 5143 "" +#line 5133 "" comtrill_1.icrdat[icrd - 1] = bit_clear(comtrill_1.icrdat[ icrd - 1],26); -#line 5144 "" +#line 5134 "" } /* We are adding a main note dot shift, so push any later ones back */ -#line 5149 "" +#line 5139 "" if (! bit_test(irest[*ivx + *ip * 24],19)) { -#line 5150 "" +#line 5140 "" ++comcc_1.maxdotmv[*ivx - 1]; -#line 5151 "" +#line 5141 "" i__2 = comcc_1.ndotmv[*ivx - 1] + 2; -#line 5151 "" +#line 5141 "" for (indm = comcc_1.maxdotmv[*ivx - 1]; indm >= i__2; --indm) { -#line 5152 "" +#line 5142 "" comcc_1.updot[*ivx + indm * 24 - 25] = comcc_1.updot[* ivx + (indm - 1) * 24 - 25]; -#line 5153 "" +#line 5143 "" comcc_1.rtdot[*ivx + indm * 24 - 25] = comcc_1.rtdot[* ivx + (indm - 1) * 24 - 25]; -#line 5154 "" +#line 5144 "" /* L1: */ -#line 5154 "" +#line 5144 "" } -#line 5155 "" +#line 5145 "" } -#line 5156 "" +#line 5146 "" irest[*ivx + *ip * 24] = bit_set(irest[*ivx + *ip * 24],19); -#line 5157 "" +#line 5147 "" comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = ((127 & icrdotsav) - 64) * .1f; -#line 5158 "" +#line 5148 "" comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) - 64) * .1f; -#line 5160 "" +#line 5150 "" } -#line 5161 "" +#line 5151 "" } else if (bit_test(*nacc,31) && nolev == *nolevm + 1) { /* Downstem, 2nd with lower as main, interchange pitches, */ @@ -12412,63 +12410,63 @@ L10: /* probably had shifted dot, dot parameters must be moved from */ /* main to chord */ -#line 5168 "" +#line 5158 "" nolev = *nolevm; -#line 5169 "" +#line 5159 "" if (bit_test(irest[*ivx + *ip * 24],19)) { -#line 5170 "" +#line 5160 "" icrdotsav = comtrill_1.icrdot[icrd - 1]; -#line 5171 "" +#line 5161 "" icrdatsav = comtrill_1.icrdat[icrd - 1]; -#line 5172 "" +#line 5162 "" comtrill_1.icrdat[icrd - 1] = bit_set(comtrill_1.icrdat[icrd - 1],26); /* bits in icrdot */ /* 0-6 10*abs(vertical dot shift in \internote) + 64 */ /* 7-13 10*abs(horizontal dot shift in \internote) + 64 */ /* Assuming >0 for now! */ -#line 5177 "" +#line 5167 "" r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] * 10; -#line 5177 "" +#line 5167 "" i__2 = i_nint(&r__1) + 64; -#line 5177 "" +#line 5167 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &i__2); -#line 5179 "" +#line 5169 "" r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] * 10; -#line 5179 "" +#line 5169 "" i__2 = i_nint(&r__1) + 64; -#line 5179 "" +#line 5169 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, &i__2); /* Must also set dot shift for (now) main note (orig. chord note). */ -#line 5184 "" +#line 5174 "" if (bit_test(icrdatsav,26)) { -#line 5185 "" +#line 5175 "" comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = ((127 & icrdotsav) - 64) * .1f; -#line 5186 "" +#line 5176 "" comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) - 64) * .1f; -#line 5188 "" +#line 5178 "" } else { /* No dot move on original chord (now main) note, */ -#line 5192 "" +#line 5182 "" comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = 0.f; -#line 5193 "" +#line 5183 "" comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] = 0.f; -#line 5194 "" +#line 5184 "" } -#line 5195 "" +#line 5185 "" } -#line 5196 "" +#line 5186 "" } /* Lower dot for lower-voice notes?. Conditions are: */ @@ -12478,282 +12476,282 @@ L10: /* 4. Not a rest (cannot be a rest in a chord!) */ /* . 5. Flag (lowdot) is set to true */ -#line 5205 "" +#line 5195 "" if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) { -#line 5206 "" +#line 5196 "" i__2 = log2_(nodu); -#line 5206 "" +#line 5196 "" if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) { -#line 5207 "" +#line 5197 "" if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { /* Note already in movdot list. Drop by 2. */ -#line 5211 "" +#line 5201 "" i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, & c__0) - 20; -#line 5211 "" +#line 5201 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, & i__2); -#line 5213 "" +#line 5203 "" } else { /* Not in list so just move it right now */ -#line 5217 "" +#line 5207 "" i__2 = igetbits_(islur, &c__1, &c__3); -#line 5217 "" +#line 5207 "" dotmov_(&c_b1007, &c_b1008, soutq, lsout, &i__2, (ftnlen) 80); -#line 5218 "" +#line 5208 "" } -#line 5219 "" +#line 5209 "" } -#line 5220 "" +#line 5210 "" } -#line 5221 "" +#line 5211 "" if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { /* Move the dot. Basic call for chord notes, not main note. */ -#line 5225 "" +#line 5215 "" updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f; -#line 5226 "" +#line 5216 "" rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen) -7)) - 64) * .1f; -#line 5227 "" +#line 5217 "" i__2 = igetbits_(islur, &c__1, &c__3); -#line 5227 "" +#line 5217 "" dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80); -#line 5228 "" +#line 5218 "" } -#line 5229 "" +#line 5219 "" isleft = bit_test(comtrill_1.icrdat[icrd - 1],23); -#line 5230 "" +#line 5220 "" isright = bit_test(comtrill_1.icrdat[icrd - 1],24); /* Check for ornament in chord. */ -#line 5234 "" +#line 5224 "" if (comtrill_1.icrdorn[icrd - 1] > 0) { -#line 5235 "" +#line 5225 "" putorn_(&comtrill_1.icrdorn[icrd - 1], &nolev, nolevm, nodu, & nornb[1], ulq + 25, ibmcnt, ivx, ncm, islur, nvmx, nv, & ihornb[25], stemlen, outq, &lout, ip, &c__0, beamon, & c_true, (ftnlen)1, (ftnlen)79); -#line 5238 "" +#line 5228 "" addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80); -#line 5239 "" +#line 5229 "" } /* Chord-note symbol. First check for breve */ -#line 5243 "" +#line 5233 "" if (*nodu == 128) { /* Writing concatenation */ -#line 5244 "" +#line 5234 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5244 "" +#line 5234 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5244 "" +#line 5234 "" i__3[1] = 6, a__1[1] = "zbreve"; -#line 5244 "" +#line 5234 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5245 "" +#line 5235 "" lsym = 7; -#line 5246 "" +#line 5236 "" } else { /* Not a breve chord. Get first letters in chord-note symbol */ -#line 5250 "" +#line 5240 "" if (isleft) { /* Writing concatenation */ -#line 5251 "" +#line 5241 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5251 "" +#line 5241 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5251 "" +#line 5241 "" i__3[1] = 1, a__1[1] = "l"; -#line 5251 "" +#line 5241 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5252 "" +#line 5242 "" } else if (isright) { /* Writing concatenation */ -#line 5253 "" +#line 5243 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5253 "" +#line 5243 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5253 "" +#line 5243 "" i__3[1] = 1, a__1[1] = "r"; -#line 5253 "" +#line 5243 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5254 "" +#line 5244 "" } else { /* Writing concatenation */ -#line 5255 "" +#line 5245 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5255 "" +#line 5245 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5255 "" +#line 5245 "" i__3[1] = 1, a__1[1] = "z"; -#line 5255 "" +#line 5245 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5256 "" +#line 5246 "" } -#line 5257 "" +#line 5247 "" if (*nodu >= 64) { /* Writing concatenation */ -#line 5258 "" +#line 5248 "" i__3[0] = 2, a__1[0] = nosymq; -#line 5258 "" +#line 5248 "" i__3[1] = 1, a__1[1] = "w"; -#line 5258 "" +#line 5248 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5259 "" +#line 5249 "" } else if (*nodu >= 32) { /* Writing concatenation */ -#line 5260 "" +#line 5250 "" i__3[0] = 2, a__1[0] = nosymq; -#line 5260 "" +#line 5250 "" i__3[1] = 1, a__1[1] = "h"; -#line 5260 "" +#line 5250 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5261 "" +#line 5251 "" } else { /* Writing concatenation */ -#line 5262 "" +#line 5252 "" i__3[0] = 2, a__1[0] = nosymq; -#line 5262 "" +#line 5252 "" i__3[1] = 1, a__1[1] = "q"; -#line 5262 "" +#line 5252 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5263 "" +#line 5253 "" } -#line 5264 "" +#line 5254 "" i__2 = log2_(nodu); -#line 5264 "" +#line 5254 "" if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) { -#line 5265 "" +#line 5255 "" lsym = 3; -#line 5266 "" +#line 5256 "" } else if (! bit_test(*islur,3) || *dotxtup) { /* Single dot */ /* Writing concatenation */ -#line 5270 "" +#line 5260 "" i__3[0] = 3, a__1[0] = nosymq; -#line 5270 "" +#line 5260 "" i__3[1] = 1, a__1[1] = "p"; -#line 5270 "" +#line 5260 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5271 "" +#line 5261 "" lsym = 4; -#line 5272 "" +#line 5262 "" } else { /* Double dot */ /* Writing concatenation */ -#line 5276 "" +#line 5266 "" i__3[0] = 3, a__1[0] = nosymq; -#line 5276 "" +#line 5266 "" i__3[1] = 2, a__1[1] = "pp"; -#line 5276 "" +#line 5266 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); -#line 5277 "" +#line 5267 "" lsym = 5; -#line 5278 "" +#line 5268 "" } -#line 5279 "" +#line 5269 "" } -#line 5280 "" +#line 5270 "" if (bit_test(comtrill_1.icrdat[icrd - 1],19) && ! bit_test( comtrill_1.icrdat[icrd - 1],27)) { /* Accidental and not MIDI-only. Build up bits 0-3 of nacc */ -#line 5284 "" +#line 5274 "" nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); /* Kluge for bigness. Only means 'As' has not been issued */ -#line 5288 "" +#line 5278 "" if (spfacs_1.bacfac != 1e6f) { -#line 5288 "" +#line 5278 "" nactmp += 8; -#line 5288 "" +#line 5278 "" } -#line 5289 "" +#line 5279 "" i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) - 107; -#line 5289 "" +#line 5279 "" i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14); -#line 5289 "" +#line 5279 "" i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12); -#line 5289 "" +#line 5279 "" i__6 = ncmid_(iv, ip); -#line 5289 "" +#line 5279 "" L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31); -#line 5289 "" +#line 5279 "" doacc_(&i__2, &i__4, notexq, &lnote, &nactmp, &i__5, &i__6, &L__1, (ftnlen)79); /* * notexq,lnote,nactmp,nolev,ncmid(iv,ip)) */ /* Get original nolev, not altered to deal with 2nds */ /* * ncmid(iv,ip)) */ /* Writing concatenation */ -#line 5296 "" +#line 5286 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5296 "" +#line 5286 "" i__3[1] = 7, a__1[1] = nosymq; -#line 5296 "" +#line 5286 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5297 "" +#line 5287 "" commidi_1.crdacc = TRUE_; -#line 5298 "" +#line 5288 "" } else { -#line 5299 "" +#line 5289 "" s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7); -#line 5300 "" +#line 5290 "" } -#line 5301 "" +#line 5291 "" lnote += lsym; /* Get note name (again if accid, due to possible octave jump) */ -#line 5305 "" +#line 5295 "" notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8); -#line 5306 "" +#line 5296 "" if (lnoten == 1) { -#line 5306 "" +#line 5296 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 5306 "" +#line 5296 "" } /* Put in note name */ /* Writing concatenation */ -#line 5310 "" +#line 5300 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5310 "" +#line 5300 "" i__3[1] = 8, a__1[1] = noteq; -#line 5310 "" +#line 5300 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5311 "" +#line 5301 "" lnote += lnoten; -#line 5312 "" +#line 5302 "" if (bit_test(comtrill_1.icrdat[icrd - 1],25)) { /* Arpeggio signal */ -#line 5316 "" +#line 5306 "" putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80); -#line 5317 "" +#line 5307 "" } -#line 5318 "" +#line 5308 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); -#line 5319 "" +#line 5309 "" if (commidi_1.ismidi) { /* Here is where we collect MIDI pitch info for the chord note. By checking */ @@ -12761,53 +12759,53 @@ L10: /* pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() */ /* for MAIN note, will put in note codes for all chord notes + main note. */ -#line 5326 "" +#line 5316 "" kv = 1; -#line 5327 "" +#line 5317 "" if (*ivx > *iv) { -#line 5327 "" +#line 5317 "" kv = 2; -#line 5327 "" +#line 5317 "" } -#line 5328 "" +#line 5318 "" ++commidi_1.nmidcrd; -#line 5329 "" +#line 5319 "" if (commidi_1.nmidcrd > 20) { -#line 5330 "" +#line 5320 "" s_wsle(&io___382); -#line 5330 "" +#line 5320 "" e_wsle(); -#line 5331 "" +#line 5321 "" s_wsle(&io___383); -#line 5331 "" +#line 5321 "" do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"\ "ocessor", (ftnlen)45); -#line 5331 "" +#line 5321 "" e_wsle(); -#line 5332 "" +#line 5322 "" stop1_(); -#line 5333 "" +#line 5323 "" } /* Use original saved pitch level, unaltered by 2nds logic. */ -#line 5337 "" +#line 5327 "" i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1] - 1]; -#line 5337 "" +#line 5327 "" i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); -#line 5337 "" +#line 5327 "" addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, & commidisig_1.midisig, &c_b1053, &c_false, &c_false); -#line 5340 "" +#line 5330 "" } -#line 5341 "" +#line 5331 "" /* L5: */ -#line 5341 "" +#line 5331 "" } -#line 5342 "" +#line 5332 "" commidi_1.notmain = FALSE_; -#line 5343 "" +#line 5333 "" return 0; } /* docrd_ */ @@ -12882,196 +12880,196 @@ L10: /* Inputs are array *elements* except ihornb,nornb,ulq */ -#line 5371 "" +#line 5361 "" /* Parameter adjustments */ -#line 5371 "" +#line 5361 "" ulq -= 25; -#line 5371 "" +#line 5361 "" --nornb; -#line 5371 "" +#line 5361 "" ihornb -= 25; -#line 5371 "" +#line 5361 "" -#line 5371 "" +#line 5361 "" /* Function Body */ -#line 5372 "" +#line 5362 "" numdyn = 0; /* Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values */ /* in idynn(1...4) */ -#line 5377 "" +#line 5367 "" i__1 = comdyn_1.ndyn; -#line 5377 "" +#line 5367 "" for (idyn = 1; idyn <= i__1; ++idyn) { -#line 5378 "" +#line 5368 "" ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(& comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4); -#line 5380 "" +#line 5370 "" if (ivxtent == *ivx) { -#line 5381 "" +#line 5371 "" iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4); -#line 5382 "" +#line 5372 "" if (iptent == *ip) { -#line 5383 "" +#line 5373 "" ++numdyn; -#line 5384 "" +#line 5374 "" idynn[numdyn - 1] = idyn; -#line 5385 "" +#line 5375 "" } else if (iptent > *ip) { /* I don't think there are any more possible for this ivx,ip, so exit loop */ -#line 5389 "" +#line 5379 "" goto L2; -#line 5390 "" +#line 5380 "" } -#line 5391 "" +#line 5381 "" } -#line 5392 "" +#line 5382 "" /* L1: */ -#line 5392 "" +#line 5382 "" } -#line 5393 "" +#line 5383 "" L2: /* At this point there is a list of idyn's in idynn(1...numdyn) */ /* Compute level, and stem-dir'n-based horizontal tweaks */ -#line 5398 "" +#line 5388 "" hoffsd = 0.f; /* Set upstem to false as default */ -#line 5402 "" +#line 5392 "" upstem = FALSE_; -#line 5403 "" +#line 5393 "" if (bit_test(*irest,0)) { /* It's a rest. Assume it doesn't go below the staff */ -#line 5407 "" +#line 5397 "" lbot = *ncm - 4; -#line 5408 "" +#line 5398 "" } else if (! (*beamon)) { -#line 5409 "" +#line 5399 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv); -#line 5409 "" +#line 5399 "" if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) { -#line 5410 "" +#line 5400 "" upstem = TRUE_; -#line 5411 "" +#line 5401 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ -#line 5412 "" +#line 5402 "" i__1 = *nolev - 1, i__2 = *ncm - 4; -#line 5412 "" +#line 5402 "" lbot = min(i__1,i__2); -#line 5413 "" +#line 5403 "" } else { /* Computing MIN */ -#line 5414 "" +#line 5404 "" i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; -#line 5414 "" +#line 5404 "" lbot = min(i__1,i__2); -#line 5415 "" +#line 5405 "" } -#line 5416 "" +#line 5406 "" } else { -#line 5417 "" +#line 5407 "" hoffsd = -.5f; -#line 5418 "" +#line 5408 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ -#line 5419 "" +#line 5409 "" i__1 = *nolev - 7, i__2 = *ncm - 4; -#line 5419 "" +#line 5409 "" lbot = min(i__1,i__2); -#line 5420 "" +#line 5410 "" } else { /* Computing MIN */ -#line 5421 "" +#line 5411 "" i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4; -#line 5421 "" +#line 5411 "" lbot = min(i__1,i__2); -#line 5422 "" +#line 5412 "" } -#line 5423 "" +#line 5413 "" } -#line 5424 "" +#line 5414 "" } else { -#line 5425 "" +#line 5415 "" if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { -#line 5426 "" +#line 5416 "" upstem = TRUE_; -#line 5427 "" +#line 5417 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ -#line 5428 "" +#line 5418 "" i__1 = *nolev - 1, i__2 = *ncm - 4; -#line 5428 "" +#line 5418 "" lbot = min(i__1,i__2); -#line 5429 "" +#line 5419 "" } else { /* Computing MIN */ -#line 5430 "" +#line 5420 "" i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; -#line 5430 "" +#line 5420 "" lbot = min(i__1,i__2); -#line 5431 "" +#line 5421 "" } -#line 5432 "" +#line 5422 "" } else { -#line 5433 "" +#line 5423 "" hoffsd = -.5f; /* 171230 Desperation */ /* lbot = ihornb(ivx,nornb(ivx))+1 */ -#line 5437 "" +#line 5427 "" if (nornb[*ivx] == 0) { -#line 5438 "" +#line 5428 "" lbot = 1; -#line 5439 "" +#line 5429 "" } else { -#line 5440 "" +#line 5430 "" lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1; -#line 5441 "" +#line 5431 "" } -#line 5442 "" +#line 5432 "" if (lbot == 1) { /* Kluge for non-beamed, down xtup, for which ihorb was never set. */ /* Assumes stem is shortened. */ -#line 5447 "" +#line 5437 "" lbot = *nolev - 5; -#line 5448 "" +#line 5438 "" } -#line 5449 "" +#line 5439 "" ++nornb[*ivx]; -#line 5450 "" +#line 5440 "" } -#line 5451 "" +#line 5441 "" } -#line 5452 "" +#line 5442 "" lbot += -5; -#line 5453 "" +#line 5443 "" jtxtdyn1 = 1; /* Now ready to loop over current dyn's */ -#line 5457 "" +#line 5447 "" i__1 = numdyn; -#line 5457 "" +#line 5447 "" for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) { -#line 5458 "" +#line 5448 "" idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1]; -#line 5459 "" +#line 5449 "" idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1]; -#line 5460 "" +#line 5450 "" idno = igetbits_(&idynd, &c__4, &c__12); /* ivx = iand(15,idynd) */ -#line 5462 "" +#line 5452 "" *ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4); /* Build the command into notex in stages. Insert name & rq'd args in order: */ @@ -13087,366 +13085,366 @@ L2: /* d-mark */ /* X */ -#line 5477 "" +#line 5467 "" if (idno == 0) { /* Text-dynamic */ /* Writing concatenation */ -#line 5481 "" +#line 5471 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5481 "" +#line 5471 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5481 "" +#line 5471 "" i__3[1] = 6, a__1[1] = "txtdyn"; -#line 5481 "" +#line 5471 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5482 "" +#line 5472 "" lnote = 7; -#line 5483 "" +#line 5473 "" } else if (idno <= 12) { /* Letter-group */ /* Writing concatenation */ -#line 5487 "" +#line 5477 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5487 "" +#line 5477 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5487 "" +#line 5477 "" i__3[1] = 6, a__1[1] = "pmxdyn"; -#line 5487 "" +#line 5477 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5488 "" +#line 5478 "" lnote = 7; -#line 5489 "" +#line 5479 "" } else if (comslur_1.fontslur) { -#line 5490 "" +#line 5480 "" lnote = 7; -#line 5491 "" +#line 5481 "" if (idno == 13) { /* Start a font-based hairpin */ /* Writing concatenation */ -#line 5495 "" +#line 5485 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5495 "" +#line 5485 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5495 "" +#line 5485 "" i__3[1] = 6, a__1[1] = "hpstrt"; -#line 5495 "" +#line 5485 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5496 "" +#line 5486 "" } else if (idno == 14) { /* End crescendo */ /* Writing concatenation */ -#line 5500 "" +#line 5490 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5500 "" +#line 5490 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5500 "" +#line 5490 "" i__3[1] = 6, a__1[1] = "hpcend"; -#line 5500 "" +#line 5490 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5501 "" +#line 5491 "" } else { /* End decrescendo */ /* Writing concatenation */ -#line 5505 "" +#line 5495 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5505 "" +#line 5495 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5505 "" +#line 5495 "" i__3[1] = 6, a__1[1] = "hpdend"; -#line 5505 "" +#line 5495 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5506 "" +#line 5496 "" } /* Put in voice number as ID for font-based hairpin */ -#line 5510 "" +#line 5500 "" if (*ivx <= 9) { /* Writing concatenation */ -#line 5511 "" +#line 5501 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5511 "" +#line 5501 "" *(unsigned char *)&ch__1[0] = *ivx + 48; -#line 5511 "" +#line 5501 "" i__3[1] = 1, a__1[1] = ch__1; -#line 5511 "" +#line 5501 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5512 "" +#line 5502 "" ++lnote; -#line 5513 "" +#line 5503 "" } else if (*ivx <= 19) { /* Writing concatenation */ -#line 5514 "" +#line 5504 "" i__4[0] = lnote, a__2[0] = notexq; -#line 5514 "" +#line 5504 "" i__4[1] = 2, a__2[1] = "{1"; -#line 5514 "" +#line 5504 "" *(unsigned char *)&ch__1[0] = *ivx + 38; -#line 5514 "" +#line 5504 "" i__4[2] = 1, a__2[2] = ch__1; -#line 5514 "" +#line 5504 "" i__4[3] = 1, a__2[3] = "}"; -#line 5514 "" +#line 5504 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 5515 "" +#line 5505 "" lnote += 4; -#line 5516 "" +#line 5506 "" } else { /* Writing concatenation */ -#line 5517 "" +#line 5507 "" i__4[0] = lnote, a__2[0] = notexq; -#line 5517 "" +#line 5507 "" i__4[1] = 2, a__2[1] = "{2"; -#line 5517 "" +#line 5507 "" *(unsigned char *)&ch__1[0] = *ivx + 28; -#line 5517 "" +#line 5507 "" i__4[2] = 1, a__2[2] = ch__1; -#line 5517 "" +#line 5507 "" i__4[3] = 1, a__2[3] = "}"; -#line 5517 "" +#line 5507 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 5518 "" +#line 5508 "" lnote += 4; -#line 5519 "" +#line 5509 "" } -#line 5520 "" +#line 5510 "" } else { /* Postscript hairpins */ -#line 5524 "" +#line 5514 "" lnote = 7; -#line 5525 "" +#line 5515 "" if (idno == 13) { /* Writing concatenation */ -#line 5526 "" +#line 5516 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5526 "" +#line 5516 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5526 "" +#line 5516 "" i__3[1] = 6, a__1[1] = "Icresc"; -#line 5526 "" +#line 5516 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5527 "" +#line 5517 "" } else if (idno == 14) { /* Writing concatenation */ -#line 5528 "" +#line 5518 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5528 "" +#line 5518 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5528 "" +#line 5518 "" i__3[1] = 8, a__1[1] = "Idecresc"; -#line 5528 "" +#line 5518 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5529 "" +#line 5519 "" lnote = 9; -#line 5530 "" +#line 5520 "" } else { /* Writing concatenation */ -#line 5531 "" +#line 5521 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5531 "" +#line 5521 "" i__3[0] = 1, a__1[0] = ch__1; -#line 5531 "" +#line 5521 "" i__3[1] = 6, a__1[1] = "Tcresc"; -#line 5531 "" +#line 5521 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5532 "" +#line 5522 "" } -#line 5533 "" +#line 5523 "" if (idno <= 14) { /* Get and record ID no for start of ps hairpin */ /* Find first unused ID */ -#line 5538 "" +#line 5528 "" for (idh = 1; idh <= 24; ++idh) { -#line 5539 "" +#line 5529 "" if (! bit_test(comhair_1.ihairuse,idh)) { -#line 5539 "" +#line 5529 "" goto L9; -#line 5539 "" +#line 5529 "" } -#line 5540 "" +#line 5530 "" /* L8: */ -#line 5540 "" +#line 5530 "" } -#line 5541 "" +#line 5531 "" printl_("Bad place in putdyn, call Dr. Don", (ftnlen)33); -#line 5542 "" +#line 5532 "" stop1_(); -#line 5543 "" +#line 5533 "" L9: -#line 5544 "" +#line 5534 "" comhair_1.ihairuse = bit_set(comhair_1.ihairuse,idh); -#line 5545 "" +#line 5535 "" comhair_1.idhair[*ivx - 1] = idh; -#line 5546 "" +#line 5536 "" } else { /* Unrecord ID no for end of ps hairpin */ -#line 5550 "" +#line 5540 "" setbits_(&comhair_1.ihairuse, &c__1, &comhair_1.idhair[*ivx - 1], &c__0); -#line 5551 "" +#line 5541 "" } /* Write ID # for start or end of ps hairpin */ -#line 5555 "" +#line 5545 "" idh = comhair_1.idhair[*ivx - 1]; -#line 5556 "" +#line 5546 "" if (idh <= 9) { /* Writing concatenation */ -#line 5557 "" +#line 5547 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5557 "" +#line 5547 "" *(unsigned char *)&ch__1[0] = idh + 48; -#line 5557 "" +#line 5547 "" i__3[1] = 1, a__1[1] = ch__1; -#line 5557 "" +#line 5547 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5558 "" +#line 5548 "" ++lnote; -#line 5559 "" +#line 5549 "" } else if (idh <= 19) { /* Writing concatenation */ -#line 5560 "" +#line 5550 "" i__4[0] = lnote, a__2[0] = notexq; -#line 5560 "" +#line 5550 "" i__4[1] = 2, a__2[1] = "{1"; -#line 5560 "" +#line 5550 "" *(unsigned char *)&ch__1[0] = idh + 38; -#line 5560 "" +#line 5550 "" i__4[2] = 1, a__2[2] = ch__1; -#line 5560 "" +#line 5550 "" i__4[3] = 1, a__2[3] = "}"; -#line 5560 "" +#line 5550 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 5561 "" +#line 5551 "" lnote += 4; -#line 5562 "" +#line 5552 "" } else { /* Writing concatenation */ -#line 5563 "" +#line 5553 "" i__4[0] = lnote, a__2[0] = notexq; -#line 5563 "" +#line 5553 "" i__4[1] = 2, a__2[1] = "{2"; -#line 5563 "" +#line 5553 "" *(unsigned char *)&ch__1[0] = idh + 28; -#line 5563 "" +#line 5553 "" i__4[2] = 1, a__2[2] = ch__1; -#line 5563 "" +#line 5553 "" i__4[3] = 1, a__2[3] = "}"; -#line 5563 "" +#line 5553 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 5564 "" +#line 5554 "" lnote += 4; -#line 5565 "" +#line 5555 "" } -#line 5566 "" +#line 5556 "" } /* Begin setting level */ -#line 5570 "" +#line 5560 "" lbot1 = lbot; -#line 5571 "" +#line 5561 "" if (idno > 0 && idno <= 5) { /* All letters are short so raise a bit. */ -#line 5575 "" +#line 5565 "" ++lbot1; -#line 5576 "" +#line 5566 "" } else if (idno >= 13) { -#line 5577 "" +#line 5567 "" lbot1 += 2; -#line 5578 "" +#line 5568 "" } /* Convert so reference is bottom line */ -#line 5582 "" +#line 5572 "" lbot1 = lbot1 - *ncm + 4; -#line 5583 "" +#line 5573 "" if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno == 13 || idno == 14)) { /* Hairpin start. Save level and user-tweak before applying user tweak. */ -#line 5588 "" +#line 5578 "" comdyn_1.levdsav[*ivx - 1] = lbot1; -#line 5589 "" +#line 5579 "" comdyn_1.levhssav[*ivx - 1] = 0; -#line 5590 "" +#line 5580 "" if (bit_test(idynd,16)) { -#line 5590 "" +#line 5580 "" comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17) - 64; -#line 5590 "" +#line 5580 "" } -#line 5591 "" +#line 5581 "" } else if (comslur_1.fontslur && idno >= 14 || idno == 15) { /* Hairpin end; Compare level with saved start level before user-tweaks */ /* Computing MIN */ -#line 5595 "" +#line 5585 "" i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1]; -#line 5595 "" +#line 5585 "" lbot1 = min(i__2,i__5); /* Save pre-tweak level */ -#line 5599 "" +#line 5589 "" lpretweak = lbot1; -#line 5600 "" +#line 5590 "" } /* Check for user-defined vertical tweak */ -#line 5604 "" +#line 5594 "" if (bit_test(idynd,16)) { -#line 5604 "" +#line 5594 "" lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17); -#line 5604 "" +#line 5594 "" } /* Now horizontal stuff */ -#line 5608 "" +#line 5598 "" hoff = hoffsd; /* Some special horizontal tweaks */ -#line 5612 "" +#line 5602 "" if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) { -#line 5612 "" +#line 5602 "" hoff += .4f; -#line 5612 "" +#line 5602 "" } /* User-defined tweaks */ -#line 5617 "" +#line 5607 "" if (bit_test(idynd2,0)) { -#line 5617 "" +#line 5607 "" hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f; -#line 5617 "" +#line 5607 "" } -#line 5619 "" +#line 5609 "" if (numdyn > 1) { /* Horizontal-interaction-based tweaks. */ @@ -13458,23 +13456,23 @@ L9: /* 2 hrpnend hrpnstrt - hoh2h1(1...2) */ /* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */ -#line 5630 "" +#line 5620 "" if (idno > 0 && idno <= 12) { /* Word-group, may need vertical tweak to line up. */ -#line 5634 "" +#line 5624 "" lbot1 += comdyn_1.ivowg[idno - 1]; /* Protecting against hp start-stop on same note */ -#line 5638 "" +#line 5628 "" } else if ((comslur_1.fontslur && idno >= 14 || idno == 15) && icntdyn < numdyn) { /* Hairpin ending, check next type */ -#line 5643 "" +#line 5633 "" if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ icntdyn] - 1], &c__4, &c__12) == 13 || ! comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[ @@ -13484,28 +13482,28 @@ L9: /* Hairpin end then hairpin start, no words, (remember dealing with end now) */ -#line 5653 "" +#line 5643 "" hoff += comdyn_1.hoh2h1[0]; -#line 5654 "" +#line 5644 "" } else { /* Hairpin end then word-group, need idno for w-g to set hp offset */ -#line 5658 "" +#line 5648 "" hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[ icntdyn] - 1], &c__4, &c__12) - 1]; -#line 5660 "" +#line 5650 "" } /* Protecting against hp start-stop on same note */ -#line 5664 "" +#line 5654 "" } else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno < 14 || ! comslur_1.fontslur && idno < 15)) { /* Hairpin start, check prior type */ -#line 5670 "" +#line 5660 "" if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ icntdyn - 2] - 1], &c__4, &c__12) >= 14 || ! comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[ @@ -13513,30 +13511,30 @@ L9: /* Hairpin end then hairpin start, (remember dealing with start now) */ -#line 5679 "" +#line 5669 "" hoff += comdyn_1.hoh2h1[1]; -#line 5680 "" +#line 5670 "" } else { /* Hairpin start after word-group, need idno for w-g to set hp offset */ -#line 5684 "" +#line 5674 "" hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[ icntdyn - 2] - 1], &c__4, &c__12) - 1]; -#line 5686 "" +#line 5676 "" } -#line 5687 "" +#line 5677 "" } -#line 5688 "" +#line 5678 "" } /* End of if-block for 2- or 3-way interactions. */ -#line 5692 "" +#line 5682 "" if (! comslur_1.fontslur && idno >= 13) { -#line 5692 "" +#line 5682 "" hoff = (hoff + .5f) * 6.f / 2.5f; -#line 5692 "" +#line 5682 "" } /* Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */ @@ -13544,217 +13542,217 @@ L9: /* Position corrections all done now. Put in the level. */ -#line 5700 "" +#line 5690 "" if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno == 13 || idno == 14)) { /* Hairpin start. */ -#line 5705 "" +#line 5695 "" if (! comslur_1.fontslur) { /* Postscript hairpin start...inset placeholder for start level. */ /* Writing concatenation */ -#line 5709 "" +#line 5699 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5709 "" +#line 5699 "" i__3[1] = 5, a__1[1] = "{ }"; -#line 5709 "" +#line 5699 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5710 "" +#line 5700 "" lnote += 5; -#line 5711 "" +#line 5701 "" } -#line 5712 "" +#line 5702 "" } else { /* Insert actual level in all cases except hairpin start */ /* Create string with level in it */ -#line 5717 "" +#line 5707 "" if (lbot1 > 9) { -#line 5718 "" +#line 5708 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5719 "" +#line 5709 "" s_wsfi(&io___405); -#line 5719 "" +#line 5709 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5719 "" +#line 5709 "" e_wsfi(); /* Writing concatenation */ -#line 5720 "" +#line 5710 "" i__3[0] = 3, a__1[0] = numpq; -#line 5720 "" +#line 5710 "" i__3[1] = 1, a__1[1] = "}"; -#line 5720 "" +#line 5710 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5721 "" +#line 5711 "" lnumpq = 4; -#line 5722 "" +#line 5712 "" } else if (lbot1 > -1) { -#line 5723 "" +#line 5713 "" *(unsigned char *)&ch__1[0] = lbot1 + 48; -#line 5723 "" +#line 5713 "" s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); -#line 5724 "" +#line 5714 "" lnumpq = 1; -#line 5725 "" +#line 5715 "" } else if (lbot1 > -10) { -#line 5726 "" +#line 5716 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5727 "" +#line 5717 "" s_wsfi(&io___407); -#line 5727 "" +#line 5717 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5727 "" +#line 5717 "" e_wsfi(); /* Writing concatenation */ -#line 5728 "" +#line 5718 "" i__3[0] = 3, a__1[0] = numpq; -#line 5728 "" +#line 5718 "" i__3[1] = 1, a__1[1] = "}"; -#line 5728 "" +#line 5718 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5729 "" +#line 5719 "" lnumpq = 4; -#line 5730 "" +#line 5720 "" } else { -#line 5731 "" +#line 5721 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5732 "" +#line 5722 "" s_wsfi(&io___408); -#line 5732 "" +#line 5722 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5732 "" +#line 5722 "" e_wsfi(); /* Writing concatenation */ -#line 5733 "" +#line 5723 "" i__3[0] = 4, a__1[0] = numpq; -#line 5733 "" +#line 5723 "" i__3[1] = 1, a__1[1] = "}"; -#line 5733 "" +#line 5723 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5734 "" +#line 5724 "" lnumpq = 5; -#line 5735 "" +#line 5725 "" } /* Level has now been computed and stored in numpq */ /* Append the level */ /* Writing concatenation */ -#line 5740 "" +#line 5730 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5740 "" +#line 5730 "" i__3[1] = lnumpq, a__1[1] = numpq; -#line 5740 "" +#line 5730 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5741 "" +#line 5731 "" lnote += lnumpq; -#line 5742 "" +#line 5732 "" } -#line 5743 "" +#line 5733 "" if (dabs(hoff) < .001f) { /* No horiz offset */ /* Writing concatenation */ -#line 5747 "" +#line 5737 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5747 "" +#line 5737 "" i__3[1] = 1, a__1[1] = "0"; -#line 5747 "" +#line 5737 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5748 "" +#line 5738 "" ++lnote; -#line 5749 "" +#line 5739 "" } else { /* Horizontal tweak */ -#line 5753 "" +#line 5743 "" lform = lfmt1_(&hoff); /* Writing concatenation */ -#line 5754 "" +#line 5744 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5754 "" +#line 5744 "" i__3[1] = 1, a__1[1] = "{"; -#line 5754 "" +#line 5744 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5755 "" +#line 5745 "" ++lnote; -#line 5756 "" +#line 5746 "" i__2 = lnote; -#line 5756 "" +#line 5746 "" ici__1.icierr = 0; -#line 5756 "" +#line 5746 "" ici__1.icirnum = 1; -#line 5756 "" +#line 5746 "" ici__1.icirlen = lnote + lform - i__2; -#line 5756 "" +#line 5746 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 5756 "" +#line 5746 "" i__6[0] = 2, a__3[0] = "(f"; -#line 5756 "" +#line 5746 "" i__5 = lform + 48; -#line 5756 "" +#line 5746 "" chax_(ch__1, (ftnlen)1, &i__5); -#line 5756 "" +#line 5746 "" i__6[1] = 1, a__3[1] = ch__1; -#line 5756 "" +#line 5746 "" i__6[2] = 3, a__3[2] = ".1)"; -#line 5756 "" +#line 5746 "" ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6), ch__2); -#line 5756 "" +#line 5746 "" s_wsfi(&ici__1); -#line 5756 "" +#line 5746 "" do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real)); -#line 5756 "" +#line 5746 "" e_wsfi(); -#line 5758 "" +#line 5748 "" lnote += lform; /* Writing concatenation */ -#line 5759 "" +#line 5749 "" i__3[0] = lnote, a__1[0] = notexq; -#line 5759 "" +#line 5749 "" i__3[1] = 1, a__1[1] = "}"; -#line 5759 "" +#line 5749 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 5760 "" +#line 5750 "" ++lnote; -#line 5761 "" +#line 5751 "" } -#line 5762 "" +#line 5752 "" if (idno == 0) { /* text-dynamic. Find the string and append it */ -#line 5766 "" +#line 5756 "" i__2 = comdyn_1.ntxtdyn; -#line 5766 "" +#line 5756 "" for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) { /* ivxip = ivx+16*ip */ -#line 5768 "" +#line 5758 "" ivxip = *ivx + (*ip << 5); -#line 5769 "" +#line 5759 "" if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) { -#line 5769 "" +#line 5759 "" goto L5; -#line 5769 "" +#line 5759 "" } -#line 5770 "" +#line 5760 "" /* L4: */ -#line 5770 "" +#line 5760 "" } -#line 5771 "" +#line 5761 "" printl_("Abnormal stop in putdyn", (ftnlen)23); -#line 5772 "" +#line 5762 "" stop1_(); -#line 5773 "" +#line 5763 "" L5: -#line 5774 "" +#line 5764 "" ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128, (ftnlen)128); @@ -13780,264 +13778,264 @@ L5: /* Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) */ -#line 5798 "" +#line 5788 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); -#line 5799 "" +#line 5789 "" if (commus_1.musize == 20) { -#line 5800 "" +#line 5790 "" s_copy(notexq, "{\\medtype\\it ", (ftnlen)79, (ftnlen)13); -#line 5801 "" +#line 5791 "" lnote = 13; -#line 5802 "" +#line 5792 "" } else if (commus_1.musize == 16) { -#line 5803 "" +#line 5793 "" s_copy(notexq, "{\\normtype\\it ", (ftnlen)79, (ftnlen)14); -#line 5804 "" +#line 5794 "" lnote = 14; -#line 5805 "" +#line 5795 "" } else if (commus_1.musize == 24) { -#line 5806 "" +#line 5796 "" s_copy(notexq, "{\\bigtype\\it ", (ftnlen)79, (ftnlen)13); -#line 5807 "" +#line 5797 "" lnote = 13; -#line 5808 "" +#line 5798 "" } else if (commus_1.musize == 29) { -#line 5809 "" +#line 5799 "" s_copy(notexq, "{\\Bigtype\\it ", (ftnlen)79, (ftnlen)13); -#line 5810 "" +#line 5800 "" lnote = 13; -#line 5811 "" +#line 5801 "" } /* Writing concatenation */ -#line 5813 "" +#line 5803 "" i__6[0] = lnote, a__3[0] = notexq; -#line 5813 "" +#line 5803 "" i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7) ; -#line 5813 "" +#line 5803 "" i__6[2] = 1, a__3[2] = "}"; -#line 5813 "" +#line 5803 "" s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); -#line 5814 "" +#line 5804 "" lnote = lnote + ltxtdyn + 1; /* Reset jtxtdyn1 just in case >1 txtdyn on same note. */ -#line 5818 "" +#line 5808 "" jtxtdyn1 = jtxtdyn + 1; -#line 5819 "" +#line 5809 "" } else if (idno <= 12) { /* Letter-group dynamic. Append the letter-group command */ -#line 5823 "" +#line 5813 "" id = idno << 2; -#line 5824 "" +#line 5814 "" i__2 = id - 4; -#line 5824 "" +#line 5814 "" s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2); -#line 5825 "" +#line 5815 "" id = lenstr_(dynstrq, &c__4, (ftnlen)4); /* Writing concatenation */ -#line 5826 "" +#line 5816 "" i__6[0] = lnote, a__3[0] = notexq; -#line 5826 "" +#line 5816 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5826 "" +#line 5816 "" i__6[1] = 1, a__3[1] = ch__1; -#line 5826 "" +#line 5816 "" i__6[2] = id, a__3[2] = dynstrq; -#line 5826 "" +#line 5816 "" s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); -#line 5827 "" +#line 5817 "" lnote = lnote + 1 + id; -#line 5828 "" +#line 5818 "" } -#line 5829 "" +#line 5819 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); -#line 5830 "" +#line 5820 "" if (! comslur_1.fontslur && idno == 15) { /* PS slurs on, hairpin is ending. Go back and set height at beginning. */ /* Add user-defined tweak to default level */ -#line 5835 "" +#line 5825 "" lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1]; -#line 5836 "" +#line 5826 "" if (lbot1 > 9) { -#line 5837 "" +#line 5827 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5838 "" +#line 5828 "" s_wsfi(&io___415); -#line 5838 "" +#line 5828 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5838 "" +#line 5828 "" e_wsfi(); /* Writing concatenation */ -#line 5839 "" +#line 5829 "" i__3[0] = 3, a__1[0] = numpq; -#line 5839 "" +#line 5829 "" i__3[1] = 1, a__1[1] = "}"; -#line 5839 "" +#line 5829 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5840 "" +#line 5830 "" lnumpq = 4; -#line 5841 "" +#line 5831 "" } else if (lbot1 > -1) { -#line 5842 "" +#line 5832 "" *(unsigned char *)&ch__1[0] = lbot1 + 48; -#line 5842 "" +#line 5832 "" s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); -#line 5843 "" +#line 5833 "" lnumpq = 1; -#line 5844 "" +#line 5834 "" } else if (lbot1 > -10) { -#line 5845 "" +#line 5835 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5846 "" +#line 5836 "" s_wsfi(&io___416); -#line 5846 "" +#line 5836 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5846 "" +#line 5836 "" e_wsfi(); /* Writing concatenation */ -#line 5847 "" +#line 5837 "" i__3[0] = 3, a__1[0] = numpq; -#line 5847 "" +#line 5837 "" i__3[1] = 1, a__1[1] = "}"; -#line 5847 "" +#line 5837 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5848 "" +#line 5838 "" lnumpq = 4; -#line 5849 "" +#line 5839 "" } else { -#line 5850 "" +#line 5840 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); -#line 5851 "" +#line 5841 "" s_wsfi(&io___417); -#line 5851 "" +#line 5841 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); -#line 5851 "" +#line 5841 "" e_wsfi(); /* Writing concatenation */ -#line 5852 "" +#line 5842 "" i__3[0] = 4, a__1[0] = numpq; -#line 5852 "" +#line 5842 "" i__3[1] = 1, a__1[1] = "}"; -#line 5852 "" +#line 5842 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); -#line 5853 "" +#line 5843 "" lnumpq = 5; -#line 5854 "" +#line 5844 "" } /* Construct string to search backwards for placeholder */ -#line 5858 "" +#line 5848 "" if (idh <= 9) { /* Writing concatenation */ -#line 5859 "" +#line 5849 "" i__6[0] = 5, a__3[0] = "cresc"; -#line 5859 "" +#line 5849 "" *(unsigned char *)&ch__1[0] = idh + 48; -#line 5859 "" +#line 5849 "" i__6[1] = 1, a__3[1] = ch__1; -#line 5859 "" +#line 5849 "" i__6[2] = 5, a__3[2] = "{ }"; -#line 5859 "" +#line 5849 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); -#line 5860 "" +#line 5850 "" ltemp = 11; -#line 5861 "" +#line 5851 "" } else if (idh <= 19) { /* Writing concatenation */ -#line 5862 "" +#line 5852 "" i__6[0] = 7, a__3[0] = "cresc{1"; -#line 5862 "" +#line 5852 "" *(unsigned char *)&ch__1[0] = idh + 38; -#line 5862 "" +#line 5852 "" i__6[1] = 1, a__3[1] = ch__1; -#line 5862 "" +#line 5852 "" i__6[2] = 6, a__3[2] = "}{ }"; -#line 5862 "" +#line 5852 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); -#line 5863 "" +#line 5853 "" ltemp = 14; -#line 5864 "" +#line 5854 "" } else { /* Writing concatenation */ -#line 5865 "" +#line 5855 "" i__6[0] = 7, a__3[0] = "cresc{2"; -#line 5865 "" +#line 5855 "" *(unsigned char *)&ch__1[0] = idh + 28; -#line 5865 "" +#line 5855 "" i__6[1] = 1, a__3[1] = ch__1; -#line 5865 "" +#line 5855 "" i__6[2] = 6, a__3[2] = "}{ }"; -#line 5865 "" +#line 5855 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); -#line 5866 "" +#line 5856 "" ltemp = 14; -#line 5867 "" +#line 5857 "" } -#line 5868 "" +#line 5858 "" s_wsfe(&io___420); /* Writing concatenation */ -#line 5868 "" +#line 5858 "" i__3[0] = *lsout, a__1[0] = soutq; -#line 5868 "" +#line 5858 "" i__3[1] = 1, a__1[1] = "%"; -#line 5868 "" +#line 5858 "" s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81); -#line 5868 "" +#line 5858 "" do_fio(&c__1, ch__3, *lsout + 1); -#line 5868 "" +#line 5858 "" e_wsfe(); -#line 5869 "" +#line 5859 "" *lsout = 0; /* Writing concatenation */ -#line 5870 "" +#line 5860 "" i__3[0] = ltemp - 5, a__1[0] = tempq; -#line 5870 "" +#line 5860 "" i__3[1] = lnumpq, a__1[1] = numpq; -#line 5870 "" +#line 5860 "" s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53); -#line 5870 "" +#line 5860 "" i__2 = ltemp - 5 + lnumpq; -#line 5870 "" +#line 5860 "" backfill_(&c__11, tempq, <emp, ch__4, &i__2, (ftnlen)48, ltemp - 5 + lnumpq); -#line 5872 "" +#line 5862 "" } -#line 5873 "" +#line 5863 "" /* L3: */ -#line 5873 "" +#line 5863 "" } /* Shrink arrays, decrease ndyn 111109 */ -#line 5877 "" +#line 5867 "" for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) { -#line 5878 "" +#line 5868 "" i__1 = comdyn_1.ndyn - 1; -#line 5878 "" +#line 5868 "" for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) { -#line 5879 "" +#line 5869 "" comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn]; -#line 5880 "" +#line 5870 "" comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn]; -#line 5881 "" +#line 5871 "" /* L7: */ -#line 5881 "" +#line 5871 "" } -#line 5882 "" +#line 5872 "" --comdyn_1.ndyn; -#line 5883 "" +#line 5873 "" /* L6: */ -#line 5883 "" +#line 5873 "" } -#line 5884 "" +#line 5874 "" return 0; } /* dodyn_ */ @@ -14120,1426 +14118,1426 @@ L5: /* It is only used to find ig. */ /* ig is returned to makeabar in case there's a slur that needs to be ended */ -#line 5923 "" +#line 5913 "" /* Parameter adjustments */ -#line 5923 "" +#line 5913 "" ulq -= 25; -#line 5923 "" +#line 5913 "" --ptgr; -#line 5923 "" +#line 5913 "" -#line 5923 "" +#line 5913 "" /* Function Body */ -#line 5923 "" +#line 5913 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 5923 "" +#line 5913 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 5924 "" +#line 5914 "" isgaft = bit_test(*ipl,29); -#line 5925 "" +#line 5915 "" iswaft = bit_test(*ipl,31); -#line 5926 "" +#line 5916 "" normsp = ! isgaft; /* Find ig. */ -#line 5930 "" +#line 5920 "" i__1 = comgrace_1.ngrace; -#line 5930 "" +#line 5920 "" for (*ig = 1; *ig <= i__1; ++(*ig)) { -#line 5931 "" +#line 5921 "" if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx) { -#line 5931 "" +#line 5921 "" goto L121; -#line 5931 "" +#line 5921 "" } -#line 5932 "" +#line 5922 "" /* L120: */ -#line 5932 "" +#line 5922 "" } -#line 5933 "" +#line 5923 "" s_wsle(&io___426); -#line 5933 "" +#line 5923 "" do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38) ; -#line 5933 "" +#line 5923 "" e_wsle(); -#line 5934 "" +#line 5924 "" s_stop("", (ftnlen)0); -#line 5935 "" +#line 5925 "" L121: -#line 5936 "" +#line 5926 "" ngs = comgrace_1.ngstrt[*ig - 1]; -#line 5937 "" +#line 5927 "" mg = comgrace_1.multg[*ig - 1]; /* wheadpt1 = wheadpt*fullsize(ivx) */ -#line 5939 "" +#line 5929 "" wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1]; /* For way-after-graces at end of bar, must set the octave. */ -#line 5943 "" +#line 5933 "" if (*farend) { -#line 5944 "" +#line 5934 "" comoct_1.noctup = 0; -#line 5945 "" +#line 5935 "" if (*ncm == 23) { -#line 5945 "" +#line 5935 "" comoct_1.noctup = -2; -#line 5945 "" +#line 5935 "" } -#line 5946 "" +#line 5936 "" } -#line 5947 "" +#line 5937 "" if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) { -#line 5948 "" +#line 5938 "" if (comslur_1.listslur == 16777215) { -#line 5949 "" +#line 5939 "" s_wsle(&io___430); -#line 5949 "" +#line 5939 "" e_wsle(); -#line 5950 "" +#line 5940 "" s_wsle(&io___431); -#line 5950 "" +#line 5940 "" do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "\ "many!", (ftnlen)47); -#line 5950 "" +#line 5940 "" e_wsle(); -#line 5951 "" +#line 5941 "" s_wsfe(&io___432); -#line 5951 "" +#line 5941 "" do_fio(&c__1, "You defined the twentyfifth slur, one too many!", ( ftnlen)47); -#line 5951 "" +#line 5941 "" e_wsfe(); -#line 5953 "" +#line 5943 "" stop1_(); -#line 5954 "" +#line 5944 "" } /* Slur on fore-grace. Get index of next slur not in use, from 23 down. */ -#line 5958 "" +#line 5948 "" i__1 = 16777215 - comslur_1.listslur; -#line 5958 "" +#line 5948 "" comslur_1.ndxslur = log2_(&i__1); -#line 5960 "" +#line 5950 "" } -#line 5961 "" +#line 5951 "" if (comgrace_1.nng[*ig - 1] == 1) { /* Single grace. */ -#line 5965 "" +#line 5955 "" if (normsp) { /* Anything but GA */ /* Writing concatenation */ -#line 5969 "" +#line 5959 "" i__2[0] = 1, a__1[0] = sq; -#line 5969 "" +#line 5959 "" i__2[1] = 5, a__1[1] = "shlft"; -#line 5969 "" +#line 5959 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); -#line 5969 "" +#line 5959 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80); -#line 5970 "" +#line 5960 "" niptgr = i_nint(&ptgr[*ig]); /* Empirical tweak for postscript. */ /* if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */ /* ++ */ -#line 5976 "" +#line 5966 "" if (niptgr < 10) { /* Writing concatenation */ -#line 5977 "" +#line 5967 "" i__1 = niptgr + 48; -#line 5977 "" +#line 5967 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 5977 "" +#line 5967 "" i__2[0] = 1, a__1[0] = ch__1; -#line 5977 "" +#line 5967 "" i__2[1] = 1, a__1[1] = "{"; -#line 5977 "" +#line 5967 "" s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2); -#line 5977 "" +#line 5967 "" addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); -#line 5978 "" +#line 5968 "" } else if (niptgr < 100) { -#line 5979 "" +#line 5969 "" s_wsfi(&io___435); -#line 5979 "" +#line 5969 "" do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer)); -#line 5979 "" +#line 5969 "" e_wsfi(); /* Writing concatenation */ -#line 5980 "" +#line 5970 "" i__3[0] = 1, a__2[0] = "{"; -#line 5980 "" +#line 5970 "" i__3[1] = 2, a__2[1] = notexq; -#line 5980 "" +#line 5970 "" i__3[2] = 2, a__2[2] = "}{"; -#line 5980 "" +#line 5970 "" s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5); -#line 5980 "" +#line 5970 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); -#line 5981 "" +#line 5971 "" } else { -#line 5982 "" +#line 5972 "" s_wsle(&io___436); -#line 5982 "" +#line 5972 "" do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "\ "note group > 99 pt", (ftnlen)56); -#line 5982 "" +#line 5972 "" e_wsle(); -#line 5984 "" +#line 5974 "" s_stop("", (ftnlen)0); -#line 5985 "" +#line 5975 "" } -#line 5986 "" +#line 5976 "" } else { /* Writing concatenation */ -#line 5987 "" +#line 5977 "" i__2[0] = 1, a__1[0] = sq; -#line 5987 "" +#line 5977 "" i__2[1] = 10, a__1[1] = "gaft{1.5}{"; -#line 5987 "" +#line 5977 "" s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); -#line 5987 "" +#line 5977 "" addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); /* GA. Compute aftshft, for later use. */ -#line 5991 "" +#line 5981 "" comgrace_1.aftshft = spfacs_1.grafac; -#line 5992 "" +#line 5982 "" if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { -#line 5992 "" +#line 5982 "" comgrace_1.aftshft += spfacs_1.agc1fac; -#line 5992 "" +#line 5982 "" } -#line 5993 "" +#line 5983 "" comgrace_1.aftshft *= comask_1.wheadpt; -#line 5994 "" +#line 5984 "" } -#line 5995 "" +#line 5985 "" if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { /* Start slur on pre-grace. No accounting needed since will be ended very soon. */ -#line 5999 "" +#line 5989 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); -#line 6000 "" +#line 5990 "" if (comslur_1.fontslur) { -#line 6001 "" +#line 5991 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6002 "" +#line 5992 "" i__2[0] = 1, a__1[0] = sq; -#line 6002 "" +#line 5992 "" i__2[1] = 6, a__1[1] = "islurd"; -#line 6002 "" +#line 5992 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); -#line 6002 "" +#line 5992 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; -#line 6003 "" +#line 5993 "" } else { /* Writing concatenation */ -#line 6004 "" +#line 5994 "" i__2[0] = 1, a__1[0] = sq; -#line 6004 "" +#line 5994 "" i__2[1] = 6, a__1[1] = "isluru"; -#line 6004 "" +#line 5994 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); -#line 6004 "" +#line 5994 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; -#line 6005 "" +#line 5995 "" } -#line 6006 "" +#line 5996 "" } else { /* Start Postscript slur. */ -#line 6010 "" +#line 6000 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6011 "" +#line 6001 "" i__2[0] = 1, a__1[0] = sq; -#line 6011 "" +#line 6001 "" i__2[1] = 3, a__1[1] = "isd"; -#line 6011 "" +#line 6001 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); -#line 6011 "" +#line 6001 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; -#line 6012 "" +#line 6002 "" } else { /* Writing concatenation */ -#line 6013 "" +#line 6003 "" i__2[0] = 1, a__1[0] = sq; -#line 6013 "" +#line 6003 "" i__2[1] = 3, a__1[1] = "isu"; -#line 6013 "" +#line 6003 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); -#line 6013 "" +#line 6003 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; -#line 6014 "" +#line 6004 "" } -#line 6015 "" +#line 6005 "" } /* Print slur number, 23-ndxslur */ -#line 6019 "" +#line 6009 "" lnote = 0; -#line 6020 "" +#line 6010 "" if (23 - comslur_1.ndxslur < 10) { /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ -#line 6022 "" +#line 6012 "" i__1 = 71 - comslur_1.ndxslur; -#line 6022 "" +#line 6012 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6022 "" +#line 6012 "" s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); -#line 6023 "" +#line 6013 "" lnote = 1; -#line 6024 "" +#line 6014 "" } else if (23 - comslur_1.ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ -#line 6026 "" +#line 6016 "" i__3[0] = 2, a__2[0] = "{1"; -#line 6026 "" +#line 6016 "" i__1 = 61 - comslur_1.ndxslur; -#line 6026 "" +#line 6016 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6026 "" +#line 6016 "" i__3[1] = 1, a__2[1] = ch__1; -#line 6026 "" +#line 6016 "" i__3[2] = 1, a__2[2] = "}"; -#line 6026 "" +#line 6016 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 6027 "" +#line 6017 "" lnote = 4; -#line 6028 "" +#line 6018 "" } else { /* Writing concatenation */ -#line 6029 "" +#line 6019 "" i__4[0] = lnote, a__3[0] = notexq; -#line 6029 "" +#line 6019 "" i__4[1] = 2, a__3[1] = "{2"; -#line 6029 "" +#line 6019 "" i__1 = 51 - comslur_1.ndxslur; -#line 6029 "" +#line 6019 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6029 "" +#line 6019 "" i__4[2] = 1, a__3[2] = ch__1; -#line 6029 "" +#line 6019 "" i__4[3] = 1, a__3[3] = "}"; -#line 6029 "" +#line 6019 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 6030 "" +#line 6020 "" lnote = 4; -#line 6031 "" +#line 6021 "" } /* Writing concatenation */ -#line 6032 "" +#line 6022 "" i__2[0] = lnote, a__1[0] = notexq; -#line 6032 "" +#line 6022 "" i__2[1] = lnoten, a__1[1] = noteq; -#line 6032 "" +#line 6022 "" s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); -#line 6032 "" +#line 6022 "" i__1 = lnote + lnoten; -#line 6032 "" +#line 6022 "" addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80); -#line 6034 "" +#line 6024 "" if (! comslur_1.fontslur) { /* Horizontal tweaks for postscript slur on single grace */ -#line 6038 "" +#line 6028 "" stemup = TRUE_; -#line 6039 "" +#line 6029 "" if (comgrace_1.upg[*ig - 1]) { /* Check for up-grace + down stem. Get stem direction */ -#line 6043 "" +#line 6033 "" if (! (*beamon)) { /* Separate note. Get stem direction. */ -#line 6047 "" +#line 6037 "" udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx, ivx, nv); -#line 6047 "" +#line 6037 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; -#line 6049 "" +#line 6039 "" } else { /* In a beam */ -#line 6053 "" +#line 6043 "" stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u'; -#line 6054 "" +#line 6044 "" } /* Stop the shift if whole note */ -#line 6058 "" +#line 6048 "" stemup = stemup || *tnote > 63.f; -#line 6059 "" +#line 6049 "" } -#line 6060 "" +#line 6050 "" if (stemup) { -#line 6061 "" +#line 6051 "" addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) 80); -#line 6062 "" +#line 6052 "" } else { -#line 6063 "" +#line 6053 "" addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) 80); -#line 6064 "" +#line 6054 "" } -#line 6065 "" +#line 6055 "" } -#line 6066 "" +#line 6056 "" } -#line 6067 "" +#line 6057 "" if (comgrace_1.naccg[ngs - 1] > 0) { -#line 6068 "" +#line 6058 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Save for checking octave shifts in GA */ -#line 6072 "" +#line 6062 "" if (isgaft) { -#line 6073 "" +#line 6063 "" lnotenga = lnoten; -#line 6074 "" +#line 6064 "" s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); -#line 6075 "" +#line 6065 "" } -#line 6077 "" +#line 6067 "" if (lnoten == 1) { -#line 6077 "" +#line 6067 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 6077 "" +#line 6067 "" } -#line 6078 "" +#line 6068 "" accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ -#line 6079 "" +#line 6069 "" i__4[0] = 1, a__3[0] = sq; -#line 6079 "" +#line 6069 "" i__4[1] = 3, a__3[1] = "big"; -#line 6079 "" +#line 6069 "" i__4[2] = lacc, a__3[2] = acsymq; -#line 6079 "" +#line 6069 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6079 "" +#line 6069 "" s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); -#line 6079 "" +#line 6069 "" i__1 = lacc + 4 + lnoten; -#line 6079 "" +#line 6069 "" addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80) ; -#line 6081 "" +#line 6071 "" } -#line 6082 "" +#line 6072 "" if (comgrace_1.slashg[*ig - 1]) { /* Writing concatenation */ -#line 6083 "" +#line 6073 "" i__2[0] = 1, a__1[0] = sq; -#line 6083 "" +#line 6073 "" i__2[1] = 3, a__1[1] = "grc"; -#line 6083 "" +#line 6073 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6084 "" +#line 6074 "" lnote = 4; -#line 6085 "" +#line 6075 "" } else if (mg == 0) { /* Writing concatenation */ -#line 6086 "" +#line 6076 "" i__2[0] = 1, a__1[0] = sq; -#line 6086 "" +#line 6076 "" i__2[1] = 2, a__1[1] = "zq"; -#line 6086 "" +#line 6076 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6087 "" +#line 6077 "" lnote = 3; -#line 6088 "" +#line 6078 "" } else { /* Writing concatenation */ -#line 6089 "" +#line 6079 "" i__2[0] = 1, a__1[0] = sq; -#line 6089 "" +#line 6079 "" i__2[1] = 2, a__1[1] = "zc"; -#line 6089 "" +#line 6079 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6090 "" +#line 6080 "" i__1 = mg; -#line 6090 "" +#line 6080 "" for (i__ = 2; i__ <= i__1; ++i__) { /* Writing concatenation */ -#line 6091 "" +#line 6081 "" i__2[0] = i__ + 1, a__1[0] = notexq; -#line 6091 "" +#line 6081 "" i__2[1] = 1, a__1[1] = "c"; -#line 6091 "" +#line 6081 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6092 "" +#line 6082 "" /* L61: */ -#line 6092 "" +#line 6082 "" } -#line 6093 "" +#line 6083 "" lnote = mg + 2; -#line 6094 "" +#line 6084 "" } -#line 6095 "" +#line 6085 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6096 "" +#line 6086 "" i__2[0] = lnote, a__1[0] = notexq; -#line 6096 "" +#line 6086 "" i__2[1] = 1, a__1[1] = "u"; -#line 6096 "" +#line 6086 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6097 "" +#line 6087 "" } else { /* Writing concatenation */ -#line 6098 "" +#line 6088 "" i__2[0] = lnote, a__1[0] = notexq; -#line 6098 "" +#line 6088 "" i__2[1] = 1, a__1[1] = "l"; -#line 6098 "" +#line 6088 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6099 "" +#line 6089 "" } -#line 6100 "" +#line 6090 "" i__1 = lnote + 1; -#line 6100 "" +#line 6090 "" addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80); -#line 6101 "" +#line 6091 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); -#line 6103 "" +#line 6093 "" if (isgaft && comgrace_1.naccg[ngs - 1] == 0) { -#line 6104 "" +#line 6094 "" lnotenga = lnoten; -#line 6105 "" +#line 6095 "" s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); -#line 6106 "" +#line 6096 "" } -#line 6108 "" +#line 6098 "" if (lnoten == 1) { -#line 6108 "" +#line 6098 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 6108 "" +#line 6098 "" } -#line 6109 "" +#line 6099 "" addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80); -#line 6110 "" +#line 6100 "" if (comgrace_1.slashg[*ig - 1]) { /* Writing concatenation */ -#line 6110 "" +#line 6100 "" i__4[0] = 1, a__3[0] = sq; -#line 6110 "" +#line 6100 "" i__4[1] = 5, a__3[1] = "off{-"; -#line 6110 "" +#line 6100 "" i__4[2] = 1, a__3[2] = sq; -#line 6110 "" +#line 6100 "" i__4[3] = 9, a__3[3] = "noteskip}"; -#line 6110 "" +#line 6100 "" s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16); -#line 6110 "" +#line 6100 "" addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80); -#line 6110 "" +#line 6100 "" } /* Above code needed since slashg causes spacing */ -#line 6115 "" +#line 6105 "" if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) { /* Terminate slur on single after-grace */ -#line 6119 "" +#line 6109 "" comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); -#line 6120 "" +#line 6110 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Writing concatenation */ -#line 6121 "" +#line 6111 "" i__2[0] = 1, a__1[0] = sq; -#line 6121 "" +#line 6111 "" i__2[1] = 5, a__1[1] = "tslur"; -#line 6121 "" +#line 6111 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); -#line 6121 "" +#line 6111 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80); /* Print 24-ndxslur */ /* if (11-ndxslur .lt. 10) then */ -#line 6126 "" +#line 6116 "" if (23 - comslur_1.ndxslur < 10) { /* call addstr(chax(59-ndxslur)//noteq(1:lnoten), */ /* Writing concatenation */ -#line 6128 "" +#line 6118 "" i__1 = 71 - comslur_1.ndxslur; -#line 6128 "" +#line 6118 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6128 "" +#line 6118 "" i__2[0] = 1, a__1[0] = ch__1; -#line 6128 "" +#line 6118 "" i__2[1] = lnoten, a__1[1] = noteq; -#line 6128 "" +#line 6118 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); -#line 6128 "" +#line 6118 "" i__5 = lnoten + 1; -#line 6128 "" +#line 6118 "" addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); -#line 6130 "" +#line 6120 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 6131 "" +#line 6121 "" i__4[0] = 2, a__3[0] = "{2"; -#line 6131 "" +#line 6121 "" i__1 = 61 - comslur_1.ndxslur; -#line 6131 "" +#line 6121 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6131 "" +#line 6121 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6131 "" +#line 6121 "" i__4[2] = 1, a__3[2] = "}"; -#line 6131 "" +#line 6121 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6131 "" +#line 6121 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6131 "" +#line 6121 "" i__5 = lnoten + 4; -#line 6131 "" +#line 6121 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); -#line 6133 "" +#line 6123 "" } else { /* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */ /* Writing concatenation */ -#line 6135 "" +#line 6125 "" i__4[0] = 2, a__3[0] = "{1"; -#line 6135 "" +#line 6125 "" i__1 = 51 - comslur_1.ndxslur; -#line 6135 "" +#line 6125 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6135 "" +#line 6125 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6135 "" +#line 6125 "" i__4[2] = 1, a__3[2] = "}"; -#line 6135 "" +#line 6125 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6135 "" +#line 6125 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6135 "" +#line 6125 "" i__5 = lnoten + 4; -#line 6135 "" +#line 6125 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); -#line 6137 "" +#line 6127 "" } -#line 6138 "" +#line 6128 "" comgrace_1.slurg[*ig - 1] = FALSE_; -#line 6139 "" +#line 6129 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); -#line 6140 "" +#line 6130 "" } -#line 6141 "" +#line 6131 "" addstr_("}", &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80); /* +++ Try to fix loss of octave with single gaft */ -#line 6145 "" +#line 6135 "" if (isgaft) { -#line 6146 "" +#line 6136 "" itrans = 0; -#line 6147 "" +#line 6137 "" i__1 = lnotenga; -#line 6147 "" +#line 6137 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 6148 "" +#line 6138 "" chax_(ch__1, (ftnlen)1, &c__39); -#line 6148 "" +#line 6138 "" if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned char *)& ch__1[0]) { -#line 6149 "" +#line 6139 "" itrans += 7; -#line 6150 "" +#line 6140 "" } else /* if(complicated condition) */ { -#line 6150 "" +#line 6140 "" chax_(ch__1, (ftnlen)1, &c__96); -#line 6150 "" +#line 6140 "" if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned char *)&ch__1[0]) { -#line 6151 "" +#line 6141 "" itrans += -7; -#line 6152 "" +#line 6142 "" } -#line 6152 "" +#line 6142 "" } -#line 6153 "" +#line 6143 "" /* L1: */ -#line 6153 "" +#line 6143 "" } -#line 6154 "" +#line 6144 "" if (itrans == -14) { /* Writing concatenation */ -#line 6155 "" +#line 6145 "" i__4[0] = 1, a__3[0] = sq; -#line 6155 "" +#line 6145 "" i__4[1] = 7, a__3[1] = "advance"; -#line 6155 "" +#line 6145 "" i__4[2] = 1, a__3[2] = sq; -#line 6155 "" +#line 6145 "" i__4[3] = 12, a__3[3] = "transpose-14"; -#line 6155 "" +#line 6145 "" s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21); -#line 6155 "" +#line 6145 "" addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); -#line 6157 "" +#line 6147 "" } else if (itrans == -7) { /* Writing concatenation */ -#line 6158 "" +#line 6148 "" i__4[0] = 1, a__3[0] = sq; -#line 6158 "" +#line 6148 "" i__4[1] = 7, a__3[1] = "advance"; -#line 6158 "" +#line 6148 "" i__4[2] = 1, a__3[2] = sq; -#line 6158 "" +#line 6148 "" i__4[3] = 11, a__3[3] = "transpose-7"; -#line 6158 "" +#line 6148 "" s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); -#line 6158 "" +#line 6148 "" addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); -#line 6160 "" +#line 6150 "" } else if (itrans == 7) { /* Writing concatenation */ -#line 6161 "" +#line 6151 "" i__4[0] = 1, a__3[0] = sq; -#line 6161 "" +#line 6151 "" i__4[1] = 7, a__3[1] = "advance"; -#line 6161 "" +#line 6151 "" i__4[2] = 1, a__3[2] = sq; -#line 6161 "" +#line 6151 "" i__4[3] = 10, a__3[3] = "transpose7"; -#line 6161 "" +#line 6151 "" s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19); -#line 6161 "" +#line 6151 "" addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80); -#line 6163 "" +#line 6153 "" } else if (itrans == 14) { /* Writing concatenation */ -#line 6164 "" +#line 6154 "" i__4[0] = 1, a__3[0] = sq; -#line 6164 "" +#line 6154 "" i__4[1] = 7, a__3[1] = "advance"; -#line 6164 "" +#line 6154 "" i__4[2] = 1, a__3[2] = sq; -#line 6164 "" +#line 6154 "" i__4[3] = 11, a__3[3] = "transpose14"; -#line 6164 "" +#line 6154 "" s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); -#line 6164 "" +#line 6154 "" addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); -#line 6166 "" +#line 6156 "" } -#line 6167 "" +#line 6157 "" } -#line 6168 "" +#line 6158 "" } else { /* Multiple grace. Put in literally. Compute beam stuff */ -#line 6172 "" +#line 6162 "" sumx = 0.f; -#line 6173 "" +#line 6163 "" sumy = 0.f; -#line 6174 "" +#line 6164 "" sumxy = 0.f; -#line 6175 "" +#line 6165 "" sumxx = 0.f; -#line 6176 "" +#line 6166 "" sumyy = 0.f; -#line 6177 "" +#line 6167 "" x = 0.f; -#line 6178 "" +#line 6168 "" i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; -#line 6178 "" +#line 6168 "" for (ing = ngs; ing <= i__1; ++ing) { -#line 6179 "" +#line 6169 "" if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) { -#line 6179 "" +#line 6169 "" x += spfacs_1.acgfac; -#line 6179 "" +#line 6169 "" } -#line 6180 "" +#line 6170 "" y = (real) comgrace_1.nolevg[ing - 1]; -#line 6181 "" +#line 6171 "" sumx += x; -#line 6182 "" +#line 6172 "" sumy += y; -#line 6183 "" +#line 6173 "" sumxy += x * y; -#line 6184 "" +#line 6174 "" sumxx += x * x; -#line 6185 "" +#line 6175 "" sumyy += y * y; -#line 6186 "" +#line 6176 "" x += spfacs_1.emgfac; -#line 6187 "" +#line 6177 "" /* L118: */ -#line 6187 "" +#line 6177 "" } -#line 6188 "" +#line 6178 "" delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx; -#line 6189 "" +#line 6179 "" em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta; -#line 6190 "" +#line 6180 "" r__1 = em * .5f * spfacs_1.gslfac; -#line 6190 "" +#line 6180 "" islope = i_nint(&r__1); -#line 6191 "" +#line 6181 "" if (abs(islope) > 9) { -#line 6191 "" +#line 6181 "" islope = i_sign(&c__9, &islope); -#line 6191 "" +#line 6181 "" } -#line 6192 "" +#line 6182 "" beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig - 1]; -#line 6193 "" +#line 6183 "" nolev1 = i_nint(&beta); /* Back up */ /* Writing concatenation */ -#line 6197 "" +#line 6187 "" i__4[0] = 1, a__3[0] = sq; -#line 6197 "" +#line 6187 "" i__4[1] = 7, a__3[1] = "settiny"; -#line 6197 "" +#line 6187 "" i__4[2] = 1, a__3[2] = sq; -#line 6197 "" +#line 6187 "" i__4[3] = 4, a__3[3] = "off{"; -#line 6197 "" +#line 6187 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 6198 "" +#line 6188 "" if (normsp) { -#line 6199 "" +#line 6189 "" s_wsfi(&io___460); -#line 6199 "" +#line 6189 "" do_fio(&c__1, "-", (ftnlen)1); -#line 6199 "" +#line 6189 "" do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real)); -#line 6199 "" +#line 6189 "" e_wsfi(); /* Writing concatenation */ -#line 6200 "" +#line 6190 "" i__2[0] = 18, a__1[0] = notexq; -#line 6200 "" +#line 6190 "" i__2[1] = 3, a__1[1] = "pt}"; -#line 6200 "" +#line 6190 "" s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21); -#line 6200 "" +#line 6190 "" addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); -#line 6201 "" +#line 6191 "" finalshift = ptgr[*ig]; -#line 6202 "" +#line 6192 "" } else { -#line 6203 "" +#line 6193 "" comgrace_1.aftshft = comask_1.wheadpt * 1.33f; -#line 6204 "" +#line 6194 "" if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { -#line 6204 "" +#line 6194 "" comgrace_1.aftshft += comask_1.wheadpt * .5f; -#line 6204 "" +#line 6194 "" } -#line 6205 "" +#line 6195 "" s_wsfi(&io___462); -#line 6205 "" +#line 6195 "" do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real)); -#line 6205 "" +#line 6195 "" e_wsfi(); /* Writing concatenation */ -#line 6206 "" +#line 6196 "" i__4[0] = 17, a__3[0] = notexq; -#line 6206 "" +#line 6196 "" i__4[1] = 3, a__3[1] = "pt}"; -#line 6206 "" +#line 6196 "" i__4[2] = 1, a__3[2] = sq; -#line 6206 "" +#line 6196 "" i__4[3] = 3, a__3[3] = "bsk"; -#line 6206 "" +#line 6196 "" s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24); -#line 6206 "" +#line 6196 "" addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80); -#line 6207 "" +#line 6197 "" } /* Start the beam */ /* Writing concatenation */ -#line 6211 "" +#line 6201 "" i__2[0] = 1, a__1[0] = sq; -#line 6211 "" +#line 6201 "" i__2[1] = 2, a__1[1] = "ib"; -#line 6211 "" +#line 6201 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6212 "" +#line 6202 "" i__1 = mg; -#line 6212 "" +#line 6202 "" for (ing = 2; ing <= i__1; ++ing) { /* Writing concatenation */ -#line 6213 "" +#line 6203 "" i__2[0] = ing + 1, a__1[0] = notexq; -#line 6213 "" +#line 6203 "" i__2[1] = 1, a__1[1] = "b"; -#line 6213 "" +#line 6203 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6214 "" +#line 6204 "" /* L119: */ -#line 6214 "" +#line 6204 "" } -#line 6215 "" +#line 6205 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6216 "" +#line 6206 "" i__2[0] = mg + 2, a__1[0] = notexq; -#line 6216 "" +#line 6206 "" i__2[1] = 1, a__1[1] = "u"; -#line 6216 "" +#line 6206 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6217 "" +#line 6207 "" } else { /* Writing concatenation */ -#line 6218 "" +#line 6208 "" i__2[0] = mg + 2, a__1[0] = notexq; -#line 6218 "" +#line 6208 "" i__2[1] = 1, a__1[1] = "l"; -#line 6218 "" +#line 6208 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6219 "" +#line 6209 "" } /* Writing concatenation */ -#line 6220 "" +#line 6210 "" i__2[0] = mg + 3, a__1[0] = notexq; -#line 6220 "" +#line 6210 "" i__2[1] = 1, a__1[1] = "0"; -#line 6220 "" +#line 6210 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); /* Get starting note for beam */ -#line 6224 "" +#line 6214 "" notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8); /* Writing concatenation */ -#line 6225 "" +#line 6215 "" i__2[0] = mg + 4, a__1[0] = notexq; -#line 6225 "" +#line 6215 "" i__2[1] = lnoten, a__1[1] = noteq; -#line 6225 "" +#line 6215 "" s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); -#line 6225 "" +#line 6215 "" i__1 = mg + 4 + lnoten; -#line 6225 "" +#line 6215 "" addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80); /* Put in the slope */ -#line 6230 "" +#line 6220 "" if (islope >= 0) { -#line 6231 "" +#line 6221 "" i__1 = islope + 48; -#line 6231 "" +#line 6221 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6231 "" +#line 6221 "" addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80); -#line 6232 "" +#line 6222 "" } else { /* Writing concatenation */ -#line 6233 "" +#line 6223 "" i__3[0] = 2, a__2[0] = "{-"; -#line 6233 "" +#line 6223 "" i__1 = 48 - islope; -#line 6233 "" +#line 6223 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6233 "" +#line 6223 "" i__3[1] = 1, a__2[1] = ch__1; -#line 6233 "" +#line 6223 "" i__3[2] = 1, a__2[2] = "}"; -#line 6233 "" +#line 6223 "" s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4); -#line 6233 "" +#line 6223 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80); -#line 6234 "" +#line 6224 "" } /* Start a slur on multiple fore-grace */ -#line 6238 "" +#line 6228 "" if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { -#line 6239 "" +#line 6229 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); -#line 6240 "" +#line 6230 "" if (comslur_1.fontslur) { -#line 6241 "" +#line 6231 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6242 "" +#line 6232 "" i__2[0] = 1, a__1[0] = sq; -#line 6242 "" +#line 6232 "" i__2[1] = 6, a__1[1] = "islurd"; -#line 6242 "" +#line 6232 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); -#line 6242 "" +#line 6232 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; -#line 6243 "" +#line 6233 "" } else { /* Writing concatenation */ -#line 6244 "" +#line 6234 "" i__2[0] = 1, a__1[0] = sq; -#line 6244 "" +#line 6234 "" i__2[1] = 6, a__1[1] = "isluru"; -#line 6244 "" +#line 6234 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); -#line 6244 "" +#line 6234 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; -#line 6245 "" +#line 6235 "" } -#line 6246 "" +#line 6236 "" } else { /* Need a tweak for postscript slur */ -#line 6250 "" +#line 6240 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6251 "" +#line 6241 "" i__2[0] = 1, a__1[0] = sq; -#line 6251 "" +#line 6241 "" i__2[1] = 3, a__1[1] = "isd"; -#line 6251 "" +#line 6241 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); -#line 6251 "" +#line 6241 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; -#line 6252 "" +#line 6242 "" } else { /* Writing concatenation */ -#line 6253 "" +#line 6243 "" i__2[0] = 1, a__1[0] = sq; -#line 6253 "" +#line 6243 "" i__2[1] = 3, a__1[1] = "isu"; -#line 6253 "" +#line 6243 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); -#line 6253 "" +#line 6243 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; -#line 6254 "" +#line 6244 "" } -#line 6255 "" +#line 6245 "" } /* Print 23-ndxslur */ -#line 6259 "" +#line 6249 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ -#line 6260 "" +#line 6250 "" i__1 = 71 - comslur_1.ndxslur; -#line 6260 "" +#line 6250 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6260 "" +#line 6250 "" i__2[0] = 1, a__1[0] = ch__1; -#line 6260 "" +#line 6250 "" i__2[1] = lnoten, a__1[1] = noteq; -#line 6260 "" +#line 6250 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); -#line 6260 "" +#line 6250 "" i__5 = lnoten + 1; -#line 6260 "" +#line 6250 "" addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); -#line 6262 "" +#line 6252 "" } else if (23 - comslur_1.ndxslur < 2) { /* Writing concatenation */ -#line 6263 "" +#line 6253 "" i__4[0] = 2, a__3[0] = "{1"; -#line 6263 "" +#line 6253 "" i__1 = 61 - comslur_1.ndxslur; -#line 6263 "" +#line 6253 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6263 "" +#line 6253 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6263 "" +#line 6253 "" i__4[2] = 1, a__3[2] = "}"; -#line 6263 "" +#line 6253 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6263 "" +#line 6253 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6263 "" +#line 6253 "" i__5 = lnoten + 4; -#line 6263 "" +#line 6253 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); -#line 6265 "" +#line 6255 "" } else { /* Writing concatenation */ -#line 6266 "" +#line 6256 "" i__4[0] = 2, a__3[0] = "{1"; -#line 6266 "" +#line 6256 "" i__1 = 51 - comslur_1.ndxslur; -#line 6266 "" +#line 6256 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 6266 "" +#line 6256 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6266 "" +#line 6256 "" i__4[2] = 1, a__3[2] = "}"; -#line 6266 "" +#line 6256 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6266 "" +#line 6256 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6266 "" +#line 6256 "" i__5 = lnoten + 4; -#line 6266 "" +#line 6256 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); -#line 6268 "" +#line 6258 "" } /* Put in tweak for postscript slur */ -#line 6272 "" +#line 6262 "" if (! comslur_1.fontslur) { -#line 6272 "" +#line 6262 "" addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); -#line 6272 "" +#line 6262 "" } -#line 6273 "" +#line 6263 "" } /* Put in first note. Call notefq again in case octave changed */ -#line 6277 "" +#line 6267 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); -#line 6278 "" +#line 6268 "" if (comgrace_1.naccg[ngs - 1] == 0) { /* Writing concatenation */ -#line 6279 "" +#line 6269 "" i__3[0] = 1, a__2[0] = sq; -#line 6279 "" +#line 6269 "" i__3[1] = 4, a__2[1] = "zqb0"; -#line 6279 "" +#line 6269 "" i__3[2] = lnoten, a__2[2] = noteq; -#line 6279 "" +#line 6269 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 6280 "" +#line 6270 "" lnote = lnoten + 5; -#line 6281 "" +#line 6271 "" } else { -#line 6282 "" +#line 6272 "" if (lnoten == 1) { -#line 6282 "" +#line 6272 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 6282 "" +#line 6272 "" } -#line 6283 "" +#line 6273 "" accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ -#line 6284 "" +#line 6274 "" i__4[0] = 1, a__3[0] = sq; -#line 6284 "" +#line 6274 "" i__4[1] = 3, a__3[1] = "big"; -#line 6284 "" +#line 6274 "" i__4[2] = lacc, a__3[2] = acsymq; -#line 6284 "" +#line 6274 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6284 "" +#line 6274 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 6285 "" +#line 6275 "" lnote = lacc + 4 + lnoten; -#line 6286 "" +#line 6276 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Writing concatenation */ -#line 6287 "" +#line 6277 "" i__4[0] = lnote, a__3[0] = notexq; -#line 6287 "" +#line 6277 "" i__4[1] = 1, a__3[1] = sq; -#line 6287 "" +#line 6277 "" i__4[2] = 4, a__3[2] = "zqb0"; -#line 6287 "" +#line 6277 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6287 "" +#line 6277 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 6288 "" +#line 6278 "" lnote = lnote + 5 + lnoten; -#line 6289 "" +#line 6279 "" } -#line 6290 "" +#line 6280 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); -#line 6291 "" +#line 6281 "" i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; -#line 6291 "" +#line 6281 "" for (ing = ngs + 1; ing <= i__1; ++ing) { /* Skip */ -#line 6295 "" +#line 6285 "" ptoff = wheadpt1 * spfacs_1.emgfac; -#line 6296 "" +#line 6286 "" if (comgrace_1.naccg[ing - 1] > 0) { -#line 6296 "" +#line 6286 "" ptoff += wheadpt1 * spfacs_1.acgfac; -#line 6296 "" +#line 6286 "" } -#line 6297 "" +#line 6287 "" if (isgaft && ! iswaft) { -#line 6297 "" +#line 6287 "" comgrace_1.aftshft += ptoff; -#line 6297 "" +#line 6287 "" } /* Writing concatenation */ -#line 6298 "" +#line 6288 "" i__2[0] = 1, a__1[0] = sq; -#line 6298 "" +#line 6288 "" i__2[1] = 4, a__1[1] = "off{"; -#line 6298 "" +#line 6288 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6299 "" +#line 6289 "" s_wsfi(&io___464); -#line 6299 "" +#line 6289 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); -#line 6299 "" +#line 6289 "" e_wsfi(); -#line 6300 "" +#line 6290 "" if (normsp) { -#line 6300 "" +#line 6290 "" finalshift -= ptoff; -#line 6300 "" +#line 6290 "" } /* Writing concatenation */ -#line 6301 "" +#line 6291 "" i__2[0] = 8, a__1[0] = notexq; -#line 6301 "" +#line 6291 "" i__2[1] = 3, a__1[1] = "pt}"; -#line 6301 "" +#line 6291 "" s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); -#line 6301 "" +#line 6291 "" addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); -#line 6302 "" +#line 6292 "" if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) { /* Terminate beam if needed */ -#line 6306 "" +#line 6296 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ -#line 6307 "" +#line 6297 "" i__2[0] = 1, a__1[0] = sq; -#line 6307 "" +#line 6297 "" i__2[1] = 4, a__1[1] = "tbu0"; -#line 6307 "" +#line 6297 "" s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); -#line 6307 "" +#line 6297 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) ; -#line 6308 "" +#line 6298 "" } else { /* Writing concatenation */ -#line 6309 "" +#line 6299 "" i__2[0] = 1, a__1[0] = sq; -#line 6309 "" +#line 6299 "" i__2[1] = 4, a__1[1] = "tbl0"; -#line 6309 "" +#line 6299 "" s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); -#line 6309 "" +#line 6299 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) ; -#line 6310 "" +#line 6300 "" } /* Terminate after slur if needed */ -#line 6314 "" +#line 6304 "" if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) { /* if (iswaft) ndxslur = igetbits(ipl,4,23) */ -#line 6316 "" +#line 6306 "" if (iswaft) { -#line 6316 "" +#line 6306 "" comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); -#line 6316 "" +#line 6306 "" } -#line 6317 "" +#line 6307 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen)8); /* Writing concatenation */ -#line 6318 "" +#line 6308 "" i__2[0] = 1, a__1[0] = sq; -#line 6318 "" +#line 6308 "" i__2[1] = 5, a__1[1] = "tslur"; -#line 6318 "" +#line 6308 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); -#line 6318 "" +#line 6308 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80) ; /* Print 11-ndxslur */ /* c Print 23-ndxslur */ -#line 6323 "" +#line 6313 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ -#line 6324 "" +#line 6314 "" i__5 = 71 - comslur_1.ndxslur; -#line 6324 "" +#line 6314 "" chax_(ch__1, (ftnlen)1, &i__5); -#line 6324 "" +#line 6314 "" i__2[0] = 1, a__1[0] = ch__1; -#line 6324 "" +#line 6314 "" i__2[1] = lnoten, a__1[1] = noteq; -#line 6324 "" +#line 6314 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); -#line 6324 "" +#line 6314 "" i__6 = lnoten + 1; -#line 6324 "" +#line 6314 "" addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, ( ftnlen)80); -#line 6326 "" +#line 6316 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 6327 "" +#line 6317 "" i__4[0] = 2, a__3[0] = "{2"; -#line 6327 "" +#line 6317 "" i__5 = 61 - comslur_1.ndxslur; -#line 6327 "" +#line 6317 "" chax_(ch__1, (ftnlen)1, &i__5); -#line 6327 "" +#line 6317 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6327 "" +#line 6317 "" i__4[2] = 1, a__3[2] = "}"; -#line 6327 "" +#line 6317 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6327 "" +#line 6317 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6327 "" +#line 6317 "" i__6 = lnoten + 4; -#line 6327 "" +#line 6317 "" addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( ftnlen)80); -#line 6329 "" +#line 6319 "" } else { /* Writing concatenation */ -#line 6330 "" +#line 6320 "" i__4[0] = 2, a__3[0] = "{1"; -#line 6330 "" +#line 6320 "" i__5 = 51 - comslur_1.ndxslur; -#line 6330 "" +#line 6320 "" chax_(ch__1, (ftnlen)1, &i__5); -#line 6330 "" +#line 6320 "" i__4[1] = 1, a__3[1] = ch__1; -#line 6330 "" +#line 6320 "" i__4[2] = 1, a__3[2] = "}"; -#line 6330 "" +#line 6320 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6330 "" +#line 6320 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); -#line 6330 "" +#line 6320 "" i__6 = lnoten + 4; -#line 6330 "" +#line 6320 "" addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( ftnlen)80); -#line 6332 "" +#line 6322 "" } /* Stop slur terminator after exit from this subroutine */ -#line 6336 "" +#line 6326 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); -#line 6337 "" +#line 6327 "" comgrace_1.slurg[*ig - 1] = FALSE_; -#line 6338 "" +#line 6328 "" } -#line 6339 "" +#line 6329 "" } /* Accidental if needed */ -#line 6343 "" +#line 6333 "" if (comgrace_1.naccg[ing - 1] > 0) { -#line 6344 "" +#line 6334 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, ( ftnlen)8); -#line 6345 "" +#line 6335 "" if (lnoten == 1) { -#line 6345 "" +#line 6335 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 6345 "" +#line 6335 "" } -#line 6346 "" +#line 6336 "" accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ -#line 6347 "" +#line 6337 "" i__4[0] = 1, a__3[0] = sq; -#line 6347 "" +#line 6337 "" i__4[1] = 3, a__3[1] = "big"; -#line 6347 "" +#line 6337 "" i__4[2] = lacc, a__3[2] = acsymq; -#line 6347 "" +#line 6337 "" i__4[3] = lnoten, a__3[3] = noteq; -#line 6347 "" +#line 6337 "" s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); -#line 6347 "" +#line 6337 "" i__5 = lacc + 4 + lnoten; -#line 6347 "" +#line 6337 "" addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, ( ftnlen)80); -#line 6349 "" +#line 6339 "" } /* Put in the (beamed) grace note */ -#line 6353 "" +#line 6343 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen) 8); /* Writing concatenation */ -#line 6354 "" +#line 6344 "" i__3[0] = 1, a__2[0] = sq; -#line 6354 "" +#line 6344 "" i__3[1] = 4, a__2[1] = "zqb0"; -#line 6354 "" +#line 6344 "" i__3[2] = lnoten, a__2[2] = noteq; -#line 6354 "" +#line 6344 "" s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13); -#line 6354 "" +#line 6344 "" i__5 = lnoten + 5; -#line 6354 "" +#line 6344 "" addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80); -#line 6356 "" +#line 6346 "" /* L127: */ -#line 6356 "" +#line 6346 "" } /* Terminate the grace */ @@ -15549,147 +15547,147 @@ L121: /* notexq = '}'//sq//'off{' */ /* lnote = 6 */ /* Writing concatenation */ -#line 6364 "" +#line 6354 "" i__2[0] = 1, a__1[0] = sq; -#line 6364 "" +#line 6354 "" i__2[1] = 4, a__1[1] = "off{"; -#line 6364 "" +#line 6354 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6365 "" +#line 6355 "" lnote = 5; -#line 6366 "" +#line 6356 "" ptoff = comask_1.wheadpt * spfacs_1.emgfac; -#line 6367 "" +#line 6357 "" if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) { -#line 6367 "" +#line 6357 "" ptoff += comask_1.wheadpt * spfacs_1.accfac; -#line 6367 "" +#line 6357 "" } -#line 6369 "" +#line 6359 "" if (isgaft && ! iswaft) { /* Writing concatenation */ -#line 6370 "" +#line 6360 "" i__2[0] = 5, a__1[0] = notexq; -#line 6370 "" +#line 6360 "" i__2[1] = 1, a__1[1] = "-"; -#line 6370 "" +#line 6360 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 6371 "" +#line 6361 "" lnote = 6; -#line 6372 "" +#line 6362 "" ptoff = comgrace_1.aftshft; -#line 6373 "" +#line 6363 "" } -#line 6374 "" +#line 6364 "" if (normsp) { -#line 6374 "" +#line 6364 "" ptoff = finalshift; -#line 6374 "" +#line 6364 "" } -#line 6375 "" +#line 6365 "" if (ptoff < 9.95f) { -#line 6376 "" +#line 6366 "" i__1 = lnote; -#line 6376 "" +#line 6366 "" ici__1.icierr = 0; -#line 6376 "" +#line 6366 "" ici__1.icirnum = 1; -#line 6376 "" +#line 6366 "" ici__1.icirlen = lnote + 3 - i__1; -#line 6376 "" +#line 6366 "" ici__1.iciunit = notexq + i__1; -#line 6376 "" +#line 6366 "" ici__1.icifmt = "(f3.1)"; -#line 6376 "" +#line 6366 "" s_wsfi(&ici__1); -#line 6376 "" +#line 6366 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); -#line 6376 "" +#line 6366 "" e_wsfi(); -#line 6377 "" +#line 6367 "" lnote += 3; -#line 6378 "" +#line 6368 "" } else if (ptoff < 99.95f) { -#line 6379 "" +#line 6369 "" i__1 = lnote; -#line 6379 "" +#line 6369 "" ici__1.icierr = 0; -#line 6379 "" +#line 6369 "" ici__1.icirnum = 1; -#line 6379 "" +#line 6369 "" ici__1.icirlen = lnote + 4 - i__1; -#line 6379 "" +#line 6369 "" ici__1.iciunit = notexq + i__1; -#line 6379 "" +#line 6369 "" ici__1.icifmt = "(f4.1)"; -#line 6379 "" +#line 6369 "" s_wsfi(&ici__1); -#line 6379 "" +#line 6369 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); -#line 6379 "" +#line 6369 "" e_wsfi(); -#line 6380 "" +#line 6370 "" lnote += 4; -#line 6381 "" +#line 6371 "" } else { -#line 6382 "" +#line 6372 "" i__1 = lnote; -#line 6382 "" +#line 6372 "" ici__1.icierr = 0; -#line 6382 "" +#line 6372 "" ici__1.icirnum = 1; -#line 6382 "" +#line 6372 "" ici__1.icirlen = lnote + 5 - i__1; -#line 6382 "" +#line 6372 "" ici__1.iciunit = notexq + i__1; -#line 6382 "" +#line 6372 "" ici__1.icifmt = "(f5.1)"; -#line 6382 "" +#line 6372 "" s_wsfi(&ici__1); -#line 6382 "" +#line 6372 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); -#line 6382 "" +#line 6372 "" e_wsfi(); -#line 6383 "" +#line 6373 "" lnote += 5; -#line 6384 "" +#line 6374 "" } /* Writing concatenation */ -#line 6385 "" +#line 6375 "" i__2[0] = lnote, a__1[0] = notexq; -#line 6385 "" +#line 6375 "" i__2[1] = 3, a__1[1] = "pt}"; -#line 6385 "" +#line 6375 "" s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82); -#line 6385 "" +#line 6375 "" i__1 = lnote + 3; -#line 6385 "" +#line 6375 "" addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80); -#line 6386 "" +#line 6376 "" if (isgaft && ! iswaft) { /* Writing concatenation */ -#line 6386 "" +#line 6376 "" i__2[0] = 1, a__1[0] = sq; -#line 6386 "" +#line 6376 "" i__2[1] = 2, a__1[1] = "sk"; -#line 6386 "" +#line 6376 "" s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3); -#line 6386 "" +#line 6376 "" addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80); -#line 6386 "" +#line 6376 "" } /* Writing concatenation */ -#line 6387 "" +#line 6377 "" i__2[0] = 1, a__1[0] = sq; -#line 6387 "" +#line 6377 "" i__2[1] = 9, a__1[1] = "resetsize"; -#line 6387 "" +#line 6377 "" s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10); -#line 6387 "" +#line 6377 "" addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80); -#line 6388 "" +#line 6378 "" } -#line 6389 "" +#line 6379 "" return 0; } /* dograce_ */ @@ -15811,67 +15809,67 @@ L121: /* If highest note has upslur, save slur height in islhgt in case */ /* ornament must be moved. */ -#line 6486 "" +#line 6476 "" /* Parameter adjustments */ -#line 6486 "" +#line 6476 "" --isdat4; -#line 6486 "" +#line 6476 "" --isdat3; -#line 6486 "" +#line 6476 "" --isdat2; -#line 6486 "" +#line 6476 "" --isdat1; -#line 6486 "" +#line 6476 "" -#line 6486 "" +#line 6476 "" /* Function Body */ -#line 6486 "" +#line 6476 "" *islhgt = 0; -#line 6487 "" +#line 6477 "" if (*beamon) { -#line 6488 "" +#line 6478 "" stemup = *(unsigned char *)ulq == 'u'; -#line 6489 "" +#line 6479 "" } else if (commvl_1.nvmx[*iv - 1] == 2) { -#line 6490 "" +#line 6480 "" if (! bit_test(*islur,30)) { /* Single note, 2 lines of music, stem direction not forced */ -#line 6494 "" +#line 6484 "" stemup = commvl_1.ivx > *nv; -#line 6495 "" +#line 6485 "" } else { -#line 6496 "" +#line 6486 "" stemup = bit_test(*islur,17); -#line 6497 "" +#line 6487 "" } -#line 6498 "" +#line 6488 "" } else { -#line 6499 "" +#line 6489 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & commvl_1.ivx, nv); -#line 6499 "" +#line 6489 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; -#line 6500 "" +#line 6490 "" } -#line 6501 "" +#line 6491 "" iscrd = bit_test(*ipl,10); -#line 6502 "" +#line 6492 "" if (commidi_1.ismidi) { -#line 6503 "" +#line 6493 "" settie = FALSE_; -#line 6504 "" +#line 6494 "" comslm_1.dbltie = FALSE_; -#line 6505 "" +#line 6495 "" } -#line 6506 "" +#line 6496 "" i__1 = *nsdat; -#line 6506 "" +#line 6496 "" for (isdat = 1; isdat <= i__1; ++isdat) { -#line 6507 "" +#line 6497 "" isdata = isdat1[isdat]; -#line 6508 "" +#line 6498 "" if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(& isdata, &c__8, &c__3) && (*kv == igetbits_(&isdata, &c__1, & c__12) + 1 || bit_test(isdata,1))) { @@ -15879,217 +15877,217 @@ L121: /* Since iv and kv match, ivx will be correct */ -#line 6516 "" +#line 6506 "" idcode = igetbits_(&isdata, &c__7, &c__19); -#line 6517 "" +#line 6507 "" ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; -#line 6518 "" +#line 6508 "" ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; -#line 6519 "" +#line 6509 "" iupdn = 0; -#line 6520 "" +#line 6510 "" *(unsigned char *)slurudq = 'd'; -#line 6521 "" +#line 6511 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); -#line 6522 "" +#line 6512 "" pstie = bit_test(isdat2[isdat],3) || idcode == 1; -#line 6523 "" +#line 6513 "" if (bit_test(isdata,11)) { /* Turnon */ /* Get slur direction */ -#line 6528 "" +#line 6518 "" if (bit_test(isdata,26)) { /* Force slur direction */ -#line 6532 "" +#line 6522 "" if (bit_test(isdata,27)) { -#line 6532 "" +#line 6522 "" *(unsigned char *)slurudq = 'u'; -#line 6532 "" +#line 6522 "" } -#line 6533 "" +#line 6523 "" } else if (commvl_1.nvmx[*iv - 1] == 1) { /* Only one voice per line */ -#line 6537 "" +#line 6527 "" if (! (*beamon)) { /* Separate note. */ -#line 6541 "" +#line 6531 "" udfq_(ch__1, (ftnlen)1, nolev, ncm); -#line 6541 "" +#line 6531 "" *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ 0]; -#line 6542 "" +#line 6532 "" } else { /* In a beam */ -#line 6546 "" +#line 6536 "" if (*(unsigned char *)ulq != 'u') { -#line 6546 "" +#line 6536 "" *(unsigned char *)slurudq = 'u'; -#line 6546 "" +#line 6536 "" } -#line 6547 "" +#line 6537 "" } -#line 6548 "" +#line 6538 "" if (iscrd) { -#line 6549 "" +#line 6539 "" if (nolevs > *ncm) { -#line 6550 "" +#line 6540 "" *(unsigned char *)slurudq = 'u'; -#line 6551 "" +#line 6541 "" } else { -#line 6552 "" +#line 6542 "" *(unsigned char *)slurudq = 'd'; -#line 6553 "" +#line 6543 "" } -#line 6554 "" +#line 6544 "" } -#line 6555 "" +#line 6545 "" } else { /* Two voices per line. Get default */ -#line 6559 "" +#line 6549 "" if (commvl_1.ivx > *nv) { -#line 6559 "" +#line 6549 "" *(unsigned char *)slurudq = 'u'; -#line 6559 "" +#line 6549 "" } /* Upper voice of the two, so up slur */ -#line 6563 "" +#line 6553 "" } -#line 6564 "" +#line 6554 "" if (bit_test(isdata,2)) { /* ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. */ -#line 6568 "" +#line 6558 "" if (stemup) { -#line 6569 "" +#line 6559 "" *(unsigned char *)slurudq = 'u'; -#line 6570 "" +#line 6560 "" ivoff += 4; -#line 6571 "" +#line 6561 "" } else { -#line 6572 "" +#line 6562 "" *(unsigned char *)slurudq = 'd'; -#line 6573 "" +#line 6563 "" ivoff += -4; -#line 6574 "" +#line 6564 "" } -#line 6575 "" +#line 6565 "" } /* Set level for slur starting on rest */ -#line 6579 "" +#line 6569 "" if (nolevs == 0 || nolevs > 60) { -#line 6580 "" +#line 6570 "" if (*(unsigned char *)slurudq == 'u') { -#line 6581 "" +#line 6571 "" nolevs = *ncm + 2; -#line 6582 "" +#line 6572 "" } else { -#line 6583 "" +#line 6573 "" nolevs = *ncm - 2; -#line 6584 "" +#line 6574 "" } -#line 6585 "" +#line 6575 "" } /* Save up/down-ness for use at termination */ -#line 6589 "" +#line 6579 "" if (*(unsigned char *)slurudq == 'u') { -#line 6589 "" +#line 6579 "" isdata = bit_set(isdata,27); -#line 6589 "" +#line 6579 "" } /* End of section for setting slur direction, still in "Turnon" if-block. */ -#line 6593 "" +#line 6583 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ -#line 6597 "" +#line 6587 "" ivoffinc = 0; -#line 6598 "" +#line 6588 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { /* Must move the slur for _ or . */ -#line 6603 "" +#line 6593 "" if (stemup) { -#line 6604 "" +#line 6594 "" ivoffinc = -1; -#line 6605 "" +#line 6595 "" } else { -#line 6606 "" +#line 6596 "" ivoffinc = 1; -#line 6607 "" +#line 6597 "" } -#line 6608 "" +#line 6598 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { -#line 6608 "" +#line 6598 "" ivoffinc <<= 1; -#line 6608 "" +#line 6598 "" } -#line 6611 "" +#line 6601 "" ivoff += ivoffinc; -#line 6612 "" +#line 6602 "" } -#line 6613 "" +#line 6603 "" } -#line 6614 "" +#line 6604 "" if (comslur_1.listslur == 16777215) { -#line 6615 "" +#line 6605 "" s_wsle(&io___478); -#line 6615 "" +#line 6605 "" e_wsle(); -#line 6616 "" +#line 6606 "" s_wsle(&io___479); -#line 6616 "" +#line 6606 "" do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"\ " one too many!", (ftnlen)48); -#line 6616 "" +#line 6606 "" e_wsle(); -#line 6617 "" +#line 6607 "" s_wsfe(&io___480); -#line 6617 "" +#line 6607 "" do_fio(&c__1, "You defined the twentyfifth slur, one too"\ " many!", (ftnlen)47); -#line 6617 "" +#line 6607 "" e_wsfe(); -#line 6619 "" +#line 6609 "" stop1_(); -#line 6620 "" +#line 6610 "" } /* Get index of next slur not in use, starting from 12 down */ -#line 6624 "" +#line 6614 "" i__2 = 16777215 - comslur_1.listslur; -#line 6624 "" +#line 6614 "" comslur_1.ndxslur = log2_(&i__2); /* Record slur index */ -#line 6628 "" +#line 6618 "" comslur_1.listslur = bit_set(comslur_1.listslur, comslur_1.ndxslur); @@ -16097,206 +16095,206 @@ L121: /* call setbits(isdata,4,28,ndxslur) */ /* 080531 Allow >16 slurs */ -#line 6634 "" +#line 6624 "" i__2 = comslur_1.ndxslur % 16; -#line 6634 "" +#line 6624 "" setbits_(&isdata, &c__4, &c__28, &i__2); -#line 6635 "" +#line 6625 "" i__2 = comslur_1.ndxslur / 16; -#line 6635 "" +#line 6625 "" setbits_(&isdata, &c__1, &c__18, &i__2); /* Shift for stem? */ -#line 6639 "" +#line 6629 "" if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) { -#line 6640 "" +#line 6630 "" if (! pstie) { -#line 6641 "" +#line 6631 "" ihoff += 8; -#line 6642 "" +#line 6632 "" } else { -#line 6643 "" +#line 6633 "" ihoff += 2; -#line 6644 "" +#line 6634 "" } -#line 6645 "" +#line 6635 "" } -#line 6646 "" +#line 6636 "" if (iscrd) { /* Additional horiz shifts for h-shifted noteheads? */ -#line 6650 "" +#line 6640 "" if (bit_test(isdat2[isdat],1)) { /* Slur start on left-shifted chord notehead. ASSUME downstem. */ -#line 6654 "" +#line 6644 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { -#line 6655 "" +#line 6645 "" ihoff += -2; -#line 6656 "" +#line 6646 "" } else { -#line 6657 "" +#line 6647 "" ihoff += -10; -#line 6658 "" +#line 6648 "" } -#line 6659 "" +#line 6649 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ -#line 6663 "" +#line 6653 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { -#line 6664 "" +#line 6654 "" ihoff += 2; -#line 6665 "" +#line 6655 "" } else { -#line 6666 "" +#line 6656 "" ihoff += 10; -#line 6667 "" +#line 6657 "" } -#line 6668 "" +#line 6658 "" } -#line 6669 "" +#line 6659 "" } -#line 6670 "" +#line 6660 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6670 "" +#line 6660 "" s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); -#line 6671 "" +#line 6661 "" lnote = 1; /* Check for local adjustment default changes */ -#line 6675 "" +#line 6665 "" if (bit_test(isdat2[isdat],26)) { /* Writing concatenation */ -#line 6676 "" +#line 6666 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6676 "" +#line 6666 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6676 "" +#line 6666 "" i__3[1] = 10, a__1[1] = "sluradjust"; -#line 6676 "" +#line 6666 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 6676 "" +#line 6666 "" i__3[2] = 1, a__1[2] = ch__2; -#line 6676 "" +#line 6666 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6677 "" +#line 6667 "" lnote = 12; -#line 6678 "" +#line 6668 "" } else if (bit_test(isdat2[isdat],27)) { /* Writing concatenation */ -#line 6679 "" +#line 6669 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6679 "" +#line 6669 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6679 "" +#line 6669 "" i__3[1] = 12, a__1[1] = "nosluradjust"; -#line 6679 "" +#line 6669 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 6679 "" +#line 6669 "" i__3[2] = 1, a__1[2] = ch__2; -#line 6679 "" +#line 6669 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6680 "" +#line 6670 "" lnote = 14; -#line 6681 "" +#line 6671 "" } else if (bit_test(isdat2[isdat],28)) { /* Writing concatenation */ -#line 6682 "" +#line 6672 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6682 "" +#line 6672 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6682 "" +#line 6672 "" i__3[1] = 9, a__1[1] = "tieadjust"; -#line 6682 "" +#line 6672 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 6682 "" +#line 6672 "" i__3[2] = 1, a__1[2] = ch__2; -#line 6682 "" +#line 6672 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6683 "" +#line 6673 "" lnote = 11; -#line 6684 "" +#line 6674 "" } else if (bit_test(isdat2[isdat],29)) { /* Writing concatenation */ -#line 6685 "" +#line 6675 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6685 "" +#line 6675 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6685 "" +#line 6675 "" i__3[1] = 11, a__1[1] = "notieadjust"; -#line 6685 "" +#line 6675 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 6685 "" +#line 6675 "" i__3[2] = 1, a__1[2] = ch__2; -#line 6685 "" +#line 6675 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6686 "" +#line 6676 "" lnote = 13; -#line 6687 "" +#line 6677 "" } -#line 6688 "" +#line 6678 "" if (ihoff == 0) { /* Write stuff for non-shifted start */ /* Writing concatenation */ -#line 6692 "" +#line 6682 "" i__3[0] = lnote, a__1[0] = notexq; -#line 6692 "" +#line 6682 "" i__3[1] = 5, a__1[1] = "islur"; -#line 6692 "" +#line 6682 "" i__3[2] = 1, a__1[2] = slurudq; -#line 6692 "" +#line 6682 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6693 "" +#line 6683 "" lnote += 6; -#line 6694 "" +#line 6684 "" } else { /* Writing concatenation */ -#line 6695 "" +#line 6685 "" i__3[0] = lnote, a__1[0] = notexq; -#line 6695 "" +#line 6685 "" i__3[1] = 2, a__1[1] = "is"; -#line 6695 "" +#line 6685 "" i__3[2] = 1, a__1[2] = slurudq; -#line 6695 "" +#line 6685 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6696 "" +#line 6686 "" lnote += 3; -#line 6697 "" +#line 6687 "" } /* Prepend postscript tie switch */ -#line 6701 "" +#line 6691 "" if (pstie) { /* Writing concatenation */ -#line 6702 "" +#line 6692 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6702 "" +#line 6692 "" i__4[0] = 1, a__2[0] = ch__1; -#line 6702 "" +#line 6692 "" i__4[1] = 8, a__2[1] = "tieforis"; -#line 6702 "" +#line 6692 "" i__4[2] = 1, a__2[2] = slurudq; -#line 6702 "" +#line 6692 "" i__4[3] = lnote, a__2[3] = notexq; -#line 6702 "" +#line 6692 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 6703 "" +#line 6693 "" lnote += 10; -#line 6704 "" +#line 6694 "" } -#line 6705 "" +#line 6695 "" if (bit_test(isdat2[isdat],4)) { /* Dotted slur */ @@ -16304,288 +16302,288 @@ L121: /* noteq = notexq */ /* notexq = chax(92)//'dotted'//noteq */ /* Writing concatenation */ -#line 6711 "" +#line 6701 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6711 "" +#line 6701 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6711 "" +#line 6701 "" i__3[1] = 6, a__1[1] = "dotted"; -#line 6711 "" +#line 6701 "" i__3[2] = lnote, a__1[2] = notexq; -#line 6711 "" +#line 6701 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6712 "" +#line 6702 "" lnote += 7; -#line 6713 "" +#line 6703 "" } /* Add slur index to string */ /* Print 23-ndxslur */ -#line 6718 "" +#line 6708 "" if (23 - comslur_1.ndxslur < 10) { /* 5/25/08 Allow 24 slurs */ /* Writing concatenation */ -#line 6722 "" +#line 6712 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6722 "" +#line 6712 "" i__2 = 71 - comslur_1.ndxslur; -#line 6722 "" +#line 6712 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6722 "" +#line 6712 "" i__5[1] = 1, a__3[1] = ch__1; -#line 6722 "" +#line 6712 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6723 "" +#line 6713 "" ++lnote; -#line 6724 "" +#line 6714 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 6725 "" +#line 6715 "" i__4[0] = lnote, a__2[0] = notexq; -#line 6725 "" +#line 6715 "" i__4[1] = 2, a__2[1] = "{1"; -#line 6725 "" +#line 6715 "" i__2 = 61 - comslur_1.ndxslur; -#line 6725 "" +#line 6715 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6725 "" +#line 6715 "" i__4[2] = 1, a__2[2] = ch__1; -#line 6725 "" +#line 6715 "" i__4[3] = 1, a__2[3] = "}"; -#line 6725 "" +#line 6715 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 6726 "" +#line 6716 "" lnote += 4; -#line 6727 "" +#line 6717 "" } else { /* Writing concatenation */ -#line 6728 "" +#line 6718 "" i__4[0] = lnote, a__2[0] = notexq; -#line 6728 "" +#line 6718 "" i__4[1] = 2, a__2[1] = "{2"; -#line 6728 "" +#line 6718 "" i__2 = 51 - comslur_1.ndxslur; -#line 6728 "" +#line 6718 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6728 "" +#line 6718 "" i__4[2] = 1, a__2[2] = ch__1; -#line 6728 "" +#line 6718 "" i__4[3] = 1, a__2[3] = "}"; -#line 6728 "" +#line 6718 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 6729 "" +#line 6719 "" lnote += 4; -#line 6730 "" +#line 6720 "" } /* Add note name to string */ -#line 6734 "" +#line 6724 "" *islhgt = nolevs + iupdn + ivoff; -#line 6735 "" +#line 6725 "" notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8); /* Writing concatenation */ -#line 6736 "" +#line 6726 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6736 "" +#line 6726 "" i__5[1] = lnoten, a__3[1] = noteq; -#line 6736 "" +#line 6726 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6737 "" +#line 6727 "" lnote += lnoten; /* Store height and staff mid level for use with LineBreakTies */ -#line 6741 "" +#line 6731 "" setbits_(&isdat3[isdat], &c__8, &c__14, islhgt); -#line 6742 "" +#line 6732 "" setbits_(&isdat3[isdat], &c__8, &c__22, ncm); /* Save height (for ornament and barnobox interference) if topmost slur is up */ -#line 6746 "" +#line 6736 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { -#line 6748 "" +#line 6738 "" *islhgt = nolevs + iupdn + ivoff; /* Save height & idcode if top voice and slur start */ -#line 6752 "" +#line 6742 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { -#line 6753 "" +#line 6743 "" comsln_1.is1n1 = *islhgt; -#line 6754 "" +#line 6744 "" comsln_1.is2n1 = idcode; -#line 6755 "" +#line 6745 "" } -#line 6756 "" +#line 6746 "" } -#line 6757 "" +#line 6747 "" if ((real) ihoff != 0.f) { -#line 6758 "" +#line 6748 "" shift = ihoff * .1f; /* Writing concatenation */ -#line 6759 "" +#line 6749 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6759 "" +#line 6749 "" i__5[1] = 1, a__3[1] = "{"; -#line 6759 "" +#line 6749 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6760 "" +#line 6750 "" ++lnote; -#line 6761 "" +#line 6751 "" lform = lfmt1_(&shift); -#line 6762 "" +#line 6752 "" i__2 = lnote; -#line 6762 "" +#line 6752 "" ici__1.icierr = 0; -#line 6762 "" +#line 6752 "" ici__1.icirnum = 1; -#line 6762 "" +#line 6752 "" ici__1.icirlen = lnote + lform - i__2; -#line 6762 "" +#line 6752 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 6762 "" +#line 6752 "" i__3[0] = 2, a__1[0] = "(f"; -#line 6762 "" +#line 6752 "" i__6 = lform + 48; -#line 6762 "" +#line 6752 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 6762 "" +#line 6752 "" i__3[1] = 1, a__1[1] = ch__1; -#line 6762 "" +#line 6752 "" i__3[2] = 3, a__1[2] = ".1)"; -#line 6762 "" +#line 6752 "" ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) 6), ch__3); -#line 6762 "" +#line 6752 "" s_wsfi(&ici__1); -#line 6762 "" +#line 6752 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); -#line 6762 "" +#line 6752 "" e_wsfi(); -#line 6764 "" +#line 6754 "" lnote += lform; /* Writing concatenation */ -#line 6765 "" +#line 6755 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6765 "" +#line 6755 "" i__5[1] = 1, a__3[1] = "}"; -#line 6765 "" +#line 6755 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6766 "" +#line 6756 "" ++lnote; -#line 6767 "" +#line 6757 "" } -#line 6768 "" +#line 6758 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Zero out ip1 to avoid problems if slur goes to next input blk. */ -#line 6772 "" +#line 6762 "" setbits_(&isdata, &c__8, &c__3, &c__0); /* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */ -#line 6776 "" +#line 6766 "" if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { /* levson(midchan(iv,kv)) = nolevs */ /* 130316 */ -#line 6779 "" +#line 6769 "" comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1]; -#line 6780 "" +#line 6770 "" if (settie) { -#line 6780 "" +#line 6770 "" comslm_1.dbltie = TRUE_; -#line 6780 "" +#line 6770 "" } /* Only way settie=T is if we just set a tie ending. So there's also a slur */ /* start here, so set a flag telling addmidi not to zero out levson */ -#line 6785 "" +#line 6775 "" } -#line 6786 "" +#line 6776 "" } else { /* Slur is ending. Back thru list to find starting slur */ -#line 6790 "" +#line 6780 "" for (j = isdat - 1; j >= 1; --j) { -#line 6791 "" +#line 6781 "" if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && (*kv == igetbits_(&isdat1[j], &c__1, &c__12) + 1 || bit_test(isdat1[j],1))) { /* * kv.eq.igetbits(isdat1(j),1,12)+1) then */ -#line 6795 "" +#line 6785 "" if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { -#line 6796 "" +#line 6786 "" comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & c__28) + (igetbits_(&isdat1[j], &c__1, & c__18) << 4); /* 080531 Allow >16 slurs */ -#line 6801 "" +#line 6791 "" if (bit_test(isdat1[j],27)) { -#line 6801 "" +#line 6791 "" *(unsigned char *)slurudq = 'u'; -#line 6801 "" +#line 6791 "" } -#line 6802 "" +#line 6792 "" goto L4; -#line 6803 "" +#line 6793 "" } -#line 6804 "" +#line 6794 "" } -#line 6805 "" +#line 6795 "" /* L3: */ -#line 6805 "" +#line 6795 "" } -#line 6806 "" +#line 6796 "" s_wsle(&io___488); -#line 6806 "" +#line 6796 "" do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); -#line 6806 "" +#line 6796 "" e_wsle(); -#line 6807 "" +#line 6797 "" stop1_(); -#line 6808 "" +#line 6798 "" L4: /* Bugfix 070901 for slur ending on rest in 2-voice staff */ -#line 6812 "" +#line 6802 "" if (nolevs <= 2 || nolevs > 60) { /* Ending is on a rest, reset nolevs to default starting height */ -#line 6816 "" +#line 6806 "" nolevs = igetbits_(&isdat2[j], &c__7, &c__19); -#line 6817 "" +#line 6807 "" } -#line 6818 "" +#line 6808 "" if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) { /* Deal with \curve or \midslur. isdat is ending, j is start. */ -#line 6822 "" +#line 6812 "" if (bit_test(isdat3[isdat],0)) { -#line 6823 "" +#line 6813 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; -#line 6824 "" +#line 6814 "" } else { -#line 6825 "" +#line 6815 "" imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32; -#line 6826 "" +#line 6816 "" } /* Postscript slurs, and \midslur adjustment is needed. Invoke macro */ @@ -16598,458 +16596,458 @@ L4: /* 6+ HH */ /* Writing concatenation */ -#line 6837 "" +#line 6827 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6837 "" +#line 6827 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6837 "" +#line 6827 "" i__3[1] = 7, a__1[1] = "psforts"; /* Computing MIN */ -#line 6837 "" +#line 6827 "" i__6 = abs(imid); -#line 6837 "" +#line 6827 "" i__2 = min(i__6,6) + 48; -#line 6837 "" +#line 6827 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 6837 "" +#line 6827 "" i__3[2] = 1, a__1[2] = ch__2; -#line 6837 "" +#line 6827 "" s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9); -#line 6837 "" +#line 6827 "" addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80) ; -#line 6839 "" +#line 6829 "" } -#line 6840 "" +#line 6830 "" if (bit_test(isdata,2)) { /* ADjust for stem slur. */ -#line 6844 "" +#line 6834 "" if (stemup) { -#line 6845 "" +#line 6835 "" *(unsigned char *)slurudq = 'u'; -#line 6846 "" +#line 6836 "" ivoff += 4; -#line 6847 "" +#line 6837 "" } else { -#line 6848 "" +#line 6838 "" *(unsigned char *)slurudq = 'd'; -#line 6849 "" +#line 6839 "" ivoff += -4; -#line 6850 "" +#line 6840 "" } -#line 6851 "" +#line 6841 "" } /* Shift slur ending for stem on any note? */ -#line 6855 "" +#line 6845 "" if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < 63.f) { -#line 6856 "" +#line 6846 "" if (! pstie) { -#line 6857 "" +#line 6847 "" ihoff += -8; -#line 6858 "" +#line 6848 "" } else { -#line 6859 "" +#line 6849 "" ihoff += -3; -#line 6860 "" +#line 6850 "" } -#line 6861 "" +#line 6851 "" } -#line 6862 "" +#line 6852 "" if (iscrd) { /* Shift termination for shifted notehead? */ -#line 6866 "" +#line 6856 "" if (bit_test(isdat2[isdat],1)) { /* Left-shifted chord notehead. ASSUME downstem. */ -#line 6870 "" +#line 6860 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { -#line 6871 "" +#line 6861 "" ihoff += -2; -#line 6872 "" +#line 6862 "" } else { -#line 6873 "" +#line 6863 "" ihoff += -10; -#line 6874 "" +#line 6864 "" } -#line 6875 "" +#line 6865 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ -#line 6879 "" +#line 6869 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { -#line 6880 "" +#line 6870 "" ihoff += 2; -#line 6881 "" +#line 6871 "" } else { -#line 6882 "" +#line 6872 "" ihoff += 10; -#line 6883 "" +#line 6873 "" } -#line 6884 "" +#line 6874 "" } -#line 6885 "" +#line 6875 "" } -#line 6886 "" +#line 6876 "" if (ihoff == 0) { /* Writing concatenation */ -#line 6887 "" +#line 6877 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6887 "" +#line 6877 "" i__5[0] = 1, a__3[0] = ch__1; -#line 6887 "" +#line 6877 "" i__5[1] = 5, a__3[1] = "tslur"; -#line 6887 "" +#line 6877 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6888 "" +#line 6878 "" lnote = 6; -#line 6889 "" +#line 6879 "" } else { /* Shift needed */ /* Writing concatenation */ -#line 6893 "" +#line 6883 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6893 "" +#line 6883 "" i__5[0] = 1, a__3[0] = ch__1; -#line 6893 "" +#line 6883 "" i__5[1] = 2, a__3[1] = "ts"; -#line 6893 "" +#line 6883 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6894 "" +#line 6884 "" lnote = 3; -#line 6895 "" +#line 6885 "" } /* Switch to postscript tie */ -#line 6899 "" +#line 6889 "" if (pstie) { /* Writing concatenation */ -#line 6900 "" +#line 6890 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 6900 "" +#line 6890 "" i__3[0] = 1, a__1[0] = ch__1; -#line 6900 "" +#line 6890 "" i__3[1] = 8, a__1[1] = "tieforts"; -#line 6900 "" +#line 6890 "" i__3[2] = lnote, a__1[2] = notexq; -#line 6900 "" +#line 6890 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 6901 "" +#line 6891 "" lnote += 9; -#line 6902 "" +#line 6892 "" } /* Print 13-ndxslur */ /* 5/25/08 Allow 14 slurs */ -#line 6907 "" +#line 6897 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ -#line 6908 "" +#line 6898 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6908 "" +#line 6898 "" i__2 = 71 - comslur_1.ndxslur; -#line 6908 "" +#line 6898 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6908 "" +#line 6898 "" i__5[1] = 1, a__3[1] = ch__1; -#line 6908 "" +#line 6898 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6909 "" +#line 6899 "" ++lnote; -#line 6910 "" +#line 6900 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 6911 "" +#line 6901 "" i__4[0] = lnote, a__2[0] = notexq; -#line 6911 "" +#line 6901 "" i__4[1] = 2, a__2[1] = "{1"; -#line 6911 "" +#line 6901 "" i__2 = 61 - comslur_1.ndxslur; -#line 6911 "" +#line 6901 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6911 "" +#line 6901 "" i__4[2] = 1, a__2[2] = ch__1; -#line 6911 "" +#line 6901 "" i__4[3] = 1, a__2[3] = "}"; -#line 6911 "" +#line 6901 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 6912 "" +#line 6902 "" lnote += 4; -#line 6913 "" +#line 6903 "" } else { /* Writing concatenation */ -#line 6914 "" +#line 6904 "" i__4[0] = lnote, a__2[0] = notexq; -#line 6914 "" +#line 6904 "" i__4[1] = 2, a__2[1] = "{2"; -#line 6914 "" +#line 6904 "" i__2 = 51 - comslur_1.ndxslur; -#line 6914 "" +#line 6904 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 6914 "" +#line 6904 "" i__4[2] = 1, a__2[2] = ch__1; -#line 6914 "" +#line 6904 "" i__4[3] = 1, a__2[3] = "}"; -#line 6914 "" +#line 6904 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); -#line 6915 "" +#line 6905 "" lnote += 4; -#line 6916 "" +#line 6906 "" } -#line 6917 "" +#line 6907 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ -#line 6921 "" +#line 6911 "" ivoffinc = 0; -#line 6922 "" +#line 6912 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { -#line 6924 "" +#line 6914 "" if (stemup) { -#line 6925 "" +#line 6915 "" ivoffinc = -1; -#line 6926 "" +#line 6916 "" } else { -#line 6927 "" +#line 6917 "" ivoffinc = 1; -#line 6928 "" +#line 6918 "" } -#line 6929 "" +#line 6919 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { -#line 6929 "" +#line 6919 "" ivoffinc <<= 1; -#line 6929 "" +#line 6919 "" } -#line 6932 "" +#line 6922 "" } -#line 6933 "" +#line 6923 "" ivoff += ivoffinc; -#line 6934 "" +#line 6924 "" } -#line 6935 "" +#line 6925 "" i__2 = nolevs + iupdn + ivoff; -#line 6935 "" +#line 6925 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); -#line 6936 "" +#line 6926 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { -#line 6938 "" +#line 6928 "" *islhgt = nolevs + iupdn + ivoff; /* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ -#line 6942 "" +#line 6932 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && comsln_1.is1n1 > 0) { -#line 6943 "" +#line 6933 "" if (idcode == comsln_1.is2n1) { -#line 6943 "" +#line 6933 "" comsln_1.is1n1 = 0; -#line 6943 "" +#line 6933 "" } -#line 6944 "" +#line 6934 "" } -#line 6945 "" +#line 6935 "" } /* Writing concatenation */ -#line 6946 "" +#line 6936 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6946 "" +#line 6936 "" i__5[1] = lnoten, a__3[1] = noteq; -#line 6946 "" +#line 6936 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6947 "" +#line 6937 "" lnote += lnoten; -#line 6948 "" +#line 6938 "" if (ihoff != 0) { -#line 6949 "" +#line 6939 "" shift = ihoff * .1f; /* Writing concatenation */ -#line 6950 "" +#line 6940 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6950 "" +#line 6940 "" i__5[1] = 1, a__3[1] = "{"; -#line 6950 "" +#line 6940 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6951 "" +#line 6941 "" ++lnote; -#line 6952 "" +#line 6942 "" lform = lfmt1_(&shift); -#line 6953 "" +#line 6943 "" i__2 = lnote; -#line 6953 "" +#line 6943 "" ici__1.icierr = 0; -#line 6953 "" +#line 6943 "" ici__1.icirnum = 1; -#line 6953 "" +#line 6943 "" ici__1.icirlen = lnote + lform - i__2; -#line 6953 "" +#line 6943 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 6953 "" +#line 6943 "" i__3[0] = 2, a__1[0] = "(f"; -#line 6953 "" +#line 6943 "" i__6 = lform + 48; -#line 6953 "" +#line 6943 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 6953 "" +#line 6943 "" i__3[1] = 1, a__1[1] = ch__1; -#line 6953 "" +#line 6943 "" i__3[2] = 3, a__1[2] = ".1)"; -#line 6953 "" +#line 6943 "" ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) 6), ch__3); -#line 6953 "" +#line 6943 "" s_wsfi(&ici__1); -#line 6953 "" +#line 6943 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); -#line 6953 "" +#line 6943 "" e_wsfi(); -#line 6955 "" +#line 6945 "" lnote += lform; /* Writing concatenation */ -#line 6956 "" +#line 6946 "" i__5[0] = lnote, a__3[0] = notexq; -#line 6956 "" +#line 6946 "" i__5[1] = 1, a__3[1] = "}"; -#line 6956 "" +#line 6946 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); -#line 6957 "" +#line 6947 "" ++lnote; -#line 6958 "" +#line 6948 "" } -#line 6959 "" +#line 6949 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Clear the bit from list of slurs in use */ -#line 6963 "" +#line 6953 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); /* Zero out the entire strings for start and stop */ -#line 6967 "" +#line 6957 "" isdata = 0; -#line 6968 "" +#line 6958 "" isdat2[isdat] = 0; -#line 6969 "" +#line 6959 "" isdat3[isdat] = 0; -#line 6970 "" +#line 6960 "" isdat4[isdat] = 0; -#line 6971 "" +#line 6961 "" isdat1[j] = 0; -#line 6972 "" +#line 6962 "" isdat2[j] = 0; -#line 6973 "" +#line 6963 "" isdat3[j] = 0; -#line 6974 "" +#line 6964 "" isdat4[j] = 0; /* Set midi info for slur ending */ -#line 6978 "" +#line 6968 "" if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { -#line 6979 "" +#line 6969 "" icm = commidi_1.midchan[*iv + *kv * 24 - 25]; -#line 6980 "" +#line 6970 "" if (comslm_1.slmon[icm]) { -#line 6981 "" +#line 6971 "" if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1] == comslm_1.levson[icm] && (7 & *nacc) == 0) { /* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */ -#line 6986 "" +#line 6976 "" comslm_1.levsoff[icm] = nolevs + commvel_1.miditran[cominsttrans_1.instno[* iv - 1] - 1]; -#line 6987 "" +#line 6977 "" settie = TRUE_; -#line 6988 "" +#line 6978 "" } else { -#line 6989 "" +#line 6979 "" comslm_1.levsoff[icm] = 0; -#line 6990 "" +#line 6980 "" comslm_1.levson[icm] = 0; -#line 6991 "" +#line 6981 "" comslm_1.slmon[icm] = FALSE_; -#line 6992 "" +#line 6982 "" } -#line 6993 "" +#line 6983 "" } -#line 6994 "" +#line 6984 "" } -#line 6995 "" +#line 6985 "" } -#line 6996 "" +#line 6986 "" isdat1[isdat] = isdata; -#line 6997 "" +#line 6987 "" } -#line 6998 "" +#line 6988 "" /* L1: */ -#line 6998 "" +#line 6988 "" } /* Clear and collapse the slur data list */ -#line 7002 "" +#line 6992 "" numdrop = 0; -#line 7003 "" +#line 6993 "" i__1 = *nsdat; -#line 7003 "" +#line 6993 "" for (isdat = 1; isdat <= i__1; ++isdat) { -#line 7004 "" +#line 6994 "" if (isdat1[isdat] == 0) { -#line 7005 "" +#line 6995 "" ++numdrop; -#line 7006 "" +#line 6996 "" } else if (numdrop > 0) { -#line 7007 "" +#line 6997 "" isdat1[isdat - numdrop] = isdat1[isdat]; -#line 7008 "" +#line 6998 "" isdat2[isdat - numdrop] = isdat2[isdat]; -#line 7009 "" +#line 6999 "" isdat3[isdat - numdrop] = isdat3[isdat]; -#line 7010 "" +#line 7000 "" isdat4[isdat - numdrop] = isdat4[isdat]; -#line 7011 "" +#line 7001 "" isdat1[isdat] = 0; -#line 7012 "" +#line 7002 "" isdat2[isdat] = 0; -#line 7013 "" +#line 7003 "" isdat3[isdat] = 0; -#line 7014 "" +#line 7004 "" isdat4[isdat] = 0; -#line 7015 "" +#line 7005 "" } -#line 7016 "" +#line 7006 "" /* L2: */ -#line 7016 "" +#line 7006 "" } -#line 7017 "" +#line 7007 "" *nsdat -= numdrop; /* call report(nsdat,isdat1,isdat2) */ -#line 7019 "" +#line 7009 "" return 0; } /* dopsslur_ */ @@ -17159,129 +17157,129 @@ L4: /* If highest note has upslur, save slur height in islhgt in case */ /* ornament must be moved. */ -#line 7097 "" +#line 7087 "" /* Parameter adjustments */ -#line 7097 "" +#line 7087 "" --isdat3; -#line 7097 "" +#line 7087 "" --isdat2; -#line 7097 "" +#line 7087 "" --isdat1; -#line 7097 "" +#line 7087 "" -#line 7097 "" +#line 7087 "" /* Function Body */ -#line 7097 "" +#line 7087 "" *islhgt = 0; -#line 7098 "" +#line 7088 "" if (*beamon) { -#line 7099 "" +#line 7089 "" stemup = *(unsigned char *)ulq == 'u'; -#line 7100 "" +#line 7090 "" } else if (commvl_1.nvmx[*iv - 1] == 2) { -#line 7101 "" +#line 7091 "" if (! bit_test(*islur,30)) { /* Single note, 2 lines of music, stem direction not forced */ -#line 7105 "" +#line 7095 "" stemup = commvl_1.ivx > *nv; -#line 7106 "" +#line 7096 "" } else { -#line 7107 "" +#line 7097 "" stemup = bit_test(*islur,17); -#line 7108 "" +#line 7098 "" } -#line 7109 "" +#line 7099 "" } else { -#line 7110 "" +#line 7100 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & commvl_1.ivx, nv); -#line 7110 "" +#line 7100 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; -#line 7111 "" +#line 7101 "" } -#line 7112 "" +#line 7102 "" iscrd = bit_test(*ipl,10); -#line 7113 "" +#line 7103 "" if (bit_test(*islur,1)) { /* 't'-slur (idcode=1) somewhere on this note. Find it, check height against */ /* 's'-slur (idcode=32) */ -#line 7118 "" +#line 7108 "" sfound = FALSE_; -#line 7119 "" +#line 7109 "" tfound = FALSE_; -#line 7120 "" +#line 7110 "" tmove = FALSE_; -#line 7121 "" +#line 7111 "" i__1 = *nsdat; -#line 7121 "" +#line 7111 "" for (isdat = 1; isdat <= i__1; ++isdat) { -#line 7122 "" +#line 7112 "" if (*iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *ip == igetbits_(&isdat1[isdat], &c__8, &c__3) && *kv == igetbits_(&isdat1[isdat], &c__1, &c__12) + 1) { -#line 7125 "" +#line 7115 "" if (! tfound) { -#line 7126 "" +#line 7116 "" tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1; -#line 7127 "" +#line 7117 "" if (tfound) { -#line 7128 "" +#line 7118 "" nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19); -#line 7129 "" +#line 7119 "" isdatt = isdat; -#line 7130 "" +#line 7120 "" if (sfound) { -#line 7130 "" +#line 7120 "" goto L6; -#line 7130 "" +#line 7120 "" } -#line 7131 "" +#line 7121 "" } -#line 7132 "" +#line 7122 "" } -#line 7133 "" +#line 7123 "" if (! sfound) { -#line 7134 "" +#line 7124 "" sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32; -#line 7135 "" +#line 7125 "" if (sfound) { -#line 7136 "" +#line 7126 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); -#line 7137 "" +#line 7127 "" isdats = isdat; -#line 7138 "" +#line 7128 "" if (tfound) { -#line 7138 "" +#line 7128 "" goto L6; -#line 7138 "" +#line 7128 "" } -#line 7139 "" +#line 7129 "" } -#line 7140 "" +#line 7130 "" } -#line 7141 "" +#line 7131 "" } -#line 7142 "" +#line 7132 "" /* L5: */ -#line 7142 "" +#line 7132 "" } /* Will come thru here if there is a t with no s, so comment out the following */ /* print*,'Did not find s+t-slurs in doslur' */ -#line 7147 "" +#line 7137 "" L6: -#line 7148 "" +#line 7138 "" if (sfound && tfound) { -#line 7148 "" +#line 7138 "" tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) && bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats], 11) && ! bit_test(isdat1[isdatt],11)); -#line 7148 "" +#line 7138 "" } /* Check if 2 starts or two stops */ @@ -17289,229 +17287,229 @@ L6: /* This is a flag for later changing slur level, after we know slur dir'n. */ -#line 7159 "" +#line 7149 "" } -#line 7160 "" +#line 7150 "" if (commidi_1.ismidi) { -#line 7161 "" +#line 7151 "" settie = FALSE_; -#line 7162 "" +#line 7152 "" comslm_1.dbltie = FALSE_; -#line 7163 "" +#line 7153 "" } -#line 7164 "" +#line 7154 "" i__1 = *nsdat; -#line 7164 "" +#line 7154 "" for (isdat = 1; isdat <= i__1; ++isdat) { -#line 7165 "" +#line 7155 "" isdata = isdat1[isdat]; -#line 7166 "" +#line 7156 "" if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(& isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, & c__12) + 1) { /* Since iv and kv match, ivx will be correct */ -#line 7172 "" +#line 7162 "" idcode = igetbits_(&isdata, &c__7, &c__19); -#line 7173 "" +#line 7163 "" ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; -#line 7174 "" +#line 7164 "" ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; -#line 7175 "" +#line 7165 "" iupdn = 0; -#line 7176 "" +#line 7166 "" *(unsigned char *)slurudq = 'd'; -#line 7177 "" +#line 7167 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); -#line 7178 "" +#line 7168 "" if (bit_test(isdata,11)) { /* Turnon, */ -#line 7182 "" +#line 7172 "" if (nolevs == 0 || nolevs > 60) { /* Note was a rest, cannot start slur on rest. */ -#line 7186 "" +#line 7176 "" s_wsle(&io___509); -#line 7186 "" +#line 7176 "" e_wsle(); -#line 7187 "" +#line 7177 "" printl_("Cannot start slur on a rest", (ftnlen)27); -#line 7188 "" +#line 7178 "" stop1_(); -#line 7189 "" +#line 7179 "" } /* Get slur direction */ -#line 7193 "" +#line 7183 "" if (bit_test(isdata,26)) { /* Force slur direction */ -#line 7197 "" +#line 7187 "" if (bit_test(isdata,27)) { -#line 7197 "" +#line 7187 "" *(unsigned char *)slurudq = 'u'; -#line 7197 "" +#line 7187 "" } -#line 7198 "" +#line 7188 "" } else if (commvl_1.nvmx[*iv - 1] == 1) { /* Only one voice per line */ -#line 7202 "" +#line 7192 "" if (! (*beamon)) { /* Separate note. */ -#line 7206 "" +#line 7196 "" udfq_(ch__1, (ftnlen)1, nolev, ncm); -#line 7206 "" +#line 7196 "" *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ 0]; -#line 7207 "" +#line 7197 "" } else { /* In a beam */ -#line 7211 "" +#line 7201 "" if (*(unsigned char *)ulq != 'u') { -#line 7211 "" +#line 7201 "" *(unsigned char *)slurudq = 'u'; -#line 7211 "" +#line 7201 "" } -#line 7212 "" +#line 7202 "" } -#line 7213 "" +#line 7203 "" if (iscrd) { -#line 7214 "" +#line 7204 "" if (nolevs > *ncm) { -#line 7215 "" +#line 7205 "" *(unsigned char *)slurudq = 'u'; -#line 7216 "" +#line 7206 "" } else { -#line 7217 "" +#line 7207 "" *(unsigned char *)slurudq = 'd'; -#line 7218 "" +#line 7208 "" } -#line 7219 "" +#line 7209 "" } -#line 7220 "" +#line 7210 "" } else { /* Two voices per line. Get default */ -#line 7224 "" +#line 7214 "" if (commvl_1.ivx > *nv) { -#line 7224 "" +#line 7214 "" *(unsigned char *)slurudq = 'u'; -#line 7224 "" +#line 7214 "" } /* Upper voice of the two, so up slur */ -#line 7228 "" +#line 7218 "" } /* Save up/down-ness for use at termination */ -#line 7232 "" +#line 7222 "" if (*(unsigned char *)slurudq == 'u') { -#line 7232 "" +#line 7222 "" isdata = bit_set(isdata,27); -#line 7232 "" +#line 7222 "" } /* End of section for setting slur direction, still in "Turnon" if-block. */ -#line 7236 "" +#line 7226 "" if (idcode == 1 && tmove) { -#line 7237 "" +#line 7227 "" iupdn = 1; -#line 7238 "" +#line 7228 "" if (*(unsigned char *)slurudq == 'd') { -#line 7238 "" +#line 7228 "" iupdn = -1; -#line 7238 "" +#line 7228 "" } -#line 7239 "" +#line 7229 "" } -#line 7240 "" +#line 7230 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ -#line 7244 "" +#line 7234 "" ivoffinc = 0; -#line 7245 "" +#line 7235 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { /* Must move the slur for _ or . */ -#line 7250 "" +#line 7240 "" if (stemup) { -#line 7251 "" +#line 7241 "" ivoffinc = -1; -#line 7252 "" +#line 7242 "" } else { -#line 7253 "" +#line 7243 "" ivoffinc = 1; -#line 7254 "" +#line 7244 "" } -#line 7255 "" +#line 7245 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { -#line 7255 "" +#line 7245 "" ivoffinc <<= 1; -#line 7255 "" +#line 7245 "" } -#line 7258 "" +#line 7248 "" ivoff += ivoffinc; -#line 7259 "" +#line 7249 "" } -#line 7260 "" +#line 7250 "" } -#line 7261 "" +#line 7251 "" if (comslur_1.listslur == 16777215) { -#line 7262 "" +#line 7252 "" s_wsle(&io___511); -#line 7262 "" +#line 7252 "" e_wsle(); -#line 7263 "" +#line 7253 "" s_wsle(&io___512); -#line 7263 "" +#line 7253 "" do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"\ ", one too many!", (ftnlen)49); -#line 7263 "" +#line 7253 "" e_wsle(); -#line 7264 "" +#line 7254 "" s_wsfe(&io___513); -#line 7264 "" +#line 7254 "" do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"\ "oo many!", (ftnlen)49); -#line 7264 "" +#line 7254 "" e_wsfe(); -#line 7266 "" +#line 7256 "" stop1_(); -#line 7267 "" +#line 7257 "" } /* Get index of next slur not in use, starting from ? down */ -#line 7271 "" +#line 7261 "" i__2 = 16777215 - comslur_1.listslur; -#line 7271 "" +#line 7261 "" comslur_1.ndxslur = log2_(&i__2); /* Record slur index */ -#line 7275 "" +#line 7265 "" comslur_1.listslur = bit_set(comslur_1.listslur, comslur_1.ndxslur); @@ -17519,149 +17517,149 @@ L6: /* call setbits(isdata,4,28,ndxslur) */ /* 080531 Allow >16 slurs */ -#line 7281 "" +#line 7271 "" i__2 = comslur_1.ndxslur % 16; -#line 7281 "" +#line 7271 "" setbits_(&isdata, &c__4, &c__28, &i__2); -#line 7282 "" +#line 7272 "" i__2 = comslur_1.ndxslur / 16; -#line 7282 "" +#line 7272 "" setbits_(&isdata, &c__1, &c__18, &i__2); /* Shift for stem? */ -#line 7286 "" +#line 7276 "" if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) { -#line 7286 "" +#line 7276 "" ihoff += 8; -#line 7286 "" +#line 7276 "" } -#line 7288 "" +#line 7278 "" if (bit_test(isdat2[isdat],3)) { /* Tie spacing, (slur start) */ -#line 7292 "" +#line 7282 "" if (*(unsigned char *)slurudq == 'd') { -#line 7293 "" +#line 7283 "" ++ivoff; -#line 7294 "" +#line 7284 "" ihoff += 8; -#line 7295 "" +#line 7285 "" } else if (*(unsigned char *)slurudq == 'u') { -#line 7296 "" +#line 7286 "" --ivoff; -#line 7297 "" +#line 7287 "" if (! (stemup && *tno < 63.f)) { -#line 7297 "" +#line 7287 "" ihoff += 8; -#line 7297 "" +#line 7287 "" } /* (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */ -#line 7301 "" +#line 7291 "" } -#line 7302 "" +#line 7292 "" } -#line 7303 "" +#line 7293 "" if (iscrd) { /* Additional horiz shifts for h-shifted noteheads? */ -#line 7307 "" +#line 7297 "" if (bit_test(isdat2[isdat],1)) { /* Slur start on left-shifted chord notehead. ASSUME downstem. */ -#line 7311 "" +#line 7301 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { -#line 7312 "" +#line 7302 "" ihoff += -2; -#line 7313 "" +#line 7303 "" } else { -#line 7314 "" +#line 7304 "" ihoff += -10; -#line 7315 "" +#line 7305 "" } -#line 7316 "" +#line 7306 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ -#line 7320 "" +#line 7310 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { -#line 7321 "" +#line 7311 "" ihoff += 2; -#line 7322 "" +#line 7312 "" } else { -#line 7323 "" +#line 7313 "" ihoff += 10; -#line 7324 "" +#line 7314 "" } -#line 7325 "" +#line 7315 "" } -#line 7326 "" +#line 7316 "" } -#line 7327 "" +#line 7317 "" if (ihoff == 0) { /* Write stuff for non-shifted start */ /* Writing concatenation */ -#line 7331 "" +#line 7321 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7331 "" +#line 7321 "" i__3[0] = 1, a__1[0] = ch__1; -#line 7331 "" +#line 7321 "" i__3[1] = 5, a__1[1] = "islur"; -#line 7331 "" +#line 7321 "" i__3[2] = 1, a__1[2] = slurudq; -#line 7331 "" +#line 7321 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 7332 "" +#line 7322 "" lnote = 7; -#line 7333 "" +#line 7323 "" } else { /* Writing concatenation */ -#line 7334 "" +#line 7324 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7334 "" +#line 7324 "" i__3[0] = 1, a__1[0] = ch__1; -#line 7334 "" +#line 7324 "" i__3[1] = 2, a__1[1] = "is"; -#line 7334 "" +#line 7324 "" i__3[2] = 1, a__1[2] = slurudq; -#line 7334 "" +#line 7324 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 7335 "" +#line 7325 "" lnote = 4; -#line 7336 "" +#line 7326 "" } -#line 7337 "" +#line 7327 "" if (bit_test(isdat2[isdat],4)) { /* Dotted slur */ -#line 7341 "" +#line 7331 "" s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79); /* Writing concatenation */ -#line 7342 "" +#line 7332 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7342 "" +#line 7332 "" i__3[0] = 1, a__1[0] = ch__1; -#line 7342 "" +#line 7332 "" i__3[1] = 6, a__1[1] = "dotted"; -#line 7342 "" +#line 7332 "" i__3[2] = 8, a__1[2] = noteq; -#line 7342 "" +#line 7332 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); -#line 7343 "" +#line 7333 "" lnote += 7; -#line 7344 "" +#line 7334 "" } /* Add slur index to string */ @@ -17669,250 +17667,250 @@ L6: /* Print 23-ndxslur */ /* if (11-ndxslur .lt. 10) then */ -#line 7351 "" +#line 7341 "" if (23 - comslur_1.ndxslur < 10) { /* 5/25/08 Allow 24 slurs */ /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ /* Writing concatenation */ -#line 7356 "" +#line 7346 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7356 "" +#line 7346 "" i__2 = 71 - comslur_1.ndxslur; -#line 7356 "" +#line 7346 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7356 "" +#line 7346 "" i__4[1] = 1, a__2[1] = ch__1; -#line 7356 "" +#line 7346 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7357 "" +#line 7347 "" ++lnote; -#line 7358 "" +#line 7348 "" } else if (23 - comslur_1.ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ -#line 7360 "" +#line 7350 "" i__5[0] = lnote, a__3[0] = notexq; -#line 7360 "" +#line 7350 "" i__5[1] = 2, a__3[1] = "{1"; -#line 7360 "" +#line 7350 "" i__2 = 61 - comslur_1.ndxslur; -#line 7360 "" +#line 7350 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7360 "" +#line 7350 "" i__5[2] = 1, a__3[2] = ch__1; -#line 7360 "" +#line 7350 "" i__5[3] = 1, a__3[3] = "}"; -#line 7360 "" +#line 7350 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); -#line 7361 "" +#line 7351 "" lnote += 4; -#line 7362 "" +#line 7352 "" } else { /* Writing concatenation */ -#line 7363 "" +#line 7353 "" i__5[0] = lnote, a__3[0] = notexq; -#line 7363 "" +#line 7353 "" i__5[1] = 2, a__3[1] = "{2"; -#line 7363 "" +#line 7353 "" i__2 = 51 - comslur_1.ndxslur; -#line 7363 "" +#line 7353 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7363 "" +#line 7353 "" i__5[2] = 1, a__3[2] = ch__1; -#line 7363 "" +#line 7353 "" i__5[3] = 1, a__3[3] = "}"; -#line 7363 "" +#line 7353 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); -#line 7364 "" +#line 7354 "" lnote += 4; -#line 7365 "" +#line 7355 "" } /* Add note name to string */ -#line 7369 "" +#line 7359 "" i__2 = nolevs + iupdn + ivoff; -#line 7369 "" +#line 7359 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); /* Writing concatenation */ -#line 7370 "" +#line 7360 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7370 "" +#line 7360 "" i__4[1] = lnoten, a__2[1] = noteq; -#line 7370 "" +#line 7360 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7371 "" +#line 7361 "" lnote += lnoten; /* Save height (for ornament and barnobox interference) if topmost slur is up */ -#line 7375 "" +#line 7365 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { -#line 7377 "" +#line 7367 "" *islhgt = nolevs + iupdn + ivoff; /* Save height & idcode if top voice and slur start */ -#line 7381 "" +#line 7371 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { -#line 7382 "" +#line 7372 "" comsln_1.is1n1 = *islhgt; -#line 7383 "" +#line 7373 "" comsln_1.is2n1 = idcode; -#line 7384 "" +#line 7374 "" } -#line 7385 "" +#line 7375 "" } -#line 7386 "" +#line 7376 "" if ((real) ihoff != 0.f) { -#line 7387 "" +#line 7377 "" shift = ihoff * .1f; /* Writing concatenation */ -#line 7388 "" +#line 7378 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7388 "" +#line 7378 "" i__4[1] = 1, a__2[1] = "{"; -#line 7388 "" +#line 7378 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7389 "" +#line 7379 "" ++lnote; -#line 7390 "" +#line 7380 "" lform = lfmt1_(&shift); -#line 7391 "" +#line 7381 "" i__2 = lnote; -#line 7391 "" +#line 7381 "" ici__1.icierr = 0; -#line 7391 "" +#line 7381 "" ici__1.icirnum = 1; -#line 7391 "" +#line 7381 "" ici__1.icirlen = lnote + lform - i__2; -#line 7391 "" +#line 7381 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 7391 "" +#line 7381 "" i__3[0] = 2, a__1[0] = "(f"; -#line 7391 "" +#line 7381 "" i__6 = lform + 48; -#line 7391 "" +#line 7381 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 7391 "" +#line 7381 "" i__3[1] = 1, a__1[1] = ch__1; -#line 7391 "" +#line 7381 "" i__3[2] = 3, a__1[2] = ".1)"; -#line 7391 "" +#line 7381 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) 6), ch__2); -#line 7391 "" +#line 7381 "" s_wsfi(&ici__1); -#line 7391 "" +#line 7381 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); -#line 7391 "" +#line 7381 "" e_wsfi(); -#line 7393 "" +#line 7383 "" lnote += lform; /* Writing concatenation */ -#line 7394 "" +#line 7384 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7394 "" +#line 7384 "" i__4[1] = 1, a__2[1] = "}"; -#line 7394 "" +#line 7384 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7395 "" +#line 7385 "" ++lnote; -#line 7396 "" +#line 7386 "" } -#line 7397 "" +#line 7387 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Zero out ip1 to avoid problems if slur goes to next input blk. */ -#line 7401 "" +#line 7391 "" setbits_(&isdata, &c__8, &c__3, &c__0); /* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */ -#line 7405 "" +#line 7395 "" if (commidi_1.ismidi && idcode == 32) { -#line 7406 "" +#line 7396 "" comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1]; -#line 7407 "" +#line 7397 "" if (settie) { -#line 7407 "" +#line 7397 "" comslm_1.dbltie = TRUE_; -#line 7407 "" +#line 7397 "" } /* Only way settie=T is if we just set a tie ending. So there's also a slur */ /* start here, so set a flag telling addmidi not to zero out levson */ -#line 7412 "" +#line 7402 "" } -#line 7413 "" +#line 7403 "" } else { /* Slur is ending. Back thru list to find starting slur */ -#line 7417 "" +#line 7407 "" for (j = isdat - 1; j >= 1; --j) { -#line 7418 "" +#line 7408 "" if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv == igetbits_(&isdat1[j], &c__1, &c__12) + 1) { -#line 7420 "" +#line 7410 "" if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { -#line 7421 "" +#line 7411 "" comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & c__28) + (igetbits_(&isdat1[j], &c__1, & c__18) << 4); /* 080531 Allow >16 slurs */ -#line 7426 "" +#line 7416 "" if (bit_test(isdat1[j],27)) { -#line 7426 "" +#line 7416 "" *(unsigned char *)slurudq = 'u'; -#line 7426 "" +#line 7416 "" } -#line 7427 "" +#line 7417 "" goto L4; -#line 7428 "" +#line 7418 "" } -#line 7429 "" +#line 7419 "" } -#line 7430 "" +#line 7420 "" /* L3: */ -#line 7430 "" +#line 7420 "" } -#line 7431 "" +#line 7421 "" s_wsle(&io___521); -#line 7431 "" +#line 7421 "" do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); -#line 7431 "" +#line 7421 "" e_wsle(); -#line 7432 "" +#line 7422 "" stop1_(); -#line 7433 "" +#line 7423 "" L4: -#line 7434 "" +#line 7424 "" if (nolevs == 0 || nolevs > 60) { /* Ending is on a rest, reset nolevs to default starting height */ -#line 7438 "" +#line 7428 "" nolevs = igetbits_(&isdat2[j], &c__7, &c__19); -#line 7439 "" +#line 7429 "" } -#line 7440 "" +#line 7430 "" if (bit_test(isdat3[isdat],0)) { /* Deal with \curve or \midslur */ -#line 7444 "" +#line 7434 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; /* Remember, only dealing with non-ps slurs */ @@ -17922,598 +17920,598 @@ L4: /* if (slurudq .eq. 'd') imid = -imid */ /* 3/8/03 added the following */ -#line 7453 "" +#line 7443 "" if (*(unsigned char *)slurudq == 'd') { -#line 7453 "" +#line 7443 "" imid = -abs(imid); -#line 7453 "" +#line 7443 "" } -#line 7455 "" +#line 7445 "" if (bit_test(isdat3[isdat],1)) { /* Writing concatenation */ -#line 7456 "" +#line 7446 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7456 "" +#line 7446 "" i__4[0] = 1, a__2[0] = ch__1; -#line 7456 "" +#line 7446 "" i__4[1] = 5, a__2[1] = "curve"; -#line 7456 "" +#line 7446 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7457 "" +#line 7447 "" lnote = 6; -#line 7458 "" +#line 7448 "" } else { /* Writing concatenation */ -#line 7459 "" +#line 7449 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7459 "" +#line 7449 "" i__4[0] = 1, a__2[0] = ch__1; -#line 7459 "" +#line 7449 "" i__4[1] = 7, a__2[1] = "midslur"; -#line 7459 "" +#line 7449 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7460 "" +#line 7450 "" lnote = 8; -#line 7461 "" +#line 7451 "" } -#line 7462 "" +#line 7452 "" if (imid < 0 || imid > 9) { /* Need brackets */ /* Writing concatenation */ -#line 7466 "" +#line 7456 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7466 "" +#line 7456 "" i__4[1] = 1, a__2[1] = "{"; -#line 7466 "" +#line 7456 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7467 "" +#line 7457 "" ++lnote; -#line 7468 "" +#line 7458 "" if (imid < -9) { -#line 7469 "" +#line 7459 "" i__2 = lnote; -#line 7469 "" +#line 7459 "" ici__1.icierr = 0; -#line 7469 "" +#line 7459 "" ici__1.icirnum = 1; -#line 7469 "" +#line 7459 "" ici__1.icirlen = lnote + 3 - i__2; -#line 7469 "" +#line 7459 "" ici__1.iciunit = notexq + i__2; -#line 7469 "" +#line 7459 "" ici__1.icifmt = "(i3)"; -#line 7469 "" +#line 7459 "" s_wsfi(&ici__1); -#line 7469 "" +#line 7459 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); -#line 7469 "" +#line 7459 "" e_wsfi(); -#line 7470 "" +#line 7460 "" lnote += 3; -#line 7471 "" +#line 7461 "" } else if (imid < 0 || imid > 9) { -#line 7472 "" +#line 7462 "" i__2 = lnote; -#line 7472 "" +#line 7462 "" ici__1.icierr = 0; -#line 7472 "" +#line 7462 "" ici__1.icirnum = 1; -#line 7472 "" +#line 7462 "" ici__1.icirlen = lnote + 2 - i__2; -#line 7472 "" +#line 7462 "" ici__1.iciunit = notexq + i__2; -#line 7472 "" +#line 7462 "" ici__1.icifmt = "(i2)"; -#line 7472 "" +#line 7462 "" s_wsfi(&ici__1); -#line 7472 "" +#line 7462 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); -#line 7472 "" +#line 7462 "" e_wsfi(); -#line 7473 "" +#line 7463 "" lnote += 2; -#line 7474 "" +#line 7464 "" } else { -#line 7475 "" +#line 7465 "" i__2 = lnote; -#line 7475 "" +#line 7465 "" ici__1.icierr = 0; -#line 7475 "" +#line 7465 "" ici__1.icirnum = 1; -#line 7475 "" +#line 7465 "" ici__1.icirlen = lnote + 1 - i__2; -#line 7475 "" +#line 7465 "" ici__1.iciunit = notexq + i__2; -#line 7475 "" +#line 7465 "" ici__1.icifmt = "(i1)"; -#line 7475 "" +#line 7465 "" s_wsfi(&ici__1); -#line 7475 "" +#line 7465 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); -#line 7475 "" +#line 7465 "" e_wsfi(); -#line 7476 "" +#line 7466 "" ++lnote; -#line 7477 "" +#line 7467 "" } /* Writing concatenation */ -#line 7478 "" +#line 7468 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7478 "" +#line 7468 "" i__4[1] = 1, a__2[1] = "}"; -#line 7478 "" +#line 7468 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7479 "" +#line 7469 "" ++lnote; -#line 7480 "" +#line 7470 "" } else { /* 1= 63.f) { -#line 7513 "" +#line 7503 "" ihoff += -8; -#line 7513 "" +#line 7503 "" } -#line 7514 "" +#line 7504 "" } -#line 7515 "" +#line 7505 "" } -#line 7516 "" +#line 7506 "" if (iscrd) { /* Shift termination for shifted notehead? */ -#line 7520 "" +#line 7510 "" if (bit_test(isdat2[isdat],1)) { /* Left-shifted chord notehead. ASSUME downstem. */ -#line 7524 "" +#line 7514 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { -#line 7525 "" +#line 7515 "" ihoff += -2; -#line 7526 "" +#line 7516 "" } else { -#line 7527 "" +#line 7517 "" ihoff += -10; -#line 7528 "" +#line 7518 "" } -#line 7529 "" +#line 7519 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ -#line 7533 "" +#line 7523 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { -#line 7534 "" +#line 7524 "" ihoff += 2; -#line 7535 "" +#line 7525 "" } else { -#line 7536 "" +#line 7526 "" ihoff += 10; -#line 7537 "" +#line 7527 "" } -#line 7538 "" +#line 7528 "" } -#line 7539 "" +#line 7529 "" } -#line 7540 "" +#line 7530 "" if (ihoff == 0) { /* Writing concatenation */ -#line 7541 "" +#line 7531 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7541 "" +#line 7531 "" i__4[0] = 1, a__2[0] = ch__1; -#line 7541 "" +#line 7531 "" i__4[1] = 5, a__2[1] = "tslur"; -#line 7541 "" +#line 7531 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7542 "" +#line 7532 "" lnote = 6; -#line 7543 "" +#line 7533 "" } else { /* Shift needed */ /* Writing concatenation */ -#line 7547 "" +#line 7537 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7547 "" +#line 7537 "" i__4[0] = 1, a__2[0] = ch__1; -#line 7547 "" +#line 7537 "" i__4[1] = 2, a__2[1] = "ts"; -#line 7547 "" +#line 7537 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7548 "" +#line 7538 "" lnote = 3; -#line 7549 "" +#line 7539 "" } /* Print 23-ndxslur */ /* 5/25/08 Allow 14 slurs (???????????) */ -#line 7554 "" +#line 7544 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ -#line 7555 "" +#line 7545 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7555 "" +#line 7545 "" i__2 = 71 - comslur_1.ndxslur; -#line 7555 "" +#line 7545 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7555 "" +#line 7545 "" i__4[1] = 1, a__2[1] = ch__1; -#line 7555 "" +#line 7545 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7556 "" +#line 7546 "" ++lnote; -#line 7557 "" +#line 7547 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 7558 "" +#line 7548 "" i__5[0] = lnote, a__3[0] = notexq; -#line 7558 "" +#line 7548 "" i__5[1] = 2, a__3[1] = "{1"; -#line 7558 "" +#line 7548 "" i__2 = 61 - comslur_1.ndxslur; -#line 7558 "" +#line 7548 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7558 "" +#line 7548 "" i__5[2] = 1, a__3[2] = ch__1; -#line 7558 "" +#line 7548 "" i__5[3] = 1, a__3[3] = "}"; -#line 7558 "" +#line 7548 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); -#line 7559 "" +#line 7549 "" lnote += 4; -#line 7560 "" +#line 7550 "" } else { /* Writing concatenation */ -#line 7561 "" +#line 7551 "" i__5[0] = lnote, a__3[0] = notexq; -#line 7561 "" +#line 7551 "" i__5[1] = 2, a__3[1] = "{2"; -#line 7561 "" +#line 7551 "" i__2 = 51 - comslur_1.ndxslur; -#line 7561 "" +#line 7551 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7561 "" +#line 7551 "" i__5[2] = 1, a__3[2] = ch__1; -#line 7561 "" +#line 7551 "" i__5[3] = 1, a__3[3] = "}"; -#line 7561 "" +#line 7551 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); -#line 7562 "" +#line 7552 "" lnote += 4; -#line 7563 "" +#line 7553 "" } -#line 7564 "" +#line 7554 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ -#line 7568 "" +#line 7558 "" ivoffinc = 0; -#line 7569 "" +#line 7559 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { -#line 7571 "" +#line 7561 "" if (stemup) { -#line 7572 "" +#line 7562 "" ivoffinc = -1; -#line 7573 "" +#line 7563 "" } else { -#line 7574 "" +#line 7564 "" ivoffinc = 1; -#line 7575 "" +#line 7565 "" } -#line 7576 "" +#line 7566 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { -#line 7576 "" +#line 7566 "" ivoffinc <<= 1; -#line 7576 "" +#line 7566 "" } -#line 7579 "" +#line 7569 "" } -#line 7580 "" +#line 7570 "" ivoff += ivoffinc; -#line 7581 "" +#line 7571 "" } -#line 7582 "" +#line 7572 "" if (idcode == 1 && tmove) { /* t-slur height adjustment */ -#line 7586 "" +#line 7576 "" iupdn = 1; -#line 7587 "" +#line 7577 "" if (*(unsigned char *)slurudq == 'd') { -#line 7587 "" +#line 7577 "" iupdn = -1; -#line 7587 "" +#line 7577 "" } -#line 7588 "" +#line 7578 "" } -#line 7589 "" +#line 7579 "" i__2 = nolevs + iupdn + ivoff; -#line 7589 "" +#line 7579 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); -#line 7590 "" +#line 7580 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { -#line 7592 "" +#line 7582 "" *islhgt = nolevs + iupdn + ivoff; /* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ -#line 7596 "" +#line 7586 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && comsln_1.is1n1 > 0) { -#line 7597 "" +#line 7587 "" if (idcode == comsln_1.is2n1) { -#line 7597 "" +#line 7587 "" comsln_1.is1n1 = 0; -#line 7597 "" +#line 7587 "" } -#line 7598 "" +#line 7588 "" } -#line 7599 "" +#line 7589 "" } /* Writing concatenation */ -#line 7600 "" +#line 7590 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7600 "" +#line 7590 "" i__4[1] = lnoten, a__2[1] = noteq; -#line 7600 "" +#line 7590 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7601 "" +#line 7591 "" lnote += lnoten; -#line 7602 "" +#line 7592 "" if (ihoff != 0) { -#line 7603 "" +#line 7593 "" shift = ihoff * .1f; /* Writing concatenation */ -#line 7604 "" +#line 7594 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7604 "" +#line 7594 "" i__4[1] = 1, a__2[1] = "{"; -#line 7604 "" +#line 7594 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7605 "" +#line 7595 "" ++lnote; -#line 7606 "" +#line 7596 "" lform = lfmt1_(&shift); -#line 7607 "" +#line 7597 "" i__2 = lnote; -#line 7607 "" +#line 7597 "" ici__1.icierr = 0; -#line 7607 "" +#line 7597 "" ici__1.icirnum = 1; -#line 7607 "" +#line 7597 "" ici__1.icirlen = lnote + lform - i__2; -#line 7607 "" +#line 7597 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 7607 "" +#line 7597 "" i__3[0] = 2, a__1[0] = "(f"; -#line 7607 "" +#line 7597 "" i__6 = lform + 48; -#line 7607 "" +#line 7597 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 7607 "" +#line 7597 "" i__3[1] = 1, a__1[1] = ch__1; -#line 7607 "" +#line 7597 "" i__3[2] = 3, a__1[2] = ".1)"; -#line 7607 "" +#line 7597 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) 6), ch__2); -#line 7607 "" +#line 7597 "" s_wsfi(&ici__1); -#line 7607 "" +#line 7597 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); -#line 7607 "" +#line 7597 "" e_wsfi(); -#line 7609 "" +#line 7599 "" lnote += lform; /* Writing concatenation */ -#line 7610 "" +#line 7600 "" i__4[0] = lnote, a__2[0] = notexq; -#line 7610 "" +#line 7600 "" i__4[1] = 1, a__2[1] = "}"; -#line 7610 "" +#line 7600 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 7611 "" +#line 7601 "" ++lnote; -#line 7612 "" +#line 7602 "" } -#line 7613 "" +#line 7603 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Clear the bit from list of slurs in use */ -#line 7617 "" +#line 7607 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); /* Zero out the entire strings for start and stop */ -#line 7621 "" +#line 7611 "" isdata = 0; -#line 7622 "" +#line 7612 "" isdat2[isdat] = 0; -#line 7623 "" +#line 7613 "" isdat1[j] = 0; -#line 7624 "" +#line 7614 "" isdat2[j] = 0; -#line 7625 "" +#line 7615 "" isdat3[isdat] = 0; /* Set midi info for slur ending */ -#line 7629 "" +#line 7619 "" if (commidi_1.ismidi && idcode == 32) { -#line 7630 "" +#line 7620 "" icm = commidi_1.midchan[*iv + *kv * 24 - 25]; -#line 7631 "" +#line 7621 "" if (comslm_1.slmon[icm]) { -#line 7632 "" +#line 7622 "" if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1] == comslm_1.levson[icm] && (7 & *nacc) == 0) { /* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */ -#line 7637 "" +#line 7627 "" comslm_1.levsoff[icm] = nolevs + commvel_1.miditran[cominsttrans_1.instno[* iv - 1] - 1]; -#line 7638 "" +#line 7628 "" settie = TRUE_; -#line 7639 "" +#line 7629 "" } else { -#line 7640 "" +#line 7630 "" comslm_1.levsoff[icm] = 0; -#line 7641 "" +#line 7631 "" comslm_1.levson[icm] = 0; -#line 7642 "" +#line 7632 "" comslm_1.slmon[icm] = FALSE_; -#line 7643 "" +#line 7633 "" } -#line 7644 "" +#line 7634 "" } -#line 7645 "" +#line 7635 "" } -#line 7646 "" +#line 7636 "" } -#line 7647 "" +#line 7637 "" isdat1[isdat] = isdata; -#line 7648 "" +#line 7638 "" } -#line 7649 "" +#line 7639 "" /* L1: */ -#line 7649 "" +#line 7639 "" } /* Clear and collapse the slur data list */ -#line 7653 "" +#line 7643 "" numdrop = 0; -#line 7654 "" +#line 7644 "" i__1 = *nsdat; -#line 7654 "" +#line 7644 "" for (isdat = 1; isdat <= i__1; ++isdat) { -#line 7655 "" +#line 7645 "" if (isdat1[isdat] == 0) { -#line 7656 "" +#line 7646 "" ++numdrop; -#line 7657 "" +#line 7647 "" } else if (numdrop > 0) { -#line 7658 "" +#line 7648 "" isdat1[isdat - numdrop] = isdat1[isdat]; -#line 7659 "" +#line 7649 "" isdat2[isdat - numdrop] = isdat2[isdat]; -#line 7660 "" +#line 7650 "" isdat3[isdat - numdrop] = isdat3[isdat]; -#line 7661 "" +#line 7651 "" isdat1[isdat] = 0; -#line 7662 "" +#line 7652 "" isdat2[isdat] = 0; -#line 7663 "" +#line 7653 "" isdat3[isdat] = 0; -#line 7664 "" +#line 7654 "" } -#line 7665 "" +#line 7655 "" /* L2: */ -#line 7665 "" +#line 7655 "" } -#line 7666 "" +#line 7656 "" *nsdat -= numdrop; /* call report(nsdat,isdat1,isdat2) */ -#line 7668 "" +#line 7658 "" return 0; } /* doslur_ */ @@ -18544,102 +18542,102 @@ L4: /* iddot = 0 for single dot, 1 for double */ -#line 7676 "" +#line 7666 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7676 "" +#line 7666 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 7677 "" +#line 7667 "" lfmtup = lfmt1_(updot); -#line 7678 "" +#line 7668 "" lfmtrt = lfmt1_(rtdot); -#line 7679 "" +#line 7669 "" ici__1.icierr = 0; -#line 7679 "" +#line 7669 "" ici__1.icirnum = 1; -#line 7679 "" +#line 7669 "" ici__1.icirlen = 80; -#line 7679 "" +#line 7669 "" ici__1.iciunit = notexq; /* Writing concatenation */ -#line 7679 "" +#line 7669 "" i__1[0] = 6, a__1[0] = "(a37,f"; -#line 7679 "" +#line 7669 "" i__2 = lfmtup + 48; -#line 7679 "" +#line 7669 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7679 "" +#line 7669 "" i__1[1] = 1, a__1[1] = ch__1; -#line 7679 "" +#line 7669 "" i__1[2] = 7, a__1[2] = ".1,a2,f"; -#line 7679 "" +#line 7669 "" i__3 = lfmtrt + 48; -#line 7679 "" +#line 7669 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7679 "" +#line 7669 "" i__1[3] = 1, a__1[3] = ch__3; -#line 7679 "" +#line 7669 "" i__1[4] = 7, a__1[4] = ".1,a15)"; -#line 7679 "" +#line 7669 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2); -#line 7679 "" +#line 7669 "" s_wsfi(&ici__1); /* Writing concatenation */ -#line 7679 "" +#line 7669 "" i__4[0] = 1, a__2[0] = sq; -#line 7679 "" +#line 7669 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 7679 "" +#line 7669 "" i__4[2] = 1, a__2[2] = sq; -#line 7679 "" +#line 7669 "" i__4[3] = 3, a__2[3] = "def"; -#line 7679 "" +#line 7669 "" i__4[4] = 1, a__2[4] = sq; -#line 7679 "" +#line 7669 "" i__4[5] = 12, a__2[5] = "C@Point#1#2{"; -#line 7679 "" +#line 7669 "" i__4[6] = 1, a__2[6] = sq; -#line 7679 "" +#line 7669 "" i__4[7] = 6, a__2[7] = "PMXpt{"; -#line 7679 "" +#line 7669 "" s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37); -#line 7679 "" +#line 7669 "" do_fio(&c__1, ch__4, (ftnlen)37); -#line 7679 "" +#line 7669 "" do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real)); -#line 7679 "" +#line 7669 "" do_fio(&c__1, "}{", (ftnlen)2); -#line 7679 "" +#line 7669 "" do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real)); /* Writing concatenation */ -#line 7679 "" +#line 7669 "" i__5[0] = 1, a__3[0] = "}"; -#line 7679 "" +#line 7669 "" i__6 = *iddot + 48; -#line 7679 "" +#line 7669 "" chax_(ch__6, (ftnlen)1, &i__6); -#line 7679 "" +#line 7669 "" i__5[1] = 1, a__3[1] = ch__6; -#line 7679 "" +#line 7669 "" i__5[2] = 1, a__3[2] = "}"; -#line 7679 "" +#line 7669 "" i__5[3] = 1, a__3[3] = sq; -#line 7679 "" +#line 7669 "" i__5[4] = 11, a__3[4] = "makeatother"; -#line 7679 "" +#line 7669 "" s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15); -#line 7679 "" +#line 7669 "" do_fio(&c__1, ch__5, (ftnlen)15); -#line 7679 "" +#line 7669 "" e_wsfi(); /* Example of string just created: */ /* \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */ -#line 7688 "" +#line 7678 "" lnote = lfmtup + 54 + lfmtrt; -#line 7689 "" +#line 7679 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); -#line 7690 "" +#line 7680 "" return 0; } /* dotmov_ */ @@ -18671,162 +18669,162 @@ L4: static cilist io___531 = { 0, 6, 0, 0, 0 }; -#line 7700 "" +#line 7690 "" i__1 = comtrill_1.ntrill; -#line 7700 "" +#line 7690 "" for (itr = 1; itr <= i__1; ++itr) { -#line 7701 "" +#line 7691 "" if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[ itr - 1]) { -#line 7701 "" +#line 7691 "" goto L2; -#line 7701 "" +#line 7691 "" } -#line 7702 "" +#line 7692 "" /* L1: */ -#line 7702 "" +#line 7692 "" } -#line 7703 "" +#line 7693 "" s_wsle(&io___531); -#line 7703 "" +#line 7693 "" do_lio(&c__9, &c__1, "Problem in dotrill. Call Dr. Don", (ftnlen)33); -#line 7703 "" +#line 7693 "" e_wsle(); -#line 7704 "" +#line 7694 "" s_stop("", (ftnlen)0); -#line 7705 "" +#line 7695 "" L2: -#line 7706 "" +#line 7696 "" tronly = comtrill_1.xnsktr[itr - 1] < .01f; -#line 7707 "" +#line 7697 "" if (tronly) { /* Writing concatenation */ -#line 7708 "" +#line 7698 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7708 "" +#line 7698 "" i__2[0] = 1, a__1[0] = ch__1; -#line 7708 "" +#line 7698 "" i__2[1] = 9, a__1[1] = "zcharnote"; -#line 7708 "" +#line 7698 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 7709 "" +#line 7699 "" *lnote = 10; -#line 7710 "" +#line 7700 "" } else if (bit_test(*iornq,7)) { /* Writing concatenation */ -#line 7711 "" +#line 7701 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7711 "" +#line 7701 "" i__2[0] = 1, a__1[0] = ch__1; -#line 7711 "" +#line 7701 "" i__2[1] = 6, a__1[1] = "Trille"; -#line 7711 "" +#line 7701 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 7712 "" +#line 7702 "" *lnote = 7; -#line 7713 "" +#line 7703 "" } else { /* Writing concatenation */ -#line 7714 "" +#line 7704 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7714 "" +#line 7704 "" i__2[0] = 1, a__1[0] = ch__1; -#line 7714 "" +#line 7704 "" i__2[1] = 6, a__1[1] = "trille"; -#line 7714 "" +#line 7704 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 7715 "" +#line 7705 "" *lnote = 7; -#line 7716 "" +#line 7706 "" } /* Writing concatenation */ -#line 7717 "" +#line 7707 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 7717 "" +#line 7707 "" i__3[1] = *lnoten, a__2[1] = noteq; -#line 7717 "" +#line 7707 "" i__3[2] = 1, a__2[2] = "{"; -#line 7717 "" +#line 7707 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 7718 "" +#line 7708 "" *lnote = *lnote + *lnoten + 1; /* Write trill duration to nearest tenth of a noteskip */ -#line 7722 "" +#line 7712 "" if (tronly) { /* Writing concatenation */ -#line 7723 "" +#line 7713 "" i__3[0] = *lnote, a__2[0] = notexq; -#line 7723 "" +#line 7713 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7723 "" +#line 7713 "" i__3[1] = 1, a__2[1] = ch__1; -#line 7723 "" +#line 7713 "" i__3[2] = 6, a__2[2] = "it tr}"; -#line 7723 "" +#line 7713 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 7724 "" +#line 7714 "" *lnote += 7; -#line 7725 "" +#line 7715 "" return 0; -#line 7726 "" +#line 7716 "" } -#line 7727 "" +#line 7717 "" if (comtrill_1.xnsktr[itr - 1] < .95f) { -#line 7728 "" +#line 7718 "" nfmt = 2; -#line 7729 "" +#line 7719 "" } else if (comtrill_1.xnsktr[itr - 1] < 9.95f) { -#line 7730 "" +#line 7720 "" nfmt = 3; -#line 7731 "" +#line 7721 "" } else { -#line 7732 "" +#line 7722 "" nfmt = 4; -#line 7733 "" +#line 7723 "" } -#line 7734 "" +#line 7724 "" i__1 = *lnote; -#line 7734 "" +#line 7724 "" ici__1.icierr = 0; -#line 7734 "" +#line 7724 "" ici__1.icirnum = 1; -#line 7734 "" +#line 7724 "" ici__1.icirlen = *lnote + nfmt - i__1; -#line 7734 "" +#line 7724 "" ici__1.iciunit = notexq + i__1; /* Writing concatenation */ -#line 7734 "" +#line 7724 "" i__3[0] = 2, a__2[0] = "(f"; -#line 7734 "" +#line 7724 "" i__4 = nfmt + 48; -#line 7734 "" +#line 7724 "" chax_(ch__1, (ftnlen)1, &i__4); -#line 7734 "" +#line 7724 "" i__3[1] = 1, a__2[1] = ch__1; -#line 7734 "" +#line 7724 "" i__3[2] = 3, a__2[2] = ".1)"; -#line 7734 "" +#line 7724 "" ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2); -#line 7734 "" +#line 7724 "" s_wsfi(&ici__1); -#line 7734 "" +#line 7724 "" do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real)); -#line 7734 "" +#line 7724 "" e_wsfi(); -#line 7736 "" +#line 7726 "" *lnote += nfmt; /* Writing concatenation */ -#line 7737 "" +#line 7727 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 7737 "" +#line 7727 "" i__2[1] = 1, a__1[1] = "}"; -#line 7737 "" +#line 7727 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 7738 "" +#line 7728 "" ++(*lnote); -#line 7739 "" +#line 7729 "" return 0; } /* dotrill_ */ @@ -18856,41 +18854,41 @@ L2: /* Only called to end slur started in dograce. */ -#line 7751 "" +#line 7741 "" shift = ! (*stemup) && ! (*upslur); -#line 7752 "" +#line 7742 "" if (! shift) { /* No shift needed */ /* Writing concatenation */ -#line 7756 "" +#line 7746 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7756 "" +#line 7746 "" i__1[0] = 1, a__1[0] = ch__1; -#line 7756 "" +#line 7746 "" i__1[1] = 5, a__1[1] = "tslur"; -#line 7756 "" +#line 7746 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7757 "" +#line 7747 "" lnote = 6; -#line 7758 "" +#line 7748 "" } else { /* Shift needed */ /* Writing concatenation */ -#line 7762 "" +#line 7752 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 7762 "" +#line 7752 "" i__1[0] = 1, a__1[0] = ch__1; -#line 7762 "" +#line 7752 "" i__1[1] = 2, a__1[1] = "ts"; -#line 7762 "" +#line 7752 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7763 "" +#line 7753 "" lnote = 3; -#line 7764 "" +#line 7754 "" } /* if (ndxslur .lt. 10) then */ /* notexq = notexq(1:lnote)//chax(48+ndxslur) */ @@ -18904,105 +18902,105 @@ L2: /* Print 23-ndxslur */ /* if (11-ndxslur .lt. 10) then */ -#line 7777 "" +#line 7767 "" if (23 - *ndxslur < 10) { /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ /* Writing concatenation */ -#line 7779 "" +#line 7769 "" i__1[0] = lnote, a__1[0] = notexq; -#line 7779 "" +#line 7769 "" i__2 = 71 - *ndxslur; -#line 7779 "" +#line 7769 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7779 "" +#line 7769 "" i__1[1] = 1, a__1[1] = ch__1; -#line 7779 "" +#line 7769 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7780 "" +#line 7770 "" ++lnote; -#line 7781 "" +#line 7771 "" } else if (23 - *ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ -#line 7783 "" +#line 7773 "" i__3[0] = lnote, a__2[0] = notexq; -#line 7783 "" +#line 7773 "" i__3[1] = 2, a__2[1] = "{1"; -#line 7783 "" +#line 7773 "" i__2 = 61 - *ndxslur; -#line 7783 "" +#line 7773 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7783 "" +#line 7773 "" i__3[2] = 1, a__2[2] = ch__1; -#line 7783 "" +#line 7773 "" i__3[3] = 1, a__2[3] = "}"; -#line 7783 "" +#line 7773 "" s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); -#line 7784 "" +#line 7774 "" lnote += 4; -#line 7785 "" +#line 7775 "" } else { /* Writing concatenation */ -#line 7786 "" +#line 7776 "" i__3[0] = lnote, a__2[0] = notexq; -#line 7786 "" +#line 7776 "" i__3[1] = 2, a__2[1] = "{2"; -#line 7786 "" +#line 7776 "" i__2 = 51 - *ndxslur; -#line 7786 "" +#line 7776 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 7786 "" +#line 7776 "" i__3[2] = 1, a__2[2] = ch__1; -#line 7786 "" +#line 7776 "" i__3[3] = 1, a__2[3] = "}"; -#line 7786 "" +#line 7776 "" s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); -#line 7787 "" +#line 7777 "" lnote += 4; -#line 7788 "" +#line 7778 "" } -#line 7789 "" +#line 7779 "" i__2 = *nolev + *iupdn + *ivoff; -#line 7789 "" +#line 7779 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); /* Writing concatenation */ -#line 7790 "" +#line 7780 "" i__1[0] = lnote, a__1[0] = notexq; -#line 7790 "" +#line 7780 "" i__1[1] = lnoten, a__1[1] = noteq; -#line 7790 "" +#line 7780 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7791 "" +#line 7781 "" lnote += lnoten; -#line 7792 "" +#line 7782 "" if (shift) { -#line 7793 "" +#line 7783 "" if (*fontslur) { /* Writing concatenation */ -#line 7794 "" +#line 7784 "" i__1[0] = lnote, a__1[0] = notexq; -#line 7794 "" +#line 7784 "" i__1[1] = 5, a__1[1] = "{-.6}"; -#line 7794 "" +#line 7784 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7795 "" +#line 7785 "" } else { /* Writing concatenation */ -#line 7796 "" +#line 7786 "" i__1[0] = lnote, a__1[0] = notexq; -#line 7796 "" +#line 7786 "" i__1[1] = 5, a__1[1] = "{-.8}"; -#line 7796 "" +#line 7786 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 7797 "" +#line 7787 "" } -#line 7798 "" +#line 7788 "" lnote += 5; -#line 7799 "" +#line 7789 "" } -#line 7800 "" +#line 7790 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); -#line 7801 "" +#line 7791 "" return 0; } /* endslur_ */ @@ -19045,32 +19043,32 @@ L2: static cilist io___553 = { 0, 15, 0, "(a)", 0 }; -#line 7813 "" +#line 7803 "" if (*iccount <= 78) { -#line 7814 "" +#line 7804 "" s_copy(outq, lineq, (ftnlen)78, (ftnlen)78); -#line 7815 "" +#line 7805 "" iposn = *iccount; -#line 7816 "" +#line 7806 "" } else { /* Writing concatenation */ -#line 7817 "" +#line 7807 "" i__1[0] = 4, a__1[0] = "... "; -#line 7817 "" +#line 7807 "" i__1[1] = 74, a__1[1] = lineq + 54; -#line 7817 "" +#line 7807 "" s_cat(outq, a__1, i__1, &c__2, (ftnlen)78); -#line 7818 "" +#line 7808 "" iposn = *iccount - 50; -#line 7819 "" +#line 7809 "" } -#line 7820 "" +#line 7810 "" s_wsle(&io___541); -#line 7820 "" +#line 7810 "" e_wsle(); -#line 7821 "" +#line 7811 "" ibarnop = *ibarno; -#line 7822 "" +#line 7812 "" if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline > c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) { @@ -19078,299 +19076,299 @@ L2: /* nlinep = nline-linesinpmxmod */ /* Correct for comments not copied into buffer */ -#line 7829 "" +#line 7819 "" nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] - c1omget_1.linesinpmxmod; -#line 7830 "" +#line 7820 "" } else { /* Error is in include file */ -#line 7834 "" +#line 7824 "" ibarnop = 0; -#line 7835 "" +#line 7825 "" nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1; -#line 7836 "" +#line 7826 "" printl_("ERROR in include file named above, description given below", (ftnlen)58); -#line 7838 "" +#line 7828 "" } -#line 7839 "" +#line 7829 "" o__1.oerr = 0; -#line 7839 "" +#line 7829 "" o__1.ounit = 19; -#line 7839 "" +#line 7829 "" o__1.ofnmlen = 11; -#line 7839 "" +#line 7829 "" o__1.ofnm = "pmxaerr.dat"; -#line 7839 "" +#line 7829 "" o__1.orl = 0; -#line 7839 "" +#line 7829 "" o__1.osta = 0; -#line 7839 "" +#line 7829 "" o__1.oacc = 0; -#line 7839 "" +#line 7829 "" o__1.ofm = 0; -#line 7839 "" +#line 7829 "" o__1.oblnk = 0; -#line 7839 "" +#line 7829 "" f_open(&o__1); -#line 7840 "" +#line 7830 "" s_wsfe(&io___544); -#line 7840 "" +#line 7830 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); -#line 7840 "" +#line 7830 "" e_wsfe(); -#line 7841 "" +#line 7831 "" cl__1.cerr = 0; -#line 7841 "" +#line 7831 "" cl__1.cunit = 19; -#line 7841 "" +#line 7831 "" cl__1.csta = 0; -#line 7841 "" +#line 7831 "" f_clos(&cl__1); /* Computing MAX */ -#line 7842 "" +#line 7832 "" r__1 = ibarnop + .1f; -#line 7842 "" +#line 7832 "" i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1); -#line 7842 "" +#line 7832 "" ndigbn = max(i__2,i__3); -#line 7843 "" +#line 7833 "" r__1 = nlinep + .1f; -#line 7843 "" +#line 7833 "" ndignl = (integer) (r_lg10(&r__1) + 1); -#line 7844 "" +#line 7834 "" lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1; /* Split off msgq(..) since UNIX compilers don't allow concat substring!!! */ -#line 7848 "" +#line 7838 "" ci__1.cierr = 0; -#line 7848 "" +#line 7838 "" ci__1.ciunit = 6; /* Writing concatenation */ -#line 7848 "" +#line 7838 "" i__4[0] = 8, a__2[0] = "(/,a15,i"; -#line 7848 "" +#line 7838 "" i__2 = ndignl + 48; -#line 7848 "" +#line 7838 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7848 "" +#line 7838 "" i__4[1] = 1, a__2[1] = ch__2; -#line 7848 "" +#line 7838 "" i__4[2] = 5, a__2[2] = ",a6,i"; -#line 7848 "" +#line 7838 "" i__3 = ndigbn + 48; -#line 7848 "" +#line 7838 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7848 "" +#line 7838 "" i__4[3] = 1, a__2[3] = ch__3; -#line 7848 "" +#line 7838 "" i__4[4] = 3, a__2[4] = ",$)"; -#line 7848 "" +#line 7838 "" ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); -#line 7848 "" +#line 7838 "" s_wsfe(&ci__1); -#line 7848 "" +#line 7838 "" do_fio(&c__1, " ERROR in line ", (ftnlen)15); -#line 7848 "" +#line 7838 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); -#line 7848 "" +#line 7838 "" do_fio(&c__1, ", bar ", (ftnlen)6); -#line 7848 "" +#line 7838 "" do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); -#line 7848 "" +#line 7838 "" e_wsfe(); -#line 7850 "" +#line 7840 "" s_wsfe(&io___548); -#line 7850 "" +#line 7840 "" do_fio(&c__1, msgq, lenmsg); -#line 7850 "" +#line 7840 "" e_wsfe(); -#line 7851 "" +#line 7841 "" ci__1.cierr = 0; -#line 7851 "" +#line 7841 "" ci__1.ciunit = 15; /* Writing concatenation */ -#line 7851 "" +#line 7841 "" i__4[0] = 8, a__2[0] = "(/,a15,i"; -#line 7851 "" +#line 7841 "" i__2 = ndignl + 48; -#line 7851 "" +#line 7841 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7851 "" +#line 7841 "" i__4[1] = 1, a__2[1] = ch__2; -#line 7851 "" +#line 7841 "" i__4[2] = 5, a__2[2] = ",a6,i"; -#line 7851 "" +#line 7841 "" i__3 = ndigbn + 48; -#line 7851 "" +#line 7841 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7851 "" +#line 7841 "" i__4[3] = 1, a__2[3] = ch__3; -#line 7851 "" +#line 7841 "" i__4[4] = 3, a__2[4] = ",$)"; -#line 7851 "" +#line 7841 "" ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); -#line 7851 "" +#line 7841 "" s_wsfe(&ci__1); -#line 7851 "" +#line 7841 "" do_fio(&c__1, " ERROR in line ", (ftnlen)15); -#line 7851 "" +#line 7841 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); -#line 7851 "" +#line 7841 "" do_fio(&c__1, ", bar ", (ftnlen)6); -#line 7851 "" +#line 7841 "" do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); -#line 7851 "" +#line 7841 "" e_wsfe(); -#line 7853 "" +#line 7843 "" s_wsfe(&io___549); -#line 7853 "" +#line 7843 "" do_fio(&c__1, msgq, lenmsg); -#line 7853 "" +#line 7843 "" e_wsfe(); -#line 7854 "" +#line 7844 "" i10 = iposn / 10; -#line 7855 "" +#line 7845 "" i1 = iposn - i10 * 10; -#line 7856 "" +#line 7846 "" ci__1.cierr = 0; -#line 7856 "" +#line 7846 "" ci__1.ciunit = 6; /* Writing concatenation */ -#line 7856 "" +#line 7846 "" i__5[0] = 1, a__3[0] = "("; -#line 7856 "" +#line 7846 "" i__2 = i10 + 48; -#line 7856 "" +#line 7846 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7856 "" +#line 7846 "" i__5[1] = 1, a__3[1] = ch__2; -#line 7856 "" +#line 7846 "" i__3 = i1 + 48; -#line 7856 "" +#line 7846 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7856 "" +#line 7846 "" i__5[2] = 1, a__3[2] = ch__3; -#line 7856 "" +#line 7846 "" i__5[3] = 4, a__3[3] = "x,a)"; -#line 7856 "" +#line 7846 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); -#line 7856 "" +#line 7846 "" s_wsfe(&ci__1); -#line 7856 "" +#line 7846 "" do_fio(&c__1, "v", (ftnlen)1); -#line 7856 "" +#line 7846 "" e_wsfe(); -#line 7857 "" +#line 7847 "" ci__1.cierr = 0; -#line 7857 "" +#line 7847 "" ci__1.ciunit = 15; /* Writing concatenation */ -#line 7857 "" +#line 7847 "" i__5[0] = 1, a__3[0] = "("; -#line 7857 "" +#line 7847 "" i__2 = i10 + 48; -#line 7857 "" +#line 7847 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7857 "" +#line 7847 "" i__5[1] = 1, a__3[1] = ch__2; -#line 7857 "" +#line 7847 "" i__3 = i1 + 48; -#line 7857 "" +#line 7847 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7857 "" +#line 7847 "" i__5[2] = 1, a__3[2] = ch__3; -#line 7857 "" +#line 7847 "" i__5[3] = 4, a__3[3] = "x,a)"; -#line 7857 "" +#line 7847 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); -#line 7857 "" +#line 7847 "" s_wsfe(&ci__1); -#line 7857 "" +#line 7847 "" do_fio(&c__1, "v", (ftnlen)1); -#line 7857 "" +#line 7847 "" e_wsfe(); -#line 7858 "" +#line 7848 "" s_wsle(&io___552); -#line 7858 "" +#line 7848 "" do_lio(&c__9, &c__1, outq, (ftnlen)78); -#line 7858 "" +#line 7848 "" e_wsle(); -#line 7859 "" +#line 7849 "" s_wsfe(&io___553); /* Writing concatenation */ -#line 7859 "" +#line 7849 "" i__1[0] = 1, a__1[0] = " "; -#line 7859 "" +#line 7849 "" i__1[1] = 78, a__1[1] = outq; -#line 7859 "" +#line 7849 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79); -#line 7859 "" +#line 7849 "" do_fio(&c__1, ch__5, (ftnlen)79); -#line 7859 "" +#line 7849 "" e_wsfe(); -#line 7860 "" +#line 7850 "" ci__1.cierr = 0; -#line 7860 "" +#line 7850 "" ci__1.ciunit = 6; /* Writing concatenation */ -#line 7860 "" +#line 7850 "" i__5[0] = 1, a__3[0] = "("; -#line 7860 "" +#line 7850 "" i__2 = i10 + 48; -#line 7860 "" +#line 7850 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7860 "" +#line 7850 "" i__5[1] = 1, a__3[1] = ch__2; -#line 7860 "" +#line 7850 "" i__3 = i1 + 48; -#line 7860 "" +#line 7850 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7860 "" +#line 7850 "" i__5[2] = 1, a__3[2] = ch__3; -#line 7860 "" +#line 7850 "" i__5[3] = 4, a__3[3] = "x,a)"; -#line 7860 "" +#line 7850 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); -#line 7860 "" +#line 7850 "" s_wsfe(&ci__1); -#line 7860 "" +#line 7850 "" do_fio(&c__1, "^", (ftnlen)1); -#line 7860 "" +#line 7850 "" e_wsfe(); -#line 7861 "" +#line 7851 "" ci__1.cierr = 0; -#line 7861 "" +#line 7851 "" ci__1.ciunit = 15; /* Writing concatenation */ -#line 7861 "" +#line 7851 "" i__5[0] = 1, a__3[0] = "("; -#line 7861 "" +#line 7851 "" i__2 = i10 + 48; -#line 7861 "" +#line 7851 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 7861 "" +#line 7851 "" i__5[1] = 1, a__3[1] = ch__2; -#line 7861 "" +#line 7851 "" i__3 = i1 + 48; -#line 7861 "" +#line 7851 "" chax_(ch__3, (ftnlen)1, &i__3); -#line 7861 "" +#line 7851 "" i__5[2] = 1, a__3[2] = ch__3; -#line 7861 "" +#line 7851 "" i__5[3] = 4, a__3[3] = "x,a)"; -#line 7861 "" +#line 7851 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); -#line 7861 "" +#line 7851 "" s_wsfe(&ci__1); -#line 7861 "" +#line 7851 "" do_fio(&c__1, "^", (ftnlen)1); -#line 7861 "" +#line 7851 "" e_wsfe(); -#line 7862 "" +#line 7852 "" return 0; } /* errmsg_ */ @@ -19397,76 +19395,76 @@ L2: /* Get elemskips to previous note. Called only for graces, no xtups involved. */ -#line 7882 "" +#line 7872 "" /* Parameter adjustments */ -#line 7882 "" +#line 7872 "" --tstart; -#line 7882 "" +#line 7872 "" --space; -#line 7882 "" +#line 7872 "" -#line 7882 "" +#line 7872 "" /* Function Body */ -#line 7882 "" +#line 7872 "" itnd = i_nint(&all_1.to[*in - 1]); -#line 7883 "" +#line 7873 "" if (*ip == 1 || itnd == *itrpt) { /* Start of bar or after rpt. */ -#line 7887 "" +#line 7877 "" *esk = *fbar; -#line 7888 "" +#line 7878 "" return 0; -#line 7889 "" +#line 7879 "" } else { -#line 7890 "" +#line 7880 "" *esk = 0.f; -#line 7891 "" +#line 7881 "" itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25]; -#line 7892 "" +#line 7882 "" for (iib = *ib; iib >= 1; --iib) { -#line 7893 "" +#line 7883 "" if (tstart[iib] < itprev + comtol_1.tol) { /* This is the block */ -#line 7897 "" +#line 7887 "" r__1 = (real) (itnd - itprev) / space[iib]; -#line 7897 "" +#line 7887 "" nnsk = i_nint(&r__1); -#line 7898 "" +#line 7888 "" *esk += nnsk * feon_(&space[iib]); -#line 7899 "" +#line 7889 "" return 0; -#line 7900 "" +#line 7890 "" } else { -#line 7901 "" +#line 7891 "" r__1 = (itnd - tstart[iib]) / space[iib]; -#line 7901 "" +#line 7891 "" nnsk = i_nint(&r__1); -#line 7902 "" +#line 7892 "" *esk += nnsk * feon_(&space[iib]); -#line 7903 "" +#line 7893 "" itnd = i_nint(&tstart[iib]); -#line 7904 "" +#line 7894 "" } -#line 7905 "" +#line 7895 "" /* L1: */ -#line 7905 "" +#line 7895 "" } -#line 7906 "" +#line 7896 "" } -#line 7907 "" +#line 7897 "" s_wsle(&io___558); -#line 7907 "" +#line 7897 "" do_lio(&c__9, &c__1, "Problem in eskb4. Send files to Dr. Don", (ftnlen) 40); -#line 7907 "" +#line 7897 "" e_wsle(); -#line 7908 "" +#line 7898 "" s_stop("", (ftnlen)0); -#line 7909 "" +#line 7899 "" return 0; } /* eskb4_ */ @@ -19478,9 +19476,9 @@ doublereal f1eon_(real *time) /* Builtin functions */ double sqrt(doublereal); -#line 7911 "" +#line 7901 "" ret_val = sqrt(*time / 2); -#line 7912 "" +#line 7902 "" return ret_val; } /* f1eon_ */ @@ -19493,13 +19491,13 @@ doublereal feon_(real *time) /* Builtin functions */ double sqrt(doublereal), pow_dd(doublereal *, doublereal *); -#line 7916 "" +#line 7906 "" d__1 = (doublereal) sqrt(*time / 2); -#line 7916 "" +#line 7906 "" d__2 = (doublereal) (1.f - comeon_1.eonk); -#line 7916 "" +#line 7906 "" ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk; -#line 7917 "" +#line 7907 "" return ret_val; } /* feon_ */ @@ -19578,428 +19576,432 @@ doublereal feon_(real *time) /* Called once per voice per bar, after setting forced beams. */ -/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */ +/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(24), */ /* * itr(48),nodue(48) */ /* logical short(48),eqonly */ -#line 7947 "" +#line 7937 "" /* Parameter adjustments */ -#line 7947 "" +#line 7937 "" --mapfb; -#line 7947 "" +#line 7937 "" --numbms; -#line 7947 "" +#line 7937 "" -#line 7947 "" +#line 7937 "" /* Function Body */ -#line 7968 "" +#line 7958 "" ip = 0; -#line 7969 "" +#line 7959 "" nreal = 0; -#line 7970 "" +#line 7960 "" itnow = 0; -#line 7971 "" +#line 7961 "" L1: -#line 7972 "" +#line 7962 "" ++ip; -#line 7973 "" +#line 7963 "" if (ip > all_1.nn[commvl_1.ivx - 1]) { -#line 7973 "" +#line 7963 "" goto L9; -#line 7973 "" +#line 7963 "" } -#line 7974 "" +#line 7964 "" L11: -#line 7974 "" +#line 7964 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* Ignore all xtup notes except the last, the one with nodur > 0 . */ /* Xtups are irrelevant here since they are already all in forced beams. */ /* Will update itnow by nodur at the END of this loop */ -#line 7980 "" +#line 7970 "" ++ip; -#line 7981 "" +#line 7971 "" goto L11; -#line 7982 "" +#line 7972 "" } -#line 7983 "" +#line 7973 "" ++nreal; -#line 7984 "" +#line 7974 "" nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 7985 "" +#line 7975 "" short__[nreal - 1] = nodue[nreal - 1] < 16 && ! bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(all_1.islur[ commvl_1.ivx + ip * 24 - 25],18); /* Rule out notes that have 'alone'-flag set */ -#line 7991 "" +#line 7981 "" ipr[nreal - 1] = ip; -#line 7992 "" +#line 7982 "" itr[nreal - 1] = itnow; -#line 7993 "" +#line 7983 "" if (nodue[nreal - 1] == 1) { /* 64th gap */ -#line 7997 "" +#line 7987 "" if (itnow % 2 == 0) { /* Start of 32nd gap, lump with following note */ -#line 8001 "" +#line 7991 "" ++ip; -#line 8002 "" +#line 7992 "" nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1; -#line 8003 "" +#line 7993 "" itnow += nodue[nreal - 1]; -#line 8004 "" +#line 7994 "" } else { /* End of 32nd gap, lump with preceeding note */ -#line 8008 "" +#line 7998 "" --nreal; -#line 8009 "" +#line 7999 "" ++nodue[nreal - 1]; -#line 8010 "" +#line 8000 "" ++itnow; -#line 8011 "" +#line 8001 "" } -#line 8012 "" +#line 8002 "" } else { -#line 8013 "" +#line 8003 "" itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 8014 "" +#line 8004 "" } -#line 8015 "" +#line 8005 "" goto L1; -#line 8016 "" +#line 8006 "" L9: -#line 8017 "" +#line 8007 "" ir1 = 1; -#line 8018 "" +#line 8008 "" itseg = all_1.lenbar / *ibmrep; -#line 8019 "" +#line 8009 "" i__1 = *ibmrep; -#line 8019 "" +#line 8009 "" for (irep = 1; irep <= i__1; ++irep) { /* Set bitmaps for all shorts neighbored by a short. Each bit represents a */ /* span of 32nd note. maps, mapm, mape record start, full duration, and end */ /* of consecutive span of beamable (<1/4) notes. */ -#line 8025 "" +#line 8015 "" maps = 0; -#line 8026 "" +#line 8016 "" mapm = 0; -#line 8027 "" +#line 8017 "" mape = 0; -#line 8028 "" +#line 8018 "" itend = itseg * irep; -#line 8029 "" +#line 8019 "" itoff = itend - itseg; -#line 8030 "" +#line 8020 "" i__2 = nreal; -#line 8030 "" +#line 8020 "" for (ir = ir1; ir <= i__2; ++ir) { -#line 8031 "" +#line 8021 "" it2 = itr[ir - 1] + nodue[ir - 1] - 2; -#line 8032 "" +#line 8022 "" if (it2 >= itend) { -#line 8033 "" +#line 8023 "" ir1 = ir; -#line 8034 "" +#line 8024 "" goto L14; -#line 8035 "" +#line 8025 "" } /* if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */ /* Computing MAX */ -#line 8037 "" +#line 8027 "" i__3 = ir - 1; -#line 8037 "" +#line 8027 "" if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir < nreal && short__[ir])) { -#line 8039 "" +#line 8029 "" ib1 = (itr[ir - 1] - itoff) / 2; -#line 8040 "" +#line 8030 "" ib2 = (it2 - itoff) / 2; -#line 8041 "" +#line 8031 "" if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) { -#line 8041 "" +#line 8031 "" return 0; -#line 8041 "" +#line 8031 "" } +/* if (max(ib1,ib2).gt.247 .or. ir.gt.248 .or. */ +/* * min(ib1,ib2).lt.0) return */ /* Must have an odd number obe beats in a long bar. Auto-beam won't work */ -#line 8046 "" +#line 8038 "" nip1[ib1] = ipr[ir - 1]; -#line 8047 "" +#line 8039 "" nip2[ib2] = ipr[ir - 1]; /* nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */ -#line 8051 "" +#line 8043 "" maps = bit_set(maps,ib1); -#line 8052 "" +#line 8044 "" mape = bit_set(mape,ib2); -#line 8053 "" +#line 8045 "" i__3 = ib2; -#line 8053 "" +#line 8045 "" for (ib = ib1; ib <= i__3; ++ib) { -#line 8054 "" +#line 8046 "" mapm = bit_set(mapm,ib); -#line 8055 "" +#line 8047 "" /* L3: */ -#line 8055 "" +#line 8047 "" } -#line 8056 "" +#line 8048 "" } -#line 8057 "" +#line 8049 "" /* L2: */ -#line 8057 "" +#line 8049 "" } -#line 8058 "" +#line 8050 "" L14: -#line 8059 "" +#line 8051 "" if (mapm == 0) { -#line 8059 "" +#line 8051 "" goto L13; -#line 8059 "" +#line 8051 "" } /* Zero out bits from forced beams */ -#line 8063 "" +#line 8055 "" maps &= ~ mapfb[irep]; -#line 8064 "" +#line 8056 "" mapm &= ~ mapfb[irep]; -#line 8065 "" +#line 8057 "" mape &= ~ mapfb[irep]; /* Compare map with template. */ -#line 8069 "" +#line 8061 "" i__2 = nummask[combeam_1.ibmtyp - 1]; -#line 8069 "" +#line 8061 "" for (it = 1; it <= i__2; ++it) { -#line 8070 "" +#line 8062 "" masknow = mask[it + combeam_1.ibmtyp * 49 - 50]; -#line 8071 "" +#line 8063 "" if ((masknow & mapm) == masknow) { /* Find least significant bit in the mask to check start time */ -#line 8075 "" +#line 8067 "" mtemp = masknow; -#line 8076 "" +#line 8068 "" maskm = masknow; -#line 8077 "" +#line 8069 "" for (is1 = 0; is1 <= 47; ++is1) { -#line 8078 "" +/* do 5 is1 = 0 , 247 */ +#line 8071 "" if ((1 & mtemp) == 1) { -#line 8078 "" +#line 8071 "" goto L6; -#line 8078 "" +#line 8071 "" } -#line 8079 "" +#line 8072 "" mtemp = lbit_shift(mtemp, (ftnlen)-1); -#line 8080 "" +#line 8073 "" /* L5: */ -#line 8080 "" +#line 8073 "" } -#line 8081 "" +#line 8074 "" L6: -#line 8082 "" +#line 8075 "" if ((lbit_shift((ftnlen)1, is1) & maps) == 0) { -#line 8082 "" +#line 8075 "" goto L4; -#line 8082 "" +#line 8075 "" } /* is1 is the bit where the beam starts. Continue shifting to */ /* find most significant bit in the mask to check ending time */ -#line 8087 "" +#line 8080 "" for (is2 = is1; is2 <= 47; ++is2) { -#line 8088 "" +/* do 7 is2 = is1 , 247 */ +#line 8082 "" mtemp = lbit_shift(mtemp, (ftnlen)-1); -#line 8089 "" +#line 8083 "" if ((1 & ~ mtemp) == 1) { -#line 8089 "" +#line 8083 "" goto L8; -#line 8089 "" +#line 8083 "" } -#line 8090 "" +#line 8084 "" /* L7: */ -#line 8090 "" +#line 8084 "" } -#line 8091 "" +#line 8085 "" L8: /* is2 is now the bit on which the beam ends. */ -#line 8095 "" +#line 8089 "" if ((lbit_shift((ftnlen)1, is2) & mape) == 0) { -#line 8095 "" +#line 8089 "" goto L4; -#line 8095 "" +#line 8089 "" } /* Did we pick out a single note from the middle of a longer sequence? */ -#line 8099 "" +#line 8093 "" if (nip1[is1] == nip2[is2]) { -#line 8099 "" +#line 8093 "" goto L4; -#line 8099 "" +#line 8093 "" } /* We almost have a beam. Check equality of notes if needed. */ -#line 8103 "" +#line 8097 "" if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) { -#line 8104 "" +#line 8098 "" i__3 = nip2[is2]; -#line 8104 "" +#line 8098 "" for (ip = nip1[is1]; ip <= i__3; ++ip) { -#line 8105 "" +#line 8099 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] != 8) { /* There is a non-1/8th note in this beam. Exit if not 2 quarters */ -#line 8109 "" +#line 8103 "" if (is2 - is1 != 15) { -#line 8109 "" +#line 8103 "" goto L4; -#line 8109 "" +#line 8103 "" } /* Beam is 2 quarters long. Check if can split in half. */ -#line 8113 "" +#line 8107 "" ithalf = 0; -#line 8114 "" +#line 8108 "" i__4 = nip2[is2]; -#line 8114 "" +#line 8108 "" for (iip = nip1[is1]; iip <= i__4; ++iip) { -#line 8115 "" +#line 8109 "" ithalf += all_1.nodur[commvl_1.ivx + iip * 24 - 25]; -#line 8116 "" +#line 8110 "" if (ithalf > 16) { -#line 8116 "" +#line 8110 "" goto L4; -#line 8116 "" +#line 8110 "" } -#line 8117 "" +#line 8111 "" if (ithalf == 16) { -#line 8117 "" +#line 8111 "" goto L21; -#line 8117 "" +#line 8111 "" } -#line 8118 "" +#line 8112 "" /* L20: */ -#line 8118 "" +#line 8112 "" } -#line 8119 "" +#line 8113 "" s_wsle(&io___592); -#line 8119 "" +#line 8113 "" do_lio(&c__9, &c__1, "Problem in findbeam, pleas"\ "e call Dr. Don", (ftnlen)40); -#line 8119 "" +#line 8113 "" e_wsle(); -#line 8120 "" +#line 8114 "" goto L4; -#line 8121 "" +#line 8115 "" L21: /* Otherwise, split in half by keeping only the first half. Other half will */ /* be picked up later, assuming masks are listed longest first. */ -#line 8126 "" +#line 8120 "" is2 = is1 + 7; /* Reset maskm (since only used part of mask), used later to zero out */ /* bits that contain beams */ -#line 8131 "" +#line 8125 "" maskm = 0; -#line 8132 "" +#line 8126 "" i__4 = is2; -#line 8132 "" +#line 8126 "" for (is = is1; is <= i__4; ++is) { -#line 8133 "" +#line 8127 "" maskm = bit_set(maskm,is); -#line 8134 "" +#line 8128 "" /* L15: */ -#line 8134 "" +#line 8128 "" } -#line 8135 "" +#line 8129 "" goto L16; -#line 8136 "" +#line 8130 "" } -#line 8137 "" +#line 8131 "" /* L10: */ -#line 8137 "" +#line 8131 "" } -#line 8138 "" +#line 8132 "" } -#line 8139 "" +#line 8133 "" L16: /* This is a beam. If last "effective" ends on odd 64th, add 1 more */ /* if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) */ /* * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then */ -#line 8145 "" +#line 8139 "" r__2 = all_1.to[comipl2_1.ipl2[commvl_1.ivx + nip2[is2] * 24 - 25] - 1] + all_1.nodur[commvl_1.ivx + nip2[is2] * 24 - 25] + comtol_1.tol * .5f; -#line 8145 "" +#line 8139 "" if ((r__1 = r_mod(&r__2, &c_b1901), dabs(r__1)) > comtol_1.tol) { -#line 8147 "" +#line 8141 "" ++nip2[is2]; -#line 8148 "" +#line 8142 "" } -#line 8149 "" +#line 8143 "" ++numbms[commvl_1.ivx]; -#line 8150 "" +#line 8144 "" numnew = numbms[commvl_1.ivx]; -#line 8151 "" +#line 8145 "" logbeam_(&numnew, &nip1[is1], &nip2[is2]); /* Zero out the appropriate bits so these notes don't get used again */ -#line 8155 "" +#line 8149 "" mapm &= ~ maskm; -#line 8156 "" +#line 8150 "" if (mapm == 0) { -#line 8156 "" +#line 8150 "" goto L13; -#line 8156 "" +#line 8150 "" } -#line 8157 "" +#line 8151 "" maps &= ~ maskm; -#line 8158 "" +#line 8152 "" mape &= ~ maskm; -#line 8159 "" +#line 8153 "" } -#line 8160 "" +#line 8154 "" L4: -#line 8160 "" +#line 8154 "" ; -#line 8160 "" +#line 8154 "" } -#line 8161 "" +#line 8155 "" L13: -#line 8161 "" +#line 8155 "" ; -#line 8161 "" +#line 8155 "" } -#line 8162 "" +#line 8156 "" return 0; } /* findbeam_ */ @@ -20030,85 +20032,83 @@ L13: /* Compute an exponent eonk for use in the "flattened" formula for elemskips */ /* vs time. We must solve the eqution f = 0. Initial quess is eonk0. */ -/* logical gotclef */ -/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ -#line 8177 "" +#line 8169 "" comeon_1.eonk = *eonk0; -#line 8178 "" +#line 8170 "" niter = 0; -#line 8179 "" +#line 8171 "" L1: -#line 8180 "" +#line 8172 "" d__1 = (doublereal) f1eon_(dtmax); -#line 8180 "" +#line 8172 "" d__2 = (doublereal) comeon_1.eonk; -#line 8180 "" +#line 8172 "" comeon_1.ewmxk = pow_dd(&d__1, &d__2); -#line 8181 "" +#line 8173 "" ++niter; -#line 8182 "" +#line 8174 "" esum = 0.f; -#line 8183 "" +#line 8175 "" desum = 0.f; -#line 8184 "" +#line 8176 "" i__1 = *nptr2; -#line 8184 "" +#line 8176 "" for (iptr = *nptr1; iptr <= i__1; ++iptr) { -#line 8185 "" +#line 8177 "" targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]; -#line 8186 "" +#line 8178 "" esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * feon_(&targ); -#line 8187 "" +#line 8179 "" d__1 = (doublereal) (*dtmax / targ); -#line 8187 "" +#line 8179 "" d__2 = (doublereal) comeon_1.eonk; -#line 8187 "" +#line 8179 "" detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ); -#line 8188 "" +#line 8180 "" desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * detarg; -#line 8189 "" +#line 8181 "" /* L2: */ -#line 8189 "" +#line 8181 "" } -#line 8190 "" +#line 8182 "" f = *wovera * feon_(dtmin) - *xelsk - esum; -#line 8191 "" +#line 8183 "" d__1 = (doublereal) (*dtmax / *dtmin); -#line 8191 "" +#line 8183 "" d__2 = (doublereal) comeon_1.eonk; -#line 8191 "" +#line 8183 "" fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / * dtmin) - desum; -#line 8193 "" +#line 8185 "" if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) > .5f || niter > 100) { -#line 8194 "" +#line 8186 "" printl_("Error in findeonk. Please send source to Dr. Don", (ftnlen) 49); -#line 8196 "" +#line 8188 "" comeon_1.eonk = 0.f; -#line 8197 "" +#line 8189 "" comeon_1.ewmxk = 1.f; -#line 8198 "" +#line 8190 "" return 0; -#line 8199 "" +#line 8191 "" } -#line 8200 "" +#line 8192 "" dsoln = -f / fp; -#line 8201 "" +#line 8193 "" if (dabs(dsoln) < comtol_1.tol * .1f) { -#line 8201 "" +#line 8193 "" return 0; -#line 8201 "" +#line 8193 "" } /* Not converged yet, try again */ -#line 8205 "" +#line 8197 "" comeon_1.eonk += dsoln; -#line 8206 "" +#line 8198 "" goto L1; } /* findeonk_ */ @@ -20135,136 +20135,136 @@ doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc) /* This return the real duration of a note */ -#line 8215 "" +#line 8207 "" /* Parameter adjustments */ -#line 8215 "" +#line 8207 "" nacc -= 25; -#line 8215 "" +#line 8207 "" nodur -= 25; -#line 8215 "" +#line 8207 "" -#line 8215 "" +#line 8207 "" /* Function Body */ -#line 8215 "" +#line 8207 "" ipback = *ip; -#line 8216 "" +#line 8208 "" if (nodur[*ivx + *ip * 24] > 0) { -#line 8217 "" +#line 8209 "" if (*ip > 1) { /* Check if this is last note of xtup */ -#line 8221 "" +#line 8213 "" if (nodur[*ivx + (*ip - 1) * 24] == 0) { -#line 8222 "" +#line 8214 "" ipback = *ip - 1; -#line 8223 "" +#line 8215 "" goto L2; -#line 8224 "" +#line 8216 "" } -#line 8225 "" +#line 8217 "" } -#line 8226 "" +#line 8218 "" ret_val = (real) nodur[*ivx + *ip * 24]; -#line 8227 "" +#line 8219 "" return ret_val; -#line 8228 "" +#line 8220 "" } -#line 8229 "" +#line 8221 "" L2: /* Count back to prior non zero note. Start at ip to avoid neg index if ip=1. */ /* Count how many doubled xtups notes there are from ip-1 to first note. */ -#line 8234 "" +#line 8226 "" ndoub = 0; -#line 8235 "" +#line 8227 "" for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) { -#line 8236 "" +#line 8228 "" if (nodur[*ivx + ip1m1 * 24] > 0) { -#line 8236 "" +#line 8228 "" goto L4; -#line 8236 "" +#line 8228 "" } -#line 8237 "" +#line 8229 "" if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) { -#line 8237 "" +#line 8229 "" ++ndoub; -#line 8237 "" +#line 8229 "" } -#line 8238 "" +#line 8230 "" /* L1: */ -#line 8238 "" +#line 8230 "" } -#line 8239 "" +#line 8231 "" L4: /* count forward to next non-0 nodur. Start at ip in case last note of xtup. */ -#line 8243 "" +#line 8235 "" for (iip = *ip; iip <= 200; ++iip) { /* Count doubled xtup notes from ip to end. */ -#line 8247 "" +#line 8239 "" if (bit_test(nacc[*ivx + iip * 24],18)) { -#line 8247 "" +#line 8239 "" ++ndoub; -#line 8247 "" +#line 8239 "" } -#line 8248 "" +#line 8240 "" if (nodur[*ivx + iip * 24] > 0) { /* fnote = nodur(ivx,iip)/float(iip-ip1m1) */ -#line 8250 "" +#line 8242 "" ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub); -#line 8251 "" +#line 8243 "" if (bit_test(nacc[*ivx + *ip * 24],18)) { -#line 8252 "" +#line 8244 "" ret_val *= 2; -#line 8253 "" +#line 8245 "" } else if (bit_test(nacc[*ivx + *ip * 24],27)) { -#line 8254 "" +#line 8246 "" ret_val *= 1.5f; -#line 8255 "" +#line 8247 "" } else if (*ip > 1) { -#line 8256 "" +#line 8248 "" if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) { -#line 8256 "" +#line 8248 "" ret_val *= .5f; -#line 8256 "" +#line 8248 "" } -#line 8257 "" +#line 8249 "" } -#line 8258 "" +#line 8250 "" return ret_val; -#line 8259 "" +#line 8251 "" } -#line 8260 "" +#line 8252 "" /* L3: */ -#line 8260 "" +#line 8252 "" } -#line 8261 "" +#line 8253 "" s_wsle(&io___608); -#line 8261 "" +#line 8253 "" do_lio(&c__9, &c__1, " ", (ftnlen)1); -#line 8261 "" +#line 8253 "" e_wsle(); -#line 8262 "" +#line 8254 "" printl_("Probable misplaced barline or incorrect meter, stopping", ( ftnlen)55); -#line 8264 "" +#line 8256 "" s_wsle(&io___609); -#line 8264 "" +#line 8256 "" do_lio(&c__9, &c__1, "ivx,ip:", (ftnlen)7); -#line 8264 "" +#line 8256 "" do_lio(&c__3, &c__1, (char *)&(*ivx), (ftnlen)sizeof(integer)); -#line 8264 "" +#line 8256 "" do_lio(&c__3, &c__1, (char *)&(*ip), (ftnlen)sizeof(integer)); -#line 8264 "" +#line 8256 "" e_wsle(); -#line 8265 "" +#line 8257 "" stop1_(); -#line 8266 "" +#line 8258 "" return ret_val; } /* fnote_ */ @@ -20285,50 +20285,50 @@ L4: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ -#line 8280 "" +#line 8272 "" if (*iccount == 128) { -#line 8281 "" +#line 8273 "" read10_(lineq, &c1omget_1.lastchar, (ftnlen)128); -#line 8282 "" +#line 8274 "" if (c1omget_1.lastchar) { -#line 8282 "" +#line 8274 "" return 0; -#line 8282 "" +#line 8274 "" } -#line 8283 "" +#line 8275 "" if (! commac_1.endmac) { -#line 8284 "" +#line 8276 "" *iccount = 0; -#line 8285 "" +#line 8277 "" if (! commac_1.mplay) { -#line 8285 "" +#line 8277 "" ++c1omget_1.nline; -#line 8285 "" +#line 8277 "" } -#line 8286 "" +#line 8278 "" } else { -#line 8287 "" +#line 8279 "" commac_1.endmac = FALSE_; -#line 8288 "" +#line 8280 "" *iccount = commac_1.icchold; -#line 8289 "" +#line 8281 "" s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); -#line 8290 "" +#line 8282 "" } -#line 8291 "" +#line 8283 "" if (commac_1.mrecord) { -#line 8292 "" +#line 8284 "" m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, ( ftnlen)128); -#line 8293 "" +#line 8285 "" } -#line 8294 "" +#line 8286 "" } -#line 8295 "" +#line 8287 "" ++(*iccount); -#line 8296 "" +#line 8288 "" *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; -#line 8297 "" +#line 8289 "" return 0; } /* g1etchar_ */ @@ -20350,7 +20350,8 @@ L4: address a__1[3], a__2[2], a__3[4]; integer i__1, i__2[3], i__3[2], i__4, i__5, i__6, i__7, i__8[4]; real r__1; - char ch__1[42], ch__2[1], ch__3[2], ch__4[55], ch__5[54], ch__6[46]; + char ch__1[42], ch__2[1], ch__3[2], ch__4[1], ch__5[55], ch__6[54], ch__7[ + 46]; icilist ici__1; /* Builtin functions */ @@ -20361,8 +20362,7 @@ L4: integer do_fio(integer *, char *, ftnlen), e_wsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), i_nint(real *); double log(doublereal); - integer pow_ii(integer *, integer *), s_rsfe(cilist *), e_rsfe(void), - s_rsfi(icilist *), e_rsfi(void); + integer pow_ii(integer *, integer *), s_rsfi(icilist *), e_rsfi(void); /* Local variables */ extern integer i1fnodur_(integer *, char *, ftnlen); @@ -20453,4736 +20453,4786 @@ L4: static cilist io___692 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 }; static cilist io___696 = { 0, 6, 0, 0, 0 }; static cilist io___697 = { 0, 6, 0, 0, 0 }; - static cilist io___698 = { 0, 5, 0, "(a)", 0 }; + static cilist io___701 = { 0, 6, 0, 0, 0 }; static cilist io___702 = { 0, 6, 0, 0, 0 }; - static cilist io___703 = { 0, 6, 0, 0, 0 }; -/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ -#line 8371 "" +#line 8362 "" cdot = FALSE_; -#line 8372 "" +#line 8363 "" twotrem = FALSE_; -#line 8373 "" +#line 8364 "" L1: -#line 8373 "" +#line 8364 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 8374 "" +#line 8365 "" if (*(unsigned char *)charq != ' ') { -#line 8374 "" +#line 8365 "" *(unsigned char *)charlq = *(unsigned char *)charq; -#line 8374 "" +#line 8365 "" } -#line 8375 "" +#line 8366 "" if (c1omget_1.lastchar) { -#line 8376 "" +#line 8367 "" if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) { -#line 8377 "" +#line 8368 "" s_wsle(&io___621); -#line 8377 "" +#line 8368 "" e_wsle(); -#line 8378 "" +#line 8369 "" s_wsle(&io___622); -#line 8378 "" +#line 8369 "" do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8); -#line 8378 "" +#line 8369 "" e_wsle(); -#line 8379 "" +#line 8370 "" s_wsle(&io___623); -#line 8379 "" +#line 8370 "" do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29) ; -#line 8379 "" +#line 8370 "" do_lio(&c__9, &c__1, charlq, (ftnlen)1); -#line 8379 "" +#line 8370 "" do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12); -#line 8379 "" +#line 8370 "" e_wsle(); -#line 8380 "" +#line 8371 "" s_wsle(&io___624); -#line 8380 "" +#line 8371 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); -#line 8380 "" +#line 8371 "" i__1 = *(unsigned char *)charlq; -#line 8380 "" +#line 8371 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 8380 "" +#line 8371 "" e_wsle(); -#line 8381 "" +#line 8372 "" s_wsfe(&io___625); /* Writing concatenation */ -#line 8381 "" +#line 8372 "" i__2[0] = 29, a__1[0] = "Last non-blank character is \""; -#line 8381 "" +#line 8372 "" i__2[1] = 1, a__1[1] = charlq; -#line 8381 "" +#line 8372 "" i__2[2] = 12, a__1[2] = "\", not \"/,%\""; -#line 8381 "" +#line 8372 "" s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42); -#line 8381 "" +#line 8372 "" do_fio(&c__1, ch__1, (ftnlen)42); -#line 8381 "" +#line 8372 "" e_wsfe(); -#line 8383 "" +#line 8374 "" s_wsfe(&io___626); -#line 8383 "" +#line 8374 "" do_fio(&c__1, "ASCII code:", (ftnlen)11); -#line 8383 "" +#line 8374 "" i__1 = *(unsigned char *)charlq; -#line 8383 "" +#line 8374 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 8383 "" +#line 8374 "" e_wsfe(); /* Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. */ -#line 8387 "" +#line 8378 "" --inbuff_1.ilbuf; -#line 8388 "" +#line 8379 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[ inbuff_1.ilbuf - 1] + 2); /* Writing concatenation */ -#line 8389 "" +#line 8380 "" i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq; -#line 8389 "" +#line 8380 "" i__3[1] = 2, a__2[1] = " /"; -#line 8389 "" +#line 8380 "" s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)131072); -#line 8390 "" +#line 8381 "" s_wsle(&io___627); -#line 8390 "" +#line 8381 "" do_lio(&c__9, &c__1, "appending /", (ftnlen)18); -#line 8390 "" +#line 8381 "" e_wsle(); -#line 8391 "" +#line 8382 "" s_wsle(&io___628); -#line 8391 "" +#line 8382 "" do_lio(&c__9, &c__1, "appending /", (ftnlen)18); -#line 8391 "" +#line 8382 "" e_wsle(); /* Writing concatenation */ -#line 8392 "" +#line 8383 "" i__3[0] = a1ll_2.iccount, a__2[0] = lineq; -#line 8392 "" +#line 8383 "" i__3[1] = 2, a__2[1] = " /"; -#line 8392 "" +#line 8383 "" s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128); -#line 8393 "" +#line 8384 "" c1omget_1.lastchar = FALSE_; -#line 8394 "" +#line 8385 "" goto L1; -#line 8395 "" +#line 8386 "" } -#line 8396 "" +#line 8387 "" return 0; -#line 8397 "" +#line 8388 "" } -#line 8398 "" +#line 8389 "" if (*(unsigned char *)charq == ' ') { -#line 8399 "" +#line 8390 "" goto L1; -#line 8400 "" +#line 8391 "" } else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) { -#line 8401 "" +#line 8392 "" a1ll_2.iccount = 128; -#line 8402 "" +#line 8393 "" goto L1; /* Replacement 1/22/12 since gfortran 4.7 with -O was choking here! */ /* else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. */ -#line 8407 "" +#line 8398 "" } else if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) > 0 || *( unsigned char *)charq == 'r') { -/* This is a note/rest. gotclef is only used for checking for clef before "/" */ +/* This is a note/rest. */ -#line 8412 "" +#line 8403 "" if (cdot) { -#line 8412 "" +#line 8403 "" goto L28; -#line 8412 "" +#line 8403 "" } -/* if (gotclef) gotclef=.false. */ -#line 8414 "" +#line 8404 "" idotform = 0; -#line 8415 "" +#line 8405 "" numnum = 0; -#line 8416 "" +#line 8406 "" plusmin = FALSE_; -#line 8417 "" +#line 8407 "" L28: -#line 8417 "" +#line 8407 "" ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; -#line 8418 "" +#line 8408 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) { -#line 8419 "" +#line 8409 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8419 "" +#line 8409 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"\ "sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48); -#line 8421 "" +#line 8411 "" stop1_(); -#line 8422 "" +#line 8412 "" } -#line 8423 "" +#line 8413 "" *(unsigned char *)dotq = 'x'; /* Check if this is 'r ' and previous note was full-bar-pause */ -#line 8427 "" +#line 8417 "" i__1 = a1ll_2.iccount; /* Computing MAX */ -#line 8427 "" +#line 8417 "" i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; /* Computing MAX */ -#line 8427 "" +#line 8417 "" i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; -#line 8427 "" +#line 8417 "" fulbrp = *(unsigned char *)charq == 'r' && s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0 && a1ll_2.nnl[ c1ommvl_1.ivx - 1] > 1 && a1ll_2.rest[c1ommvl_1.ivx + max( i__4,i__5) * 24 - 25] && a1ll_2.nodur[c1ommvl_1.ivx + max( i__6,i__7) * 24 - 25] == a1ll_2.lenbar; -#line 8430 "" +#line 8420 "" L2: -#line 8430 "" +#line 8420 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 8431 "" +#line 8421 "" ic = *(unsigned char *)durq; -#line 8432 "" +#line 8422 "" if (ic <= 57 && ic >= 48) { /* Digit */ -#line 8436 "" +#line 8426 "" if (numnum == 0) { -#line 8437 "" +#line 8427 "" c1omnotes_1.nnodur = ic - 48; -#line 8438 "" +#line 8428 "" numnum = 1; -#line 8439 "" +#line 8429 "" goto L2; -#line 8440 "" +#line 8430 "" } else if (numnum == 1) { -#line 8441 "" +#line 8431 "" if (*(unsigned char *)charq == 'r') { -#line 8442 "" +#line 8432 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8442 "" +#line 8432 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"\ "llowed after rest symbol \"r\"!", (ftnlen)128, ( ftnlen)45); -#line 8444 "" +#line 8434 "" stop1_(); -#line 8445 "" +#line 8435 "" } -#line 8446 "" +#line 8436 "" numnum = 2; -#line 8447 "" +#line 8437 "" if (plusmin) { -#line 8448 "" +#line 8438 "" s_wsle(&io___636); -#line 8448 "" +#line 8438 "" e_wsle(); -#line 8449 "" +#line 8439 "" s_wsle(&io___637); -#line 8449 "" +#line 8439 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) 25); -#line 8449 "" +#line 8439 "" e_wsle(); -#line 8450 "" +#line 8440 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8450 "" +#line 8440 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); -#line 8452 "" +#line 8442 "" s_wsle(&io___638); -#line 8452 "" +#line 8442 "" do_lio(&c__9, &c__1, "explicitly specified. May need to"\ " edit old editions", (ftnlen)52); -#line 8452 "" +#line 8442 "" e_wsle(); -#line 8454 "" +#line 8444 "" } -#line 8455 "" +#line 8445 "" goto L2; -#line 8456 "" +#line 8446 "" } else { -#line 8457 "" +#line 8447 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8457 "" +#line 8447 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"\ "mbol!", (ftnlen)128, (ftnlen)25); -#line 8459 "" +#line 8449 "" stop1_(); -#line 8460 "" +#line 8450 "" } -#line 8461 "" +#line 8451 "" } else if (*(unsigned char *)durq == 'd') { -#line 8462 "" +#line 8452 "" *(unsigned char *)dotq = *(unsigned char *)durq; -#line 8463 "" +#line 8453 "" i__1 = a1ll_2.iccount; -#line 8463 "" +#line 8453 "" if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { -#line 8464 "" +#line 8454 "" c1omnotes_1.iddot = 1; -#line 8465 "" +#line 8455 "" ++a1ll_2.iccount; /* Since we flow out, double dots won't work with other dot options */ -#line 8469 "" +#line 8459 "" } -#line 8470 "" +#line 8460 "" i__1 = a1ll_2.iccount; -#line 8470 "" +#line 8460 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 - i__1) > 0) { /* move a dot, provided a number follows. */ -#line 8474 "" +#line 8464 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8475 "" +#line 8465 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8476 "" +#line 8466 "" if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0) { /* Backup, exit the loop normally */ -#line 8480 "" +#line 8470 "" a1ll_2.iccount += -2; -#line 8481 "" +#line 8471 "" goto L2; -#line 8482 "" +#line 8472 "" } -#line 8483 "" +#line 8473 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 8484 "" +#line 8474 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ -#line 8488 "" +#line 8478 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 8489 "" +#line 8479 "" if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0) { -#line 8490 "" +#line 8480 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8490 "" +#line 8480 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"\ "ber after 2nd +/- (shift dot)!", (ftnlen)128, (ftnlen)42); -#line 8492 "" +#line 8482 "" stop1_(); -#line 8493 "" +#line 8483 "" } -#line 8494 "" +#line 8484 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 8495 "" +#line 8485 "" } -#line 8496 "" +#line 8486 "" --a1ll_2.iccount; -#line 8497 "" +#line 8487 "" } -#line 8498 "" +#line 8488 "" goto L2; -#line 8499 "" +#line 8489 "" } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Accidental shift */ /* if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */ -#line 8504 "" +#line 8494 "" i__1 = a1ll_2.iccount - 2; -#line 8504 "" +#line 8494 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) == 0) { -#line 8505 "" +#line 8495 "" i__1 = a1ll_2.iccount - 1; -#line 8505 "" +#line 8495 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8505 "" +#line 8495 "" errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o"\ "r \"A\" before \"<\" or \">\"!", (ftnlen)128, (ftnlen) 48); /* * 'Expected "f", "s", or "n" before "<" or ">"!') */ -#line 8508 "" +#line 8498 "" stop1_(); -#line 8509 "" +#line 8499 "" } -#line 8510 "" +#line 8500 "" ipm = 1; -#line 8511 "" +#line 8501 "" if (*(unsigned char *)durq == '<') { -#line 8511 "" +#line 8501 "" ipm = -1; -#line 8511 "" +#line 8501 "" } -#line 8512 "" +#line 8502 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 8513 "" +#line 8503 "" if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 8514 "" +#line 8504 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8514 "" +#line 8504 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"\ "r (accidental shift)!", (ftnlen)128, (ftnlen)45); -#line 8516 "" +#line 8506 "" stop1_(); -#line 8517 "" +#line 8507 "" } -#line 8518 "" +#line 8508 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 8519 "" +#line 8509 "" fnum = ipm * fnum; -#line 8520 "" +#line 8510 "" if (fnum < -5.35f || fnum > 1.f) { -#line 8521 "" +#line 8511 "" i__1 = a1ll_2.iccount - 1; -#line 8521 "" +#line 8511 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8521 "" +#line 8511 "" errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"\ "st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52); -#line 8523 "" +#line 8513 "" stop1_(); -#line 8524 "" +#line 8514 "" } -#line 8525 "" +#line 8515 "" --a1ll_2.iccount; -#line 8526 "" +#line 8516 "" goto L2; -#line 8527 "" +#line 8517 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8528 "" +#line 8518 "" if (*(unsigned char *)charq != 'r') { -#line 8529 "" +#line 8519 "" i__1 = a1ll_2.iccount - 2; -#line 8529 "" +#line 8519 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) > 0) { -#line 8530 "" +#line 8520 "" ipm = 1; -#line 8531 "" +#line 8521 "" if (*(unsigned char *)durq == '-') { -#line 8531 "" +#line 8521 "" ipm = -1; -#line 8531 "" +#line 8521 "" } -#line 8532 "" +#line 8522 "" i__1 = a1ll_2.iccount; -#line 8532 "" +#line 8522 "" if (i_indx("0123456789", lineq + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) > 0) { /* This may be start of accidental shift, but may be octave jump; then duration */ -#line 8537 "" +#line 8527 "" icsav = a1ll_2.iccount; -#line 8538 "" +#line 8528 "" ++a1ll_2.iccount; -#line 8539 "" +#line 8529 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 8540 "" +#line 8530 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* This is an accid shift since there's a 2nd consecutive signed number. */ /* Check size of 1st number. */ -#line 8545 "" +#line 8535 "" if (fnum > 30.5f) { -#line 8546 "" +#line 8536 "" i__1 = a1ll_2.iccount - 1; -#line 8546 "" +#line 8536 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8546 "" +#line 8536 "" errmsg_(lineq, &i__1, &i__4, "Vertical accid"\ "ental shift must be less than 31!", ( ftnlen)128, (ftnlen)47); -#line 8548 "" +#line 8538 "" stop1_(); -#line 8549 "" +#line 8539 "" } -#line 8550 "" +#line 8540 "" ipm = 1; -#line 8551 "" +#line 8541 "" if (*(unsigned char *)durq == '-') { -#line 8551 "" +#line 8541 "" ipm = -1; -#line 8551 "" +#line 8541 "" } -#line 8552 "" +#line 8542 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) 128, (ftnlen)1); -#line 8553 "" +#line 8543 "" if (i_indx("1234567890.", durq, (ftnlen)11, ( ftnlen)1) == 0) { -#line 8554 "" +#line 8544 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8554 "" +#line 8544 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"\ "cted 2nd number of accidental shift)!" , (ftnlen)128, (ftnlen)41); -#line 8556 "" +#line 8546 "" stop1_(); -#line 8557 "" +#line 8547 "" } -#line 8558 "" +#line 8548 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 8559 "" +#line 8549 "" fnum = ipm * fnum; -#line 8560 "" +#line 8550 "" if (fnum < -5.35f || fnum > 1.f) { -#line 8561 "" +#line 8551 "" i__1 = a1ll_2.iccount - 1; -#line 8561 "" +#line 8551 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8561 "" +#line 8551 "" errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"\ "tal shift must be >-5.35 and <1.0!", ( ftnlen)128, (ftnlen)48); -#line 8563 "" +#line 8553 "" stop1_(); -#line 8564 "" +#line 8554 "" } -#line 8565 "" +#line 8555 "" --a1ll_2.iccount; -#line 8566 "" +#line 8556 "" goto L2; -#line 8567 "" +#line 8557 "" } else { /* Not accid shift, reset, then flow out */ -#line 8571 "" +#line 8561 "" a1ll_2.iccount = icsav; -#line 8572 "" +#line 8562 "" } -#line 8573 "" +#line 8563 "" } -#line 8574 "" +#line 8564 "" } -#line 8575 "" +#line 8565 "" plusmin = TRUE_; -#line 8576 "" +#line 8566 "" if (numnum == 2) { -#line 8577 "" +#line 8567 "" s_wsle(&io___643); -#line 8577 "" +#line 8567 "" e_wsle(); -#line 8578 "" +#line 8568 "" s_wsle(&io___644); -#line 8578 "" +#line 8568 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) 25); -#line 8578 "" +#line 8568 "" e_wsle(); -#line 8579 "" +#line 8569 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8579 "" +#line 8569 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); -#line 8581 "" +#line 8571 "" s_wsle(&io___645); -#line 8581 "" +#line 8571 "" do_lio(&c__9, &c__1, "explicitly specified. May need to"\ " edit old editions", (ftnlen)52); -#line 8581 "" +#line 8571 "" e_wsle(); -#line 8583 "" +#line 8573 "" } -#line 8584 "" +#line 8574 "" goto L2; /* It's a rest containing +|- . Must refer to a vertical shift. Read past. */ -#line 8588 "" +#line 8578 "" } else { -#line 8589 "" +#line 8579 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8590 "" +#line 8580 "" readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, ( ftnlen)1); -#line 8591 "" +#line 8581 "" i__1 = a1ll_2.iccount - 2; -#line 8591 "" +#line 8581 "" if (s_cmp(lineq + i__1, ".", a1ll_2.iccount - 1 - i__1, ( ftnlen)1) == 0) { -#line 8591 "" +#line 8581 "" --a1ll_2.iccount; -#line 8591 "" +#line 8581 "" } -#line 8592 "" +#line 8582 "" --a1ll_2.iccount; -#line 8593 "" +#line 8583 "" goto L2; -#line 8594 "" +#line 8584 "" } /* else if (index('ulare',durq) .gt. 0) then */ -#line 8596 "" +#line 8586 "" } else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) { -#line 8597 "" +#line 8587 "" goto L2; -#line 8598 "" +#line 8588 "" } else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Stemlength change */ -#line 8602 "" +#line 8592 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 8603 "" +#line 8593 "" if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) { -#line 8604 "" +#line 8594 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8604 "" +#line 8594 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"\ "er or colon here!", (ftnlen)128, (ftnlen)37); -#line 8606 "" +#line 8596 "" stop1_(); -#line 8607 "" +#line 8597 "" } -#line 8608 "" +#line 8598 "" if (*(unsigned char *)durq == ':') { -#line 8609 "" +#line 8599 "" if (! comkeys_1.stickys) { -#line 8610 "" +#line 8600 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8610 "" +#line 8600 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"\ "y stemlegth changes without turning on!", (ftnlen) 128, (ftnlen)55); -#line 8612 "" +#line 8602 "" stop1_(); -#line 8613 "" +#line 8603 "" } -#line 8614 "" +#line 8604 "" comkeys_1.stickys = FALSE_; -#line 8615 "" +#line 8605 "" goto L2; -#line 8616 "" +#line 8606 "" } -#line 8617 "" +#line 8607 "" readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen) 1); /* if (dum.lt..5 .or. dum.gt.4.) then */ -#line 8619 "" +#line 8609 "" if (*(unsigned char *)durq == 'L' && dum > 20.f || *(unsigned char *)durq == 'S' && dum > 4.f) { -#line 8621 "" +#line 8611 "" i__1 = a1ll_2.iccount - 1; -#line 8621 "" +#line 8611 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8621 "" +#line 8611 "" errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b"\ "ig!", (ftnlen)128, (ftnlen)33); -#line 8623 "" +#line 8613 "" stop1_(); -#line 8624 "" +#line 8614 "" } -#line 8625 "" +#line 8615 "" if (*(unsigned char *)durq != ':') { -#line 8626 "" +#line 8616 "" --a1ll_2.iccount; -#line 8627 "" +#line 8617 "" } else { -#line 8628 "" +#line 8618 "" if (comkeys_1.stickys) { -#line 8629 "" +#line 8619 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8629 "" +#line 8619 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"\ " stemshrinks when already on!", (ftnlen)128, ( ftnlen)45); -#line 8631 "" +#line 8621 "" stop1_(); -#line 8632 "" +#line 8622 "" } -#line 8633 "" +#line 8623 "" comkeys_1.stickys = TRUE_; -#line 8634 "" +#line 8624 "" } -#line 8635 "" +#line 8625 "" goto L2; -#line 8636 "" +#line 8626 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */ /* MUST come right after "f,s,n" */ -#line 8641 "" +#line 8631 "" i__1 = a1ll_2.iccount; -#line 8641 "" +#line 8631 "" if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { -#line 8641 "" +#line 8631 "" ++a1ll_2.iccount; -#line 8641 "" +#line 8631 "" } -#line 8642 "" +#line 8632 "" goto L2; -#line 8643 "" +#line 8633 "" } else if (*(unsigned char *)durq == 'p') { -#line 8644 "" +#line 8634 "" fulbrp = *(unsigned char *)charq == 'r'; -#line 8645 "" +#line 8635 "" if (! fulbrp) { -#line 8646 "" +#line 8636 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8646 "" +#line 8636 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"\ "y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42); -#line 8648 "" +#line 8638 "" stop1_(); -#line 8649 "" +#line 8639 "" } -#line 8650 "" +#line 8640 "" goto L2; -#line 8651 "" +#line 8641 "" } else if (*(unsigned char *)durq == 'b') { -#line 8652 "" +#line 8642 "" if (*(unsigned char *)charq != 'r') { -#line 8653 "" +#line 8643 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8653 "" +#line 8643 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"\ " expected \"rb\"!", (ftnlen)128, (ftnlen)33); -#line 8655 "" +#line 8645 "" stop1_(); -#line 8656 "" +#line 8646 "" } else if (numnum == 2) { -#line 8657 "" +#line 8647 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8657 "" +#line 8647 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"\ " \"b\" with two numbers!", (ftnlen)128, (ftnlen)39); -#line 8659 "" +#line 8649 "" } -#line 8660 "" +#line 8650 "" goto L2; -#line 8661 "" +#line 8651 "" } else if (*(unsigned char *)durq == 'x') { /* Xtuplet. Count number of doubled notes (for unequal xtups) */ -#line 8665 "" +#line 8655 "" if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25],18)) { -#line 8666 "" +#line 8656 "" ndoub = 1; -#line 8667 "" +#line 8657 "" } else { -#line 8668 "" +#line 8658 "" ndoub = 0; -#line 8669 "" +#line 8659 "" } /* Will set all durations to 0 except last one. */ -#line 8673 "" +#line 8663 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 8674 "" +#line 8664 "" if (i_indx("123456789T", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 8675 "" +#line 8665 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8675 "" +#line 8665 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""\ "x\" in xtuplet must be \"1\"-\"9\" or \"T\"!", ( ftnlen)128, (ftnlen)55); -#line 8677 "" +#line 8667 "" stop1_(); -#line 8678 "" +#line 8668 "" } -#line 8679 "" +#line 8669 "" if (*(unsigned char *)durq == 'T') { /* Set a flag for checking 2nd note inputs if dot is moved */ -#line 8683 "" +#line 8673 "" twotrem = TRUE_; /* Check all x-tremolo inputs here; set fnum=2 */ -#line 8687 "" +#line 8677 "" fnum = 2.f; -#line 8688 "" +#line 8678 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) ; -#line 8689 "" +#line 8679 "" if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) { -#line 8690 "" +#line 8680 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8690 "" +#line 8680 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char aft"\ "er \"T\" in xtuplet must be \"0\"-\"3\" or blank!" , (ftnlen)128, (ftnlen)57); -#line 8692 "" +#line 8682 "" stop1_(); -#line 8693 "" +#line 8683 "" } else if (*(unsigned char *)durq != ' ') { -#line 8694 "" +#line 8684 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 8695 "" +#line 8685 "" if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) { -#line 8696 "" +#line 8686 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8696 "" +#line 8686 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "This char mu"\ "st be \"0\"-\"3\" or blank!", (ftnlen)128, ( ftnlen)35); -#line 8698 "" +#line 8688 "" stop1_(); -#line 8699 "" +#line 8689 "" } else if (*(unsigned char *)durq != ' ') { -#line 8700 "" +#line 8690 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); /* Probably blank unles other options entered */ -#line 8704 "" +#line 8694 "" } -#line 8705 "" +#line 8695 "" } -#line 8706 "" +#line 8696 "" } else { /* durq is digit, normal xtup */ -#line 8710 "" +#line 8700 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); /* Leaves durq at next char after number */ -#line 8714 "" +#line 8704 "" if (fnum > 99.f) { -#line 8715 "" +#line 8705 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8715 "" +#line 8705 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot h"\ "ave more than 99 notes!", (ftnlen)128, (ftnlen)39) ; -#line 8717 "" +#line 8707 "" stop1_(); -#line 8718 "" +#line 8708 "" } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) { -#line 8719 "" +#line 8709 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8719 "" +#line 8709 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal chara"\ "cters here are \" \",\"D\",\"F\",\"n\"!", (ftnlen) 128, (ftnlen)47); -#line 8721 "" +#line 8711 "" stop1_(); -#line 8722 "" +#line 8712 "" } -#line 8723 "" +#line 8713 "" } /* End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. */ -#line 8727 "" +#line 8717 "" if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double xtup note to make an un= xtup. Here, number already set, but may also */ /* have used this before number was set. */ -#line 8732 "" +#line 8722 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18); -#line 8733 "" +#line 8723 "" ndoub = 1; -#line 8734 "" +#line 8724 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8735 "" +#line 8725 "" } else if (*(unsigned char *)durq == 'd') { -#line 8736 "" +#line 8726 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],27); -#line 8737 "" +#line 8727 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8738 "" +#line 8728 "" } -#line 8739 "" +#line 8729 "" if (*(unsigned char *)durq == 'n') { /* Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. */ -#line 8743 "" +#line 8733 "" numshft = 0; -#line 8744 "" +#line 8734 "" L30: -#line 8744 "" +#line 8734 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8745 "" +#line 8735 "" if (*(unsigned char *)durq == 'f') { -#line 8746 "" +#line 8736 "" goto L30; -#line 8747 "" +#line 8737 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8748 "" +#line 8738 "" ++numshft; -#line 8749 "" +#line 8739 "" if (numshft == 3) { -#line 8750 "" +#line 8740 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8750 "" +#line 8740 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"\ "s are allowed after \"n\" in xtup!", (ftnlen) 128, (ftnlen)44); -#line 8752 "" +#line 8742 "" stop1_(); -#line 8753 "" +#line 8743 "" } -#line 8754 "" +#line 8744 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 8755 "" +#line 8745 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 8756 "" +#line 8746 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8756 "" +#line 8746 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ "er should be a digit or \".\"!", (ftnlen)128, (ftnlen)40); -#line 8758 "" +#line 8748 "" stop1_(); -#line 8759 "" +#line 8749 "" } -#line 8760 "" +#line 8750 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); -#line 8761 "" +#line 8751 "" --a1ll_2.iccount; /* if ((numshft.eq.1 .and. snum.gt.15.1) .or. */ -#line 8763 "" +#line 8753 "" if (numshft == 1 && snum > 64.f || numshft == 2 && snum > 1.51f) { -#line 8765 "" +#line 8755 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8765 "" +#line 8755 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"\ " after \"n\" in xtup is out of range!", ( ftnlen)128, (ftnlen)47); -#line 8767 "" +#line 8757 "" stop1_(); -#line 8768 "" +#line 8758 "" } -#line 8769 "" +#line 8759 "" goto L30; -#line 8770 "" +#line 8760 "" } else if (*(unsigned char *)durq == 's') { /* Slope alteration for bracket */ -#line 8774 "" +#line 8764 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 8775 "" +#line 8765 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 8776 "" +#line 8766 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8776 "" +#line 8766 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"\ "justment, this character must be \"+\" or \"-"\ "\"!", (ftnlen)128, (ftnlen)56); -#line 8778 "" +#line 8768 "" stop1_(); -#line 8779 "" +#line 8769 "" } -#line 8780 "" +#line 8770 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 8781 "" +#line 8771 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 8782 "" +#line 8772 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8782 "" +#line 8772 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ "er should be a digit!", (ftnlen)128, (ftnlen) 33); -#line 8784 "" +#line 8774 "" stop1_(); -#line 8785 "" +#line 8775 "" } -#line 8786 "" +#line 8776 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); -#line 8787 "" +#line 8777 "" --a1ll_2.iccount; -#line 8788 "" +#line 8778 "" if (i_nint(&snum) > 15) { -#line 8789 "" +#line 8779 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8789 "" +#line 8779 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"\ "ment cannot exceed 15!", (ftnlen)128, (ftnlen) 34); -#line 8791 "" +#line 8781 "" stop1_(); -#line 8792 "" +#line 8782 "" } -#line 8793 "" +#line 8783 "" goto L30; -#line 8794 "" +#line 8784 "" } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) > 0) { /* Unsigned integer => alternate printed number */ -#line 8798 "" +#line 8788 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); -#line 8799 "" +#line 8789 "" if (snum > 15.1f) { -#line 8800 "" +#line 8790 "" i__1 = a1ll_2.iccount - 1; -#line 8800 "" +#line 8790 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8800 "" +#line 8790 "" errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "\ "after \"n\" must be <16!", (ftnlen)128, ( ftnlen)44); -#line 8802 "" +#line 8792 "" stop1_(); -#line 8803 "" +#line 8793 "" } -#line 8804 "" +#line 8794 "" --a1ll_2.iccount; -#line 8805 "" +#line 8795 "" goto L30; -#line 8806 "" +#line 8796 "" } else if (*(unsigned char *)durq != ' ') { -#line 8807 "" +#line 8797 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8807 "" +#line 8797 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36); -#line 8809 "" +#line 8799 "" stop1_(); -#line 8810 "" +#line 8800 "" } -#line 8811 "" +#line 8801 "" } -#line 8812 "" +#line 8802 "" ntup = i_nint(&fnum); -#line 8813 "" +#line 8803 "" i__1 = ntup; -#line 8813 "" +#line 8803 "" for (itup = 2; itup <= i__1; ++itup) { -#line 8814 "" +#line 8804 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = 0; -#line 8815 "" +#line 8805 "" ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; -#line 8816 "" +#line 8806 "" L110: -#line 8816 "" +#line 8806 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 8817 "" +#line 8807 "" if (*(unsigned char *)durq == ' ') { -#line 8818 "" +#line 8808 "" goto L110; -#line 8819 "" +#line 8809 "" } else if (*(unsigned char *)durq == 'o') { /* Ornament in xtup. "o" symbol must come AFTER the affected note */ -#line 8823 "" +#line 8813 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8824 "" +#line 8814 "" if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, ( ftnlen)1) == 0) { -#line 8825 "" +#line 8815 "" if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8826 "" +#line 8816 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8826 "" +#line 8816 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "\ "or segno not allowed in xtuplet!", ( ftnlen)128, (ftnlen)40); -#line 8828 "" +#line 8818 "" } else { -#line 8829 "" +#line 8819 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8829 "" +#line 8819 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ "ornament!", (ftnlen)128, (ftnlen)17); -#line 8831 "" +#line 8821 "" } -#line 8832 "" +#line 8822 "" stop1_(); -#line 8833 "" +#line 8823 "" } -#line 8834 "" +#line 8824 "" if (*(unsigned char *)dumq == 'T') { /* Trill. may be followed by 't' and/or number. read 'til blank */ -#line 8838 "" +#line 8828 "" L29: -#line 8838 "" +#line 8828 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8839 "" +#line 8829 "" if (*(unsigned char *)dumq != ' ') { -#line 8839 "" +#line 8829 "" goto L29; -#line 8839 "" +#line 8829 "" } -#line 8840 "" +#line 8830 "" } else if (*(unsigned char *)dumq == 'e') { -#line 8841 "" +#line 8831 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8842 "" +#line 8832 "" if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { -#line 8843 "" +#line 8833 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8843 "" +#line 8833 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ "character after \"e\" in edit. accid. sy"\ "mbol!", (ftnlen)128, (ftnlen)51); -#line 8845 "" +#line 8835 "" stop1_(); -#line 8846 "" +#line 8836 "" } -#line 8847 "" +#line 8837 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8848 "" +#line 8838 "" if (*(unsigned char *)dumq == '?') { -#line 8848 "" +#line 8838 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) 128, (ftnlen)1); -#line 8848 "" +#line 8838 "" } -#line 8849 "" +#line 8839 "" } else if (*(unsigned char *)dumq == ':') { -#line 8850 "" +#line 8840 "" i__4 = a1ll_2.iccount; -#line 8850 "" +#line 8840 "" if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - i__4, (ftnlen)1) != 0) { -#line 8851 "" +#line 8841 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8851 "" +#line 8841 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ "st be followed by blank in \"o: \"!", ( ftnlen)128, (ftnlen)39); -#line 8853 "" +#line 8843 "" stop1_(); -#line 8854 "" +#line 8844 "" } else if (! comkeys_1.ornrpt) { -#line 8855 "" +#line 8845 "" i__4 = a1ll_2.iccount - 1; -#line 8855 "" +#line 8845 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8855 "" +#line 8845 "" errmsg_(lineq, &i__4, &i__5, "Turned off repeate"\ "d ornaments before they were on!", ( ftnlen)128, (ftnlen)50); -#line 8857 "" +#line 8847 "" stop1_(); -#line 8858 "" +#line 8848 "" } -#line 8859 "" +#line 8849 "" comkeys_1.ornrpt = FALSE_; -#line 8860 "" +#line 8850 "" } else { -#line 8861 "" +#line 8851 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8862 "" +#line 8852 "" } -#line 8863 "" +#line 8853 "" if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { -#line 8864 "" +#line 8854 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8864 "" +#line 8854 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in ornament symbol!", (ftnlen)128, ( ftnlen)37); -#line 8866 "" +#line 8856 "" stop1_(); -#line 8867 "" +#line 8857 "" } -#line 8868 "" +#line 8858 "" if (*(unsigned char *)dumq == ':') { -#line 8869 "" +#line 8859 "" i__4 = a1ll_2.iccount; -#line 8869 "" +#line 8859 "" if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - i__4, (ftnlen)1) != 0) { -#line 8870 "" +#line 8860 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8870 "" +#line 8860 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ "st be followed by blank in \"o: \"!", ( ftnlen)128, (ftnlen)39); -#line 8872 "" +#line 8862 "" stop1_(); -#line 8873 "" +#line 8863 "" } else if (comkeys_1.ornrpt) { -#line 8874 "" +#line 8864 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8874 "" +#line 8864 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"\ "n repeated ornaments but already on!", ( ftnlen)128, (ftnlen)44); -#line 8876 "" +#line 8866 "" stop1_(); -#line 8877 "" +#line 8867 "" } -#line 8878 "" +#line 8868 "" comkeys_1.ornrpt = TRUE_; -#line 8879 "" +#line 8869 "" } -#line 8880 "" +#line 8870 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8881 "" +#line 8871 "" i__4 = a1ll_2.iccount; -#line 8881 "" +#line 8871 "" if (i_indx("0123456789", lineq + i__4, (ftnlen)10, a1ll_2.iccount + 1 - i__4) == 0) { -#line 8883 "" +#line 8873 "" i__4 = a1ll_2.iccount + 1; -#line 8883 "" +#line 8873 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8883 "" +#line 8873 "" errmsg_(lineq, &i__4, &i__5, "There should be an"\ " integer here!", (ftnlen)128, (ftnlen)32); -#line 8885 "" +#line 8875 "" stop1_(); -#line 8886 "" +#line 8876 "" } -#line 8887 "" +#line 8877 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 8888 "" +#line 8878 "" if (*(unsigned char *)durq == ':') { -#line 8889 "" +#line 8879 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8889 "" +#line 8879 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"\ "hift AND repeat an ornament!", (ftnlen) 128, (ftnlen)36); -#line 8891 "" +#line 8881 "" stop1_(); -#line 8892 "" +#line 8882 "" } /* 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */ -#line 8896 "" +#line 8886 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8897 "" +#line 8887 "" i__4 = a1ll_2.iccount; -#line 8897 "" +#line 8887 "" if (i_indx(".0123456789", lineq + i__4, (ftnlen) 11, a1ll_2.iccount + 1 - i__4) == 0) { -#line 8899 "" +#line 8889 "" i__4 = a1ll_2.iccount + 1; -#line 8899 "" +#line 8889 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8899 "" +#line 8889 "" errmsg_(lineq, &i__4, &i__5, "There should b"\ "e a number here!", (ftnlen)128, ( ftnlen)30); -#line 8902 "" +#line 8892 "" stop1_(); -#line 8903 "" +#line 8893 "" } -#line 8904 "" +#line 8894 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 8905 "" +#line 8895 "" } -#line 8906 "" +#line 8896 "" } -#line 8907 "" +#line 8897 "" goto L110; -#line 8908 "" +#line 8898 "" } else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) { /* Slur in xtup */ -#line 8912 "" +#line 8902 "" iposn = 0; -#line 8913 "" +#line 8903 "" numint = 0; -#line 8914 "" +#line 8904 "" L15: -#line 8914 "" +#line 8904 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8915 "" +#line 8905 "" ++iposn; -#line 8916 "" +#line 8906 "" if (i_indx("udlbfnhtv", dumq, (ftnlen)9, (ftnlen)1) > 0) { -#line 8917 "" +#line 8907 "" if (*(unsigned char *)dumq == 't' && *(unsigned char * )durq == 't') { -#line 8918 "" +#line 8908 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8918 "" +#line 8908 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"\ "se \"t\" as an option on a tie!", (ftnlen) 128, (ftnlen)37); -#line 8920 "" +#line 8910 "" stop1_(); -#line 8921 "" +#line 8911 "" } -#line 8922 "" +#line 8912 "" goto L15; -#line 8923 "" +#line 8913 "" } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8924 "" +#line 8914 "" ++numint; -#line 8925 "" +#line 8915 "" ++a1ll_2.iccount; -#line 8926 "" +#line 8916 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 8927 "" +#line 8917 "" if (numint == 1) { -#line 8928 "" +#line 8918 "" if (i_nint(&fnum) > 30) { -#line 8929 "" +#line 8919 "" i__4 = a1ll_2.iccount - 1; -#line 8929 "" +#line 8919 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8929 "" +#line 8919 "" errmsg_(lineq, &i__4, &i__5, "Magnitude of s"\ "lur height adjustment cannot exceed "\ "30!", (ftnlen)128, (ftnlen)53); -#line 8931 "" +#line 8921 "" stop1_(); -#line 8932 "" +#line 8922 "" } -#line 8933 "" +#line 8923 "" } else if (numint == 2) { -#line 8934 "" +#line 8924 "" if (dabs(fnum) > 6.3f) { -#line 8935 "" +#line 8925 "" i__4 = a1ll_2.iccount - 1; -#line 8935 "" +#line 8925 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8935 "" +#line 8925 "" errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ "ft must be in the range (-6.3,6.3)!", (ftnlen)128, (ftnlen)49); -#line 8937 "" +#line 8927 "" stop1_(); -#line 8938 "" +#line 8928 "" } -#line 8939 "" +#line 8929 "" } else { /* Third signed integer, must be a midslur or curve spec. */ -#line 8943 "" +#line 8933 "" if (dabs(fnum) > 31.f) { -#line 8944 "" +#line 8934 "" i__4 = a1ll_2.iccount - 1; -#line 8944 "" +#line 8934 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8944 "" +#line 8934 "" errmsg_(lineq, &i__4, &i__5, "Slur midheight"\ " must be in the range (-31,31)!", ( ftnlen)128, (ftnlen)45); -#line 8946 "" +#line 8936 "" stop1_(); -#line 8947 "" +#line 8937 "" } -#line 8948 "" +#line 8938 "" if (*(unsigned char *)durq == ':') { /* Expecting curve parameters. Get two numbers */ -#line 8952 "" +#line 8942 "" for (i__ = 1; i__ <= 2; ++i__) { -#line 8953 "" +#line 8943 "" ++a1ll_2.iccount; -#line 8954 "" +#line 8944 "" fnum = (real) (*(unsigned char *)&lineq[ a1ll_2.iccount - 1] - 48); -#line 8955 "" +#line 8945 "" if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { -#line 8956 "" +#line 8946 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8956 "" +#line 8946 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur curve parameter must "\ "be in range (0,7)!", (ftnlen) 128, (ftnlen)44); -#line 8959 "" +#line 8949 "" stop1_(); -#line 8960 "" +#line 8950 "" } -#line 8961 "" +#line 8951 "" /* L40: */ -#line 8961 "" +#line 8951 "" } -#line 8962 "" +#line 8952 "" ++a1ll_2.iccount; -#line 8963 "" +#line 8953 "" } -#line 8964 "" +#line 8954 "" } -#line 8965 "" +#line 8955 "" --a1ll_2.iccount; -#line 8966 "" +#line 8956 "" goto L15; -#line 8968 "" +#line 8958 "" } else if (*(unsigned char *)dumq == 's') { /* What follows should be one or two signed numbers for adjustment of line break */ /* slur, end of 1st segment or start of second. */ -#line 8973 "" +#line 8963 "" if (comslur_1.fontslur) { -#line 8974 "" +#line 8964 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8974 "" +#line 8964 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "\ "use linebreak slur options with font-bas"\ "ed slurs!", (ftnlen)128, (ftnlen)57); -#line 8976 "" +#line 8966 "" stop1_(); -#line 8977 "" +#line 8967 "" } -#line 8978 "" +#line 8968 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 8979 "" +#line 8969 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 8980 "" +#line 8970 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8980 "" +#line 8970 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"\ "racter must be \"+\" or \"-\"!", (ftnlen) 128, (ftnlen)34); -#line 8982 "" +#line 8972 "" stop1_(); -#line 8983 "" +#line 8973 "" } -#line 8984 "" +#line 8974 "" ++a1ll_2.iccount; -#line 8985 "" +#line 8975 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 8986 "" +#line 8976 "" if (i_nint(&fnum) > 30) { -#line 8987 "" +#line 8977 "" i__4 = a1ll_2.iccount - 1; -#line 8987 "" +#line 8977 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8987 "" +#line 8977 "" errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "\ "height adjustment cannot exceed 30!", ( ftnlen)128, (ftnlen)53); -#line 8989 "" +#line 8979 "" stop1_(); -#line 8990 "" +#line 8980 "" } -#line 8991 "" +#line 8981 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 8992 "" +#line 8982 "" ++a1ll_2.iccount; -#line 8993 "" +#line 8983 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 8994 "" +#line 8984 "" if (dabs(fnum) > 6.3f) { -#line 8995 "" +#line 8985 "" i__4 = a1ll_2.iccount - 1; -#line 8995 "" +#line 8985 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 8995 "" +#line 8985 "" errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ "ft must be in range (-6.3,6.3)!", ( ftnlen)128, (ftnlen)45); -#line 8997 "" +#line 8987 "" stop1_(); -#line 8998 "" +#line 8988 "" } -#line 8999 "" +#line 8989 "" } -#line 9000 "" +#line 8990 "" --a1ll_2.iccount; -#line 9001 "" +#line 8991 "" goto L15; -#line 9002 "" +#line 8992 "" } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { -#line 9003 "" +#line 8993 "" i__4 = a1ll_2.iccount; -#line 9003 "" +#line 8993 "" if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 - i__4, (ftnlen)1) == 0) { -#line 9003 "" +#line 8993 "" ++a1ll_2.iccount; -#line 9003 "" +#line 8993 "" } -#line 9005 "" +#line 8995 "" goto L15; -#line 9006 "" +#line 8996 "" } else if (*(unsigned char *)dumq == 'p') { /* local change in postscript slur/tie adjustment default */ -#line 9010 "" +#line 9000 "" if (comslur_1.fontslur) { -#line 9011 "" +#line 9001 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9011 "" +#line 9001 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"\ " postscript slurs (\"Ap\") to use this o"\ "ption!", (ftnlen)128, (ftnlen)52); -#line 9013 "" +#line 9003 "" stop1_(); -#line 9014 "" +#line 9004 "" } -#line 9015 "" +#line 9005 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 9016 "" +#line 9006 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9017 "" +#line 9007 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9017 "" +#line 9007 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ "ed \"+\" or \"-\" here!", (ftnlen)128, ( ftnlen)25); -#line 9019 "" +#line 9009 "" stop1_(); -#line 9020 "" +#line 9010 "" } -#line 9021 "" +#line 9011 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); -#line 9022 "" +#line 9012 "" if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9023 "" +#line 9013 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9023 "" +#line 9013 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ "ed \"s\" or \"t\" here!", (ftnlen)128, ( ftnlen)25); -#line 9025 "" +#line 9015 "" stop1_(); -#line 9026 "" +#line 9016 "" } -#line 9027 "" +#line 9017 "" goto L15; -#line 9028 "" +#line 9018 "" } else if (*(unsigned char *)dumq != ' ') { -#line 9029 "" +#line 9019 "" ic = *(unsigned char *)dumq; -#line 9030 "" +#line 9020 "" if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) { -#line 9032 "" +#line 9022 "" if (iposn == 1) { -#line 9033 "" +#line 9023 "" if (*(unsigned char *)durq == 't' && comslur_1.fontslur) { -#line 9034 "" +#line 9024 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9034 "" +#line 9024 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID not allowed on non-post"\ "script tie!", (ftnlen)128, ( ftnlen)42); -#line 9036 "" +#line 9026 "" stop1_(); -#line 9037 "" +#line 9027 "" } -#line 9038 "" +#line 9028 "" i__4 = a1ll_2.iccount; -#line 9038 "" +#line 9028 "" if (s_cmp(lineq + i__4, "x", a1ll_2.iccount + 1 - i__4, (ftnlen)1) == 0) { -#line 9038 "" +#line 9028 "" ++a1ll_2.iccount; -#line 9038 "" +#line 9028 "" } -#line 9040 "" +#line 9030 "" goto L15; -#line 9041 "" +#line 9031 "" } -#line 9042 "" +#line 9032 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9042 "" +#line 9032 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "\ "must be 2nd character in slur symbol!", ( ftnlen)128, (ftnlen)45); -#line 9044 "" +#line 9034 "" stop1_(); -#line 9045 "" +#line 9035 "" } -#line 9046 "" +#line 9036 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9046 "" +#line 9036 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in slur symbol!", (ftnlen)128, (ftnlen) 33); -#line 9048 "" +#line 9038 "" stop1_(); -#line 9049 "" +#line 9039 "" } -#line 9050 "" +#line 9040 "" goto L110; -#line 9051 "" +#line 9041 "" } else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, ( ftnlen)1) > 0) { /* We have a figure. Only allow on 1st note of xtup */ -#line 9055 "" +#line 9045 "" if (itup != 2) { -#line 9056 "" +#line 9046 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9056 "" +#line 9046 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"\ "up only allowed on 1st note!", (ftnlen)128, ( ftnlen)40); -#line 9058 "" +#line 9048 "" stop1_(); -#line 9059 "" +#line 9049 "" } else if (*(unsigned char *)durq == 'x') { -#line 9060 "" +#line 9050 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9060 "" +#line 9050 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "\ "figures in xtuplets!", (ftnlen)128, (ftnlen) 32); -#line 9062 "" +#line 9052 "" stop1_(); -#line 9063 "" +#line 9053 "" } -#line 9064 "" +#line 9054 "" if (compage_1.usefig && c1ommvl_1.ivx == 1) { -#line 9064 "" +#line 9054 "" *ifig = 1; -#line 9064 "" +#line 9054 "" } -#line 9065 "" +#line 9055 "" L26: -#line 9065 "" +#line 9055 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); /* if (index('0123456789#-n_.:',durq) .gt. 0) then */ -#line 9067 "" +#line 9057 "" if (i_indx("0123456789#-n_.:v", durq, (ftnlen)17, (ftnlen) 1) > 0) { -#line 9068 "" +#line 9058 "" goto L26; -#line 9069 "" +#line 9059 "" } else if (*(unsigned char *)durq == 's') { -#line 9070 "" +#line 9060 "" comligfont_1.isligfont = TRUE_; -#line 9071 "" +#line 9061 "" goto L26; -#line 9072 "" +#line 9062 "" } else if (*(unsigned char *)durq == '+') { /* vertical offset, must be integer then blank */ -#line 9076 "" +#line 9066 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 9077 "" +#line 9067 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) != 0) { -#line 9078 "" +#line 9068 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9078 "" +#line 9068 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "\ "for vertical offset expected here!", ( ftnlen)128, (ftnlen)42); -#line 9080 "" +#line 9070 "" stop1_(); -#line 9081 "" +#line 9071 "" } -#line 9082 "" +#line 9072 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 9083 "" +#line 9073 "" if (*(unsigned char *)durq != ' ') { -#line 9084 "" +#line 9074 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9084 "" +#line 9074 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"\ " offset must terminate figure!", (ftnlen) 128, (ftnlen)38); -#line 9086 "" +#line 9076 "" stop1_(); -#line 9087 "" +#line 9077 "" } -#line 9088 "" +#line 9078 "" --a1ll_2.iccount; -#line 9089 "" +#line 9079 "" goto L26; -#line 9090 "" +#line 9080 "" } else if (*(unsigned char *)durq != ' ') { -#line 9091 "" +#line 9081 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9091 "" +#line 9081 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in figure in xtuplet!", (ftnlen)128, ( ftnlen)39); -#line 9093 "" +#line 9083 "" stop1_(); -#line 9094 "" +#line 9084 "" } -#line 9095 "" +#line 9085 "" goto L110; -#line 9096 "" +#line 9086 "" } else if (*(unsigned char *)durq == 'G') { -#line 9097 "" +#line 9087 "" ngr = 1; -#line 9098 "" +#line 9088 "" L79: -#line 9098 "" +#line 9088 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, ( ftnlen)1); -#line 9099 "" +#line 9089 "" if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { -#line 9100 "" +#line 9090 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 9101 "" +#line 9091 "" ngr = i_nint(&fnum); -#line 9102 "" +#line 9092 "" --a1ll_2.iccount; -#line 9103 "" +#line 9093 "" goto L79; -#line 9104 "" +#line 9094 "" } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) { -#line 9105 "" +#line 9095 "" goto L79; -#line 9106 "" +#line 9096 "" } else if (*(unsigned char *)charq == 'm') { -#line 9107 "" +#line 9097 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9108 "" +#line 9098 "" if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) { -#line 9109 "" +#line 9099 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9109 "" +#line 9099 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "\ "less than 5 must follow \"m\" in a grace"\ " note!", (ftnlen)128, (ftnlen)52); -#line 9111 "" +#line 9101 "" stop1_(); -#line 9112 "" +#line 9102 "" } -#line 9113 "" +#line 9103 "" goto L79; -#line 9114 "" +#line 9104 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note */ -#line 9118 "" +#line 9108 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9119 "" +#line 9109 "" if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen) 1) > 0) { -#line 9120 "" +#line 9110 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 9121 "" +#line 9111 "" --a1ll_2.iccount; -#line 9122 "" +#line 9112 "" goto L79; -#line 9123 "" +#line 9113 "" } else { -#line 9124 "" +#line 9114 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9124 "" +#line 9114 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"\ " must follow \"X\" in a grace note!", ( ftnlen)128, (ftnlen)41); -#line 9126 "" +#line 9116 "" stop1_(); -#line 9127 "" +#line 9117 "" } -#line 9128 "" +#line 9118 "" } /* At this point, charq is first note name in rest (grace?) */ -#line 9132 "" +#line 9122 "" i__4 = ngr; -#line 9132 "" +#line 9122 "" for (igr = 1; igr <= i__4; ++igr) { -#line 9133 "" +#line 9123 "" numnum = 0; -#line 9134 "" +#line 9124 "" if (igr > 1) { -#line 9135 "" +#line 9125 "" L75: -#line 9135 "" +#line 9125 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen) 128, (ftnlen)1); -#line 9136 "" +#line 9126 "" if (*(unsigned char *)charq == ' ') { -#line 9136 "" +#line 9126 "" goto L75; -#line 9136 "" +#line 9126 "" } -#line 9137 "" +#line 9127 "" } -#line 9138 "" +#line 9128 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { -#line 9139 "" +#line 9129 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9139 "" +#line 9129 "" errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"\ ", expected \"a\"-\"g\"!", (ftnlen)128, ( ftnlen)27); -#line 9141 "" +#line 9131 "" stop1_(); -#line 9142 "" +#line 9132 "" } -#line 9143 "" +#line 9133 "" L78: -#line 9143 "" +#line 9133 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9144 "" +#line 9134 "" if (*(unsigned char *)charq != ' ') { -#line 9145 "" +#line 9135 "" if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) { -#line 9146 "" +#line 9136 "" if (numnum == 1) { -#line 9147 "" +#line 9137 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9147 "" +#line 9137 "" errmsg_(lineq, &a1ll_2.iccount, &i__5, "Only one of \"+-1234567\" allow"\ "ed here in grace!", (ftnlen)128, ( ftnlen)46); -#line 9149 "" +#line 9139 "" stop1_(); -#line 9150 "" +#line 9140 "" } -#line 9151 "" +#line 9141 "" numnum = 1; -#line 9152 "" +#line 9142 "" goto L78; -#line 9153 "" +#line 9143 "" } else if (i_indx("+-nfs", charq, (ftnlen)5, ( ftnlen)1) > 0) { -#line 9154 "" +#line 9144 "" goto L78; -#line 9155 "" +#line 9145 "" } /* Digits are possible octave numbers */ -#line 9159 "" +#line 9149 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9159 "" +#line 9149 "" errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "\ "character after note name in grace!", ( ftnlen)128, (ftnlen)43); -#line 9161 "" +#line 9151 "" stop1_(); -#line 9162 "" +#line 9152 "" } -#line 9163 "" +#line 9153 "" /* L71: */ -#line 9163 "" +#line 9153 "" } -#line 9164 "" +#line 9154 "" goto L110; -#line 9165 "" +#line 9155 "" } else /* if(complicated condition) */ { -#line 9165 "" +#line 9155 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 9165 "" +#line 9155 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0]) { -#line 9166 "" +#line 9156 "" chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); -#line 9167 "" +#line 9157 "" if (literr > 0) { -#line 9168 "" +#line 9158 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9168 "" +#line 9158 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + ( literr - 1) * 51, (ftnlen)128, (ftnlen)51) ; -#line 9170 "" +#line 9160 "" stop1_(); -#line 9171 "" +#line 9161 "" } -#line 9172 "" +#line 9162 "" goto L110; -#line 9173 "" - } else if (*(unsigned char *)durq == '"') { +#line 9163 "" + } else /* if(complicated condition) */ { +#line 9163 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 9163 "" + if (*(unsigned char *)durq == *(unsigned char *)& + ch__2[0]) { /* pmx lyric */ -#line 9177 "" - chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen) - 128); +#line 9167 "" + chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, ( + ftnlen)128); +#line 9168 "" + if (lyrerr > 0) { +#line 9169 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9169 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + + (lyrerr - 1) * 51, (ftnlen)128, ( + ftnlen)51); +#line 9171 "" + stop1_(); +#line 9172 "" + } +#line 9173 "" + goto L110; +#line 9174 "" + } else if (*(unsigned char *)durq == 'M') { + +/* Temporary trap until I get around putting this in pmxb */ + #line 9178 "" - if (lyrerr > 0) { -#line 9179 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9179 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + ( - lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51) - ; -#line 9181 "" +#line 9178 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros n"\ + "ot yet allowed in xtuplets!", (ftnlen)128, + (ftnlen)35); +#line 9180 "" stop1_(); +#line 9181 "" + } else if (*(unsigned char *)durq == 'X') { #line 9182 "" - } -#line 9183 "" - goto L110; + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9182 "" + g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, + &i__4, &c1omnotes_1.udsp[ + c1omnotes_1.ibarcnt + a1ll_2.nbars], & + c1omnotes_1.wheadpt, (ftnlen)128); #line 9184 "" - } else if (*(unsigned char *)durq == 'M') { + goto L110; +#line 9185 "" + } else if (*(unsigned char *)durq == 'z') { -/* Temporary trap until I get around putting this in pmxb */ +/* Chord note in xtup. Read past for now. */ -#line 9188 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9188 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"\ - "et allowed in xtuplets!", (ftnlen)128, ( - ftnlen)35); +#line 9189 "" +L33: +#line 9189 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 9190 "" - stop1_(); + if (*(unsigned char *)durq != ' ') { +#line 9190 "" + goto L33; +#line 9190 "" + } #line 9191 "" - } else if (*(unsigned char *)durq == 'X') { -#line 9192 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + goto L110; #line 9192 "" - g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, & - i__4, &c1omnotes_1.udsp[c1omnotes_1.ibarcnt + - a1ll_2.nbars], &c1omnotes_1.wheadpt, (ftnlen) - 128); -#line 9194 "" - goto L110; -#line 9195 "" - } else if (*(unsigned char *)durq == 'z') { + } else if (*(unsigned char *)durq == 'D') { -/* Chord note in xtup. Read past for now. */ +/* Dynamic mark */ +#line 9196 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9196 "" + checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen) + 128); +#line 9197 "" + goto L110; +#line 9198 "" + } else if (*(unsigned char *)durq == '%') { #line 9199 "" -L33: -#line 9199 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 9200 "" - if (*(unsigned char *)durq != ' ') { + if (a1ll_2.iccount != 1) { #line 9200 "" - goto L33; + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; #line 9200 "" - } -#line 9201 "" - goto L110; + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comm"\ + "ent must have \"%\" in column 1!", ( + ftnlen)128, (ftnlen)34); #line 9202 "" - } else if (*(unsigned char *)durq == 'D') { - -/* Dynamic mark */ - -#line 9206 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); +#line 9203 "" + } +#line 9204 "" + a1ll_2.iccount = 128; +#line 9205 "" + goto L110; #line 9206 "" - checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128); + } else if (*(unsigned char *)durq == '?') { #line 9207 "" - goto L110; + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 9208 "" - } else if (*(unsigned char *)durq == '%') { + if (*(unsigned char *)durq == ' ') { #line 9209 "" - if (a1ll_2.iccount != 1) { -#line 9210 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; + --a1ll_2.iccount; #line 9210 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "\ - "must have \"%\" in column 1!", (ftnlen) - 128, (ftnlen)34); + goto L110; +#line 9211 "" + } #line 9212 "" - stop1_(); + if (*(unsigned char *)durq != '-') { #line 9213 "" - } -#line 9214 "" - a1ll_2.iccount = 128; + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9213 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\ + "cting \"-\"", (ftnlen)128, (ftnlen)13) + ; #line 9215 "" - goto L110; + stop1_(); #line 9216 "" - } else if (*(unsigned char *)durq == '?') { + } #line 9217 "" - getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 9218 "" - if (*(unsigned char *)durq == ' ') { + if (i_indx("0123456789.", durq, (ftnlen)11, ( + ftnlen)1) == 0) { #line 9219 "" - --a1ll_2.iccount; -#line 9220 "" - goto L110; + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9219 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\ + "cting number", (ftnlen)128, (ftnlen) + 16); #line 9221 "" - } + stop1_(); #line 9222 "" - if (*(unsigned char *)durq != '-') { -#line 9223 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; + } #line 9223 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ - "g \"-\"", (ftnlen)128, (ftnlen)13); + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 9224 "" + --a1ll_2.iccount; #line 9225 "" - stop1_(); -#line 9226 "" - } -#line 9227 "" - getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 9228 "" - if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) - == 0) { -#line 9229 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; -#line 9229 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ - "g number", (ftnlen)128, (ftnlen)16); -#line 9231 "" - stop1_(); -#line 9232 "" - } -#line 9233 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) - 128, (ftnlen)1); -#line 9234 "" - --a1ll_2.iccount; -#line 9235 "" - goto L110; + goto L110; /* 140215 Allow clef change inside xtup */ -#line 9239 "" - } else if (*(unsigned char *)durq == 'C') { -#line 9240 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 9241 "" - if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) - > 0 || *(unsigned char *)durq >= 48 && *( - unsigned char *)durq <= 56)) { +#line 9229 "" + } else if (*(unsigned char *)durq == 'C') { +#line 9230 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); +#line 9231 "" + if (! (i_indx("tsmanrbf", durq, (ftnlen)8, ( + ftnlen)1) > 0 || *(unsigned char *)durq >= + 48 && *(unsigned char *)durq <= 56)) { /* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */ -#line 9244 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; -#line 9244 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\ - "e t,s,m,a,n,r,b,f or 0-8 after C!", ( - ftnlen)128, (ftnlen)41); -#line 9246 "" - stop1_(); -#line 9247 "" - } -/* gotclef = .true. */ -#line 9249 "" - goto L110; -/* +++ */ -#line 9251 "" - } else /* if(complicated condition) */ { -#line 9251 "" - i__4 = a1ll_2.iccount; -#line 9251 "" - i__5 = a1ll_2.iccount + 1; -#line 9251 "" - if (*(unsigned char *)durq == ']' && s_cmp(lineq + - i__4, "[", a1ll_2.iccount + 1 - i__4, (ftnlen) - 1) == 0 && s_cmp(lineq + i__5, " ", - a1ll_2.iccount + 2 - i__5, (ftnlen)1) == 0) { -#line 9253 "" - a1ll_2.iccount += 2; -#line 9254 "" +#line 9234 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9234 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must"\ + " have t,s,m,a,n,r,b,f or 0-8 after C!" + , (ftnlen)128, (ftnlen)41); +#line 9236 "" + stop1_(); +#line 9237 "" + } +#line 9238 "" goto L110; /* +++ */ +#line 9240 "" + } else /* if(complicated condition) */ { +#line 9240 "" + i__4 = a1ll_2.iccount; +#line 9240 "" + i__5 = a1ll_2.iccount + 1; +#line 9240 "" + if (*(unsigned char *)durq == ']' && s_cmp(lineq + + i__4, "[", a1ll_2.iccount + 1 - i__4, ( + ftnlen)1) == 0 && s_cmp(lineq + i__5, + " ", a1ll_2.iccount + 2 - i__5, (ftnlen)1) + == 0) { +#line 9242 "" + a1ll_2.iccount += 2; +#line 9243 "" + goto L110; +/* +++ */ /* Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo */ -#line 9259 "" +#line 9248 "" + } +#line 9248 "" } -#line 9259 "" +#line 9248 "" } -#line 9259 "" +#line 9248 "" } /* End of xtup options. At this point symbol can only be note or rest */ -#line 9263 "" +#line 9252 "" if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) { -#line 9264 "" +#line 9253 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9264 "" +#line 9253 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"\ "aracter is not allowed!", (ftnlen)128, (ftnlen)39) ; -#line 9266 "" +#line 9255 "" stop1_(); -#line 9267 "" +#line 9256 "" } -#line 9268 "" +#line 9257 "" L7: -#line 9268 "" +#line 9257 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 9269 "" +#line 9258 "" if (i_indx("12345678ulcb", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 9270 "" +#line 9259 "" goto L7; -#line 9271 "" +#line 9260 "" } else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */ -#line 9275 "" +#line 9264 "" i__4 = a1ll_2.iccount; -#line 9275 "" +#line 9264 "" if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, ( ftnlen)1) == 0) { -#line 9275 "" +#line 9264 "" ++a1ll_2.iccount; -#line 9275 "" +#line 9264 "" } -#line 9276 "" +#line 9265 "" goto L7; -#line 9277 "" +#line 9266 "" } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { /* May have either octave jump or shifted accid. on main xtup note */ -#line 9281 "" +#line 9270 "" i__4 = a1ll_2.iccount; -#line 9281 "" +#line 9270 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0 && i_indx("01234567890", lineq + i__4, (ftnlen)11, a1ll_2.iccount + 1 - i__4) == 0) { -#line 9281 "" +#line 9270 "" goto L7; -#line 9281 "" +#line 9270 "" } -#line 9284 "" +#line 9273 "" ++a1ll_2.iccount; -#line 9285 "" +#line 9274 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 9286 "" +#line 9275 "" --a1ll_2.iccount; -#line 9287 "" +#line 9276 "" goto L7; -#line 9288 "" +#line 9277 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double an xtup note to make an unequal xtup */ -#line 9292 "" +#line 9281 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18); -#line 9293 "" +#line 9282 "" ++ndoub; -#line 9294 "" +#line 9283 "" goto L7; -#line 9295 "" +#line 9284 "" } else if (*(unsigned char *)durq == 'd') { -#line 9296 "" +#line 9285 "" if (twotrem) { /* 2-note trem, get shift */ -#line 9300 "" +#line 9289 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 9301 "" +#line 9290 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9302 "" +#line 9291 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9302 "" +#line 9291 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expected"\ " +/- for shifted dot on end of 2-note tr"\ "em!", (ftnlen)128, (ftnlen)51); -#line 9304 "" +#line 9293 "" stop1_(); -#line 9305 "" +#line 9294 "" } -#line 9306 "" +#line 9295 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 9307 "" +#line 9296 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 9308 "" +#line 9297 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9308 "" +#line 9297 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expected"\ " number here!", (ftnlen)128, (ftnlen)21); -#line 9310 "" +#line 9299 "" stop1_(); -#line 9311 "" +#line 9300 "" } -#line 9312 "" +#line 9301 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 9313 "" +#line 9302 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ -#line 9317 "" +#line 9306 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) 128, (ftnlen)1); -#line 9318 "" +#line 9307 "" if (i_indx("0123456789-.", durq, (ftnlen)12, ( ftnlen)1) == 0) { -#line 9319 "" +#line 9308 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9319 "" +#line 9308 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\ "cted number after 2nd +/- (shift dot"\ ")!", (ftnlen)128, (ftnlen)42); -#line 9321 "" +#line 9310 "" stop1_(); -#line 9322 "" +#line 9311 "" } -#line 9323 "" +#line 9312 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 9324 "" +#line 9313 "" } -#line 9325 "" +#line 9314 "" --a1ll_2.iccount; -#line 9326 "" +#line 9315 "" goto L7; -#line 9327 "" +#line 9316 "" } else { -#line 9328 "" +#line 9317 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25] = bit_set( c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25],27); -#line 9329 "" +#line 9318 "" } -#line 9330 "" +#line 9319 "" goto L7; -#line 9331 "" +#line 9320 "" } else if (*(unsigned char *)durq != ' ') { -#line 9332 "" +#line 9321 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9332 "" +#line 9321 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"\ "n xtuplet note!", (ftnlen)128, (ftnlen)31); -#line 9334 "" +#line 9323 "" stop1_(); -#line 9335 "" +#line 9324 "" } -#line 9336 "" +#line 9325 "" if (itup == ntup - ndoub) { -#line 9336 "" +#line 9325 "" goto L3; -#line 9336 "" +#line 9325 "" } -#line 9337 "" +#line 9326 "" /* L6: */ -#line 9337 "" +#line 9326 "" } -#line 9338 "" +#line 9327 "" L3: /* 6==End of loop for xtuplet input */ -#line 9342 "" +#line 9331 "" ; -#line 9342 "" +#line 9331 "" } else if (*(unsigned char *)durq == 'm') { /* Multi-bar rest: next 1 or two digits are # of bars. */ -#line 9346 "" +#line 9335 "" if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) { -#line 9347 "" +#line 9336 "" i__1 = a1ll_2.iccount - 1; -#line 9347 "" +#line 9336 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9347 "" +#line 9336 "" errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"\ "ginning of bar!", (ftnlen)128, (ftnlen)45); -#line 9349 "" +#line 9338 "" stop1_(); -#line 9350 "" +#line 9339 "" } else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) { -#line 9351 "" +#line 9340 "" i__1 = a1ll_2.iccount - 1; -#line 9351 "" +#line 9340 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9351 "" +#line 9340 "" errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"\ "ime per block!", (ftnlen)128, (ftnlen)44); -#line 9353 "" +#line 9342 "" stop1_(); -#line 9354 "" +#line 9343 "" } /* For some purposes, pretend its one bar only */ -#line 9358 "" +#line 9347 "" a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] = a1ll_2.lenbar; -#line 9359 "" +#line 9348 "" c1omnotes_1.ibarmbr = a1ll_2.nbars + 1; -#line 9360 "" +#line 9349 "" c1omnotes_1.mbrest = 0; /* 20 call g1etchar(lineq,iccount,durq) */ -#line 9362 "" +#line 9351 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9363 "" +#line 9352 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 9364 "" +#line 9353 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9364 "" +#line 9353 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "\ "after \"rm\"!", (ftnlen)128, (ftnlen)31); -#line 9366 "" +#line 9355 "" stop1_(); -#line 9367 "" +#line 9356 "" } -#line 9368 "" +#line 9357 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9369 "" +#line 9358 "" c1omnotes_1.mbrest = i_nint(&fnum); /* iccount = iccount-1 */ -#line 9371 "" +#line 9360 "" if (a1ll_2.nv > 1) { -#line 9372 "" +#line 9361 "" if (a1ll_2.iv == 1) { -#line 9373 "" +#line 9362 "" comkeys_1.mbrestsav = c1omnotes_1.mbrest; -#line 9374 "" +#line 9363 "" } else { -#line 9375 "" +#line 9364 "" if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) { -#line 9376 "" +#line 9365 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9376 "" +#line 9365 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"\ "ame multi-bar rest in every voice!", (ftnlen) 128, (ftnlen)46); -#line 9378 "" +#line 9367 "" stop1_(); -#line 9379 "" +#line 9368 "" } -#line 9380 "" +#line 9369 "" } /* Zero out mbrestsav so can check at end of input block whether */ /* all voices have one */ -#line 9385 "" +#line 9374 "" if (a1ll_2.iv == a1ll_2.nv) { -#line 9385 "" +#line 9374 "" comkeys_1.mbrestsav = 0; -#line 9385 "" +#line 9374 "" } -#line 9386 "" +#line 9375 "" } -#line 9387 "" +#line 9376 "" if (*(unsigned char *)durq == 'n') { /* Get new height */ -#line 9391 "" +#line 9380 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 9392 "" +#line 9381 "" if (i_indx("+-123456789", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 9393 "" +#line 9382 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9393 "" +#line 9382 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an inte"\ "ger after \"rm[x]n\"!", (ftnlen)128, (ftnlen)35); -#line 9395 "" +#line 9384 "" stop1_(); -#line 9396 "" +#line 9385 "" } -#line 9397 "" +#line 9386 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) != 0) { -#line 9397 "" +#line 9386 "" ++a1ll_2.iccount; -#line 9397 "" +#line 9386 "" } -#line 9398 "" +#line 9387 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9399 "" +#line 9388 "" } -#line 9400 "" +#line 9389 "" if (*(unsigned char *)durq != ' ') { -#line 9401 "" +#line 9390 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9401 "" +#line 9390 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ "ter \"rm\"!", (ftnlen)128, (ftnlen)29); -#line 9403 "" +#line 9392 "" stop1_(); -#line 9404 "" +#line 9393 "" } -#line 9405 "" +#line 9394 "" } else if (*(unsigned char *)durq == '.') { /* Dotted pattern. Close out note. Mult time by 3/4. */ /* Set time for next note to 1/4. Start the note. */ -#line 9410 "" +#line 9399 "" idotform = 1; -#line 9411 "" +#line 9400 "" } else if (*(unsigned char *)durq == ',') { -#line 9412 "" +#line 9401 "" idotform = 3; /* Now flow to duration setting, as if durq=' ' */ -#line 9416 "" +#line 9405 "" } else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Suppress full bar rest, or look left for height */ -#line 9420 "" +#line 9409 "" if (*(unsigned char *)charq != 'r') { -#line 9421 "" +#line 9410 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9421 "" +#line 9410 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "\ "only legal for rest, not note!", (ftnlen)128, (ftnlen) 46); -#line 9423 "" +#line 9412 "" stop1_(); -#line 9424 "" +#line 9413 "" } -#line 9425 "" +#line 9414 "" goto L2; -#line 9426 "" +#line 9415 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double note for xtup. Must check here in case "D" or "F" came before "x" or on */ /* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */ -#line 9431 "" +#line 9420 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25],18); -#line 9432 "" +#line 9421 "" goto L2; -#line 9433 "" +#line 9422 "" } else if (*(unsigned char *)durq == 'A') { /* Main note accidental option */ -#line 9437 "" +#line 9426 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9438 "" +#line 9427 "" if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) { -#line 9439 "" +#line 9428 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9439 "" +#line 9428 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""\ "<\",\">\" are the only legal options here!", (ftnlen) 128, (ftnlen)51); -#line 9441 "" +#line 9430 "" stop1_(); -#line 9442 "" +#line 9431 "" } /* Need more stuff here */ -#line 9446 "" +#line 9435 "" if (*(unsigned char *)durq != 'o') { /* Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will */ /* proceed to number input checking */ -#line 9451 "" +#line 9440 "" --a1ll_2.iccount; -#line 9452 "" +#line 9441 "" } -#line 9453 "" +#line 9442 "" goto L2; -#line 9454 "" +#line 9443 "" } else if (*(unsigned char *)durq == 'T') { /* Single stem tremolo. Only option (optional) is 1,2,3, or 4. */ -#line 9458 "" +#line 9447 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9459 "" +#line 9448 "" if (i_indx("1234", durq, (ftnlen)4, (ftnlen)1) == 0) { -#line 9459 "" +#line 9448 "" --a1ll_2.iccount; -#line 9459 "" +#line 9448 "" } -#line 9460 "" +#line 9449 "" goto L2; -#line 9461 "" +#line 9450 "" } else if (*(unsigned char *)durq != ' ') { -#line 9462 "" +#line 9451 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9462 "" +#line 9451 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", ( ftnlen)128, (ftnlen)18); -#line 9464 "" +#line 9453 "" s_wsle(&io___659); -#line 9464 "" +#line 9453 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); -#line 9464 "" +#line 9453 "" i__1 = *(unsigned char *)durq; -#line 9464 "" +#line 9453 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 9464 "" +#line 9453 "" e_wsle(); -#line 9465 "" +#line 9454 "" stop1_(); -#line 9466 "" +#line 9455 "" } /* End of block for note options. */ /* Set the duration */ -#line 9472 "" +#line 9461 "" if (idotform > 0) { -#line 9473 "" +#line 9462 "" if (idotform == 1) { -#line 9474 "" +#line 9463 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, ( ftnlen)1) * 3 / 2; -#line 9475 "" +#line 9464 "" } else if (idotform == 2) { -#line 9476 "" +#line 9465 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[ c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 3; -#line 9477 "" +#line 9466 "" } else if (idotform == 3) { -#line 9478 "" +#line 9467 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, ( ftnlen)1); -#line 9479 "" +#line 9468 "" } else if (idotform == 4) { -#line 9480 "" +#line 9469 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[ c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 2; -#line 9481 "" +#line 9470 "" } -#line 9482 "" +#line 9471 "" } else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) { -#line 9483 "" +#line 9472 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (ftnlen)1); /* Check for double dot */ -#line 9487 "" +#line 9476 "" if (c1omnotes_1.iddot == 1) { -#line 9488 "" +#line 9477 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25] * 7 / 6; -#line 9489 "" +#line 9478 "" c1omnotes_1.iddot = 0; -#line 9490 "" +#line 9479 "" } -#line 9491 "" +#line 9480 "" } else if (fulbrp) { -#line 9492 "" +#line 9481 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.lenbar; /* Use a one-line function to set nnodur. It gives inverse of ifnodur. */ -#line 9496 "" +#line 9485 "" i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48; -#line 9496 "" +#line 9485 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 9496 "" +#line 9485 "" c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, ( ftnlen)1) - 1; -#line 9498 "" +#line 9487 "" fulbrp = FALSE_; -#line 9499 "" +#line 9488 "" } -#line 9500 "" +#line 9489 "" a1ll_2.rest[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq == 'r'; /* If inside forced beam, check if note is beamable */ -#line 9504 "" +#line 9493 "" if (c1omget_1.fbon) { -#line 9505 "" +#line 9494 "" if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] < 16) { -#line 9505 "" +#line 9494 "" goto L120; -#line 9505 "" +#line 9494 "" } -#line 9506 "" +#line 9495 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) { -#line 9507 "" +#line 9496 "" if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1) * 24 - 25] == 0) { -#line 9507 "" +#line 9496 "" goto L120; -#line 9507 "" +#line 9496 "" } -#line 9508 "" +#line 9497 "" } -#line 9509 "" +#line 9498 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9509 "" +#line 9498 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"\ "ed beam!", (ftnlen)128, (ftnlen)32); -#line 9511 "" +#line 9500 "" stop1_(); -#line 9512 "" +#line 9501 "" } -#line 9513 "" +#line 9502 "" L120: /* Get number of prior bars for later check on whether note spans bar line */ -#line 9517 "" +#line 9506 "" nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; -#line 9518 "" +#line 9507 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25]; -#line 9519 "" +#line 9508 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) { -#line 9520 "" +#line 9509 "" ++a1ll_2.nbars; -#line 9521 "" +#line 9510 "" if (comkeys_1.shifton) { -#line 9521 "" +#line 9510 "" comkeys_1.barend = TRUE_; -#line 9521 "" +#line 9510 "" } /* Will check barend when 1st note of next bar is entered. */ -#line 9525 "" +#line 9514 "" if (a1ll_2.nbars > 15) { -#line 9526 "" +#line 9515 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9526 "" +#line 9515 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"\ "n 15 bars in an input block!", (ftnlen)128, (ftnlen) 48); -#line 9528 "" +#line 9517 "" stop1_(); -#line 9529 "" +#line 9518 "" } -#line 9530 "" +#line 9519 "" a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[ c1ommvl_1.ivx - 1]; -#line 9531 "" +#line 9520 "" if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) { /* Just finished the pickup bar for this voice. */ -#line 9535 "" +#line 9524 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) { -#line 9536 "" +#line 9525 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9536 "" +#line 9525 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"\ "h disagrees with mtrnum0!", (ftnlen)128, (ftnlen) 41); -#line 9538 "" +#line 9527 "" stop1_(); -#line 9539 "" +#line 9528 "" } -#line 9540 "" +#line 9529 "" a1ll_2.lenbar = a1ll_2.lenbr1; -#line 9541 "" +#line 9530 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; -#line 9542 "" +#line 9531 "" } -#line 9543 "" +#line 9532 "" } else if (comkeys_1.barend) { -#line 9544 "" +#line 9533 "" if (comkeys_1.shifton) { -#line 9545 "" +#line 9534 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9545 "" +#line 9534 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ "defined shift still on!", (ftnlen)128, (ftnlen)43); -#line 9547 "" +#line 9536 "" stop1_(); -#line 9548 "" +#line 9537 "" } -#line 9549 "" +#line 9538 "" comkeys_1.barend = FALSE_; -#line 9550 "" +#line 9539 "" } else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) { -#line 9551 "" +#line 9540 "" i__1 = a1ll_2.iccount - 1; -#line 9551 "" +#line 9540 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9551 "" +#line 9540 "" errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", ( ftnlen)128, (ftnlen)27); -#line 9553 "" +#line 9542 "" stop1_(); -#line 9554 "" +#line 9543 "" } -#line 9555 "" +#line 9544 "" if (idotform == 1 || idotform == 3) { -#line 9556 "" +#line 9545 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9557 "" +#line 9546 "" if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) { -#line 9558 "" +#line 9547 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9558 "" +#line 9547 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"\ "r \"r\" here!", (ftnlen)128, (ftnlen)31); -#line 9560 "" +#line 9549 "" stop1_(); -#line 9561 "" +#line 9550 "" } -#line 9562 "" +#line 9551 "" ++idotform; -#line 9563 "" +#line 9552 "" numnum = 1; -#line 9564 "" +#line 9553 "" goto L28; -#line 9565 "" +#line 9554 "" } /* End of sub block for note-rest */ -#line 9569 "" +#line 9558 "" } else if (*(unsigned char *)charq == 'z') { -#line 9570 "" +#line 9559 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9571 "" +#line 9560 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { -#line 9572 "" +#line 9561 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9572 "" +#line 9561 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"\ " here!", (ftnlen)128, (ftnlen)30); -#line 9574 "" +#line 9563 "" stop1_(); -#line 9575 "" +#line 9564 "" } -#line 9576 "" +#line 9565 "" L25: -#line 9576 "" +#line 9565 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); /* if (index('dre12345678',durq) .gt. 0) then */ -#line 9578 "" +#line 9567 "" if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 9579 "" +#line 9568 "" goto L25; -#line 9580 "" +#line 9569 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */ /* MUST come right after "f,s,n" */ -#line 9585 "" +#line 9574 "" i__1 = a1ll_2.iccount; -#line 9585 "" +#line 9574 "" if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { -#line 9585 "" +#line 9574 "" ++a1ll_2.iccount; -#line 9585 "" +#line 9574 "" } -#line 9586 "" +#line 9575 "" goto L25; -#line 9587 "" +#line 9576 "" } else if (*(unsigned char *)durq == 'A') { -#line 9588 "" +#line 9577 "" i__1 = a1ll_2.iccount - 2; -#line 9588 "" +#line 9577 "" if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 - i__1) == 0) { -#line 9589 "" +#line 9578 "" i__1 = a1ll_2.iccount - 1; -#line 9589 "" +#line 9578 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9589 "" +#line 9578 "" errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""\ "A\" in chord note!", (ftnlen)128, (ftnlen)43); -#line 9591 "" +#line 9580 "" stop1_(); -#line 9592 "" +#line 9581 "" } -#line 9593 "" +#line 9582 "" goto L25; -#line 9594 "" +#line 9583 "" } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 9595 "" +#line 9584 "" i__1 = a1ll_2.iccount - 2; -#line 9595 "" +#line 9584 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) == 0) { /* if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems */ -#line 9597 "" +#line 9586 "" i__1 = a1ll_2.iccount - 1; -#line 9597 "" +#line 9586 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9597 "" +#line 9586 "" errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"\ " \"<\" or \">\"!", (ftnlen)128, (ftnlen)38); -#line 9599 "" +#line 9588 "" stop1_(); -#line 9600 "" +#line 9589 "" } -#line 9601 "" +#line 9590 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9602 "" +#line 9591 "" if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 9603 "" +#line 9592 "" i__1 = a1ll_2.iccount - 1; -#line 9603 "" +#line 9592 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9603 "" +#line 9592 "" errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"\ "e for accidental shift!", (ftnlen)128, (ftnlen)53); -#line 9605 "" +#line 9594 "" stop1_(); -#line 9606 "" +#line 9595 "" } -#line 9607 "" +#line 9596 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9608 "" +#line 9597 "" --a1ll_2.iccount; -#line 9609 "" +#line 9598 "" goto L25; -#line 9610 "" +#line 9599 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 9611 "" +#line 9600 "" i__1 = a1ll_2.iccount; -#line 9611 "" +#line 9600 "" if (i_indx("1234567890.", lineq + i__1, (ftnlen)11, a1ll_2.iccount + 1 - i__1) == 0) { -#line 9611 "" +#line 9600 "" goto L25; -#line 9611 "" +#line 9600 "" } /* Number or '.' (durq) follows +/- . Get it. */ -#line 9616 "" +#line 9605 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9617 "" +#line 9606 "" i__1 = a1ll_2.iccount; -#line 9617 "" +#line 9606 "" if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) { -#line 9619 "" +#line 9608 "" i__1 = a1ll_2.iccount - 1; -#line 9619 "" +#line 9608 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9619 "" +#line 9608 "" errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"\ " a digit!", (ftnlen)128, (ftnlen)37); -#line 9621 "" +#line 9610 "" stop1_(); -#line 9622 "" +#line 9611 "" } else /* if(complicated condition) */ { -#line 9622 "" +#line 9611 "" i__1 = a1ll_2.iccount - 3; -#line 9622 "" +#line 9611 "" if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount - 2 - i__1) == 0) { -#line 9623 "" +#line 9612 "" i__1 = a1ll_2.iccount - 1; -#line 9623 "" +#line 9612 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9623 "" +#line 9612 "" errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"\ "ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41); -#line 9625 "" +#line 9614 "" stop1_(); -#line 9626 "" +#line 9615 "" } -#line 9626 "" +#line 9615 "" } -#line 9627 "" +#line 9616 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9628 "" +#line 9617 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9629 "" +#line 9618 "" --a1ll_2.iccount; -#line 9630 "" +#line 9619 "" goto L25; -#line 9631 "" +#line 9620 "" } /* 2nd +/- */ -#line 9635 "" +#line 9624 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 9636 "" +#line 9625 "" if (*(unsigned char *)durq == '.') { -#line 9636 "" +#line 9625 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); -#line 9636 "" +#line 9625 "" } -#line 9637 "" +#line 9626 "" if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 9638 "" +#line 9627 "" i__1 = a1ll_2.iccount - 1; -#line 9638 "" +#line 9627 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9638 "" +#line 9627 "" errmsg_(lineq, &i__1, &i__4, "Expected a number here!", ( ftnlen)128, (ftnlen)23); -#line 9640 "" +#line 9629 "" stop1_(); -#line 9641 "" +#line 9630 "" } -#line 9642 "" +#line 9631 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9643 "" +#line 9632 "" --a1ll_2.iccount; -#line 9644 "" +#line 9633 "" goto L25; -#line 9645 "" +#line 9634 "" } else if (*(unsigned char *)durq != ' ') { -#line 9646 "" +#line 9635 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9646 "" +#line 9635 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"\ "rd note!", (ftnlen)128, (ftnlen)32); -#line 9648 "" +#line 9637 "" stop1_(); -#line 9649 "" +#line 9638 "" } -#line 9650 "" +#line 9639 "" } else if (*(unsigned char *)charq == 'G') { -#line 9651 "" +#line 9640 "" ngr = 1; -#line 9652 "" +#line 9641 "" L9: -#line 9652 "" +#line 9641 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9653 "" +#line 9642 "" if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { -#line 9654 "" +#line 9643 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9655 "" +#line 9644 "" ngr = i_nint(&fnum); -#line 9656 "" +#line 9645 "" --a1ll_2.iccount; -#line 9657 "" +#line 9646 "" goto L9; -#line 9658 "" +#line 9647 "" } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) { -#line 9659 "" +#line 9648 "" goto L9; -#line 9660 "" +#line 9649 "" } else if (*(unsigned char *)charq == 'm') { -#line 9661 "" +#line 9650 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9662 "" +#line 9651 "" if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) { -#line 9663 "" +#line 9652 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9663 "" +#line 9652 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "\ "must follow \"m\" in a grace note!", (ftnlen)128, ( ftnlen)52); -#line 9665 "" +#line 9654 "" stop1_(); -#line 9666 "" +#line 9655 "" } -#line 9667 "" +#line 9656 "" goto L9; -#line 9668 "" +#line 9657 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note */ -#line 9672 "" +#line 9661 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9673 "" +#line 9662 "" if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) { -#line 9674 "" +#line 9663 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 9675 "" +#line 9664 "" --a1ll_2.iccount; -#line 9676 "" +#line 9665 "" goto L9; -#line 9677 "" +#line 9666 "" } else { -#line 9678 "" +#line 9667 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9678 "" +#line 9667 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"\ "ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41); -#line 9680 "" +#line 9669 "" stop1_(); -#line 9681 "" +#line 9670 "" } -#line 9682 "" +#line 9671 "" } /* At this point, charq is first note name in rest (grace?) */ -#line 9686 "" +#line 9675 "" i__1 = ngr; -#line 9686 "" +#line 9675 "" for (igr = 1; igr <= i__1; ++igr) { -#line 9687 "" +#line 9676 "" numnum = 0; -#line 9688 "" +#line 9677 "" if (igr > 1) { -#line 9689 "" +#line 9678 "" L55: -#line 9689 "" +#line 9678 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) 1); -#line 9690 "" +#line 9679 "" if (*(unsigned char *)charq == ' ') { -#line 9690 "" +#line 9679 "" goto L55; -#line 9690 "" +#line 9679 "" } -#line 9691 "" +#line 9680 "" } -#line 9692 "" +#line 9681 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { -#line 9693 "" +#line 9682 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9693 "" +#line 9682 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"\ " \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27); -#line 9695 "" +#line 9684 "" stop1_(); -#line 9696 "" +#line 9685 "" } -#line 9697 "" +#line 9686 "" L18: -#line 9697 "" +#line 9686 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 9698 "" +#line 9687 "" if (*(unsigned char *)charq != ' ') { -#line 9699 "" +#line 9688 "" if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) { -#line 9700 "" +#line 9689 "" if (numnum == 1) { -#line 9701 "" +#line 9690 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9701 "" +#line 9690 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"\ " \"+-1234567\" allowed here in grace!", ( ftnlen)128, (ftnlen)46); -#line 9703 "" +#line 9692 "" stop1_(); -#line 9704 "" +#line 9693 "" } -#line 9705 "" +#line 9694 "" numnum = 1; -#line 9706 "" +#line 9695 "" goto L18; /* else if (index('nfs',charq) .gt. 0) then */ -#line 9708 "" +#line 9697 "" } else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) { -#line 9709 "" +#line 9698 "" goto L18; -#line 9710 "" +#line 9699 "" } /* Digits are possible octave numbers */ -#line 9714 "" +#line 9703 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9714 "" +#line 9703 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"\ "ter note name in grace!", (ftnlen)128, (ftnlen)43); -#line 9716 "" +#line 9705 "" stop1_(); -#line 9717 "" +#line 9706 "" } -#line 9718 "" +#line 9707 "" /* L19: */ -#line 9718 "" +#line 9707 "" } -#line 9719 "" +#line 9708 "" } else /* if(complicated condition) */ { -#line 9719 "" +#line 9708 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 9719 "" +#line 9708 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) { -#line 9720 "" +#line 9709 "" chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); -#line 9721 "" +#line 9710 "" if (literr > 0) { -#line 9722 "" +#line 9711 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9722 "" +#line 9711 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) * 51, (ftnlen)128, (ftnlen)51); -#line 9724 "" +#line 9713 "" stop1_(); -#line 9725 "" +#line 9714 "" } -#line 9726 "" - } else if (*(unsigned char *)charq == '"') { +#line 9715 "" + } else /* if(complicated condition) */ { +#line 9715 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 9715 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) { /* pmx lyric */ +#line 9719 "" + chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128); +#line 9720 "" + if (lyrerr > 0) { +#line 9721 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9721 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - + 1) * 51, (ftnlen)128, (ftnlen)51); +#line 9723 "" + stop1_(); +#line 9724 "" + } +#line 9725 "" + } else if (*(unsigned char *)charq == 'o') { + +/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */ + +#line 9729 "" + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { #line 9730 "" - chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128); -#line 9731 "" - if (lyrerr > 0) { -#line 9732 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9730 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in"\ + " same input block, after affected note!", (ftnlen) + 128, (ftnlen)53); #line 9732 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - 1) * - 51, (ftnlen)128, (ftnlen)51); + stop1_(); +#line 9733 "" + } #line 9734 "" - stop1_(); -#line 9735 "" - } + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */ #line 9736 "" - } else if (*(unsigned char *)charq == 'o') { - -/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */ - + if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, ( + ftnlen)1) == 0) { +#line 9737 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9737 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!" + , (ftnlen)128, (ftnlen)17); +#line 9739 "" + stop1_(); #line 9740 "" - if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { -#line 9741 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 9741 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"\ - "e input block, after affected note!", (ftnlen)128, ( - ftnlen)53); + if (*(unsigned char *)dumq == ':') { +#line 9742 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9743 "" - stop1_(); + if (*(unsigned char *)dumq != ' ') { #line 9744 "" - } -#line 9745 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); -/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */ + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9744 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\ + "nk after \"o:\"!", (ftnlen)128, (ftnlen)26); +#line 9746 "" + stop1_(); #line 9747 "" - if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (ftnlen)1) - == 0) { + } else if (! comkeys_1.ornrpt) { #line 9748 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount - 1; +#line 9748 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9748 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", ( - ftnlen)128, (ftnlen)17); + errmsg_(lineq, &i__1, &i__4, "Turned off repeated or"\ + "naments before they were on!", (ftnlen)128, ( + ftnlen)50); #line 9750 "" - stop1_(); + stop1_(); #line 9751 "" - } + } #line 9752 "" - if (*(unsigned char *)dumq == ':') { + comkeys_1.ornrpt = FALSE_; #line 9753 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + } else if (*(unsigned char *)dumq == 'g') { #line 9754 "" - if (*(unsigned char *)dumq != ' ') { + if (c1omget_1.issegno) { #line 9755 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9755 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"\ - "fter \"o:\"!", (ftnlen)128, (ftnlen)26); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only "\ + "one \"segno\" per input block!", (ftnlen)128, + (ftnlen)40); #line 9757 "" - stop1_(); + stop1_(); #line 9758 "" - } else if (! comkeys_1.ornrpt) { + } else if (c1ommvl_1.ivx != 1) { #line 9759 "" - i__1 = a1ll_2.iccount - 1; -#line 9759 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9759 "" - errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"\ - "nts before they were on!", (ftnlen)128, (ftnlen) - 50); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can on"\ + "ly be in voice 1!", (ftnlen)128, (ftnlen)29); #line 9761 "" - stop1_(); + stop1_(); #line 9762 "" - } + } #line 9763 "" - comkeys_1.ornrpt = FALSE_; + c1omget_1.issegno = TRUE_; +#line 9764 "" +L12: #line 9764 "" - } else if (*(unsigned char *)dumq == 'g') { + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9765 "" - if (c1omget_1.issegno) { -#line 9766 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9766 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"\ - " \"segno\" per input block!", (ftnlen)128, ( - ftnlen)40); + if (*(unsigned char *)dumq == '-' || *(unsigned char *) + dumq >= 48 && *(unsigned char *)dumq <= 58) { +#line 9765 "" + goto L12; +#line 9765 "" + } +#line 9767 "" + if (*(unsigned char *)dumq != ' ') { #line 9768 "" - stop1_(); -#line 9769 "" - } else if (c1ommvl_1.ivx != 1) { -#line 9770 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9768 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter in segno ornament symbol!", (ftnlen)128, + (ftnlen)43); #line 9770 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"\ - "e in voice 1!", (ftnlen)128, (ftnlen)29); + stop1_(); +#line 9771 "" + } #line 9772 "" - stop1_(); -#line 9773 "" - } -#line 9774 "" - c1omget_1.issegno = TRUE_; -#line 9775 "" -L12: -#line 9775 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); -#line 9776 "" - if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >= - 48 && *(unsigned char *)dumq <= 58) { + } else if (*(unsigned char *)dumq == 'T') { + +/* Trill. may be followed by 't' and/or number. read 'til blank */ + #line 9776 "" - goto L12; +L22: #line 9776 "" - } + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 9777 "" + if (*(unsigned char *)dumq == ':') { #line 9778 "" - if (*(unsigned char *)dumq != ' ') { + i__1 = a1ll_2.iccount; +#line 9778 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - + i__1, (ftnlen)1) != 0) { #line 9779 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9779 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r in segno ornament symbol!", (ftnlen)128, ( - ftnlen)43); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected"\ + " blank after \":\"!", (ftnlen)128, ( + ftnlen)25); #line 9781 "" - stop1_(); + stop1_(); #line 9782 "" - } + } #line 9783 "" - } else if (*(unsigned char *)dumq == 'T') { - -/* Trill. may be followed by 't' and/or number. read 'til blank */ - -#line 9787 "" -L22: + goto L32; +#line 9784 "" + } else if (*(unsigned char *)dumq != ' ') { +#line 9785 "" + goto L22; +#line 9786 "" + } #line 9787 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + } else if (*(unsigned char *)dumq == 'f') { #line 9788 "" - if (*(unsigned char *)dumq == ':') { -#line 9789 "" - i__1 = a1ll_2.iccount; + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9789 "" - if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) != 0) { + if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) { #line 9790 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; #line 9790 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\ - "nk after \":\"!", (ftnlen)128, (ftnlen)25); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter after \"f\" in fermata ornament symbol!" + , (ftnlen)128, (ftnlen)55); #line 9792 "" stop1_(); #line 9793 "" } #line 9794 "" - goto L32; + if (*(unsigned char *)dumq == 'd') { +#line 9794 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 9794 "" + } +#line 9795 "" + if (*(unsigned char *)dumq == ':') { #line 9795 "" - } else if (*(unsigned char *)dumq != ' ') { + goto L32; +#line 9795 "" + } #line 9796 "" - goto L22; + } else if (*(unsigned char *)dumq == 'e') { #line 9797 "" - } + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9798 "" - } else if (*(unsigned char *)dumq == 'f') { + if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { #line 9799 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); -#line 9800 "" - if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) { -#line 9801 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9799 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter after \"e\" in edit. accid. symbol!", ( + ftnlen)128, (ftnlen)51); #line 9801 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r after \"f\" in fermata ornament symbol!", ( - ftnlen)128, (ftnlen)55); + stop1_(); +#line 9802 "" + } #line 9803 "" - stop1_(); -#line 9804 "" - } -#line 9805 "" - if (*(unsigned char *)dumq == 'd') { -#line 9805 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 9804 "" + if (*(unsigned char *)dumq == '?') { +#line 9804 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 9804 "" + } #line 9805 "" - } -#line 9806 "" - if (*(unsigned char *)dumq == ':') { -#line 9806 "" - goto L32; + } else { #line 9806 "" - } + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9807 "" - } else if (*(unsigned char *)dumq == 'e') { + } #line 9808 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { #line 9809 "" - if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { -#line 9810 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9810 "" +#line 9809 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r after \"e\" in edit. accid. symbol!", (ftnlen) - 128, (ftnlen)51); -#line 9812 "" + "r in ornament symbol!", (ftnlen)128, (ftnlen)37); +#line 9811 "" stop1_(); -#line 9813 "" +#line 9812 "" } +#line 9813 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { #line 9814 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + i__1 = a1ll_2.iccount; +#line 9814 "" + if (i_indx("0123456789", lineq + i__1, (ftnlen)10, + a1ll_2.iccount + 1 - i__1) == 0) { #line 9815 "" - if (*(unsigned char *)dumq == '?') { + i__1 = a1ll_2.iccount + 1; #line 9815 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( - ftnlen)1); + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9815 "" - } -#line 9816 "" - } else { + errmsg_(lineq, &i__1, &i__4, "There should be an int"\ + "eger here!", (ftnlen)128, (ftnlen)32); #line 9817 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + stop1_(); #line 9818 "" - } + } #line 9819 "" - if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { -#line 9820 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 9820 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ - " ornament symbol!", (ftnlen)128, (ftnlen)37); -#line 9822 "" - stop1_(); + if (*(unsigned char *)durq == ':') { +#line 9821 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9821 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift"\ + " AND repeat an ornament!", (ftnlen)128, ( + ftnlen)36); #line 9823 "" - } + stop1_(); #line 9824 "" - if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 9825 "" - i__1 = a1ll_2.iccount; -#line 9825 "" - if (i_indx("0123456789", lineq + i__1, (ftnlen)10, - a1ll_2.iccount + 1 - i__1) == 0) { -#line 9826 "" - i__1 = a1ll_2.iccount + 1; -#line 9826 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9826 "" - errmsg_(lineq, &i__1, &i__4, "There should be an integer"\ - " here!", (ftnlen)128, (ftnlen)32); + } + +/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */ + #line 9828 "" - stop1_(); + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { #line 9829 "" - } -#line 9830 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + i__1 = a1ll_2.iccount; +#line 9829 "" + if (i_indx(".0123456789", lineq + i__1, (ftnlen)11, + a1ll_2.iccount + 1 - i__1) == 0) { #line 9831 "" - if (*(unsigned char *)durq == ':') { -#line 9832 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9832 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"\ - " repeat an ornament!", (ftnlen)128, (ftnlen)36); + i__1 = a1ll_2.iccount + 1; +#line 9831 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9831 "" + errmsg_(lineq, &i__1, &i__4, "There should be a "\ + "number here!", (ftnlen)128, (ftnlen)30); +#line 9833 "" + stop1_(); #line 9834 "" - stop1_(); + } #line 9835 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 9836 "" + } +#line 9837 "" } - -/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */ - +#line 9838 "" +L32: #line 9839 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + if (*(unsigned char *)dumq == ':') { #line 9840 "" i__1 = a1ll_2.iccount; #line 9840 "" - if (i_indx(".0123456789", lineq + i__1, (ftnlen)11, - a1ll_2.iccount + 1 - i__1) == 0) { -#line 9842 "" - i__1 = a1ll_2.iccount + 1; -#line 9842 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 9841 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9842 "" - errmsg_(lineq, &i__1, &i__4, "There should be a numb"\ - "er here!", (ftnlen)128, (ftnlen)30); -#line 9844 "" +#line 9841 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must b"\ + "e followed by blank in \"o: \"!", (ftnlen)128, + (ftnlen)39); +#line 9843 "" stop1_(); +#line 9844 "" + } else if (comkeys_1.ornrpt) { #line 9845 "" - } -#line 9846 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, - (ftnlen)1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9845 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on re"\ + "peated ornaments but already on!", (ftnlen) + 128, (ftnlen)44); #line 9847 "" - } + stop1_(); #line 9848 "" - } + } #line 9849 "" -L32: + comkeys_1.ornrpt = TRUE_; #line 9850 "" - if (*(unsigned char *)dumq == ':') { -#line 9851 "" - i__1 = a1ll_2.iccount; + } #line 9851 "" - if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) != 0) { -#line 9852 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { #line 9852 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"\ - "llowed by blank in \"o: \"!", (ftnlen)128, ( - ftnlen)39); + numint = 0; +#line 9853 "" + iposn = 0; #line 9854 "" - stop1_(); +L8: +#line 9854 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); #line 9855 "" - } else if (comkeys_1.ornrpt) { + ++iposn; #line 9856 "" + if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq + == 't') { +#line 9857 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9856 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"\ - "ed ornaments but already on!", (ftnlen)128, ( - ftnlen)44); -#line 9858 "" - stop1_(); +#line 9857 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\""\ + " as an option on a tie!", (ftnlen)128, (ftnlen)37) + ; #line 9859 "" - } + stop1_(); #line 9860 "" - comkeys_1.ornrpt = TRUE_; + } #line 9861 "" - } -#line 9862 "" - } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { -#line 9863 "" - numint = 0; -#line 9864 "" - iposn = 0; -#line 9865 "" -L8: + if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == + 0) { + +/* Check for explicit ID code. */ + #line 9865 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); + ic = *(unsigned char *)dumq; #line 9866 "" - ++iposn; -#line 9867 "" - if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq == - 't') { -#line 9868 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9868 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "\ - "an option on a tie!", (ftnlen)128, (ftnlen)37); -#line 9870 "" - stop1_(); + if (ic < 48 || ic > 57 && ic < 65 || ic > 90) { + +/* Not 0-9 or A-Z, so exit */ + #line 9871 "" - } -#line 9872 "" - if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == 0) { + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9871 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter in slur symbol!", (ftnlen)128, (ftnlen) + 33); +#line 9873 "" + stop1_(); +#line 9874 "" + } else { -/* Check for explicit ID code. */ +/* It is a possible ID code. Right place? */ -#line 9876 "" - ic = *(unsigned char *)dumq; -#line 9877 "" - if (ic < 48 || ic > 57 && ic < 65 || ic > 90) { +#line 9878 "" + if (iposn != 1) { -/* Not 0-9 or A-Z, so exit */ +/* Slur ID is not 2nd! */ #line 9882 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9882 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r in slur symbol!", (ftnlen)128, (ftnlen)33); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID "\ + "must be second character in slur symbol!", + (ftnlen)128, (ftnlen)48); #line 9884 "" - stop1_(); + stop1_(); #line 9885 "" - } else { - -/* It is a possible ID code. Right place? */ - + } else if (*(unsigned char *)charq == 't' && + comslur_1.fontslur) { +#line 9886 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9886 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID "\ + "not allowed on non-postscript tie!", ( + ftnlen)128, (ftnlen)42); +#line 9888 "" + stop1_(); #line 9889 "" - if (iposn != 1) { + } else /* if(complicated condition) */ { +#line 9889 "" + i__1 = a1ll_2.iccount; +#line 9889 "" + if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 - + i__1, (ftnlen)1) == 0) { +#line 9890 "" + ++a1ll_2.iccount; +#line 9891 "" + } +#line 9891 "" + } +#line 9892 "" + } -/* Slur ID is not 2nd! */ +/* Slur ID is OK. Note it cannot be "H" at this point.. */ -#line 9893 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9893 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"\ - " be second character in slur symbol!", ( - ftnlen)128, (ftnlen)48); -#line 9895 "" - stop1_(); #line 9896 "" - } else if (*(unsigned char *)charq == 't' && - comslur_1.fontslur) { + goto L8; #line 9897 "" + } else if (*(unsigned char *)dumq == 'H') { +#line 9898 "" + if (iposn == 1) { +#line 9898 "" + goto L8; +#line 9898 "" + } + +/* "H" is NOT an ID code. */ + +#line 9902 "" + if (! comslur_1.fontslur && *(unsigned char *)charq == + 't') { +#line 9903 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9897 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "\ - "allowed on non-postscript tie!", (ftnlen)128, - (ftnlen)42); -#line 9899 "" +#line 9903 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot resha"\ + "pe postscript ties this way!", (ftnlen)128, ( + ftnlen)40); +#line 9905 "" stop1_(); -#line 9900 "" - } else /* if(complicated condition) */ { -#line 9900 "" - i__1 = a1ll_2.iccount; -#line 9900 "" - if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 - - i__1, (ftnlen)1) == 0) { -#line 9901 "" - ++a1ll_2.iccount; -#line 9902 "" - } -#line 9902 "" +#line 9906 "" } -#line 9903 "" - } - -/* Slur ID is OK. Note it cannot be "H" at this point.. */ - #line 9907 "" - goto L8; + i__1 = a1ll_2.iccount; +#line 9907 "" + if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) == 0) { #line 9908 "" - } else if (*(unsigned char *)dumq == 'H') { -#line 9909 "" - if (iposn == 1) { + ++a1ll_2.iccount; #line 9909 "" + ++iposn; +#line 9910 "" + } +#line 9911 "" goto L8; -#line 9909 "" - } +#line 9912 "" + } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && ! + comslur_1.fontslur && *(unsigned char *)charq == 't') + { -/* "H" is NOT an ID code. */ +/* 3/9/03 Can't reshape postscript tie. */ -#line 9913 "" - if (! comslur_1.fontslur && *(unsigned char *)charq == 't') { -#line 9914 "" +#line 9917 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 9914 "" +#line 9917 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"\ "ostscript ties this way!", (ftnlen)128, (ftnlen) 40); -#line 9916 "" - stop1_(); -#line 9917 "" - } -#line 9918 "" - i__1 = a1ll_2.iccount; -#line 9918 "" - if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) == 0) { #line 9919 "" - ++a1ll_2.iccount; + stop1_(); #line 9920 "" - ++iposn; -#line 9921 "" - } -#line 9922 "" - goto L8; -#line 9923 "" - } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && ! - comslur_1.fontslur && *(unsigned char *)charq == 't') { + } else if (*(unsigned char *)dumq == 'p') { -/* 3/9/03 Can't reshape postscript tie. */ +/* local change in postscript slur/tie adjustment default */ +#line 9924 "" + if (comslur_1.fontslur) { +#line 9925 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9925 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use pos"\ + "tscript slurs (\"Ap\") to use this option!", ( + ftnlen)128, (ftnlen)52); +#line 9927 "" + stop1_(); #line 9928 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9928 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"\ - "cript ties this way!", (ftnlen)128, (ftnlen)40); + } +#line 9929 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9930 "" - stop1_(); + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { #line 9931 "" - } else if (*(unsigned char *)dumq == 'p') { - -/* local change in postscript slur/tie adjustment default */ - + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9931 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \""\ + "+\" or \"-\" here!", (ftnlen)128, (ftnlen)25); +#line 9933 "" + stop1_(); +#line 9934 "" + } #line 9935 "" - if (comslur_1.fontslur) { -#line 9936 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 9936 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"\ - "ipt slurs (\"Ap\") to use this option!", (ftnlen) - 128, (ftnlen)52); -#line 9938 "" - stop1_(); + if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9937 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9937 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \""\ + "s\" or \"t\" here!", (ftnlen)128, (ftnlen)25); #line 9939 "" - } + stop1_(); #line 9940 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + } #line 9941 "" - if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9942 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + iposn += 2; #line 9942 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"\ - "r \"-\" here!", (ftnlen)128, (ftnlen)25); + goto L8; +#line 9943 "" + } #line 9944 "" - stop1_(); + if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) { #line 9945 "" - } + goto L8; #line 9946 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { #line 9947 "" - if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 9948 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + ++numint; #line 9948 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"\ - "r \"t\" here!", (ftnlen)128, (ftnlen)25); -#line 9950 "" - stop1_(); + if (comslur_1.fontslur && *(unsigned char *)charq == 't') + { +#line 9949 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9949 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for "\ + "slur height only allowed in \"s\"-slurs!", ( + ftnlen)128, (ftnlen)48); #line 9951 "" - } + stop1_(); #line 9952 "" - iposn += 2; + } #line 9953 "" - goto L8; + ++a1ll_2.iccount; #line 9954 "" - } + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 9955 "" - if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) { + if (numint == 1) { #line 9956 "" - goto L8; + if (i_nint(&fnum) > 30) { +#line 9957 "" + i__1 = a1ll_2.iccount - 1; +#line 9957 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 9957 "" - } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { -#line 9958 "" - ++numint; + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur "\ + "height adjustment cannot exceed 30!", ( + ftnlen)128, (ftnlen)53); #line 9959 "" - if (comslur_1.fontslur && *(unsigned char *)charq == 't') { -#line 9960 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 9960 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"\ - " height only allowed in \"s\"-slurs!", (ftnlen) - 128, (ftnlen)48); + } +#line 9961 "" + } else if (numint == 2) { #line 9962 "" - stop1_(); + if (dabs(fnum) > 6.3f) { #line 9963 "" - } -#line 9964 "" - ++a1ll_2.iccount; + i__1 = a1ll_2.iccount - 1; +#line 9963 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9963 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift m"\ + "ust be in range (-6.3,6.3)!", (ftnlen)128, + (ftnlen)45); #line 9965 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + stop1_(); #line 9966 "" - if (numint == 1) { + } #line 9967 "" - if (i_nint(&fnum) > 30) { -#line 9968 "" - i__1 = a1ll_2.iccount - 1; -#line 9968 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9968 "" - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\ - "ht adjustment cannot exceed 30!", (ftnlen)128, - (ftnlen)53); -#line 9970 "" - stop1_(); + } else { + +/* Third signed integer, must be a midslur or curve spec. */ + #line 9971 "" - } + if (dabs(fnum) > 31.f) { #line 9972 "" - } else if (numint == 2) { -#line 9973 "" - if (dabs(fnum) > 6.3f) { -#line 9974 "" - i__1 = a1ll_2.iccount - 1; -#line 9974 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount - 1; +#line 9972 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9972 "" + errmsg_(lineq, &i__1, &i__4, "Slur midheight mus"\ + "t be in the range (-31,31)!", (ftnlen)128, + (ftnlen)45); #line 9974 "" - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ - "be in range (-6.3,6.3)!", (ftnlen)128, ( - ftnlen)45); + stop1_(); +#line 9975 "" + } #line 9976 "" - stop1_(); -#line 9977 "" - } -#line 9978 "" - } else { + if (*(unsigned char *)durq == ':') { -/* Third signed integer, must be a midslur or curve spec. */ +/* Expecting curve parameters. Get two numbers */ +#line 9980 "" + for (i__ = 1; i__ <= 2; ++i__) { +#line 9981 "" + ++a1ll_2.iccount; #line 9982 "" - if (dabs(fnum) > 31.f) { -#line 9983 "" - i__1 = a1ll_2.iccount - 1; + fnum = (real) (*(unsigned char *)&lineq[ + a1ll_2.iccount - 1] - 48); #line 9983 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 9983 "" - errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"\ - " in the range (-31,31)!", (ftnlen)128, ( - ftnlen)45); -#line 9985 "" - stop1_(); + if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { +#line 9984 "" + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9984 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, + "Slur curve parameter must be in"\ + " range (0,7)!", (ftnlen)128, ( + ftnlen)44); #line 9986 "" - } + stop1_(); #line 9987 "" - if (*(unsigned char *)durq == ':') { - -/* Expecting curve parameters. Get two numbers */ - + } +#line 9988 "" +/* L41: */ +#line 9988 "" + } +#line 9989 "" + ++a1ll_2.iccount; +#line 9990 "" + } #line 9991 "" - for (i__ = 1; i__ <= 2; ++i__) { + } #line 9992 "" - ++a1ll_2.iccount; + --a1ll_2.iccount; #line 9993 "" - fnum = (real) (*(unsigned char *)&lineq[ - a1ll_2.iccount - 1] - 48); + goto L8; #line 9994 "" - if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { -#line 9995 "" - i__1 = c1omnotes_1.ibarcnt - - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; -#line 9995 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"\ - " curve parameter must be in range (0"\ - ",7)!", (ftnlen)128, (ftnlen)44); -#line 9997 "" - stop1_(); -#line 9998 "" - } -#line 9999 "" -/* L41: */ + } else if (*(unsigned char *)dumq == 's') { + +/* What follows should be one or two signed numbers for adjustment of line break */ +/* slur, end of 1st segment or start of second. */ + #line 9999 "" - } + if (comslur_1.fontslur) { #line 10000 "" - ++a1ll_2.iccount; -#line 10001 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10000 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use "\ + "linebreak slur options with font-based slurs!" + , (ftnlen)128, (ftnlen)57); #line 10002 "" - } + stop1_(); #line 10003 "" - --a1ll_2.iccount; + } #line 10004 "" - goto L8; + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); #line 10005 "" - } else if (*(unsigned char *)dumq == 's') { - -/* What follows should be one or two signed numbers for adjustment of line break */ -/* slur, end of 1st segment or start of second. */ - + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10006 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10006 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ + "er must be \"+\" or \"-\"!", (ftnlen)128, ( + ftnlen)34); +#line 10008 "" + stop1_(); +#line 10009 "" + } #line 10010 "" - if (comslur_1.fontslur) { -#line 10011 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + ++a1ll_2.iccount; #line 10011 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"\ - "break slur options with font-based slurs!", ( - ftnlen)128, (ftnlen)57); + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 10012 "" + if (i_nint(&fnum) > 30) { #line 10013 "" - stop1_(); -#line 10014 "" - } + i__1 = a1ll_2.iccount - 1; +#line 10013 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10013 "" + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\ + "ht adjustment cannot exceed 30!", (ftnlen)128, + (ftnlen)53); #line 10015 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) - 1); + stop1_(); #line 10016 "" - if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { -#line 10017 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10017 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"\ - "ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34); + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 10018 "" + ++a1ll_2.iccount; #line 10019 "" - stop1_(); + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen) + 128, (ftnlen)1); #line 10020 "" - } + if (dabs(fnum) > 6.3f) { #line 10021 "" - ++a1ll_2.iccount; -#line 10022 "" - readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( - ftnlen)1); + i__1 = a1ll_2.iccount - 1; +#line 10021 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10021 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift m"\ + "ust be in range (-6.3,6.3)!", (ftnlen)128, + (ftnlen)45); #line 10023 "" - if (i_nint(&fnum) > 30) { -#line 10024 "" - i__1 = a1ll_2.iccount - 1; -#line 10024 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10024 "" - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"\ - "djustment cannot exceed 30!", (ftnlen)128, ( - ftnlen)53); + } +#line 10025 "" + } #line 10026 "" - stop1_(); + --a1ll_2.iccount; #line 10027 "" - } + goto L8; #line 10028 "" - if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { + } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { #line 10029 "" - ++a1ll_2.iccount; + i__1 = a1ll_2.iccount; +#line 10029 "" + if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) == 0) { +#line 10029 "" + ++a1ll_2.iccount; +#line 10029 "" + } #line 10030 "" - readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, - (ftnlen)1); + goto L8; #line 10031 "" - if (dabs(fnum) > 6.3f) { -#line 10032 "" - i__1 = a1ll_2.iccount - 1; -#line 10032 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10032 "" - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ - "be in range (-6.3,6.3)!", (ftnlen)128, ( - ftnlen)45); + } else if (*(unsigned char *)charq == '?') { +#line 10033 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) + ; #line 10034 "" - stop1_(); + if (*(unsigned char *)durq == ' ') { #line 10035 "" - } + --a1ll_2.iccount; #line 10036 "" - } + } else { #line 10037 "" - --a1ll_2.iccount; + if (*(unsigned char *)durq != '-') { #line 10038 "" - goto L8; -#line 10039 "" - } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { -#line 10040 "" - i__1 = a1ll_2.iccount; -#line 10040 "" - if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) == 0) { -#line 10040 "" - ++a1ll_2.iccount; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10038 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting"\ + " \"-\"!", (ftnlen)128, (ftnlen)14); #line 10040 "" - } + stop1_(); #line 10041 "" - goto L8; + } #line 10042 "" - } + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10043 "" - } else if (*(unsigned char *)charq == '?') { + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == + 0) { #line 10044 "" - getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 10045 "" - if (*(unsigned char *)durq == ' ') { + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10044 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting nu"\ + "mber!", (ftnlen)128, (ftnlen)17); #line 10046 "" - --a1ll_2.iccount; + stop1_(); #line 10047 "" - } else { + } #line 10048 "" - if (*(unsigned char *)durq != '-') { -#line 10049 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 10049 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!", - (ftnlen)128, (ftnlen)14); -#line 10051 "" - stop1_(); -#line 10052 "" - } -#line 10053 "" - getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) - ; -#line 10054 "" - if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 10055 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10055 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!" - , (ftnlen)128, (ftnlen)17); -#line 10057 "" - stop1_(); -#line 10058 "" + --a1ll_2.iccount; +#line 10050 "" } -#line 10059 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 10060 "" - --a1ll_2.iccount; -#line 10061 "" - } -#line 10062 "" - } else if (*(unsigned char *)charq >= 48 && *(unsigned char *)charq <= - 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen)1) > 0) { +#line 10051 "" + } else if (*(unsigned char *)charq >= 48 && *(unsigned char *) + charq <= 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen) + 1) > 0) { /* We have a figure. Must come AFTER the note it goes under */ -#line 10067 "" - if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (! a1ll_2.firstline - || a1ll_2.lenbr0 == 0 || a1ll_2.lenbar == a1ll_2.lenbr0)) - { +#line 10056 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (! + a1ll_2.firstline || a1ll_2.lenbr0 == 0 || + a1ll_2.lenbar == a1ll_2.lenbr0)) { /* Figure before first note in block */ +#line 10061 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10061 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figur"\ + "e before first note in block!", (ftnlen)128, ( + ftnlen)45); +#line 10063 "" + stop1_(); +#line 10064 "" + } +#line 10065 "" + if (*(unsigned char *)charq == 'x') { +#line 10066 "" + indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - ( + a1ll_2.iccount - 1), (ftnlen)1); +#line 10067 "" + if (indxb < 5) { +#line 10068 "" + i__1 = a1ll_2.iccount + indxb - 1; +#line 10068 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10068 "" + errmsg_(lineq, &i__1, &i__4, "Cannot have a blank he"\ + "re in floating figure!", (ftnlen)128, (ftnlen) + 44); +#line 10070 "" + stop1_(); +#line 10071 "" + } #line 10072 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10072 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"\ - "fore first note in block!", (ftnlen)128, (ftnlen)45); + } +#line 10073 "" + if (compage_1.usefig) { +#line 10073 "" + *ifig = 1; +#line 10073 "" + } #line 10074 "" - stop1_(); +L5: +#line 10074 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); #line 10075 "" - } + if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, ( + ftnlen)1) == 0) { #line 10076 "" - if (*(unsigned char *)charq == 'x') { -#line 10077 "" - indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - ( - a1ll_2.iccount - 1), (ftnlen)1); -#line 10078 "" - if (indxb < 5) { -#line 10079 "" - i__1 = a1ll_2.iccount + indxb - 1; -#line 10079 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10079 "" - errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"\ - "n floating figure!", (ftnlen)128, (ftnlen)44); -#line 10081 "" +#line 10076 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r in figure!", (ftnlen)128, (ftnlen)28); +#line 10078 "" stop1_(); -#line 10082 "" - } +#line 10079 "" + } else if (*(unsigned char *)charq == '+') { + +/* vertical offset, must be integer, then blank */ + #line 10083 "" - } -#line 10084 "" - if (compage_1.usefig) { -#line 10084 "" - *ifig = 1; + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, ( + ftnlen)1); #line 10084 "" - } + if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) + { #line 10085 "" -L5: + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10085 "" - g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 10086 "" - if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (ftnlen)1) - == 0) { -#line 10087 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for "\ + "vertical offset expected here!", (ftnlen)128, + (ftnlen)42); #line 10087 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ - " figure!", (ftnlen)128, (ftnlen)28); + stop1_(); +#line 10088 "" + } #line 10089 "" - stop1_(); + readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen) + 128, (ftnlen)1); #line 10090 "" - } else if (*(unsigned char *)charq == '+') { - -/* vertical offset, must be integer, then blank */ - + if (*(unsigned char *)charq != ' ') { +#line 10091 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10091 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical off"\ + "set must terminate figure!", (ftnlen)128, ( + ftnlen)38); +#line 10093 "" + stop1_(); #line 10094 "" - g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) - 1); + } #line 10095 "" - if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) { -#line 10096 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + --a1ll_2.iccount; #line 10096 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"\ - "ical offset expected here!", (ftnlen)128, (ftnlen) - 42); + goto L5; +#line 10097 "" + } else if (*(unsigned char *)charq == 's') { #line 10098 "" - stop1_(); + comligfont_1.isligfont = TRUE_; #line 10099 "" } #line 10100 "" - readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 10101 "" if (*(unsigned char *)charq != ' ') { +#line 10100 "" + goto L5; +#line 10100 "" + } +#line 10101 "" + } else if (*(unsigned char *)charq == '[') { #line 10102 "" + if (c1omget_1.fbon) { +#line 10103 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10102 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "\ - "must terminate figure!", (ftnlen)128, (ftnlen)38); -#line 10104 "" - stop1_(); +#line 10103 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced b"\ + "eam while another was open!", (ftnlen)128, ( + ftnlen)43); #line 10105 "" - } + stop1_(); #line 10106 "" - --a1ll_2.iccount; + } #line 10107 "" - goto L5; + c1omget_1.fbon = TRUE_; +#line 10108 "" +L17: #line 10108 "" - } else if (*(unsigned char *)charq == 's') { + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); #line 10109 "" - comligfont_1.isligfont = TRUE_; + if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) { #line 10110 "" - } + goto L17; #line 10111 "" - if (*(unsigned char *)charq != ' ') { -#line 10111 "" - goto L5; -#line 10111 "" - } + } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { #line 10112 "" - } else if (*(unsigned char *)charq == '[') { + ++a1ll_2.iccount; #line 10113 "" - if (c1omget_1.fbon) { -#line 10114 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 10114 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "\ - "while another was open!", (ftnlen)128, (ftnlen)43); + --a1ll_2.iccount; +#line 10115 "" + goto L17; #line 10116 "" - stop1_(); -#line 10117 "" - } -#line 10118 "" - c1omget_1.fbon = TRUE_; -#line 10119 "" -L17: -#line 10119 "" - g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); + } else if (*(unsigned char *)charq == 'm') { + +/* Forced multiplicity, next char should be 1-4 */ + #line 10120 "" - if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) { + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, ( + ftnlen)1); #line 10121 "" - goto L17; + if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) { #line 10122 "" - } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { -#line 10123 "" - ++a1ll_2.iccount; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10122 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multi"\ + "plicity for a beam must be 1, 2, 3, or 4!", ( + ftnlen)128, (ftnlen)53); #line 10124 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + stop1_(); #line 10125 "" - --a1ll_2.iccount; + } #line 10126 "" - goto L17; + goto L17; #line 10127 "" - } else if (*(unsigned char *)charq == 'm') { - -/* Forced multiplicity, next char should be 1-4 */ - + } else if (*(unsigned char *)charq != ' ') { +#line 10128 "" + if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > + 0) { +#line 10129 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10129 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\","\ + " digits must now be preceeded by \"+\" or \"-"\ + "\"!", (ftnlen)128, (ftnlen)54); #line 10131 "" - g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) - 1); + s_wsle(&io___662); +#line 10131 "" + do_lio(&c__9, &c__1, "You will have to edit older so"\ + "urces to meet this rqmt,", (ftnlen)54); +#line 10131 "" + e_wsle(); +#line 10132 "" + s_wsle(&io___663); +#line 10132 "" + do_lio(&c__9, &c__1, "but it was needed to allow 2-d"\ + "igit height adjustments.", (ftnlen)54); #line 10132 "" - if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) { + e_wsle(); #line 10133 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + s_wsle(&io___664); #line 10133 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"\ - "ity for a beam must be 1, 2, 3, or 4!", (ftnlen) - 128, (ftnlen)53); + do_lio(&c__9, &c__1, "Sorry for the inconvenience. "\ + "--The Management", (ftnlen)46); +#line 10133 "" + e_wsle(); +#line 10134 "" + } else { #line 10135 "" - stop1_(); -#line 10136 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10135 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter after [!", (ftnlen)128, (ftnlen)26); #line 10137 "" - goto L17; + } #line 10138 "" - } else if (*(unsigned char *)charq != ' ') { + stop1_(); #line 10139 "" - if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) { + } #line 10140 "" + } else if (*(unsigned char *)charq == ']') { +#line 10141 "" + if (! c1omget_1.fbon) { +#line 10142 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10140 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\ - "its must now be preceeded by \"+\" or \"-\"!", ( - ftnlen)128, (ftnlen)54); -#line 10142 "" - s_wsle(&io___662); #line 10142 "" - do_lio(&c__9, &c__1, "You will have to edit older source"\ - "s to meet this rqmt,", (ftnlen)54); -#line 10142 "" - e_wsle(); -#line 10143 "" - s_wsle(&io___663); -#line 10143 "" - do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"\ - " height adjustments.", (ftnlen)54); -#line 10143 "" - e_wsle(); -#line 10144 "" - s_wsle(&io___664); -#line 10144 "" - do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"\ - "e Management", (ftnlen)46); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop"\ + " with no corresponding start!", (ftnlen)128, ( + ftnlen)45); #line 10144 "" - e_wsle(); + stop1_(); #line 10145 "" - } else { -#line 10146 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10146 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r after [!", (ftnlen)128, (ftnlen)26); + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); +#line 10147 "" + if (*(unsigned char *)charq == '-') { #line 10148 "" - } + i__1 = a1ll_2.iccount; +#line 10148 "" + if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, ( + ftnlen)2) != 0) { #line 10149 "" - stop1_(); -#line 10150 "" - } + i__1 = a1ll_2.iccount + 1; +#line 10149 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10149 "" + errmsg_(lineq, &i__1, &i__4, "Only sequence allowed "\ + "here is \"[ \"!", (ftnlen)128, (ftnlen)35); #line 10151 "" - } else if (*(unsigned char *)charq == ']') { + stop1_(); #line 10152 "" - if (! c1omget_1.fbon) { -#line 10153 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } else { #line 10153 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"\ - "h no corresponding start!", (ftnlen)128, (ftnlen)45); + a1ll_2.iccount += 2; +#line 10154 "" + } #line 10155 "" - stop1_(); + } else if (*(unsigned char *)charq == '[') { #line 10156 "" - } + i__1 = a1ll_2.iccount; +#line 10156 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { #line 10157 "" - g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 10158 "" - if (*(unsigned char *)charq == '-') { -#line 10159 "" - i__1 = a1ll_2.iccount; + i__1 = a1ll_2.iccount + 1; +#line 10157 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10157 "" + errmsg_(lineq, &i__1, &i__4, "This character must be"\ + " a blank!", (ftnlen)128, (ftnlen)31); #line 10159 "" - if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, ( - ftnlen)2) != 0) { -#line 10160 "" - i__1 = a1ll_2.iccount + 1; -#line 10160 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10160 "" - errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"\ - " is \"[ \"!", (ftnlen)128, (ftnlen)35); -#line 10162 "" - stop1_(); -#line 10163 "" + } +#line 10161 "" } else { -#line 10164 "" - a1ll_2.iccount += 2; + +/* Forced beam is really ending */ + #line 10165 "" - } + c1omget_1.fbon = FALSE_; #line 10166 "" - } else if (*(unsigned char *)charq == '[') { + if (*(unsigned char *)charq == 'j') { #line 10167 "" - i__1 = a1ll_2.iccount; + i__1 = a1ll_2.iccount; #line 10167 "" - if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) != 0) { + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - + i__1, (ftnlen)1) != 0) { #line 10168 "" - i__1 = a1ll_2.iccount + 1; + i__1 = a1ll_2.iccount + 1; #line 10168 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10168 "" - errmsg_(lineq, &i__1, &i__4, "This character must be a b"\ - "lank!", (ftnlen)128, (ftnlen)31); + errmsg_(lineq, &i__1, &i__4, "This character mus"\ + "t be a blank!", (ftnlen)128, (ftnlen)31); #line 10170 "" - stop1_(); + stop1_(); #line 10171 "" - } + } #line 10172 "" - } else { - -/* Forced beam is really ending */ - + } else if (*(unsigned char *)charq != ' ') { +#line 10173 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10173 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must b"\ + "e followed by blank, \"j\", \"-\", or \"[\"!", + (ftnlen)128, (ftnlen)48); +#line 10175 "" + stop1_(); #line 10176 "" - c1omget_1.fbon = FALSE_; + } #line 10177 "" - if (*(unsigned char *)charq == 'j') { -#line 10178 "" - i__1 = a1ll_2.iccount; + } #line 10178 "" - if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) != 0) { -#line 10179 "" - i__1 = a1ll_2.iccount + 1; -#line 10179 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10179 "" - errmsg_(lineq, &i__1, &i__4, "This character must be"\ - " a blank!", (ftnlen)128, (ftnlen)31); -#line 10181 "" - stop1_(); + } else if (*(unsigned char *)charq == 'D') { + +/* Dynamic mark */ + #line 10182 "" - } + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { #line 10183 "" - } else if (*(unsigned char *)charq != ' ') { -#line 10184 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10184 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"\ - "llowed by blank, \"j\", \"-\", or \"[\"!", ( - ftnlen)128, (ftnlen)48); -#line 10186 "" +#line 10183 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not c"\ + "ome before any notes have been entered!", (ftnlen) + 128, (ftnlen)53); +#line 10185 "" stop1_(); -#line 10187 "" +#line 10186 "" } +#line 10187 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10187 "" + checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128); #line 10188 "" - } -#line 10189 "" - } else if (*(unsigned char *)charq == 'D') { + } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) { -/* Dynamic mark */ +/* Save position for later check */ +#line 10192 "" + icclhw = a1ll_2.iccount; #line 10193 "" - if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { -#line 10194 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10194 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "\ - "before any notes have been entered!", (ftnlen)128, ( - ftnlen)53); -#line 10196 "" - stop1_(); + if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == + 0) { +#line 10195 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10195 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after \"l\", \"w\", or \"h\"!", (ftnlen)128, ( + ftnlen)41); #line 10197 "" - } -#line 10198 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; + stop1_(); #line 10198 "" - checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128); + } #line 10199 "" - } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) { - -/* Save position for later check */ - -#line 10203 "" - icclhw = a1ll_2.iccount; -#line 10204 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 10205 "" - if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) { -#line 10206 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10206 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ - "ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41) - ; -#line 10208 "" - stop1_(); -#line 10209 "" - } -#line 10210 "" - c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq - == 'h'; -#line 10211 "" - if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) { + c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *) + charq == 'h'; +#line 10200 "" + if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) { /* There is a header (or lower string?) */ -#line 10215 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 10204 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* User-defined vert offset (\internote). */ -#line 10219 "" - if (*(unsigned char *)charq != 'h') { -#line 10220 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10220 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""\ - "-\" not permitted here!", (ftnlen)128, ( - ftnlen)30); -#line 10222 "" - stop1_(); -#line 10223 "" - } +#line 10208 "" + if (*(unsigned char *)charq != 'h') { +#line 10209 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10209 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" "\ + "or \"-\" not permitted here!", (ftnlen) + 128, (ftnlen)30); +#line 10211 "" + stop1_(); +#line 10212 "" + } /* Have "h" followed by +/- . Check for digit. */ /* Can blow durq since not using fnum for now, but... */ -#line 10228 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 10229 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) - { -#line 10230 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10230 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"\ - "e a digit here!", (ftnlen)128, (ftnlen)27); -#line 10232 "" - stop1_(); -#line 10233 "" - } +#line 10217 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10218 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == + 0) { +#line 10219 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10219 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There mu"\ + "st be a digit here!", (ftnlen)128, ( + ftnlen)27); +#line 10221 "" + stop1_(); +#line 10222 "" + } /* Have "h" followed by +/- followed by a digit. No need to get the number. */ /* call readnum(lineq,iccount,durq,fnum) */ -#line 10238 "" - } -#line 10239 "" - if (*(unsigned char *)charq != 'w') { +#line 10227 "" + } +#line 10228 "" + if (*(unsigned char *)charq != 'w') { /* Header or lower string. */ +#line 10232 "" + if (icclhw != 1) { +#line 10233 "" + i__1 = a1ll_2.iccount - 1; +#line 10233 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10233 "" + errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" mus"\ + "t be first character in line!", (ftnlen) + 128, (ftnlen)43); +#line 10235 "" + stop1_(); +#line 10236 "" + } + +/* Read past the next line, which has the string. */ + +#line 10240 "" + read10_(charq, &c1omget_1.lastchar, (ftnlen)1); +#line 10241 "" + ++c1omget_1.nline; +#line 10242 "" + a1ll_2.iccount = 128; #line 10243 "" - if (icclhw != 1) { -#line 10244 "" - i__1 = a1ll_2.iccount - 1; + } else { #line 10244 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; #line 10244 "" - errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"\ - " first character in line!", (ftnlen)128, ( - ftnlen)43); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\""\ + " (width) must be followed by a digit!", ( + ftnlen)128, (ftnlen)47); #line 10246 "" stop1_(); #line 10247 "" } +#line 10248 "" + } else { -/* Read past the next line, which has the string. */ +/* Height or width change spec. Check if at start of piece. */ -#line 10251 "" - read10_(charq, &c1omget_1.lastchar, (ftnlen)1); #line 10252 "" - ++c1omget_1.nline; + if (c1omnotes_1.ibarcnt > 0) { #line 10253 "" - a1ll_2.iccount = 128; -#line 10254 "" - } else { -#line 10255 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10253 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must "\ + "go at top of first input block!", (ftnlen)128, + (ftnlen)43); #line 10255 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"\ - "dth) must be followed by a digit!", (ftnlen)128, ( - ftnlen)47); + stop1_(); +#line 10256 "" + } #line 10257 "" - stop1_(); -#line 10258 "" - } -#line 10259 "" - } else { + readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen) + 128, (ftnlen)1); -/* Height or width change spec. Check if at start of piece. */ +/* Check units. Convert to points */ +#line 10261 "" + if (*(unsigned char *)durq == ' ' || *(unsigned char *) + durq == 'p') { +#line 10262 "" + dimen += .5f; #line 10263 "" - if (c1omnotes_1.ibarcnt > 0) { -#line 10264 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } else if (*(unsigned char *)durq == 'i') { #line 10264 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"\ - "t top of first input block!", (ftnlen)128, ( - ftnlen)43); + dimen = dimen * 72 + .5f; +#line 10265 "" + } else if (*(unsigned char *)durq == 'm') { #line 10266 "" - stop1_(); + dimen = dimen / 25.4f * 72 + .5f; #line 10267 "" - } + } else { #line 10268 "" - readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, ( - ftnlen)1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10268 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit"\ + "; must be \"p\",\"i\",or\"m\"!", (ftnlen)128, + (ftnlen)36); +#line 10270 "" + stop1_(); +#line 10271 "" + } -/* Check units. Convert to points */ +/* 151211 fix. May have extra character. */ -#line 10272 "" - if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq == - 'p') { -#line 10273 "" - dimen += .5f; -#line 10274 "" - } else if (*(unsigned char *)durq == 'i') { #line 10275 "" - dimen = dimen * 72 + .5f; -#line 10276 "" - } else if (*(unsigned char *)durq == 'm') { -#line 10277 "" - dimen = dimen / 25.4f * 72 + .5f; -#line 10278 "" - } else { + if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Get another character, see if it's blank */ + #line 10279 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount; #line 10279 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"\ - "st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen) - 36); -#line 10281 "" - stop1_(); + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - + i__1, (ftnlen)1) != 0) { +#line 10280 "" + i__1 = a1ll_2.iccount + 1; +#line 10280 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10280 "" + errmsg_(lineq, &i__1, &i__4, "This character sho"\ + "uld be a blank!", (ftnlen)128, (ftnlen)33) + ; #line 10282 "" + stop1_(); +#line 10283 "" + } +#line 10284 "" + } +#line 10285 "" + if (*(unsigned char *)charq == 'h') { +#line 10286 "" + compage_1.ptheight = (real) ((integer) dimen); +#line 10287 "" + } else { +#line 10288 "" + compage_1.widthpt = (real) ((integer) dimen); +#line 10289 "" + } +#line 10290 "" } +#line 10291 "" + } else if (*(unsigned char *)charq == 'm') { -/* 151211 fix. May have extra character. */ - -#line 10286 "" - if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) { +/* Time signature change. Only allow at beginning of block. */ +/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */ +/* mtrnuml=0 initially. (In common) */ -/* Get another character, see if it's blank */ +/* Check whether at beginning of a block */ -#line 10290 "" - i__1 = a1ll_2.iccount; -#line 10290 "" - if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( - ftnlen)1) != 0) { -#line 10291 "" - i__1 = a1ll_2.iccount + 1; -#line 10291 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10291 "" - errmsg_(lineq, &i__1, &i__4, "This character should "\ - "be a blank!", (ftnlen)128, (ftnlen)33); -#line 10293 "" - stop1_(); -#line 10294 "" - } -#line 10295 "" - } -#line 10296 "" - if (*(unsigned char *)charq == 'h') { -#line 10297 "" - compage_1.ptheight = (real) ((integer) dimen); -#line 10298 "" - } else { #line 10299 "" - compage_1.widthpt = (real) ((integer) dimen); + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { #line 10300 "" - } -#line 10301 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10300 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change onl"\ + "y OK in voice 1, at start of block!", (ftnlen)128, + (ftnlen)51); #line 10302 "" - } else if (*(unsigned char *)charq == 'm') { - -/* Time signature change. Only allow at beginning of block. */ -/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */ -/* mtrnuml=0 initially. (In common) */ - -/* Check whether at beginning of a block */ - + s_wsle(&io___667); +#line 10302 "" + do_lio(&c__9, &c__1, "voice number is", (ftnlen)15); +#line 10302 "" + do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen) + sizeof(integer)); +#line 10302 "" + e_wsle(); +#line 10303 "" + stop1_(); +#line 10304 "" + } +#line 10305 "" + a1ll_2.newmeter = TRUE_; +#line 10306 "" + i__1 = a1ll_2.iccount; +#line 10306 "" + if (i_indx("o0123456789", lineq + i__1, (ftnlen)11, + a1ll_2.iccount + 1 - i__1) == 0) { +#line 10307 "" + i__1 = a1ll_2.iccount + 1; +#line 10307 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10307 "" + errmsg_(lineq, &i__1, &i__4, "Illegal character in \"m\""\ + " command for meter change!", (ftnlen)128, (ftnlen) + 50); +#line 10309 "" + stop1_(); #line 10310 "" - if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { -#line 10311 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10311 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\ - " in voice 1, at start of block!", (ftnlen)128, ( - ftnlen)51); + readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, + (ftnlen)128); +#line 10312 "" + if (a1ll_2.mtrnuml == 0) { #line 10313 "" - s_wsle(&io___667); -#line 10313 "" - do_lio(&c__9, &c__1, "voice number is", (ftnlen)15); + i__1 = a1ll_2.iccount - 1; #line 10313 "" - do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof( - integer)); + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10313 "" - e_wsle(); -#line 10314 "" - stop1_(); + errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", + (ftnlen)128, (ftnlen)25); #line 10315 "" - } + stop1_(); #line 10316 "" - a1ll_2.newmeter = TRUE_; -#line 10317 "" - i__1 = a1ll_2.iccount; + } #line 10317 "" - if (i_indx("o0123456789", lineq + i__1, (ftnlen)11, - a1ll_2.iccount + 1 - i__1) == 0) { -#line 10318 "" - i__1 = a1ll_2.iccount + 1; -#line 10318 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10318 "" - errmsg_(lineq, &i__1, &i__4, "Illegal character in \"m\" com"\ - "mand for meter change!", (ftnlen)128, (ftnlen)50); -#line 10320 "" - stop1_(); + readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen) + 128); + +/* Read past printed time signature; not used in pmxa. */ + #line 10321 "" - } + lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); #line 10322 "" - readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, ( - ftnlen)128); + lenmult = 1; #line 10323 "" - if (a1ll_2.mtrnuml == 0) { -#line 10324 "" - i__1 = a1ll_2.iccount - 1; -#line 10324 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + if (mtrdenl == 2) { #line 10324 "" - errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", ( - ftnlen)128, (ftnlen)25); + lenbeat = 16; +#line 10325 "" + lenmult = 2; #line 10326 "" - stop1_(); + } #line 10327 "" - } + a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat; #line 10328 "" - readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128); - -/* Read past printed time signature; not used in pmxa. */ - -#line 10332 "" - lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); + a1ll_2.mtrnuml = 0; +#line 10329 "" + } else if (*(unsigned char *)charq == 'C') { +#line 10330 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10331 "" + if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || * + (unsigned char *)durq >= 48 && *(unsigned char *)durq + <= 56)) { +#line 10333 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10333 "" - lenmult = 1; -#line 10334 "" - if (mtrdenl == 2) { + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,"\ + "a,n,r,b,f or 0-8 after C!", (ftnlen)128, (ftnlen) + 41); #line 10335 "" - lenbeat = 16; + stop1_(); #line 10336 "" - lenmult = 2; + } #line 10337 "" - } + } else if (*(unsigned char *)charq == 'R') { #line 10338 "" - a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat; + if (c1ommvl_1.ivx != 1) { #line 10339 "" - a1ll_2.mtrnuml = 0; -#line 10340 "" - } else if (*(unsigned char *)charq == 'C') { + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10339 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only"\ + " go in voice 1!", (ftnlen)128, (ftnlen)31); #line 10341 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + stop1_(); #line 10342 "" - if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *( - unsigned char *)durq >= 48 && *(unsigned char *)durq <= - 56)) { -#line 10344 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10344 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n,"\ - "r,b,f or 0-8 after C!", (ftnlen)128, (ftnlen)41); -#line 10346 "" - stop1_(); -#line 10347 "" - } -#line 10348 "" - } else if (*(unsigned char *)charq == 'R') { -#line 10349 "" - if (c1ommvl_1.ivx != 1) { -#line 10350 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10350 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "\ - "in voice 1!", (ftnlen)128, (ftnlen)31); -#line 10352 "" - stop1_(); -#line 10353 "" - } + } /* 10 call g1etchar(lineq,iccount,durq) */ /* if (index('lrdDbz',durq) .gt. 0) go to 10 */ /* if (durq .ne. ' ') then */ @@ -25190,704 +25240,730 @@ L17: /* * 'Illegal character after "R" (repeat/double bar)!') */ /* call stop1() */ /* end if */ -#line 10361 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 10362 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); +#line 10350 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10351 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); /* Writing concatenation */ +#line 10352 "" + i__3[0] = 1, a__2[0] = durq; +#line 10352 "" + i__3[1] = 1, a__2[1] = dumq; +#line 10352 "" + s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2); +#line 10352 "" + if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, ( + ftnlen)2) == 0) { +#line 10353 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10353 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after \"R*\" (repeat/double bar)!", (ftnlen)128, + (ftnlen)49); +#line 10355 "" + stop1_(); +#line 10356 "" + } +#line 10357 "" + if (*(unsigned char *)dumq != ' ') { +#line 10358 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10359 "" + if (*(unsigned char *)durq != ' ') { +#line 10360 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10360 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have bl"\ + "ank after \"R**\" (repeat/double bar)!", ( + ftnlen)128, (ftnlen)48); +#line 10362 "" + stop1_(); #line 10363 "" - i__3[0] = 1, a__2[0] = durq; -#line 10363 "" - i__3[1] = 1, a__2[1] = dumq; -#line 10363 "" - s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2); -#line 10363 "" - if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, (ftnlen) - 2) == 0) { -#line 10364 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10364 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ - "ter \"R*\" (repeat/double bar)!", (ftnlen)128, ( - ftnlen)49); -#line 10366 "" - stop1_(); -#line 10367 "" - } -#line 10368 "" - if (*(unsigned char *)dumq != ' ') { + } +#line 10365 "" + } else if (*(unsigned char *)charq == 'V') { + +/* Ending */ + #line 10369 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + if (a1ll_2.iv != 1) { #line 10370 "" - if (*(unsigned char *)durq != ' ') { -#line 10371 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10371 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have blank "\ - "after \"R**\" (repeat/double bar)!", (ftnlen)128, - (ftnlen)48); -#line 10373 "" +#line 10370 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only "\ + "allowed in voice #1!", (ftnlen)128, (ftnlen)36); +#line 10372 "" stop1_(); +#line 10373 "" + } else if (c1omget_1.isvolt) { #line 10374 "" - } + s_wsle(&io___673); +#line 10374 "" + e_wsle(); #line 10375 "" - } + s_wsle(&io___674); +#line 10375 "" + do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22) + ; +#line 10375 "" + e_wsle(); #line 10376 "" - } else if (*(unsigned char *)charq == 'V') { - -/* Ending */ - + s_wsfe(&io___675); +#line 10376 "" + do_fio(&c__1, "*******WARNING********", (ftnlen)22); +#line 10376 "" + e_wsfe(); +#line 10377 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10377 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more th"\ + "an one volta in this input block.!", (ftnlen)128, + (ftnlen)50); +#line 10379 "" + s_wsle(&io___676); +#line 10379 "" + do_lio(&c__9, &c__1, "This may work in a score, but WILL"\ + " NOT work in parts.", (ftnlen)53); +#line 10379 "" + e_wsle(); #line 10380 "" - if (a1ll_2.iv != 1) { -#line 10381 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10381 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"\ - "wed in voice #1!", (ftnlen)128, (ftnlen)36); -#line 10383 "" - stop1_(); + s_wsle(&io___677); +#line 10380 "" + do_lio(&c__9, &c__1, "Safest to have only 1 volta per bl"\ + "ock, at the start of the block", (ftnlen)64); +#line 10380 "" + e_wsle(); +#line 10382 "" + s_wsfe(&io___678); +#line 10382 "" + do_fio(&c__1, "This may work in a score, but WILL NOT wo"\ + "rk in parts.", (ftnlen)53); +#line 10382 "" + e_wsfe(); #line 10384 "" - } else if (c1omget_1.isvolt) { -#line 10385 "" - s_wsle(&io___673); -#line 10385 "" - e_wsle(); -#line 10386 "" - s_wsle(&io___674); -#line 10386 "" - do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22); + s_wsfe(&io___679); +#line 10384 "" + do_fio(&c__1, "Safest to have only 1 volta per block, at"\ + " the start of the block", (ftnlen)64); +#line 10384 "" + e_wsfe(); #line 10386 "" - e_wsle(); -#line 10387 "" - s_wsfe(&io___675); -#line 10387 "" - do_fio(&c__1, "*******WARNING********", (ftnlen)22); + } #line 10387 "" - e_wsfe(); -#line 10388 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + c1omget_1.isvolt = TRUE_; #line 10388 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\ - "ne volta in this input block.!", (ftnlen)128, (ftnlen) - 50); -#line 10390 "" - s_wsle(&io___676); -#line 10390 "" - do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"\ - " work in parts.", (ftnlen)53); + lvoltxt = 0; +#line 10389 "" +L11: +#line 10389 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10390 "" - e_wsle(); -#line 10391 "" - s_wsle(&io___677); -#line 10391 "" - do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"\ - " at the start of the block", (ftnlen)64); + if (*(unsigned char *)durq != ' ') { #line 10391 "" - e_wsle(); -#line 10393 "" - s_wsfe(&io___678); -#line 10393 "" - do_fio(&c__1, "This may work in a score, but WILL NOT work i"\ - "n parts.", (ftnlen)53); + goto L11; +#line 10392 "" + } #line 10393 "" - e_wsfe(); + } else if (*(unsigned char *)charq == 'B') { #line 10395 "" - s_wsfe(&io___679); -#line 10395 "" - do_fio(&c__1, "Safest to have only 1 volta per block, at the"\ - " start of the block", (ftnlen)64); -#line 10395 "" - e_wsfe(); + } else if (*(unsigned char *)charq == 'P') { +#line 10396 "" + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { #line 10397 "" - } -#line 10398 "" - c1omget_1.isvolt = TRUE_; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10397 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at "\ + "beginning of block!", (ftnlen)128, (ftnlen)35); #line 10399 "" - lvoltxt = 0; -#line 10400 "" -L11: + stop1_(); #line 10400 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + } #line 10401 "" - if (*(unsigned char *)durq != ' ') { +L16: +#line 10401 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10402 "" - goto L11; -#line 10403 "" - } + if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq == + 'r' || *(unsigned char *)durq >= 48 && *(unsigned + char *)durq <= 57) { +#line 10402 "" + goto L16; +#line 10402 "" + } #line 10404 "" - } else if (*(unsigned char *)charq == 'B') { -#line 10406 "" - } else if (*(unsigned char *)charq == 'P') { -#line 10407 "" - if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { -#line 10408 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10408 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"\ - "nning of block!", (ftnlen)128, (ftnlen)35); -#line 10410 "" - stop1_(); -#line 10411 "" - } -#line 10412 "" -L16: -#line 10412 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 10413 "" - if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq == - 'r' || *(unsigned char *)durq >= 48 && *(unsigned char *) - durq <= 57) { -#line 10413 "" - goto L16; -#line 10413 "" - } -#line 10415 "" - if (*(unsigned char *)durq == 'c') { + if (*(unsigned char *)durq == 'c') { /* Expect a centered name, and it has to be last option */ +#line 10408 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10409 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 10409 "" + if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0]) + { + +/* Quoted name, go to next quote mark */ + +#line 10413 "" + for (++a1ll_2.iccount; a1ll_2.iccount <= 127; + ++a1ll_2.iccount) { +#line 10414 "" + i__1 = a1ll_2.iccount - 2; +#line 10414 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 10414 "" + chax_(ch__4, (ftnlen)1, &c__92); +#line 10414 "" + if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] + == *(unsigned char *)&ch__2[0] && s_cmp( + lineq + i__1, ch__4, a1ll_2.iccount - 1 - + i__1, (ftnlen)1) != 0) { +#line 10414 "" + goto L36; +#line 10414 "" + } +#line 10416 "" +/* L35: */ +#line 10416 "" + } +#line 10417 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10417 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing clos"\ + "e quote after page number command (P)!", ( + ftnlen)128, (ftnlen)50); #line 10419 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + stop1_(); #line 10420 "" - if (*(unsigned char *)durq == '"') { +L36: +#line 10421 "" + ; +#line 10421 "" + } else if (*(unsigned char *)durq != ' ') { -/* Quoted name, go to next quote mark */ +/* Space-delimited name, look for next blank */ -#line 10424 "" - for (++a1ll_2.iccount; a1ll_2.iccount <= 127; - ++a1ll_2.iccount) { -#line 10425 "" - i__1 = a1ll_2.iccount - 2; -#line 10425 "" - if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == - '"' && s_cmp(lineq + i__1, "\\", - a1ll_2.iccount - 1 - i__1, (ftnlen)1) != 0) { -#line 10425 "" - goto L36; #line 10425 "" - } + for (++a1ll_2.iccount; a1ll_2.iccount <= 127; + ++a1ll_2.iccount) { +#line 10426 "" + if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] + == ' ') { +#line 10426 "" + goto L38; +#line 10426 "" + } #line 10427 "" -/* L35: */ +/* L37: */ #line 10427 "" - } + } #line 10428 "" +L38: +#line 10429 "" + ; +#line 10429 "" + } +#line 10430 "" + } else if (*(unsigned char *)durq != ' ') { +#line 10431 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10428 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"\ - "ote after page number command (P)!", (ftnlen)128, - (ftnlen)50); -#line 10430 "" - stop1_(); #line 10431 "" -L36: -#line 10432 "" - ; -#line 10432 "" - } else if (*(unsigned char *)durq != ' ') { - -/* Space-delimited name, look for next blank */ - + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\""\ + "r\",\"c\" or digit allowed after \"P\"!", (ftnlen) + 128, (ftnlen)44); +#line 10433 "" + stop1_(); +#line 10434 "" + } +#line 10435 "" + } else if (*(unsigned char *)charq == 'W') { #line 10436 "" - for (++a1ll_2.iccount; a1ll_2.iccount <= 127; - ++a1ll_2.iccount) { -#line 10437 "" - if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == - ' ') { -#line 10437 "" - goto L38; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10437 "" - } + if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) { #line 10438 "" -/* L37: */ + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10438 "" - } -#line 10439 "" -L38: -#line 10440 "" - ; + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a numbe"\ + "r to start here!", (ftnlen)128, (ftnlen)32); #line 10440 "" - } + stop1_(); #line 10441 "" - } else if (*(unsigned char *)durq != ' ') { -#line 10442 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 10442 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""\ - "c\" or digit allowed after \"P\"!", (ftnlen)128, ( - ftnlen)44); -#line 10444 "" - stop1_(); -#line 10445 "" - } -#line 10446 "" - } else if (*(unsigned char *)charq == 'W') { + readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[ + c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, ( + ftnlen)1); +#line 10443 "" + } else if (*(unsigned char *)charq == 'T') { + +/* Titles */ + #line 10447 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10448 "" - if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) { + if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) { #line 10449 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10449 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"\ - " start here!", (ftnlen)128, (ftnlen)32); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\","\ + " \"t\", or \"c\" after \"T\"!", (ftnlen)128, ( + ftnlen)36); #line 10451 "" - stop1_(); + stop1_(); #line 10452 "" - } + } #line 10453 "" - readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[ - c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen) - 1); -#line 10454 "" - } else if (*(unsigned char *)charq == 'T') { + i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1; +#line 10453 "" + c1omget_1.ihead += pow_ii(&c__2, &i__1); -/* Titles */ +/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */ +#line 10457 "" + read10_(charq, &c1omget_1.lastchar, (ftnlen)1); #line 10458 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + ++c1omget_1.nline; #line 10459 "" - if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) { -#line 10460 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + a1ll_2.iccount = 128; #line 10460 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""\ - "t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36); + } else if (*(unsigned char *)charq == 'A') { +#line 10461 "" +L27: +#line 10461 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); #line 10462 "" - stop1_(); + if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) { #line 10463 "" - } -#line 10464 "" - i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1; + goto L27; #line 10464 "" - c1omget_1.ihead += pow_ii(&c__2, &i__1); + } else if (*(unsigned char *)durq == 'e') { -/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */ +/* Check for is4bignv. Must do here to catch first \internote, written in topfile */ +/* before ever calling getnote. Initialize as .false. in pmxa. Make it true only */ +/* if nv>7, AI not set, Ai not set. */ -#line 10468 "" - read10_(charq, &c1omget_1.lastchar, (ftnlen)1); -#line 10469 "" - ++c1omget_1.nline; #line 10470 "" - a1ll_2.iccount = 128; + comis4bignv_1.is4bignv = a1ll_2.nv > 7 && ! + comis4bignv_1.aiset; #line 10471 "" - } else if (*(unsigned char *)charq == 'A') { -#line 10472 "" -L27: + goto L27; #line 10472 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -/* if (index('rbsdeK',durq) .gt. 0) then */ + } else if (*(unsigned char *)durq == 'v') { +#line 10473 "" + if (c1omnotes_1.ibarcnt == 0) { +#line 10473 "" + comnvst_1.novshrinktop = TRUE_; +#line 10473 "" + } #line 10474 "" - if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) { + goto L27; #line 10475 "" - goto L27; + } else if (*(unsigned char *)durq == 'a') { #line 10476 "" - } else if (*(unsigned char *)durq == 'e') { - -/* Check for is4bignv. Must do here to catch first \internote, written in topfile */ -/* before ever calling getnote. Initialize as .false. in pmxa. Make it true only */ -/* if nv>7, AI not set, Ai not set. */ - + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10477 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == + 0) { +#line 10478 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10478 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\""\ + ", need decimal number!", (ftnlen)128, (ftnlen) + 32); +#line 10480 "" + stop1_(); +#line 10481 "" + } #line 10482 "" - comis4bignv_1.is4bignv = a1ll_2.nv > 7 && ! - comis4bignv_1.aiset; + readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, ( + ftnlen)128, (ftnlen)1); #line 10483 "" - goto L27; + --a1ll_2.iccount; #line 10484 "" - } else if (*(unsigned char *)durq == 'v') { + goto L27; #line 10485 "" - if (c1omnotes_1.ibarcnt == 0) { -#line 10485 "" - comnvst_1.novshrinktop = TRUE_; -#line 10485 "" - } + } else if (*(unsigned char *)durq == 'i') { #line 10486 "" - goto L27; + comis4bignv_1.is4bignv = FALSE_; #line 10487 "" - } else if (*(unsigned char *)durq == 'a') { + comis4bignv_1.aiset = TRUE_; #line 10488 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); -#line 10489 "" - if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 10490 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10490 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"\ - "ed decimal number!", (ftnlen)128, (ftnlen)32); -#line 10492 "" - stop1_(); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); + +/* Local interstaff correction. Set to -1. if not specifiec, or after use, */ +/* or anytime except at top, since pmxb handles all times except at top. */ + #line 10493 "" - } + readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen) + 128, (ftnlen)1); #line 10494 "" - readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, ( - ftnlen)128, (ftnlen)1); + if (c1omnotes_1.ibarcnt == 0) { +#line 10494 "" + compage_1.fintstf = tintstf; +#line 10494 "" + } #line 10495 "" - --a1ll_2.iccount; + --a1ll_2.iccount; #line 10496 "" - goto L27; + goto L27; #line 10497 "" - } else if (*(unsigned char *)durq == 'i') { -#line 10498 "" - comis4bignv_1.is4bignv = FALSE_; -#line 10499 "" - comis4bignv_1.aiset = TRUE_; -#line 10500 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + } else if (*(unsigned char *)durq == 'I') { -/* Local interstaff correction. Set to -1. if not specifiec, or after use, */ -/* or anytime except at top, since pmxb handles all times except at top. */ +/* Global interstaff correction. Use in place of fintstf if fintstf<0 */ +#line 10501 "" + comis4bignv_1.is4bignv = FALSE_; +#line 10502 "" + comis4bignv_1.aiset = TRUE_; +#line 10503 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10504 "" + readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, + (ftnlen)128, (ftnlen)1); #line 10505 "" - readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128, - (ftnlen)1); -#line 10506 "" - if (c1omnotes_1.ibarcnt == 0) { -#line 10506 "" - compage_1.fintstf = tintstf; + --a1ll_2.iccount; #line 10506 "" - } + goto L27; #line 10507 "" - --a1ll_2.iccount; + } else if (*(unsigned char *)durq == 'o') { #line 10508 "" - goto L27; + *optimize = TRUE_; #line 10509 "" - } else if (*(unsigned char *)durq == 'I') { - -/* Global interstaff correction. Use in place of fintstf if fintstf<0 */ - + goto L27; +#line 10510 "" + } else if (*(unsigned char *)durq == 'S') { +#line 10511 "" + i__1 = comkeys_1.noinst; +#line 10511 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 10512 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10513 "" - comis4bignv_1.is4bignv = FALSE_; + if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) { #line 10514 "" - comis4bignv_1.aiset = TRUE_; -#line 10515 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10514 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \""\ + "AS\", need nv instances of \"s,t,-,0\"!", + (ftnlen)128, (ftnlen)43); #line 10516 "" - readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, ( - ftnlen)128, (ftnlen)1); + stop1_(); #line 10517 "" - --a1ll_2.iccount; + } #line 10518 "" - goto L27; + if (*(unsigned char *)durq == '-' || *(unsigned char * + )durq == 's') { #line 10519 "" - } else if (*(unsigned char *)durq == 'o') { + comsize_1.isize[iiv - 1] = 1; #line 10520 "" - *optimize = TRUE_; + } else if (*(unsigned char *)durq == 't') { #line 10521 "" - goto L27; + comsize_1.isize[iiv - 1] = 2; #line 10522 "" - } else if (*(unsigned char *)durq == 'S') { + } #line 10523 "" - i__1 = comkeys_1.noinst; +/* L50: */ #line 10523 "" - for (iiv = 1; iiv <= i__1; ++iiv) { + } #line 10524 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + goto L27; #line 10525 "" - if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) { + } else if (*(unsigned char *)durq == 'p') { #line 10526 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10526 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""\ - ", need nv instances of \"s,t,-,0\"!", (ftnlen) - 128, (ftnlen)43); + comslur_1.fontslur = FALSE_; +#line 10527 "" +L42: #line 10528 "" - stop1_(); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10529 "" - } -#line 10530 "" - if (*(unsigned char *)durq == '-' || *(unsigned char *) - durq == 's') { -#line 10531 "" - comsize_1.isize[iiv - 1] = 1; -#line 10532 "" - } else if (*(unsigned char *)durq == 't') { + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Characters to change defaults for ps slurs */ + #line 10533 "" - comsize_1.isize[iiv - 1] = 2; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10534 "" - } + if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) { #line 10535 "" -/* L50: */ + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10535 "" - } -#line 10536 "" - goto L27; + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only let"\ + "ters allowed here are \"s\",\"h\",\"t\""\ + ",\"c\"!", (ftnlen)128, (ftnlen)46); #line 10537 "" - } else if (*(unsigned char *)durq == 'p') { + stop1_(); #line 10538 "" - comslur_1.fontslur = FALSE_; -#line 10539 "" -L42: -#line 10540 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); -#line 10541 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + } -/* Characters to change defaults for ps slurs */ +/* Now check for another default modifier */ + +#line 10542 "" + goto L42; +#line 10543 "" + } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Flags for optional linebreak ties or header specials */ -#line 10545 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 10546 "" - if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) { -#line 10547 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; #line 10547 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"\ - " allowed here are \"s\",\"h\",\"t\",\"c\"!", ( - ftnlen)128, (ftnlen)46); + goto L42; +#line 10548 "" + } else { #line 10549 "" - stop1_(); + --a1ll_2.iccount; #line 10550 "" } +#line 10551 "" + goto L27; +#line 10552 "" + } else if (*(unsigned char *)durq == 'N') { -/* Now check for another default modifier */ - -#line 10554 "" - goto L42; -#line 10555 "" - } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) { - -/* Flags for optional linebreak ties or header specials */ +/* Override default name for a part file. Must have part number, then */ +/* partname in quotes. Must be on line by itself, and start in column 1. */ +/* Will only be passed thru to scor2prt. */ +#line 10558 "" + if (a1ll_2.iccount != 2) { #line 10559 "" - goto L42; -#line 10560 "" - } else { + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10559 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must "\ + "start in column 1!", (ftnlen)128, (ftnlen)28); #line 10561 "" - --a1ll_2.iccount; + stop1_(); #line 10562 "" - } + } #line 10563 "" - goto L27; + chax_(ch__2, (ftnlen)1, &c__34); +#line 10563 "" + ndxquote = i_indx(lineq, ch__2, (ftnlen)128, (ftnlen)1); #line 10564 "" - } else if (*(unsigned char *)durq == 'N') { - -/* Override default name for a part file. Must have part number, then */ -/* partname in quotes. Must be on line by itself, and start in column 1. */ -/* Will only be passed thru to scor2prt. */ - -#line 10570 "" - if (a1ll_2.iccount != 2) { + if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789", + lineq + 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote + == 5 && i_indx("012", lineq + 3, (ftnlen)3, ( + ftnlen)1) == 0) { +#line 10567 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10567 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must "\ + "be followed by inst. #, then quote!", (ftnlen) + 128, (ftnlen)45); +#line 10569 "" + stop1_(); +#line 10570 "" + } #line 10571 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = ndxquote; #line 10571 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"\ - "t in column 1!", (ftnlen)128, (ftnlen)28); + chax_(ch__2, (ftnlen)1, &c__34); +#line 10571 "" + ndxquote = i_indx(lineq + i__1, ch__2, 128 - i__1, ( + ftnlen)1); +#line 10572 "" + if (ndxquote == 0) { #line 10573 "" - stop1_(); -#line 10574 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10573 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", f"\ + "ile name must be in quotes!", (ftnlen)128, ( + ftnlen)37); #line 10575 "" - ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1); + stop1_(); #line 10576 "" - if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789", lineq - + 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote == 5 && - i_indx("012", lineq + 3, (ftnlen)3, (ftnlen)1) == 0) { -#line 10579 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } +#line 10577 "" + a1ll_2.iccount = 128; +#line 10578 "" + } else if (*(unsigned char *)durq == 'T') { #line 10579 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"\ - "ollowed by inst. #, then quote!", (ftnlen)128, ( - ftnlen)45); -#line 10581 "" - stop1_(); -#line 10582 "" - } -#line 10583 "" - i__1 = ndxquote; -#line 10583 "" - ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); + comnvst_1.cstuplet = TRUE_; +#line 10580 "" + } else if (*(unsigned char *)durq == 'R') { + +/* Get full name of normal include file; must occupy remainder of line */ + #line 10584 "" - if (ndxquote == 0) { -#line 10585 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount; +#line 10584 "" + getpmxmod_(&c_false, lineq + i__1, 128 - i__1); #line 10585 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "\ - "name must be in quotes!", (ftnlen)128, (ftnlen)37) - ; + a1ll_2.iccount = 128; +#line 10586 "" + } else if (*(unsigned char *)durq == 'c') { #line 10587 "" - stop1_(); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10588 "" - } + if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) { #line 10589 "" - a1ll_2.iccount = 128; -#line 10590 "" - } else if (*(unsigned char *)durq == 'T') { + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10589 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" o"\ + "r \"4\" is allowed here!", (ftnlen)128, ( + ftnlen)32); #line 10591 "" - comnvst_1.cstuplet = TRUE_; + stop1_(); #line 10592 "" - } else if (*(unsigned char *)durq == 'R') { - -/* Get full name of normal include file; must occupy remainder of line */ - -#line 10596 "" - i__1 = a1ll_2.iccount; + } +#line 10593 "" + if (*(unsigned char *)durq == 'l') { +#line 10594 "" + compage_1.hoffpt = -25.f; +#line 10595 "" + compage_1.voffpt = -45.f; #line 10596 "" - getpmxmod_(&c_false, lineq + i__1, 128 - i__1); + } else if (*(unsigned char *)durq == '4') { #line 10597 "" - a1ll_2.iccount = 128; + compage_1.ptheight = 745.f; #line 10598 "" - } else if (*(unsigned char *)durq == 'c') { + compage_1.widthpt = 499.f; #line 10599 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + compage_1.hoffpt = -24.f; #line 10600 "" - if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 10601 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + compage_1.voffpt = -24.f; #line 10601 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"\ - " \"4\" is allowed here!", (ftnlen)128, (ftnlen)32) - ; + } +#line 10602 "" + goto L27; #line 10603 "" - stop1_(); + } else if (*(unsigned char *)durq == 'V') { #line 10604 "" - } + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10605 "" - if (*(unsigned char *)durq == 'l') { + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10606 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10606 "" - compage_1.hoffpt = -25.f; -#line 10607 "" - compage_1.voffpt = -45.f; + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" o"\ + "r \"-\" is allowed here!", (ftnlen)128, ( + ftnlen)32); #line 10608 "" - } else if (*(unsigned char *)durq == '4') { + stop1_(); #line 10609 "" - compage_1.ptheight = 745.f; + } #line 10610 "" - compage_1.widthpt = 499.f; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10611 "" - compage_1.hoffpt = -24.f; + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == + 0) { #line 10612 "" - compage_1.voffpt = -24.f; -#line 10613 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10612 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for"\ + " vert shift before \\eject must start here!", + (ftnlen)128, (ftnlen)54); #line 10614 "" - goto L27; + stop1_(); #line 10615 "" - } else if (*(unsigned char *)durq == 'V') { + } #line 10616 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 10617 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { #line 10618 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10618 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\ - " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32) - ; + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" o"\ + "r \"-\" is allowed here!", (ftnlen)128, ( + ftnlen)32); #line 10620 "" - stop1_(); + stop1_(); #line 10621 "" - } + } #line 10622 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10623 "" - if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == + 0) { #line 10624 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10624 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\ - "t shift before \\eject must start here!", (ftnlen) - 128, (ftnlen)54); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for"\ + " vert shift after \\eject must start here!", ( + ftnlen)128, (ftnlen)53); #line 10626 "" - stop1_(); + stop1_(); #line 10627 "" - } + } #line 10628 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 10629 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { + --a1ll_2.iccount; #line 10630 "" + goto L27; +#line 10631 "" + } else if (*(unsigned char *)durq != ' ') { +#line 10632 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; -#line 10630 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\ - " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32) - ; #line 10632 "" - stop1_(); -#line 10633 "" - } -#line 10634 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must"\ + " follow one of abcdeiILNprRsSTvV!", (ftnlen)128, ( + ftnlen)47); +/* * 'After "A" must follow one of the letters abcdeiINprRsST!') */ +#line 10635 "" + s_wsle(&io___684); #line 10635 "" - if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { + do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only "\ + "have noinst args.", (ftnlen)51); +#line 10635 "" + e_wsle(); #line 10636 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + s_wsfe(&io___685); #line 10636 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\ - "t shift after \\eject must start here!", (ftnlen) - 128, (ftnlen)53); + do_fio(&c__1, "For AS, since ver. 2.7, must only have no"\ + "inst args.", (ftnlen)51); +#line 10636 "" + e_wsfe(); #line 10638 "" stop1_(); #line 10639 "" } #line 10640 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 10641 "" - --a1ll_2.iccount; -#line 10642 "" - goto L27; -#line 10643 "" - } else if (*(unsigned char *)durq != ' ') { -#line 10644 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10644 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"\ - "low one of abcdeiILNprRsSTvV!", (ftnlen)128, (ftnlen) - 47); -/* * 'After "A" must follow one of the letters abcdeiINprRsST!') */ -#line 10647 "" - s_wsle(&io___684); -#line 10647 "" - do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"\ - " noinst args.", (ftnlen)51); -#line 10647 "" - e_wsle(); -#line 10648 "" - s_wsfe(&io___685); -#line 10648 "" - do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"\ - " args.", (ftnlen)51); -#line 10648 "" - e_wsfe(); -#line 10650 "" - stop1_(); -#line 10651 "" - } -#line 10652 "" - } else if (*(unsigned char *)charq == 'K') { + } else if (*(unsigned char *)charq == 'K') { /* Rules and function of K command */ @@ -25898,166 +25974,171 @@ L42: /* then adjust fbar to make poenom much more accurate. */ /* Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. */ -#line 10663 "" +#line 10651 "" L77: -#line 10664 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10652 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); /* if (index('+-i',durq) .eq. 0) then */ -#line 10666 "" - if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) { -#line 10667 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10667 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "\ - "key change) must be followed by \"+,-,i,n\"!", ( - ftnlen)128, (ftnlen)60); -#line 10669 "" - stop1_(); -#line 10670 "" - } -#line 10671 "" - if (*(unsigned char *)durq == 'n') { -#line 10671 "" - goto L77; -#line 10671 "" - } -#line 10672 "" - if (*(unsigned char *)durq != 'i') { +#line 10654 "" + if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 10655 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10655 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose"\ + " or key change) must be followed by \"+,-,i,n\"!", + (ftnlen)128, (ftnlen)60); +#line 10657 "" + stop1_(); +#line 10658 "" + } +#line 10659 "" + if (*(unsigned char *)durq == 'n') { +#line 10659 "" + goto L77; +#line 10659 "" + } +#line 10660 "" + if (*(unsigned char *)durq != 'i') { /* Normal key change and/or transposition) */ /* iccount = iccount+1 */ -#line 10677 "" - num1 = 44 - *(unsigned char *)durq; +#line 10665 "" + num1 = 44 - *(unsigned char *)durq; /* num1= +1 or -1 */ +#line 10669 "" + ztrans = num1 == -1; +#line 10670 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10671 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == + 0) { +#line 10672 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10672 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must"\ + " be followed by a number!", (ftnlen)128, ( + ftnlen)37); +#line 10674 "" + stop1_(); +#line 10675 "" + } +/* iccount = iccount+1 */ +#line 10677 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 10678 "" + num1 = i_nint(&fnum) * num1; +#line 10679 "" + ztrans = ztrans && num1 == 0; +#line 10680 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { #line 10681 "" - ztrans = num1 == -1; -#line 10682 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10681 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number a"\ + "fter \"K\" must be followed by \"+,-\"!", ( + ftnlen)128, (ftnlen)47); #line 10683 "" - if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 10684 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10684 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "\ - "followed by a number!", (ftnlen)128, (ftnlen)37); + } +#line 10685 "" + ++a1ll_2.iccount; #line 10686 "" - stop1_(); + num2 = 44 - *(unsigned char *)durq; #line 10687 "" - } -/* iccount = iccount+1 */ + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 10688 "" + num2 *= (integer) (fnum + .1f); #line 10689 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 10690 "" - num1 = i_nint(&fnum) * num1; -#line 10691 "" - ztrans = ztrans && num1 == 0; -#line 10692 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 10693 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + if (num1 == 0 && ! ztrans) { + +/* Key change, only one per block allowed */ + #line 10693 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"\ - "er \"K\" must be followed by \"+,-\"!", (ftnlen) - 128, (ftnlen)47); -#line 10695 "" - stop1_(); + if (comkeys_1.iskchb) { +#line 10694 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10694 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one"\ + " key change allowed per input block!", ( + ftnlen)128, (ftnlen)44); #line 10696 "" - } + stop1_(); #line 10697 "" - ++a1ll_2.iccount; + } #line 10698 "" - num2 = 44 - *(unsigned char *)durq; + comkeys_1.iskchb = TRUE_; #line 10699 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + ++comkeys_1.nkeys; #line 10700 "" - num2 *= (integer) (fnum + .1f); -#line 10701 "" - if (num1 == 0 && ! ztrans) { + comkeys_1.kchmid[comkeys_1.nkeys - 1] = + a1ll_2.itsofar[c1ommvl_1.ivx - 1] % + a1ll_2.lenbar != 0; -/* Key change, only one per block allowed */ +/* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */ +#line 10704 "" + comkeys_1.ibrkch[comkeys_1.nkeys - 1] = + c1omnotes_1.ibarcnt + a1ll_2.nbars; #line 10705 "" - if (comkeys_1.iskchb) { -#line 10706 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) { +#line 10705 "" + ++comkeys_1.ibrkch[comkeys_1.nkeys - 1]; +#line 10705 "" + } #line 10706 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"\ - " change allowed per input block!", (ftnlen) - 128, (ftnlen)44); -#line 10708 "" - stop1_(); + comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 + + comkeys_1.idsig; +/* 130316 */ +/* do 43 iinst = 1 , noinst */ #line 10709 "" - } -#line 10710 "" - comkeys_1.iskchb = TRUE_; + commidisig_1.midisig = comkeys_1.newkey[ + comkeys_1.nkeys - 1]; +/* 43 continue */ #line 10711 "" - ++comkeys_1.nkeys; -#line 10712 "" - comkeys_1.kchmid[comkeys_1.nkeys - 1] = a1ll_2.itsofar[ - c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0; + } else { -/* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */ +/* Transposition */ +#line 10715 "" + *fulltrans = TRUE_; #line 10716 "" - comkeys_1.ibrkch[comkeys_1.nkeys - 1] = - c1omnotes_1.ibarcnt + a1ll_2.nbars; -#line 10717 "" - if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) { + if (c1omnotes_1.ibarcnt > 0) { #line 10717 "" - ++comkeys_1.ibrkch[comkeys_1.nkeys - 1]; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10717 "" - } -#line 10718 "" - comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 + - comkeys_1.idsig; -/* 130316 */ -/* do 43 iinst = 1 , noinst */ + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpos"\ + "ition must be at top of first input bloc"\ + "k!", (ftnlen)128, (ftnlen)50); +#line 10719 "" + stop1_(); +#line 10720 "" + } #line 10721 "" - commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys - - 1]; -/* 43 continue */ -#line 10723 "" - } else { - -/* Transposition */ - -#line 10727 "" - *fulltrans = TRUE_; -#line 10728 "" - if (c1omnotes_1.ibarcnt > 0) { -#line 10729 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10729 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"\ - "n must be at top of first input block!", ( - ftnlen)128, (ftnlen)50); -#line 10731 "" - stop1_(); -#line 10732 "" - } -#line 10733 "" - comkeys_1.isig1 = num2; -#line 10734 "" - comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[0]; + comkeys_1.isig1 = num2; +#line 10722 "" + comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[ + 0]; /* idsig is the difference between sig after transposition, and sig in setup. */ /* It may alter # of accid's in key changes if there is transposition. */ -#line 10739 "" - } -#line 10740 "" - } else { +#line 10727 "" + } +#line 10728 "" + } else { /* 110522/110529 */ /* Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */ @@ -26071,1212 +26152,1279 @@ L77: /* each staff. */ /* durq='i' */ -#line 10753 "" - getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, & - a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, & - comkeys_1.noinst, (ftnlen)128); -#line 10755 "" - } -#line 10756 "" - } else if (*(unsigned char *)charq == '|') { +#line 10741 "" + getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, & + a1ll_2.iccount, &c1omnotes_1.ibaroff, & + a1ll_2.nbars, &comkeys_1.noinst, (ftnlen)128); +#line 10743 "" + } +#line 10744 "" + } else if (*(unsigned char *)charq == '|') { /* Optional bar symbol */ -#line 10760 "" - if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { -#line 10761 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; +#line 10748 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { +#line 10749 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10749 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker "\ + "out of place!", (ftnlen)128, (ftnlen)29); +#line 10751 "" + stop1_(); +#line 10752 "" + } else if (comkeys_1.shifton) { +#line 10753 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10753 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with u"\ + "ser-defined shift still on!", (ftnlen)128, ( + ftnlen)43); +#line 10755 "" + stop1_(); +#line 10756 "" + } +#line 10757 "" + } else /* if(complicated condition) */ { +#line 10757 "" + chax_(ch__2, (ftnlen)1, &c__47); +#line 10757 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) { +#line 10758 "" + if (comkeys_1.ornrpt) { +#line 10759 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10759 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Blo"\ + "ck ended with repeated ornament still on!", ( + ftnlen)128, (ftnlen)53); #line 10761 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "\ - "of place!", (ftnlen)128, (ftnlen)29); + comkeys_1.ornrpt = FALSE_; +#line 10762 "" + } #line 10763 "" - stop1_(); + if (comkeys_1.stickys) { #line 10764 "" - } else if (comkeys_1.shifton) { -#line 10765 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10765 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ - "defined shift still on!", (ftnlen)128, (ftnlen)43); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10764 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Blo"\ + "ck ended with sticky stemshrink still on!", ( + ftnlen)128, (ftnlen)53); +#line 10766 "" + comkeys_1.stickys = FALSE_; #line 10767 "" - stop1_(); + } #line 10768 "" - } + if (c1omget_1.fbon) { #line 10769 "" - } else if (*(unsigned char *)charq == '/') { -#line 10770 "" - if (comkeys_1.ornrpt) { -#line 10771 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10769 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended "\ + "with forced beam open!", (ftnlen)128, (ftnlen) + 34); #line 10771 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ - " with repeated ornament still on!", (ftnlen)128, ( - ftnlen)53); + stop1_(); +#line 10772 "" + } else if (comkeys_1.shifton) { #line 10773 "" - comkeys_1.ornrpt = FALSE_; -#line 10774 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10773 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended wi"\ + "th user-defined shift still on!", (ftnlen)128, + (ftnlen)43); #line 10775 "" - if (comkeys_1.stickys) { -#line 10776 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10776 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ - " with sticky stemshrink still on!", (ftnlen)128, ( - ftnlen)53); -#line 10778 "" - comkeys_1.stickys = FALSE_; -#line 10779 "" - } -#line 10780 "" - if (c1omget_1.fbon) { -#line 10781 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } +#line 10777 "" + comkeys_1.barend = FALSE_; + +/* Perform time checks */ + #line 10781 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"\ - "ced beam open!", (ftnlen)128, (ftnlen)34); -#line 10783 "" - stop1_(); + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != + 0) { +#line 10782 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10782 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block durati"\ + "on not divisible by lenbar!", (ftnlen)128, ( + ftnlen)39); #line 10784 "" - } else if (comkeys_1.shifton) { -#line 10785 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + s_wsle(&io___689); +#line 10784 "" + do_lio(&c__9, &c__1, "lenbar, timesofar are ", ( + ftnlen)22); +#line 10784 "" + do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen) + sizeof(integer)); +#line 10784 "" + do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[ + c1ommvl_1.ivx - 1], (ftnlen)sizeof(integer)); +#line 10784 "" + e_wsle(); #line 10785 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ - "defined shift still on!", (ftnlen)128, (ftnlen)43); + stop1_(); +#line 10786 "" + } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[ + c1ommvl_1.ivx - 1] != a1ll_2.itsofar[0]) { #line 10787 "" - stop1_(); - -/* 140215 Temporary to allow clef change in stup */ - -/* else if (gotclef) then */ -/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ -/* * 'May not enter clef at end of input block!') */ -/* call stop1() */ + s_wsle(&io___690); +#line 10787 "" + e_wsle(); +#line 10788 "" + s_wsle(&io___691); +#line 10788 "" + do_lio(&c__9, &c__1, "No of bars in voice 1, current"\ + " voice:", (ftnlen)37); +#line 10788 "" + i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar; +#line 10788 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof( + integer)); +#line 10788 "" + i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / + a1ll_2.lenbar; +#line 10788 "" + do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof( + integer)); +#line 10788 "" + e_wsle(); +#line 10790 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10790 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block durati"\ + "on not equal to voice 1!", (ftnlen)128, ( + ftnlen)36); +#line 10792 "" + stop1_(); +#line 10793 "" + } +#line 10794 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10795 "" - } -#line 10796 "" - comkeys_1.barend = FALSE_; + if (*(unsigned char *)durq == ' ' && a1ll_2.iv == + a1ll_2.nv) { -/* Perform time checks */ +/* End of input block */ +#line 10799 "" + *loop = FALSE_; #line 10800 "" - if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { -#line 10801 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10801 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\ - "ivisible by lenbar!", (ftnlen)128, (ftnlen)39); -#line 10803 "" - s_wsle(&io___689); -#line 10803 "" - do_lio(&c__9, &c__1, "lenbar, timesofar are ", (ftnlen)22); -#line 10803 "" - do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof( - integer)); -#line 10803 "" - do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[c1ommvl_1.ivx - - 1], (ftnlen)sizeof(integer)); -#line 10803 "" - e_wsle(); + } else { + +/* Start a new voice */ + #line 10804 "" - stop1_(); + if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) { +#line 10804 "" + a1ll_2.lenbar = a1ll_2.lenbr0; +#line 10804 "" + } #line 10805 "" - } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1] - != a1ll_2.itsofar[0]) { + a1ll_2.nbars = 0; #line 10806 "" - s_wsle(&io___690); -#line 10806 "" - e_wsle(); -#line 10807 "" - s_wsle(&io___691); -#line 10807 "" - do_lio(&c__9, &c__1, "No of bars in voice 1, current voice:", - (ftnlen)37); -#line 10807 "" - i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar; -#line 10807 "" - do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 10807 "" - i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; -#line 10807 "" - do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 10807 "" - e_wsle(); -#line 10809 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10809 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"\ - "qual to voice 1!", (ftnlen)128, (ftnlen)36); + if (*(unsigned char *)durq == ' ') { + +/* New voice is on next staff */ + +#line 10810 "" + ++a1ll_2.iv; #line 10811 "" - stop1_(); + c1ommvl_1.ivx = a1ll_2.iv; #line 10812 "" - } -#line 10813 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 10814 "" - if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) { + } else { -/* End of input block */ +/* New voice is on same staff. Set up for it */ +#line 10816 "" + c1ommvl_1.ivx = a1ll_2.nv + 1; +#line 10817 "" + i__1 = a1ll_2.nv; +#line 10817 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 10818 "" + if (c1ommvl_1.nvmx[iiv - 1] == 2) { +#line 10818 "" + ++c1ommvl_1.ivx; #line 10818 "" - *loop = FALSE_; + } #line 10819 "" - } else { - -/* Start a new voice */ - -#line 10823 "" - if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) { -#line 10823 "" - a1ll_2.lenbar = a1ll_2.lenbr0; +/* L23: */ +#line 10819 "" + } +#line 10820 "" + if (c1ommvl_1.ivx > 24) { +#line 10821 "" + s_wsfe(&io___692); +#line 10821 "" + do_fio(&c__1, "Cannot have more than", ( + ftnlen)21); +#line 10821 "" + do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof( + integer)); +#line 10821 "" + do_fio(&c__1, " lines of music at once", ( + ftnlen)23); +#line 10821 "" + e_wsfe(); #line 10823 "" - } + stop1_(); #line 10824 "" - a1ll_2.nbars = 0; + } #line 10825 "" - if (*(unsigned char *)durq == ' ') { - -/* New voice is on next staff */ - + c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2; +#line 10826 "" + c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx; +#line 10827 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; +#line 10828 "" + a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0; #line 10829 "" - ++a1ll_2.iv; + for (j = 1; j <= 200; ++j) { #line 10830 "" - c1ommvl_1.ivx = a1ll_2.iv; + a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = + FALSE_; #line 10831 "" - } else { + c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = + 0; +#line 10832 "" +/* L24: */ +#line 10832 "" + } -/* New voice is on same staff. Set up for it */ +/* For midi stuff, record that there is a 2nd line of music in this voice */ -#line 10835 "" - c1ommvl_1.ivx = a1ll_2.nv + 1; #line 10836 "" - i__1 = a1ll_2.nv; + if (commidi_1.ismidi) { #line 10836 "" - for (iiv = 1; iiv <= i__1; ++iiv) { -#line 10837 "" - if (c1ommvl_1.nvmx[iiv - 1] == 2) { -#line 10837 "" - ++c1ommvl_1.ivx; + commidi_1.twoline[a1ll_2.iv - 1] = TRUE_; +#line 10836 "" + } #line 10837 "" } -#line 10838 "" -/* L23: */ #line 10838 "" } #line 10839 "" - if (c1ommvl_1.ivx > 24) { -#line 10840 "" - s_wsfe(&io___692); -#line 10840 "" - do_fio(&c__1, "Cannot have more than", (ftnlen)21); -#line 10840 "" - do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)) - ; -#line 10840 "" - do_fio(&c__1, " lines of music at once", (ftnlen)23); + a1ll_2.iccount = 128; #line 10840 "" - e_wsfe(); -#line 10842 "" - stop1_(); -#line 10843 "" - } + } else if (*(unsigned char *)charq == 'S') { + +/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */ + #line 10844 "" - c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2; + if (c1omnotes_1.ibarcnt > 0) { #line 10845 "" - c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx; -#line 10846 "" - a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10845 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can on"\ + "ly be in first input block!", (ftnlen)128, ( + ftnlen)37); #line 10847 "" - a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0; + stop1_(); #line 10848 "" - for (j = 1; j <= 200; ++j) { + } #line 10849 "" - a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10850 "" - c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0; + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == + 0) { #line 10851 "" -/* L24: */ + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10851 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must"\ + " follow \"S\"!", (ftnlen)128, (ftnlen)24); +#line 10853 "" + stop1_(); +#line 10854 "" } - -/* For midi stuff, record that there is a 2nd line of music in this voice */ - #line 10855 "" - if (commidi_1.ismidi) { -#line 10855 "" - commidi_1.twoline[a1ll_2.iv - 1] = TRUE_; -#line 10855 "" - } + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen) + 128, (ftnlen)1); #line 10856 "" - } + compage_1.nsyst = i_nint(&fnsyst); #line 10857 "" - } +L14: #line 10858 "" - a1ll_2.iccount = 128; -#line 10859 "" - } else if (*(unsigned char *)charq == 'S') { + if (*(unsigned char *)durq == 'P') { -/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */ +/* New npages for parts. */ +#line 10862 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10863 "" - if (c1omnotes_1.ibarcnt > 0) { + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) + == 0) { #line 10864 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10864 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"\ - " first input block!", (ftnlen)128, (ftnlen)37); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must hav"\ + "e a number here!", (ftnlen)128, (ftnlen) + 24); #line 10866 "" - stop1_(); + stop1_(); #line 10867 "" - } + } #line 10868 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, ( + ftnlen)128, (ftnlen)1); #line 10869 "" - if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 10870 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + compage_1.npages = i_nint(&fnsyst); #line 10870 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"\ - " \"S\"!", (ftnlen)128, (ftnlen)24); -#line 10872 "" - stop1_(); -#line 10873 "" - } -#line 10874 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( - ftnlen)1); + goto L14; +#line 10871 "" + } else if (*(unsigned char *)durq == 'm') { + +/* Reset musize (musicsize). */ + #line 10875 "" - compage_1.nsyst = i_nint(&fnsyst); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10876 "" -L14: + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) + == 0) { #line 10877 "" - if (*(unsigned char *)durq == 'P') { - -/* New npages for parts. */ - + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10877 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must hav"\ + "e a number here!", (ftnlen)128, (ftnlen) + 24); +#line 10879 "" + stop1_(); +#line 10880 "" + } #line 10881 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, ( + ftnlen)128, (ftnlen)1); #line 10882 "" - if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 10883 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + commus_1.musize = i_nint(&fnsyst); #line 10883 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ - "er here!", (ftnlen)128, (ftnlen)24); + c1omnotes_1.wheadpt = commus_1.whead20 * + commus_1.musize; +#line 10884 "" + goto L14; #line 10885 "" - stop1_(); + } else if (*(unsigned char *)durq != ' ') { #line 10886 "" - } -#line 10887 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( - ftnlen)1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10886 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter in \"S\" symbol!", (ftnlen)128, (ftnlen) + 32); #line 10888 "" - compage_1.npages = i_nint(&fnsyst); + stop1_(); #line 10889 "" - goto L14; + } #line 10890 "" - } else if (*(unsigned char *)durq == 'm') { + } else if (*(unsigned char *)charq == 'L') { -/* Reset musize (musicsize). */ +/* Force line break */ #line 10894 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10895 "" - if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 10896 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10896 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ - "er here!", (ftnlen)128, (ftnlen)24); -#line 10898 "" - stop1_(); + if (*(unsigned char *)durq == 'C') { + +/* Coda, no real line break, just get coda length */ + #line 10899 "" - } + if (comshort_1.ishort != 1) { #line 10900 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( - ftnlen)1); -#line 10901 "" - commus_1.musize = i_nint(&fnsyst); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10900 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot u"\ + "se \"LC\" without first using \"L[n]S\"!", + (ftnlen)128, (ftnlen)44); #line 10902 "" - c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; + stop1_(); #line 10903 "" - goto L14; + } #line 10904 "" - } else if (*(unsigned char *)durq != ' ') { -#line 10905 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + comshort_1.ishort = 0; #line 10905 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "\ - "in \"S\" symbol!", (ftnlen)128, (ftnlen)32); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10906 "" + if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) + == 0) { #line 10907 "" - stop1_(); -#line 10908 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10907 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need num"\ + "ber to define coda length!", (ftnlen)128, + (ftnlen)34); #line 10909 "" - } else if (*(unsigned char *)charq == 'L') { - -/* Force line break */ - + stop1_(); +#line 10910 "" + } +#line 10911 "" + readnum_(lineq, &a1ll_2.iccount, durq, & + comshort_1.codafrac, (ftnlen)128, (ftnlen)1); +#line 10912 "" + comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - + 1] += comshort_1.codafrac; #line 10913 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); + if (i_indx(" n", durq, (ftnlen)2, (ftnlen)1) == 0) { #line 10914 "" - if (*(unsigned char *)durq == 'C') { - -/* Coda, no real line break, just get coda length */ - + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10914 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need bla"\ + "nk or \"n\" here!", (ftnlen)128, (ftnlen) + 23); +#line 10916 "" + stop1_(); +#line 10917 "" + } #line 10918 "" - if (comshort_1.ishort != 1) { -#line 10919 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + return 0; #line 10919 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"L"\ - "C\" without first using \"L[n]S\"!", (ftnlen)128, - (ftnlen)44); + } +#line 10920 "" + ++compage_1.nflb; #line 10921 "" - stop1_(); + compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + + a1ll_2.nbars + 1; #line 10922 "" - } + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) + { #line 10923 "" - comshort_1.ishort = 0; -#line 10924 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10923 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer"\ + " to define forced line break!", (ftnlen)128, ( + ftnlen)41); #line 10925 "" - if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 10926 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10926 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need number to d"\ - "efine coda length!", (ftnlen)128, (ftnlen)34); + } +#line 10927 "" + readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen) + 128, (ftnlen)1); #line 10928 "" - stop1_(); + compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb); #line 10929 "" - } + if (compage_1.isysflb[compage_1.nflb] == 1) { #line 10930 "" - readnum_(lineq, &a1ll_2.iccount, durq, &comshort_1.codafrac, ( - ftnlen)128, (ftnlen)1); -#line 10931 "" - comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - 1] += - comshort_1.codafrac; + i__1 = a1ll_2.iccount - 1; +#line 10930 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10930 "" + errmsg_(lineq, &i__1, &i__4, "For now, \"L1\" not al"\ + "lowed!", (ftnlen)128, (ftnlen)26); #line 10932 "" - if (i_indx(" n", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 10933 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10933 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need blank or"\ - " \"n\" here!", (ftnlen)128, (ftnlen)23); -#line 10935 "" - stop1_(); -#line 10936 "" - } -#line 10937 "" - return 0; + } +#line 10934 "" + if (compage_1.nflb > 1) { + +/* Check if new number is > prior one */ + #line 10938 "" - } + if (compage_1.isysflb[compage_1.nflb] <= + compage_1.isysflb[compage_1.nflb - 1]) { #line 10939 "" - ++compage_1.nflb; -#line 10940 "" - compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount - 1; +#line 10939 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10939 "" + errmsg_(lineq, &i__1, &i__4, "You already forced"\ + " a line break at a later line!", (ftnlen) + 128, (ftnlen)48); #line 10941 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 10942 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10942 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"\ - "ne forced line break!", (ftnlen)128, (ftnlen)41); + } +#line 10943 "" + } #line 10944 "" - stop1_(); + if (compage_1.npages == 0) { #line 10945 "" - } + s_wsle(&io___696); +#line 10945 "" + e_wsle(); #line 10946 "" - readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, ( - ftnlen)1); -#line 10947 "" - compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb); -#line 10948 "" - if (compage_1.isysflb[compage_1.nflb] == 1) { -#line 10949 "" - i__1 = a1ll_2.iccount - 1; -#line 10949 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 10949 "" - errmsg_(lineq, &i__1, &i__4, "For now, \"L1\" not allowed!", ( - ftnlen)128, (ftnlen)26); + s_wsle(&io___697); +#line 10946 "" + do_lio(&c__9, &c__1, "WARNING! You forced a line bre"\ + "ak at line ", (ftnlen)41); +#line 10946 "" + do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[ + compage_1.nflb], (ftnlen)sizeof(integer)); +#line 10946 "" + do_lio(&c__9, &c__1, " but npage = 0. Continue?", ( + ftnlen)26); +#line 10946 "" + e_wsle(); +/* read(*,'(a)') charq */ +/* if (index('yY',charq) .eq. 0) call stop1() */ +#line 10950 "" + } else if (compage_1.isysflb[compage_1.nflb] > + compage_1.nsyst) { #line 10951 "" - stop1_(); -#line 10952 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10951 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line "\ + "break at line num > nsyst!", (ftnlen)128, ( + ftnlen)38); #line 10953 "" - if (compage_1.nflb > 1) { - -/* Check if new number is > prior one */ - + stop1_(); +#line 10954 "" + } else if (i_indx(" PMS", durq, (ftnlen)4, (ftnlen)1) == + 0) { +#line 10955 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10955 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\ + " \" \", \"P\", \"M\", or \"S\" here!", ( + ftnlen)128, (ftnlen)37); #line 10957 "" - if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[ - compage_1.nflb - 1]) { -#line 10958 "" - i__1 = a1ll_2.iccount - 1; -#line 10958 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10958 "" - errmsg_(lineq, &i__1, &i__4, "You already forced a line "\ - "break at a later line!", (ftnlen)128, (ftnlen)48); + } +#line 10959 "" +L49: +/* Transfer up from below to allow S after M */ #line 10960 "" - stop1_(); -#line 10961 "" - } -#line 10962 "" - } -#line 10963 "" - if (compage_1.npages == 0) { -#line 10964 "" - s_wsle(&io___696); + if (*(unsigned char *)durq == 'S') { + +/* Shortened line, get shortening fraction */ + #line 10964 "" - e_wsle(); -#line 10965 "" - s_wsle(&io___697); -#line 10965 "" - do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"\ - "ne ", (ftnlen)41); + comshort_1.ishort = 1; #line 10965 "" - do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[ - compage_1.nflb], (ftnlen)sizeof(integer)); -#line 10965 "" - do_lio(&c__9, &c__1, " but npage = 0. Continue?", (ftnlen)26) - ; -#line 10965 "" - e_wsle(); -#line 10967 "" - s_rsfe(&io___698); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10966 "" + if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) + == 0) { #line 10967 "" - do_fio(&c__1, charq, (ftnlen)1); + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10967 "" - e_rsfe(); -#line 10968 "" - if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) { -#line 10968 "" - stop1_(); -#line 10968 "" - } + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need num"\ + "ber to define line shortening fraction!", + (ftnlen)128, (ftnlen)47); #line 10969 "" - } else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) { -#line 10970 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + stop1_(); #line 10970 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"\ - " line num > nsyst!", (ftnlen)128, (ftnlen)38); + } +#line 10971 "" + readnum_(lineq, &a1ll_2.iccount, durq, & + comshort_1.shortfrac, (ftnlen)128, (ftnlen)1); #line 10972 "" - stop1_(); + comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - + 1] = comshort_1.shortfrac; #line 10973 "" - } else if (i_indx(" PMS", durq, (ftnlen)4, (ftnlen)1) == 0) { + if (*(unsigned char *)durq != ' ') { #line 10974 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 10974 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""\ - "P\", \"M\", or \"S\" here!", (ftnlen)128, (ftnlen)37); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need bla"\ + "nk here!", (ftnlen)128, (ftnlen)16); #line 10976 "" - stop1_(); + } #line 10977 "" - } + } #line 10978 "" -L49: -/* Transfer up from below to allow S after M */ -#line 10979 "" - if (*(unsigned char *)durq == 'S') { + if (*(unsigned char *)durq == 'P') { -/* Shortened line, get shortening fraction */ +/* Forced page break here, get page number. */ +#line 10982 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 10983 "" - comshort_1.ishort = 1; + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == + 0) { #line 10984 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); -#line 10985 "" - if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 10986 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10984 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need int"\ + "eger to define forced page break!", ( + ftnlen)128, (ftnlen)41); #line 10986 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need number to d"\ - "efine line shortening fraction!", (ftnlen)128, ( - ftnlen)47); + stop1_(); +#line 10987 "" + } #line 10988 "" - stop1_(); + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); #line 10989 "" - } + ++compage_1.nfpb; #line 10990 "" - readnum_(lineq, &a1ll_2.iccount, durq, &comshort_1.shortfrac, - (ftnlen)128, (ftnlen)1); + compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum); #line 10991 "" - comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - 1] = - comshort_1.shortfrac; + compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[ + compage_1.nflb]; #line 10992 "" - if (*(unsigned char *)durq != ' ') { + if (compage_1.ipagfpb[compage_1.nfpb] > + compage_1.npages) { #line 10993 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__1 = a1ll_2.iccount - 1; #line 10993 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need blank here!", - (ftnlen)128, (ftnlen)16); + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10993 "" + errmsg_(lineq, &i__1, &i__4, "Forced page break "\ + "at page num > npages!", (ftnlen)128, ( + ftnlen)39); #line 10995 "" - } + stop1_(); #line 10996 "" - } + } else if (compage_1.nfpb > 1) { #line 10997 "" - if (*(unsigned char *)durq == 'P') { - -/* Forced page break here, get page number. */ - + if (compage_1.ipagfpb[compage_1.nfpb] <= + compage_1.ipagfpb[compage_1.nfpb - 1]) { +#line 10998 "" + i__1 = a1ll_2.iccount - 1; +#line 10998 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 10998 "" + errmsg_(lineq, &i__1, &i__4, "Forced page br"\ + "eak numbers must increase!", (ftnlen) + 128, (ftnlen)40); +#line 11000 "" + stop1_(); #line 11001 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); + } #line 11002 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 11003 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 11003 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "\ - "define forced page break!", (ftnlen)128, (ftnlen) - 41); + } +#line 11004 "" + if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) { #line 11005 "" - stop1_(); -#line 11006 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11005 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\ + "acter in linebreak symbol!", (ftnlen)128, ( + ftnlen)38); #line 11007 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + stop1_(); #line 11008 "" - ++compage_1.nfpb; + } else if (*(unsigned char *)durq == 'M') { #line 11009 "" - compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum); + ++compage_1.nmovbrk; #line 11010 "" - compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[ - compage_1.nflb]; + compage_1.isysmb[compage_1.nmovbrk] = + compage_1.isysflb[compage_1.nflb]; #line 11011 "" - if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) { -#line 11012 "" - i__1 = a1ll_2.iccount - 1; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 11012 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; +L31: #line 11012 "" - errmsg_(lineq, &i__1, &i__4, "Forced page break at page "\ - "num > npages!", (ftnlen)128, (ftnlen)39); -#line 11014 "" - stop1_(); -#line 11015 "" - } else if (compage_1.nfpb > 1) { + if (*(unsigned char *)durq == '+') { + +/* Vertical spacing, read past number. */ + #line 11016 "" - if (compage_1.ipagfpb[compage_1.nfpb] <= - compage_1.ipagfpb[compage_1.nfpb - 1]) { -#line 11017 "" - i__1 = a1ll_2.iccount - 1; -#line 11017 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 11017 "" - errmsg_(lineq, &i__1, &i__4, "Forced page break numb"\ - "ers must increase!", (ftnlen)128, (ftnlen)40); -#line 11019 "" - stop1_(); + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen) + 1) == 0) { +#line 11018 "" + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 11018 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Inte"\ + "ger required here!", (ftnlen)128, ( + ftnlen)22); #line 11020 "" - } + stop1_(); #line 11021 "" - } + } #line 11022 "" - } + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); #line 11023 "" - if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 11024 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + goto L31; #line 11024 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ - " linebreak symbol!", (ftnlen)128, (ftnlen)38); -#line 11026 "" - stop1_(); -#line 11027 "" - } else if (*(unsigned char *)durq == 'M') { + } else if (*(unsigned char *)durq == 'i') { + +/* Change indentation, */ + #line 11028 "" - ++compage_1.nmovbrk; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 11029 "" - compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[ - compage_1.nflb]; + if (i_indx(".123456789", durq, (ftnlen)10, ( + ftnlen)1) == 0) { #line 11030 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) - 1); -#line 11031 "" -L31: -#line 11031 "" - if (*(unsigned char *)durq == '+') { + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 11030 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Deci"\ + "mal number required here!", (ftnlen) + 128, (ftnlen)29); +#line 11032 "" + stop1_(); +#line 11033 "" + } -/* Vertical spacing, read past number. */ +/* fracsys was initialized in block data to all 0.'s */ -#line 11035 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 11036 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) - { #line 11037 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; -#line 11037 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"\ - "ired here!", (ftnlen)128, (ftnlen)22); + readnum_(lineq, &a1ll_2.iccount, durq, & + compage_1.fracsys[compage_1.nmovbrk - 1], + (ftnlen)128, (ftnlen)1); +#line 11038 "" + goto L31; #line 11039 "" - stop1_(); + } else if (*(unsigned char *)durq == 'c') { #line 11040 "" - } + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 11041 "" - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, - (ftnlen)1); + goto L31; #line 11042 "" - goto L31; + } else if (*(unsigned char *)durq == 'r') { #line 11043 "" - } else if (*(unsigned char *)durq == 'i') { - -/* Change indentation, */ - + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); +#line 11044 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) + { +#line 11045 "" + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 11045 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must"\ + " have \"+\" or \"-\" after \"r\" as "\ + "movement break option!", (ftnlen)128, + (ftnlen)56); #line 11047 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + stop1_(); #line 11048 "" - if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) == - 0) { -#line 11049 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + } #line 11049 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"\ - "er required here!", (ftnlen)128, (ftnlen)29); + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); +#line 11050 "" + goto L31; #line 11051 "" - stop1_(); -#line 11052 "" - } + } else if (*(unsigned char *)durq == 'n') { -/* fracsys was initialized in block data to all 0.'s */ +/* Change # of voices. Input ninow, iorig(1...ninow). Will use names, */ +/* staves per inst. and clefs corr. to iorig in original list of instruments. */ #line 11056 "" - readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[ - compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1); + a1ll_2.nv = 0; #line 11057 "" - goto L31; + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 11058 "" - } else if (*(unsigned char *)durq == 'c') { -#line 11059 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 11060 "" - goto L31; -#line 11061 "" - } else if (*(unsigned char *)durq == 'r') { + if (*(unsigned char *)durq == ':') { + +/* Signals a 2-digit number, get next two characters */ + #line 11062 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + g1etchar_(lineq, &a1ll_2.iccount, durq, ( + ftnlen)128, (ftnlen)1); #line 11063 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 11064 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + g1etchar_(lineq, &a1ll_2.iccount, dumq, ( + ftnlen)128, (ftnlen)1); #line 11064 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\ - " \"+\" or \"-\" after \"r\" as movement brea"\ - "k option!", (ftnlen)128, (ftnlen)56); + if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) + == 0 || i_indx("0123456789", dumq, ( + ftnlen)10, (ftnlen)1) == 0) { #line 11066 "" - stop1_(); -#line 11067 "" - } -#line 11068 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +/* Writing concatenation */ +#line 11066 "" + i__8[0] = 34, a__3[0] = "Illegal new num"\ + "ber of instruments "; +#line 11066 "" + i__8[1] = 1, a__3[1] = durq; +#line 11066 "" + i__8[2] = 1, a__3[2] = dumq; +#line 11066 "" + i__8[3] = 19, a__3[3] = " at movement br"\ + "eak!"; +#line 11066 "" + s_cat(ch__5, a__3, i__8, &c__4, (ftnlen) + 55); +#line 11066 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, + ch__5, (ftnlen)128, (ftnlen)55); #line 11069 "" - goto L31; + stop1_(); #line 11070 "" - } else if (*(unsigned char *)durq == 'n') { + } +#line 11071 "" + i__1 = a1ll_2.iccount - 2; +#line 11071 "" + ici__1.icierr = 0; +#line 11071 "" + ici__1.iciend = 0; +#line 11071 "" + ici__1.icirnum = 1; +#line 11071 "" + ici__1.icirlen = a1ll_2.iccount - i__1; +#line 11071 "" + ici__1.iciunit = lineq + i__1; +#line 11071 "" + ici__1.icifmt = "(i2)"; +#line 11071 "" + s_rsfi(&ici__1); +#line 11071 "" + do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof( + integer)); +#line 11071 "" + e_rsfi(); +#line 11072 "" + } else { -/* Change # of voices. Input ninow, iorig(1...ninow). Will use names, */ -/* staves per inst. and clefs corr. to iorig in original list of instruments. */ +/* durq is a single digit number for noinow */ -#line 11075 "" - a1ll_2.nv = 0; #line 11076 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + if (i_indx("123456789", durq, (ftnlen)9, ( + ftnlen)1) == 0) { #line 11077 "" - if (*(unsigned char *)durq == ':') { - -/* Signals a 2-digit number, get next two characters */ - + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +/* Writing concatenation */ +#line 11077 "" + i__2[0] = 34, a__1[0] = "Illegal new num"\ + "ber of instruments "; +#line 11077 "" + i__2[1] = 1, a__1[1] = durq; +#line 11077 "" + i__2[2] = 19, a__1[2] = " at movement br"\ + "eak!"; +#line 11077 "" + s_cat(ch__6, a__1, i__2, &c__3, (ftnlen) + 54); +#line 11077 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, + ch__6, (ftnlen)128, (ftnlen)54); +#line 11080 "" + stop1_(); #line 11081 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); + } #line 11082 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( - ftnlen)1); + ninow = *(unsigned char *)durq - 48; #line 11083 "" - if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 || - i_indx("0123456789", dumq, (ftnlen)10, ( - ftnlen)1) == 0) { -#line 11085 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; -/* Writing concatenation */ -#line 11085 "" - i__8[0] = 34, a__3[0] = "Illegal new number of i"\ - "nstruments "; -#line 11085 "" - i__8[1] = 1, a__3[1] = durq; -#line 11085 "" - i__8[2] = 1, a__3[2] = dumq; -#line 11085 "" - i__8[3] = 19, a__3[3] = " at movement break!"; + } +#line 11084 "" + if (ninow > comkeys_1.noinst) { #line 11085 "" - s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55); + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; #line 11085 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, ( - ftnlen)128, (ftnlen)55); + errmsg_(lineq, &a1ll_2.iccount, &i__1, "New "\ + "number of instruments must be <= ori"\ + "ginal!", (ftnlen)128, (ftnlen)46); +#line 11087 "" + stop1_(); #line 11088 "" - stop1_(); + } #line 11089 "" - } -#line 11090 "" - i__1 = a1ll_2.iccount - 2; -#line 11090 "" - ici__1.icierr = 0; -#line 11090 "" - ici__1.iciend = 0; -#line 11090 "" - ici__1.icirnum = 1; -#line 11090 "" - ici__1.icirlen = a1ll_2.iccount - i__1; -#line 11090 "" - ici__1.iciunit = lineq + i__1; -#line 11090 "" - ici__1.icifmt = "(i2)"; -#line 11090 "" - s_rsfi(&ici__1); -#line 11090 "" - do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer)) - ; + i__1 = ninow; +#line 11089 "" + for (iinow = 1; iinow <= i__1; ++iinow) { #line 11090 "" - e_rsfi(); + g1etchar_(lineq, &a1ll_2.iccount, durq, ( + ftnlen)128, (ftnlen)1); #line 11091 "" - } else { + if (*(unsigned char *)durq == ':') { -/* durq is a single digit number for noinow */ +/* Signals a 2-digit number */ #line 11095 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == - 0) { + g1etchar_(lineq, &a1ll_2.iccount, durq, ( + ftnlen)128, (ftnlen)1); #line 11096 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; + g1etchar_(lineq, &a1ll_2.iccount, dumq, ( + ftnlen)128, (ftnlen)1); +#line 11097 "" + if (i_indx("12", durq, (ftnlen)2, (ftnlen) + 1) == 0 || i_indx("0123456789", + dumq, (ftnlen)10, (ftnlen)1) == 0) + { +#line 11099 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; /* Writing concatenation */ -#line 11096 "" - i__2[0] = 34, a__1[0] = "Illegal new number of i"\ - "nstruments "; -#line 11096 "" - i__2[1] = 1, a__1[1] = durq; -#line 11096 "" - i__2[2] = 19, a__1[2] = " at movement break!"; -#line 11096 "" - s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)54); -#line 11096 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__5, ( - ftnlen)128, (ftnlen)54); #line 11099 "" - stop1_(); -#line 11100 "" - } -#line 11101 "" - ninow = *(unsigned char *)durq - 48; + i__8[0] = 34, a__3[0] = "Illegal 2-d"\ + "igit instrument number "; +#line 11099 "" + i__8[1] = 1, a__3[1] = durq; +#line 11099 "" + i__8[2] = 1, a__3[2] = dumq; +#line 11099 "" + i__8[3] = 19, a__3[3] = " at movemen"\ + "t break!"; +#line 11099 "" + s_cat(ch__5, a__3, i__8, &c__4, ( + ftnlen)55); +#line 11099 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, + ch__5, (ftnlen)128, (ftnlen) + 55); #line 11102 "" - } + stop1_(); #line 11103 "" - if (ninow > comkeys_1.noinst) { + } #line 11104 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + i__4 = a1ll_2.iccount - 2; #line 11104 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"\ - "f instruments must be <= original!", (ftnlen) - 128, (ftnlen)46); -#line 11106 "" - stop1_(); -#line 11107 "" - } -#line 11108 "" - i__1 = ninow; -#line 11108 "" - for (iinow = 1; iinow <= i__1; ++iinow) { -#line 11109 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 11110 "" - if (*(unsigned char *)durq == ':') { + ici__1.icierr = 0; +#line 11104 "" + ici__1.iciend = 0; +#line 11104 "" + ici__1.icirnum = 1; +#line 11104 "" + ici__1.icirlen = a1ll_2.iccount - i__4; +#line 11104 "" + ici__1.iciunit = lineq + i__4; +#line 11104 "" + ici__1.icifmt = "(i2)"; +#line 11104 "" + s_rsfi(&ici__1); +#line 11104 "" + do_fio(&c__1, (char *)&iorig, (ftnlen) + sizeof(integer)); +#line 11104 "" + e_rsfi(); +#line 11105 "" + } else { -/* Signals a 2-digit number */ +/* durq is a single digit number for iorig */ +#line 11109 "" + if (i_indx("123456789", durq, (ftnlen)9, ( + ftnlen)1) == 0) { +#line 11110 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +/* Writing concatenation */ +#line 11110 "" + i__2[0] = 26, a__1[0] = "Illegal ins"\ + "trument number "; +#line 11110 "" + i__2[1] = 1, a__1[1] = durq; +#line 11110 "" + i__2[2] = 19, a__1[2] = " at movemen"\ + "t break!"; +#line 11110 "" + s_cat(ch__7, a__1, i__2, &c__3, ( + ftnlen)46); +#line 11110 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, + ch__7, (ftnlen)128, (ftnlen) + 46); +#line 11113 "" + stop1_(); #line 11114 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) - 128, (ftnlen)1); + } #line 11115 "" - g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) - 128, (ftnlen)1); + iorig = *(unsigned char *)durq - 48; #line 11116 "" - if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 - || i_indx("0123456789", dumq, (ftnlen)10, - (ftnlen)1) == 0) { -#line 11118 "" - i__4 = c1omnotes_1.ibarcnt - - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; -/* Writing concatenation */ -#line 11118 "" - i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"\ - "trument number "; + } +#line 11117 "" + if (iorig > comkeys_1.noinst) { #line 11118 "" - i__8[1] = 1, a__3[1] = durq; + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 11118 "" - i__8[2] = 1, a__3[2] = dumq; -#line 11118 "" - i__8[3] = 19, a__3[3] = " at movement break!"; -#line 11118 "" - s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55); -#line 11118 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__4, - (ftnlen)128, (ftnlen)55); + errmsg_(lineq, &a1ll_2.iccount, &i__4, + "New instrument number must be <"\ + "= original noinst!", (ftnlen)128, + (ftnlen)49); +#line 11120 "" + stop1_(); #line 11121 "" - stop1_(); + } #line 11122 "" - } -#line 11123 "" - i__4 = a1ll_2.iccount - 2; -#line 11123 "" - ici__1.icierr = 0; -#line 11123 "" - ici__1.iciend = 0; -#line 11123 "" - ici__1.icirnum = 1; -#line 11123 "" - ici__1.icirlen = a1ll_2.iccount - i__4; + a1ll_2.nv += c1omget_1.nsperi[iorig - 1]; #line 11123 "" - ici__1.iciunit = lineq + i__4; -#line 11123 "" - ici__1.icifmt = "(i2)"; -#line 11123 "" - s_rsfi(&ici__1); -#line 11123 "" - do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof( - integer)); +/* L63: */ #line 11123 "" - e_rsfi(); + } #line 11124 "" - } else { + i__1 = a1ll_2.nv; +#line 11124 "" + for (iiv = 1; iiv <= i__1; ++iiv) { -/* durq is a single digit number for iorig */ +/* Get clef names */ #line 11128 "" - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen) - 1) == 0) { -#line 11129 "" - i__4 = c1omnotes_1.ibarcnt - - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; -/* Writing concatenation */ -#line 11129 "" - i__2[0] = 26, a__1[0] = "Illegal instrument "\ - "number "; -#line 11129 "" - i__2[1] = 1, a__1[1] = durq; -#line 11129 "" - i__2[2] = 19, a__1[2] = " at movement break!"; -#line 11129 "" - s_cat(ch__6, a__1, i__2, &c__3, (ftnlen)46); + g1etchar_(lineq, &a1ll_2.iccount, durq, ( + ftnlen)128, (ftnlen)1); #line 11129 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__6, - (ftnlen)128, (ftnlen)46); + if (! (i_indx("tsmanrbf", durq, (ftnlen)8, ( + ftnlen)1) > 0 || *(unsigned char *) + durq >= 48 && *(unsigned char *)durq + <= 56)) { +/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */ #line 11132 "" - stop1_(); -#line 11133 "" - } + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11132 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, + "Must have t,s,m,a,n,r,b,f or 1-"\ + "7 as clef symbol here!", (ftnlen) + 128, (ftnlen)53); #line 11134 "" - iorig = *(unsigned char *)durq - 48; + stop1_(); #line 11135 "" - } -#line 11136 "" - if (iorig > comkeys_1.noinst) { -#line 11137 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; -#line 11137 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"\ - "rument number must be <= original noinst!" - , (ftnlen)128, (ftnlen)49); + } + +/* Initialize new voices */ + #line 11139 "" - stop1_(); + c1ommvl_1.nvmx[iiv - 1] = 1; #line 11140 "" - } + c1ommvl_1.ivmx[iiv - 1] = iiv; #line 11141 "" - a1ll_2.nv += c1omget_1.nsperi[iorig - 1]; -#line 11142 "" -/* L63: */ + a1ll_2.itsofar[iiv - 1] = 0; #line 11142 "" - } + a1ll_2.nnl[iiv - 1] = 0; #line 11143 "" - i__1 = a1ll_2.nv; -#line 11143 "" - for (iiv = 1; iiv <= i__1; ++iiv) { + for (j = 1; j <= 200; ++j) { +#line 11144 "" + a1ll_2.rest[iiv + j * 24 - 25] = FALSE_; +#line 11145 "" +/* L62: */ +#line 11145 "" + } +#line 11146 "" +/* L61: */ +#line 11146 "" + } -/* Get clef names */ +/* Loop back up, this might not be last option in M */ -#line 11147 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 11148 "" - if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) - > 0 || *(unsigned char *)durq >= 48 && *( - unsigned char *)durq <= 56)) { -/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */ -#line 11151 "" - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff - + a1ll_2.nbars + 1; +#line 11150 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 11151 "" - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\ - "e t,s,m,a,n,r,b,f or 1-7 as clef symbol "\ - "here!", (ftnlen)128, (ftnlen)53); + goto L31; +#line 11152 "" + } else if (*(unsigned char *)durq == 'S') { #line 11153 "" - stop1_(); + goto L49; #line 11154 "" + } else if (*(unsigned char *)durq != ' ') { +#line 11155 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11155 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal "\ + "character after Movement break symbol!", ( + ftnlen)128, (ftnlen)46); +#line 11157 "" + stop1_(); +#line 11158 "" } +#line 11159 "" + if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) + { -/* Initialize new voices */ +/* Since fracsys was not explicitly set, set it to prior value. */ -#line 11158 "" - c1ommvl_1.nvmx[iiv - 1] = 1; -#line 11159 "" - c1ommvl_1.ivmx[iiv - 1] = iiv; -#line 11160 "" - a1ll_2.itsofar[iiv - 1] = 0; -#line 11161 "" - a1ll_2.nnl[iiv - 1] = 0; -#line 11162 "" - for (j = 1; j <= 200; ++j) { #line 11163 "" - a1ll_2.rest[iiv + j * 24 - 25] = FALSE_; -#line 11164 "" -/* L62: */ + if (compage_1.nmovbrk == 1) { #line 11164 "" - } -#line 11165 "" -/* L61: */ + compage_1.fracsys[compage_1.nmovbrk - 1] = + c1omget_1.fracindent; #line 11165 "" + } else { +#line 11166 "" + compage_1.fracsys[compage_1.nmovbrk - 1] = + compage_1.fracsys[compage_1.nmovbrk - + 2]; +#line 11167 "" + } +#line 11168 "" + } +#line 11169 "" } -/* Loop back up, this might not be last option in M */ +/* Just before exiting if-block for forced line breaks, set counter to use when */ +/* dealing with vertical space calcs */ -#line 11169 "" - g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 11170 "" - goto L31; -#line 11171 "" - } else if (*(unsigned char *)durq == 'S') { -#line 11172 "" - goto L49; -#line 11173 "" - } else if (*(unsigned char *)durq != ' ') { -#line 11174 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; #line 11174 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ - "r after Movement break symbol!", (ftnlen)128, ( - ftnlen)46); + compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1; +#line 11175 "" + } else if (*(unsigned char *)charq == 'F') { #line 11176 "" - stop1_(); + compage_1.usefig = FALSE_; #line 11177 "" - } + } else if (*(unsigned char *)charq == 'X') { +#line 11178 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; #line 11178 "" - if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) { + g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &i__1, + &c1omnotes_1.udsp[c1omnotes_1.ibarcnt + + a1ll_2.nbars], &c1omnotes_1.wheadpt, (ftnlen)128); +#line 11180 "" + } else if (*(unsigned char *)charq == 'I') { -/* Since fracsys was not explicitly set, set it to prior value. */ +/* MIDI settings. */ -#line 11182 "" - if (compage_1.nmovbrk == 1) { -#line 11183 "" - compage_1.fracsys[compage_1.nmovbrk - 1] = - c1omget_1.fracindent; #line 11184 "" - } else { + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { #line 11185 "" - compage_1.fracsys[compage_1.nmovbrk - 1] = - compage_1.fracsys[compage_1.nmovbrk - 2]; -#line 11186 "" - } + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11185 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff o"\ + "nly allowed at start of block!", (ftnlen)128, + (ftnlen)42); #line 11187 "" - } + stop1_(); #line 11188 "" - } - -/* Just before exiting if-block for forced line breaks, set counter to use when */ -/* dealing with vertical space calcs */ - + } +#line 11189 "" + if (a1ll_2.nv > 15) { +#line 11190 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11190 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MI"\ + "DI does not work with more than 15 voices!", ( + ftnlen)128, (ftnlen)54); +#line 11192 "" + stop1_(); #line 11193 "" - compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1; + } #line 11194 "" - } else if (*(unsigned char *)charq == 'F') { + commidi_1.ismidi = TRUE_; #line 11195 "" - compage_1.usefig = FALSE_; -#line 11196 "" - } else if (*(unsigned char *)charq == 'X') { -#line 11197 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; + getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, & + c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, & + a1ll_2.nbars, &a1ll_2.lenbar, &mtrdenl, & + a1ll_2.nv, &c_true, (ftnlen)128); #line 11197 "" - g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &i__1, & - c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], & - c1omnotes_1.wheadpt, (ftnlen)128); -#line 11199 "" - } else if (*(unsigned char *)charq == 'I') { + } else if (*(unsigned char *)charq == 'M') { +#line 11198 "" + setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, & + c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, & + c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, ( + ftnlen)1, (ftnlen)1); +#line 11200 "" + } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { -/* MIDI settings. */ +/* Continued rhythmic shortcut */ -#line 11203 "" - if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { -#line 11204 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; #line 11204 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"\ - "wed at start of block!", (ftnlen)128, (ftnlen)42); -#line 11206 "" - stop1_(); -#line 11207 "" - } -#line 11208 "" - if (a1ll_2.nv > 15) { -#line 11209 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; + idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); +#line 11205 "" + if (idotform == 1) { + +/* Change duration of prior note */ + #line 11209 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "\ - "not work with more than 15 voices!", (ftnlen)128, ( - ftnlen)54); + a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[ + c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] + * 24 - 25]; +#line 11210 "" + a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx + - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] * + 3 / 2; #line 11211 "" - stop1_(); + a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[ + c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] + * 24 - 25]; #line 11212 "" - } + } #line 11213 "" - commidi_1.ismidi = TRUE_; + ++idotform; #line 11214 "" - getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, & - c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &a1ll_2.nbars, - &a1ll_2.lenbar, &mtrdenl, &a1ll_2.nv, &c_true, (ftnlen) - 128); + numnum = 1; +#line 11215 "" + cdot = TRUE_; #line 11216 "" - } else if (*(unsigned char *)charq == 'M') { + goto L1; #line 11217 "" - setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, & - c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, & - c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, (ftnlen)1, ( - ftnlen)1); + } else { +#line 11218 "" + s_wsle(&io___701); +#line 11218 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 11218 "" + i__1 = *(unsigned char *)charq; +#line 11218 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof( + integer)); +#line 11218 "" + e_wsle(); #line 11219 "" - } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { - -/* Continued rhythmic shortcut */ - + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 11219 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character i"\ + "s not allowed here!", (ftnlen)128, (ftnlen)35); +#line 11221 "" + s_wsle(&io___702); +#line 11221 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 11221 "" + i__1 = *(unsigned char *)charq; +#line 11221 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof( + integer)); +#line 11221 "" + e_wsle(); +#line 11222 "" + stop1_(); +#line 11223 "" + } #line 11223 "" - idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); -#line 11224 "" - if (idotform == 1) { - -/* Change duration of prior note */ - -#line 11228 "" - a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[ - c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - - 25]; -#line 11229 "" - a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * - 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[ - c1ommvl_1.ivx - 1] * 24 - 25] * 3 / 2; -#line 11230 "" - a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[ - c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - - 25]; -#line 11231 "" } -#line 11232 "" - ++idotform; -#line 11233 "" - numnum = 1; -#line 11234 "" - cdot = TRUE_; -#line 11235 "" - goto L1; -#line 11236 "" - } else { -#line 11237 "" - s_wsle(&io___702); -#line 11237 "" - do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); -#line 11237 "" - i__1 = *(unsigned char *)charq; -#line 11237 "" - do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 11237 "" - e_wsle(); -#line 11238 "" - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + - 1; -#line 11238 "" - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\ - "lowed here!", (ftnlen)128, (ftnlen)35); -#line 11240 "" - s_wsle(&io___703); -#line 11240 "" - do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); -#line 11240 "" - i__1 = *(unsigned char *)charq; -#line 11240 "" - do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 11240 "" - e_wsle(); -#line 11241 "" - stop1_(); -#line 11242 "" +#line 11223 "" } -#line 11242 "" +#line 11223 "" } -#line 11243 "" +#line 11224 "" return 0; } /* g1etnote_ */ @@ -27312,159 +27460,159 @@ L31: static integer iccount; /* Fortran I/O blocks */ - static cilist io___706 = { 0, 6, 0, 0, 0 }; - static cilist io___707 = { 0, 6, 0, "(1x,a46,i3)", 0 }; - static cilist io___708 = { 0, 6, 0, "(a)", 0 }; + static cilist io___705 = { 0, 6, 0, 0, 0 }; + static cilist io___706 = { 0, 6, 0, "(1x,a46,i3)", 0 }; + static cilist io___707 = { 0, 6, 0, "(a)", 0 }; + static cilist io___710 = { 0, 6, 0, "(a)", 0 }; static cilist io___711 = { 0, 6, 0, "(a)", 0 }; - static cilist io___712 = { 0, 6, 0, "(a)", 0 }; - static cilist io___713 = { 0, 6, 0, 0, 0 }; + static cilist io___712 = { 0, 6, 0, 0, 0 }; /* Get the first line */ -#line 11261 "" +#line 11242 "" iccount = 0; -#line 11262 "" +#line 11243 "" c1omget_1.nline = 1; -#line 11263 "" +#line 11244 "" L9: -#line 11263 "" +#line 11244 "" getbuf_(lineq, (ftnlen)128); -#line 11264 "" +#line 11245 "" if (*(unsigned char *)lineq == '%') { -#line 11265 "" +#line 11246 "" ++c1omget_1.nline; -#line 11266 "" +#line 11247 "" goto L9; -#line 11267 "" +#line 11248 "" } -#line 11268 "" +#line 11249 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) { /* Have TeX input until next line that starts with '---' */ -#line 11272 "" +#line 11253 "" L3: -#line 11272 "" +#line 11253 "" ++c1omget_1.nline; -#line 11273 "" +#line 11254 "" getbuf_(lineq, (ftnlen)128); -#line 11274 "" +#line 11255 "" if (inbuff_1.ilbuf > inbuff_1.nlbuf) { -#line 11274 "" +#line 11255 "" goto L1; -#line 11274 "" +#line 11255 "" } -#line 11275 "" +#line 11256 "" goto L2; -#line 11276 "" +#line 11257 "" L1: -#line 11276 "" - s_wsle(&io___706); -#line 11276 "" +#line 11257 "" + s_wsle(&io___705); +#line 11257 "" do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""\ "---\"", (ftnlen)49); -#line 11276 "" +#line 11257 "" e_wsle(); -#line 11277 "" +#line 11258 "" stop1_(); -#line 11278 "" +#line 11259 "" L2: -#line 11279 "" +#line 11260 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { -#line 11279 "" +#line 11260 "" goto L3; -#line 11279 "" +#line 11260 "" } /* Force a new line read on first call to readin */ -#line 11283 "" +#line 11264 "" iccount = 128; -#line 11284 "" +#line 11265 "" } /* Here, lineq and nline are first non-TeX lines. */ -#line 11288 "" +#line 11269 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11288 "" +#line 11269 "" *nv = i_nint(&r__1); -#line 11289 "" +#line 11270 "" if (*nv > 24) { -#line 11290 "" - s_wsfe(&io___707); -#line 11290 "" +#line 11271 "" + s_wsfe(&io___706); +#line 11271 "" do_fio(&c__1, "In setup data, number of voices cannot exceed", ( ftnlen)45); -#line 11290 "" +#line 11271 "" do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)); -#line 11290 "" +#line 11271 "" e_wsfe(); -#line 11292 "" +#line 11273 "" stop1_(); -#line 11293 "" +#line 11274 "" } -#line 11294 "" +#line 11275 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11294 "" +#line 11275 "" *noinst = i_nint(&r__1); -#line 11295 "" +#line 11276 "" if (*noinst > *nv) { -#line 11296 "" - s_wsfe(&io___708); -#line 11296 "" +#line 11277 "" + s_wsfe(&io___707); +#line 11277 "" do_fio(&c__1, "In setup data, cannot have more instruments than stav"\ "es", (ftnlen)55); -#line 11296 "" +#line 11277 "" e_wsfe(); -#line 11298 "" +#line 11279 "" stop1_(); -#line 11299 "" +#line 11280 "" } -#line 11300 "" +#line 11281 "" newway = *noinst <= 0; -#line 11301 "" +#line 11282 "" if (newway) { -#line 11301 "" +#line 11282 "" *noinst = -(*noinst); -#line 11301 "" +#line 11282 "" } -#line 11302 "" +#line 11283 "" i__1 = *noinst; -#line 11302 "" +#line 11283 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* Seve # of staves per inst in case later drop some inst's. */ -#line 11306 "" +#line 11287 "" if (newway) { -#line 11307 "" +#line 11288 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11307 "" +#line 11288 "" c1omget_1.nsperi[iinst - 1] = i_nint(&r__1); -#line 11308 "" +#line 11289 "" } else if (iinst > 1) { -#line 11309 "" +#line 11290 "" c1omget_1.nsperi[iinst - 1] = 1; -#line 11310 "" +#line 11291 "" } else { -#line 11311 "" +#line 11292 "" c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1; -#line 11312 "" +#line 11293 "" } -#line 11313 "" +#line 11294 "" /* L10: */ -#line 11313 "" +#line 11294 "" } -#line 11314 "" +#line 11295 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11314 "" +#line 11295 "" *mtrnuml = i_nint(&r__1); -#line 11315 "" +#line 11296 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11315 "" +#line 11296 "" *mtrdenl = i_nint(&r__1); /* c */ /* c Kluge!!! */ @@ -27473,208 +27621,208 @@ L2: /* mtrdenl = 2 */ /* mtrnuml = mtrnuml*2 */ /* end if */ -#line 11323 "" +#line 11304 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11323 "" +#line 11304 "" *mtrnmp = i_nint(&r__1); -#line 11324 "" +#line 11305 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11324 "" +#line 11305 "" *mtrdnp = i_nint(&r__1); -#line 11325 "" +#line 11306 "" if (*mtrnmp == 0 && *mtrdnp >= 8) { -#line 11326 "" - s_wsfe(&io___711); -#line 11326 "" +#line 11307 "" + s_wsfe(&io___710); +#line 11307 "" do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", ( ftnlen)47); -#line 11326 "" +#line 11307 "" e_wsfe(); -#line 11327 "" +#line 11308 "" stop1_(); -#line 11328 "" +#line 11309 "" } -#line 11329 "" +#line 11310 "" *xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11330 "" +#line 11311 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11330 "" +#line 11311 "" *newkey = i_nint(&r__1); /* 130316 */ /* do 11 iinst = 1 , noinst */ -#line 11333 "" +#line 11314 "" commidisig_1.midisig = *newkey; /* 11 continue */ -#line 11335 "" +#line 11316 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11335 "" +#line 11316 "" *npages = i_nint(&r__1); -#line 11336 "" +#line 11317 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11336 "" +#line 11317 "" *nsyst = i_nint(&r__1); -#line 11337 "" +#line 11318 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); -#line 11337 "" +#line 11318 "" *musize = i_nint(&r__1); -#line 11338 "" +#line 11319 "" c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen) 128); -#line 11339 "" +#line 11320 "" if (c1omget_1.fracindent >= 1.f) { -#line 11340 "" - s_wsfe(&io___712); -#line 11340 "" +#line 11321 "" + s_wsfe(&io___711); +#line 11321 "" do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36); -#line 11340 "" +#line 11321 "" e_wsfe(); -#line 11341 "" +#line 11322 "" stop1_(); -#line 11342 "" +#line 11323 "" } -#line 11343 "" +#line 11324 "" if (*npages > *nsyst) { -#line 11344 "" - s_wsle(&io___713); -#line 11344 "" +#line 11325 "" + s_wsle(&io___712); +#line 11325 "" do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen) 35); -#line 11344 "" +#line 11325 "" e_wsle(); -#line 11345 "" +#line 11326 "" stop1_(); -#line 11346 "" +#line 11327 "" } else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize - 29) != 0) { -#line 11347 "" +#line 11328 "" printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35); -#line 11348 "" +#line 11329 "" stop1_(); -#line 11349 "" +#line 11330 "" } /* Next noinst non-comment lines are names of instruments. */ -#line 11353 "" +#line 11334 "" i__1 = abs(*noinst); -#line 11353 "" +#line 11334 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 11354 "" +#line 11335 "" L5: -#line 11354 "" +#line 11335 "" getbuf_(lineq, (ftnlen)128); -#line 11355 "" +#line 11336 "" ++c1omget_1.nline; -#line 11356 "" +#line 11337 "" if (*(unsigned char *)lineq == '%') { -#line 11356 "" +#line 11337 "" goto L5; -#line 11356 "" +#line 11337 "" } -#line 11357 "" +#line 11338 "" /* L4: */ -#line 11357 "" +#line 11338 "" } /* Mext non-comment line has nv clef names */ -#line 11361 "" +#line 11342 "" L6: -#line 11361 "" +#line 11342 "" getbuf_(lineq, (ftnlen)128); -#line 11362 "" +#line 11343 "" ++c1omget_1.nline; -#line 11363 "" +#line 11344 "" if (*(unsigned char *)lineq == '%') { -#line 11363 "" +#line 11344 "" goto L6; -#line 11363 "" +#line 11344 "" } -#line 11364 "" +#line 11345 "" i__1 = *nv; -#line 11364 "" +#line 11345 "" for (iv = 1; iv <= i__1; ++iv) { /* if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then */ -#line 11366 "" +#line 11347 "" if (i_indx("brnamstf012345678", lineq + (iv - 1), (ftnlen)17, (ftnlen) 1) == 0) { -#line 11367 "" +#line 11348 "" errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!", (ftnlen)128, (ftnlen)35); -#line 11369 "" +#line 11350 "" stop1_(); -#line 11370 "" +#line 11351 "" } -#line 11371 "" +#line 11352 "" /* L7: */ -#line 11371 "" +#line 11352 "" } -#line 11372 "" +#line 11353 "" i__1 = *nv; -#line 11372 "" +#line 11353 "" if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) { -#line 11373 "" +#line 11354 "" i__1 = *nv + 1; -#line 11373 "" +#line 11354 "" errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen) 128, (ftnlen)29); -#line 11375 "" +#line 11356 "" stop1_(); -#line 11376 "" +#line 11357 "" } /* Set flag if voice 1 is treble, since it affects vertical spacing */ /* bottreb = lineq(1:1).eq.'t' */ -#line 11381 "" +#line 11362 "" *bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0; /* Next non-comment line has path name */ -#line 11385 "" +#line 11366 "" L8: -#line 11385 "" +#line 11366 "" getbuf_(lineq, (ftnlen)128); -#line 11386 "" +#line 11367 "" ++c1omget_1.nline; -#line 11387 "" +#line 11368 "" if (*(unsigned char *)lineq == '%') { -#line 11387 "" +#line 11368 "" goto L8; -#line 11387 "" +#line 11368 "" } -#line 11388 "" +#line 11369 "" lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1; /* Writing concatenation */ -#line 11389 "" +#line 11370 "" i__2[0] = 2, a__1[0] = "/:"; -#line 11389 "" +#line 11370 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 11389 "" +#line 11370 "" i__2[1] = 1, a__1[1] = ch__2; -#line 11389 "" +#line 11370 "" s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3); -#line 11389 "" +#line 11370 "" if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) { /* Writing concatenation */ -#line 11390 "" +#line 11371 "" i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""\ ":\", or \""; -#line 11390 "" +#line 11371 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 11390 "" +#line 11371 "" i__3[1] = 1, a__2[1] = ch__2; -#line 11390 "" +#line 11371 "" i__3[2] = 2, a__2[2] = "\"!"; -#line 11390 "" +#line 11371 "" s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50); -#line 11390 "" +#line 11371 "" errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50); -#line 11393 "" +#line 11374 "" stop1_(); -#line 11394 "" +#line 11375 "" } -#line 11395 "" +#line 11376 "" return 0; } /* g1etset_ */ @@ -27703,155 +27851,155 @@ L8: /* Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. */ /* In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */ -#line 11405 "" +#line 11386 "" number = FALSE_; -#line 11406 "" +#line 11387 "" npbsc = 0; -#line 11407 "" +#line 11388 "" L1: -#line 11407 "" +#line 11388 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11408 "" +#line 11389 "" if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) { /* Continue checking here even if "P". */ -#line 11412 "" +#line 11393 "" ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1); -#line 11413 "" +#line 11394 "" if (bit_test(npbsc,ipbsc)) { -#line 11414 "" +#line 11395 "" errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", ( ftnlen)128, (ftnlen)28); -#line 11415 "" +#line 11396 "" stop1_(); -#line 11416 "" +#line 11397 "" } -#line 11417 "" +#line 11398 "" npbsc = bit_set(npbsc,ipbsc); -#line 11418 "" +#line 11399 "" goto L1; -#line 11419 "" +#line 11400 "" } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { -#line 11420 "" +#line 11401 "" number = TRUE_; -#line 11421 "" +#line 11402 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { -#line 11422 "" +#line 11403 "" g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1); -#line 11423 "" +#line 11404 "" if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) { -#line 11424 "" +#line 11405 "" errmsg_(lineq, iccount, ibar, "Expected a number here!", ( ftnlen)128, (ftnlen)23); -#line 11425 "" +#line 11406 "" stop1_(); -#line 11426 "" +#line 11407 "" } -#line 11427 "" +#line 11408 "" } -#line 11428 "" +#line 11409 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11429 "" +#line 11410 "" if (*(unsigned char *)charq == '-') { -#line 11429 "" +#line 11410 "" fnum = -fnum; -#line 11429 "" +#line 11410 "" } -#line 11430 "" +#line 11411 "" if (*(unsigned char *)dumq != 'p') { -#line 11431 "" +#line 11412 "" --(*iccount); -#line 11432 "" +#line 11413 "" fnum *= *wheadpt; -#line 11433 "" +#line 11414 "" } -#line 11434 "" +#line 11415 "" goto L1; -#line 11435 "" +#line 11416 "" } else if (*(unsigned char *)charq != ' ') { -#line 11436 "" +#line 11417 "" errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen) 128, (ftnlen)26); -#line 11437 "" +#line 11418 "" stop1_(); -#line 11438 "" +#line 11419 "" } /* Done with parsing. Other checks */ -#line 11442 "" +#line 11423 "" if ((6 & npbsc) == 6 || (24 & npbsc) == 24) { -#line 11443 "" +#line 11424 "" i__1 = *iccount - 1; -#line 11443 "" +#line 11424 "" errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""\ "S\" and \":\"!", (ftnlen)128, (ftnlen)44); -#line 11445 "" +#line 11426 "" stop1_(); -#line 11446 "" +#line 11427 "" } -#line 11447 "" +#line 11428 "" if (bit_test(npbsc,4)) { -#line 11448 "" +#line 11429 "" if (number) { -#line 11449 "" +#line 11430 "" if (*shifton) { -#line 11450 "" +#line 11431 "" i__1 = *iccount - 1; -#line 11450 "" +#line 11431 "" errmsg_(lineq, &i__1, ibar, "Started a group shift without s"\ "topping prior one!", (ftnlen)128, (ftnlen)49); -#line 11452 "" +#line 11433 "" stop1_(); -#line 11453 "" +#line 11434 "" } else { -#line 11454 "" +#line 11435 "" *shifton = TRUE_; -#line 11455 "" +#line 11436 "" } -#line 11456 "" +#line 11437 "" } else { -#line 11457 "" +#line 11438 "" if (! (*shifton)) { -#line 11458 "" +#line 11439 "" i__1 = *iccount - 1; -#line 11458 "" +#line 11439 "" errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"\ "rting one!", (ftnlen)128, (ftnlen)41); -#line 11460 "" +#line 11441 "" stop1_(); -#line 11461 "" +#line 11442 "" } else { -#line 11462 "" +#line 11443 "" *shifton = FALSE_; -#line 11463 "" +#line 11444 "" } -#line 11464 "" +#line 11445 "" } -#line 11465 "" +#line 11446 "" } /* P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) */ -#line 11469 "" +#line 11450 "" if ((npbsc & 26) == 0) { -#line 11469 "" +#line 11450 "" *udsp += fnum; -#line 11469 "" +#line 11450 "" } -#line 11470 "" +#line 11451 "" if (! number && ! bit_test(npbsc,4)) { -#line 11471 "" +#line 11452 "" i__1 = *iccount - 1; -#line 11471 "" +#line 11452 "" errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "\ "in \"X\" symbol!", (ftnlen)128, (ftnlen)51); -#line 11473 "" +#line 11454 "" stop1_(); -#line 11474 "" +#line 11455 "" } -#line 11475 "" +#line 11456 "" return 0; } /* g1etx_ */ @@ -27870,16 +28018,16 @@ L1: /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); -#line 11490 "" +#line 11471 "" i__1 = inbuff_1.ipbuf; -#line 11490 "" +#line 11471 "" s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1); -#line 11491 "" +#line 11472 "" inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; -#line 11492 "" +#line 11473 "" ++inbuff_1.ilbuf; -#line 11493 "" +#line 11474 "" return 0; } /* getbuf_ */ @@ -27898,43 +28046,43 @@ L1: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ -#line 11509 "" +#line 11490 "" if (*iccount == 128) { -#line 11510 "" +#line 11491 "" read10_(lineq, &comget_1.lastchar, (ftnlen)128); -#line 11511 "" +#line 11492 "" if (comget_1.lastchar) { -#line 11511 "" +#line 11492 "" return 0; -#line 11511 "" +#line 11492 "" } -#line 11512 "" +#line 11493 "" if (! commac_1.endmac) { -#line 11513 "" +#line 11494 "" *iccount = 0; -#line 11514 "" +#line 11495 "" } else { -#line 11515 "" +#line 11496 "" commac_1.endmac = FALSE_; -#line 11516 "" +#line 11497 "" *iccount = commac_1.icchold; -#line 11517 "" +#line 11498 "" s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); -#line 11518 "" +#line 11499 "" } -#line 11519 "" +#line 11500 "" if (commac_1.mrecord) { -#line 11520 "" +#line 11501 "" mrec1_(lineq, iccount, &ndxm, (ftnlen)128); -#line 11521 "" +#line 11502 "" } -#line 11522 "" +#line 11503 "" } -#line 11523 "" +#line 11504 "" ++(*iccount); -#line 11524 "" +#line 11505 "" *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; -#line 11525 "" +#line 11506 "" return 0; } /* getchar_ */ @@ -27945,7 +28093,7 @@ L1: address a__1[3]; integer i__1, i__2[3], i__3; real r__1; - char ch__1[4], ch__2[1]; + char ch__1[1], ch__2[4]; icilist ici__1; /* Builtin functions */ @@ -27991,284 +28139,290 @@ L1: /* 01-09 (horizontal offset)/10 + 25.6 notehead widths */ /* 10 5th bit for ivx (5/15/10) */ -#line 11562 "" +#line 11543 "" *irest = bit_set(*irest,26); -#line 11563 "" +#line 11544 "" ++comdyn_1.ndyn; -#line 11564 "" +#line 11545 "" idyn = *ivx; -#line 11565 "" +#line 11546 "" comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0; -#line 11566 "" +#line 11547 "" if (*ivx >= 16) { -#line 11566 "" +#line 11547 "" setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1); -#line 11566 "" +#line 11547 "" } -#line 11567 "" +#line 11548 "" setbits_(&idyn, &c__8, &c__4, ip); -#line 11568 "" +#line 11549 "" i__1 = *iccount; -#line 11568 "" - if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 11549 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 11549 "" + if (s_cmp(lineq + i__1, ch__1, *iccount + 1 - i__1, (ftnlen)1) == 0) { /* text-dynamic */ -#line 11572 "" +#line 11553 "" ++comdyn_1.ntxtdyn; -#line 11573 "" +#line 11554 "" iccountt = *iccount; -#line 11574 "" +#line 11555 "" L3: -#line 11575 "" +#line 11556 "" i__1 = iccountt + 1; -#line 11575 "" - iend = iccountt + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) + - 2; -#line 11576 "" +#line 11556 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 11556 "" + iend = iccountt + i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1) + + 2; +#line 11557 "" i__1 = iend - 3; -#line 11576 "" - if (s_cmp(lineq + i__1, "\\", iend - 2 - i__1, (ftnlen)1) == 0) { -#line 11577 "" +#line 11557 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 11557 "" + if (s_cmp(lineq + i__1, ch__1, iend - 2 - i__1, (ftnlen)1) == 0) { +#line 11558 "" iccountt = iend - 2; -#line 11578 "" +#line 11559 "" goto L3; -#line 11579 "" +#line 11560 "" } -#line 11580 "" +#line 11561 "" i__1 = *iccount + 1; -#line 11580 "" +#line 11561 "" s_copy(comdyn_1.txtdynq + (comdyn_1.ntxtdyn - 1 << 7), lineq + i__1, ( ftnlen)128, iend - 2 - i__1); /* Store ivx, ip in bits 0-12 */ -#line 11584 "" +#line 11565 "" comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5); -#line 11585 "" +#line 11566 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); -#line 11586 "" +#line 11567 "" idno = 0; -#line 11587 "" +#line 11568 "" } else { /* Word-group or hairpin */ -#line 11591 "" +#line 11572 "" for (iend = *iccount + 2; iend <= 128; ++iend) { -#line 11592 "" +#line 11573 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); /* Exit the loop at first blank, "+", or "-" */ -#line 11596 "" +#line 11577 "" if (ipm > 0) { -#line 11596 "" +#line 11577 "" goto L2; -#line 11596 "" +#line 11577 "" } -#line 11597 "" +#line 11578 "" /* L1: */ -#line 11597 "" +#line 11578 "" } -#line 11598 "" +#line 11579 "" L2: -#line 11599 "" +#line 11580 "" i__1 = *iccount; -#line 11599 "" +#line 11580 "" ici__1.icierr = 0; -#line 11599 "" +#line 11580 "" ici__1.iciend = 0; -#line 11599 "" +#line 11580 "" ici__1.icirnum = 1; -#line 11599 "" +#line 11580 "" ici__1.icirlen = iend - 1 - i__1; -#line 11599 "" +#line 11580 "" ici__1.iciunit = lineq + i__1; /* Writing concatenation */ -#line 11599 "" +#line 11580 "" i__2[0] = 2, a__1[0] = "(a"; -#line 11599 "" +#line 11580 "" i__3 = iend + 47 - *iccount; -#line 11599 "" - chax_(ch__2, (ftnlen)1, &i__3); -#line 11599 "" - i__2[1] = 1, a__1[1] = ch__2; -#line 11599 "" +#line 11580 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 11580 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 11580 "" i__2[2] = 1, a__1[2] = ")"; -#line 11599 "" - ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); -#line 11599 "" +#line 11580 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2); +#line 11580 "" s_rsfi(&ici__1); -#line 11599 "" +#line 11580 "" do_fio(&c__1, dynsymq, (ftnlen)4); -#line 11599 "" +#line 11580 "" e_rsfi(); -#line 11601 "" +#line 11582 "" idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff "\ "< > ", dynsymq, (ftnlen)60, (ftnlen)4) + 3) / 4; /* Save for later down */ -#line 11607 "" +#line 11588 "" idno1 = idno; -#line 11608 "" +#line 11589 "" } /* Set flag to check level later if in beam */ -#line 11612 "" +#line 11593 "" *iornq = bit_set(*iornq,23); -#line 11613 "" +#line 11594 "" if (idno >= 14) { /* Hairpin here. Check if opposite type from one that's already on */ -#line 11617 "" +#line 11598 "" if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 && bit_test(comdyn_1.listcresc,*ivx)) { -#line 11619 "" +#line 11600 "" printl_(" ", (ftnlen)1); -#line 11620 "" +#line 11601 "" printl_("Started one kind of hairpin while other is on", (ftnlen) 45); -#line 11621 "" +#line 11602 "" stop1_(); -#line 11622 "" +#line 11603 "" } /* Start or stop? */ -#line 11626 "" +#line 11607 "" if (bit_test(comdyn_1.listcresc,*ivx) || bit_test( comdyn_1.listdecresc,*ivx)) { /* Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. */ -#line 11630 "" +#line 11611 "" if (! comslur_1.fontslur) { -#line 11630 "" +#line 11611 "" idno = 15; -#line 11630 "" +#line 11611 "" } -#line 11631 "" +#line 11612 "" } else if (comslur_1.fontslur) { /* Start of font slur */ -#line 11635 "" +#line 11616 "" idno = 13; -#line 11636 "" +#line 11617 "" } else { /* Start of postscript slur */ -#line 11640 "" +#line 11621 "" --idno; -#line 11641 "" +#line 11622 "" } -#line 11642 "" +#line 11623 "" } /* Now that we used list[de]cresc, update */ -#line 11646 "" +#line 11627 "" if (idno >= 13) { -#line 11647 "" +#line 11628 "" if (idno == 15 || comslur_1.fontslur && idno == 14) { /* Something's ending */ -#line 11651 "" +#line 11632 "" if (bit_test(comdyn_1.listcresc,*ivx)) { /* It's a cresc! */ -#line 11655 "" +#line 11636 "" comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx); -#line 11656 "" +#line 11637 "" } else { -#line 11657 "" +#line 11638 "" comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx); -#line 11658 "" +#line 11639 "" } -#line 11659 "" +#line 11640 "" } else { /* Something's starting */ -#line 11663 "" +#line 11644 "" if (idno1 == 14) { /* It's a cresc! */ -#line 11667 "" +#line 11648 "" comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx); -#line 11668 "" +#line 11649 "" } else { -#line 11669 "" +#line 11650 "" comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx); -#line 11670 "" +#line 11651 "" } -#line 11671 "" +#line 11652 "" } -#line 11672 "" +#line 11653 "" } -#line 11673 "" +#line 11654 "" setbits_(&idyn, &c__4, &c__12, &idno); -#line 11674 "" +#line 11655 "" *iccount = iend; -#line 11675 "" +#line 11656 "" if (ipm != 2) { /* There is a vertical shift */ -#line 11679 "" +#line 11660 "" idyn = bit_set(idyn,16); -#line 11680 "" +#line 11661 "" ++(*iccount); -#line 11681 "" +#line 11662 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11682 "" +#line 11663 "" idno = i_nint(&fnum); -#line 11683 "" +#line 11664 "" i__1 = (ipm - 2) * idno + 64; -#line 11683 "" +#line 11664 "" setbits_(&idyn, &c__7, &c__17, &i__1); -#line 11684 "" +#line 11665 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); -#line 11685 "" +#line 11666 "" if (ipm != 2) { /* There is a horizontal shift */ /* idynda2(ndyn) = ibset(idyn,23) */ -#line 11690 "" +#line 11671 "" comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[ comdyn_1.ndyn - 1],0); -#line 11691 "" +#line 11672 "" ++(*iccount); -#line 11692 "" +#line 11673 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11693 "" +#line 11674 "" r__1 = fnum * 10; -#line 11693 "" +#line 11674 "" idno = i_nint(&r__1); -#line 11694 "" +#line 11675 "" i__1 = (ipm - 2) * idno + 256; -#line 11694 "" +#line 11675 "" setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, & i__1); -#line 11695 "" +#line 11676 "" } /* iccount should be on the blank at the end of the entire symbol */ -#line 11699 "" +#line 11680 "" } -#line 11700 "" +#line 11681 "" comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn; -#line 11701 "" +#line 11682 "" return 0; } /* getdyn_ */ @@ -28300,129 +28454,129 @@ L2: extern integer ifnodur_(integer *, char *, ftnlen); /* * itsofar,nodur,figq,ivupfig,nfigs) */ -#line 11710 "" +#line 11691 "" ++(*nfigs); -#line 11711 "" +#line 11692 "" *ivupfig = 0; -#line 11712 "" +#line 11693 "" *ivvfig = 0; -#line 11713 "" +#line 11694 "" *itoff = 0; -#line 11714 "" +#line 11695 "" if (*(unsigned char *)charq == 'x') { /* Floating figure. */ -#line 11718 "" +#line 11699 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11719 "" +#line 11700 "" ici__1.icierr = 0; -#line 11719 "" +#line 11700 "" ici__1.iciend = 0; -#line 11719 "" +#line 11700 "" ici__1.icirnum = 1; -#line 11719 "" +#line 11700 "" ici__1.icirlen = 1; -#line 11719 "" +#line 11700 "" ici__1.iciunit = charq; -#line 11719 "" +#line 11700 "" ici__1.icifmt = "(i1)"; -#line 11719 "" +#line 11700 "" s_rsfi(&ici__1); -#line 11719 "" +#line 11700 "" do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer)); -#line 11719 "" +#line 11700 "" e_rsfi(); -#line 11720 "" +#line 11701 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11721 "" +#line 11702 "" ici__1.icierr = 0; -#line 11721 "" +#line 11702 "" ici__1.iciend = 0; -#line 11721 "" +#line 11702 "" ici__1.icirnum = 1; -#line 11721 "" +#line 11702 "" ici__1.icirlen = 1; -#line 11721 "" +#line 11702 "" ici__1.iciunit = charq; -#line 11721 "" +#line 11702 "" ici__1.icifmt = "(i1)"; -#line 11721 "" +#line 11702 "" s_rsfi(&ici__1); -#line 11721 "" +#line 11702 "" do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer)); -#line 11721 "" +#line 11702 "" e_rsfi(); -#line 11722 "" +#line 11703 "" *itoff = noff * ifnodur_(&loff, "x", (ftnlen)1); -#line 11723 "" +#line 11704 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11724 "" +#line 11705 "" } else { /* Figure on a note */ -#line 11728 "" +#line 11709 "" *isfig = TRUE_; -#line 11729 "" +#line 11710 "" } -#line 11730 "" +#line 11711 "" *itfig = *itsofar + *itoff - *nodur; -#line 11731 "" +#line 11712 "" lfig = 1; -#line 11732 "" +#line 11713 "" s_copy(figq, charq, (ftnlen)10, (ftnlen)1); -#line 11733 "" +#line 11714 "" L5: -#line 11733 "" +#line 11714 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); /* if (index(' +',charq) .eq. 0) then */ -#line 11735 "" +#line 11716 "" if (i_indx(" +v", charq, (ftnlen)3, (ftnlen)1) == 0) { /* Writing concatenation */ -#line 11736 "" +#line 11717 "" i__1[0] = lfig, a__1[0] = figq; -#line 11736 "" +#line 11717 "" i__1[1] = 1, a__1[1] = charq; -#line 11736 "" +#line 11717 "" s_cat(figq, a__1, i__1, &c__2, (ftnlen)10); -#line 11737 "" +#line 11718 "" ++lfig; -#line 11738 "" +#line 11719 "" goto L5; -#line 11739 "" +#line 11720 "" } else if (*(unsigned char *)charq == '+') { /* Get vertical offset for figure. Next character after number has to be blank. */ -#line 11743 "" +#line 11724 "" ++(*iccount); -#line 11744 "" +#line 11725 "" readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11745 "" +#line 11726 "" *ivupfig = i_nint(&fnum); -#line 11746 "" +#line 11727 "" } else if (*(unsigned char *)charq == 'v') { /* Get vertical change in figdrop. Must be last item in figure word. */ -#line 11750 "" +#line 11731 "" isign = 1; -#line 11751 "" +#line 11732 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11752 "" +#line 11733 "" if (*(unsigned char *)charq == '-') { -#line 11753 "" +#line 11734 "" isign = -1; -#line 11754 "" +#line 11735 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11755 "" +#line 11736 "" } -#line 11756 "" +#line 11737 "" *ivvfig = isign * (*(unsigned char *)charq - 48); -#line 11757 "" +#line 11738 "" } -#line 11758 "" +#line 11739 "" return 0; } /* getfig_ */ @@ -28460,289 +28614,289 @@ L5: /* These data MUST precede note name of first note */ /* nolevg, naccg: lists of levels and accid's, indexed as described above. */ -#line 11792 "" +#line 11773 "" /* Parameter adjustments */ -#line 11792 "" +#line 11773 "" ndlev -= 25; -#line 11792 "" +#line 11773 "" ipl -= 25; -#line 11792 "" +#line 11773 "" --iornq; -#line 11792 "" +#line 11773 "" islur -= 25; -#line 11792 "" +#line 11773 "" --nnl; -#line 11792 "" +#line 11773 "" -#line 11792 "" +#line 11773 "" /* Function Body */ -#line 11792 "" +#line 11773 "" ++comgrace_1.ngrace; -#line 11793 "" +#line 11774 "" comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx; -#line 11794 "" +#line 11775 "" comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1; -#line 11795 "" +#line 11776 "" if (comgrace_1.ngrace == 1) { -#line 11796 "" +#line 11777 "" comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1; -#line 11797 "" +#line 11778 "" } else { -#line 11798 "" +#line 11779 "" comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[ comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2] ; -#line 11799 "" +#line 11780 "" } -#line 11800 "" +#line 11781 "" islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1) * 24],4); -#line 11801 "" +#line 11782 "" comgrace_1.nng[comgrace_1.ngrace - 1] = 1; -#line 11802 "" +#line 11783 "" comgrace_1.multg[comgrace_1.ngrace - 1] = 1; -#line 11803 "" +#line 11784 "" comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_; -#line 11804 "" +#line 11785 "" comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_; -#line 11805 "" +#line 11786 "" comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_; -#line 11806 "" +#line 11787 "" L18: -#line 11806 "" +#line 11787 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11807 "" +#line 11788 "" if (i_indx("WA", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Grace is on note that was already done, so shift flags forward one note. */ /* This puts flag on actual note with grace; later for W will go ahead one more. */ -#line 11812 "" +#line 11793 "" comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx]; -#line 11813 "" +#line 11794 "" islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx] + 1) * 24],4); -#line 11814 "" +#line 11795 "" islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4) ; -#line 11815 "" +#line 11796 "" if (comgrace_1.slurg[comgrace_1.ngrace - 1]) { -#line 11815 "" +#line 11796 "" iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] * 24],24); -#line 11815 "" +#line 11796 "" } -#line 11817 "" +#line 11798 "" if (*(unsigned char *)charq == 'A') { /* close After, clear way-after bit, to ensure priority of most recent A/W */ -#line 11821 "" +#line 11802 "" ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* ivx] * 24],31),29); -#line 11822 "" +#line 11803 "" } else { /* Way after; later assign to following note, and position like normal grace. */ -#line 11826 "" +#line 11807 "" ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* ivx] * 24],29),31); -#line 11827 "" +#line 11808 "" } -#line 11828 "" +#line 11809 "" } else if (*(unsigned char *)charq == 'm') { -#line 11829 "" +#line 11810 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11830 "" +#line 11811 "" comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq - 48; -#line 11831 "" +#line 11812 "" } else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { -#line 11832 "" +#line 11813 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11833 "" +#line 11814 "" --(*iccount); -#line 11834 "" +#line 11815 "" comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum); -#line 11835 "" +#line 11816 "" } else if (*(unsigned char *)charq == 'l') { -#line 11836 "" +#line 11817 "" comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_; -#line 11837 "" +#line 11818 "" } else if (*(unsigned char *)charq == 's') { -#line 11838 "" +#line 11819 "" comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_; -#line 11839 "" +#line 11820 "" if (nnl[*ivx] > 0) { /* If A- or W-grace, set signal to start slur on main note. */ -#line 11843 "" +#line 11824 "" if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx + nnl[*ivx] * 24],29)) { -#line 11843 "" +#line 11824 "" iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] * 24],24); -#line 11843 "" +#line 11824 "" } -#line 11846 "" +#line 11827 "" } -#line 11847 "" +#line 11828 "" } else if (*(unsigned char *)charq == 'x') { -#line 11848 "" +#line 11829 "" comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_; -#line 11849 "" +#line 11830 "" } else if (*(unsigned char *)charq == 'u') { -#line 11850 "" +#line 11831 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note of grace. Number will come next. */ -#line 11854 "" +#line 11835 "" ++(*iccount); -#line 11855 "" +#line 11836 "" readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace - 1], (ftnlen)128, (ftnlen)1); -#line 11856 "" +#line 11837 "" --(*iccount); -#line 11857 "" +#line 11838 "" } -#line 11858 "" +#line 11839 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { -#line 11858 "" +#line 11839 "" goto L18; -#line 11858 "" +#line 11839 "" } /* At this point, charq is first note name in grace */ -#line 11862 "" +#line 11843 "" i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[ comgrace_1.ngrace - 1] - 1; -#line 11862 "" +#line 11843 "" for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) { -#line 11863 "" +#line 11844 "" comgrace_1.naccg[ing - 1] = 0; -#line 11864 "" +#line 11845 "" ioct = 0; -#line 11865 "" +#line 11846 "" if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) { -#line 11866 "" +#line 11847 "" L55: -#line 11866 "" +#line 11847 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 11867 "" +#line 11848 "" if (*(unsigned char *)charq == ' ') { -#line 11867 "" +#line 11848 "" goto L55; -#line 11867 "" +#line 11848 "" } -#line 11868 "" +#line 11849 "" } -#line 11869 "" +#line 11850 "" iclastlev = 0; -#line 11870 "" +#line 11851 "" L9: -#line 11870 "" +#line 11851 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 11871 "" +#line 11852 "" if (*(unsigned char *)durq != ' ') { -#line 11872 "" +#line 11853 "" if (*(unsigned char *)durq == '+') { -#line 11873 "" +#line 11854 "" *lastlev += 7; -#line 11874 "" +#line 11855 "" iclastlev += 7; -#line 11875 "" +#line 11856 "" } else if (*(unsigned char *)durq == '-') { -#line 11876 "" +#line 11857 "" *lastlev += -7; -#line 11877 "" +#line 11858 "" iclastlev += -7; -#line 11878 "" +#line 11859 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { -#line 11879 "" +#line 11860 "" if (comgrace_1.naccg[ing - 1] == 0) { -#line 11880 "" +#line 11861 "" comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); -#line 11881 "" +#line 11862 "" } else { /* Double accidental */ -#line 11885 "" +#line 11866 "" comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing - 1],2); -#line 11886 "" +#line 11867 "" } -#line 11887 "" +#line 11868 "" } else { -#line 11888 "" +#line 11869 "" ioct = *(unsigned char *)durq - 48; -#line 11889 "" +#line 11870 "" } -#line 11890 "" +#line 11871 "" goto L9; -#line 11891 "" +#line 11872 "" } -#line 11892 "" +#line 11873 "" if (ioct > 0) { -#line 11893 "" +#line 11874 "" *lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[ cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1); -#line 11894 "" +#line 11875 "" } else { -#line 11895 "" +#line 11876 "" if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace - 1]) { -#line 11896 "" +#line 11877 "" if (*ivx <= *nv) { -#line 11897 "" +#line 11878 "" kv = 1; -#line 11898 "" +#line 11879 "" } else { -#line 11899 "" +#line 11880 "" kv = 2; -#line 11900 "" +#line 11881 "" } -#line 11901 "" +#line 11882 "" *lastlev = ndlev[*iv + kv * 24] + iclastlev; -#line 11902 "" +#line 11883 "" } -#line 11903 "" +#line 11884 "" *lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, & cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1) - *lastlev + 3) % 7; -#line 11905 "" +#line 11886 "" } -#line 11906 "" +#line 11887 "" comgrace_1.nolevg[ing - 1] = *lastlev; -#line 11907 "" +#line 11888 "" /* L19: */ -#line 11907 "" +#line 11888 "" } /* Grace could come before first note of block, so reset end level. */ -#line 11911 "" +#line 11892 "" if (nnl[*ivx] == 0) { -#line 11912 "" +#line 11893 "" if (*ivx <= *nv) { -#line 11913 "" +#line 11894 "" kv = 1; -#line 11914 "" +#line 11895 "" } else { -#line 11915 "" +#line 11896 "" kv = 2; -#line 11916 "" +#line 11897 "" } -#line 11917 "" +#line 11898 "" ndlev[*iv + kv * 24] = *lastlev; -#line 11918 "" +#line 11899 "" } -#line 11919 "" +#line 11900 "" return 0; } /* getgrace_ */ @@ -28798,166 +28952,166 @@ L9: /* fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */ /* simplifies use of iTransAmt for all calls to ifnolev. */ -#line 11958 "" +#line 11939 "" *(unsigned char *)durq = 'x'; /* Can't initialize in declaration stmt, only works onc */ -#line 11959 "" +#line 11940 "" if (! cominsttrans_1.earlytranson) { -#line 11959 "" +#line 11940 "" cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0; -#line 11959 "" +#line 11940 "" } -#line 11960 "" +#line 11941 "" store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && ! (*from1); -#line 11962 "" +#line 11943 "" cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0; -#line 11963 "" +#line 11944 "" if (store) { -#line 11963 "" +#line 11944 "" cominsttrans_1.ninsttrans = 0; -#line 11963 "" +#line 11944 "" } -#line 11964 "" +#line 11945 "" L1: -#line 11965 "" +#line 11946 "" if (*(unsigned char *)durq == ' ') { -#line 11965 "" +#line 11946 "" return 0; -#line 11965 "" +#line 11946 "" } -#line 11966 "" +#line 11947 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 11967 "" +#line 11948 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 11968 "" +#line 11949 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 11968 "" +#line 11949 "" errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"\ "ere!", (ftnlen)128, (ftnlen)40); -#line 11970 "" +#line 11951 "" stop1_(); -#line 11971 "" +#line 11952 "" } -#line 11972 "" +#line 11953 "" if (store) { -#line 11972 "" +#line 11953 "" ++cominsttrans_1.ninsttrans; -#line 11972 "" +#line 11953 "" } -#line 11973 "" +#line 11954 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11974 "" +#line 11955 "" instn = i_nint(&fnum); -#line 11975 "" +#line 11956 "" if (instn > *noinst) { -#line 11976 "" +#line 11957 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 11976 "" +#line 11957 "" errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", ( ftnlen)128, (ftnlen)31); -#line 11978 "" +#line 11959 "" stop1_(); -#line 11979 "" +#line 11960 "" } -#line 11980 "" +#line 11961 "" if (store) { -#line 11980 "" +#line 11961 "" cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn; -#line 11980 "" +#line 11961 "" } /* durq is +/- following inst # (for iTransAmt), iccount is on it. */ -#line 11984 "" +#line 11965 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 11985 "" +#line 11966 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 11985 "" +#line 11966 "" errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"\ "r must be \"+,-\"!", (ftnlen)128, (ftnlen)52); -#line 11987 "" +#line 11968 "" stop1_(); -#line 11988 "" +#line 11969 "" } -#line 11989 "" +#line 11970 "" itramt = 44 - *(unsigned char *)durq; /* +1/-1 for itramt */ -#line 11990 "" +#line 11971 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 11991 "" +#line 11972 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 11992 "" +#line 11973 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 11992 "" +#line 11973 "" errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"\ " here!", (ftnlen)128, (ftnlen)42); -#line 11994 "" +#line 11975 "" stop1_(); -#line 11995 "" +#line 11976 "" } -#line 11996 "" +#line 11977 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 11997 "" +#line 11978 "" if (store) { -#line 11997 "" +#line 11978 "" cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt; -#line 11997 "" +#line 11978 "" } /* durq is +/- following iTransAmt (for iTransKey), iccount is on it. */ -#line 12001 "" +#line 11982 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { -#line 12002 "" +#line 11983 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12002 "" +#line 11983 "" errmsg_(lineq, iccount, &i__1, "1st character after transposition am"\ "ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55); -#line 12004 "" +#line 11985 "" stop1_(); -#line 12005 "" +#line 11986 "" } -#line 12006 "" +#line 11987 "" ikey = 44 - *(unsigned char *)durq; /* +1/-1 */ -#line 12007 "" +#line 11988 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12008 "" +#line 11989 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 12009 "" +#line 11990 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12009 "" +#line 11990 "" errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!", (ftnlen)128, (ftnlen)35); -#line 12011 "" +#line 11992 "" stop1_(); -#line 12012 "" +#line 11993 "" } -#line 12013 "" +#line 11994 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12014 "" +#line 11995 "" if (store) { -#line 12014 "" +#line 11995 "" cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(& fnum) * ikey; -#line 12014 "" +#line 11995 "" } /* durq is now 1st character after iTransKey, should be either 'i' or ' ' */ -#line 12018 "" +#line 11999 "" if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') { -#line 12019 "" +#line 12000 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12019 "" +#line 12000 "" errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", ( ftnlen)128, (ftnlen)32); -#line 12021 "" +#line 12002 "" stop1_(); -#line 12022 "" +#line 12003 "" } -#line 12023 "" +#line 12004 "" goto L1; } /* getitransinfo_ */ @@ -29001,8 +29155,8 @@ L1: char *, real *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___762 = { 0, 6, 0, "(a)", 0 }; - static cilist io___763 = { 0, 15, 0, "(a)", 0 }; + static cilist io___761 = { 0, 6, 0, "(a)", 0 }; + static cilist io___762 = { 0, 15, 0, "(a)", 0 }; @@ -29021,480 +29175,480 @@ L1: /* bsXobXbaXclXflXreXctXvo */ -#line 12069 "" +#line 12050 "" L1: -#line 12069 "" +#line 12050 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12070 "" +#line 12051 "" if (*(unsigned char *)durq == 't') { /* Tempo in beats ber minute */ -#line 12074 "" +#line 12055 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12075 "" +#line 12056 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 12076 "" +#line 12057 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12076 "" +#line 12057 "" errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ " pause!", (ftnlen)128, (ftnlen)39); -#line 12078 "" +#line 12059 "" stop1_(); -#line 12079 "" +#line 12060 "" } -#line 12080 "" +#line 12061 "" readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1); -#line 12081 "" +#line 12062 "" --(*iccount); -#line 12082 "" +#line 12063 "" if (! (*first)) { -#line 12083 "" +#line 12064 "" i__1 = i_nint(&qpm); -#line 12083 "" +#line 12064 "" midievent_("t", &i__1, &c__0, (ftnlen)1); -#line 12084 "" +#line 12065 "" commmac_1.gottempo = TRUE_; -#line 12085 "" +#line 12066 "" } -#line 12086 "" +#line 12067 "" goto L1; -#line 12087 "" +#line 12068 "" } else if (*(unsigned char *)durq == 'p') { /* Insert a pause. pausemid = pause in 1/4's */ -#line 12091 "" +#line 12072 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12092 "" +#line 12073 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { -#line 12093 "" +#line 12074 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12093 "" +#line 12074 "" errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"\ "ause!", (ftnlen)128, (ftnlen)37); -#line 12095 "" +#line 12076 "" stop1_(); -#line 12096 "" +#line 12077 "" } -#line 12097 "" +#line 12078 "" readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1); -#line 12098 "" +#line 12079 "" --(*iccount); -#line 12099 "" +#line 12080 "" if (! (*first)) { /* Compute a meter for the pause. This is only to keep MidiNotate on track. */ /* Round pause to nearest 16th. Let denominator always be 16. */ -#line 12104 "" +#line 12085 "" r__1 = pausemid * 4; -#line 12104 "" +#line 12085 "" numb16 = i_nint(&r__1); -#line 12105 "" +#line 12086 "" midievent_("m", &numb16, &c__16, (ftnlen)1); /* Put in pausemid beats of rest */ -#line 12109 "" +#line 12090 "" i__1 = commidi_1.numchan - 1; -#line 12109 "" +#line 12090 "" for (icm = 0; icm <= i__1; ++icm) { -#line 12110 "" +#line 12091 "" r__1 = numb16 * 4.f; -#line 12110 "" +#line 12091 "" addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); -#line 12111 "" +#line 12092 "" /* L3: */ -#line 12111 "" +#line 12092 "" } -#line 12112 "" +#line 12093 "" r__1 = pausemid * 240; -#line 12112 "" +#line 12093 "" comevent_1.miditime += i_nint(&r__1); /* Restore meter */ -#line 12116 "" +#line 12097 "" i__1 = *mtrdenl * *lenbar / 64; -#line 12116 "" +#line 12097 "" midievent_("m", &i__1, mtrdenl, (ftnlen)1); -#line 12117 "" +#line 12098 "" } -#line 12118 "" +#line 12099 "" goto L1; -#line 12119 "" +#line 12100 "" } else if (*(unsigned char *)durq == 'i') { /* Instrument numbers or letters. Expect noinst of them. */ -#line 12123 "" +#line 12104 "" i__1 = *noinstarg; -#line 12123 "" +#line 12104 "" for (ivx = 1; ivx <= i__1; ++ivx) { -#line 12124 "" +#line 12105 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12125 "" +#line 12106 "" if (*(unsigned char *)durq > 96) { /* It's a lowercase letter. Get another, find corr. instrument #. */ -#line 12129 "" +#line 12110 "" *(unsigned char *)instq = *(unsigned char *)durq; -#line 12130 "" +#line 12111 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Writing concatenation */ -#line 12131 "" +#line 12112 "" i__2[0] = 1, a__1[0] = instq; -#line 12131 "" +#line 12112 "" i__2[1] = 1, a__1[1] = durq; -#line 12131 "" +#line 12112 "" s_cat(instq, a__1, i__2, &c__2, (ftnlen)2); -#line 12132 "" +#line 12113 "" iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"\ "frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen) 79, (ftnlen)2) / 3; -#line 12134 "" +#line 12115 "" if (iname == 0) { -#line 12135 "" +#line 12116 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12135 "" +#line 12116 "" errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"\ "di instrument name!", (ftnlen)128, (ftnlen)43); -#line 12137 "" +#line 12118 "" stop1_(); -#line 12138 "" +#line 12119 "" } -#line 12139 "" +#line 12120 "" commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1; -#line 12140 "" +#line 12121 "" } else { /* Expect a number, followed by ":" if that is followed by another number. */ /* I.e., if after call to readnum, durq is not ":", it must be either blank */ /* or next instrument letter. */ -#line 12146 "" +#line 12127 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 12147 "" +#line 12128 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12147 "" +#line 12128 "" errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"\ "nt number here!", (ftnlen)128, (ftnlen)39); -#line 12149 "" +#line 12130 "" stop1_(); -#line 12150 "" +#line 12131 "" } -#line 12151 "" +#line 12132 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12152 "" +#line 12133 "" commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1; -#line 12153 "" +#line 12134 "" if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx - 1] > 255) { -#line 12154 "" +#line 12135 "" i__3 = *iccount - 1; -#line 12154 "" +#line 12135 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12154 "" +#line 12135 "" errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"\ "t be in range 1-128!", (ftnlen)128, (ftnlen)46); -#line 12156 "" +#line 12137 "" stop1_(); -#line 12157 "" +#line 12138 "" } -#line 12158 "" +#line 12139 "" if (*(unsigned char *)durq != ':') { -#line 12158 "" +#line 12139 "" --(*iccount); -#line 12158 "" +#line 12139 "" } -#line 12159 "" +#line 12140 "" } -#line 12160 "" +#line 12141 "" /* L2: */ -#line 12160 "" +#line 12141 "" } -#line 12161 "" +#line 12142 "" goto L1; -#line 12162 "" +#line 12143 "" } else if (*(unsigned char *)durq == 'v') { /* Get volumes for each instrument. Expect noinst of them. */ /* Follow same pattern as for insttrument numbers above. */ -#line 12167 "" +#line 12148 "" i__1 = *noinstarg; -#line 12167 "" +#line 12148 "" for (ivx = 1; ivx <= i__1; ++ivx) { -#line 12168 "" +#line 12149 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12169 "" +#line 12150 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 12170 "" +#line 12151 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12170 "" +#line 12151 "" errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"\ "ber here!", (ftnlen)128, (ftnlen)37); -#line 12172 "" +#line 12153 "" stop1_(); -#line 12173 "" +#line 12154 "" } -#line 12174 "" +#line 12155 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12175 "" +#line 12156 "" commvel_2.midivel[ivx - 1] = i_nint(&fnum) - 1; -#line 12176 "" +#line 12157 "" if (commvel_2.midivel[ivx - 1] < 0 || commvel_2.midivel[ivx - 1] > 127) { -#line 12177 "" +#line 12158 "" i__3 = *iccount - 1; -#line 12177 "" +#line 12158 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12177 "" +#line 12158 "" errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"\ " 1-128!", (ftnlen)128, (ftnlen)37); -#line 12179 "" +#line 12160 "" stop1_(); -#line 12180 "" +#line 12161 "" } -#line 12181 "" +#line 12162 "" if (*(unsigned char *)durq != ':') { -#line 12181 "" +#line 12162 "" --(*iccount); -#line 12181 "" +#line 12162 "" } -#line 12182 "" +#line 12163 "" /* L7: */ -#line 12182 "" +#line 12163 "" } -#line 12183 "" +#line 12164 "" if (! (*first)) { -#line 12184 "" +#line 12165 "" inst2chan_(commvel_2.midvelc, commvel_2.midivel, commidi_1.midchan, nv, commvel_2.iinsiv, commidi_1.twoline); -#line 12185 "" +#line 12166 "" } -#line 12186 "" +#line 12167 "" goto L1; -#line 12187 "" +#line 12168 "" } else if (*(unsigned char *)durq == 'b') { /* Get balance for each instrument. Expect noinst of them. */ /* Follow same pattern as for instrument numbers above. */ -#line 12192 "" +#line 12173 "" i__1 = *noinstarg; -#line 12192 "" +#line 12173 "" for (ivx = 1; ivx <= i__1; ++ivx) { -#line 12193 "" +#line 12174 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12194 "" +#line 12175 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 12195 "" +#line 12176 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12195 "" +#line 12176 "" errmsg_(lineq, iccount, &i__3, "Expected a balance number he"\ "re!", (ftnlen)128, (ftnlen)31); -#line 12197 "" +#line 12178 "" stop1_(); -#line 12198 "" +#line 12179 "" } -#line 12199 "" +#line 12180 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12200 "" +#line 12181 "" commvel_2.midibal[ivx - 1] = i_nint(&fnum) - 1; -#line 12201 "" +#line 12182 "" if (commvel_2.midibal[ivx - 1] < 0 || commvel_2.midibal[ivx - 1] > 127) { -#line 12202 "" +#line 12183 "" i__3 = *iccount - 1; -#line 12202 "" +#line 12183 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12202 "" +#line 12183 "" errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "\ "1-128!", (ftnlen)128, (ftnlen)36); -#line 12204 "" +#line 12185 "" stop1_(); -#line 12205 "" +#line 12186 "" } -#line 12206 "" +#line 12187 "" if (*(unsigned char *)durq != ':') { -#line 12206 "" +#line 12187 "" --(*iccount); -#line 12206 "" +#line 12187 "" } -#line 12207 "" +#line 12188 "" /* L8: */ -#line 12207 "" +#line 12188 "" } -#line 12208 "" +#line 12189 "" if (! (*first)) { -#line 12209 "" +#line 12190 "" inst2chan_(commvel_2.midbc, commvel_2.midibal, commidi_1.midchan, nv, commvel_2.iinsiv, commidi_1.twoline); -#line 12210 "" +#line 12191 "" } -#line 12211 "" +#line 12192 "" goto L1; -#line 12212 "" +#line 12193 "" } else if (*(unsigned char *)durq == 'T') { /* Get transposition for each instrument. Expect noinst of them. */ /* Follow similar pattern as above, but separator is +|-. */ -#line 12217 "" +#line 12198 "" i__1 = *noinstarg; -#line 12217 "" +#line 12198 "" for (ivx = 1; ivx <= i__1; ++ivx) { -#line 12218 "" +#line 12199 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12219 "" +#line 12200 "" ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1); -#line 12220 "" +#line 12201 "" if (ipm == 0) { -#line 12221 "" +#line 12202 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12221 "" +#line 12202 "" errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "\ "midi transposition here!", (ftnlen)128, (ftnlen)48); -#line 12223 "" +#line 12204 "" stop1_(); -#line 12224 "" +#line 12205 "" } -#line 12225 "" +#line 12206 "" ipm = (ipm << 1) - 3; -#line 12226 "" +#line 12207 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12227 "" +#line 12208 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 12228 "" +#line 12209 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12228 "" +#line 12209 "" errmsg_(lineq, iccount, &i__3, "Expected a number here!", ( ftnlen)128, (ftnlen)23); -#line 12230 "" +#line 12211 "" stop1_(); -#line 12231 "" +#line 12212 "" } -#line 12232 "" +#line 12213 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12233 "" +#line 12214 "" commvel_2.miditran[ivx - 1] = ipm * i_nint(&fnum); /* if (mod(miditran(ivx),12).ne. 0) then */ /* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ /* * 'Midi transposition limited to multiples of 12!') */ /* call stop1() */ /* end if */ -#line 12239 "" +#line 12220 "" --(*iccount); -#line 12240 "" +#line 12221 "" /* L9: */ -#line 12240 "" +#line 12221 "" } -#line 12241 "" +#line 12222 "" if (! (*first)) { -#line 12242 "" +#line 12223 "" inst2chan_(commvel_2.midtc, commvel_2.miditran, commidi_1.midchan, nv, commvel_2.iinsiv, commidi_1.twoline); -#line 12243 "" +#line 12224 "" } -#line 12244 "" +#line 12225 "" goto L1; -#line 12245 "" +#line 12226 "" } else if (*(unsigned char *)durq == 'g') { -#line 12246 "" +#line 12227 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12247 "" +#line 12228 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { -#line 12248 "" +#line 12229 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12248 "" +#line 12229 "" errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ " midi gap!", (ftnlen)128, (ftnlen)42); -#line 12250 "" +#line 12231 "" stop1_(); -#line 12251 "" +#line 12232 "" } -#line 12252 "" +#line 12233 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12253 "" +#line 12234 "" commidi_1.mgap = i_nint(&fnum); -#line 12254 "" +#line 12235 "" --(*iccount); -#line 12255 "" +#line 12236 "" goto L1; -#line 12256 "" +#line 12237 "" } else if (*(unsigned char *)durq == 'M') { /* MidiMacros */ -#line 12260 "" +#line 12241 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12261 "" +#line 12242 "" if (*(unsigned char *)durq == 'R') { /* Start recording */ -#line 12265 "" +#line 12246 "" if (commmac_1.mmacrec) { -#line 12266 "" +#line 12247 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12266 "" +#line 12247 "" errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"\ "cro while already recording!", (ftnlen)128, (ftnlen) 56); -#line 12268 "" +#line 12249 "" stop1_(); -#line 12269 "" +#line 12250 "" } -#line 12270 "" +#line 12251 "" commmac_1.mmacrec = TRUE_; -#line 12271 "" +#line 12252 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12272 "" +#line 12253 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 12273 "" +#line 12254 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12273 "" +#line 12254 "" errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ " here!", (ftnlen)128, (ftnlen)34); -#line 12275 "" +#line 12256 "" stop1_(); -#line 12276 "" +#line 12257 "" } -#line 12277 "" +#line 12258 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12278 "" +#line 12259 "" --(*iccount); -#line 12279 "" +#line 12260 "" if (! (*first)) { -#line 12280 "" +#line 12261 "" commmac_1.immac = i_nint(&fnum); -#line 12281 "" +#line 12262 "" if (commmac_1.immac > 20) { -#line 12282 "" +#line 12263 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12282 "" +#line 12263 "" errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"\ "ed 20!", (ftnlen)128, (ftnlen)30); -#line 12284 "" +#line 12265 "" stop1_(); -#line 12285 "" +#line 12266 "" } /* Save the start time */ -#line 12289 "" +#line 12270 "" commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime; -#line 12290 "" +#line 12271 "" i__1 = commidi_1.numchan; -#line 12290 "" +#line 12271 "" for (icm = 0; icm <= i__1; ++icm) { -#line 12291 "" +#line 12272 "" if (icm < commidi_1.numchan) { -#line 12292 "" +#line 12273 "" if (commidi_1.restpend[icm]) { /* Adjust if there's a rest at end of prior section. Insert dummy turnoff. */ @@ -29503,294 +29657,294 @@ L1: /* Before: section1 ------rest------- section2(to be recorded) */ /* After: section1 rest1 now rest2 section2(recorded) */ -#line 12300 "" +#line 12281 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); -#line 12301 "" +#line 12282 "" commidi_1.trest[icm] = 0.f; -#line 12302 "" +#line 12283 "" commidi_1.restpend[icm] = FALSE_; -#line 12303 "" +#line 12284 "" } -#line 12304 "" +#line 12285 "" } else { -#line 12305 "" +#line 12286 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track */ -#line 12309 "" +#line 12290 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; -#line 12309 "" +#line 12290 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); -#line 12311 "" +#line 12292 "" comevent_1.lasttime = comevent_1.miditime; -#line 12312 "" +#line 12293 "" } -#line 12313 "" +#line 12294 "" } -#line 12314 "" +#line 12295 "" commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] = commidi_1.imidi[icm] + 1; -#line 12315 "" +#line 12296 "" /* L4: */ -#line 12315 "" +#line 12296 "" } -#line 12316 "" +#line 12297 "" } -#line 12317 "" +#line 12298 "" goto L1; -#line 12318 "" +#line 12299 "" } else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) { /* End recording; close the open macro. Get immac from common. */ -#line 12322 "" +#line 12303 "" if (! commmac_1.mmacrec) { -#line 12323 "" +#line 12304 "" i__1 = *iccount - 1; -#line 12323 "" +#line 12304 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12323 "" +#line 12304 "" errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"\ "efore starting one!", (ftnlen)128, (ftnlen)49); -#line 12325 "" +#line 12306 "" stop1_(); -#line 12326 "" +#line 12307 "" } -#line 12327 "" +#line 12308 "" commmac_1.mmacrec = FALSE_; -#line 12328 "" +#line 12309 "" --(*iccount); -#line 12329 "" +#line 12310 "" if (! (*first)) { /* Save the macro duration */ -#line 12333 "" +#line 12314 "" commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime - commmac_1.mmactime[commmac_1.immac - 1]; -#line 12334 "" +#line 12315 "" i__1 = commidi_1.numchan; -#line 12334 "" +#line 12315 "" for (icm = 0; icm <= i__1; ++icm) { -#line 12335 "" +#line 12316 "" if (icm < commidi_1.numchan) { -#line 12336 "" +#line 12317 "" if (commidi_1.restpend[icm]) { -#line 12337 "" +#line 12318 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); -#line 12338 "" +#line 12319 "" commidi_1.trest[icm] = 0.f; -#line 12339 "" +#line 12320 "" commidi_1.restpend[icm] = FALSE_; -#line 12340 "" +#line 12321 "" } -#line 12341 "" +#line 12322 "" } else { -#line 12342 "" +#line 12323 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track if needed. */ -#line 12346 "" +#line 12327 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; -#line 12346 "" +#line 12327 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); -#line 12348 "" +#line 12329 "" comevent_1.lasttime = comevent_1.miditime; -#line 12349 "" +#line 12330 "" } -#line 12350 "" +#line 12331 "" } -#line 12351 "" +#line 12332 "" commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] = commidi_1.imidi[icm]; -#line 12352 "" +#line 12333 "" /* L5: */ -#line 12352 "" +#line 12333 "" } -#line 12353 "" +#line 12334 "" } -#line 12354 "" +#line 12335 "" if (*(unsigned char *)durq != ' ') { -#line 12354 "" +#line 12335 "" goto L1; -#line 12354 "" +#line 12335 "" } -#line 12355 "" +#line 12336 "" } else if (*(unsigned char *)durq == 'P') { /* Play Back a Macro */ -#line 12359 "" +#line 12340 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12360 "" +#line 12341 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 12361 "" +#line 12342 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12361 "" +#line 12342 "" errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ " here!", (ftnlen)128, (ftnlen)34); -#line 12363 "" +#line 12344 "" stop1_(); -#line 12364 "" +#line 12345 "" } -#line 12365 "" +#line 12346 "" if (commmac_1.mmacrec) { -#line 12366 "" +#line 12347 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12366 "" +#line 12347 "" errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"\ "o before ending recording!", (ftnlen)128, (ftnlen)54); -#line 12368 "" +#line 12349 "" stop1_(); -#line 12369 "" +#line 12350 "" } -#line 12370 "" +#line 12351 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 12371 "" +#line 12352 "" --(*iccount); -#line 12372 "" +#line 12353 "" if (! (*first)) { -#line 12373 "" +#line 12354 "" commmac_1.immac = i_nint(&fnum); -#line 12374 "" +#line 12355 "" if (commmac_1.mmactime[commmac_1.immac - 1] == 0) { -#line 12375 "" +#line 12356 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12375 "" +#line 12356 "" errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"\ " before recording it!", (ftnlen)128, (ftnlen)45); -#line 12377 "" +#line 12358 "" stop1_(); -#line 12378 "" +#line 12359 "" } -#line 12379 "" +#line 12360 "" i__1 = commidi_1.numchan; -#line 12379 "" +#line 12360 "" for (icm = 0; icm <= i__1; ++icm) { -#line 12380 "" +#line 12361 "" if (icm < commidi_1.numchan) { -#line 12381 "" +#line 12362 "" if (commidi_1.restpend[icm]) { -#line 12382 "" +#line 12363 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); -#line 12383 "" +#line 12364 "" commidi_1.trest[icm] = 0.f; -#line 12384 "" +#line 12365 "" commidi_1.restpend[icm] = FALSE_; -#line 12385 "" +#line 12366 "" } -#line 12386 "" +#line 12367 "" } else { -#line 12387 "" +#line 12368 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track */ -#line 12391 "" +#line 12372 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; -#line 12391 "" +#line 12372 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); -#line 12393 "" +#line 12374 "" } -#line 12394 "" +#line 12375 "" } -#line 12395 "" +#line 12376 "" commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] = commidi_1.imidi[icm]; -#line 12396 "" +#line 12377 "" commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 - 25] = commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25]; -#line 12397 "" +#line 12378 "" commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25] = commmac_1.mmacend[icm + commmac_1.immac * 25 - 25]; -#line 12398 "" +#line 12379 "" commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 - 25] = commidi_1.imidi[icm] + 1; -#line 12399 "" +#line 12380 "" /* L6: */ -#line 12399 "" +#line 12380 "" } -#line 12400 "" +#line 12381 "" commmac_1.nmidsec += 2; /* Update running time */ -#line 12404 "" +#line 12385 "" comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1] ; -#line 12405 "" +#line 12386 "" comevent_1.lasttime = comevent_1.miditime; -#line 12406 "" +#line 12387 "" } -#line 12407 "" +#line 12388 "" goto L1; -#line 12408 "" +#line 12389 "" } else { -#line 12409 "" +#line 12390 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12409 "" +#line 12390 "" errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"\ "ub-command!", (ftnlen)128, (ftnlen)43); -#line 12411 "" +#line 12392 "" stop1_(); -#line 12412 "" +#line 12393 "" } -#line 12413 "" +#line 12394 "" } else if (*(unsigned char *)durq == 'd') { -#line 12414 "" +#line 12395 "" commidi_1.debugmidi = TRUE_; -#line 12415 "" +#line 12396 "" goto L1; -#line 12416 "" +#line 12397 "" } else if (*(unsigned char *)durq != ' ') { -#line 12417 "" +#line 12398 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 12417 "" +#line 12398 "" errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!" , (ftnlen)128, (ftnlen)37); -#line 12419 "" - s_wsfe(&io___762); -#line 12419 "" +#line 12400 "" + s_wsfe(&io___761); +#line 12400 "" do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\ "should be noinst, not nv", (ftnlen)77); -#line 12419 "" +#line 12400 "" e_wsfe(); -#line 12422 "" - s_wsfe(&io___763); -#line 12422 "" +#line 12403 "" + s_wsfe(&io___762); +#line 12403 "" do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\ "should be noinst, not nv", (ftnlen)77); -#line 12422 "" +#line 12403 "" e_wsfe(); -#line 12425 "" +#line 12406 "" stop1_(); -#line 12426 "" +#line 12407 "" } -#line 12427 "" +#line 12408 "" if (! commmac_1.gottempo && ! (*first)) { /* If no tempo is set on first call on the pmxb pass, then set it */ -#line 12431 "" +#line 12412 "" midievent_("t", &c__96, &c__0, (ftnlen)1); -#line 12432 "" +#line 12413 "" commmac_1.gottempo = TRUE_; -#line 12433 "" +#line 12414 "" } -#line 12434 "" +#line 12415 "" return 0; } /* getmidi_ */ @@ -29912,37 +30066,38 @@ L1: static integer lvoltxt, ltopnam; /* Fortran I/O blocks */ - static cilist io___768 = { 0, 11, 0, "(a)", 0 }; - static cilist io___776 = { 0, 6, 0, 0, 0 }; + static cilist io___767 = { 0, 11, 0, "(a)", 0 }; + static cilist io___775 = { 0, 6, 0, 0, 0 }; + static cilist io___786 = { 0, 6, 0, 0, 0 }; static cilist io___787 = { 0, 6, 0, 0, 0 }; - static cilist io___788 = { 0, 6, 0, 0, 0 }; + static cilist io___798 = { 0, 6, 0, 0, 0 }; static cilist io___799 = { 0, 6, 0, 0, 0 }; - static cilist io___800 = { 0, 6, 0, 0, 0 }; + static cilist io___815 = { 0, 6, 0, 0, 0 }; static cilist io___816 = { 0, 6, 0, 0, 0 }; static cilist io___817 = { 0, 6, 0, 0, 0 }; - static cilist io___818 = { 0, 6, 0, 0, 0 }; - static cilist io___820 = { 0, 6, 0, 0, 0 }; + static cilist io___819 = { 0, 6, 0, 0, 0 }; + static cilist io___824 = { 0, 11, 0, "(a)", 0 }; static cilist io___825 = { 0, 11, 0, "(a)", 0 }; - static cilist io___826 = { 0, 11, 0, "(a)", 0 }; + static cilist io___828 = { 0, 11, 0, "(a)", 0 }; static cilist io___829 = { 0, 11, 0, "(a)", 0 }; static cilist io___830 = { 0, 11, 0, "(a)", 0 }; static cilist io___831 = { 0, 11, 0, "(a)", 0 }; static cilist io___832 = { 0, 11, 0, "(a)", 0 }; - static cilist io___833 = { 0, 11, 0, "(a)", 0 }; - static cilist io___834 = { 0, 11, 0, "(a11,i2,a)", 0 }; - static cilist io___835 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___837 = { 0, 11, 0, "(a8,i1,a3)", 0 }; - static cilist io___838 = { 0, 11, 0, "(a9,i2,a4)", 0 }; - static cilist io___839 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___840 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___833 = { 0, 11, 0, "(a11,i2,a)", 0 }; + static cilist io___834 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___836 = { 0, 11, 0, "(a8,i1,a3)", 0 }; + static cilist io___837 = { 0, 11, 0, "(a9,i2,a4)", 0 }; + static cilist io___838 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___839 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___840 = { 0, 6, 0, 0, 0 }; static cilist io___841 = { 0, 6, 0, 0, 0 }; - static cilist io___842 = { 0, 6, 0, 0, 0 }; - static cilist io___851 = { 0, 6, 0, 0, 0 }; + static cilist io___850 = { 0, 6, 0, 0, 0 }; + static cilist io___852 = { 0, 11, 0, "(a)", 0 }; static cilist io___853 = { 0, 11, 0, "(a)", 0 }; static cilist io___854 = { 0, 11, 0, "(a)", 0 }; static cilist io___855 = { 0, 11, 0, "(a)", 0 }; - static cilist io___856 = { 0, 11, 0, "(a)", 0 }; - static cilist io___858 = { 0, 11, 0, "(a)", 0 }; + static cilist io___857 = { 0, 11, 0, "(a)", 0 }; + static cilist io___860 = { 0, 11, 0, "(a)", 0 }; static cilist io___861 = { 0, 11, 0, "(a)", 0 }; static cilist io___862 = { 0, 11, 0, "(a)", 0 }; static cilist io___863 = { 0, 11, 0, "(a)", 0 }; @@ -29950,108 +30105,110 @@ L1: static cilist io___865 = { 0, 11, 0, "(a)", 0 }; static cilist io___866 = { 0, 11, 0, "(a)", 0 }; static cilist io___867 = { 0, 11, 0, "(a)", 0 }; - static cilist io___868 = { 0, 11, 0, "(a)", 0 }; /* nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined */ /* ivx is current ivmx, and is the index for all notes, acc's etc. */ -#line 12560 "" +#line 12541 "" cdot = FALSE_; -#line 12561 "" +#line 12542 "" inxtup = FALSE_; -#line 12562 "" +#line 12543 "" L1: -#line 12562 "" +#line 12543 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 12563 "" +#line 12544 "" if (comget_1.lastchar) { -#line 12563 "" +#line 12544 "" return 0; -#line 12563 "" +#line 12544 "" } -#line 12564 "" +#line 12545 "" if (*(unsigned char *)charq == ' ') { -#line 12564 "" +#line 12545 "" goto L1; -#line 12564 "" +#line 12545 "" } -#line 12565 "" +#line 12546 "" if (*(unsigned char *)charq == '%') { /* Check for a bar number format: */ -#line 12569 "" +#line 12550 "" if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' && i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0) { -#line 12571 "" +#line 12552 "" if (comlast_1.islast) { -#line 12571 "" - s_wsfe(&io___768); -#line 12571 "" +#line 12552 "" + s_wsfe(&io___767); +#line 12552 "" do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128)); -#line 12571 "" +#line 12552 "" e_wsfe(); -#line 12571 "" +#line 12552 "" } -#line 12572 "" +#line 12553 "" } -#line 12573 "" +#line 12554 "" all_1.iccount = 128; -#line 12574 "" +#line 12555 "" goto L1; -#line 12575 "" +#line 12556 "" } /* Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */ -#line 12579 "" +#line 12560 "" if (comget_1.rptprev) { -#line 12580 "" - comget_1.rptnd1 = *(unsigned char *)charq == '/'; -#line 12581 "" +#line 12561 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 12561 "" + comget_1.rptnd1 = *(unsigned char *)charq == *(unsigned char *)&ch__1[ + 0]; +#line 12562 "" comget_1.rptprev = FALSE_; -#line 12582 "" +#line 12563 "" } /* Repeat at end of a piece */ -#line 12586 "" +#line 12567 "" if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *( unsigned char *)charq == 'r') { -#line 12588 "" +#line 12569 "" if (cdot) { -#line 12588 "" +#line 12569 "" goto L28; -#line 12588 "" +#line 12569 "" } /* This is a note/rest. */ -#line 12592 "" +#line 12573 "" idotform = 0; -#line 12593 "" +#line 12574 "" numnum = 0; /* If start of line of music, set pitch from previous */ -#line 12597 "" +#line 12578 "" if (commvl_1.ivx <= all_1.nv) { -#line 12598 "" +#line 12579 "" kv = 1; -#line 12599 "" +#line 12580 "" } else { -#line 12600 "" +#line 12581 "" kv = 2; -#line 12601 "" +#line 12582 "" } -#line 12602 "" +#line 12583 "" if (all_1.nnl[commvl_1.ivx - 1] == 0) { -#line 12602 "" +#line 12583 "" comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25]; -#line 12602 "" +#line 12583 "" } /* notcrd is used to tell if orn. goes on main note or chord note */ @@ -30060,63 +30217,63 @@ L1: /* Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */ -#line 12610 "" +#line 12591 "" L28: /* Moved this from just above, 2 Feb 02 */ -#line 12614 "" +#line 12595 "" comnotes_1.notcrd = TRUE_; -#line 12615 "" +#line 12596 "" ++all_1.nnl[commvl_1.ivx - 1]; -#line 12616 "" +#line 12597 "" if (comget_1.ornrpt) { /* Replicate ornament bits, also bit 23 for beam handling if chord. */ -#line 12620 "" +#line 12601 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx - 1]; -#line 12621 "" +#line 12602 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ -#line 12625 "" +#line 12606 "" ++comtrill_1.ntrill; -#line 12626 "" +#line 12607 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; -#line 12627 "" +#line 12608 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; -#line 12628 "" +#line 12609 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[ comtrill_1.ntrill - 2]; -#line 12629 "" +#line 12610 "" } -#line 12630 "" +#line 12611 "" } -#line 12631 "" +#line 12612 "" if (comget_1.stickys) { /* Grab stemlength shortening parameters from prior note */ -#line 12635 "" +#line 12616 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); /* call setbits (mult(ivx,nnl(ivx)),3,28, */ /* * igetbits(mult(ivx,nnl(ivx)-1),3,28)) */ -#line 12638 "" +#line 12619 "" i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10); -#line 12638 "" +#line 12619 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); -#line 12640 "" +#line 12621 "" } -#line 12641 "" +#line 12622 "" if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && ! comget_1.fbon) { @@ -30124,514 +30281,514 @@ L28: /* starts a period. */ /* if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */ -#line 12647 "" +#line 12628 "" r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; -#line 12647 "" +#line 12628 "" if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { /* Start a forced beam here */ -#line 12651 "" +#line 12632 "" ++comfb_1.nfb[commvl_1.ivx - 1]; -#line 12652 "" +#line 12633 "" comget_1.fbon = TRUE_; -#line 12653 "" +#line 12634 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ commvl_1.ivx - 1] * 24 - 25] = 'x'; -#line 12654 "" +#line 12635 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; -#line 12655 "" +#line 12636 "" } -#line 12656 "" +#line 12637 "" } -#line 12657 "" +#line 12638 "" if (comget_1.fbon) { -#line 12657 "" +#line 12638 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); -#line 12657 "" +#line 12638 "" } -#line 12658 "" +#line 12639 "" *(unsigned char *)dotq = 'x'; -#line 12659 "" +#line 12640 "" if (*(unsigned char *)charq == 'r') { -#line 12659 "" +#line 12640 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0); -#line 12659 "" +#line 12640 "" } -#line 12661 "" +#line 12642 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { /* Rest stuff. First check if previous note was full-bar-pause */ -#line 12665 "" +#line 12646 "" i__1 = all_1.iccount; -#line 12665 "" +#line 12646 "" if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1) == 0 && all_1.nnl[commvl_1.ivx - 1] > 1) { -#line 12667 "" +#line 12648 "" if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25],19)) { -#line 12667 "" +#line 12648 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); -#line 12667 "" +#line 12648 "" } -#line 12669 "" +#line 12650 "" } /* Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 */ /* for voice a or b. Set a-types at 0 as encountered and adjust later */ /* after '//'. (Override heights will be set to 100+offset) */ -#line 12675 "" +#line 12656 "" if (commvl_1.ivx <= all_1.nv) { -#line 12676 "" +#line 12657 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; -#line 12677 "" +#line 12658 "" } else { -#line 12678 "" +#line 12659 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 2; -#line 12679 "" +#line 12660 "" } -#line 12680 "" +#line 12661 "" } -#line 12681 "" +#line 12662 "" L2: -#line 12681 "" +#line 12662 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12682 "" +#line 12663 "" ic = *(unsigned char *)durq; -#line 12683 "" +#line 12664 "" if (ic <= 57 && ic >= 48) { /* Digit */ -#line 12687 "" +#line 12668 "" if (numnum == 0) { -#line 12688 "" +#line 12669 "" comnotes_1.nnodur = ic - 48; -#line 12689 "" +#line 12670 "" numnum = 1; -#line 12690 "" +#line 12671 "" goto L2; -#line 12691 "" +#line 12672 "" } else if (numnum == 1) { -#line 12692 "" +#line 12673 "" ioct = ic - 48; -#line 12693 "" +#line 12674 "" numnum = 2; -#line 12694 "" +#line 12675 "" goto L2; -#line 12695 "" +#line 12676 "" } else { -#line 12696 "" - s_wsle(&io___776); -#line 12696 "" +#line 12677 "" + s_wsle(&io___775); +#line 12677 "" do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", ( ftnlen)31); -#line 12696 "" +#line 12677 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); -#line 12696 "" +#line 12677 "" do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( ftnlen)sizeof(integer)); -#line 12696 "" +#line 12677 "" e_wsle(); -#line 12697 "" +#line 12678 "" stop1_(); -#line 12698 "" +#line 12679 "" } -#line 12699 "" +#line 12680 "" } else if (*(unsigned char *)durq == 'd') { -#line 12700 "" +#line 12681 "" *(unsigned char *)dotq = *(unsigned char *)durq; -#line 12701 "" +#line 12682 "" i__1 = all_1.iccount; -#line 12701 "" +#line 12682 "" if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1) == 0) { /* Double dot. */ -#line 12705 "" +#line 12686 "" ++all_1.iccount; -#line 12706 "" +#line 12687 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],3); -#line 12707 "" +#line 12688 "" } -#line 12708 "" +#line 12689 "" i__1 = all_1.iccount; -#line 12708 "" +#line 12689 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 - i__1) > 0) { /* move a dot, unless next char is not part of a number */ -#line 12712 "" +#line 12693 "" i__1 = all_1.iccount + 1; -#line 12712 "" +#line 12693 "" if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, all_1.iccount + 2 - i__1) == 0) { -#line 12712 "" +#line 12693 "" goto L2; -#line 12712 "" +#line 12693 "" } -#line 12714 "" +#line 12695 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); -#line 12715 "" +#line 12696 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12716 "" +#line 12697 "" ++comcc_1.ndotmv[commvl_1.ivx - 1]; -#line 12717 "" +#line 12698 "" ++all_1.iccount; -#line 12718 "" +#line 12699 "" readnum_(lineq, &all_1.iccount, dumq, &comcc_1.updot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); -#line 12719 "" +#line 12700 "" if (*(unsigned char *)durq == '-') { -#line 12719 "" +#line 12700 "" comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25] = -comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25]; -#line 12719 "" +#line 12700 "" } -#line 12721 "" +#line 12702 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ -#line 12725 "" +#line 12706 "" ++all_1.iccount; -#line 12726 "" +#line 12707 "" readnum_(lineq, &all_1.iccount, durq, &comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); -#line 12727 "" +#line 12708 "" if (*(unsigned char *)dumq == '-') { -#line 12727 "" +#line 12708 "" comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25] = -comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25]; -#line 12727 "" +#line 12708 "" } -#line 12729 "" +#line 12710 "" } else { -#line 12730 "" +#line 12711 "" comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25] = 0.f; -#line 12731 "" +#line 12712 "" } -#line 12732 "" +#line 12713 "" --all_1.iccount; -#line 12733 "" +#line 12714 "" } -#line 12734 "" +#line 12715 "" goto L2; -#line 12735 "" +#line 12716 "" } else if (*(unsigned char *)durq == 'p') { /* Full-bar rest as pause */ -#line 12739 "" +#line 12720 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); -#line 12740 "" +#line 12721 "" goto L2; -#line 12741 "" +#line 12722 "" } else if (*(unsigned char *)durq == 'b') { /* Blank rest */ -#line 12745 "" +#line 12726 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],29); -#line 12746 "" +#line 12727 "" goto L2; -#line 12747 "" +#line 12728 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Accidental */ /* if (nacc(ivx,nnl(ivx)) .eq. 0) then */ /* 171209 May have set bit 18 earlier if D or F preceded accidental */ -#line 12753 "" +#line 12734 "" if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__2, &c__0) == 0) { /* No accidental has been set yet */ /* nacc(ivx,nnl(ivx)) = index('fsn',durq) */ -#line 12758 "" +#line 12739 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] |= i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); -#line 12760 "" +#line 12741 "" } else { /* Repeated accid, so must be double */ -#line 12764 "" +#line 12745 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],2); -#line 12765 "" +#line 12746 "" } -#line 12766 "" +#line 12747 "" goto L2; -#line 12767 "" +#line 12748 "" } else if (*(unsigned char *)durq == 'i') { /* Set flag for MIDI-only accidental. */ -#line 12771 "" +#line 12752 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); -#line 12772 "" +#line 12753 "" goto L2; -#line 12773 "" +#line 12754 "" } else if (*(unsigned char *)durq == 'c') { /* Set flags for cautionary accidental */ -#line 12777 "" +#line 12758 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],31); -#line 12778 "" +#line 12759 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1],31); -#line 12779 "" +#line 12760 "" goto L2; -#line 12780 "" +#line 12761 "" } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { -#line 12781 "" +#line 12762 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; -#line 12782 "" +#line 12763 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { /* A note, not a rest. */ -#line 12786 "" +#line 12767 "" chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, ( ftnlen)128); -#line 12787 "" +#line 12768 "" if (moved) { -#line 12787 "" +#line 12768 "" goto L2; -#line 12787 "" +#line 12768 "" } /* Octave jump with a note */ -#line 12791 "" +#line 12772 "" if (numnum < 2) { -#line 12792 "" +#line 12773 "" comnotes_1.lastlev += ipm * 7; -#line 12793 "" +#line 12774 "" } else { -#line 12794 "" +#line 12775 "" ioct += ipm; -#line 12795 "" +#line 12776 "" } -#line 12796 "" +#line 12777 "" goto L2; -#line 12797 "" +#line 12778 "" } else { /* Override default height of a rest */ -#line 12801 "" +#line 12782 "" ++all_1.iccount; -#line 12802 "" +#line 12783 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 12803 "" +#line 12784 "" i__1 = all_1.iccount - 2; -#line 12803 "" +#line 12784 "" if (s_cmp(lineq + i__1, ".", all_1.iccount - 1 - i__1, ( ftnlen)1) == 0) { /* Kluge in case there is a shortcut ".". It will have been sucked up by */ /* readnum. (Same doesn't hold for ",") */ -#line 12808 "" +#line 12789 "" --all_1.iccount; /* go to 2 */ -#line 12810 "" +#line 12791 "" } -#line 12811 "" +#line 12792 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ipm * i_nint(&fnum) + 100; /* There may be more characters for this rest */ -#line 12815 "" +#line 12796 "" --all_1.iccount; -#line 12816 "" +#line 12797 "" goto L2; -#line 12817 "" +#line 12798 "" } -#line 12818 "" +#line 12799 "" } else if (*(unsigned char *)durq == 'x') { /* Xtuplet. Count number of doubled notes (for unequal xtups) */ -#line 12822 "" +#line 12803 "" if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18)) { -#line 12823 "" +#line 12804 "" ndoub = 1; -#line 12824 "" +#line 12805 "" } else { -#line 12825 "" +#line 12806 "" ndoub = 0; -#line 12826 "" +#line 12807 "" } /* Initialize counter for # of non-rests, so can later unbeam if = 1. */ -#line 12830 "" +#line 12811 "" inxtup = TRUE_; -#line 12831 "" +#line 12812 "" note1xtup = all_1.nnl[commvl_1.ivx - 1]; -#line 12832 "" +#line 12813 "" nnb = 0; -#line 12833 "" +#line 12814 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { -#line 12833 "" +#line 12814 "" nnb = 1; -#line 12833 "" +#line 12814 "" } /* Will set all durations to 0 except last one. Set flag on this note. */ -#line 12837 "" +#line 12818 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],28); /* Next input will be digit unless its a "T" */ -#line 12841 "" +#line 12822 "" ++all_1.iccount; -#line 12842 "" +#line 12823 "" if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'T') { /* Set up tremolo */ -#line 12846 "" +#line 12827 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],2); -#line 12847 "" +#line 12828 "" ntup = 2; /* Set default beaming, based on Wikipedia article */ /* May be a problem here is nnodur is inherited */ -#line 12852 "" +#line 12833 "" if (comnotes_1.nnodur == 4) { -#line 12853 "" +#line 12834 "" nsolid = 0; -#line 12854 "" +#line 12835 "" nindent = 3; -#line 12855 "" +#line 12836 "" } else if (comnotes_1.nnodur == 2) { -#line 12856 "" +#line 12837 "" nsolid = 3; -#line 12857 "" +#line 12838 "" nindent = 0; -#line 12858 "" +#line 12839 "" } else if (comnotes_1.nnodur == 8) { -#line 12859 "" +#line 12840 "" nsolid = 1; -#line 12860 "" +#line 12841 "" nindent = 2; -#line 12861 "" +#line 12842 "" } -#line 12862 "" +#line 12843 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12863 "" +#line 12844 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) { -#line 12864 "" +#line 12845 "" nsolid = i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) - 1; -#line 12865 "" +#line 12846 "" if (nsolid == 0 && comnotes_1.nnodur == 2) { -#line 12866 "" - s_wsle(&io___787); -#line 12866 "" +#line 12847 "" + s_wsle(&io___786); +#line 12847 "" do_lio(&c__9, &c__1, "", (ftnlen)0); -#line 12866 "" +#line 12847 "" e_wsle(); -#line 12867 "" - s_wsle(&io___788); -#line 12867 "" +#line 12848 "" + s_wsle(&io___787); +#line 12848 "" do_lio(&c__9, &c__1, "Unbeamed half-note 2-note trem"\ "olo forbidden.", (ftnlen)44); -#line 12867 "" +#line 12848 "" e_wsle(); -#line 12868 "" +#line 12849 "" stop1_(); -#line 12869 "" +#line 12850 "" } -#line 12870 "" +#line 12851 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 12871 "" +#line 12852 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) { -#line 12872 "" +#line 12853 "" nindent = i_indx("0123456789", durq, (ftnlen)10, ( ftnlen)1) - 1; -#line 12873 "" +#line 12854 "" } -#line 12874 "" +#line 12855 "" } -#line 12875 "" +#line 12856 "" setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__2, &c__3, &nsolid); -#line 12876 "" +#line 12857 "" setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__2, &c__5, &nindent); -#line 12877 "" +#line 12858 "" if (nsolid == 0) { -#line 12878 "" +#line 12859 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); -#line 12880 "" +#line 12861 "" } -#line 12881 "" +#line 12862 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],31); -#line 12882 "" +#line 12863 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21); -#line 12883 "" +#line 12864 "" setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &c__3, &c__22, &nsolid); @@ -30640,144 +30797,144 @@ L2: /* Need to check if there's already a forced beam explicitly set here. */ /* If there was, shouldn't do any harm resetting parameters. */ -#line 12890 "" +#line 12871 "" if (comfb_1.nfb[commvl_1.ivx - 1] == 0 || comfb_1.t1fb[ commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] != (real) all_1.itsofar[commvl_1.ivx - 1]) { -#line 12890 "" +#line 12871 "" ++comfb_1.nfb[commvl_1.ivx - 1]; -#line 12890 "" +#line 12871 "" } -#line 12892 "" +#line 12873 "" comget_1.fbon = TRUE_; -#line 12893 "" +#line 12874 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ commvl_1.ivx - 1] * 24 - 25] = 'x'; -#line 12894 "" +#line 12875 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; -#line 12895 "" +#line 12876 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) (all_1.itsofar[commvl_1.ivx - 1] + ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1)); -#line 12896 "" +#line 12877 "" nadj = 0; /* Set open beamed notehead flag for half-note tremolo */ /* Just gave 2 quarters with or without flag set. Need to fix */ -#line 12901 "" +#line 12882 "" } else { -#line 12902 "" +#line 12883 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); -#line 12903 "" +#line 12884 "" ntup = i_nint(&fnum); -#line 12904 "" +#line 12885 "" } -#line 12905 "" +#line 12886 "" if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double xtup note to make an un= xtup. Here xtup number already set but may also */ /* have this command before. */ -#line 12911 "" +#line 12892 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); -#line 12912 "" +#line 12893 "" if (*(unsigned char *)durq == 'F') { -#line 12912 "" +#line 12893 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); -#line 12912 "" +#line 12893 "" } -#line 12914 "" +#line 12895 "" ndoub = 1; -#line 12915 "" +#line 12896 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12916 "" +#line 12897 "" } else if (*(unsigned char *)durq == 'd') { -#line 12917 "" +#line 12898 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); -#line 12918 "" +#line 12899 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 12919 "" +#line 12900 "" } /* Only other possibilities here are ' ' or 'n' */ -#line 12923 "" +#line 12904 "" if (*(unsigned char *)durq == 'n') { /* Alter xtup number */ -#line 12927 "" +#line 12908 "" i__1 = all_1.iccount; -#line 12927 "" +#line 12908 "" if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, ( ftnlen)1) == 0) { /* If the only modifier is 'n', cancel the number */ -#line 12931 "" +#line 12912 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31); -#line 12932 "" +#line 12913 "" } else { -#line 12933 "" +#line 12914 "" numshft = 0; -#line 12934 "" +#line 12915 "" L30: -#line 12934 "" +#line 12915 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 12935 "" +#line 12916 "" if (*(unsigned char *)durq == 'f') { /* Flip up-down-ness */ -#line 12939 "" +#line 12920 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],14); -#line 12940 "" +#line 12921 "" goto L30; -#line 12941 "" +#line 12922 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical or horiz shift */ -#line 12945 "" +#line 12926 "" ++numshft; -#line 12946 "" +#line 12927 "" iofforn = 1; -#line 12947 "" +#line 12928 "" if (*(unsigned char *)durq == '-') { -#line 12947 "" +#line 12928 "" iofforn = -1; -#line 12947 "" +#line 12928 "" } -#line 12948 "" +#line 12929 "" ++all_1.iccount; -#line 12949 "" +#line 12930 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); -#line 12950 "" +#line 12931 "" --all_1.iccount; -#line 12951 "" +#line 12932 "" if (numshft == 1) { /* Vertical shift */ /* 160214 Allow (-64,64) */ /* iofforn = iofforn*nint(xofforn) + 16 */ -#line 12956 "" +#line 12937 "" iofforn = iofforn * i_nint(&xofforn) + 64; /* c Turn on bit 1; set bits 2-6 to iofforn */ @@ -30785,1055 +30942,1078 @@ L30: /* irest(ivx,nnl(ivx)) = */ /* * ior(irest(ivx,nnl(ivx)),2+4*iofforn) */ -#line 12963 "" +#line 12944 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],1); -#line 12964 "" +#line 12945 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__8, & c__16, &iofforn); -#line 12965 "" +#line 12946 "" } else { /* Horizontal shift */ -#line 12969 "" +#line 12950 "" r__1 = xofforn * 10; -#line 12969 "" +#line 12950 "" iofforn = iofforn * i_nint(&r__1) + 16; -#line 12970 "" +#line 12951 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],7); -#line 12971 "" +#line 12952 "" setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, & c__9, &iofforn); -#line 12972 "" +#line 12953 "" } -#line 12973 "" +#line 12954 "" goto L30; -#line 12974 "" +#line 12955 "" } else if (*(unsigned char *)durq == 's') { /* Slope adjustment for bracket */ -#line 12978 "" +#line 12959 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],4); -#line 12979 "" +#line 12960 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 12980 "" +#line 12961 "" iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; -#line 12981 "" +#line 12962 "" ++all_1.iccount; -#line 12982 "" +#line 12963 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); -#line 12983 "" +#line 12964 "" --all_1.iccount; -#line 12984 "" +#line 12965 "" r__1 = iofforn * xofforn + 16; -#line 12984 "" +#line 12965 "" iofforn = i_nint(&r__1); -#line 12985 "" +#line 12966 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, & iofforn); -#line 12986 "" +#line 12967 "" } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) > 0) { /* Replacement printed number */ -#line 12990 "" +#line 12971 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); -#line 12991 "" +#line 12972 "" i__1 = i_nint(&xofforn); -#line 12991 "" +#line 12972 "" setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, & i__1); -#line 12992 "" +#line 12973 "" --all_1.iccount; -#line 12993 "" +#line 12974 "" goto L30; -#line 12994 "" +#line 12975 "" } -#line 12995 "" +#line 12976 "" } -#line 12996 "" +#line 12977 "" } /* Set note level of 1st note of xtup, provided not a rest */ -#line 13000 "" +#line 12981 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { -#line 13001 "" +#line 12982 "" if (numnum == 2) { -#line 13002 "" +#line 12983 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1); -#line 13003 "" +#line 12984 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; -#line 13004 "" +#line 12985 "" } else { -#line 13005 "" +#line 12986 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_( charq, &c__10, &cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen) 1) - comnotes_1.lastlev + 3) % 7; -#line 13007 "" +#line 12988 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; -#line 13008 "" +#line 12989 "" } -#line 13009 "" +#line 12990 "" } -#line 13010 "" +#line 12991 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set note level for preslur on starting note of xtuplet */ -#line 13014 "" +#line 12995 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & c__7, &c__19, &comnotes_1.lastlev); -#line 13015 "" +#line 12996 "" /* L40: */ -#line 13015 "" +#line 12996 "" } -#line 13016 "" +#line 12997 "" numnum = 0; -#line 13017 "" +#line 12998 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; -#line 13018 "" +#line 12999 "" i__1 = ntup; -#line 13018 "" +#line 12999 "" for (itup = 2; itup <= i__1; ++itup) { -#line 13019 "" +#line 13000 "" if (comget_1.ornrpt) { -#line 13020 "" +#line 13001 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991; -#line 13022 "" +#line 13003 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ -#line 13026 "" +#line 13007 "" ++comtrill_1.ntrill; -#line 13027 "" +#line 13008 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; -#line 13028 "" +#line 13009 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; -#line 13029 "" +#line 13010 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[comtrill_1.ntrill - 2]; -#line 13030 "" +#line 13011 "" } -#line 13031 "" +#line 13012 "" } -#line 13032 "" +#line 13013 "" ++all_1.nnl[commvl_1.ivx - 1]; -#line 13033 "" +#line 13014 "" if (comget_1.fbon) { -#line 13033 "" +#line 13014 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); -#line 13033 "" +#line 13014 "" } -#line 13034 "" +#line 13015 "" L7: -#line 13034 "" +#line 13015 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1) ; -#line 13035 "" +#line 13016 "" if (*(unsigned char *)charq == ' ') { -#line 13036 "" +#line 13017 "" goto L7; -#line 13037 "" +#line 13018 "" } else if (*(unsigned char *)charq == '%') { -#line 13038 "" +#line 13019 "" all_1.iccount = 128; -#line 13039 "" +#line 13020 "" goto L7; -#line 13040 "" +#line 13021 "" } else if (*(unsigned char *)charq == 'o') { /* Ornament in xtuplet. "o" symbol must come AFTER the affected note */ -#line 13044 "" +#line 13025 "" if (comnotes_1.notcrd) { -#line 13045 "" +#line 13026 "" nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25]; -#line 13046 "" +#line 13027 "" } else { -#line 13047 "" +#line 13028 "" nole = 127 & lbit_shift(comtrill_1.icrdat[ comtrill_1.ncrd - 1], (ftnlen)-12); -#line 13048 "" +#line 13029 "" } -#line 13049 "" +#line 13030 "" i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; -#line 13049 "" +#line 13030 "" getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1], & all_1.iornq[commvl_1.ivx - 1], &comget_1.ornrpt, & comgrace_1.noffseg, &i__2, &commvl_1.ivx, & c_false, &comnotes_1.notcrd, &nole, (ftnlen)128); -#line 13052 "" +#line 13033 "" goto L7; -#line 13053 "" +#line 13034 "" } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { -#line 13054 "" +#line 13035 "" nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1; -#line 13055 "" +#line 13036 "" if (*(unsigned char *)charq == '(' || *(unsigned char *) charq == '{') { /* Detected preslur in xtuplet loop, non-chord note */ -#line 13059 "" +#line 13040 "" ++nnlivx; -#line 13060 "" +#line 13041 "" ++comnotes_1.npreslur; -#line 13061 "" +#line 13042 "" } -#line 13062 "" +#line 13043 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0); -#line 13063 "" +#line 13044 "" if (*(unsigned char *)charq == 't') { -#line 13063 "" +#line 13044 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); -#line 13063 "" +#line 13044 "" } -#line 13065 "" +#line 13046 "" if (commvl_1.ivx <= all_1.nv) { -#line 13066 "" +#line 13047 "" kv = 1; -#line 13067 "" +#line 13048 "" } else { -#line 13068 "" +#line 13049 "" kv = 2; -#line 13069 "" +#line 13050 "" } -#line 13070 "" +#line 13051 "" if (comslur_1.fontslur) { -#line 13071 "" +#line 13052 "" sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, & all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[ commvl_1.ivx + nnlivx * 24 - 25], charq, ( ftnlen)128, (ftnlen)1); -#line 13073 "" +#line 13054 "" } else { -#line 13074 "" +#line 13055 "" spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, & nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, & comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, ( ftnlen)1); -#line 13076 "" +#line 13057 "" } -#line 13077 "" +#line 13058 "" goto L7; -#line 13078 "" +#line 13059 "" } else if (*(unsigned char *)charq == 'G') { /* Kluge to get grace in xtup at right location */ -#line 13082 "" +#line 13063 "" --all_1.nnl[commvl_1.ivx - 1]; -#line 13083 "" +#line 13064 "" getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount, all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, &comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128); -#line 13085 "" +#line 13066 "" ++all_1.nnl[commvl_1.ivx - 1]; -#line 13086 "" +#line 13067 "" goto L7; -#line 13087 "" +#line 13068 "" } else if (*(unsigned char *)charq == *(unsigned char *) all_1.sq) { -#line 13088 "" +#line 13069 "" littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); -#line 13089 "" +#line 13070 "" goto L7; -#line 13090 "" - } else if (*(unsigned char *)charq == '"') { +#line 13071 "" + } else /* if(complicated condition) */ { +#line 13071 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 13071 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0] + ) { /* pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ */ +#line 13075 "" + if (! comlyr_1.inputmlyr) { +#line 13076 "" + ictemp = 0; +/* Writing concatenation */ +#line 13077 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 13077 "" + i__3[1] = 1, a__1[1] = all_1.sq; +#line 13077 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 13077 "" + i__3[3] = 15, a__1[3] = "input musixlyr "; +#line 13077 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 13077 "" + s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); +#line 13078 "" + i__2 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 13078 "" + littex_(all_1.islur, &i__2, &commvl_1.ivx, & + comas3_1.topmods, lineqt, &ictemp, ( + ftnlen)128); +#line 13079 "" + comlyr_1.inputmlyr = TRUE_; +#line 13080 "" + } +#line 13081 "" + dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 13082 "" + *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 13083 "" + littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & + commvl_1.ivx, &comas3_1.topmods, lineq, & + all_1.iccount, (ftnlen)128); +#line 13084 "" + goto L7; +#line 13085 "" + } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, ( + ftnlen)1) > 0) { + +/* Figure. Must come AFTER the first note of xtup */ + +#line 13089 "" + ivf = 1; +#line 13090 "" + if (commvl_1.ivx > 1) { +#line 13091 "" + if (comfig_1.ivxfig2 == 0) { +#line 13092 "" + comfig_1.ivxfig2 = commvl_1.ivx; +#line 13093 "" + } else if (commvl_1.ivx != comfig_1.ivxfig2) { +#line 13094 "" + s_wsle(&io___798); #line 13094 "" - if (! comlyr_1.inputmlyr) { + e_wsle(); #line 13095 "" - ictemp = 0; -/* Writing concatenation */ -#line 13096 "" - i__3[0] = 1, a__1[0] = all_1.sq; -#line 13096 "" - i__3[1] = 1, a__1[1] = all_1.sq; -#line 13096 "" - i__3[2] = 1, a__1[2] = all_1.sq; -#line 13096 "" - i__3[3] = 15, a__1[3] = "input musixlyr "; -#line 13096 "" - i__3[4] = 1, a__1[4] = all_1.sq; + s_wsle(&io___799); +#line 13095 "" + do_lio(&c__9, &c__1, "Figures not allowed in"\ + " >1 voice above first", (ftnlen)43); +#line 13095 "" + e_wsle(); #line 13096 "" - s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); + s_stop("", (ftnlen)0); #line 13097 "" - i__2 = all_1.nnl[commvl_1.ivx - 1] + 1; -#line 13097 "" - littex_(all_1.islur, &i__2, &commvl_1.ivx, & - comas3_1.topmods, lineqt, &ictemp, (ftnlen) - 128); + } #line 13098 "" - comlyr_1.inputmlyr = TRUE_; + ivf = 2; #line 13099 "" - } + } #line 13100 "" - dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); + nfig1 = comfig_1.nfigs[ivf - 1] + 1; #line 13101 "" - *(unsigned char *)charq = *(unsigned char *)all_1.sq; -#line 13102 "" - littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & - commvl_1.ivx, &comas3_1.topmods, lineq, & - all_1.iccount, (ftnlen)128); -#line 13103 "" - goto L7; -#line 13104 "" - } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, ( - ftnlen)1) > 0) { - -/* Figure. Must come AFTER the first note of xtup */ - + getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], + charq, lineq, &all_1.iccount, &all_1.isfig[ + ivf + (all_1.nnl[commvl_1.ivx - 1] - 1 << 1) + - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], + &all_1.itsofar[commvl_1.ivx - 1], &c__0, + comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, + &comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], & + comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & + comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen) + 128, (ftnlen)10); +/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 13106 "" + goto L7; +#line 13107 "" + } else if (*(unsigned char *)charq == 'X') { +/* Computing MAX */ #line 13108 "" - ivf = 1; -#line 13109 "" - if (commvl_1.ivx > 1) { -#line 13110 "" - if (comfig_1.ivxfig2 == 0) { -#line 13111 "" - comfig_1.ivxfig2 = commvl_1.ivx; + i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 13108 "" + getx_(lineq, &all_1.iccount, &all_1.irest[ + commvl_1.ivx + max(i__2,i__4) * 24 - 25], & + comnotes_1.shifton, &comask_1.wheadpt, & + all_1.iornq[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 1], &commvl_1.ivx, & + all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25], &all_1.itsofar[ + commvl_1.ivx - 1], &ntup, &itup, & + comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, + (ftnlen)1); #line 13112 "" - } else if (commvl_1.ivx != comfig_1.ivxfig2) { -#line 13113 "" - s_wsle(&io___799); + goto L7; #line 13113 "" - e_wsle(); -#line 13114 "" - s_wsle(&io___800); -#line 13114 "" - do_lio(&c__9, &c__1, "Figures not allowed in >1 "\ - "voice above first", (ftnlen)43); -#line 13114 "" - e_wsle(); -#line 13115 "" - s_stop("", (ftnlen)0); -#line 13116 "" - } + } else if (*(unsigned char *)charq == 'z') { + +/* Chord note in xtup. Goes with *prior* note. */ + #line 13117 "" - ivf = 2; + comnotes_1.notcrd = FALSE_; #line 13118 "" - } + ++comtrill_1.ncrd; #line 13119 "" - nfig1 = comfig_1.nfigs[ivf - 1] + 1; + all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + - 1) * 24 - 25] = bit_set(all_1.ipl[ + commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 25],10); #line 13120 "" - getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, - lineq, &all_1.iccount, &all_1.isfig[ivf + ( - all_1.nnl[commvl_1.ivx - 1] - 1 << 1) - 3], & - comfig_1.itfig[ivf + (nfig1 << 1) - 3], & - all_1.itsofar[commvl_1.ivx - 1], &c__0, - comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, & - comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], & - comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & - comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, ( - ftnlen)10); -/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */ -#line 13125 "" - goto L7; -#line 13126 "" - } else if (*(unsigned char *)charq == 'X') { -/* Computing MAX */ -#line 13127 "" - i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1; -#line 13127 "" - getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + - max(i__2,i__4) * 24 - 25], &comnotes_1.shifton, & - comask_1.wheadpt, &all_1.iornq[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 1], & - commvl_1.ivx, &all_1.irest[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 25], & - all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, & - comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, ( - ftnlen)1); -#line 13131 "" - goto L7; -#line 13132 "" - } else if (*(unsigned char *)charq == 'z') { + numnum = 0; +/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ +#line 13122 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[ + commvl_1.ivx - 1] - 1; +#line 13123 "" + i__2 = commvl_1.ivx % 16; +#line 13123 "" + setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], & + c__4, &c__8, &i__2); +#line 13124 "" + if (commvl_1.ivx >= 16) { +#line 13124 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],28) + ; +#line 13124 "" + } +#line 13125 "" + comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; -/* Chord note in xtup. Goes with *prior* note. */ +/* Get note name */ + +#line 13129 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( + ftnlen)1); + +/* Get optional inputs */ + +#line 13133 "" +L34: +#line 13133 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); + +/* When chord note is done, will get ' ', making ndx=0, so go past this block */ -#line 13136 "" - comnotes_1.notcrd = FALSE_; #line 13137 "" - ++comtrill_1.ncrd; + ndx = i_indx("fsn+-<>12345678reicd", durq, (ftnlen)20, + (ftnlen)1); #line 13138 "" - all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) - * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + ( - all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],10); + if (ndx > 0) { #line 13139 "" - numnum = 0; -/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ + if (ndx <= 3) { +#line 13140 "" + if (! bit_test(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],19)) { #line 13141 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[ - commvl_1.ivx - 1] - 1; -#line 13142 "" - i__2 = commvl_1.ivx % 16; + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],19); #line 13142 "" - setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, & - c__8, &i__2); -#line 13143 "" - if (commvl_1.ivx >= 16) { -#line 13143 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],28); + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= + ndx << 20; #line 13143 "" - } + } else { #line 13144 "" - comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; - -/* Get note name */ - -#line 13148 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( - ftnlen)1); + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],22); +#line 13145 "" + } +#line 13146 "" + } else if (*(unsigned char *)durq == 'd') { -/* Get optional inputs */ +/* Get dot on chord note in xtup. Assume +n+n */ +#line 13150 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],26); +#line 13151 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen) + 128, (ftnlen)1); #line 13152 "" -L34: -#line 13152 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( - ftnlen)1); - -/* When chord note is done, will get ' ', making ndx=0, so go past this block */ - + ++all_1.iccount; +#line 13153 "" + readnum_(lineq, &all_1.iccount, dumq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 13154 "" + if (*(unsigned char *)durq == '+') { +#line 13155 "" + r__1 = fnum * 10; +#line 13155 "" + comtrill_1.icrdot[comtrill_1.ncrd - 1] |= + i_nint(&r__1) + 64; #line 13156 "" - ndx = i_indx("fsn+-<>12345678reicd", durq, (ftnlen)20, ( - ftnlen)1); + } else { +#line 13157 "" + r__1 = fnum * 10; #line 13157 "" - if (ndx > 0) { + comtrill_1.icrdot[comtrill_1.ncrd - 1] |= + -i_nint(&r__1) + 64; #line 13158 "" - if (ndx <= 3) { + } #line 13159 "" - if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - - 1],19)) { -#line 13160 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = - bit_set(comtrill_1.icrdat[ - comtrill_1.ncrd - 1],19); -#line 13161 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx - << 20; -#line 13162 "" - } else { + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) + > 0) { + +/* Vertical shift specified also */ + #line 13163 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = - bit_set(comtrill_1.icrdat[ - comtrill_1.ncrd - 1],22); + ++all_1.iccount; #line 13164 "" - } + readnum_(lineq, &all_1.iccount, durq, & + fnum, (ftnlen)128, (ftnlen)1); #line 13165 "" - } else if (*(unsigned char *)durq == 'd') { - -/* Get dot on chord note in xtup. Assume +n+n */ - + if (*(unsigned char *)dumq == '+') { +#line 13166 "" + r__1 = fnum * 10; +#line 13166 "" + ifnum = i_nint(&r__1) + 64; +#line 13167 "" + } else { +#line 13168 "" + r__1 = fnum * 10; +#line 13168 "" + ifnum = -i_nint(&r__1) + 64; #line 13169 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],26) - ; + } #line 13170 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, - (ftnlen)1); + } else { #line 13171 "" - ++all_1.iccount; + ifnum = 64; #line 13172 "" - readnum_(lineq, &all_1.iccount, dumq, &fnum, ( - ftnlen)128, (ftnlen)1); + } #line 13173 "" - if (*(unsigned char *)durq == '+') { -#line 13174 "" - r__1 = fnum * 10; -#line 13174 "" - comtrill_1.icrdot[comtrill_1.ncrd - 1] |= - i_nint(&r__1) + 64; -#line 13175 "" - } else { -#line 13176 "" - r__1 = fnum * 10; -#line 13176 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= - -i_nint(&r__1) + 64; -#line 13177 "" - } -#line 13178 "" - if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) - { + ifnum << 7; +#line 13174 "" + --all_1.iccount; +/* iccount = iccount+4 */ -/* Vertical shift specified also */ -#line 13182 "" - ++all_1.iccount; + +#line 13179 "" + } else if (ndx == 19) { + +/* Set flags for cautionary accidental */ + #line 13183 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, ( - ftnlen)128, (ftnlen)1); + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],31); #line 13184 "" - if (*(unsigned char *)dumq == '+') { -#line 13185 "" - r__1 = fnum * 10; -#line 13185 "" - ifnum = i_nint(&r__1) + 64; + all_1.iornq[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 1] = + bit_set(all_1.iornq[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] - 1) * 24 + - 1],31); #line 13186 "" - } else { -#line 13187 "" - r__1 = fnum * 10; -#line 13187 "" - ifnum = -i_nint(&r__1) + 64; -#line 13188 "" - } -#line 13189 "" - } else { + } else if (ndx <= 7) { + +/* +/-/ Check whether octave or accidental shift */ + #line 13190 "" - ifnum = 64; + nactmp = 0; #line 13191 "" - } + chkpm4ac_(lineq, &all_1.iccount, &nactmp, & + moved, (ftnlen)128); #line 13192 "" - comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << - 7; -#line 13193 "" - --all_1.iccount; -/* iccount = iccount+4 */ - + if (moved) { +/* Transfer accidental shift values */ +#line 13196 "" + i__2 = igetbits_(&nactmp, &c__6, &c__4); +#line 13196 "" + setbits_(&comtrill_1.icrdot[ + comtrill_1.ncrd - 1], &c__6, & + c__14, &i__2); #line 13198 "" - } else if (ndx == 19) { - -/* Set flags for cautionary accidental */ - + i__2 = igetbits_(&nactmp, &c__7, &c__10); +#line 13198 "" + setbits_(&comtrill_1.icrdot[ + comtrill_1.ncrd - 1], &c__7, & + c__20, &i__2); +#line 13200 "" + } else { +#line 13201 "" + if (*(unsigned char *)durq == '+') { #line 13202 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],31) - ; + comnotes_1.lastlev += 7; #line 13203 "" - all_1.iornq[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] - 1) * 24 - 1] = - bit_set(all_1.iornq[commvl_1.ivx + ( - all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1] - ,31); + } else if (*(unsigned char *)durq == '-') + { +#line 13204 "" + comnotes_1.lastlev += -7; #line 13205 "" - } else if (ndx <= 7) { - -/* +/-/ Check whether octave or accidental shift */ - + } +#line 13206 "" + } +#line 13207 "" + } else if (*(unsigned char *)durq == 'e') { +#line 13208 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],23); #line 13209 "" - nactmp = 0; + all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25] = + bit_set(all_1.irest[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] + ,27); #line 13210 "" - chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, - (ftnlen)128); + } else if (*(unsigned char *)durq == 'r') { #line 13211 "" - if (moved) { + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],24); +#line 13212 "" + all_1.irest[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25] = + bit_set(all_1.irest[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] - 1) * 24 + - 25],20); +#line 13214 "" + } else if (*(unsigned char *)durq == 'i') { -/* Transfer accidental shift values */ +/* Midi-only accidental */ -#line 13215 "" - i__2 = igetbits_(&nactmp, &c__6, &c__4); -#line 13215 "" - setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - - 1], &c__6, &c__14, &i__2); -#line 13217 "" - i__2 = igetbits_(&nactmp, &c__7, &c__10); -#line 13217 "" - setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - - 1], &c__7, &c__20, &i__2); +#line 13218 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],27); #line 13219 "" } else { -#line 13220 "" - if (*(unsigned char *)durq == '+') { -#line 13221 "" - comnotes_1.lastlev += 7; -#line 13222 "" - } else if (*(unsigned char *)durq == '-') { + +/* must be a number, save it in ioct */ + #line 13223 "" - comnotes_1.lastlev += -7; + numnum = 1; #line 13224 "" - } + ioct = ndx - 7; #line 13225 "" } #line 13226 "" - } else if (*(unsigned char *)durq == 'e') { + goto L34; #line 13227 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],23) - ; + } #line 13228 "" - all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - - 1] * 24 - 25] = bit_set(all_1.irest[ - commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] - * 24 - 25],27); + if (numnum == 1) { #line 13229 "" - } else if (*(unsigned char *)durq == 'r') { + comnotes_1.lastlev = ifnolev_(charq, &ioct, & + cominsttrans_1.itransamt[ + cominsttrans_1.instno[all_1.iv - 1] - 1], + (ftnlen)1); #line 13230 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],24) - ; + } else { #line 13231 "" - all_1.irest[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] - 1) * 24 - 25] = - bit_set(all_1.irest[commvl_1.ivx + ( - all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - - 25],20); + comnotes_1.lastlev = comnotes_1.lastlev - 3 + ( + ifnolev_(charq, &c__10, & + cominsttrans_1.itransamt[ + cominsttrans_1.instno[all_1.iv - 1] - 1], + (ftnlen)1) - comnotes_1.lastlev + 3) % 7; #line 13233 "" - } else if (*(unsigned char *)durq == 'i') { + } +#line 13234 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= + comnotes_1.lastlev << 12; +#line 13235 "" + for (comnotes_1.npreslur = comnotes_1.npreslur; + comnotes_1.npreslur >= 1; + --comnotes_1.npreslur) { -/* Midi-only accidental */ +/* Set note level for preslur on chord note in xtup */ -#line 13237 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],27) - ; -#line 13238 "" - } else { +#line 13239 "" + setbits_(&all_1.isdat2[all_1.nsdat - + comnotes_1.npreslur], &c__7, &c__19, & + comnotes_1.lastlev); -/* must be a number, save it in ioct */ +/* Following lines copied from loop for non-xtup, chord note, preslur */ +/* Initially I assigned the slur(s) to next note, so fix. */ -#line 13242 "" - numnum = 1; -#line 13243 "" - ioct = ndx - 7; #line 13244 "" - } + all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25] = bit_clear(all_1.islur[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25],0); #line 13245 "" - goto L34; + all_1.islur[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25] = + bit_set(all_1.islur[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - + 25],0); #line 13246 "" - } -#line 13247 "" - if (numnum == 1) { + all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = + bit_set(all_1.isdat2[all_1.nsdat - + comnotes_1.npreslur],0); #line 13248 "" - comnotes_1.lastlev = ifnolev_(charq, &ioct, & - cominsttrans_1.itransamt[ - cominsttrans_1.instno[all_1.iv - 1] - 1], ( - ftnlen)1); -#line 13249 "" - } else { + i__2 = igetbits_(&all_1.isdat1[all_1.nsdat - + comnotes_1.npreslur], &c__8, &c__3) - 1; +#line 13248 "" + setbits_(&all_1.isdat1[all_1.nsdat - + comnotes_1.npreslur], &c__8, &c__3, &i__2) + ; #line 13250 "" - comnotes_1.lastlev = comnotes_1.lastlev - 3 + ( - ifnolev_(charq, &c__10, & - cominsttrans_1.itransamt[ - cominsttrans_1.instno[all_1.iv - 1] - 1], ( - ftnlen)1) - comnotes_1.lastlev + 3) % 7; +/* L41: */ +#line 13250 "" + } +#line 13251 "" + goto L7; #line 13252 "" - } -#line 13253 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] |= - comnotes_1.lastlev << 12; -#line 13254 "" - for (comnotes_1.npreslur = comnotes_1.npreslur; - comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { + } else if (*(unsigned char *)charq == '?') { -/* Set note level for preslur on chord note in xtup */ +/* Arpeggio */ -#line 13258 "" - setbits_(&all_1.isdat2[all_1.nsdat - - comnotes_1.npreslur], &c__7, &c__19, & - comnotes_1.lastlev); +#line 13256 "" + if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25],10)) { -/* Following lines copied from loop for non-xtup, chord note, preslur */ -/* Initially I assigned the slur(s) to next note, so fix. */ +/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ +/* of chord, will not set icrdat(25), but iornq(27) */ +#line 13261 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],25) + ; +#line 13262 "" + } else { #line 13263 "" - all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] - * 24 - 25] = bit_clear(all_1.islur[ - commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * - 24 - 25],0); + all_1.iornq[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 1] = + bit_set(all_1.iornq[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1] + ,27); #line 13264 "" - all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - - 1] - 1) * 24 - 25] = bit_set(all_1.islur[ - commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - - 1) * 24 - 25],0); -#line 13265 "" - all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = - bit_set(all_1.isdat2[all_1.nsdat - - comnotes_1.npreslur],0); -#line 13267 "" - i__2 = igetbits_(&all_1.isdat1[all_1.nsdat - - comnotes_1.npreslur], &c__8, &c__3) - 1; -#line 13267 "" - setbits_(&all_1.isdat1[all_1.nsdat - - comnotes_1.npreslur], &c__8, &c__3, &i__2); -#line 13269 "" -/* L41: */ + } + +/* Check for shift */ + +#line 13268 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 13269 "" - } + if (*(unsigned char *)durq == ' ') { #line 13270 "" - goto L7; + --all_1.iccount; #line 13271 "" - } else if (*(unsigned char *)charq == '?') { + } else { -/* Arpeggio */ +/* durq must be "-" */ #line 13275 "" - if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] - 1) * 24 - 25],10)) { + ++all_1.iccount; +#line 13276 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 13277 "" + --all_1.iccount; -/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ -/* of chord, will not set icrdat(25), but iornq(27) */ +/* record the shift */ -#line 13280 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],25); #line 13281 "" - } else { + ++comarpshift_1.numarpshift; #line 13282 "" - all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - - 1] - 1) * 24 - 1] = bit_set(all_1.iornq[ - commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - - 1) * 24 - 1],27); + comarpshift_1.ivarpshift[ + comarpshift_1.numarpshift - 1] = + commvl_1.ivx; #line 13283 "" - } - -/* Check for shift */ - + comarpshift_1.iparpshift[ + comarpshift_1.numarpshift - 1] = + all_1.nnl[commvl_1.ivx - 1] - 1; +#line 13284 "" + comarpshift_1.arpshift[comarpshift_1.numarpshift + - 1] = fnum; +#line 13285 "" + } +#line 13286 "" + goto L7; #line 13287 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( - ftnlen)1); + } else if (*(unsigned char *)charq == 'D') { #line 13288 "" - if (*(unsigned char *)durq == ' ') { -#line 13289 "" - --all_1.iccount; + i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 13288 "" + getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[ + commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 25], &all_1.iornq[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1], + lineq, &all_1.iccount, (ftnlen)128); #line 13290 "" - } else { + goto L7; -/* durq must be "-" */ +/* 140215 Allow clef change inside xtuplet. With normal code, came out one */ +/* note too late, so try making it come earlier. */ -#line 13294 "" - ++all_1.iccount; #line 13295 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) - 128, (ftnlen)1); -#line 13296 "" - --all_1.iccount; + } else if (*(unsigned char *)charq == 'C') { -/* record the shift */ +/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ + +#line 13299 "" + if (all_1.nnl[all_1.iv - 1] - 1 > 0) { +#line 13299 "" + ++comcc_1.ncc[all_1.iv - 1]; +#line 13299 "" + } + +/* 140218 Need to get time differently inside xtup, since itsofar doesn't get */ +/* updated until after xtup is done */ -#line 13300 "" - ++comarpshift_1.numarpshift; -#line 13301 "" - comarpshift_1.ivarpshift[comarpshift_1.numarpshift - - 1] = commvl_1.ivx; -#line 13302 "" - comarpshift_1.iparpshift[comarpshift_1.numarpshift - - 1] = all_1.nnl[commvl_1.ivx - 1] - 1; -#line 13303 "" - comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] - = fnum; #line 13304 "" - } + nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1) + ; #line 13305 "" - goto L7; + comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 + - 25] = (real) (all_1.itsofar[all_1.iv - 1] + + (integer) (nodurt * 1.f / ntup * (itup - 1))); #line 13306 "" - } else if (*(unsigned char *)charq == 'D') { -#line 13307 "" - i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; + isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[ + all_1.iv - 1] * 24 - 25],11); #line 13307 "" - getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[commvl_1.ivx + - (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25], & - all_1.iornq[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] - 1) * 24 - 1], lineq, & - all_1.iccount, (ftnlen)128); -#line 13309 "" - goto L7; + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); -/* 140215 Allow clef change inside xtuplet. With normal code, came out one */ -/* note too late, so try making it come earlier. */ +/* Store clef number, or 7 if clef number = 9 (French violin clef) */ +/* Computing MIN */ +#line 13311 "" + i__2 = numclef_(durq, (ftnlen)1); +#line 13311 "" + isl |= min(i__2,7) << 12; +#line 13312 "" + comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * + 24 - 25] = ncmidf_(durq, (ftnlen)1); +#line 13313 "" + if (*(unsigned char *)durq == '8') { #line 13314 "" - } else if (*(unsigned char *)charq == 'C') { - -/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ - -#line 13318 "" - if (all_1.nnl[all_1.iv - 1] - 1 > 0) { -#line 13318 "" - ++comcc_1.ncc[all_1.iv - 1]; -#line 13318 "" - } + all_1.ipl[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 + - 25] = bit_set(all_1.ipl[all_1.iv + + all_1.nnl[all_1.iv - 1] * 24 - 25],2); +#line 13315 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[ + all_1.iv - 1] - 1] += 7; +#line 13316 "" + } -/* 140218 Need to get time differently inside xtup, since itsofar doesn't get */ -/* updated until after xtup is done */ +/* Set marker on note with lowest voice # starting at same time. */ +#line 13320 "" + if (all_1.iv == 1) { +#line 13321 "" + isl = bit_set(isl,15); +#line 13322 "" + } else { #line 13323 "" - nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); -#line 13324 "" - comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - - 25] = (real) (all_1.itsofar[all_1.iv - 1] + ( - integer) (nodurt * 1.f / ntup * (itup - 1))); + i__2 = all_1.iv; +#line 13323 "" + for (iiv = 1; iiv <= i__2; ++iiv) { +/* nnliiv = nnl(iiv) */ #line 13325 "" - isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[all_1.iv - - 1] * 24 - 25],11); + nnliiv = all_1.nnl[iiv - 1] - 1; #line 13326 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( - ftnlen)1); - -/* Store clef number, or 7 if clef number = 9 (French violin clef) */ - -/* Computing MIN */ -#line 13330 "" - i__2 = numclef_(durq, (ftnlen)1); + if (iiv == all_1.iv) { +#line 13326 "" + ++nnliiv; +#line 13326 "" + } +#line 13327 "" + itother = 0; +#line 13328 "" + i__4 = nnliiv; +#line 13328 "" + for (iip = 1; iip <= i__4; ++iip) { +#line 13329 "" + if (itother < all_1.itsofar[all_1.iv - 1]) + { #line 13330 "" - isl |= min(i__2,7) << 12; + itother += all_1.nodur[iiv + iip * 24 + - 25]; #line 13331 "" - comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - - 25] = ncmidf_(durq, (ftnlen)1); + goto L71; #line 13332 "" - if (*(unsigned char *)durq == '8') { + } else if (itother == all_1.itsofar[ + all_1.iv - 1]) { #line 13333 "" - all_1.ipl[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - - 25] = bit_set(all_1.ipl[all_1.iv + all_1.nnl[ - all_1.iv - 1] * 24 - 25],2); + all_1.islur[iiv + iip * 24 - 25] = + bit_set(all_1.islur[iiv + iip + * 24 - 25],15); #line 13334 "" - cominsttrans_1.itransamt[cominsttrans_1.instno[ - all_1.iv - 1] - 1] += 7; + goto L72; #line 13335 "" - } - -/* Set marker on note with lowest voice # starting at same time. */ - -#line 13339 "" - if (all_1.iv == 1) { -#line 13340 "" - isl = bit_set(isl,15); -#line 13341 "" - } else { -#line 13342 "" - i__2 = all_1.iv; -#line 13342 "" - for (iiv = 1; iiv <= i__2; ++iiv) { -/* nnliiv = nnl(iiv) */ -#line 13344 "" - nnliiv = all_1.nnl[iiv - 1] - 1; -#line 13345 "" - if (iiv == all_1.iv) { -#line 13345 "" - ++nnliiv; -#line 13345 "" - } -#line 13346 "" - itother = 0; -#line 13347 "" - i__4 = nnliiv; -#line 13347 "" - for (iip = 1; iip <= i__4; ++iip) { -#line 13348 "" - if (itother < all_1.itsofar[all_1.iv - 1]) { -#line 13349 "" - itother += all_1.nodur[iiv + iip * 24 - - 25]; -#line 13350 "" - goto L71; -#line 13351 "" - } else if (itother == all_1.itsofar[all_1.iv - - 1]) { -#line 13352 "" - all_1.islur[iiv + iip * 24 - 25] = - bit_set(all_1.islur[iiv + iip * - 24 - 25],15); -#line 13353 "" - goto L72; -#line 13354 "" - } -#line 13355 "" + } +#line 13336 "" L71: -#line 13355 "" - ; -#line 13355 "" - } -#line 13356 "" +#line 13336 "" + ; +#line 13336 "" + } +#line 13337 "" /* L70: */ -#line 13356 "" - } -#line 13357 "" +#line 13337 "" + } +#line 13338 "" L72: -#line 13358 "" - ; -#line 13358 "" - } +#line 13339 "" + ; +#line 13339 "" + } /* Need 'or' since may have set bit 15 in the above loop */ /* islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) */ -#line 13363 "" - all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25] - = isl | all_1.islur[all_1.iv + all_1.nnl[all_1.iv - - 1] * 24 - 25]; -#line 13364 "" - goto L7; +#line 13344 "" + all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - + 25] = isl | all_1.islur[all_1.iv + all_1.nnl[ + all_1.iv - 1] * 24 - 25]; +#line 13345 "" + goto L7; /* +++ */ -#line 13366 "" - } else if (*(unsigned char *)charq == ']') { +#line 13347 "" + } else if (*(unsigned char *)charq == ']') { /* Multiplicity up-down, must have '][ ' */ -#line 13370 "" - all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - - 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx - + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],20) - ; -#line 13371 "" - all_1.iccount += 2; -#line 13372 "" - goto L7; +#line 13351 "" + all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - + 1] - 1) * 24 - 25] = bit_set(all_1.islur[ + commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 25],20); +#line 13352 "" + all_1.iccount += 2; +#line 13353 "" + goto L7; /* c+++ */ -#line 13374 "" +#line 13355 "" + } +#line 13355 "" } /* End of loop for xtup options. If here, charq must be a (non-crd) note name. */ /* or rest */ -#line 13379 "" +#line 13360 "" if (*(unsigned char *)charq == 'r') { /* Rest in xtup */ -#line 13383 "" +#line 13364 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0); -#line 13384 "" +#line 13365 "" i__2 = all_1.iccount; -#line 13384 "" +#line 13365 "" if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount + 1 - i__2) > 0) { -#line 13385 "" +#line 13366 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 13386 "" +#line 13367 "" if (*(unsigned char *)durq == 'b') { /* Blank rest in middle of xtup */ -#line 13390 "" +#line 13371 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],29); -#line 13391 "" +#line 13372 "" } else { /* Override height of embedded xtup rest */ -#line 13395 "" +#line 13376 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; -#line 13396 "" +#line 13377 "" ++all_1.iccount; -#line 13397 "" +#line 13378 "" readnum_(lineq, &all_1.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); -#line 13398 "" +#line 13379 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ipm * i_nint(&fnum) + 100; -#line 13399 "" +#line 13380 "" --all_1.iccount; -#line 13400 "" +#line 13381 "" } -#line 13401 "" +#line 13382 "" } else if (commvl_1.ivx <= all_1.nv) { -#line 13402 "" +#line 13383 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; -#line 13403 "" +#line 13384 "" } else { -#line 13404 "" +#line 13385 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 2; -#line 13405 "" +#line 13386 "" } -#line 13406 "" +#line 13387 "" } else { /* Counter for non-rests */ -#line 13410 "" +#line 13391 "" ++nnb; -#line 13411 "" +#line 13392 "" } -#line 13412 "" +#line 13393 "" comnotes_1.notcrd = TRUE_; -#line 13413 "" +#line 13394 "" L8: -#line 13413 "" +#line 13394 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 13414 "" +#line 13395 "" if (*(unsigned char *)durq != ' ') { -#line 13415 "" +#line 13396 "" if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { /* Accidental horizontal shift */ -#line 13419 "" +#line 13400 "" chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, (ftnlen)128); -#line 13420 "" +#line 13401 "" if (! moved) { -#line 13421 "" +#line 13402 "" if (*(unsigned char *)durq == '+') { -#line 13422 "" +#line 13403 "" comnotes_1.lastlev += 7; -#line 13423 "" +#line 13404 "" } else if (*(unsigned char *)durq == '-') { -#line 13424 "" +#line 13405 "" comnotes_1.lastlev += -7; -#line 13425 "" +#line 13406 "" } -#line 13426 "" +#line 13407 "" } -#line 13427 "" +#line 13408 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* if (nacc(ivx,nnl(ivx)) .eq. 0) then */ /* May have set other bits earlier */ -#line 13431 "" +#line 13412 "" if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__2, &c__0) == 0) { @@ -31841,208 +32021,208 @@ L8: /* No accid set yet */ /* nacc(ivx,nnl(ivx)) = index('fsn',durq) */ -#line 13436 "" +#line 13417 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] |= i_indx("fsn", durq, ( ftnlen)3, (ftnlen)1); -#line 13438 "" +#line 13419 "" } else { /* Symbol must be repeated, so it's a double */ -#line 13442 "" +#line 13423 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],2); -#line 13443 "" +#line 13424 "" } -#line 13444 "" +#line 13425 "" } else if (*(unsigned char *)durq == 'i') { /* Set flag for midi-only accidental */ -#line 13448 "" +#line 13429 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); -#line 13450 "" +#line 13431 "" } else if (*(unsigned char *)durq == 'c') { /* Set flags for cautionary accidental */ -#line 13454 "" +#line 13435 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31); -#line 13455 "" +#line 13436 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1],31); -#line 13456 "" +#line 13437 "" } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Force stem direction for non-beamed xtup note */ -#line 13460 "" +#line 13441 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); -#line 13461 "" +#line 13442 "" if (*(unsigned char *)durq == 'u') { -#line 13461 "" +#line 13442 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); -#line 13461 "" +#line 13442 "" } -#line 13463 "" +#line 13444 "" } else if (*(unsigned char *)durq == 'e') { /* Left-shift main xtup note */ -#line 13467 "" +#line 13448 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8); -#line 13468 "" +#line 13449 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); -#line 13469 "" +#line 13450 "" } else if (*(unsigned char *)durq == 'r') { /* Right-shift main xtup note */ -#line 13473 "" +#line 13454 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9); -#line 13474 "" +#line 13455 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],20); -#line 13475 "" +#line 13456 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double an xtup note to make an unequal xtup */ -#line 13479 "" +#line 13460 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); -#line 13480 "" +#line 13461 "" if (*(unsigned char *)durq == 'F') { -#line 13480 "" +#line 13461 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); -#line 13480 "" +#line 13461 "" } -#line 13482 "" +#line 13463 "" ++ndoub; -#line 13483 "" +#line 13464 "" } else if (*(unsigned char *)durq == 'd') { /* Dotted xtup note */ /* if (btest(irest(ivx,nnl(ivx))-1,2)) then */ -#line 13488 "" +#line 13469 "" if (bit_test(all_1.irest[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25],2)) { /* Move dot on 2nd note of 2-note tremolo */ -#line 13492 "" +#line 13473 "" ++comcc_1.ndotmv[commvl_1.ivx - 1]; -#line 13493 "" +#line 13474 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); -#line 13494 "" +#line 13475 "" g1etchar_(lineq, &all_1.iccount, durq, (ftnlen) 128, (ftnlen)1); /* Will be + or - */ -#line 13495 "" +#line 13476 "" ++all_1.iccount; -#line 13496 "" +#line 13477 "" readnum_(lineq, &all_1.iccount, dumq, & comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); -#line 13498 "" +#line 13479 "" if (*(unsigned char *)durq == '-') { -#line 13498 "" +#line 13479 "" comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25] = -comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25]; -#line 13498 "" +#line 13479 "" } -#line 13500 "" +#line 13481 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ -#line 13504 "" +#line 13485 "" readnum_(lineq, &all_1.iccount, durq, & comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); -#line 13506 "" +#line 13487 "" if (*(unsigned char *)durq == '-') { -#line 13506 "" +#line 13487 "" comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25] = -comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25]; -#line 13506 "" +#line 13487 "" } -#line 13508 "" +#line 13489 "" } -#line 13509 "" +#line 13490 "" --all_1.iccount; -#line 13510 "" +#line 13491 "" } else { /* Dot for 3:1 pair of xtup notes */ -#line 13514 "" +#line 13495 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); -#line 13515 "" +#line 13496 "" } -#line 13516 "" +#line 13497 "" } else { /* Must be an octave number */ -#line 13520 "" +#line 13501 "" i__2 = *(unsigned char *)durq - 48; -#line 13520 "" +#line 13501 "" comnotes_1.lastlev = ifnolev_(charq, &i__2, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1); -#line 13522 "" +#line 13503 "" } -#line 13523 "" +#line 13504 "" goto L8; -#line 13524 "" +#line 13505 "" } -#line 13525 "" +#line 13506 "" if (itup < ntup) { /* Last note is handled *after* flowing out of the xtup if block, but still */ @@ -32050,201 +32230,201 @@ L8: /* Could have problem here if rests & doubled notes are combined in xtup, */ /* since might exit the loop at the wrong place. Worry about it later. */ -#line 13532 "" +#line 13513 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0)) { -#line 13533 "" +#line 13514 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + ( ifnolev_(charq, &c__10, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1) - comnotes_1.lastlev + 3) % 7; -#line 13535 "" +#line 13516 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; -#line 13536 "" +#line 13517 "" } -#line 13537 "" +#line 13518 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; -#line 13538 "" +#line 13519 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set note level for preslur on internal xtup note */ -#line 13542 "" +#line 13523 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7, &c__19, & comnotes_1.lastlev); -#line 13543 "" +#line 13524 "" /* L42: */ -#line 13543 "" +#line 13524 "" } -#line 13544 "" +#line 13525 "" } -#line 13545 "" +#line 13526 "" if (itup == ntup - ndoub) { -#line 13545 "" +#line 13526 "" goto L12; -#line 13545 "" +#line 13526 "" } -#line 13546 "" +#line 13527 "" /* L6: */ -#line 13546 "" +#line 13527 "" } -#line 13547 "" +#line 13528 "" L12: -#line 13548 "" +#line 13529 "" if (comget_1.ornrpt) { -#line 13549 "" +#line 13530 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991; -#line 13551 "" +#line 13532 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ -#line 13555 "" +#line 13536 "" ++comtrill_1.ntrill; -#line 13556 "" +#line 13537 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; -#line 13557 "" +#line 13538 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; -#line 13558 "" +#line 13539 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[comtrill_1.ntrill - 2]; -#line 13559 "" +#line 13540 "" } -#line 13560 "" +#line 13541 "" } /* End of if-block for xtuplet input */ -#line 13564 "" +#line 13545 "" } else if (*(unsigned char *)durq == 'm') { /* Multi-bar rest: next 1 or two digits are # of bars. */ /* For some purposes, pretend its one bar only */ -#line 13569 "" +#line 13550 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.lenbar; -#line 13570 "" +#line 13551 "" comgrace_1.ibarmbr = all_1.nbars + 1; -#line 13571 "" +#line 13552 "" comgrace_1.mbrest = 0; -#line 13572 "" +#line 13553 "" comgrace_1.xb4mbr = 0.f; -#line 13573 "" +#line 13554 "" L20: -#line 13573 "" +#line 13554 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 13574 "" +#line 13555 "" if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) { -#line 13575 "" +#line 13556 "" comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char * )durq - 48; -#line 13576 "" +#line 13557 "" goto L20; -#line 13577 "" +#line 13558 "" } /* durq will either be blank or 'n' */ -#line 13580 "" +#line 13561 "" if (*(unsigned char *)durq == 'n') { /* Get new height */ -#line 13584 "" +#line 13565 "" iplmi = 1; -#line 13585 "" +#line 13566 "" g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1) ; -#line 13586 "" +#line 13567 "" if (*(unsigned char *)durq == '-') { -#line 13587 "" +#line 13568 "" iplmi = -1; -#line 13588 "" +#line 13569 "" ++all_1.iccount; -#line 13589 "" +#line 13570 "" } -#line 13590 "" +#line 13571 "" readnum_(lineq, &all_1.iccount, durq, &hgt, (ftnlen)128, ( ftnlen)1); -#line 13591 "" +#line 13572 "" r__1 = iplmi * hgt; -#line 13591 "" +#line 13572 "" comignorenats_1.mbrhgt = i_nint(&r__1); -#line 13592 "" +#line 13573 "" comignorenats_1.newmbrhgt = TRUE_; -#line 13593 "" +#line 13574 "" } -#line 13594 "" +#line 13575 "" } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Set stem flipper */ -#line 13598 "" +#line 13579 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],30); -#line 13599 "" +#line 13580 "" if (*(unsigned char *)durq == 'u') { -#line 13599 "" +#line 13580 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],17); -#line 13599 "" +#line 13580 "" } -#line 13601 "" +#line 13582 "" goto L2; -#line 13602 "" +#line 13583 "" } else if (*(unsigned char *)durq == 'a') { /* "Alone", i.e., prohibit beam */ -#line 13606 "" +#line 13587 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); -#line 13607 "" +#line 13588 "" goto L2; -#line 13608 "" +#line 13589 "" } else if (*(unsigned char *)durq == 'r') { /* Right offset by one notehead */ -#line 13612 "" +#line 13593 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9); -#line 13613 "" +#line 13594 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],20); -#line 13614 "" +#line 13595 "" goto L2; -#line 13615 "" +#line 13596 "" } else if (*(unsigned char *)durq == 'e') { /* Left offset by one notehead */ -#line 13619 "" +#line 13600 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8); -#line 13620 "" +#line 13601 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); -#line 13621 "" +#line 13602 "" goto L2; -#line 13622 "" +#line 13603 "" } else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 */ @@ -32252,427 +32432,427 @@ L20: /* interbeams = internotes*2/3. */ -#line 13629 "" +#line 13610 "" isign = 1; -#line 13630 "" +#line 13611 "" if (*(unsigned char *)durq == 'S') { -#line 13630 "" +#line 13611 "" isign = -1; -#line 13630 "" +#line 13611 "" } -#line 13631 "" +#line 13612 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); -#line 13632 "" +#line 13613 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 13633 "" +#line 13614 "" if (*(unsigned char *)durq == ':') { /* End stickyS. Grab data now from prior note, since we have to shut off stickyS. */ -#line 13637 "" +#line 13618 "" i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10); -#line 13637 "" +#line 13618 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); -#line 13639 "" +#line 13620 "" comget_1.stickys = FALSE_; -#line 13640 "" +#line 13621 "" goto L2; -#line 13641 "" +#line 13622 "" } /* If durq .ne. ':' then iccount is now on the start of the number */ -#line 13645 "" +#line 13626 "" readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen) 1); -#line 13646 "" +#line 13627 "" dum = isign * dum; -#line 13647 "" +#line 13628 "" r__1 = (dum + 4.f) * 2; -#line 13647 "" +#line 13628 "" i__1 = i_nint(&r__1); -#line 13647 "" +#line 13628 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); -#line 13648 "" +#line 13629 "" if (*(unsigned char *)durq == ':') { -#line 13649 "" +#line 13630 "" comget_1.stickys = TRUE_; -#line 13650 "" +#line 13631 "" } else { -#line 13651 "" +#line 13632 "" --all_1.iccount; -#line 13652 "" +#line 13633 "" } -#line 13653 "" +#line 13634 "" goto L2; -#line 13654 "" +#line 13635 "" } else if (*(unsigned char *)durq == ',') { /* 2:1 pattern */ -#line 13658 "" +#line 13639 "" idotform = 3; /* Now flow to duration setting, as if durq=' ' */ -#line 13662 "" +#line 13643 "" } else if (*(unsigned char *)durq == '.') { /* Dotted pattern. Close out note. Mult time by 3/4. */ /* Set time for next note to 1/4. Start the note. */ -#line 13667 "" +#line 13648 "" idotform = 1; -#line 13668 "" +#line 13649 "" } else if (*(unsigned char *)durq == 'o') { /* Suppress rest centering */ -#line 13672 "" +#line 13653 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],25); -#line 13673 "" +#line 13654 "" goto L2; -#line 13674 "" +#line 13655 "" } else if (*(unsigned char *)durq == 'L') { /* With keyboard rest option, look left */ /* iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) */ -#line 13679 "" +#line 13660 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],1); -#line 13680 "" +#line 13661 "" goto L2; -#line 13681 "" +#line 13662 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double note for xtup. Must check here in case "D" came before "x" or on */ /* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */ -#line 13686 "" +#line 13667 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); -#line 13687 "" +#line 13668 "" if (*(unsigned char *)durq == 'F') { -#line 13687 "" +#line 13668 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); -#line 13687 "" +#line 13668 "" } -#line 13689 "" +#line 13670 "" goto L2; -#line 13690 "" +#line 13671 "" } else if (*(unsigned char *)durq == 'A') { /* Accidental option */ -#line 13694 "" +#line 13675 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 13696 "" +#line 13677 "" if (*(unsigned char *)durq == 'o') { /* Ordered accidentals in a chord. Mark the main note. */ -#line 13700 "" +#line 13681 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],28); -#line 13701 "" +#line 13682 "" } else { /* Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */ -#line 13705 "" +#line 13686 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],29); -#line 13706 "" +#line 13687 "" --all_1.iccount; -#line 13707 "" +#line 13688 "" } -#line 13708 "" +#line 13689 "" goto L2; -#line 13709 "" +#line 13690 "" } else if (*(unsigned char *)durq == 'T') { -#line 13710 "" +#line 13691 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 13711 "" +#line 13692 "" multtrem = i_indx("1234", durq, (ftnlen)4, (ftnlen)1); -#line 13712 "" +#line 13693 "" if (multtrem == 0) { -#line 13713 "" +#line 13694 "" --all_1.iccount; -#line 13714 "" +#line 13695 "" multtrem = 1; -#line 13715 "" +#line 13696 "" } -#line 13716 "" +#line 13697 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],4); -#line 13717 "" +#line 13698 "" i__1 = multtrem - 1; -#line 13717 "" +#line 13698 "" setbits_(&all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__2, &c__5, &i__1); -#line 13718 "" +#line 13699 "" goto L2; -#line 13719 "" +#line 13700 "" } else if (*(unsigned char *)durq != ' ') { -#line 13720 "" - s_wsle(&io___816); -#line 13720 "" +#line 13701 "" + s_wsle(&io___815); +#line 13701 "" do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27); -#line 13720 "" +#line 13701 "" do_lio(&c__9, &c__1, durq, (ftnlen)1); -#line 13720 "" +#line 13701 "" do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9); -#line 13720 "" +#line 13701 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); -#line 13720 "" +#line 13701 "" do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( ftnlen)sizeof(integer)); -#line 13720 "" +#line 13701 "" e_wsle(); -#line 13722 "" +#line 13703 "" stop1_(); -#line 13723 "" +#line 13704 "" } /* Done with note/rest options. Set level and duration. */ -#line 13727 "" +#line 13708 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { -#line 13728 "" +#line 13709 "" if (numnum == 2) { -#line 13729 "" +#line 13710 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1); -#line 13730 "" +#line 13711 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; -#line 13731 "" +#line 13712 "" } else { -#line 13732 "" +#line 13713 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, &c__10, &cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) % 7; -#line 13734 "" +#line 13715 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; -#line 13735 "" +#line 13716 "" } -#line 13736 "" +#line 13717 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set level for preslur on normal note, non-chord */ -#line 13740 "" +#line 13721 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & c__7, &c__19, &comnotes_1.lastlev); -#line 13741 "" +#line 13722 "" /* L43: */ -#line 13741 "" +#line 13722 "" } /* Only matters if last note, non-rest of xtuplet */ -#line 13745 "" +#line 13726 "" ++nnb; -#line 13746 "" +#line 13727 "" } /* Set flag for unbeamed xtup if it just has 1 note */ -#line 13750 "" +#line 13731 "" if (inxtup && nnb == 1) { -#line 13751 "" +#line 13732 "" all_1.islur[commvl_1.ivx + note1xtup * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + note1xtup * 24 - 25],18); -#line 13752 "" +#line 13733 "" } -#line 13753 "" +#line 13734 "" if (idotform > 0) { -#line 13754 "" +#line 13735 "" if (idotform == 1) { -#line 13755 "" +#line 13736 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1) * 3 / 2; -#line 13756 "" +#line 13737 "" } else if (idotform == 2) { -#line 13757 "" +#line 13738 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25] / 3; -#line 13758 "" +#line 13739 "" } else if (idotform == 3) { -#line 13759 "" +#line 13740 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); -#line 13760 "" +#line 13741 "" } else if (idotform == 4) { -#line 13761 "" +#line 13742 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25] / 2; -#line 13762 "" +#line 13743 "" } -#line 13763 "" +#line 13744 "" } else if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19)) { /* Set duration of full-bar rest as pause */ -#line 13767 "" +#line 13748 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.lenbar; /* Use a one-line function to set nnodur. It gives inverse of ifnodur. */ -#line 13771 "" +#line 13752 "" i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48; -#line 13771 "" +#line 13752 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 13771 "" +#line 13752 "" comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, ( ftnlen)1) - 1; -#line 13773 "" +#line 13754 "" } else if (comgrace_1.ibarmbr != all_1.nbars + 1) { -#line 13774 "" +#line 13755 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); -#line 13775 "" +#line 13756 "" if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],3)) { -#line 13775 "" +#line 13756 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25] * 7 / 6; -#line 13775 "" +#line 13756 "" } -#line 13777 "" +#line 13758 "" } -#line 13778 "" +#line 13759 "" if (comnotes_1.shifton && ! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],16)) { /* Shift is on, and this is not first shifted note. Check for duration change */ -#line 13782 "" +#line 13763 "" if (all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] != all_1.nodur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25]) { /* Must stop and restart the offset. */ -#line 13786 "" +#line 13767 "" all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],17); -#line 13787 "" +#line 13768 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],16); -#line 13788 "" +#line 13769 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; -#line 13789 "" +#line 13770 "" comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udoff[commvl_1.ivx + ( comudsp_1.nudoff[commvl_1.ivx - 1] - 1) * 24 - 25]; -#line 13790 "" +#line 13771 "" } -#line 13791 "" +#line 13772 "" } -#line 13792 "" +#line 13773 "" all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; -#line 13793 "" +#line 13774 "" if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && comget_1.fbon) { /* Check to see if need to terminate auto forced beam */ -#line 13797 "" +#line 13778 "" r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; -#line 13797 "" +#line 13778 "" if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { /* Terminate autofb */ -#line 13801 "" +#line 13782 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; -#line 13802 "" +#line 13783 "" comget_1.fbon = FALSE_; -#line 13803 "" +#line 13784 "" } -#line 13804 "" +#line 13785 "" } -#line 13805 "" +#line 13786 "" if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar == 0) { /* Finished a bar */ -#line 13809 "" +#line 13790 "" ++all_1.nbars; -#line 13810 "" +#line 13791 "" all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[ commvl_1.ivx - 1]; -#line 13811 "" +#line 13792 "" if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) { /* Just finished the pickup bar for this voice. */ -#line 13815 "" +#line 13796 "" all_1.lenbar = all_1.lenb1; -#line 13816 "" +#line 13797 "" } -#line 13817 "" +#line 13798 "" } -#line 13818 "" +#line 13799 "" if (idotform == 1) { -#line 13819 "" +#line 13800 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 13820 "" +#line 13801 "" idotform = 2; -#line 13821 "" +#line 13802 "" numnum = 1; -#line 13822 "" +#line 13803 "" goto L28; -#line 13823 "" +#line 13804 "" } else if (idotform == 3) { -#line 13824 "" +#line 13805 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 13825 "" +#line 13806 "" idotform = 4; -#line 13826 "" +#line 13807 "" numnum = 1; -#line 13827 "" +#line 13808 "" goto L28; -#line 13828 "" +#line 13809 "" } /* End of sub block for note-rest */ -#line 13832 "" +#line 13813 "" } else if (*(unsigned char *)charq == 'z') { /* Chord note. Must have note name, may have octave#,+,-,s,f,n,d */ @@ -32704,331 +32884,331 @@ L20: /* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ -#line 13863 "" +#line 13844 "" ++comtrill_1.ncrd; -#line 13864 "" +#line 13845 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],10); -#line 13865 "" +#line 13846 "" numnum = 0; /* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ -#line 13867 "" +#line 13848 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1]; -#line 13868 "" +#line 13849 "" i__1 = commvl_1.ivx % 16; -#line 13868 "" +#line 13849 "" setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1) ; -#line 13869 "" +#line 13850 "" if (commvl_1.ivx >= 16) { -#line 13869 "" +#line 13850 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],28); -#line 13869 "" +#line 13850 "" } -#line 13870 "" +#line 13851 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0; -#line 13871 "" +#line 13852 "" comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; /* Get note name */ -#line 13875 "" +#line 13856 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); /* Get optional inputs */ -#line 13879 "" +#line 13860 "" L25: -#line 13879 "" +#line 13860 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* ndx = index('fsn+-<>12345678rediA',durq) */ -#line 13881 "" +#line 13862 "" ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1); -#line 13882 "" +#line 13863 "" if (ndx == 20) { /* Expect +|-|<|> , set tag, loop */ -#line 13886 "" +#line 13867 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],29); -#line 13887 "" +#line 13868 "" goto L25; -#line 13888 "" +#line 13869 "" } else if (ndx > 0) { -#line 13889 "" +#line 13870 "" if (ndx <= 3) { -#line 13890 "" +#line 13871 "" if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) { -#line 13891 "" +#line 13872 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],19); -#line 13892 "" +#line 13873 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20; -#line 13893 "" +#line 13874 "" } else { -#line 13894 "" +#line 13875 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],22); -#line 13895 "" +#line 13876 "" } -#line 13896 "" +#line 13877 "" } else if (ndx == 21) { /* Set flags for cautionary accidental */ -#line 13900 "" +#line 13881 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],31); -#line 13901 "" +#line 13882 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1],31); -#line 13902 "" +#line 13883 "" } else if (ndx <= 7) { /* +/-/ Check whether octave or accidental shift */ -#line 13906 "" +#line 13887 "" nactmp = 0; -#line 13907 "" +#line 13888 "" chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128) ; -#line 13908 "" +#line 13889 "" if (moved) { /* Transfer accidental shift values */ -#line 13912 "" +#line 13893 "" i__1 = igetbits_(&nactmp, &c__6, &c__4); -#line 13912 "" +#line 13893 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, & c__14, &i__1); -#line 13913 "" +#line 13894 "" i__1 = igetbits_(&nactmp, &c__7, &c__10); -#line 13913 "" +#line 13894 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, & c__20, &i__1); -#line 13914 "" +#line 13895 "" } else { -#line 13915 "" +#line 13896 "" if (*(unsigned char *)durq == '+') { -#line 13916 "" +#line 13897 "" comnotes_1.lastlev += 7; -#line 13917 "" +#line 13898 "" } else if (*(unsigned char *)durq == '-') { -#line 13918 "" +#line 13899 "" comnotes_1.lastlev += -7; -#line 13919 "" +#line 13900 "" } -#line 13920 "" +#line 13901 "" } -#line 13921 "" +#line 13902 "" } else if (*(unsigned char *)durq == 'e') { -#line 13922 "" +#line 13903 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],23); -#line 13923 "" +#line 13904 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); -#line 13924 "" +#line 13905 "" } else if (*(unsigned char *)durq == 'r') { -#line 13925 "" +#line 13906 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],24); -#line 13926 "" +#line 13907 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],20); -#line 13927 "" +#line 13908 "" } else if (*(unsigned char *)durq == 'i') { /* Midi-only accidental on chord note */ -#line 13931 "" +#line 13912 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],27); -#line 13932 "" +#line 13913 "" } else if (*(unsigned char *)durq == 'd') { /* Must keep 'd' optional (backward compatibility), unless it is moved! */ -#line 13936 "" +#line 13917 "" i__1 = all_1.iccount; -#line 13936 "" +#line 13917 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 - i__1) > 0) { /* move a dot, unless next char is not part of a number */ -#line 13940 "" +#line 13921 "" i__1 = all_1.iccount + 1; -#line 13940 "" +#line 13921 "" if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, all_1.iccount + 2 - i__1) == 0) { -#line 13940 "" +#line 13921 "" goto L25; -#line 13940 "" +#line 13921 "" } -#line 13942 "" +#line 13923 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],26); -#line 13943 "" +#line 13924 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); -#line 13944 "" +#line 13925 "" ++all_1.iccount; -#line 13945 "" +#line 13926 "" readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 13946 "" +#line 13927 "" if (*(unsigned char *)durq == '+') { -#line 13947 "" +#line 13928 "" r__1 = fnum * 10; -#line 13947 "" +#line 13928 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(& r__1) + 64; -#line 13948 "" +#line 13929 "" } else { -#line 13949 "" +#line 13930 "" r__1 = fnum * 10; -#line 13949 "" +#line 13930 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(& r__1) + 64; -#line 13950 "" +#line 13931 "" } -#line 13951 "" +#line 13932 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift specified also */ -#line 13955 "" +#line 13936 "" ++all_1.iccount; -#line 13956 "" +#line 13937 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); -#line 13957 "" +#line 13938 "" if (*(unsigned char *)dumq == '+') { -#line 13958 "" +#line 13939 "" r__1 = fnum * 10; -#line 13958 "" +#line 13939 "" ifnum = i_nint(&r__1) + 64; -#line 13959 "" +#line 13940 "" } else { -#line 13960 "" +#line 13941 "" r__1 = fnum * 10; -#line 13960 "" +#line 13941 "" ifnum = -i_nint(&r__1) + 64; -#line 13961 "" +#line 13942 "" } -#line 13962 "" +#line 13943 "" } else { -#line 13963 "" +#line 13944 "" ifnum = 64; -#line 13964 "" +#line 13945 "" } -#line 13965 "" +#line 13946 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7; -#line 13966 "" +#line 13947 "" --all_1.iccount; -#line 13967 "" +#line 13948 "" } -#line 13968 "" +#line 13949 "" } else { /* must be a single digit, save it in ioct */ -#line 13972 "" +#line 13953 "" numnum = 1; -#line 13973 "" +#line 13954 "" ioct = ndx - 7; -#line 13974 "" +#line 13955 "" } -#line 13975 "" +#line 13956 "" goto L25; -#line 13976 "" +#line 13957 "" } -#line 13977 "" +#line 13958 "" if (numnum == 1) { -#line 13978 "" +#line 13959 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1); -#line 13979 "" +#line 13960 "" } else { -#line 13980 "" +#line 13961 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, & c__10, &cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) % 7; -#line 13982 "" +#line 13963 "" } -#line 13983 "" +#line 13964 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12; -#line 13984 "" +#line 13965 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { -#line 13985 "" +#line 13966 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7, &c__19, &comnotes_1.lastlev); /* Set level for chord note. */ /* Initially I assigned the slur(s) to next note, so fix. */ -#line 13990 "" +#line 13971 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_clear(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],0); -#line 13991 "" +#line 13972 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0); -#line 13992 "" +#line 13973 "" all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set( all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0); -#line 13993 "" +#line 13974 "" i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3) - 1; -#line 13993 "" +#line 13974 "" setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3, &i__1); -#line 13995 "" +#line 13976 "" /* L44: */ -#line 13995 "" +#line 13976 "" } -#line 13996 "" +#line 13977 "" if (comnotes_1.notcrd) { /* This is the first chord note in this chord. */ /* Computing MIN */ -#line 14000 "" +#line 13981 "" i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; -#line 14000 "" +#line 13981 "" comtrill_1.minlev = min(i__1,comnotes_1.lastlev); /* Computing MAX */ -#line 14001 "" +#line 13982 "" i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; -#line 14001 "" +#line 13982 "" comtrill_1.maxlev = max(i__1,comnotes_1.lastlev); -#line 14002 "" +#line 13983 "" } else { -#line 14003 "" +#line 13984 "" comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev); -#line 14004 "" +#line 13985 "" comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev); -#line 14005 "" +#line 13986 "" } -#line 14006 "" +#line 13987 "" comnotes_1.notcrd = FALSE_; -#line 14007 "" +#line 13988 "" } else if (*(unsigned char *)charq == 'G') { -#line 14008 "" +#line 13989 "" getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount, all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, & comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128); @@ -33046,1372 +33226,1394 @@ L25: /* These data MUST precede note name of first note */ /* nolevg, naccg: lists of levels and accid's, indexed as described above. */ -#line 14024 "" +#line 14005 "" } else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) { /* Literal TeX string */ -#line 14028 "" +#line 14009 "" i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; -#line 14028 "" +#line 14009 "" littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); -#line 14029 "" - } else if (*(unsigned char *)charq == '"') { +#line 14010 "" + } else /* if(complicated condition) */ { +#line 14010 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 14010 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { /* pmxlyr string. Expand "..." to \pmxlyr{...}\ */ -#line 14033 "" - if (! comlyr_1.inputmlyr) { -#line 14034 "" - ictemp = 0; +#line 14014 "" + if (! comlyr_1.inputmlyr) { +#line 14015 "" + ictemp = 0; /* Writing concatenation */ -#line 14035 "" - i__3[0] = 1, a__1[0] = all_1.sq; -#line 14035 "" - i__3[1] = 1, a__1[1] = all_1.sq; -#line 14035 "" - i__3[2] = 1, a__1[2] = all_1.sq; -#line 14035 "" - i__3[3] = 15, a__1[3] = "input musixlyr "; -#line 14035 "" - i__3[4] = 1, a__1[4] = all_1.sq; -#line 14035 "" - s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); -#line 14036 "" +#line 14016 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14016 "" + i__3[1] = 1, a__1[1] = all_1.sq; +#line 14016 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 14016 "" + i__3[3] = 15, a__1[3] = "input musixlyr "; +#line 14016 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 14016 "" + s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); +#line 14017 "" + i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 14017 "" + littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, + lineqt, &ictemp, (ftnlen)128); +#line 14018 "" + comlyr_1.inputmlyr = TRUE_; +#line 14019 "" + } +#line 14020 "" + dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 14021 "" + *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 14022 "" i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; -#line 14036 "" +#line 14022 "" littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, - lineqt, &ictemp, (ftnlen)128); -#line 14037 "" - comlyr_1.inputmlyr = TRUE_; -#line 14038 "" - } -#line 14039 "" - dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); -#line 14040 "" - *(unsigned char *)charq = *(unsigned char *)all_1.sq; -#line 14041 "" - i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; -#line 14041 "" - littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & - all_1.iccount, (ftnlen)128); -#line 14042 "" - } else if (*(unsigned char *)charq == 'o') { + lineq, &all_1.iccount, (ftnlen)128); +#line 14023 "" + } else if (*(unsigned char *)charq == 'o') { /* Ornament on non-xtup note. Symbol must come AFTER the affected note */ -#line 14046 "" - if (comnotes_1.notcrd) { +#line 14027 "" + if (comnotes_1.notcrd) { +#line 14028 "" + nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25]; +#line 14029 "" + } else { +#line 14030 "" + nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1] + , (ftnlen)-12); +#line 14031 "" + } +#line 14032 "" + getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[ + commvl_1.ivx - 1], &comget_1.ornrpt, &comgrace_1.noffseg, + &all_1.nnl[commvl_1.ivx - 1], &commvl_1.ivx, &c_true, & + comnotes_1.notcrd, &nole, (ftnlen)128); +#line 14035 "" + } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 14036 "" + nnlivx = all_1.nnl[commvl_1.ivx - 1]; +#line 14037 "" + if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == + '{') { + +/* Detect preslur on normal non-chord note */ + +#line 14041 "" + ++nnlivx; +#line 14042 "" + ++comnotes_1.npreslur; +#line 14043 "" + } +#line 14044 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0); +#line 14045 "" + if (*(unsigned char *)charq == 't') { +#line 14045 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); +#line 14045 "" + } #line 14047 "" - nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * - 24 - 25]; + if (commvl_1.ivx <= all_1.nv) { #line 14048 "" - } else { + kv = 1; #line 14049 "" - nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], ( - ftnlen)-12); + } else { #line 14050 "" - } + kv = 2; #line 14051 "" - getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[commvl_1.ivx - 1], & - comget_1.ornrpt, &comgrace_1.noffseg, &all_1.nnl[commvl_1.ivx - - 1], &commvl_1.ivx, &c_true, &comnotes_1.notcrd, &nole, ( - ftnlen)128); -#line 14054 "" - } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { + } +#line 14052 "" + if (comslur_1.fontslur) { +#line 14053 "" + sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, + all_1.isdat1, all_1.isdat2, all_1.isdat3, & + all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[ + commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, + (ftnlen)1); #line 14055 "" - nnlivx = all_1.nnl[commvl_1.ivx - 1]; + } else { #line 14056 "" - if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{') - { + spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, + all_1.isdat1, all_1.isdat2, all_1.isdat3, + all_1.isdat4, &all_1.nsdat, &comnotes_1.notcrd, & + all_1.nolev[commvl_1.ivx + nnlivx * 24 - 25], charq, ( + ftnlen)128, (ftnlen)1); +#line 14058 "" + } +#line 14059 "" + } else if (*(unsigned char *)charq == '?') { -/* Detect preslur on normal non-chord note */ +/* Arpeggio */ -#line 14060 "" - ++nnlivx; -#line 14061 "" - ++comnotes_1.npreslur; -#line 14062 "" - } #line 14063 "" - all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[ - commvl_1.ivx + nnlivx * 24 - 25],0); -#line 14064 "" - if (*(unsigned char *)charq == 't') { -#line 14064 "" - all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( - all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); -#line 14064 "" - } -#line 14066 "" - if (commvl_1.ivx <= all_1.nv) { -#line 14067 "" - kv = 1; + if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25],10)) { + +/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ +/* of chord, will not set icrdat(25), but iornq(27) */ + #line 14068 "" - } else { + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],25); #line 14069 "" - kv = 2; + } else { #line 14070 "" - } + all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 1],27); #line 14071 "" - if (comslur_1.fontslur) { -#line 14072 "" - sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, - all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, & - comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx * - 24 - 25], charq, (ftnlen)128, (ftnlen)1); -#line 14074 "" - } else { + } + +/* Check for shift */ + #line 14075 "" - spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, - all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, & - all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[ - commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, ( - ftnlen)1); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14076 "" + if (*(unsigned char *)durq == ' ') { #line 14077 "" - } + --all_1.iccount; #line 14078 "" - } else if (*(unsigned char *)charq == '?') { + } else { -/* Arpeggio */ +/* durq must be "-" */ #line 14082 "" - if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * - 24 - 25],10)) { + ++all_1.iccount; +#line 14083 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 14084 "" + --all_1.iccount; -/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ -/* of chord, will not set icrdat(25), but iornq(27) */ +/* record the shift */ -#line 14087 "" - comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( - comtrill_1.icrdat[comtrill_1.ncrd - 1],25); #line 14088 "" - } else { + ++comarpshift_1.numarpshift; #line 14089 "" - all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = - bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 1],27); + comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] = + commvl_1.ivx; #line 14090 "" - } - -/* Check for shift */ - -#line 14094 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14095 "" - if (*(unsigned char *)durq == ' ') { -#line 14096 "" - --all_1.iccount; -#line 14097 "" - } else { + comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] = + all_1.nnl[commvl_1.ivx - 1]; +#line 14091 "" + comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum; +#line 14092 "" + } +#line 14093 "" + } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > + 0) { -/* durq must be "-" */ +/* We have a figure. Must come AFTER the note it goes under */ +#line 14098 "" + ivf = 1; +#line 14099 "" + if (commvl_1.ivx > 1) { +#line 14100 "" + if (comfig_1.ivxfig2 == 0) { #line 14101 "" - ++all_1.iccount; + comfig_1.ivxfig2 = commvl_1.ivx; #line 14102 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); + } else if (commvl_1.ivx != comfig_1.ivxfig2) { #line 14103 "" - --all_1.iccount; - -/* record the shift */ - + s_wsle(&io___816); +#line 14103 "" + e_wsle(); +#line 14104 "" + s_wsle(&io___817); +#line 14104 "" + do_lio(&c__9, &c__1, "Figures not allowed in >1 voice ab"\ + "ove first", (ftnlen)43); +#line 14104 "" + e_wsle(); +#line 14105 "" + s_stop("", (ftnlen)0); +#line 14106 "" + } #line 14107 "" - ++comarpshift_1.numarpshift; + ivf = 2; #line 14108 "" - comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] = - commvl_1.ivx; + } #line 14109 "" - comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] = - all_1.nnl[commvl_1.ivx - 1]; + nfig1 = comfig_1.nfigs[ivf - 1] + 1; #line 14110 "" - comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum; -#line 14111 "" - } -#line 14112 "" - } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > 0) { + getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, & + all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx + - 1] << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], + &all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], + comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, & + comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], & + comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], &comfig_1.nfigs[ + ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10); +/* * ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 14115 "" + } else if (*(unsigned char *)charq == '[') { -/* We have a figure. Must come AFTER the note it goes under */ +/* Start forced beam. Record barno & time since start of inp. blk. Set signal */ -#line 14117 "" - ivf = 1; -#line 14118 "" - if (commvl_1.ivx > 1) { #line 14119 "" - if (comfig_1.ivxfig2 == 0) { + ++comfb_1.nfb[commvl_1.ivx - 1]; #line 14120 "" - comfig_1.ivxfig2 = commvl_1.ivx; + comget_1.fbon = TRUE_; #line 14121 "" - } else if (commvl_1.ivx != comfig_1.ivxfig2) { -#line 14122 "" - s_wsle(&io___817); + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = 'x'; #line 14122 "" - e_wsle(); -#line 14123 "" - s_wsle(&io___818); -#line 14123 "" - do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "\ - "first", (ftnlen)43); + comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - + 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; #line 14123 "" - e_wsle(); + nadj = 0; #line 14124 "" - s_stop("", (ftnlen)0); + if (comfb_1.autofbon) { #line 14125 "" - } + comfb_1.autofbon = FALSE_; #line 14126 "" - ivf = 2; + } #line 14127 "" - } +L17: +#line 14127 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); #line 14128 "" - nfig1 = comfig_1.nfigs[ivf - 1] + 1; + if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) { #line 14129 "" - getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, & - all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx - 1] - << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], & - all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 25], comfig_1.figq + (ivf - + (nfig1 << 1) - 3) * 10, &comfig_1.ivupfig[ivf + (nfig1 << 1) - - 3], &comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & - comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10); -/* * ivupfig(ivf,nfig1),nfigs(ivf)) */ -#line 14134 "" - } else if (*(unsigned char *)charq == '[') { + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *) + charq; +#line 14130 "" + goto L17; +#line 14131 "" + } else if (*(unsigned char *)charq == 'j') { -/* Start forced beam. Record barno & time since start of inp. blk. Set signal */ +/* Continuing a jumped beam here */ + +#line 14135 "" + all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],24); + +/* Set flag to watch for END of this forced beam, so can set flag rest(30) on */ +/* NEXT note as signal to start a new notes group there. */ -#line 14138 "" - ++comfb_1.nfb[commvl_1.ivx - 1]; -#line 14139 "" - comget_1.fbon = TRUE_; #line 14140 "" - *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ - commvl_1.ivx - 1] * 24 - 25] = 'x'; + combjmp_1.isbj2 = TRUE_; #line 14141 "" - comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = - (real) all_1.itsofar[commvl_1.ivx - 1]; + goto L17; #line 14142 "" - nadj = 0; + } else if (*(unsigned char *)charq == 'h') { #line 14143 "" - if (comfb_1.autofbon) { + all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],2); #line 14144 "" - comfb_1.autofbon = FALSE_; + goto L17; #line 14145 "" - } -#line 14146 "" -L17: -#line 14146 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 14147 "" - if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) { -#line 14148 "" - *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ - commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq; + } else if (*(unsigned char *)charq == 'm') { + +/* Force multiplicity. Next input is digit */ + #line 14149 "" - goto L17; + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1) + ; #line 14150 "" - } else if (*(unsigned char *)charq == 'j') { + all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21); +#line 14151 "" + i__1 = *(unsigned char *)charq - 48; +#line 14151 "" + setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx + - 1] + 1) * 24 - 25], &c__3, &c__22, &i__1); +#line 14152 "" + goto L17; +#line 14153 "" + } else if (*(unsigned char *)charq == ':') { -/* Continuing a jumped beam here */ +/* Start auto forced beam pattern */ -#line 14154 "" - all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 25],24); +#line 14157 "" + comfb_1.autofbon = TRUE_; -/* Set flag to watch for END of this forced beam, so can set flag rest(30) on */ -/* NEXT note as signal to start a new notes group there. */ +/* When forced later beam ends, check whether tautofv <=0; if so set it. */ -#line 14159 "" - combjmp_1.isbj2 = TRUE_; -#line 14160 "" - goto L17; #line 14161 "" - } else if (*(unsigned char *)charq == 'h') { + comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]); #line 14162 "" - all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 25],2); + comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1]; #line 14163 "" - goto L17; + goto L17; #line 14164 "" - } else if (*(unsigned char *)charq == 'm') { + } else if (*(unsigned char *)charq != ' ') { -/* Force multiplicity. Next input is digit */ +/* Must be '+/-' for height or slope shift */ #line 14168 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 14169 "" - all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 25],21); -#line 14170 "" - i__1 = *(unsigned char *)charq - 48; -#line 14170 "" - setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 25], &c__3, &c__22, &i__1); -#line 14171 "" - goto L17; -#line 14172 "" - } else if (*(unsigned char *)charq == ':') { + ++nadj; -/* Start auto forced beam pattern */ +/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */ +#line 14172 "" + ++all_1.iccount; +#line 14173 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 14174 "" + --all_1.iccount; +#line 14175 "" + iadj = i_nint(&fnum); +#line 14176 "" + if (*(unsigned char *)charq == '-') { +#line 14176 "" + iadj = -iadj; #line 14176 "" - comfb_1.autofbon = TRUE_; + } +#line 14177 "" + if (nadj == 1) { -/* When forced later beam ends, check whether tautofv <=0; if so set it. */ +/* This is a level shift. Note if 0 was entered, iadj = 30 */ -#line 14180 "" - comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]); #line 14181 "" - comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1]; + i__1 = iadj + 30; +#line 14181 "" + setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__11, + &i__1); #line 14182 "" - goto L17; -#line 14183 "" - } else if (*(unsigned char *)charq != ' ') { + } else if (nadj == 2) { -/* Must be '+/-' for height or slope shift */ +/* Must be a slope shift */ +#line 14186 "" + i__1 = iadj + 30; +#line 14186 "" + setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__17, + &i__1); #line 14187 "" - ++nadj; + } else { -/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */ +/* Beam-thk fine tune */ #line 14191 "" - ++all_1.iccount; + setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 25], &c__2, &c__27, + &iadj); #line 14192 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); + } #line 14193 "" - --all_1.iccount; + goto L17; #line 14194 "" - iadj = i_nint(&fnum); -#line 14195 "" - if (*(unsigned char *)charq == '-') { -#line 14195 "" - iadj = -iadj; -#line 14195 "" } +#line 14195 "" + } else if (*(unsigned char *)charq == ']') { #line 14196 "" - if (nadj == 1) { - -/* This is a level shift. Note if 0 was entered, iadj = 30 */ - -#line 14200 "" - i__1 = iadj + 30; + if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) { +#line 14197 "" + comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] + + comfb_1.tautofb; +#line 14198 "" + } +#line 14199 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); #line 14200 "" - setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - - 1] + 1) * 24 - 25], &c__6, &c__11, &i__1); -#line 14201 "" - } else if (nadj == 2) { + if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) { -/* Must be a slope shift */ +/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */ +#line 14204 "" + comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * + 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; #line 14205 "" - i__1 = iadj + 30; -#line 14205 "" - setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - - 1] + 1) * 24 - 25], &c__6, &c__17, &i__1); + comget_1.fbon = FALSE_; #line 14206 "" - } else { + if (*(unsigned char *)charq == 'j') { +#line 14207 "" + all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],23); +#line 14208 "" + } +#line 14209 "" + if (combjmp_1.isbj2) { -/* Beam-thk fine tune */ +/* This is the end of a fb segment of a jump beam. Set flag on NEXT note to */ +/* force start of new notes group, provided this is not last note in bar. */ -#line 14210 "" - setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - - 1] + 1) * 24 - 25], &c__2, &c__27, &iadj); -#line 14211 "" - } -#line 14212 "" - goto L17; -#line 14213 "" - } #line 14214 "" - } else if (*(unsigned char *)charq == ']') { -#line 14215 "" - if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) { + if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) { +#line 14214 "" + all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - + 1] + 1) * 24 - 25] = bit_set(all_1.irest[ + commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + + 1) * 24 - 25],30); +#line 14214 "" + } #line 14216 "" - comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] + - comfb_1.tautofb; + combjmp_1.isbj2 = FALSE_; #line 14217 "" - } + } #line 14218 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 14219 "" - if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) { + } else if (*(unsigned char *)charq == '[') { -/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */ +/* Multiplicity down-up signal */ +#line 14222 "" + all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],20); #line 14223 "" - comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; -#line 14224 "" - comget_1.fbon = FALSE_; -#line 14225 "" - if (*(unsigned char *)charq == 'j') { -#line 14226 "" - all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 25],23); + } else if (*(unsigned char *)charq == '-') { + +/* Set signals for gap in single-slope beam [...]-[...] */ + #line 14227 "" - } + all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],20); #line 14228 "" - if (combjmp_1.isbj2) { + all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21); -/* This is the end of a fb segment of a jump beam. Set flag on NEXT note to */ -/* force start of new notes group, provided this is not last note in bar. */ +/* Next two characters must be "[ ". Skip over them. */ +#line 14232 "" + all_1.iccount += 2; #line 14233 "" - if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) { -#line 14233 "" - all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + - 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx - + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],30) - ; -#line 14233 "" - } -#line 14235 "" - combjmp_1.isbj2 = FALSE_; -#line 14236 "" } +#line 14234 "" + } else if (*(unsigned char *)charq == 'D') { +#line 14235 "" + getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], & + all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 1], lineq, &all_1.iccount, (ftnlen)128); #line 14237 "" - } else if (*(unsigned char *)charq == '[') { + } else if (*(unsigned char *)charq == 'h') { -/* Multiplicity down-up signal */ +/* Heading or height. For heading, only OK if at start of block */ +/* Check whether at beginning of a block */ -#line 14241 "" - all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] - = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 25],20); #line 14242 "" - } else if (*(unsigned char *)charq == '-') { - -/* Set signals for gap in single-slope beam [...]-[...] */ - + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 14243 "" + s_wsle(&io___819); +#line 14243 "" + do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of "\ + "block", (ftnlen)41); +#line 14243 "" + e_wsle(); +#line 14244 "" + stop1_(); +#line 14245 "" + } #line 14246 "" - all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = - bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - - 1] * 24 - 25],20); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14247 "" - all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 25] = bit_set(all_1.nacc[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 25],21); + comhead_1.ihdvrt = 0; +#line 14248 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -/* Next two characters must be "[ ". Skip over them. */ +/* Vertical offset */ -#line 14251 "" - all_1.iccount += 2; #line 14252 "" - } + ++all_1.iccount; #line 14253 "" - } else if (*(unsigned char *)charq == 'D') { + readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( + ftnlen)1); #line 14254 "" - getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[ - commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], & - all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - - 1], lineq, &all_1.iccount, (ftnlen)128); + comhead_1.ihdvrt = fnum + .1f; +#line 14255 "" + if (*(unsigned char *)durq == '-') { +#line 14255 "" + comhead_1.ihdvrt = -comhead_1.ihdvrt; +#line 14255 "" + } #line 14256 "" - } else if (*(unsigned char *)charq == 'h') { + *(unsigned char *)durq = *(unsigned char *)charq; +#line 14257 "" + } +#line 14258 "" + if (*(unsigned char *)durq != ' ') { -/* Heading or height. For heading, only OK if at start of block */ -/* Check whether at beginning of a block */ +/* Height symbol. Read past (until next blank) */ -#line 14261 "" - if (all_1.iv != 1 || all_1.nnl[0] != 0) { -#line 14262 "" - s_wsle(&io___820); #line 14262 "" - do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block" - , (ftnlen)41); +L3: #line 14262 "" - e_wsle(); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14263 "" - stop1_(); + if (*(unsigned char *)durq != ' ') { +#line 14263 "" + goto L3; +#line 14263 "" + } #line 14264 "" - } -#line 14265 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14266 "" - comhead_1.ihdvrt = 0; -#line 14267 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + } else { -/* Vertical offset */ +/* Set flag for header & read it in */ +#line 14268 "" + comhead_1.ihdht = 16; +#line 14269 "" + getbuf_(comhead_1.headrq, (ftnlen)80); +#line 14270 "" + all_1.iccount = 128; #line 14271 "" - ++all_1.iccount; -#line 14272 "" - readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 14273 "" - comhead_1.ihdvrt = fnum + .1f; -#line 14274 "" - if (*(unsigned char *)durq == '-') { -#line 14274 "" - comhead_1.ihdvrt = -comhead_1.ihdvrt; -#line 14274 "" } -#line 14275 "" - *(unsigned char *)durq = *(unsigned char *)charq; -#line 14276 "" - } +#line 14272 "" + } else if (*(unsigned char *)charq == 'L') { + +/* Linebreak, already handled some in pmxa, but need to get data for */ +/* shortened line or coda lengths */ + #line 14277 "" - if (*(unsigned char *)durq != ' ') { + ++all_1.iccount; +#line 14278 "" + if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'C') { -/* Height symbol. Read past (until next blank) */ +/* Coda, get length */ -#line 14281 "" -L3: -#line 14281 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14282 "" - if (*(unsigned char *)durq != ' ') { -#line 14282 "" - goto L3; -#line 14282 "" - } + ++all_1.iccount; #line 14283 "" - } else { + readnum_(lineq, &all_1.iccount, durq, &comshort_1.codafrac, ( + ftnlen)128, (ftnlen)1); +#line 14284 "" + comshort_1.ishort = 3; +#line 14285 "" + if (*(unsigned char *)durq == 'n') { +#line 14285 "" + comshort_1.nocodabn = TRUE_; +#line 14285 "" + } +#line 14286 "" + return 0; +#line 14287 "" + } -/* Set flag for header & read it in */ +/* Get line number */ -#line 14287 "" - comhead_1.ihdht = 16; -#line 14288 "" - getbuf_(comhead_1.headrq, (ftnlen)80); -#line 14289 "" - all_1.iccount = 128; -#line 14290 "" - } #line 14291 "" - } else if (*(unsigned char *)charq == 'L') { + readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, ( + ftnlen)1); +#line 14292 "" +L48: +/* Allow transfer up from below if S follows M */ +#line 14293 "" + if (*(unsigned char *)durq == 'S') { -/* Linebreak, already handled some in pmxa, but need to get data for */ -/* shortened line or coda lengths */ +/* Shortened line, get shortening fraction */ -#line 14296 "" - ++all_1.iccount; #line 14297 "" - if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'C') { - -/* Coda, get length */ - + ++all_1.iccount; +#line 14298 "" + readnum_(lineq, &all_1.iccount, durq, &comshort_1.shortfrac, ( + ftnlen)128, (ftnlen)1); +#line 14299 "" + comshort_1.ishort = 1; +#line 14300 "" + comshort_1.codafrac = 0.f; #line 14301 "" - ++all_1.iccount; -#line 14302 "" - readnum_(lineq, &all_1.iccount, durq, &comshort_1.codafrac, ( - ftnlen)128, (ftnlen)1); -#line 14303 "" - comshort_1.ishort = 3; -#line 14304 "" - if (*(unsigned char *)durq == 'n') { -#line 14304 "" - comshort_1.nocodabn = TRUE_; -#line 14304 "" } -#line 14305 "" - return 0; -#line 14306 "" - } -/* Get line number */ +/* Begin check for movement break */ +#line 14305 "" + if (*(unsigned char *)durq == 'P') { +#line 14306 "" + ++all_1.iccount; +#line 14307 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 14308 "" + } +#line 14309 "" + if (*(unsigned char *)durq == 'M') { #line 14310 "" - readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen) - 1); + comget_1.movbrk = i_nint(&fmovbrk); #line 14311 "" -L48: -/* Allow transfer up from below if S follows M */ + comget_1.movgap = 0; #line 14312 "" - if (*(unsigned char *)durq == 'S') { + comget_1.parmov = -1.f; +#line 14313 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14314 "" +L31: +#line 14314 "" + if (*(unsigned char *)durq == '+') { -/* Shortened line, get shortening fraction */ +/* Get vertical space (\internotes) */ -#line 14316 "" - ++all_1.iccount; -#line 14317 "" - readnum_(lineq, &all_1.iccount, durq, &comshort_1.shortfrac, ( - ftnlen)128, (ftnlen)1); #line 14318 "" - comshort_1.ishort = 1; + ++all_1.iccount; #line 14319 "" - comshort_1.codafrac = 0.f; + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 14320 "" - } - -/* Begin check for movement break */ - + comget_1.movgap = i_nint(&fnum); +#line 14321 "" + goto L31; +#line 14322 "" + } else if (*(unsigned char *)durq == 'i') { +#line 14323 "" + ++all_1.iccount; #line 14324 "" - if (*(unsigned char *)durq == 'P') { + readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, ( + ftnlen)128, (ftnlen)1); #line 14325 "" - ++all_1.iccount; + goto L31; #line 14326 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); + } else if (*(unsigned char *)durq == 'c') { #line 14327 "" - } + comnotes_1.nobar1 = TRUE_; #line 14328 "" - if (*(unsigned char *)durq == 'M') { + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14329 "" - comget_1.movbrk = i_nint(&fmovbrk); + goto L31; #line 14330 "" - comget_1.movgap = 0; -#line 14331 "" - comget_1.parmov = -1.f; -#line 14332 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14333 "" -L31: -#line 14333 "" - if (*(unsigned char *)durq == '+') { + } else if (*(unsigned char *)durq == 'r') { -/* Get vertical space (\internotes) */ +/* "rename" can be set on or off. */ +#line 14334 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 14335 "" + comnvi_1.rename = *(unsigned char *)durq == '+'; +#line 14336 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14337 "" - ++all_1.iccount; + goto L31; #line 14338 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 14339 "" - comget_1.movgap = i_nint(&fnum); -#line 14340 "" - goto L31; -#line 14341 "" - } else if (*(unsigned char *)durq == 'i') { -#line 14342 "" - ++all_1.iccount; + } else if (*(unsigned char *)durq == 'n') { + +/* Change # of voices. Input ninow, iiorig(1...ninow). Will use names, */ +/* staves per inst. and clefs corr. to iiorig in original list of instruments. */ + #line 14343 "" - readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, ( - ftnlen)128, (ftnlen)1); + nvold = all_1.nv; #line 14344 "" - goto L31; + all_1.nv = 0; #line 14345 "" - } else if (*(unsigned char *)durq == 'c') { + comnvi_1.rename = TRUE_; #line 14346 "" - comnotes_1.nobar1 = TRUE_; + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14347 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + if (*(unsigned char *)durq == ':') { #line 14348 "" - goto L31; + all_1.iccount += 2; #line 14349 "" - } else if (*(unsigned char *)durq == 'r') { - -/* "rename" can be set on or off. */ - + i__1 = all_1.iccount - 2; +#line 14349 "" + ici__1.icierr = 0; +#line 14349 "" + ici__1.iciend = 0; +#line 14349 "" + ici__1.icirnum = 1; +#line 14349 "" + ici__1.icirlen = all_1.iccount - i__1; +#line 14349 "" + ici__1.iciunit = lineq + i__1; +#line 14349 "" + ici__1.icifmt = "(i2)"; +#line 14349 "" + s_rsfi(&ici__1); +#line 14349 "" + do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) + sizeof(integer)); +#line 14349 "" + e_rsfi(); +#line 14350 "" + } else { +#line 14351 "" + comnotes_1.ninow = *(unsigned char *)durq - 48; +#line 14352 "" + } #line 14353 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + iiv = 0; +#line 14354 "" + i__1 = comnotes_1.ninow; #line 14354 "" - comnvi_1.rename = *(unsigned char *)durq == '+'; + for (iinow = 1; iinow <= i__1; ++iinow) { #line 14355 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14356 "" - goto L31; + if (*(unsigned char *)durq == ':') { #line 14357 "" - } else if (*(unsigned char *)durq == 'n') { - -/* Change # of voices. Input ninow, iiorig(1...ninow). Will use names, */ -/* staves per inst. and clefs corr. to iiorig in original list of instruments. */ - + all_1.iccount += 2; +#line 14358 "" + i__2 = all_1.iccount - 2; +#line 14358 "" + ici__1.icierr = 0; +#line 14358 "" + ici__1.iciend = 0; +#line 14358 "" + ici__1.icirnum = 1; +#line 14358 "" + ici__1.icirlen = all_1.iccount - i__2; +#line 14358 "" + ici__1.iciunit = lineq + i__2; +#line 14358 "" + ici__1.icifmt = "(i2)"; +#line 14358 "" + s_rsfi(&ici__1); +#line 14358 "" + do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], + (ftnlen)sizeof(integer)); +#line 14358 "" + e_rsfi(); +#line 14359 "" + } else { +#line 14360 "" + comnvi_1.iiorig[iinow - 1] = *(unsigned char *) + durq - 48; +#line 14361 "" + } #line 14362 "" - nvold = all_1.nv; + comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[ + comnvi_1.iiorig[iinow - 1] - 1]; #line 14363 "" - all_1.nv = 0; + all_1.nv += comnvi_1.nspern[iinow - 1]; #line 14364 "" - comnvi_1.rename = TRUE_; + *(unsigned char *)&all_1.sepsymq[iiv + + comnvi_1.nspern[iinow - 1] - 1] = '&'; #line 14365 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + if (comnvi_1.nspern[iinow - 1] > 1) { #line 14366 "" - if (*(unsigned char *)durq == ':') { + i__2 = comnvi_1.nspern[iinow - 1] - 1; +#line 14366 "" + for (iis = 1; iis <= i__2; ++iis) { #line 14367 "" - all_1.iccount += 2; -#line 14368 "" - i__1 = all_1.iccount - 2; -#line 14368 "" - ici__1.icierr = 0; -#line 14368 "" - ici__1.iciend = 0; -#line 14368 "" - ici__1.icirnum = 1; -#line 14368 "" - ici__1.icirlen = all_1.iccount - i__1; -#line 14368 "" - ici__1.iciunit = lineq + i__1; -#line 14368 "" - ici__1.icifmt = "(i2)"; -#line 14368 "" - s_rsfi(&ici__1); + *(unsigned char *)&all_1.sepsymq[iiv + iis - + 1] = '|'; #line 14368 "" - do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof( - integer)); +/* L64: */ #line 14368 "" - e_rsfi(); + } #line 14369 "" - } else { + } #line 14370 "" - comnotes_1.ninow = *(unsigned char *)durq - 48; + iiv += comnvi_1.nspern[iinow - 1]; +#line 14371 "" +/* L63: */ #line 14371 "" - } -#line 14372 "" - iiv = 0; -#line 14373 "" - i__1 = comnotes_1.ninow; -#line 14373 "" - for (iinow = 1; iinow <= i__1; ++iinow) { -#line 14374 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( - ftnlen)1); -#line 14375 "" - if (*(unsigned char *)durq == ':') { -#line 14376 "" - all_1.iccount += 2; -#line 14377 "" - i__2 = all_1.iccount - 2; -#line 14377 "" - ici__1.icierr = 0; -#line 14377 "" - ici__1.iciend = 0; -#line 14377 "" - ici__1.icirnum = 1; -#line 14377 "" - ici__1.icirlen = all_1.iccount - i__2; -#line 14377 "" - ici__1.iciunit = lineq + i__2; -#line 14377 "" - ici__1.icifmt = "(i2)"; -#line 14377 "" - s_rsfi(&ici__1); -#line 14377 "" - do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], ( - ftnlen)sizeof(integer)); -#line 14377 "" - e_rsfi(); -#line 14378 "" - } else { -#line 14379 "" - comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq - - 48; -#line 14380 "" } -#line 14381 "" - comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[ - comnvi_1.iiorig[iinow - 1] - 1]; + +/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */ + +/* if (islast) then */ +/* if (ninow .lt. 10) then */ +/* write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */ +/* else */ +/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */ +/* end if */ +/* end if */ #line 14382 "" - all_1.nv += comnvi_1.nspern[iinow - 1]; + if (all_1.nv == 1 && nvold > 1) { +#line 14383 "" + if (comlast_1.islast) { +#line 14383 "" + s_wsfe(&io___824); +/* Writing concatenation */ +#line 14383 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14383 "" + i__5[1] = 11, a__2[1] = "nostartrule"; +#line 14383 "" + s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 14383 "" + do_fio(&c__1, ch__2, (ftnlen)12); +#line 14383 "" + e_wsfe(); #line 14383 "" - *(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[ - iinow - 1] - 1] = '&'; + } #line 14384 "" - if (comnvi_1.nspern[iinow - 1] > 1) { + } else if (all_1.nv > 1 && nvold == 1) { #line 14385 "" - i__2 = comnvi_1.nspern[iinow - 1] - 1; + if (comlast_1.islast) { #line 14385 "" - for (iis = 1; iis <= i__2; ++iis) { + s_wsfe(&io___825); +/* Writing concatenation */ +#line 14385 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14385 "" + i__5[1] = 9, a__2[1] = "startrule"; +#line 14385 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14385 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 14385 "" + e_wsfe(); +#line 14385 "" + } #line 14386 "" - *(unsigned char *)&all_1.sepsymq[iiv + iis - 1] = - '|'; -#line 14387 "" -/* L64: */ + } #line 14387 "" - } + iiv = 0; #line 14388 "" - } + i__1 = comnotes_1.ninow; +#line 14388 "" + for (iinow = 1; iinow <= i__1; ++iinow) { #line 14389 "" - iiv += comnvi_1.nspern[iinow - 1]; -#line 14390 "" -/* L63: */ + i__2 = comnvi_1.nspern[iinow - 1]; +#line 14389 "" + for (iis = 1; iis <= i__2; ++iis) { #line 14390 "" - } + ++iiv; -/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */ +/* May not really need to re-enter clefs, but it's easier to program since */ +/* clef names are not saved but are needed in newvoice to set ncmidcc. */ -/* if (islast) then */ -/* if (ninow .lt. 10) then */ -/* write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */ -/* else */ -/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */ -/* end if */ -/* end if */ -#line 14401 "" - if (all_1.nv == 1 && nvold > 1) { -#line 14402 "" - if (comlast_1.islast) { -#line 14402 "" - s_wsfe(&io___825); +#line 14395 "" + getchar_(lineq, &all_1.iccount, comclefq_1.clefq + + (iiv - 1), (ftnlen)128, (ftnlen)1); +#line 14396 "" + newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), & + c_true, (ftnlen)1); +#line 14397 "" + if (comnvi_1.nspern[iinow - 1] == 1) { +#line 14398 "" + i__4 = numclef_(comclefq_1.clefq + (iiv - 1), + (ftnlen)1) + 48; +#line 14398 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 14398 "" + s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1); +#line 14399 "" + lclf = 1; +#line 14400 "" + } else if (iis == 1) { /* Writing concatenation */ +#line 14401 "" + i__5[0] = 1, a__2[0] = "{"; +#line 14401 "" + i__4 = numclef_(comclefq_1.clefq + (iiv - 1), + (ftnlen)1) + 48; +#line 14401 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 14401 "" + i__5[1] = 1, a__2[1] = ch__1; +#line 14401 "" + s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); #line 14402 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14402 "" - i__5[1] = 11, a__2[1] = "nostartrule"; -#line 14402 "" - s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); -#line 14402 "" - do_fio(&c__1, ch__2, (ftnlen)12); -#line 14402 "" - e_wsfe(); -#line 14402 "" - } + lclf = 2; #line 14403 "" - } else if (all_1.nv > 1 && nvold == 1) { -#line 14404 "" - if (comlast_1.islast) { -#line 14404 "" - s_wsfe(&io___826); + } else if (iis < comnvi_1.nspern[iinow - 1]) { /* Writing concatenation */ #line 14404 "" - i__5[0] = 1, a__2[0] = all_1.sq; + i__5[0] = lclf, a__2[0] = hdlndq; #line 14404 "" - i__5[1] = 9, a__2[1] = "startrule"; + i__4 = numclef_(comclefq_1.clefq + (iiv - 1), + (ftnlen)1) + 48; #line 14404 "" - s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); + chax_(ch__1, (ftnlen)1, &i__4); #line 14404 "" - do_fio(&c__1, ch__3, (ftnlen)10); + i__5[1] = 1, a__2[1] = ch__1; #line 14404 "" - e_wsfe(); -#line 14404 "" - } + s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); #line 14405 "" - } + ++lclf; #line 14406 "" - iiv = 0; + } else { +/* Writing concatenation */ +#line 14407 "" + i__6[0] = lclf, a__3[0] = hdlndq; +#line 14407 "" + i__4 = numclef_(comclefq_1.clefq + (iiv - 1), + (ftnlen)1) + 48; +#line 14407 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 14407 "" + i__6[1] = 1, a__3[1] = ch__1; #line 14407 "" - i__1 = comnotes_1.ninow; + i__6[2] = 1, a__3[2] = "}"; #line 14407 "" - for (iinow = 1; iinow <= i__1; ++iinow) { -#line 14408 "" - i__2 = comnvi_1.nspern[iinow - 1]; -#line 14408 "" - for (iis = 1; iis <= i__2; ++iis) { + s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); #line 14409 "" - ++iiv; + lclf += 2; +#line 14410 "" + } +#line 14411 "" +/* L61: */ +#line 14411 "" + } -/* May not really need to re-enter clefs, but it's easier to program since */ -/* clef names are not saved but are needed in newvoice to set ncmidcc. */ +/* setstaffs & setclef go by instrument, not voice */ -#line 14414 "" - getchar_(lineq, &all_1.iccount, comclefq_1.clefq + ( - iiv - 1), (ftnlen)128, (ftnlen)1); #line 14415 "" - newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true, - (ftnlen)1); + if (comlast_1.islast) { #line 14416 "" - if (comnvi_1.nspern[iinow - 1] == 1) { + if (iinow < 10) { +#line 14417 "" + s_wsfe(&io___828); +/* Writing concatenation */ +#line 14417 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14417 "" + i__3[1] = 9, a__1[1] = "setstaffs"; #line 14417 "" - i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( - ftnlen)1) + 48; + i__2 = iinow + 48; +#line 14417 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 14417 "" + i__3[2] = 1, a__1[2] = ch__1; +#line 14417 "" + i__4 = comnvi_1.nspern[iinow - 1] + 48; +#line 14417 "" + chax_(ch__5, (ftnlen)1, &i__4); #line 14417 "" - chax_(ch__1, (ftnlen)1, &i__4); + i__3[3] = 1, a__1[3] = ch__5; #line 14417 "" - s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1); -#line 14418 "" - lclf = 1; + i__3[4] = 1, a__1[4] = "%"; +#line 14417 "" + s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13); +#line 14417 "" + do_fio(&c__1, ch__4, (ftnlen)13); +#line 14417 "" + e_wsfe(); +#line 14419 "" + s_wsfe(&io___829); +/* Writing concatenation */ #line 14419 "" - } else if (iis == 1) { -/* Writing concatenation */ -#line 14420 "" - i__5[0] = 1, a__2[0] = "{"; -#line 14420 "" - i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( - ftnlen)1) + 48; -#line 14420 "" - chax_(ch__1, (ftnlen)1, &i__4); -#line 14420 "" - i__5[1] = 1, a__2[1] = ch__1; -#line 14420 "" - s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14419 "" + i__3[1] = 7, a__1[1] = "setclef"; +#line 14419 "" + i__2 = iinow + 48; +#line 14419 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 14419 "" + i__3[2] = 1, a__1[2] = ch__1; +#line 14419 "" + i__3[3] = lclf, a__1[3] = hdlndq; +#line 14419 "" + i__3[4] = 1, a__1[4] = "%"; +#line 14419 "" + s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69); +#line 14419 "" + do_fio(&c__1, ch__6, lclf + 10); +#line 14419 "" + e_wsfe(); #line 14421 "" - lclf = 2; + if (comfig_1.fullsize[comnvi_1.iiorig[iinow - + 1] - 1] > .9f) { #line 14422 "" - } else if (iis < comnvi_1.nspern[iinow - 1]) { -/* Writing concatenation */ -#line 14423 "" - i__5[0] = lclf, a__2[0] = hdlndq; -#line 14423 "" - i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( - ftnlen)1) + 48; -#line 14423 "" - chax_(ch__1, (ftnlen)1, &i__4); -#line 14423 "" - i__5[1] = 1, a__2[1] = ch__1; -#line 14423 "" - s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); -#line 14424 "" - ++lclf; -#line 14425 "" - } else { + s_wsfe(&io___830); /* Writing concatenation */ -#line 14426 "" - i__6[0] = lclf, a__3[0] = hdlndq; -#line 14426 "" - i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( - ftnlen)1) + 48; -#line 14426 "" - chax_(ch__1, (ftnlen)1, &i__4); -#line 14426 "" - i__6[1] = 1, a__3[1] = ch__1; -#line 14426 "" - i__6[2] = 1, a__3[2] = "}"; -#line 14426 "" - s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); -#line 14428 "" - lclf += 2; -#line 14429 "" - } -#line 14430 "" -/* L61: */ -#line 14430 "" - } +#line 14422 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14422 "" + i__3[1] = 7, a__1[1] = "setsize"; +#line 14422 "" + i__2 = iinow + 48; +#line 14422 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 14422 "" + i__3[2] = 1, a__1[2] = ch__1; +#line 14422 "" + i__3[3] = 1, a__1[3] = all_1.sq; +#line 14422 "" + i__3[4] = 12, a__1[4] = "normalvalue%"; +#line 14422 "" + s_cat(ch__7, a__1, i__3, &c__5, (ftnlen) + 22); +#line 14422 "" + do_fio(&c__1, ch__7, (ftnlen)22); +#line 14422 "" + e_wsfe(); -/* setstaffs & setclef go by instrument, not voice */ +/* 140526 Account for staff size specs when noinst changes. May be confusion */ +/* here if more than one staff per instrument */ +#line 14428 "" + } else if (comfig_1.fullsize[comnvi_1.iiorig[ + iinow - 1] - 1] > .7f) { +#line 14429 "" + s_wsfe(&io___831); +/* Writing concatenation */ +#line 14429 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14429 "" + i__3[1] = 7, a__1[1] = "setsize"; +#line 14429 "" + i__2 = iinow + 48; +#line 14429 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 14429 "" + i__3[2] = 1, a__1[2] = ch__1; +#line 14429 "" + i__3[3] = 1, a__1[3] = all_1.sq; +#line 14429 "" + i__3[4] = 11, a__1[4] = "smallvalue%"; +#line 14429 "" + s_cat(ch__8, a__1, i__3, &c__5, (ftnlen) + 21); +#line 14429 "" + do_fio(&c__1, ch__8, (ftnlen)21); +#line 14429 "" + e_wsfe(); +#line 14431 "" + } else { +#line 14432 "" + s_wsfe(&io___832); +/* Writing concatenation */ +#line 14432 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 14432 "" + i__3[1] = 7, a__1[1] = "setsize"; +#line 14432 "" + i__2 = iinow + 48; +#line 14432 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 14432 "" + i__3[2] = 1, a__1[2] = ch__1; +#line 14432 "" + i__3[3] = 1, a__1[3] = all_1.sq; +#line 14432 "" + i__3[4] = 10, a__1[4] = "tinyvalue%"; +#line 14432 "" + s_cat(ch__9, a__1, i__3, &c__5, (ftnlen) + 20); +#line 14432 "" + do_fio(&c__1, ch__9, (ftnlen)20); +#line 14432 "" + e_wsfe(); #line 14434 "" - if (comlast_1.islast) { + } #line 14435 "" - if (iinow < 10) { + } else { #line 14436 "" - s_wsfe(&io___829); + s_wsfe(&io___833); /* Writing concatenation */ #line 14436 "" - i__3[0] = 1, a__1[0] = all_1.sq; + i__5[0] = 1, a__2[0] = all_1.sq; #line 14436 "" - i__3[1] = 9, a__1[1] = "setstaffs"; + i__5[1] = 10, a__2[1] = "setstaffs{"; #line 14436 "" - i__2 = iinow + 48; + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); #line 14436 "" - chax_(ch__1, (ftnlen)1, &i__2); + do_fio(&c__1, ch__10, (ftnlen)11); #line 14436 "" - i__3[2] = 1, a__1[2] = ch__1; + do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 14436 "" + i__6[0] = 1, a__3[0] = "}"; #line 14436 "" - i__4 = comnvi_1.nspern[iinow - 1] + 48; + i__2 = comnvi_1.nspern[iinow - 1] + 48; #line 14436 "" - chax_(ch__5, (ftnlen)1, &i__4); + chax_(ch__1, (ftnlen)1, &i__2); #line 14436 "" - i__3[3] = 1, a__1[3] = ch__5; + i__6[1] = 1, a__3[1] = ch__1; #line 14436 "" - i__3[4] = 1, a__1[4] = "%"; + i__6[2] = 1, a__3[2] = "%"; #line 14436 "" - s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13); + s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3); #line 14436 "" - do_fio(&c__1, ch__4, (ftnlen)13); + do_fio(&c__1, ch__11, (ftnlen)3); #line 14436 "" - e_wsfe(); + e_wsfe(); #line 14438 "" - s_wsfe(&io___830); + s_wsfe(&io___834); /* Writing concatenation */ #line 14438 "" - i__3[0] = 1, a__1[0] = all_1.sq; + i__5[0] = 1, a__2[0] = all_1.sq; #line 14438 "" - i__3[1] = 7, a__1[1] = "setclef"; + i__5[1] = 8, a__2[1] = "setclef{"; #line 14438 "" - i__2 = iinow + 48; + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); #line 14438 "" - chax_(ch__1, (ftnlen)1, &i__2); + do_fio(&c__1, ch__12, (ftnlen)9); #line 14438 "" - i__3[2] = 1, a__1[2] = ch__1; + do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ #line 14438 "" - i__3[3] = lclf, a__1[3] = hdlndq; + i__6[0] = 1, a__3[0] = "}"; #line 14438 "" - i__3[4] = 1, a__1[4] = "%"; + i__6[1] = lclf, a__3[1] = hdlndq; #line 14438 "" - s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69); + i__6[2] = 1, a__3[2] = "%"; #line 14438 "" - do_fio(&c__1, ch__6, lclf + 10); + s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61); #line 14438 "" - e_wsfe(); + do_fio(&c__1, ch__13, lclf + 2); +#line 14438 "" + e_wsfe(); #line 14440 "" - if (comfig_1.fullsize[comnvi_1.iiorig[iinow - 1] - - 1] > .9f) { -#line 14441 "" - s_wsfe(&io___831); -/* Writing concatenation */ -#line 14441 "" - i__3[0] = 1, a__1[0] = all_1.sq; -#line 14441 "" - i__3[1] = 7, a__1[1] = "setsize"; -#line 14441 "" - i__2 = iinow + 48; -#line 14441 "" - chax_(ch__1, (ftnlen)1, &i__2); -#line 14441 "" - i__3[2] = 1, a__1[2] = ch__1; -#line 14441 "" - i__3[3] = 1, a__1[3] = all_1.sq; -#line 14441 "" - i__3[4] = 12, a__1[4] = "normalvalue%"; -#line 14441 "" - s_cat(ch__7, a__1, i__3, &c__5, (ftnlen)22); -#line 14441 "" - do_fio(&c__1, ch__7, (ftnlen)22); + } #line 14441 "" - e_wsfe(); + } +#line 14442 "" +/* L60: */ +#line 14442 "" + } -/* 140526 Account for staff size specs when noinst changes. May be confusion */ -/* here if more than one staff per instrument */ +/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */ +#line 14446 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14447 "" - } else if (comfig_1.fullsize[comnvi_1.iiorig[ - iinow - 1] - 1] > .7f) { -#line 14448 "" - s_wsfe(&io___832); -/* Writing concatenation */ -#line 14448 "" - i__3[0] = 1, a__1[0] = all_1.sq; -#line 14448 "" - i__3[1] = 7, a__1[1] = "setsize"; -#line 14448 "" - i__2 = iinow + 48; -#line 14448 "" - chax_(ch__1, (ftnlen)1, &i__2); -#line 14448 "" - i__3[2] = 1, a__1[2] = ch__1; -#line 14448 "" - i__3[3] = 1, a__1[3] = all_1.sq; -#line 14448 "" - i__3[4] = 11, a__1[4] = "smallvalue%"; -#line 14448 "" - s_cat(ch__8, a__1, i__3, &c__5, (ftnlen)21); -#line 14448 "" - do_fio(&c__1, ch__8, (ftnlen)21); + goto L31; #line 14448 "" - e_wsfe(); + } else if (*(unsigned char *)durq == 'S') { +#line 14449 "" + goto L48; #line 14450 "" - } else { -#line 14451 "" - s_wsfe(&io___833); -/* Writing concatenation */ -#line 14451 "" - i__3[0] = 1, a__1[0] = all_1.sq; -#line 14451 "" - i__3[1] = 7, a__1[1] = "setsize"; -#line 14451 "" - i__2 = iinow + 48; -#line 14451 "" - chax_(ch__1, (ftnlen)1, &i__2); -#line 14451 "" - i__3[2] = 1, a__1[2] = ch__1; -#line 14451 "" - i__3[3] = 1, a__1[3] = all_1.sq; -#line 14451 "" - i__3[4] = 10, a__1[4] = "tinyvalue%"; -#line 14451 "" - s_cat(ch__9, a__1, i__3, &c__5, (ftnlen)20); -#line 14451 "" - do_fio(&c__1, ch__9, (ftnlen)20); -#line 14451 "" - e_wsfe(); -#line 14453 "" - } + } + +/* Write instrument names */ + #line 14454 "" - } else { + if (! comnvi_1.rename) { #line 14455 "" - s_wsfe(&io___834); -/* Writing concatenation */ + i__1 = comnotes_1.ninow; #line 14455 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14455 "" - i__5[1] = 10, a__2[1] = "setstaffs{"; -#line 14455 "" - s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); -#line 14455 "" - do_fio(&c__1, ch__10, (ftnlen)11); -#line 14455 "" - do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( - integer)); -/* Writing concatenation */ -#line 14455 "" - i__6[0] = 1, a__3[0] = "}"; -#line 14455 "" - i__2 = comnvi_1.nspern[iinow - 1] + 48; -#line 14455 "" - chax_(ch__1, (ftnlen)1, &i__2); -#line 14455 "" - i__6[1] = 1, a__3[1] = ch__1; -#line 14455 "" - i__6[2] = 1, a__3[2] = "%"; -#line 14455 "" - s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3); -#line 14455 "" - do_fio(&c__1, ch__11, (ftnlen)3); -#line 14455 "" - e_wsfe(); -#line 14457 "" - s_wsfe(&io___835); -/* Writing concatenation */ -#line 14457 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14457 "" - i__5[1] = 8, a__2[1] = "setclef{"; -#line 14457 "" - s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); -#line 14457 "" - do_fio(&c__1, ch__12, (ftnlen)9); -#line 14457 "" - do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( - integer)); -/* Writing concatenation */ -#line 14457 "" - i__6[0] = 1, a__3[0] = "}"; -#line 14457 "" - i__6[1] = lclf, a__3[1] = hdlndq; -#line 14457 "" - i__6[2] = 1, a__3[2] = "%"; -#line 14457 "" - s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61); -#line 14457 "" - do_fio(&c__1, ch__13, lclf + 2); + for (iinst = 1; iinst <= i__1; ++iinst) { +#line 14456 "" + if (comlast_1.islast) { #line 14457 "" - e_wsfe(); + if (iinst < 10) { +#line 14458 "" + s_wsfe(&io___836); +/* Writing concatenation */ +#line 14458 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14458 "" + i__5[1] = 7, a__2[1] = "setname"; +#line 14458 "" + s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 14458 "" + do_fio(&c__1, ch__14, (ftnlen)8); +#line 14458 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +#line 14458 "" + do_fio(&c__1, "{}%", (ftnlen)3); +#line 14458 "" + e_wsfe(); #line 14459 "" - } + } else { #line 14460 "" - } -#line 14461 "" -/* L60: */ + s_wsfe(&io___837); +/* Writing concatenation */ +#line 14460 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14460 "" + i__5[1] = 8, a__2[1] = "setname{"; +#line 14460 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14460 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 14460 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +#line 14460 "" + do_fio(&c__1, "}{}%", (ftnlen)4); +#line 14460 "" + e_wsfe(); #line 14461 "" - } - -/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */ - + } +#line 14462 "" + } +#line 14463 "" +/* L62: */ +#line 14463 "" + } +#line 14464 "" + } else { #line 14465 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + i__1 = comnotes_1.ninow; +#line 14465 "" + for (iinst = 1; iinst <= i__1; ++iinst) { #line 14466 "" - goto L31; + if (comlast_1.islast) { #line 14467 "" - } else if (*(unsigned char *)durq == 'S') { + if (iinst < 10) { #line 14468 "" - goto L48; -#line 14469 "" - } - -/* Write instrument names */ - -#line 14473 "" - if (! comnvi_1.rename) { -#line 14474 "" - i__1 = comnotes_1.ninow; -#line 14474 "" - for (iinst = 1; iinst <= i__1; ++iinst) { -#line 14475 "" - if (comlast_1.islast) { -#line 14476 "" - if (iinst < 10) { -#line 14477 "" - s_wsfe(&io___837); + s_wsfe(&io___838); /* Writing concatenation */ -#line 14477 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14477 "" - i__5[1] = 7, a__2[1] = "setname"; -#line 14477 "" - s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); -#line 14477 "" - do_fio(&c__1, ch__14, (ftnlen)8); -#line 14477 "" - do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( - integer)); -#line 14477 "" - do_fio(&c__1, "{}%", (ftnlen)3); -#line 14477 "" - e_wsfe(); -#line 14478 "" - } else { -#line 14479 "" - s_wsfe(&io___838); -/* Writing concatenation */ -#line 14479 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14479 "" - i__5[1] = 8, a__2[1] = "setname{"; -#line 14479 "" - s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); -#line 14479 "" - do_fio(&c__1, ch__12, (ftnlen)9); -#line 14479 "" - do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( - integer)); -#line 14479 "" - do_fio(&c__1, "}{}%", (ftnlen)4); -#line 14479 "" - e_wsfe(); -#line 14480 "" - } -#line 14481 "" - } -#line 14482 "" -/* L62: */ -#line 14482 "" - } -#line 14483 "" - } else { -#line 14484 "" - i__1 = comnotes_1.ninow; -#line 14484 "" - for (iinst = 1; iinst <= i__1; ++iinst) { -#line 14485 "" - if (comlast_1.islast) { -#line 14486 "" - if (iinst < 10) { -#line 14487 "" - s_wsfe(&io___839); -/* Writing concatenation */ -#line 14487 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14487 "" - i__5[1] = 7, a__2[1] = "setname"; -#line 14487 "" - s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); -#line 14487 "" - do_fio(&c__1, ch__14, (ftnlen)8); -#line 14487 "" - do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( - integer)); -/* Writing concatenation */ -#line 14487 "" - i__6[0] = 1, a__3[0] = "{"; -#line 14487 "" - i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - - 1], a__3[1] = comtop_1.inameq + ( - comnvi_1.iiorig[iinst - 1] - 1) * 79; -#line 14487 "" - i__6[2] = 2, a__3[2] = "}%"; -#line 14487 "" - s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82); -#line 14487 "" - do_fio(&c__1, ch__15, comtop_1.lnam[ - comnvi_1.iiorig[iinst - 1] - 1] + 3); -#line 14487 "" - e_wsfe(); -#line 14489 "" - } else { -#line 14490 "" - s_wsfe(&io___840); +#line 14468 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14468 "" + i__5[1] = 7, a__2[1] = "setname"; +#line 14468 "" + s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 14468 "" + do_fio(&c__1, ch__14, (ftnlen)8); +#line 14468 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); /* Writing concatenation */ -#line 14490 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14490 "" - i__5[1] = 8, a__2[1] = "setname{"; -#line 14490 "" - s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); -#line 14490 "" - do_fio(&c__1, ch__12, (ftnlen)9); -#line 14490 "" - do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( - integer)); +#line 14468 "" + i__6[0] = 1, a__3[0] = "{"; +#line 14468 "" + i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst + - 1] - 1], a__3[1] = comtop_1.inameq + + (comnvi_1.iiorig[iinst - 1] - 1) * + 79; +#line 14468 "" + i__6[2] = 2, a__3[2] = "}%"; +#line 14468 "" + s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82); +#line 14468 "" + do_fio(&c__1, ch__15, comtop_1.lnam[ + comnvi_1.iiorig[iinst - 1] - 1] + 3); +#line 14468 "" + e_wsfe(); +#line 14470 "" + } else { +#line 14471 "" + s_wsfe(&io___839); +/* Writing concatenation */ +#line 14471 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14471 "" + i__5[1] = 8, a__2[1] = "setname{"; +#line 14471 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14471 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 14471 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); /* Writing concatenation */ -#line 14490 "" - i__6[0] = 2, a__3[0] = "}{"; -#line 14490 "" - i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - - 1], a__3[1] = comtop_1.inameq + ( - comnvi_1.iiorig[iinst - 1] - 1) * 79; -#line 14490 "" - i__6[2] = 2, a__3[2] = "}%"; -#line 14490 "" - s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83); -#line 14490 "" - do_fio(&c__1, ch__16, comtop_1.lnam[ - comnvi_1.iiorig[iinst - 1] - 1] + 4); -#line 14490 "" - e_wsfe(); -#line 14492 "" +#line 14471 "" + i__6[0] = 2, a__3[0] = "}{"; +#line 14471 "" + i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst + - 1] - 1], a__3[1] = comtop_1.inameq + + (comnvi_1.iiorig[iinst - 1] - 1) * + 79; +#line 14471 "" + i__6[2] = 2, a__3[2] = "}%"; +#line 14471 "" + s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83); +#line 14471 "" + do_fio(&c__1, ch__16, comtop_1.lnam[ + comnvi_1.iiorig[iinst - 1] - 1] + 4); +#line 14471 "" + e_wsfe(); +#line 14473 "" + } +#line 14474 "" } -#line 14493 "" - } -#line 14494 "" +#line 14475 "" /* L65: */ -#line 14494 "" - } -#line 14495 "" - if (comshort_1.ishort != 4 && comshort_1.ishort != 2) { -#line 14495 "" - comnvi_1.rename = FALSE_; -#line 14495 "" - } +#line 14475 "" + } +#line 14476 "" + if (comshort_1.ishort != 4 && comshort_1.ishort != 2) { +#line 14476 "" + comnvi_1.rename = FALSE_; +#line 14476 "" + } /* Reset later and rewrite setname{} in shortening case mcm, since if */ /* written here it will be inside {{...}} and will be ignored */ -#line 14500 "" +#line 14481 "" + } +#line 14482 "" } -#line 14501 "" - } -#line 14502 "" - } else if (*(unsigned char *)charq == '|') { +#line 14483 "" + } else if (*(unsigned char *)charq == '|') { /* End of bar symbol. Check about end of bar hardspace. */ -#line 14506 "" - if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 1],26)) { +#line 14487 "" + if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - + 1] + 1) * 24 - 1],26)) { /* There was a hardspace followed by a bar line. Remove it from the hardspace */ /* list, store with shifts instead, set special bit. Need to repeat this code */ /* at '/'. */ -#line 14512 "" - all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] - = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 25],18); -#line 14513 "" - ++comudsp_1.nudoff[commvl_1.ivx - 1]; -#line 14514 "" - comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] - * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; -#line 14515 "" - --comudsp_1.nudsp; -#line 14516 "" - all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 1],26); -#line 14517 "" - } -#line 14518 "" - } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) { +#line 14493 "" + all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],18); +#line 14494 "" + ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 14495 "" + comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx + - 1] * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; +#line 14496 "" + --comudsp_1.nudsp; +#line 14497 "" + all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26); +#line 14498 "" + } +#line 14499 "" + } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Width symbol or new nsyst. Read past (until blank) */ -#line 14522 "" +#line 14503 "" L4: -#line 14522 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14523 "" - if (*(unsigned char *)durq != ' ') { -#line 14523 "" - goto L4; -#line 14523 "" - } -#line 14524 "" - } else if (*(unsigned char *)charq == 'l') { +#line 14503 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14504 "" + if (*(unsigned char *)durq != ' ') { +#line 14504 "" + goto L4; +#line 14504 "" + } +#line 14505 "" + } else if (*(unsigned char *)charq == 'l') { /* Lower string. Only OK if at start of block */ /* Check whether at beginning of a block */ -#line 14529 "" - if (all_1.iv != 1 || all_1.nnl[0] != 0) { -#line 14530 "" - s_wsle(&io___841); -#line 14530 "" - do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block" - , (ftnlen)41); -#line 14530 "" - e_wsle(); -#line 14531 "" - stop1_(); -#line 14532 "" - } +#line 14510 "" + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 14511 "" + s_wsle(&io___840); +#line 14511 "" + do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of "\ + "block", (ftnlen)41); +#line 14511 "" + e_wsle(); +#line 14512 "" + stop1_(); +#line 14513 "" + } /* Set flag for lower string & read it in */ -#line 14536 "" - comhead_1.lower = TRUE_; -#line 14537 "" - getbuf_(comhead_1.lowerq, (ftnlen)80); -#line 14538 "" - all_1.iccount = 128; -#line 14539 "" - } else if (*(unsigned char *)charq == 'm') { +#line 14517 "" + comhead_1.lower = TRUE_; +#line 14518 "" + getbuf_(comhead_1.lowerq, (ftnlen)80); +#line 14519 "" + all_1.iccount = 128; +#line 14520 "" + } else if (*(unsigned char *)charq == 'm') { /* Meter change. Only allow at beginning of block. */ /* mtrnuml, mtrdenl (logical) and p (printable) will be input. */ @@ -34419,602 +34621,610 @@ L4: /* Check whether at beginning of a block */ +#line 14528 "" + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 14529 "" + s_wsle(&io___841); +#line 14529 "" + do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of "\ + "block", (ftnlen)41); +#line 14529 "" + e_wsle(); +#line 14530 "" + stop1_(); +#line 14531 "" + } +#line 14532 "" + readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, + (ftnlen)128); +#line 14533 "" + readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, ( + ftnlen)128); +#line 14534 "" + lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); +#line 14535 "" + if (all_1.mtrdenl == 2) { +#line 14535 "" + lenbeat = 16; +#line 14535 "" + } +#line 14536 "" + all_1.lenbar = all_1.mtrnuml * lenbeat; +#line 14537 "" + if (all_1.mtrdenl == 2) { +#line 14537 "" + all_1.lenbar <<= 1; +#line 14537 "" + } +#line 14538 "" + all_1.lenb1 = all_1.lenbar; +#line 14539 "" + all_1.lenb0 = 0; +#line 14540 "" + if (commidi_1.ismidi) { +#line 14540 "" + midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); +#line 14540 "" + } +#line 14541 "" + } else if (*(unsigned char *)charq == 'C') { + +/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ + +#line 14545 "" + if (all_1.nnl[all_1.iv - 1] > 0) { +#line 14545 "" + ++comcc_1.ncc[all_1.iv - 1]; +#line 14545 "" + } +#line 14546 "" + comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = ( + real) all_1.itsofar[all_1.iv - 1]; #line 14547 "" - if (all_1.iv != 1 || all_1.nnl[0] != 0) { -#line 14548 "" - s_wsle(&io___842); -#line 14548 "" - do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block" - , (ftnlen)41); + isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) + * 24 - 25],11); #line 14548 "" - e_wsle(); -#line 14549 "" - stop1_(); -#line 14550 "" - } -#line 14551 "" - readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, ( - ftnlen)128); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Store clef number, or 7 if clef number = 9 (French violin clef) */ + +/* Computing MIN */ +#line 14552 "" + i__1 = numclef_(durq, (ftnlen)1); #line 14552 "" - readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, ( - ftnlen)128); + isl |= min(i__1,7) << 12; #line 14553 "" - lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); -#line 14554 "" - if (all_1.mtrdenl == 2) { + comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = + ncmidf_(durq, (ftnlen)1); #line 14554 "" - lenbeat = 16; -#line 14554 "" - } + if (*(unsigned char *)durq == '8') { #line 14555 "" - all_1.lenbar = all_1.mtrnuml * lenbeat; -#line 14556 "" - if (all_1.mtrdenl == 2) { + all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] + = bit_set(all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - + 1] + 1) * 24 - 25],2); #line 14556 "" - all_1.lenbar <<= 1; -#line 14556 "" - } + cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] + - 1] += 7; #line 14557 "" - all_1.lenb1 = all_1.lenbar; + comnotes_1.lastlev += 7; #line 14558 "" - all_1.lenb0 = 0; -#line 14559 "" - if (commidi_1.ismidi) { -#line 14559 "" - midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); + if (all_1.nnl[all_1.iv - 1] == 0) { #line 14559 "" - } + comnotes_1.ndlev[all_1.iv - 1] += 7; #line 14560 "" - } else if (*(unsigned char *)charq == 'C') { + comnotes_1.ndlev[all_1.iv + 23] += 7; +#line 14561 "" + } +#line 14562 "" + } else { -/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ +/* This won't work if you really had an octave transposition with some */ +/* other clef. Need a check on whether prior clef was an octave clef. */ -#line 14564 "" - if (all_1.nnl[all_1.iv - 1] > 0) { -#line 14564 "" - ++comcc_1.ncc[all_1.iv - 1]; -#line 14564 "" - } -#line 14565 "" - comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real) - all_1.itsofar[all_1.iv - 1]; -#line 14566 "" - isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * - 24 - 25],11); #line 14567 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); - -/* Store clef number, or 7 if clef number = 9 (French violin clef) */ - -/* Computing MIN */ -#line 14571 "" - i__1 = numclef_(durq, (ftnlen)1); + if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - + 1] - 1] == 7) { +#line 14568 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - + 1] - 1] += -7; +#line 14569 "" + comnotes_1.lastlev += -7; +#line 14570 "" + if (all_1.nnl[all_1.iv - 1] == 0) { #line 14571 "" - isl |= min(i__1,7) << 12; + comnotes_1.ndlev[all_1.iv - 1] += -7; #line 14572 "" - comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = - ncmidf_(durq, (ftnlen)1); + comnotes_1.ndlev[all_1.iv + 23] += -7; #line 14573 "" - if (*(unsigned char *)durq == '8') { + } #line 14574 "" - all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = - bit_set(all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) - * 24 - 25],2); + } #line 14575 "" - cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1] - += 7; -#line 14576 "" - comnotes_1.lastlev += 7; -#line 14577 "" - if (all_1.nnl[all_1.iv - 1] == 0) { -#line 14578 "" - comnotes_1.ndlev[all_1.iv - 1] += 7; + } + +/* Set marker on note with lowest voice # starting at same time. */ + #line 14579 "" - comnotes_1.ndlev[all_1.iv + 23] += 7; + if (all_1.iv == 1) { #line 14580 "" - } + isl = bit_set(isl,15); #line 14581 "" - } else { - -/* This won't work if you really had an octave transposition with some */ -/* other clef. Need a check on whether prior clef was an octave clef. */ - + } else { +#line 14582 "" + i__1 = all_1.iv; +#line 14582 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 14583 "" + nnliiv = all_1.nnl[iiv - 1]; +#line 14584 "" + if (iiv == all_1.iv) { +#line 14584 "" + ++nnliiv; +#line 14584 "" + } +#line 14585 "" + itother = 0; #line 14586 "" - if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - - 1] == 7) { + i__2 = nnliiv; +#line 14586 "" + for (iip = 1; iip <= i__2; ++iip) { #line 14587 "" - cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - - 1] += -7; + if (itother < all_1.itsofar[all_1.iv - 1]) { #line 14588 "" - comnotes_1.lastlev += -7; + itother += all_1.nodur[iiv + iip * 24 - 25]; #line 14589 "" - if (all_1.nnl[all_1.iv - 1] == 0) { + goto L14; #line 14590 "" - comnotes_1.ndlev[all_1.iv - 1] += -7; + } else if (itother == all_1.itsofar[all_1.iv - 1]) { #line 14591 "" - comnotes_1.ndlev[all_1.iv + 23] += -7; + all_1.islur[iiv + iip * 24 - 25] = bit_set( + all_1.islur[iiv + iip * 24 - 25],15); #line 14592 "" - } + goto L15; #line 14593 "" - } + } #line 14594 "" - } +L14: +#line 14594 "" + ; +#line 14594 "" + } +#line 14595 "" +/* L13: */ +#line 14595 "" + } +#line 14596 "" +L15: +#line 14597 "" + ; +#line 14597 "" + } -/* Set marker on note with lowest voice # starting at same time. */ +/* Need 'or' since may have set bit 15 in the above loop */ -#line 14598 "" - if (all_1.iv == 1) { -#line 14599 "" - isl = bit_set(isl,15); -#line 14600 "" - } else { #line 14601 "" - i__1 = all_1.iv; -#line 14601 "" - for (iiv = 1; iiv <= i__1; ++iiv) { + all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = + isl | all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) + * 24 - 25]; #line 14602 "" - nnliiv = all_1.nnl[iiv - 1]; -#line 14603 "" - if (iiv == all_1.iv) { -#line 14603 "" - ++nnliiv; -#line 14603 "" - } -#line 14604 "" - itother = 0; -#line 14605 "" - i__2 = nnliiv; -#line 14605 "" - for (iip = 1; iip <= i__2; ++iip) { + } else if (*(unsigned char *)charq == 'R') { + +/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */ + #line 14606 "" - if (itother < all_1.itsofar[all_1.iv - 1]) { -#line 14607 "" - itother += all_1.nodur[iiv + iip * 24 - 25]; -#line 14608 "" - goto L14; -#line 14609 "" - } else if (itother == all_1.itsofar[all_1.iv - 1]) { +L10: +#line 14606 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Save designator in case it's a terminal Rr or Rd */ + #line 14610 "" - all_1.islur[iiv + iip * 24 - 25] = bit_set( - all_1.islur[iiv + iip * 24 - 25],15); + if (*(unsigned char *)durq == 'l') { #line 14611 "" - goto L15; + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],5); #line 14612 "" - } -#line 14613 "" -L14: -#line 14613 "" - ; + goto L10; #line 14613 "" - } + } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) { #line 14614 "" -/* L13: */ -#line 14614 "" - } + if (*(unsigned char *)durq == 'r') { #line 14615 "" -L15: + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6); #line 14616 "" - ; -#line 14616 "" - } - -/* Need 'or' since may have set bit 15 in the above loop */ - + } else if (*(unsigned char *)durq == 'd') { +#line 14617 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8); +#line 14618 "" + } else if (*(unsigned char *)durq == 'D') { +#line 14619 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26); #line 14620 "" - all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = isl - | all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - - 25]; + } else if (*(unsigned char *)durq == 'b') { #line 14621 "" - } else if (*(unsigned char *)charq == 'R') { - -/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */ - -#line 14625 "" -L10: + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25); +#line 14622 "" + } else if (*(unsigned char *)durq == 'z') { +/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */ +#line 14624 "" + all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24],0); #line 14625 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); - -/* Save designator in case it's a terminal Rr or Rd */ - + } +#line 14626 "" + comget_1.rptprev = TRUE_; +#line 14627 "" + *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq; +#line 14628 "" + goto L10; #line 14629 "" - if (*(unsigned char *)durq == 'l') { + } #line 14630 "" - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[( - all_1.nnl[0] + 1) * 24 - 24],5); -#line 14631 "" - goto L10; -#line 14632 "" - } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) { -#line 14633 "" - if (*(unsigned char *)durq == 'r') { + } else if (*(unsigned char *)charq == 'V') { + +/* Ending */ + #line 14634 "" - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6); + nnnl = all_1.nnl[0] + 1; #line 14635 "" - } else if (*(unsigned char *)durq == 'd') { + lvoltxt = 0; #line 14636 "" - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8); +L11: +#line 14636 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14637 "" - } else if (*(unsigned char *)durq == 'D') { -#line 14638 "" - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26); -#line 14639 "" - } else if (*(unsigned char *)durq == 'b') { -#line 14640 "" - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( - all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25); + if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == + 'x') { + +/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */ + #line 14641 "" - } else if (*(unsigned char *)durq == 'z') { -/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */ + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - + 24],9); +#line 14642 "" + if (*(unsigned char *)durq == 'b') { +#line 14642 "" + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * + 24 - 24],10); +#line 14642 "" + } #line 14643 "" - all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.ipl[( - all_1.nnl[0] + 1) * 24 - 24],0); + goto L11; #line 14644 "" - } -#line 14645 "" - comget_1.rptprev = TRUE_; -#line 14646 "" - *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq; -#line 14647 "" - goto L10; + } else if (*(unsigned char *)durq != ' ') { + +/* Start volta; Get text */ + #line 14648 "" - } -#line 14649 "" - } else if (*(unsigned char *)charq == 'V') { + if (lvoltxt == 0) { -/* Ending */ +/* First character for text */ +#line 14652 "" + lvoltxt = 1; #line 14653 "" - nnnl = all_1.nnl[0] + 1; + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * + 24 - 24],7); #line 14654 "" - lvoltxt = 0; + ++comgrace_1.nvolt; #line 14655 "" -L11: -#line 14655 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, + durq, (ftnlen)20, (ftnlen)1); #line 14656 "" - if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') { - -/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */ - + } else { +/* Writing concatenation */ +#line 14657 "" + i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + ( + comgrace_1.nvolt - 1) * 20; +#line 14657 "" + i__5[1] = 1, a__2[1] = durq; +#line 14657 "" + s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, + a__2, i__5, &c__2, (ftnlen)20); +#line 14658 "" + ++lvoltxt; +#line 14659 "" + } #line 14660 "" - all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24], - 9); -#line 14661 "" - if (*(unsigned char *)durq == 'b') { -#line 14661 "" - all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - - 24],10); + goto L11; #line 14661 "" } #line 14662 "" - goto L11; + } else if (*(unsigned char *)charq == 'B') { #line 14663 "" - } else if (*(unsigned char *)durq != ' ') { + combc_1.bcspec = ! combc_1.bcspec; +#line 14664 "" + } else if (*(unsigned char *)charq == 'P') { -/* Start volta; Get text */ +/* Page numbers. Print stuff right now. */ -#line 14667 "" - if (lvoltxt == 0) { +#line 14668 "" + npg1 = 0; -/* First character for text */ +/* Will use ltopnam to signal whether there's a centered heading */ -#line 14671 "" - lvoltxt = 1; #line 14672 "" - all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - - 24],7); + ltopnam = 0; #line 14673 "" - ++comgrace_1.nvolt; + ipg1r = 0; +#line 14674 "" +L16: #line 14674 "" - s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq, - (ftnlen)20, (ftnlen)1); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14675 "" - } else { -/* Writing concatenation */ -#line 14676 "" - i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + ( - comgrace_1.nvolt - 1) * 20; -#line 14676 "" - i__5[1] = 1, a__2[1] = durq; + if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) + { #line 14676 "" - s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__2, - i__5, &c__2, (ftnlen)20); + npg1 = npg1 * 10 + *(unsigned char *)durq - 48; #line 14677 "" - ++lvoltxt; + goto L16; #line 14678 "" - } + } else if (*(unsigned char *)durq == 'l') { +#line 14679 "" + if (npg1 == 0 || npg1 % 2 == 1) { +#line 14679 "" + ipg1r = 1; #line 14679 "" - goto L11; + } #line 14680 "" - } + goto L16; #line 14681 "" - } else if (*(unsigned char *)charq == 'B') { + } else if (*(unsigned char *)durq == 'r') { #line 14682 "" - combc_1.bcspec = ! combc_1.bcspec; + if (npg1 > 0 && npg1 % 2 == 0) { +#line 14682 "" + ipg1r = 1; +#line 14682 "" + } #line 14683 "" - } else if (*(unsigned char *)charq == 'P') { - -/* Page numbers. Print stuff right now. */ - -#line 14687 "" - npg1 = 0; + goto L16; +#line 14684 "" + } else if (*(unsigned char *)durq == 'c') { -/* Will use ltopnam to signal whether there's a centered heading */ +/* Top-centered name. Assume this is last option. Read the name. */ +/* May surround name in double quotes (to allow blanks). */ +#line 14689 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14690 "" + if (*(unsigned char *)durq == ' ') { #line 14691 "" - ltopnam = 0; + ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60); #line 14692 "" - ipg1r = 0; -#line 14693 "" -L16: + } else { #line 14693 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + namstrt = all_1.iccount; #line 14694 "" - if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) { -#line 14695 "" - npg1 = npg1 * 10 + *(unsigned char *)durq - 48; -#line 14696 "" - goto L16; -#line 14697 "" - } else if (*(unsigned char *)durq == 'l') { -#line 14698 "" - if (npg1 == 0 || npg1 % 2 == 1) { -#line 14698 "" - ipg1r = 1; + chax_(ch__1, (ftnlen)1, &c__34); +#line 14694 "" + if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) + { + +/* Using quote delimiters. */ + #line 14698 "" - } + quoted = TRUE_; #line 14699 "" - goto L16; + ++namstrt; #line 14700 "" - } else if (*(unsigned char *)durq == 'r') { -#line 14701 "" - if (npg1 > 0 && npg1 % 2 == 0) { -#line 14701 "" - ipg1r = 1; + } else { #line 14701 "" - } + quoted = FALSE_; #line 14702 "" - goto L16; + } #line 14703 "" - } else if (*(unsigned char *)durq == 'c') { + for (all_1.iccount = namstrt + 1; all_1.iccount <= 128; + ++all_1.iccount) { +#line 14704 "" + i__1 = all_1.iccount - 2; +#line 14704 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 14704 "" + chax_(ch__5, (ftnlen)1, &c__92); +#line 14704 "" + if (quoted && *(unsigned char *)&lineq[all_1.iccount + - 1] == *(unsigned char *)&ch__1[0] && s_cmp( + lineq + i__1, ch__5, all_1.iccount - 1 - i__1, + (ftnlen)1) != 0 || ! quoted && *(unsigned + char *)&lineq[all_1.iccount - 1] == ' ') { +#line 14704 "" + goto L36; +#line 14704 "" + } -/* Top-centered name. Assume this is last option. Read the name. */ -/* May surround name in double quotes (to allow blanks). */ +/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */ -#line 14708 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14709 "" - if (*(unsigned char *)durq == ' ') { -#line 14710 "" - ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60); #line 14711 "" - } else { +/* L35: */ +#line 14711 "" + } +#line 14712 "" + s_wsle(&io___850); #line 14712 "" - namstrt = all_1.iccount; + do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", ( + ftnlen)31); +#line 14712 "" + e_wsle(); #line 14713 "" - if (*(unsigned char *)durq == '"') { - -/* Using quote delimiters. */ - + stop1_(); +#line 14714 "" +L36: +#line 14715 "" + ltopnam = all_1.iccount - namstrt; +#line 14716 "" + s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen) + 60, all_1.iccount - 1 - (namstrt - 1)); #line 14717 "" - quoted = TRUE_; -#line 14718 "" - ++namstrt; -#line 14719 "" - } else { -#line 14720 "" - quoted = FALSE_; -#line 14721 "" - } -#line 14722 "" - for (all_1.iccount = namstrt + 1; all_1.iccount <= 128; - ++all_1.iccount) { -/* if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or. */ -#line 14724 "" - i__1 = all_1.iccount - 2; -#line 14724 "" - if (quoted && *(unsigned char *)&lineq[all_1.iccount - 1] - == '"' && s_cmp(lineq + i__1, "\\", all_1.iccount - - 1 - i__1, (ftnlen)1) != 0 || ! quoted && *( - unsigned char *)&lineq[all_1.iccount - 1] == ' ') - { -#line 14724 "" - goto L36; -#line 14724 "" - } - -/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */ - -#line 14731 "" -/* L35: */ -#line 14731 "" } -#line 14732 "" - s_wsle(&io___851); -#line 14732 "" - do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", ( - ftnlen)31); -#line 14732 "" - e_wsle(); -#line 14733 "" - stop1_(); -#line 14734 "" -L36: -#line 14735 "" - ltopnam = all_1.iccount - namstrt; -#line 14736 "" - s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60, - all_1.iccount - 1 - (namstrt - 1)); -#line 14737 "" +#line 14718 "" } -#line 14738 "" - } /* Done getting data, now assemble the command */ -#line 14742 "" - if (npg1 == 0) { -#line 14742 "" - npg1 = 1; -#line 14742 "" - } +#line 14722 "" + if (npg1 == 0) { +#line 14722 "" + npg1 = 1; +#line 14722 "" + } /* 2/23/03 Don't use \atnextline if on first page and only one system */ /* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ /* Writing concatenation */ -#line 14747 "" - i__7[0] = 1, a__4[0] = all_1.sq; -#line 14747 "" - i__7[1] = 3, a__4[1] = "def"; -#line 14747 "" - i__7[2] = 1, a__4[2] = all_1.sq; -#line 14747 "" - i__7[3] = 11, a__4[3] = "atnextline{"; -#line 14747 "" - i__7[4] = 1, a__4[4] = all_1.sq; -#line 14747 "" - i__7[5] = 10, a__4[5] = "toppageno{"; -#line 14747 "" - s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59); -#line 14748 "" - lhead = 27; +#line 14727 "" + i__7[0] = 1, a__4[0] = all_1.sq; +#line 14727 "" + i__7[1] = 3, a__4[1] = "def"; +#line 14727 "" + i__7[2] = 1, a__4[2] = all_1.sq; +#line 14727 "" + i__7[3] = 11, a__4[3] = "atnextline{"; +#line 14727 "" + i__7[4] = 1, a__4[4] = all_1.sq; +#line 14727 "" + i__7[5] = 10, a__4[5] = "toppageno{"; +#line 14727 "" + s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59); +#line 14728 "" + lhead = 27; /* else */ /* hdlndq = sq//'toppageno{' */ /* lhead = 11 */ /* end if */ -#line 14753 "" - if (npg1 < 10) { +#line 14733 "" + if (npg1 < 10) { /* Note we are overwriting the last "{" */ -#line 14757 "" - ici__1.icierr = 0; -#line 14757 "" - ici__1.icirnum = 1; -#line 14757 "" - ici__1.icirlen = 1; -#line 14757 "" - ici__1.iciunit = hdlndq + (lhead - 1); -#line 14757 "" - ici__1.icifmt = "(i1)"; -#line 14757 "" - s_wsfi(&ici__1); -#line 14757 "" - do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); -#line 14757 "" - e_wsfi(); -#line 14758 "" - } else if (npg1 < 100) { -#line 14759 "" - lhead += 3; -#line 14760 "" - i__1 = lhead - 3; -#line 14760 "" - ici__1.icierr = 0; -#line 14760 "" - ici__1.icirnum = 1; -#line 14760 "" - ici__1.icirlen = lhead - i__1; -#line 14760 "" - ici__1.iciunit = hdlndq + i__1; -#line 14760 "" - ici__1.icifmt = "(i2,a1)"; -#line 14760 "" - s_wsfi(&ici__1); -#line 14760 "" - do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); -#line 14760 "" - do_fio(&c__1, "}", (ftnlen)1); -#line 14760 "" - e_wsfi(); -#line 14761 "" - } else { -#line 14762 "" - lhead += 4; -#line 14763 "" - i__1 = lhead - 4; -#line 14763 "" - ici__1.icierr = 0; -#line 14763 "" - ici__1.icirnum = 1; -#line 14763 "" - ici__1.icirlen = lhead - i__1; -#line 14763 "" - ici__1.iciunit = hdlndq + i__1; -#line 14763 "" - ici__1.icifmt = "(i3,a1)"; -#line 14763 "" - s_wsfi(&ici__1); -#line 14763 "" - do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); -#line 14763 "" - do_fio(&c__1, "}", (ftnlen)1); -#line 14763 "" - e_wsfi(); -#line 14764 "" - } -/* Writing concatenation */ -#line 14765 "" - i__6[0] = lhead, a__3[0] = hdlndq; -#line 14765 "" - i__1 = ipg1r + 48; -#line 14765 "" - chax_(ch__1, (ftnlen)1, &i__1); -#line 14765 "" - i__6[1] = 1, a__3[1] = ch__1; -#line 14765 "" - i__6[2] = 1, a__3[2] = "{"; -#line 14765 "" - s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); -#line 14766 "" - lhead += 2; -/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ -#line 14768 "" - if (ltopnam == 0) { -#line 14769 "" - if (comlast_1.islast) { -#line 14769 "" - s_wsfe(&io___853); -/* Writing concatenation */ -#line 14769 "" - i__5[0] = lhead, a__2[0] = hdlndq; -#line 14769 "" - i__5[1] = 3, a__2[1] = "}}%"; -#line 14769 "" - s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62); -#line 14769 "" - do_fio(&c__1, ch__17, lhead + 3); -#line 14769 "" - e_wsfe(); -#line 14769 "" +#line 14737 "" + ici__1.icierr = 0; +#line 14737 "" + ici__1.icirnum = 1; +#line 14737 "" + ici__1.icirlen = 1; +#line 14737 "" + ici__1.iciunit = hdlndq + (lhead - 1); +#line 14737 "" + ici__1.icifmt = "(i1)"; +#line 14737 "" + s_wsfi(&ici__1); +#line 14737 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14737 "" + e_wsfi(); +#line 14738 "" + } else if (npg1 < 100) { +#line 14739 "" + lhead += 3; +#line 14740 "" + i__1 = lhead - 3; +#line 14740 "" + ici__1.icierr = 0; +#line 14740 "" + ici__1.icirnum = 1; +#line 14740 "" + ici__1.icirlen = lhead - i__1; +#line 14740 "" + ici__1.iciunit = hdlndq + i__1; +#line 14740 "" + ici__1.icifmt = "(i2,a1)"; +#line 14740 "" + s_wsfi(&ici__1); +#line 14740 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14740 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 14740 "" + e_wsfi(); +#line 14741 "" + } else { +#line 14742 "" + lhead += 4; +#line 14743 "" + i__1 = lhead - 4; +#line 14743 "" + ici__1.icierr = 0; +#line 14743 "" + ici__1.icirnum = 1; +#line 14743 "" + ici__1.icirlen = lhead - i__1; +#line 14743 "" + ici__1.iciunit = hdlndq + i__1; +#line 14743 "" + ici__1.icifmt = "(i3,a1)"; +#line 14743 "" + s_wsfi(&ici__1); +#line 14743 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14743 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 14743 "" + e_wsfi(); +#line 14744 "" } -#line 14770 "" - } else { -#line 14771 "" - if (comlast_1.islast) { -#line 14771 "" - s_wsfe(&io___854); /* Writing concatenation */ -#line 14771 "" - i__6[0] = lhead, a__3[0] = hdlndq; -#line 14771 "" - i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq; -#line 14771 "" - i__6[2] = 3, a__3[2] = "}}%"; -#line 14771 "" - s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122); -#line 14771 "" - do_fio(&c__1, ch__18, lhead + ltopnam + 3); -#line 14771 "" - e_wsfe(); -#line 14771 "" +#line 14745 "" + i__6[0] = lhead, a__3[0] = hdlndq; +#line 14745 "" + i__1 = ipg1r + 48; +#line 14745 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 14745 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 14745 "" + i__6[2] = 1, a__3[2] = "{"; +#line 14745 "" + s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); +#line 14746 "" + lhead += 2; +/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ +#line 14748 "" + if (ltopnam == 0) { +#line 14749 "" + if (comlast_1.islast) { +#line 14749 "" + s_wsfe(&io___852); +/* Writing concatenation */ +#line 14749 "" + i__5[0] = lhead, a__2[0] = hdlndq; +#line 14749 "" + i__5[1] = 3, a__2[1] = "}}%"; +#line 14749 "" + s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62); +#line 14749 "" + do_fio(&c__1, ch__17, lhead + 3); +#line 14749 "" + e_wsfe(); +#line 14749 "" + } +#line 14750 "" + } else { +#line 14751 "" + if (comlast_1.islast) { +#line 14751 "" + s_wsfe(&io___853); +/* Writing concatenation */ +#line 14751 "" + i__6[0] = lhead, a__3[0] = hdlndq; +#line 14751 "" + i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq; +#line 14751 "" + i__6[2] = 3, a__3[2] = "}}%"; +#line 14751 "" + s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122); +#line 14751 "" + do_fio(&c__1, ch__18, lhead + ltopnam + 3); +#line 14751 "" + e_wsfe(); +#line 14751 "" + } +#line 14753 "" } -#line 14773 "" - } /* else */ /* if (ltopnam .eq. 0) then */ /* if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' */ @@ -35023,1009 +35233,1036 @@ L36: /* * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */ /* end if */ /* end if */ -#line 14782 "" - } else if (*(unsigned char *)charq == 'W') { +#line 14762 "" + } else if (*(unsigned char *)charq == 'W') { /* Just eat the number that must follow, it was used in pmxa */ +#line 14766 "" + ++all_1.iccount; +#line 14767 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 14768 "" + } else if (*(unsigned char *)charq == 'T') { +#line 14769 "" + comtitl_1.headlog = TRUE_; +#line 14770 "" + comtitl_1.inhead = 0; +#line 14771 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14772 "" + if (*(unsigned char *)durq == 'i') { +#line 14773 "" + getbuf_(comtitl_1.instrq, (ftnlen)120); + +/* A kluge for parts from separate score file for later movements. */ + +#line 14777 "" + if (*(unsigned char *)comtitl_1.instrq == ' ') { +#line 14777 "" + comtitl_1.headlog = FALSE_; +#line 14777 "" + } +#line 14778 "" + s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, ( + ftnlen)60); +#line 14779 "" + } else if (*(unsigned char *)durq == 't') { +#line 14780 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Optionally can include extra vertical \internotes above inbothd */ + +#line 14784 "" + if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 14785 "" + ipm = 1; #line 14786 "" - ++all_1.iccount; -#line 14787 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 14788 "" - } else if (*(unsigned char *)charq == 'T') { -#line 14789 "" - comtitl_1.headlog = TRUE_; + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Don't trust readnum to round this negative integer properly */ + #line 14790 "" - comtitl_1.inhead = 0; + ++all_1.iccount; #line 14791 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + if (*(unsigned char *)durq == '-') { +#line 14791 "" + ipm = -1; +#line 14791 "" + } #line 14792 "" - if (*(unsigned char *)durq == 'i') { + } #line 14793 "" - getbuf_(comtitl_1.instrq, (ftnlen)120); - -/* A kluge for parts from separate score file for later movements. */ - -#line 14797 "" - if (*(unsigned char *)comtitl_1.instrq == ' ') { -#line 14797 "" - comtitl_1.headlog = FALSE_; + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 14794 "" + comtitl_1.inhead = ipm * i_nint(&fnum); +#line 14795 "" + } +#line 14796 "" + getbuf_(comtitl_1.titleq, (ftnlen)120); #line 14797 "" - } + } else { #line 14798 "" - s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen) - 60); + getbuf_(comtitl_1.compoq, (ftnlen)120); #line 14799 "" - } else if (*(unsigned char *)durq == 't') { + } #line 14800 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + comtitl_1.inhead += cominbot_1.inbothd; +#line 14801 "" + all_1.iccount = 128; +#line 14802 "" + } else if (*(unsigned char *)charq == 'A') { -/* Optionally can include extra vertical \internotes above inbothd */ +/* Accidental handling etc. */ -#line 14804 "" - if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 14805 "" - ipm = 1; #line 14806 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { - -/* Don't trust readnum to round this negative integer properly */ - +L27: +#line 14806 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14807 "" + if (*(unsigned char *)durq == 'r') { +#line 14808 "" + if (comlast_1.islast) { +#line 14809 "" + commidi_1.relacc = TRUE_; #line 14810 "" - ++all_1.iccount; -#line 14811 "" - if (*(unsigned char *)durq == '-') { -#line 14811 "" - ipm = -1; + s_wsfe(&io___854); +/* Writing concatenation */ +#line 14810 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14810 "" + i__5[1] = 14, a__2[1] = "relativeaccid%"; +#line 14810 "" + s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15); +#line 14810 "" + do_fio(&c__1, ch__19, (ftnlen)15); +#line 14810 "" + e_wsfe(); #line 14811 "" - } -#line 14812 "" } +#line 14812 "" + } else if (*(unsigned char *)durq == 's') { #line 14813 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); + spfacs_1.bacfac = 1e6f; #line 14814 "" - comtitl_1.inhead = ipm * i_nint(&fnum); + } else if (*(unsigned char *)durq == 'b') { #line 14815 "" - } + if (comlast_1.islast) { +#line 14815 "" + s_wsfe(&io___855); +/* Writing concatenation */ +#line 14815 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14815 "" + i__5[1] = 9, a__2[1] = "bigaccid%"; +#line 14815 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14815 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 14815 "" + e_wsfe(); +#line 14815 "" + } #line 14816 "" - getbuf_(comtitl_1.titleq, (ftnlen)120); + spfacs_1.accfac = spfacs_1.bacfac; #line 14817 "" - } else { + } else if (*(unsigned char *)durq == 'a') { #line 14818 "" - getbuf_(comtitl_1.compoq, (ftnlen)120); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14819 "" - } + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); #line 14820 "" - comtitl_1.inhead += cominbot_1.inbothd; + --all_1.iccount; #line 14821 "" - all_1.iccount = 128; + } else if (*(unsigned char *)durq == 'i') { #line 14822 "" - } else if (*(unsigned char *)charq == 'A') { + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14823 "" + readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, ( + ftnlen)1); +#line 14824 "" + if (! all_1.firstgulp) { +#line 14824 "" + comget_1.fintstf = tintstf; +#line 14824 "" + } -/* Accidental handling etc. */ +/* Local corrections for first page were handled by pmxa */ -#line 14826 "" -L27: -#line 14826 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14827 "" - if (*(unsigned char *)durq == 'r') { #line 14828 "" - if (comlast_1.islast) { + --all_1.iccount; #line 14829 "" - commidi_1.relacc = TRUE_; -#line 14830 "" - s_wsfe(&io___855); -/* Writing concatenation */ -#line 14830 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14830 "" - i__5[1] = 14, a__2[1] = "relativeaccid%"; -#line 14830 "" - s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15); -#line 14830 "" - do_fio(&c__1, ch__19, (ftnlen)15); + } else if (*(unsigned char *)durq == 'I') { #line 14830 "" - e_wsfe(); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14831 "" - } + readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, ( + ftnlen)128, (ftnlen)1); #line 14832 "" - } else if (*(unsigned char *)durq == 's') { + --all_1.iccount; #line 14833 "" - spfacs_1.bacfac = 1e6f; + } else if (*(unsigned char *)durq == 'd') { #line 14834 "" - } else if (*(unsigned char *)durq == 'b') { -#line 14835 "" - if (comlast_1.islast) { -#line 14835 "" - s_wsfe(&io___856); -/* Writing concatenation */ -#line 14835 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14835 "" - i__5[1] = 9, a__2[1] = "bigaccid%"; -#line 14835 "" - s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); -#line 14835 "" - do_fio(&c__1, ch__3, (ftnlen)10); + comarp_1.lowdot = TRUE_; #line 14835 "" - e_wsfe(); -#line 14835 "" - } -#line 14836 "" - spfacs_1.accfac = spfacs_1.bacfac; + } else if (*(unsigned char *)durq == 'o') { #line 14837 "" - } else if (*(unsigned char *)durq == 'a') { + } else if (*(unsigned char *)durq == 'S') { #line 14838 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + i__1 = comkeys_2.noinst; +#line 14838 "" + for (iiv = 1; iiv <= i__1; ++iiv) { #line 14839 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); #line 14840 "" - --all_1.iccount; + if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) { #line 14841 "" - } else if (*(unsigned char *)durq == 'i') { + comfig_1.fullsize[iiv - 1] = .8f; #line 14842 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + } else if (*(unsigned char *)durq == 't') { #line 14843 "" - readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, ( - ftnlen)1); -#line 14844 "" - if (! all_1.firstgulp) { + comfig_1.fullsize[iiv - 1] = .64f; #line 14844 "" - comget_1.fintstf = tintstf; -#line 14844 "" - } - -/* Local corrections for first page were handled by pmxa */ - + } else { +/* fullsize(ivx) = 1.0 */ +#line 14846 "" + comfig_1.fullsize[iiv - 1] = 1.f; +#line 14847 "" + } +#line 14848 "" +/* L50: */ #line 14848 "" - --all_1.iccount; + } #line 14849 "" - } else if (*(unsigned char *)durq == 'I') { -#line 14850 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14851 "" - readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen) - 128, (ftnlen)1); -#line 14852 "" - --all_1.iccount; + } else if (*(unsigned char *)durq == 'e') { + +/* Line-spacing equalization */ + #line 14853 "" - } else if (*(unsigned char *)durq == 'd') { -#line 14854 "" - comarp_1.lowdot = TRUE_; -#line 14855 "" - } else if (*(unsigned char *)durq == 'o') { -#line 14857 "" - } else if (*(unsigned char *)durq == 'S') { -#line 14858 "" - i__1 = comkeys_2.noinst; -#line 14858 "" - for (iiv = 1; iiv <= i__1; ++iiv) { + comget_1.equalize = TRUE_; + +/* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */ +/* But it causes problems with some older scores and when excerpts are combined */ +/* with LaTeX. So as of 2.352 we write it here. */ + #line 14859 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 14860 "" - if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) { + s_wsfe(&io___857); +/* Writing concatenation */ +#line 14859 "" + i__8[0] = 1, a__5[0] = all_1.sq; +#line 14859 "" + i__8[1] = 6, a__5[1] = "global"; +#line 14859 "" + i__8[2] = 1, a__5[2] = all_1.sq; +#line 14859 "" + i__8[3] = 19, a__5[3] = "parskip 0pt plus 12"; +#line 14859 "" + i__8[4] = 1, a__5[4] = all_1.sq; +#line 14859 "" + i__8[5] = 19, a__5[5] = "Interligne minus 99"; +#line 14859 "" + i__8[6] = 1, a__5[6] = all_1.sq; +#line 14859 "" + i__8[7] = 11, a__5[7] = "Interligne%"; +#line 14859 "" + s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59); +#line 14859 "" + do_fio(&c__1, ch__20, (ftnlen)59); +#line 14859 "" + e_wsfe(); #line 14861 "" - comfig_1.fullsize[iiv - 1] = .8f; + s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1); #line 14862 "" - } else if (*(unsigned char *)durq == 't') { + lentemp = 1; #line 14863 "" - comfig_1.fullsize[iiv - 1] = .64f; + i__1 = all_1.nv - 1; +#line 14863 "" + for (iiv = 2; iiv <= i__1; ++iiv) { +/* Writing concatenation */ #line 14864 "" - } else { -/* fullsize(ivx) = 1.0 */ + i__5[0] = lentemp, a__2[0] = tempq; +#line 14864 "" + i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1); +#line 14864 "" + s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24); +#line 14865 "" + ++lentemp; +#line 14866 "" +/* L51: */ #line 14866 "" - comfig_1.fullsize[iiv - 1] = 1.f; + } +#line 14867 "" + s_wsfe(&io___860); +/* Writing concatenation */ +#line 14867 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 14867 "" + i__9[1] = 3, a__6[1] = "def"; +#line 14867 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 14867 "" + i__9[3] = 8, a__6[3] = "upstrut{"; +#line 14867 "" + i__9[4] = 1, a__6[4] = all_1.sq; +#line 14867 "" + i__9[5] = 6, a__6[5] = "znotes"; +#line 14867 "" + i__9[6] = lentemp, a__6[6] = tempq; +#line 14867 "" + i__9[7] = 1, a__6[7] = all_1.sq; +#line 14867 "" + i__9[8] = 10, a__6[8] = "zcharnote{"; +#line 14867 "" + i__9[9] = 1, a__6[9] = all_1.sq; #line 14867 "" - } -#line 14868 "" -/* L50: */ -#line 14868 "" - } -#line 14869 "" - } else if (*(unsigned char *)durq == 'e') { + i__9[10] = 9, a__6[10] = "upamt}{~}"; +#line 14867 "" + i__9[11] = 1, a__6[11] = all_1.sq; +#line 14867 "" + i__9[12] = 4, a__6[12] = "en}%"; +#line 14867 "" + s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70); +#line 14867 "" + do_fio(&c__1, ch__21, lentemp + 46); +#line 14867 "" + e_wsfe(); +#line 14870 "" + } else if (*(unsigned char *)durq == 'v') { -/* Line-spacing equalization */ +/* Toggle usevshrink */ -#line 14873 "" - comget_1.equalize = TRUE_; +#line 14874 "" + comlast_1.usevshrink = ! comlast_1.usevshrink; +#line 14875 "" + } else if (*(unsigned char *)durq == 'p') { -/* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */ -/* But it causes problems with some older scores and when excerpts are combined */ -/* with LaTeX. So as of 2.352 we write it here. */ +/* Postscript slurs. fontslur is already false (set in g1etnote) */ #line 14879 "" - s_wsfe(&io___858); + if (! comslur_1.wrotepsslurdefaults) { + +/* Set postscrirpt slur adjustment defaults */ + +#line 14883 "" + s_wsfe(&io___861); /* Writing concatenation */ -#line 14879 "" - i__8[0] = 1, a__5[0] = all_1.sq; -#line 14879 "" - i__8[1] = 6, a__5[1] = "global"; -#line 14879 "" - i__8[2] = 1, a__5[2] = all_1.sq; -#line 14879 "" - i__8[3] = 19, a__5[3] = "parskip 0pt plus 12"; -#line 14879 "" - i__8[4] = 1, a__5[4] = all_1.sq; -#line 14879 "" - i__8[5] = 19, a__5[5] = "Interligne minus 99"; -#line 14879 "" - i__8[6] = 1, a__5[6] = all_1.sq; -#line 14879 "" - i__8[7] = 11, a__5[7] = "Interligne%"; -#line 14879 "" - s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59); -#line 14879 "" - do_fio(&c__1, ch__20, (ftnlen)59); -#line 14879 "" - e_wsfe(); -#line 14881 "" - s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1); -#line 14882 "" - lentemp = 1; #line 14883 "" - i__1 = all_1.nv - 1; + i__7[0] = 1, a__4[0] = all_1.sq; +#line 14883 "" + i__7[1] = 12, a__4[1] = "Nosluradjust"; +#line 14883 "" + i__7[2] = 1, a__4[2] = all_1.sq; +#line 14883 "" + i__7[3] = 11, a__4[3] = "Notieadjust"; +#line 14883 "" + i__7[4] = 1, a__4[4] = all_1.sq; +#line 14883 "" + i__7[5] = 10, a__4[5] = "nohalfties"; +#line 14883 "" + s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36); #line 14883 "" - for (iiv = 2; iiv <= i__1; ++iiv) { -/* Writing concatenation */ -#line 14884 "" - i__5[0] = lentemp, a__2[0] = tempq; -#line 14884 "" - i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1); -#line 14884 "" - s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24); + do_fio(&c__1, ch__22, (ftnlen)36); +#line 14883 "" + e_wsfe(); #line 14885 "" - ++lentemp; -#line 14886 "" -/* L51: */ + comslur_1.wrotepsslurdefaults = TRUE_; #line 14886 "" - } -#line 14887 "" - s_wsfe(&io___861); -/* Writing concatenation */ -#line 14887 "" - i__9[0] = 1, a__6[0] = all_1.sq; -#line 14887 "" - i__9[1] = 3, a__6[1] = "def"; -#line 14887 "" - i__9[2] = 1, a__6[2] = all_1.sq; -#line 14887 "" - i__9[3] = 8, a__6[3] = "upstrut{"; -#line 14887 "" - i__9[4] = 1, a__6[4] = all_1.sq; -#line 14887 "" - i__9[5] = 6, a__6[5] = "znotes"; -#line 14887 "" - i__9[6] = lentemp, a__6[6] = tempq; -#line 14887 "" - i__9[7] = 1, a__6[7] = all_1.sq; -#line 14887 "" - i__9[8] = 10, a__6[8] = "zcharnote{"; -#line 14887 "" - i__9[9] = 1, a__6[9] = all_1.sq; -#line 14887 "" - i__9[10] = 9, a__6[10] = "upamt}{~}"; -#line 14887 "" - i__9[11] = 1, a__6[11] = all_1.sq; -#line 14887 "" - i__9[12] = 4, a__6[12] = "en}%"; -#line 14887 "" - s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70); -#line 14887 "" - do_fio(&c__1, ch__21, lentemp + 46); + } #line 14887 "" - e_wsfe(); -#line 14890 "" - } else if (*(unsigned char *)durq == 'v') { +L52: +#line 14888 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1) + ; +/* might be "+", "-", "h" or */ +#line 14889 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -/* Toggle usevshrink */ +/* Characters to change defaults for ps slurs */ +#line 14893 "" + g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( + ftnlen)1); +/* charq will be "s,t,h,c */ #line 14894 "" - comlast_1.usevshrink = ! comlast_1.usevshrink; + if (*(unsigned char *)durq == '+') { #line 14895 "" - } else if (*(unsigned char *)durq == 'p') { - -/* Postscript slurs. fontslur is already false (set in g1etnote) */ - + if (*(unsigned char *)charq == 's') { +#line 14896 "" + s_wsfe(&io___862); +/* Writing concatenation */ +#line 14896 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14896 "" + i__5[1] = 10, a__2[1] = "Sluradjust"; +#line 14896 "" + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 14896 "" + do_fio(&c__1, ch__10, (ftnlen)11); +#line 14896 "" + e_wsfe(); +#line 14897 "" + } else if (*(unsigned char *)charq == 't') { +#line 14898 "" + s_wsfe(&io___863); +/* Writing concatenation */ +#line 14898 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14898 "" + i__5[1] = 9, a__2[1] = "Tieadjust"; +#line 14898 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14898 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 14898 "" + e_wsfe(); #line 14899 "" - if (! comslur_1.wrotepsslurdefaults) { - -/* Set postscrirpt slur adjustment defaults */ - -#line 14903 "" - s_wsfe(&io___862); + } else if (*(unsigned char *)charq == 'h') { +#line 14900 "" + s_wsfe(&io___864); /* Writing concatenation */ +#line 14900 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14900 "" + i__5[1] = 8, a__2[1] = "halfties"; +#line 14900 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14900 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 14900 "" + e_wsfe(); +#line 14901 "" + } else { +#line 14902 "" + comslur_1.slurcurve += 1; #line 14903 "" - i__7[0] = 1, a__4[0] = all_1.sq; -#line 14903 "" - i__7[1] = 12, a__4[1] = "Nosluradjust"; -#line 14903 "" - i__7[2] = 1, a__4[2] = all_1.sq; -#line 14903 "" - i__7[3] = 11, a__4[3] = "Notieadjust"; -#line 14903 "" - i__7[4] = 1, a__4[4] = all_1.sq; -#line 14903 "" - i__7[5] = 10, a__4[5] = "nohalfties"; -#line 14903 "" - s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36); -#line 14903 "" - do_fio(&c__1, ch__22, (ftnlen)36); -#line 14903 "" - e_wsfe(); + if (comslur_1.slurcurve > 3.1f) { +#line 14904 "" + printl_("WARNING!", (ftnlen)8); #line 14905 "" - comslur_1.wrotepsslurdefaults = TRUE_; -#line 14906 "" - } + printl_("Default slur curvature advanced pas"\ + "t HH, resetting", (ftnlen)50); #line 14907 "" -L52: + comslur_1.slurcurve = 3.f; #line 14908 "" - g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -/* might be "+", "-", "h" or */ + } #line 14909 "" - if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { - -/* Characters to change defaults for ps slurs */ - + } +#line 14910 "" + } else { +#line 14911 "" + if (*(unsigned char *)charq == 's') { +#line 14912 "" + s_wsfe(&io___865); +/* Writing concatenation */ +#line 14912 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14912 "" + i__5[1] = 12, a__2[1] = "Nosluradjust"; +#line 14912 "" + s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13); +#line 14912 "" + do_fio(&c__1, ch__4, (ftnlen)13); +#line 14912 "" + e_wsfe(); #line 14913 "" - g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen) - 1); -/* charq will be "s,t,h,c */ + } else if (*(unsigned char *)charq == 't') { #line 14914 "" - if (*(unsigned char *)durq == '+') { + s_wsfe(&io___866); +/* Writing concatenation */ +#line 14914 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 14914 "" + i__5[1] = 11, a__2[1] = "Notieadjust"; +#line 14914 "" + s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 14914 "" + do_fio(&c__1, ch__2, (ftnlen)12); +#line 14914 "" + e_wsfe(); #line 14915 "" - if (*(unsigned char *)charq == 's') { + } else if (*(unsigned char *)charq == 'h') { #line 14916 "" - s_wsfe(&io___863); + s_wsfe(&io___867); /* Writing concatenation */ #line 14916 "" - i__5[0] = 1, a__2[0] = all_1.sq; + i__5[0] = 1, a__2[0] = all_1.sq; #line 14916 "" - i__5[1] = 10, a__2[1] = "Sluradjust"; + i__5[1] = 10, a__2[1] = "nohalfties"; #line 14916 "" - s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); #line 14916 "" - do_fio(&c__1, ch__10, (ftnlen)11); + do_fio(&c__1, ch__10, (ftnlen)11); #line 14916 "" - e_wsfe(); + e_wsfe(); #line 14917 "" - } else if (*(unsigned char *)charq == 't') { -#line 14918 "" - s_wsfe(&io___864); -/* Writing concatenation */ -#line 14918 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14918 "" - i__5[1] = 9, a__2[1] = "Tieadjust"; -#line 14918 "" - s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); -#line 14918 "" - do_fio(&c__1, ch__3, (ftnlen)10); + } else { #line 14918 "" - e_wsfe(); + comslur_1.slurcurve += -1; #line 14919 "" - } else if (*(unsigned char *)charq == 'h') { -#line 14920 "" - s_wsfe(&io___865); -/* Writing concatenation */ -#line 14920 "" - i__5[0] = 1, a__2[0] = all_1.sq; + if (comslur_1.slurcurve < -1.1f) { #line 14920 "" - i__5[1] = 8, a__2[1] = "halfties"; -#line 14920 "" - s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); -#line 14920 "" - do_fio(&c__1, ch__12, (ftnlen)9); -#line 14920 "" - e_wsfe(); + printl_("WARNING!", (ftnlen)8); #line 14921 "" - } else { -#line 14922 "" - comslur_1.slurcurve += 1; + printl_("Default slur curvature decremented "\ + "below f, resetting", (ftnlen)53); #line 14923 "" - if (comslur_1.slurcurve > 3.1f) { + comslur_1.slurcurve = -1.f; #line 14924 "" - printl_("WARNING!", (ftnlen)8); + } #line 14925 "" - printl_("Default slur curvature advanced past HH"\ - ", resetting", (ftnlen)50); -#line 14927 "" - comslur_1.slurcurve = 3.f; -#line 14928 "" } -#line 14929 "" +#line 14926 "" } -#line 14930 "" - } else { -#line 14931 "" - if (*(unsigned char *)charq == 's') { -#line 14932 "" - s_wsfe(&io___866); -/* Writing concatenation */ -#line 14932 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14932 "" - i__5[1] = 12, a__2[1] = "Nosluradjust"; -#line 14932 "" - s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13); -#line 14932 "" - do_fio(&c__1, ch__4, (ftnlen)13); +#line 14927 "" + goto L52; +/* Check for another set of default changes */ +#line 14928 "" + } else if (*(unsigned char *)durq == 'l') { + +/* Set optional linebreak ties */ + #line 14932 "" - e_wsfe(); + comnotes_1.optlinebreakties = TRUE_; #line 14933 "" - } else if (*(unsigned char *)charq == 't') { -#line 14934 "" - s_wsfe(&io___867); -/* Writing concatenation */ -#line 14934 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14934 "" - i__5[1] = 11, a__2[1] = "Notieadjust"; -#line 14934 "" - s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); -#line 14934 "" - do_fio(&c__1, ch__2, (ftnlen)12); + goto L52; #line 14934 "" - e_wsfe(); -#line 14935 "" - } else if (*(unsigned char *)charq == 'h') { -#line 14936 "" - s_wsfe(&io___868); -/* Writing concatenation */ -#line 14936 "" - i__5[0] = 1, a__2[0] = all_1.sq; -#line 14936 "" - i__5[1] = 10, a__2[1] = "nohalfties"; -#line 14936 "" - s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); -#line 14936 "" - do_fio(&c__1, ch__10, (ftnlen)11); -#line 14936 "" - e_wsfe(); -#line 14937 "" - } else { + } else if (*(unsigned char *)durq == 'h') { + +/* Set flag to write header special on every page */ + #line 14938 "" - comslur_1.slurcurve += -1; + comnotes_1.headerspecial = TRUE_; #line 14939 "" - if (comslur_1.slurcurve < -1.1f) { + goto L52; #line 14940 "" - printl_("WARNING!", (ftnlen)8); + } else { #line 14941 "" - printl_("Default slur curvature decremented belo"\ - "w f, resetting", (ftnlen)53); -#line 14943 "" - comslur_1.slurcurve = -1.f; -#line 14944 "" - } -#line 14945 "" - } -#line 14946 "" + --all_1.iccount; +#line 14942 "" } +#line 14943 "" + } else if (*(unsigned char *)durq == 'K') { + +/* Toggle keyboard rest placement flag */ + #line 14947 "" - goto L52; -/* Check for another set of default changes */ + comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests; #line 14948 "" - } else if (*(unsigned char *)durq == 'l') { + } else if (*(unsigned char *)durq == 'c') { +#line 14949 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1) + ; -/* Set optional linebreak ties */ +/* Just eat the input; it was used in pmxa */ -#line 14952 "" - comnotes_1.optlinebreakties = TRUE_; #line 14953 "" - goto L52; + goto L27; #line 14954 "" - } else if (*(unsigned char *)durq == 'h') { - -/* Set flag to write header special on every page */ - + } else if (*(unsigned char *)durq == 'V') { +#line 14955 "" + combottop_1.bottopgap = TRUE_; +#line 14956 "" + combottop_1.topamt = 0.f; +#line 14957 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14958 "" - comnotes_1.headerspecial = TRUE_; + pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2) + ; #line 14959 "" - goto L52; + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1) + ; #line 14960 "" - } else { + readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, ( + ftnlen)128, (ftnlen)1); #line 14961 "" - --all_1.iccount; + combottop_1.botamt *= pmfac; #line 14962 "" - } + pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2) + ; #line 14963 "" - } else if (*(unsigned char *)durq == 'K') { - -/* Toggle keyboard rest placement flag */ - + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1) + ; +#line 14964 "" + readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, ( + ftnlen)128, (ftnlen)1); +#line 14965 "" + combottop_1.topamt *= pmfac; +#line 14966 "" + --all_1.iccount; #line 14967 "" - comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests; + goto L27; #line 14968 "" - } else if (*(unsigned char *)durq == 'c') { + } #line 14969 "" - g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) { -/* Just eat the input; it was used in pmxa */ +/* Override default part names for scor2prt, or normal include file. */ +/* Just bypass rest of input line */ -#line 14973 "" - goto L27; #line 14974 "" - } else if (*(unsigned char *)durq == 'V') { + all_1.iccount = 128; #line 14975 "" - combottop_1.bottopgap = TRUE_; + } else if (*(unsigned char *)durq != ' ') { #line 14976 "" - combottop_1.topamt = 0.f; + goto L27; #line 14977 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + } #line 14978 "" - pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2); + } else if (*(unsigned char *)charq == 'K') { #line 14979 "" - g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +L77: #line 14980 "" - readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, ( - ftnlen)128, (ftnlen)1); + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); #line 14981 "" - combottop_1.botamt *= pmfac; + if (*(unsigned char *)durq == 'n') { #line 14982 "" - pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2); + comignorenats_1.ignorenats = TRUE_; #line 14983 "" - g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + goto L77; #line 14984 "" - readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, ( - ftnlen)128, (ftnlen)1); + } #line 14985 "" - combottop_1.topamt *= pmfac; -#line 14986 "" - --all_1.iccount; -#line 14987 "" - goto L27; -#line 14988 "" - } + if (*(unsigned char *)durq != 'i') { + +/* Normal, full-score key change and/or transposition */ + #line 14989 "" - if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) { + num1 = 44 - *(unsigned char *)durq; +#line 14990 "" + ++all_1.iccount; +#line 14991 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 14992 "" + num1 *= i_nint(&fnum); -/* Override default part names for scor2prt, or normal include file. */ -/* Just bypass rest of input line */ +/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */ -#line 14994 "" - all_1.iccount = 128; -#line 14995 "" - } else if (*(unsigned char *)durq != ' ') { #line 14996 "" - goto L27; + ++all_1.iccount; #line 14997 "" - } + readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( + ftnlen)1); #line 14998 "" - } else if (*(unsigned char *)charq == 'K') { + if (commidi_1.ismidi) { #line 14999 "" -L77: + commidisig_1.midisig = i_nint(&fnum); #line 15000 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15001 "" - if (*(unsigned char *)durq == 'n') { + if (*(unsigned char *)durq == '-') { +#line 15000 "" + commidisig_1.midisig = -commidisig_1.midisig; +#line 15000 "" + } +/* 130317 */ #line 15002 "" - comignorenats_1.ignorenats = TRUE_; + commidisig_1.midisig += comtop_1.idsig; #line 15003 "" - goto L77; -#line 15004 "" - } + midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1); #line 15005 "" - if (*(unsigned char *)durq != 'i') { + } +/* 70 continue */ +#line 15007 "" + if (num1 == 0) { -/* Normal, full-score key change and/or transposition */ +/* Key change, not transposition. */ -#line 15009 "" - num1 = 44 - *(unsigned char *)durq; -#line 15010 "" - ++all_1.iccount; #line 15011 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); + all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) + * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28); #line 15012 "" - num1 *= i_nint(&fnum); - -/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */ - + comtop_1.lastisig = comtop_1.isig; +#line 15013 "" + comtop_1.isig = i_nint(&fnum); +#line 15014 "" + if (*(unsigned char *)durq == '-') { +#line 15014 "" + comtop_1.isig = -comtop_1.isig; +#line 15014 "" + } +#line 15015 "" + comtop_1.isig += comtop_1.idsig; #line 15016 "" - ++all_1.iccount; + if (commidi_1.ismidi) { +#line 15016 "" + midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1); +#line 15016 "" + } #line 15017 "" - readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( - ftnlen)1); -#line 15018 "" - if (commidi_1.ismidi) { -#line 15019 "" - commidisig_1.midisig = i_nint(&fnum); -#line 15020 "" - if (*(unsigned char *)durq == '-') { -#line 15020 "" - commidisig_1.midisig = -commidisig_1.midisig; -#line 15020 "" - } -/* 130317 */ -#line 15022 "" - commidisig_1.midisig += comtop_1.idsig; + } else { + +/* num1 .ne. 0, so transposition, so must be at beginning. isig came with K... */ +/* but was passed to pmxb through pmxtex.dat. isig0 comes from setup data */ +/* (signature before transposition). idsig must be added to future key changes. */ + #line 15023 "" - midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1); + jv = 0; +#line 15024 "" + while(jv < 24) { #line 15025 "" - } -/* 70 continue */ + ++jv; +#line 15026 "" + cominsttrans_1.itransamt[jv - 1] = num1; #line 15027 "" - if (num1 == 0) { + } +#line 15028 "" + comtop_1.idsig = comtop_1.isig - comtop_1.isig0; +#line 15029 "" + } +#line 15030 "" + } else { -/* Key change, not transposition. */ +/* Instrument specific transposition. */ -#line 15031 "" - all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * - 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + ( - all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28); -#line 15032 "" - comtop_1.lastisig = comtop_1.isig; -#line 15033 "" - comtop_1.isig = i_nint(&fnum); -#line 15034 "" - if (*(unsigned char *)durq == '-') { -#line 15034 "" - comtop_1.isig = -comtop_1.isig; #line 15034 "" - } -#line 15035 "" - comtop_1.isig += comtop_1.idsig; -#line 15036 "" - if (commidi_1.ismidi) { -#line 15036 "" - midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1); -#line 15036 "" - } -#line 15037 "" - } else { + getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, & + all_1.iccount, &ibaroff, &all_1.nbars, & + comkeys_2.noinst, (ftnlen)128); -/* num1 .ne. 0, so transposition, so must be at beginning. isig came with K... */ -/* but was passed to pmxb through pmxtex.dat. isig0 comes from setup data */ -/* (signature before transposition). idsig must be added to future key changes. */ +/* The sig parameters will have been set 1st time but that's OK */ + +#line 15039 "" + } +#line 15040 "" + } else /* if(complicated condition) */ { +#line 15040 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 15040 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { +#line 15041 "" + if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 1],26)) { + +/* There was a hardspace followed by end of block. Remove it from the hardspace */ +/* list, store with shifts instead, set special bit. This code also at '|' */ -#line 15043 "" - jv = 0; -#line 15044 "" - while(jv < 24) { -#line 15045 "" - ++jv; #line 15046 "" - cominsttrans_1.itransamt[jv - 1] = num1; + all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); #line 15047 "" - } + ++comudsp_1.nudoff[commvl_1.ivx - 1]; #line 15048 "" - comtop_1.idsig = comtop_1.isig - comtop_1.isig0; + comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[ + commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udsp[ + comudsp_1.nudsp - 1]; #line 15049 "" - } + --comudsp_1.nudsp; #line 15050 "" - } else { + all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + + 1) * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26); +#line 15051 "" + } +#line 15052 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -/* Instrument specific transposition. */ +/* Save ending note level: */ -#line 15054 "" - getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, & - all_1.iccount, &ibaroff, &all_1.nbars, &comkeys_2.noinst, - (ftnlen)128); +#line 15056 "" + if (commvl_1.ivx <= all_1.nv) { -/* The sig parameters will have been set 1st time but that's OK */ +/* This is the first line of music on this staff. If previous block had only 1 */ +/* voice, save last pitch from line 1 of prev. block to line 2, in case a */ +/* 2nd line is started just below */ -#line 15059 "" - } -#line 15060 "" - } else if (*(unsigned char *)charq == '/') { -#line 15061 "" - if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - + 1) * 24 - 1],26)) { +#line 15062 "" + if (! comnotes_1.was2[all_1.iv - 1]) { +#line 15062 "" + comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[ + all_1.iv - 1]; +#line 15062 "" + } +#line 15063 "" + comnotes_1.was2[all_1.iv - 1] = FALSE_; +#line 15064 "" + comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev; +#line 15065 "" + } else { -/* There was a hardspace followed by end of block. Remove it from the hardspace */ -/* list, store with shifts instead, set special bit. This code also at '|' */ +/* This is the 2nd line of music on this staff. */ -#line 15066 "" - all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] - = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ - commvl_1.ivx - 1] * 24 - 25],18); -#line 15067 "" - ++comudsp_1.nudoff[commvl_1.ivx - 1]; -#line 15068 "" - comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] - * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; #line 15069 "" - --comudsp_1.nudsp; + comnotes_1.was2[all_1.iv - 1] = TRUE_; #line 15070 "" - all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[ - commvl_1.ivx - 1] + 1) * 24 - 1],26); + comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev; #line 15071 "" - } + } #line 15072 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) { -/* Save ending note level: */ +/* End of input block */ #line 15076 "" - if (commvl_1.ivx <= all_1.nv) { + *loop = FALSE_; +#line 15077 "" + } else { -/* This is the first line of music on this staff. If previous block had only 1 */ -/* voice, save last pitch from line 1 of prev. block to line 2, in case a */ -/* 2nd line is started just below */ +/* Start a new line of music */ +#line 15081 "" + if (all_1.lenb0 != 0 && all_1.firstgulp) { +#line 15081 "" + all_1.lenbar = all_1.lenb0; +#line 15081 "" + } #line 15082 "" - if (! comnotes_1.was2[all_1.iv - 1]) { -#line 15082 "" - comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv - - 1]; -#line 15082 "" - } + all_1.nbars = 0; #line 15083 "" - comnotes_1.was2[all_1.iv - 1] = FALSE_; -#line 15084 "" - comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev; -#line 15085 "" - } else { + if (*(unsigned char *)durq == ' ') { -/* This is the 2nd line of music on this staff. */ +/* New line of music is on next staff */ +#line 15087 "" + ++all_1.iv; +#line 15088 "" + commvl_1.ivx = all_1.iv; #line 15089 "" - comnotes_1.was2[all_1.iv - 1] = TRUE_; -#line 15090 "" - comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev; -#line 15091 "" - } -#line 15092 "" - if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) { + } else { -/* End of input block */ +/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */ +#line 15093 "" + commvl_1.ivx = all_1.nv + 1; +#line 15094 "" + i__1 = all_1.nv; +#line 15094 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 15095 "" + if (commvl_1.nvmx[iiv - 1] == 2) { +#line 15095 "" + ++commvl_1.ivx; +#line 15095 "" + } +#line 15096 "" +/* L23: */ #line 15096 "" - *loop = FALSE_; + } #line 15097 "" - } else { - -/* Start a new line of music */ - + commvl_1.nvmx[all_1.iv - 1] = 2; +#line 15098 "" + commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx; +#line 15099 "" + all_1.itsofar[commvl_1.ivx - 1] = 0; +#line 15100 "" + all_1.nnl[commvl_1.ivx - 1] = 0; #line 15101 "" - if (all_1.lenb0 != 0 && all_1.firstgulp) { -#line 15101 "" - all_1.lenbar = all_1.lenb0; -#line 15101 "" - } + comfb_1.nfb[commvl_1.ivx - 1] = 0; #line 15102 "" - all_1.nbars = 0; + comudsp_1.nudoff[commvl_1.ivx - 1] = 0; #line 15103 "" - if (*(unsigned char *)durq == ' ') { - -/* New line of music is on next staff */ - + comcc_1.ndotmv[commvl_1.ivx - 1] = 0; +#line 15104 "" + for (j = 1; j <= 200; ++j) { +#line 15105 "" + all_1.irest[commvl_1.ivx + j * 24 - 25] = 0; +#line 15106 "" + all_1.islur[commvl_1.ivx + j * 24 - 25] = 0; #line 15107 "" - ++all_1.iv; + all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0; #line 15108 "" - commvl_1.ivx = all_1.iv; + all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0; #line 15109 "" - } else { + all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0; +#line 15110 "" + all_1.mult[commvl_1.ivx + j * 24 - 25] = 0; +#line 15111 "" +/* L24: */ +#line 15111 "" + } -/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */ +/* Go back and lower the rests in voice "a" that don't have over-ridden heights */ -#line 15113 "" - commvl_1.ivx = all_1.nv + 1; -#line 15114 "" - i__1 = all_1.nv; -#line 15114 "" - for (iiv = 1; iiv <= i__1; ++iiv) { -#line 15115 "" - if (commvl_1.nvmx[iiv - 1] == 2) { #line 15115 "" - ++commvl_1.ivx; + i__1 = all_1.nnl[all_1.iv - 1]; #line 15115 "" - } + for (j = 1; j <= i__1; ++j) { #line 15116 "" -/* L23: */ + if (bit_test(all_1.irest[all_1.iv + j * 24 - 25], + 0) && all_1.nolev[all_1.iv + j * 24 - 25] + == 0) { #line 15116 "" - } -#line 15117 "" - commvl_1.nvmx[all_1.iv - 1] = 2; + all_1.nolev[all_1.iv + j * 24 - 25] = -4; +#line 15116 "" + } +#line 15118 "" +/* L26: */ #line 15118 "" - commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx; + } #line 15119 "" - all_1.itsofar[commvl_1.ivx - 1] = 0; + } #line 15120 "" - all_1.nnl[commvl_1.ivx - 1] = 0; + } #line 15121 "" - comfb_1.nfb[commvl_1.ivx - 1] = 0; + all_1.iccount = 128; #line 15122 "" - comudsp_1.nudoff[commvl_1.ivx - 1] = 0; -#line 15123 "" - comcc_1.ndotmv[commvl_1.ivx - 1] = 0; -#line 15124 "" - for (j = 1; j <= 200; ++j) { -#line 15125 "" - all_1.irest[commvl_1.ivx + j * 24 - 25] = 0; -#line 15126 "" - all_1.islur[commvl_1.ivx + j * 24 - 25] = 0; -#line 15127 "" - all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0; + } else if (*(unsigned char *)charq == 'X') { + +/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */ +/* which only happens for normal X at block start, and we took special measures to */ +/* keep group shifts for crossing block boundaries. */ + +/* Computing MAX */ #line 15128 "" - all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0; -#line 15129 "" - all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0; -#line 15130 "" - all_1.mult[commvl_1.ivx + j * 24 - 25] = 0; -#line 15131 "" -/* L24: */ + i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1]; +#line 15128 "" + getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max( + i__1,i__2) * 24 - 25], &comnotes_1.shifton, & + comask_1.wheadpt, &all_1.iornq[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1], & + commvl_1.ivx, &all_1.irest[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[ + commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, ( + ftnlen)128, (ftnlen)1); #line 15131 "" - } + } else if (*(unsigned char *)charq == 'I') { -/* Go back and lower the rests in voice "a" that don't have over-ridden heights */ +/* Midi controls. */ #line 15135 "" - i__1 = all_1.nnl[all_1.iv - 1]; -#line 15135 "" - for (j = 1; j <= i__1; ++j) { -#line 15136 "" - if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) && - all_1.nolev[all_1.iv + j * 24 - 25] == 0) { -#line 15136 "" - all_1.nolev[all_1.iv + j * 24 - 25] = -4; -#line 15136 "" - } -#line 15138 "" -/* L26: */ -#line 15138 "" - } -#line 15139 "" - } -#line 15140 "" - } + getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, & + combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, & + all_1.lenbar, &all_1.mtrdenl, &all_1.nv, &c_false, ( + ftnlen)128); +#line 15137 "" + } else if (*(unsigned char *)charq == 'M') { + +/* Macro action */ + #line 15141 "" - all_1.iccount = 128; + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1) + ; #line 15142 "" - } else if (*(unsigned char *)charq == 'X') { + if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { -/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */ -/* which only happens for normal X at block start, and we took special measures to */ -/* keep group shifts for crossing block boundaries. */ +/* Record or save a macro. Get the number of the macro. */ -/* Computing MAX */ -#line 15148 "" - i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1]; +#line 15146 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 15147 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 15148 "" - getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__1, - i__2) * 24 - 25], &comnotes_1.shifton, &comask_1.wheadpt, & - all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * - 24 - 1], &commvl_1.ivx, &all_1.irest[commvl_1.ivx + ( - all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[ - commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen) - 128, (ftnlen)1); + commac_1.macnum = i_nint(&fnum); +#line 15149 "" + commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum) + ; +#line 15150 "" + if (*(unsigned char *)charq == 'R') { #line 15151 "" - } else if (*(unsigned char *)charq == 'I') { + mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); +#line 15152 "" + } else { -/* Midi controls. */ +/* Save (Record but don't activate) */ -#line 15155 "" - getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, & - combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &all_1.lenbar, - &all_1.mtrdenl, &all_1.nv, &c_false, (ftnlen)128); +#line 15156 "" +L5: +#line 15156 "" + mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); #line 15157 "" - } else if (*(unsigned char *)charq == 'M') { - -/* Macro action */ - + if (commac_1.mrecord) { +#line 15158 "" + getbuf_(lineq, (ftnlen)128); +#line 15159 "" + all_1.iccount = 0; +#line 15160 "" + goto L5; #line 15161 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); + } #line 15162 "" - if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { + all_1.iccount = all_1.iccount + ndxm + 1; +#line 15163 "" + } +#line 15164 "" + } else if (*(unsigned char *)charq == 'P') { -/* Record or save a macro. Get the number of the macro. */ +/* Playback the macro */ -#line 15166 "" - getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15167 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); #line 15168 "" - commac_1.macnum = i_nint(&fnum); + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( + ftnlen)1); #line 15169 "" - commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); #line 15170 "" - if (*(unsigned char *)charq == 'R') { + commac_1.macnum = i_nint(&fnum); #line 15171 "" - mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); + commac_1.icchold = all_1.iccount; #line 15172 "" - } else { - -/* Save (Record but don't activate) */ - -#line 15176 "" -L5: + s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); +#line 15173 "" + all_1.iccount = 128; +#line 15174 "" + c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; +#line 15175 "" + commac_1.mplay = TRUE_; #line 15176 "" - mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); + } #line 15177 "" - if (commac_1.mrecord) { -#line 15178 "" - getbuf_(lineq, (ftnlen)128); -#line 15179 "" - all_1.iccount = 0; -#line 15180 "" - goto L5; + } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Continued rhythmic shortcut */ + #line 15181 "" - } + idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); #line 15182 "" - all_1.iccount = all_1.iccount + ndxm + 1; -#line 15183 "" - } -#line 15184 "" - } else if (*(unsigned char *)charq == 'P') { + if (idotform == 1) { -/* Playback the macro */ +/* Check for start of forced beam on 2nd member of dotform=1 shortcut */ -#line 15188 "" - getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); -#line 15189 "" - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); +#line 15186 "" + if (comget_1.fbon) { +#line 15187 "" + if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] == (real) + all_1.itsofar[commvl_1.ivx - 1]) { +#line 15187 "" + comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] += + all_1.nodur[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25] / 2; +#line 15187 "" + } #line 15190 "" - commac_1.macnum = i_nint(&fnum); -#line 15191 "" - commac_1.icchold = all_1.iccount; -#line 15192 "" - s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); -#line 15193 "" - all_1.iccount = 128; + } + +/* Change duration of prior note */ + #line 15194 "" - c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; + all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25]; #line 15195 "" - commac_1.mplay = TRUE_; + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = all_1.nodur[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25] * 3 / 2; #line 15196 "" - } + all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25]; #line 15197 "" - } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { - -/* Continued rhythmic shortcut */ - + } +#line 15198 "" + ++idotform; +#line 15199 "" + numnum = 1; +#line 15200 "" + cdot = TRUE_; #line 15201 "" - idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); + goto L1; #line 15202 "" - if (idotform == 1) { - -/* Check for start of forced beam on 2nd member of dotform=1 shortcut */ - -#line 15206 "" - if (comget_1.fbon) { -#line 15207 "" - if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] - * 24 - 25] == (real) all_1.itsofar[commvl_1.ivx - 1]) - { -#line 15207 "" - comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] - * 24 - 25] += all_1.nodur[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 25] / 2; -#line 15207 "" - } -#line 15210 "" } - -/* Change duration of prior note */ - -#line 15214 "" - all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; -#line 15215 "" - all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] - = all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * - 24 - 25] * 3 / 2; -#line 15216 "" - all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + - all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; -#line 15217 "" - } -#line 15218 "" - ++idotform; -#line 15219 "" - numnum = 1; -#line 15220 "" - cdot = TRUE_; -#line 15221 "" - goto L1; -#line 15222 "" +#line 15202 "" + } +#line 15202 "" } -#line 15223 "" +#line 15203 "" return 0; } /* getnote_ */ @@ -36060,7 +36297,7 @@ L5: static real xofforn; /* Fortran I/O blocks */ - static cilist io___881 = { 0, 6, 0, 0, 0 }; + static cilist io___880 = { 0, 6, 0, 0, 0 }; @@ -36074,9 +36311,9 @@ L5: /* Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U */ /* 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. */ -#line 15247 "" +#line 15227 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 15248 "" +#line 15228 "" if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) { /* caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */ @@ -36086,117 +36323,117 @@ L5: /* bit 27 = 0 if caesura, 1 if breath */ /* bit 28: 5th bit of ivx */ -#line 15257 "" +#line 15237 "" *iornq = bit_set(*iornq,28); -#line 15258 "" +#line 15238 "" ++comcb_1.nbc; /* ibcdata(nbc) = ivx+16*ip */ -#line 15260 "" +#line 15240 "" comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4); -#line 15261 "" +#line 15241 "" if (*ivx >= 16) { -#line 15261 "" +#line 15241 "" comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ comcb_1.nbc - 1],28); -#line 15261 "" +#line 15241 "" } -#line 15262 "" +#line 15242 "" if (*(unsigned char *)charq == 'b') { -#line 15262 "" +#line 15242 "" comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ comcb_1.nbc - 1],27); -#line 15262 "" +#line 15242 "" } -#line 15263 "" +#line 15243 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15264 "" +#line 15244 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* We have a vertical shift, get it */ -#line 15268 "" +#line 15248 "" ++(*iccount); -#line 15269 "" +#line 15249 "" readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); -#line 15270 "" +#line 15250 "" if (*(unsigned char *)durq == '-') { -#line 15270 "" +#line 15250 "" fnum = -fnum; -#line 15270 "" +#line 15250 "" } -#line 15271 "" +#line 15251 "" r__1 = fnum + 32; -#line 15271 "" +#line 15251 "" i__1 = i_nint(&r__1); -#line 15271 "" +#line 15251 "" setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1); -#line 15272 "" +#line 15252 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Horizontal shift, get it */ -#line 15276 "" +#line 15256 "" ++(*iccount); -#line 15277 "" +#line 15257 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 15278 "" +#line 15258 "" if (*(unsigned char *)charq == '-') { -#line 15278 "" +#line 15258 "" fnum = -fnum; -#line 15278 "" +#line 15258 "" } -#line 15279 "" +#line 15259 "" r__1 = fnum * 10; -#line 15279 "" +#line 15259 "" i__1 = i_nint(&r__1) + 128; -#line 15279 "" +#line 15259 "" setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, & i__1); -#line 15280 "" +#line 15260 "" } -#line 15281 "" +#line 15261 "" } -#line 15282 "" +#line 15262 "" return 0; -#line 15283 "" +#line 15263 "" } /* Set signal on main note that some note at this time has ornament. ONLY used */ /* in beamstrt to activate further tests for whether ihornb is needed. */ -#line 15288 "" +#line 15268 "" *iornq = bit_set(*iornq,23); /* Isolate 21 bits defining exisiting ornaments */ -#line 15292 "" +#line 15272 "" if (*notcrd) { /* iorni = iand(4194303,iornq) */ /* iorni = iand(541065215,iornq) */ -#line 15295 "" +#line 15275 "" iorni = 1614807039 & *iornq; -#line 15296 "" +#line 15276 "" } else { -#line 15297 "" +#line 15277 "" iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1]; -#line 15298 "" +#line 15278 "" } /* korn = index('stmgx+Tupf._)e:XXX>^',charq) */ -#line 15300 "" +#line 15280 "" korn = i_indx("stmgx+Tupf._)e:XXX>^XXXXXXXXCG", charq, (ftnlen)30, ( ftnlen)1); -#line 15301 "" +#line 15281 "" if (korn != 15) { -#line 15301 "" +#line 15281 "" iorni = bit_set(iorni,korn); -#line 15301 "" +#line 15281 "" } /* Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later */ /* as follows: korn=16-18 for sfn, and or 21 for bare ?. */ /* When this if-block is done, korn will = bit# of actual ornament (unless "?"). */ -#line 15307 "" +#line 15287 "" if (korn == 15) { /* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */ @@ -36206,236 +36443,236 @@ L5: /* iorni = ior(iorni,iand(iornq0,1638383)) */ /* iorni = ior(iorni,iand(iornq0,3735535)) */ /* iorni = ior(iorni,iand(iornq0,540606447)) */ -#line 15316 "" +#line 15296 "" iorni |= *iornq0 & 1614348271; -#line 15317 "" +#line 15297 "" *ornrpt = FALSE_; -#line 15318 "" +#line 15298 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* durq will be ' ' */ -#line 15322 "" +#line 15302 "" } else if (korn == 14) { /* Editorial accidental */ -#line 15326 "" +#line 15306 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* korn = 15+index('sfn',durq) */ -#line 15328 "" +#line 15308 "" korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15; -#line 15329 "" +#line 15309 "" if (korn == 19) { -#line 15329 "" +#line 15309 "" korn = 21; -#line 15329 "" +#line 15309 "" } -#line 15330 "" +#line 15310 "" iorni = bit_set(bit_clear(iorni,14),korn); -#line 15331 "" +#line 15311 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15332 "" +#line 15312 "" if (*(unsigned char *)durq == '?') { /* This is "oe[s|f|n]?". Set 21st bit also. */ -#line 15336 "" +#line 15316 "" iorni = bit_set(iorni,21); -#line 15337 "" +#line 15317 "" korn += 6; -#line 15338 "" +#line 15318 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15339 "" +#line 15319 "" } /* iorni = ibset(ibclr(iorni,14),korn) */ -#line 15341 "" +#line 15321 "" } else if (korn == 4 && *noxtup) { /* segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points */ -#line 15345 "" +#line 15325 "" *noffseg = 0; -#line 15346 "" +#line 15326 "" negseg = FALSE_; -#line 15347 "" +#line 15327 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15348 "" +#line 15328 "" if (*(unsigned char *)durq != ' ') { /* Segno shift is specified */ -#line 15352 "" +#line 15332 "" if (*(unsigned char *)durq == '-') { -#line 15353 "" +#line 15333 "" negseg = TRUE_; -#line 15354 "" +#line 15334 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15355 "" +#line 15335 "" } -#line 15356 "" +#line 15336 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 15357 "" +#line 15337 "" *noffseg = (integer) fnum; -#line 15358 "" +#line 15338 "" if (negseg) { -#line 15358 "" +#line 15338 "" *noffseg = -(*noffseg); -#line 15358 "" +#line 15338 "" } -#line 15359 "" +#line 15339 "" } -#line 15360 "" +#line 15340 "" } else if (korn == 7) { /* Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" */ -#line 15364 "" +#line 15344 "" ++comtrill_1.ntrill; -#line 15365 "" +#line 15345 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx; -#line 15366 "" +#line 15346 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip; -#line 15367 "" +#line 15347 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f; -#line 15368 "" +#line 15348 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15369 "" +#line 15349 "" if (*(unsigned char *)durq == 't') { /* Convert to new internal symbol for non-'"tr" trill */ -#line 15373 "" +#line 15353 "" korn = 15; -#line 15374 "" +#line 15354 "" iorni = bit_set(bit_clear(iorni,7),15); -#line 15375 "" +#line 15355 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15376 "" +#line 15356 "" } -#line 15377 "" +#line 15357 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { /* We have a number for the length */ -#line 15381 "" +#line 15361 "" readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[ comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1); -#line 15382 "" +#line 15362 "" } -#line 15383 "" +#line 15363 "" } else if (korn == 10 && *noxtup) { /* Fermata */ -#line 15387 "" +#line 15367 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15388 "" +#line 15368 "" if (*(unsigned char *)durq == 'd') { -#line 15389 "" +#line 15369 "" korn = 14; -#line 15390 "" +#line 15370 "" iorni = bit_set(bit_clear(iorni,10),14); -#line 15391 "" +#line 15371 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15392 "" +#line 15372 "" } -#line 15393 "" +#line 15373 "" } else { -#line 15394 "" +#line 15374 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 15395 "" +#line 15375 "" } -#line 15396 "" +#line 15376 "" if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) { -#line 15397 "" - s_wsle(&io___881); -#line 15397 "" +#line 15377 "" + s_wsle(&io___880); +#line 15377 "" do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", ( ftnlen)41); -#line 15397 "" +#line 15377 "" do_lio(&c__9, &c__1, durq, (ftnlen)1); -#line 15397 "" +#line 15377 "" e_wsle(); -#line 15398 "" +#line 15378 "" stop1_(); -#line 15399 "" +#line 15379 "" } -#line 15400 "" +#line 15380 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Shift ornament up or down */ -#line 15404 "" +#line 15384 "" ++comtrill_1.nudorn; /* Set bit 25 in iorni as a signal. This may not really be necessary. */ -#line 15408 "" +#line 15388 "" iorni = bit_set(iorni,25); /* Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, */ /* 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present */ -#line 15413 "" +#line 15393 "" xofforn = (real) (44 - *(unsigned char *)durq); -#line 15414 "" +#line 15394 "" ++(*iccount); -#line 15415 "" +#line 15395 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 15416 "" +#line 15396 "" r__1 = xofforn * fnum; -#line 15416 "" +#line 15396 "" iofforn = i_nint(&r__1); -#line 15417 "" +#line 15397 "" comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (* nole << 12) + (korn << 19) + (iofforn + 32 << 25); -#line 15419 "" +#line 15399 "" comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx; -#line 15420 "" +#line 15400 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Horizontal shift */ -#line 15424 "" +#line 15404 "" comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set( comtrill_1.kudorn[comtrill_1.nudorn - 1],31); -#line 15425 "" +#line 15405 "" xofforn = (real) (44 - *(unsigned char *)durq); -#line 15426 "" +#line 15406 "" ++(*iccount); -#line 15427 "" +#line 15407 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); /* 141226 ornhshft(nudorn) = nint(xofforn*fnum) */ -#line 15429 "" +#line 15409 "" comtrill_1.ornhshft[comtrill_1.nudorn - 1] = xofforn * fnum; -#line 15430 "" +#line 15410 "" } -#line 15431 "" +#line 15411 "" } else if (*(unsigned char *)durq == ':') { /* Turn on repeated ornaments */ -#line 15435 "" +#line 15415 "" *ornrpt = TRUE_; /* Save the ornament value just set */ -#line 15439 "" +#line 15419 "" *iornq0 = iorni; -#line 15440 "" +#line 15420 "" } -#line 15441 "" +#line 15421 "" if (*notcrd) { -#line 15442 "" +#line 15422 "" *iornq |= iorni; -#line 15443 "" +#line 15423 "" } else { -#line 15444 "" +#line 15424 "" comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni; -#line 15445 "" +#line 15425 "" } -#line 15446 "" +#line 15426 "" return 0; } /* getorn_ */ @@ -36471,9 +36708,9 @@ L5: static char lnholdq[128]; /* Fortran I/O blocks */ - static cilist io___887 = { 0, 6, 0, 0, 0 }; - static cilist io___888 = { 0, 15, 0, "()", 0 }; - static cilist io___892 = { 0, 18, 1, "(a)", 0 }; + static cilist io___886 = { 0, 6, 0, 0, 0 }; + static cilist io___887 = { 0, 15, 0, "()", 0 }; + static cilist io___891 = { 0, 18, 1, "(a)", 0 }; @@ -36496,410 +36733,410 @@ L5: /* ipbufmod = points to last character of most recent inserted line */ /* from pmx.mod */ -#line 15480 "" +#line 15460 "" c1omget_1.line1pmxmod = inbuff_1.ilbuf; -#line 15481 "" +#line 15461 "" if (! (*global)) { -#line 15482 "" +#line 15462 "" ioin__1.inerr = 0; -#line 15482 "" +#line 15462 "" ioin__1.infilen = includeq_len; -#line 15482 "" +#line 15462 "" ioin__1.infile = includeq; -#line 15482 "" +#line 15462 "" ioin__1.inex = &fexist; -#line 15482 "" +#line 15462 "" ioin__1.inopen = 0; -#line 15482 "" +#line 15462 "" ioin__1.innum = 0; -#line 15482 "" +#line 15462 "" ioin__1.innamed = 0; -#line 15482 "" +#line 15462 "" ioin__1.inname = 0; -#line 15482 "" +#line 15462 "" ioin__1.inacc = 0; -#line 15482 "" +#line 15462 "" ioin__1.inseq = 0; -#line 15482 "" +#line 15462 "" ioin__1.indir = 0; -#line 15482 "" +#line 15462 "" ioin__1.infmt = 0; -#line 15482 "" +#line 15462 "" ioin__1.inform = 0; -#line 15482 "" +#line 15462 "" ioin__1.inunf = 0; -#line 15482 "" +#line 15462 "" ioin__1.inrecl = 0; -#line 15482 "" +#line 15462 "" ioin__1.innrec = 0; -#line 15482 "" +#line 15462 "" ioin__1.inblank = 0; -#line 15482 "" +#line 15462 "" f_inqu(&ioin__1); /* Transfer includeq to temporary char variable with known length */ -#line 15486 "" +#line 15466 "" s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len); -#line 15487 "" +#line 15467 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); -#line 15488 "" - s_wsle(&io___887); -#line 15488 "" +#line 15468 "" + s_wsle(&io___886); +#line 15468 "" e_wsle(); -#line 15489 "" - s_wsfe(&io___888); -#line 15489 "" +#line 15469 "" + s_wsfe(&io___887); +#line 15469 "" e_wsfe(); -#line 15490 "" +#line 15470 "" if (! fexist) { /* Writing concatenation */ -#line 15491 "" +#line 15471 "" i__1[0] = 15, a__1[0] = "Could not find "; -#line 15491 "" +#line 15471 "" i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; -#line 15491 "" +#line 15471 "" i__1[2] = 19, a__1[2] = ", checking further."; -#line 15491 "" +#line 15471 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114); -#line 15491 "" +#line 15471 "" printl_(ch__1, lpmxmoddirq + 34); /* File named includeq doesn't not exist. Get directory from PMXMODDIR and */ /* see if it's there */ -#line 15497 "" +#line 15477 "" getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); -#line 15498 "" +#line 15478 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); -#line 15499 "" +#line 15479 "" if (lpmxmoddirq > 0) { /* Writing concatenation */ -#line 15500 "" +#line 15480 "" i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; -#line 15500 "" +#line 15480 "" i__2[1] = includeq_len, a__2[1] = includeq; -#line 15500 "" +#line 15480 "" s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); -#line 15501 "" +#line 15481 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); -#line 15502 "" +#line 15482 "" } else { -#line 15503 "" +#line 15483 "" printl_("No other directory defined by PMXMODDIR, stopping", ( ftnlen)49); -#line 15505 "" +#line 15485 "" stop1_(); -#line 15506 "" +#line 15486 "" } -#line 15507 "" +#line 15487 "" ioin__1.inerr = 0; -#line 15507 "" +#line 15487 "" ioin__1.infilen = 80; -#line 15507 "" +#line 15487 "" ioin__1.infile = pmxmoddirq; -#line 15507 "" +#line 15487 "" ioin__1.inex = &fexist; -#line 15507 "" +#line 15487 "" ioin__1.inopen = 0; -#line 15507 "" +#line 15487 "" ioin__1.innum = 0; -#line 15507 "" +#line 15487 "" ioin__1.innamed = 0; -#line 15507 "" +#line 15487 "" ioin__1.inname = 0; -#line 15507 "" +#line 15487 "" ioin__1.inacc = 0; -#line 15507 "" +#line 15487 "" ioin__1.inseq = 0; -#line 15507 "" +#line 15487 "" ioin__1.indir = 0; -#line 15507 "" +#line 15487 "" ioin__1.infmt = 0; -#line 15507 "" +#line 15487 "" ioin__1.inform = 0; -#line 15507 "" +#line 15487 "" ioin__1.inunf = 0; -#line 15507 "" +#line 15487 "" ioin__1.inrecl = 0; -#line 15507 "" +#line 15487 "" ioin__1.innrec = 0; -#line 15507 "" +#line 15487 "" ioin__1.inblank = 0; -#line 15507 "" +#line 15487 "" f_inqu(&ioin__1); -#line 15508 "" +#line 15488 "" if (! fexist) { /* Writing concatenation */ -#line 15509 "" +#line 15489 "" i__1[0] = 15, a__1[0] = "Could not find "; -#line 15509 "" +#line 15489 "" i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; -#line 15509 "" +#line 15489 "" i__1[2] = 11, a__1[2] = ", stopping."; -#line 15509 "" +#line 15489 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106); -#line 15509 "" +#line 15489 "" printl_(ch__2, lpmxmoddirq + 26); -#line 15511 "" +#line 15491 "" stop1_(); -#line 15512 "" +#line 15492 "" } -#line 15513 "" +#line 15493 "" } /* Writing concatenation */ -#line 15514 "" +#line 15494 "" i__2[0] = 28, a__2[0] = "Opening normal include file "; -#line 15514 "" +#line 15494 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; -#line 15514 "" +#line 15494 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); -#line 15514 "" +#line 15494 "" printl_(ch__3, lpmxmoddirq + 28); -#line 15516 "" +#line 15496 "" o__1.oerr = 0; -#line 15516 "" +#line 15496 "" o__1.ounit = 18; -#line 15516 "" +#line 15496 "" o__1.ofnmlen = 80; -#line 15516 "" +#line 15496 "" o__1.ofnm = pmxmoddirq; -#line 15516 "" +#line 15496 "" o__1.orl = 0; -#line 15516 "" +#line 15496 "" o__1.osta = 0; -#line 15516 "" +#line 15496 "" o__1.oacc = 0; -#line 15516 "" +#line 15496 "" o__1.ofm = 0; -#line 15516 "" +#line 15496 "" o__1.oblnk = 0; -#line 15516 "" +#line 15496 "" f_open(&o__1); -#line 15517 "" +#line 15497 "" } else { /* Check for existence of pmx.mod */ -#line 15521 "" +#line 15501 "" getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); -#line 15522 "" +#line 15502 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); -#line 15523 "" +#line 15503 "" if (lpmxmoddirq == 0) { -#line 15523 "" +#line 15503 "" return 0; -#line 15523 "" +#line 15503 "" } /* Writing concatenation */ -#line 15524 "" +#line 15504 "" i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; -#line 15524 "" +#line 15504 "" i__2[1] = 7, a__2[1] = "pmx.mod"; -#line 15524 "" +#line 15504 "" s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); -#line 15525 "" +#line 15505 "" lpmxmoddirq += 7; -#line 15526 "" +#line 15506 "" ioin__1.inerr = 0; -#line 15526 "" +#line 15506 "" ioin__1.infilen = 80; -#line 15526 "" +#line 15506 "" ioin__1.infile = pmxmoddirq; -#line 15526 "" +#line 15506 "" ioin__1.inex = &fexist; -#line 15526 "" +#line 15506 "" ioin__1.inopen = 0; -#line 15526 "" +#line 15506 "" ioin__1.innum = 0; -#line 15526 "" +#line 15506 "" ioin__1.innamed = 0; -#line 15526 "" +#line 15506 "" ioin__1.inname = 0; -#line 15526 "" +#line 15506 "" ioin__1.inacc = 0; -#line 15526 "" +#line 15506 "" ioin__1.inseq = 0; -#line 15526 "" +#line 15506 "" ioin__1.indir = 0; -#line 15526 "" +#line 15506 "" ioin__1.infmt = 0; -#line 15526 "" +#line 15506 "" ioin__1.inform = 0; -#line 15526 "" +#line 15506 "" ioin__1.inunf = 0; -#line 15526 "" +#line 15506 "" ioin__1.inrecl = 0; -#line 15526 "" +#line 15506 "" ioin__1.innrec = 0; -#line 15526 "" +#line 15506 "" ioin__1.inblank = 0; -#line 15526 "" +#line 15506 "" f_inqu(&ioin__1); -#line 15527 "" +#line 15507 "" if (! fexist) { -#line 15527 "" +#line 15507 "" return 0; -#line 15527 "" +#line 15507 "" } /* Writing concatenation */ -#line 15528 "" +#line 15508 "" i__2[0] = 28, a__2[0] = "Opening global include file "; -#line 15528 "" +#line 15508 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; -#line 15528 "" +#line 15508 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); -#line 15528 "" +#line 15508 "" printl_(ch__3, lpmxmoddirq + 28); -#line 15530 "" +#line 15510 "" o__1.oerr = 0; -#line 15530 "" +#line 15510 "" o__1.ounit = 18; -#line 15530 "" +#line 15510 "" o__1.ofnmlen = lpmxmoddirq; -#line 15530 "" +#line 15510 "" o__1.ofnm = pmxmoddirq; -#line 15530 "" +#line 15510 "" o__1.orl = 0; -#line 15530 "" +#line 15510 "" o__1.osta = 0; -#line 15530 "" +#line 15510 "" o__1.oacc = 0; -#line 15530 "" +#line 15510 "" o__1.ofm = 0; -#line 15530 "" +#line 15510 "" o__1.oblnk = 0; -#line 15530 "" +#line 15510 "" f_open(&o__1); -#line 15531 "" +#line 15511 "" } -#line 15532 "" +#line 15512 "" printl_("Adding include data", (ftnlen)19); /* Read lines in from pmx.mod one at a time */ -#line 15536 "" +#line 15516 "" ipbufmod = inbuff_1.ipbuf; -#line 15537 "" +#line 15517 "" lenbufmod = c1omget_1.lenbuf0; -#line 15538 "" +#line 15518 "" for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 9600; ++ilbufmod) { -#line 15539 "" - i__3 = s_rsfe(&io___892); -#line 15539 "" +#line 15519 "" + i__3 = s_rsfe(&io___891); +#line 15519 "" if (i__3 != 0) { -#line 15539 "" +#line 15519 "" goto L3; -#line 15539 "" +#line 15519 "" } -#line 15539 "" +#line 15519 "" i__3 = do_fio(&c__1, lnholdq, (ftnlen)128); -#line 15539 "" +#line 15519 "" if (i__3 != 0) { -#line 15539 "" +#line 15519 "" goto L3; -#line 15539 "" +#line 15519 "" } -#line 15539 "" +#line 15519 "" i__3 = e_rsfe(); -#line 15539 "" +#line 15519 "" if (i__3 != 0) { -#line 15539 "" +#line 15519 "" goto L3; -#line 15539 "" +#line 15519 "" } /* A line was read. Slide all existing lengths from here forward ahead by 1 */ -#line 15543 "" +#line 15523 "" i__3 = ilbufmod; -#line 15543 "" +#line 15523 "" for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) { -#line 15544 "" +#line 15524 "" inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1]; -#line 15545 "" +#line 15525 "" /* L2: */ -#line 15545 "" +#line 15525 "" } /* Get length of line from include file */ -#line 15549 "" +#line 15529 "" lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128); -#line 15550 "" +#line 15530 "" if (lenmodline == 0) { /* Blank line. Make it a single blank with length 1 */ -#line 15554 "" +#line 15534 "" lenmodline = 1; -#line 15555 "" +#line 15535 "" s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); -#line 15556 "" +#line 15536 "" } -#line 15557 "" +#line 15537 "" inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline; -#line 15558 "" +#line 15538 "" printl_(lnholdq, lenmodline); /* Insert new stuff into bufq */ -#line 15562 "" +#line 15542 "" i__3 = ipbufmod; /* Writing concatenation */ -#line 15562 "" +#line 15542 "" i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq; -#line 15562 "" +#line 15542 "" i__1[1] = lenmodline, a__1[1] = lnholdq; -#line 15562 "" +#line 15542 "" i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3; -#line 15562 "" +#line 15542 "" s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)131072); /* Update internal parameters */ -#line 15567 "" +#line 15547 "" ipbufmod += inbuff_1.lbuf[ilbufmod - 1]; -#line 15568 "" +#line 15548 "" lenbufmod += inbuff_1.lbuf[ilbufmod - 1]; -#line 15569 "" +#line 15549 "" ++inbuff_1.nlbuf; -#line 15570 "" +#line 15550 "" /* L1: */ -#line 15570 "" +#line 15550 "" } -#line 15571 "" +#line 15551 "" L3: /* Writing concatenation */ -#line 15572 "" +#line 15552 "" i__2[0] = 8, a__2[0] = "Closing "; -#line 15572 "" +#line 15552 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; -#line 15572 "" +#line 15552 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88); -#line 15572 "" +#line 15552 "" printl_(ch__4, lpmxmoddirq + 8); -#line 15573 "" +#line 15553 "" cl__1.cerr = 0; -#line 15573 "" +#line 15553 "" cl__1.cunit = 18; -#line 15573 "" +#line 15553 "" cl__1.csta = 0; -#line 15573 "" +#line 15553 "" f_clos(&cl__1); -#line 15574 "" +#line 15554 "" c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod - inbuff_1.ilbuf; -#line 15575 "" +#line 15555 "" c1omget_1.lenbuf0 = lenbufmod; /* Fix Andre's error reporting problem 101211 leading to log(neg#) due */ /* to nline being 2 bigger than it should be */ -#line 15580 "" +#line 15560 "" c1omget_1.nline += -2; -#line 15582 "" +#line 15562 "" return 0; } /* getpmxmod_ */ @@ -36913,6 +37150,7 @@ L3: /* System generated locals */ integer i__1, i__2; real r__1; + char ch__1[1]; olist o__1; /* Builtin functions */ @@ -36921,7 +37159,9 @@ L3: i_nint(real *), i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ - static integer i__, iv, ivi, ipos, nline; + static integer i__, iv, ivi; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer ipos, nline; static char lineq[128]; static integer iinst, jinst; extern doublereal readin_(char *, integer *, integer *, ftnlen); @@ -36930,144 +37170,144 @@ L3: static integer iccount, nvsofar; /* Fortran I/O blocks */ - static cilist io___898 = { 0, 17, 0, "(a)", 0 }; + static cilist io___897 = { 0, 17, 0, "(a)", 0 }; /* Get the first line */ -#line 15598 "" +#line 15578 "" /* Parameter adjustments */ -#line 15598 "" +#line 15578 "" --sepsymq; -#line 15598 "" +#line 15578 "" --clefq; -#line 15598 "" +#line 15578 "" inameq -= 79; -#line 15598 "" +#line 15578 "" -#line 15598 "" +#line 15578 "" /* Function Body */ -#line 15598 "" +#line 15578 "" iccount = 0; -#line 15599 "" +#line 15579 "" L9: -#line 15599 "" +#line 15579 "" getbuf_(lineq, (ftnlen)128); -#line 15600 "" +#line 15580 "" if (*(unsigned char *)lineq == '%') { -#line 15600 "" +#line 15580 "" goto L9; -#line 15600 "" +#line 15580 "" } -#line 15601 "" +#line 15581 "" *istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0; -#line 15602 "" +#line 15582 "" if (*istype0) { /* Have TeX input until next line that starts with '---'. Save in scratch. */ -#line 15606 "" +#line 15586 "" o__1.oerr = 0; -#line 15606 "" +#line 15586 "" o__1.ounit = 17; -#line 15606 "" +#line 15586 "" o__1.ofnm = 0; -#line 15606 "" +#line 15586 "" o__1.orl = 0; -#line 15606 "" +#line 15586 "" o__1.osta = "SCRATCH"; -#line 15606 "" +#line 15586 "" o__1.oacc = 0; -#line 15606 "" +#line 15586 "" o__1.ofm = 0; -#line 15606 "" +#line 15586 "" o__1.oblnk = 0; -#line 15606 "" +#line 15586 "" f_open(&o__1); -#line 15607 "" +#line 15587 "" L3: -#line 15607 "" +#line 15587 "" getbuf_(lineq, (ftnlen)128); -#line 15608 "" +#line 15588 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { -#line 15609 "" - s_wsfe(&io___898); -#line 15609 "" +#line 15589 "" + s_wsfe(&io___897); +#line 15589 "" do_fio(&c__1, lineq, (ftnlen)128); -#line 15609 "" +#line 15589 "" e_wsfe(); -#line 15610 "" +#line 15590 "" goto L3; -#line 15611 "" +#line 15591 "" } /* Force a new line read on first call to readin */ -#line 15615 "" +#line 15595 "" iccount = 128; -#line 15616 "" +#line 15596 "" } /* Here, lineq is first line w/ numerical setup data. */ -#line 15620 "" +#line 15600 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15620 "" +#line 15600 "" *nv = i_nint(&r__1); -#line 15621 "" +#line 15601 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15621 "" +#line 15601 "" *noinst = i_nint(&r__1); -#line 15622 "" +#line 15602 "" newway = *noinst <= 0; -#line 15623 "" +#line 15603 "" if (newway) { -#line 15623 "" +#line 15603 "" *noinst = -(*noinst); -#line 15623 "" +#line 15603 "" } -#line 15624 "" +#line 15604 "" i__1 = *noinst; -#line 15624 "" +#line 15604 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* Seve # of staves per inst in case later drop some inst's. */ -#line 15628 "" +#line 15608 "" if (newway) { /* Read in nvi for each instrument */ -#line 15632 "" +#line 15612 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15632 "" +#line 15612 "" comnvi_1.nsperi[iinst - 1] = i_nint(&r__1); -#line 15633 "" +#line 15613 "" } else if (iinst > 1) { -#line 15634 "" +#line 15614 "" comnvi_1.nsperi[iinst - 1] = 1; -#line 15635 "" +#line 15615 "" } else { -#line 15636 "" +#line 15616 "" comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1; -#line 15637 "" +#line 15617 "" } -#line 15638 "" +#line 15618 "" comnvi_1.iiorig[iinst - 1] = iinst; -#line 15639 "" +#line 15619 "" comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1]; -#line 15640 "" +#line 15620 "" /* L2: */ -#line 15640 "" +#line 15620 "" } -#line 15641 "" +#line 15621 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15641 "" +#line 15621 "" *mtrnuml = i_nint(&r__1); -#line 15642 "" +#line 15622 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15642 "" +#line 15622 "" *mtrdenl = i_nint(&r__1); /* c */ /* c Kluge to make mtrdenl work */ @@ -37076,147 +37316,147 @@ L3: /* mtrdenl = 2 */ /* mtrnuml = mtrnuml*2 */ /* end if */ -#line 15650 "" +#line 15630 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15650 "" +#line 15630 "" *mtrnmp = i_nint(&r__1); -#line 15651 "" +#line 15631 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15651 "" +#line 15631 "" *mtrdnp = i_nint(&r__1); -#line 15652 "" +#line 15632 "" *xmtrnum0 = readin_(lineq, &iccount, &nline, (ftnlen)128); /* Original key sig (before any trnasposition) in next position. Transposed */ /* sig for topfile was transferred thru pmxtex.dat. Need isig0 for key */ /* changes if transposed. */ -#line 15658 "" +#line 15638 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15658 "" +#line 15638 "" *isig0 = i_nint(&r__1); /* 130316 */ /* do 11 iinst = 1 , noinst */ /* midisig(iinst) = isig0 */ -#line 15662 "" +#line 15642 "" commidisig_1.midisig = *isig0; /* 11 continue */ -#line 15664 "" +#line 15644 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15664 "" +#line 15644 "" *npages = i_nint(&r__1); -#line 15665 "" +#line 15645 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15665 "" +#line 15645 "" *nsyst = i_nint(&r__1); -#line 15666 "" +#line 15646 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); -#line 15666 "" +#line 15646 "" *musicsize = i_nint(&r__1); -#line 15667 "" +#line 15647 "" *fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128); /* Next noinst non-comment lines are names of instruments. */ -#line 15671 "" +#line 15651 "" i__1 = *noinst; -#line 15671 "" +#line 15651 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 15672 "" +#line 15652 "" L5: -#line 15672 "" +#line 15652 "" getbuf_(inameq + i__ * 79, (ftnlen)79); -#line 15673 "" +#line 15653 "" if (*(unsigned char *)&inameq[i__ * 79] == '%') { -#line 15673 "" +#line 15653 "" goto L5; -#line 15673 "" +#line 15653 "" } -#line 15674 "" +#line 15654 "" /* L4: */ -#line 15674 "" +#line 15654 "" } /* Next non-comment line has nv clef names */ -#line 15678 "" +#line 15658 "" L6: -#line 15678 "" +#line 15658 "" getbuf_(lineq, (ftnlen)128); -#line 15679 "" +#line 15659 "" if (*(unsigned char *)lineq == '%') { -#line 15679 "" +#line 15659 "" goto L6; -#line 15679 "" +#line 15659 "" } -#line 15680 "" +#line 15660 "" iv = 0; -#line 15681 "" +#line 15661 "" nvsofar = 0; -#line 15682 "" +#line 15662 "" i__1 = *noinst; -#line 15682 "" +#line 15662 "" for (jinst = 1; jinst <= i__1; ++jinst) { -#line 15683 "" +#line 15663 "" nvsofar += comnvi_1.nsperi[jinst - 1]; -#line 15684 "" +#line 15664 "" i__2 = comnvi_1.nsperi[jinst - 1]; -#line 15684 "" +#line 15664 "" for (ivi = 1; ivi <= i__2; ++ivi) { -#line 15685 "" +#line 15665 "" ++iv; -#line 15686 "" +#line 15666 "" *(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1]; -#line 15687 "" +#line 15667 "" if (iv == nvsofar) { -#line 15688 "" +#line 15668 "" *(unsigned char *)&sepsymq[iv] = '&'; -#line 15689 "" +#line 15669 "" } else { -#line 15690 "" +#line 15670 "" *(unsigned char *)&sepsymq[iv] = '|'; -#line 15691 "" +#line 15671 "" } -#line 15692 "" +#line 15672 "" /* L10: */ -#line 15692 "" +#line 15672 "" } -#line 15693 "" +#line 15673 "" /* L1: */ -#line 15693 "" +#line 15673 "" } /* Mext non-comment line has path name */ -#line 15697 "" +#line 15677 "" L8: -#line 15697 "" +#line 15677 "" getbuf_(pathnameq, (ftnlen)40); -#line 15698 "" +#line 15678 "" if (*(unsigned char *)pathnameq == '%') { -#line 15698 "" +#line 15678 "" goto L8; -#line 15698 "" +#line 15678 "" } -#line 15699 "" +#line 15679 "" *lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1; - -/* 160130 Replace '\' by '/' */ - -#line 15703 "" +#line 15680 "" L12: -#line 15703 "" - ipos = i_indx(pathnameq, "\\", (ftnlen)40, (ftnlen)1); -#line 15704 "" +#line 15680 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15680 "" + ipos = i_indx(pathnameq, ch__1, (ftnlen)40, (ftnlen)1); +#line 15681 "" if (ipos > 0) { -#line 15705 "" - *(unsigned char *)&pathnameq[ipos - 1] = '/'; -/* print*,'Changed pathname to ',pathnameq(1:lpath) */ -#line 15707 "" +#line 15682 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 15682 "" + *(unsigned char *)&pathnameq[ipos - 1] = *(unsigned char *)&ch__1[0]; +#line 15683 "" goto L12; -#line 15708 "" +#line 15684 "" } -#line 15709 "" +#line 15685 "" return 0; } /* getset_ */ @@ -37240,55 +37480,55 @@ doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote, /* Since notes are ordered by increasing start times, as soon as we find one */ /* that starts too late, we are done checking. */ -#line 15723 "" +#line 15699 "" /* Parameter adjustments */ -#line 15723 "" +#line 15699 "" --to; -#line 15723 "" +#line 15699 "" --tnote; -#line 15723 "" +#line 15699 "" -#line 15723 "" +#line 15699 "" /* Function Body */ -#line 15723 "" +#line 15699 "" tgovern = 1e3f; -#line 15724 "" +#line 15700 "" tend = to[*n] + *space; -#line 15725 "" +#line 15701 "" i__1 = *ntot; -#line 15725 "" +#line 15701 "" for (in = 1; in <= i__1; ++in) { /* Since to() is ordered by start times, exit loop after first note that */ /* starts later than note of interest. */ -#line 15730 "" +#line 15706 "" if (to[in] > to[*n] + comtol_1.tol) { -#line 15730 "" +#line 15706 "" goto L2; -#line 15730 "" +#line 15706 "" } -#line 15731 "" +#line 15707 "" if (to[in] + tnote[in] > tend - comtol_1.tol) { /* If here, this note overlaps and must be tested. */ /* Computing MIN */ -#line 15735 "" +#line 15711 "" r__1 = tgovern, r__2 = tnote[in]; -#line 15735 "" +#line 15711 "" tgovern = dmin(r__1,r__2); -#line 15736 "" +#line 15712 "" } -#line 15737 "" +#line 15713 "" /* L1: */ -#line 15737 "" +#line 15713 "" } -#line 15738 "" +#line 15714 "" L2: -#line 15739 "" +#line 15715 "" ret_val = *space / tgovern; -#line 15740 "" +#line 15716 "" return ret_val; } /* getsquez_ */ @@ -37319,140 +37559,140 @@ L2: /* during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if */ /* not in xtup. */ -#line 15756 "" +#line 15732 "" colon = FALSE_; -#line 15757 "" +#line 15733 "" ess = FALSE_; -#line 15758 "" +#line 15734 "" number = FALSE_; -#line 15759 "" +#line 15735 "" nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount - 1), (ftnlen)1) - 1; -#line 15760 "" +#line 15736 "" if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen) 1) > 0) { /* "Parts only", ignore entire symbol */ -#line 15764 "" +#line 15740 "" *iccount = nextbl; -#line 15765 "" +#line 15741 "" return 0; -#line 15766 "" +#line 15742 "" } -#line 15767 "" +#line 15743 "" L1: -#line 15767 "" +#line 15743 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 15768 "" +#line 15744 "" if (*(unsigned char *)charq == 'B') { /* "Both parts and score," ignore character */ -#line 15772 "" +#line 15748 "" goto L1; -#line 15773 "" +#line 15749 "" } else if (*(unsigned char *)charq == ':') { -#line 15774 "" +#line 15750 "" colon = TRUE_; -#line 15775 "" +#line 15751 "" goto L1; -#line 15776 "" +#line 15752 "" } else if (*(unsigned char *)charq == 'S') { -#line 15777 "" +#line 15753 "" ess = TRUE_; -#line 15778 "" +#line 15754 "" goto L1; -#line 15779 "" +#line 15755 "" } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { -#line 15780 "" +#line 15756 "" number = TRUE_; -#line 15781 "" +#line 15757 "" if (*(unsigned char *)charq == '-') { -#line 15781 "" +#line 15757 "" ++(*iccount); -#line 15781 "" +#line 15757 "" } -#line 15782 "" +#line 15758 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 15783 "" +#line 15759 "" if (*(unsigned char *)charq == '-') { -#line 15783 "" +#line 15759 "" fnum = -fnum; -#line 15783 "" +#line 15759 "" } -#line 15784 "" +#line 15760 "" if (*(unsigned char *)durq != 'p') { -#line 15785 "" +#line 15761 "" fnum *= *wheadpt; -#line 15786 "" +#line 15762 "" --(*iccount); -#line 15787 "" +#line 15763 "" } -#line 15788 "" +#line 15764 "" goto L1; -#line 15789 "" +#line 15765 "" } /* charq must be blank, so done parsing */ -#line 15793 "" +#line 15769 "" if (! ess && ! colon) { /* Ordinary hardspace. Goes before next note. */ /* (Later, at "|" or "/", check for presence and switch to udoff if there!) */ -#line 15798 "" +#line 15774 "" ++comudsp_1.nudsp; -#line 15799 "" +#line 15775 "" *iornq1 = bit_set(*iornq1,26); -#line 15800 "" +#line 15776 "" comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum; -#line 15801 "" +#line 15777 "" comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar); -#line 15802 "" +#line 15778 "" if (*ntup > 0) { -#line 15802 "" +#line 15778 "" comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + * ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1); -#line 15802 "" +#line 15778 "" } /* * +float(itup-1)/ntup*ifnodur(nnodur,dotq) */ -#line 15805 "" +#line 15781 "" } else if (! number) { /* Must be "X:" End a group offset. */ -#line 15809 "" +#line 15785 "" *irest = bit_set(*irest,17); -#line 15810 "" +#line 15786 "" *shifton = FALSE_; -#line 15811 "" +#line 15787 "" return 0; -#line 15812 "" +#line 15788 "" } else { /* Only other possibility is start offset, "S" for single, ':' for multiple */ -#line 15816 "" +#line 15792 "" ++comudsp_1.nudoff[*ivx - 1]; -#line 15817 "" +#line 15793 "" comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum; -#line 15818 "" +#line 15794 "" if (ess) { -#line 15819 "" +#line 15795 "" *irest1 = bit_set(*irest1,15); -#line 15820 "" +#line 15796 "" } else { -#line 15821 "" +#line 15797 "" *irest1 = bit_set(*irest1,16); -#line 15822 "" +#line 15798 "" *shifton = TRUE_; -#line 15823 "" +#line 15799 "" } -#line 15824 "" +#line 15800 "" } -#line 15825 "" +#line 15801 "" return 0; } /* getx_ */ @@ -37469,75 +37709,75 @@ integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len) extern /* Subroutine */ int stop1_(void); /* Fortran I/O blocks */ + static cilist io___917 = { 0, 6, 0, 0, 0 }; static cilist io___918 = { 0, 6, 0, 0, 0 }; - static cilist io___919 = { 0, 6, 0, 0, 0 }; -#line 15829 "" +#line 15805 "" if (*idur == 6) { -#line 15830 "" +#line 15806 "" ret_val = 1; -#line 15831 "" +#line 15807 "" } else if (*idur == 3) { -#line 15832 "" +#line 15808 "" ret_val = 2; -#line 15833 "" +#line 15809 "" } else if (*idur == 1) { -#line 15834 "" +#line 15810 "" ret_val = 4; -#line 15835 "" +#line 15811 "" } else if (*idur == 8) { -#line 15836 "" +#line 15812 "" ret_val = 8; -#line 15837 "" +#line 15813 "" } else if (*idur == 4) { -#line 15838 "" +#line 15814 "" ret_val = 16; -#line 15839 "" +#line 15815 "" } else if (*idur == 2) { -#line 15840 "" +#line 15816 "" ret_val = 32; -#line 15841 "" +#line 15817 "" } else if (*idur == 0) { -#line 15842 "" +#line 15818 "" ret_val = 64; -#line 15843 "" +#line 15819 "" } else if (*idur == 16) { /* Only used for denominator of time signatures, not for notes */ -#line 15847 "" +#line 15823 "" ret_val = 4; -#line 15848 "" +#line 15824 "" } else if (*idur == 9) { -#line 15849 "" +#line 15825 "" ret_val = 128; -#line 15850 "" +#line 15826 "" } else { -#line 15851 "" - s_wsle(&io___918); -#line 15851 "" +#line 15827 "" + s_wsle(&io___917); +#line 15827 "" e_wsle(); -#line 15852 "" - s_wsle(&io___919); -#line 15852 "" +#line 15828 "" + s_wsle(&io___918); +#line 15828 "" do_lio(&c__9, &c__1, "You entered an invalid note-length value:", ( ftnlen)41); -#line 15852 "" +#line 15828 "" do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer)); -#line 15852 "" +#line 15828 "" e_wsle(); -#line 15853 "" +#line 15829 "" stop1_(); -#line 15854 "" +#line 15830 "" } -#line 15855 "" +#line 15831 "" if (*(unsigned char *)dotq == 'd') { -#line 15855 "" +#line 15831 "" ret_val = ret_val * 3 / 2; -#line 15855 "" +#line 15831 "" } -#line 15856 "" +#line 15832 "" return ret_val; } /* i1fnodur_ */ @@ -37555,9 +37795,9 @@ integer iashft_(integer *nacc) /* System generated locals */ integer ret_val; -#line 15866 "" +#line 15842 "" ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4]; -#line 15867 "" +#line 15843 "" return ret_val; } /* iashft_ */ @@ -37572,67 +37812,67 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) /* Subroutine */ int s_stop(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___921 = { 0, 6, 0, 0, 0 }; + static cilist io___920 = { 0, 6, 0, 0, 0 }; -#line 15871 "" +#line 15847 "" if (*idur == 6) { -#line 15872 "" +#line 15848 "" ret_val = 1; -#line 15873 "" +#line 15849 "" } else if (*idur == 3) { -#line 15874 "" +#line 15850 "" ret_val = 2; -#line 15875 "" +#line 15851 "" } else if (*idur == 1) { -#line 15876 "" +#line 15852 "" ret_val = 4; -#line 15877 "" +#line 15853 "" } else if (*idur == 8) { -#line 15878 "" +#line 15854 "" ret_val = 8; -#line 15879 "" +#line 15855 "" } else if (*idur == 4) { -#line 15880 "" +#line 15856 "" ret_val = 16; -#line 15881 "" +#line 15857 "" } else if (*idur == 2) { -#line 15882 "" +#line 15858 "" ret_val = 32; -#line 15883 "" +#line 15859 "" } else if (*idur == 0) { -#line 15884 "" +#line 15860 "" ret_val = 64; -#line 15885 "" +#line 15861 "" } else if (*idur == 9) { -#line 15886 "" +#line 15862 "" ret_val = 128; -#line 15887 "" +#line 15863 "" } else if (*idur == 16) { /* Only used for denominator of time signatures, not for notes */ -#line 15891 "" +#line 15867 "" ret_val = 4; -#line 15892 "" +#line 15868 "" } else { -#line 15893 "" - s_wsle(&io___921); -#line 15893 "" +#line 15869 "" + s_wsle(&io___920); +#line 15869 "" do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33); -#line 15893 "" +#line 15869 "" e_wsle(); -#line 15894 "" +#line 15870 "" s_stop("", (ftnlen)0); -#line 15895 "" +#line 15871 "" } -#line 15896 "" +#line 15872 "" if (*(unsigned char *)dotq == 'd') { -#line 15896 "" +#line 15872 "" ret_val = ret_val * 3 / 2; -#line 15896 "" +#line 15872 "" } -#line 15897 "" +#line 15873 "" return ret_val; } /* ifnodur_ */ @@ -37641,9 +37881,9 @@ integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len) /* System generated locals */ integer ret_val; -#line 15902 "" +#line 15878 "" ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans; -#line 15903 "" +#line 15879 "" return ret_val; } /* ifnolev_ */ @@ -37687,9 +37927,9 @@ integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift) /* Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */ /* then added to ioff */ -#line 15938 "" +#line 15914 "" ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift)); -#line 15939 "" +#line 15915 "" return ret_val; } /* igetbits_ */ @@ -37705,6 +37945,7 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer * /* Local variables */ extern /* Subroutine */ int stop1_(void); + static integer mmidi4; /* Fortran I/O blocks */ static cilist io___922 = { 0, 6, 0, 0, 0 }; @@ -37713,40 +37954,43 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer * /* Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */ -#line 15947 "" +#line 15923 "" /* Parameter adjustments */ -#line 15947 "" +#line 15923 "" mmidi -= 25; -#line 15947 "" +#line 15923 "" -#line 15947 "" +#line 15923 "" /* Function Body */ -#line 15947 "" +#line 15923 "" ret_val = 0; -#line 15948 "" +#line 15924 "" for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { -#line 15949 "" - ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) * - 25]); -#line 15951 "" - if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) { -#line 15951 "" +#line 15925 "" + mmidi4 = mmidi[*icm + (*imidi + *nbytes) * 25]; +#line 15926 "" + ret_val = (ret_val << 7) + (127 & mmidi4); +/* * +iand(127,mmidi(icm,imidi+nbytes)) */ +/* if (.not.btest(mmidi(icm,imidi+nbytes),7)) return */ +#line 15930 "" + if (! bit_test(mmidi4,7)) { +#line 15930 "" return ret_val; -#line 15951 "" +#line 15930 "" } -#line 15952 "" +#line 15931 "" /* L1: */ -#line 15952 "" +#line 15931 "" } -#line 15953 "" +#line 15932 "" s_wsle(&io___922); -#line 15953 "" +#line 15932 "" do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20); -#line 15953 "" +#line 15932 "" e_wsle(); -#line 15954 "" +#line 15933 "" stop1_(); -#line 15955 "" +#line 15934 "" return ret_val; } /* igetvarlen_ */ @@ -37763,41 +38007,41 @@ logical isdotted_(integer *nodur, integer *ivx, integer *ip) /* Function returns true if note is dotted or double-dotted. */ /* Return false for any xtuplet. */ -#line 15964 "" +#line 15943 "" /* Parameter adjustments */ -#line 15964 "" +#line 15943 "" nodur -= 25; -#line 15964 "" +#line 15943 "" -#line 15964 "" +#line 15943 "" /* Function Body */ -#line 15964 "" +#line 15943 "" if (nodur[*ivx + *ip * 24] == 0) { -#line 15965 "" +#line 15944 "" ret_val = FALSE_; -#line 15966 "" +#line 15945 "" return ret_val; -#line 15967 "" +#line 15946 "" } else if (*ip > 1) { -#line 15968 "" +#line 15947 "" if (nodur[*ivx + (*ip - 1) * 24] == 0) { -#line 15969 "" +#line 15948 "" ret_val = FALSE_; -#line 15970 "" +#line 15949 "" return ret_val; -#line 15971 "" +#line 15950 "" } -#line 15972 "" +#line 15951 "" } /* Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */ -#line 15976 "" +#line 15955 "" r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol * .5f; -#line 15976 "" +#line 15955 "" ret_val = r_mod(&r__1, &c_b1053) > comtol_1.tol; -#line 15978 "" +#line 15957 "" return ret_val; } /* isdotted_ */ @@ -37819,43 +38063,43 @@ integer isetvarlen_(integer *idur, integer *nbytes) static cilist io___924 = { 0, 6, 0, 0, 0 }; -#line 15981 "" +#line 15960 "" ret_val = 0; -#line 15982 "" +#line 15961 "" itemp = *idur; -#line 15983 "" +#line 15962 "" for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { -#line 15984 "" +#line 15963 "" i__1 = *nbytes - 1; -#line 15984 "" +#line 15963 "" ret_val += (itemp & 127) * pow_ii(&c__256, &i__1); -#line 15985 "" +#line 15964 "" itemp = lbit_shift(itemp, (ftnlen)-7); -#line 15986 "" +#line 15965 "" if (itemp > 0) { -#line 15987 "" +#line 15966 "" i__1 = (*nbytes << 3) + 7; -#line 15987 "" +#line 15966 "" ret_val += pow_ii(&c__2, &i__1); -#line 15988 "" +#line 15967 "" } else { -#line 15989 "" +#line 15968 "" return ret_val; -#line 15990 "" +#line 15969 "" } -#line 15991 "" +#line 15970 "" /* L1: */ -#line 15991 "" +#line 15970 "" } -#line 15992 "" +#line 15971 "" s_wsle(&io___924); -#line 15992 "" +#line 15971 "" do_lio(&c__9, &c__1, "Problem in fn. isetvarlen", (ftnlen)25); -#line 15992 "" +#line 15971 "" e_wsle(); -#line 15993 "" +#line 15972 "" stop1_(); -#line 15994 "" +#line 15973 "" return ret_val; } /* isetvarlen_ */ @@ -37880,75 +38124,75 @@ integer isetvarlen_(integer *idur, integer *nbytes) /* Returns string with integer only if length is 1, otherwise enclosed in */ /* brackets. */ -#line 16001 "" +#line 15980 "" if (*i__ != 0) { -#line 16002 "" +#line 15981 "" r__1 = abs(*i__) * 1.0001f; -#line 16002 "" +#line 15981 "" *len = r_lg10(&r__1) + 1; -#line 16003 "" +#line 15982 "" if (*i__ < 0) { -#line 16003 "" +#line 15982 "" ++(*len); -#line 16003 "" +#line 15982 "" } -#line 16004 "" +#line 15983 "" } else { -#line 16005 "" +#line 15984 "" s_copy(string, "0", string_len, (ftnlen)1); -#line 16006 "" +#line 15985 "" *len = 1; -#line 16007 "" +#line 15986 "" return 0; -#line 16008 "" +#line 15987 "" } -#line 16009 "" +#line 15988 "" if (*len == 1) { -#line 16010 "" +#line 15989 "" *(unsigned char *)&ch__1[0] = *i__ + 48; -#line 16010 "" +#line 15989 "" s_copy(string, ch__1, string_len, (ftnlen)1); -#line 16011 "" +#line 15990 "" } else { -#line 16012 "" +#line 15991 "" s_copy(string, "{", string_len, (ftnlen)1); -#line 16013 "" +#line 15992 "" ici__1.icierr = 0; -#line 16013 "" +#line 15992 "" ici__1.icirnum = 1; -#line 16013 "" +#line 15992 "" ici__1.icirlen = *len; -#line 16013 "" +#line 15992 "" ici__1.iciunit = string + 1; /* Writing concatenation */ -#line 16013 "" +#line 15992 "" i__1[0] = 2, a__1[0] = "(i"; -#line 16013 "" +#line 15992 "" *(unsigned char *)&ch__1[0] = *len + 48; -#line 16013 "" +#line 15992 "" i__1[1] = 1, a__1[1] = ch__1; -#line 16013 "" +#line 15992 "" i__1[2] = 1, a__1[2] = ")"; -#line 16013 "" +#line 15992 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2); -#line 16013 "" +#line 15992 "" s_wsfi(&ici__1); -#line 16013 "" +#line 15992 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); -#line 16013 "" +#line 15992 "" e_wsfi(); /* Writing concatenation */ -#line 16014 "" +#line 15993 "" i__2[0] = *len + 1, a__2[0] = string; -#line 16014 "" +#line 15993 "" i__2[1] = 1, a__2[1] = "}"; -#line 16014 "" +#line 15993 "" s_cat(string, a__2, i__2, &c__2, string_len); -#line 16015 "" +#line 15994 "" *len += 2; -#line 16016 "" +#line 15995 "" } -#line 16017 "" +#line 15996 "" return 0; } /* istring_ */ @@ -37957,21 +38201,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) /* System generated locals */ integer ret_val; -#line 16021 "" +#line 16000 "" for (ret_val = *n; ret_val >= 1; --ret_val) { -#line 16022 "" +#line 16001 "" if (*(unsigned char *)&string[ret_val - 1] != ' ') { -#line 16022 "" +#line 16001 "" return ret_val; -#line 16022 "" +#line 16001 "" } -#line 16023 "" +#line 16002 "" /* L1: */ -#line 16023 "" +#line 16002 "" } -#line 16024 "" +#line 16003 "" ret_val = 0; -#line 16025 "" +#line 16004 "" return ret_val; } /* lenstr_ */ @@ -37988,45 +38232,45 @@ integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm, /* Used for placing numbers in xtups. Returns note level if not a rest, */ /* else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. */ -#line 16033 "" +#line 16012 "" if (! bit_test(*irest,0)) { -#line 16034 "" +#line 16013 "" ret_val = *nolev; -#line 16035 "" +#line 16014 "" } else { /* Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. */ -#line 16039 "" +#line 16018 "" if (*mult > 0) { -#line 16040 "" +#line 16019 "" if (*mult == 2) { -#line 16041 "" +#line 16020 "" ioff = (*iud << 1) - 1; -#line 16042 "" +#line 16021 "" } else if (*mult != 4) { -#line 16043 "" +#line 16022 "" ioff = *iud * *mult; -#line 16044 "" +#line 16023 "" } else { -#line 16045 "" +#line 16024 "" ioff = (*iud << 2) + 1; -#line 16046 "" +#line 16025 "" } -#line 16047 "" +#line 16026 "" } else { /* May need to futz with this later for non-beamed xtups (quarter, half rests) */ -#line 16051 "" +#line 16030 "" ioff = *iud << 1; -#line 16052 "" +#line 16031 "" } -#line 16053 "" +#line 16032 "" ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff; -#line 16054 "" +#line 16033 "" } -#line 16055 "" +#line 16034 "" return ret_val; } /* levrn_ */ @@ -38046,29 +38290,29 @@ integer lfmt1_(real *x) /* Computes total length of an "f" format with one decimal place. */ /* First round to nearest 0.1 */ -#line 16062 "" +#line 16041 "" if (dabs(*x) < .001f) { -#line 16063 "" +#line 16042 "" ret_val = 2; -#line 16064 "" +#line 16043 "" } else { -#line 16065 "" +#line 16044 "" r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f; -#line 16065 "" +#line 16044 "" y = r_sign(&r__1, x); -#line 16066 "" +#line 16045 "" r__1 = dabs(y) * 1000 + .001f; -#line 16066 "" +#line 16045 "" ret_val = (integer) r_lg10(&r__1); -#line 16067 "" +#line 16046 "" if (y < 0.f) { -#line 16067 "" +#line 16046 "" ++ret_val; -#line 16067 "" +#line 16046 "" } -#line 16068 "" +#line 16047 "" } -#line 16069 "" +#line 16048 "" return ret_val; } /* lfmt1_ */ @@ -38120,300 +38364,300 @@ integer lfmt1_(real *x) /* closing of full tie are not used except for shape alterations. */ /* do 1 ndx = 0 , 11 */ -#line 16094 "" +#line 16073 "" /* Parameter adjustments */ -#line 16094 "" +#line 16073 "" --sepsymq; -#line 16094 "" +#line 16073 "" --isdat4; -#line 16094 "" +#line 16073 "" --isdat3; -#line 16094 "" +#line 16073 "" --isdat2; -#line 16094 "" +#line 16073 "" --isdat1; -#line 16094 "" +#line 16073 "" -#line 16094 "" +#line 16073 "" /* Function Body */ -#line 16094 "" +#line 16073 "" for (ndx = 0; ndx <= 23; ++ndx) { -#line 16095 "" +#line 16074 "" if (bit_test(comslur_1.listslur,ndx)) { /* Slur or tie with index ndx is open. Find the one with right ndxb, see if tie */ -#line 16099 "" +#line 16078 "" i__1 = *nsdat; -#line 16099 "" +#line 16078 "" for (isdat = 1; isdat <= i__1; ++isdat) { /* if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */ -#line 16101 "" +#line 16080 "" if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(& isdat1[isdat], &c__1, &c__18) << 4) != ndx) { -#line 16101 "" +#line 16080 "" goto L2; -#line 16101 "" +#line 16080 "" } /* Wron */ -#line 16103 "" +#line 16082 "" if (! bit_test(isdat1[isdat],11)) { -#line 16103 "" +#line 16082 "" goto L2; -#line 16103 "" +#line 16082 "" } /* Bypass if stop */ -#line 16104 "" +#line 16083 "" if (bit_test(isdat2[isdat],3)) { -#line 16104 "" +#line 16083 "" goto L3; -#line 16104 "" +#line 16083 "" } /* "st" */ -#line 16105 "" +#line 16084 "" idcode = igetbits_(&isdat1[isdat], &c__7, &c__19); -#line 16106 "" +#line 16085 "" if (idcode == 1) { -#line 16106 "" +#line 16085 "" goto L3; -#line 16106 "" +#line 16085 "" } /* "t" */ -#line 16107 "" +#line 16086 "" tie = FALSE_; -#line 16108 "" +#line 16087 "" goto L5; -#line 16109 "" +#line 16088 "" L2: -#line 16109 "" +#line 16088 "" ; -#line 16109 "" +#line 16088 "" } -#line 16110 "" +#line 16089 "" } -#line 16111 "" +#line 16090 "" goto L1; -#line 16112 "" +#line 16091 "" L3: -#line 16113 "" +#line 16092 "" tie = TRUE_; -#line 16114 "" +#line 16093 "" L5: /* A slur or tie is open, with index ndx */ -#line 16118 "" +#line 16097 "" iv = igetbits_(&isdat1[isdat], &c__5, &c__13); -#line 16119 "" +#line 16098 "" kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1; -#line 16120 "" +#line 16099 "" *(unsigned char *)udq = 'd'; -#line 16121 "" +#line 16100 "" if (bit_test(isdat1[isdat],27)) { -#line 16121 "" +#line 16100 "" *(unsigned char *)udq = 'u'; -#line 16121 "" +#line 16100 "" } /* Writing concatenation */ -#line 16122 "" +#line 16101 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16122 "" +#line 16101 "" i__2[0] = 1, a__1[0] = ch__1; -#line 16122 "" +#line 16101 "" i__2[1] = 6, a__1[1] = "znotes"; -#line 16122 "" +#line 16101 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16123 "" +#line 16102 "" lnote = 7; -#line 16124 "" +#line 16103 "" i__1 = iv - 1; -#line 16124 "" +#line 16103 "" for (iiv = 1; iiv <= i__1; ++iiv) { /* Writing concatenation */ -#line 16125 "" +#line 16104 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16125 "" +#line 16104 "" i__2[1] = 1, a__1[1] = sepsymq + iiv; -#line 16125 "" +#line 16104 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16126 "" +#line 16105 "" ++lnote; -#line 16127 "" +#line 16106 "" /* L4: */ -#line 16127 "" +#line 16106 "" } -#line 16128 "" +#line 16107 "" if (kv == 2) { /* Writing concatenation */ -#line 16129 "" +#line 16108 "" i__3[0] = lnote, a__2[0] = notexq; -#line 16129 "" +#line 16108 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16129 "" +#line 16108 "" i__3[1] = 1, a__2[1] = ch__1; -#line 16129 "" +#line 16108 "" i__3[2] = 9, a__2[2] = "nextvoice"; -#line 16129 "" +#line 16108 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16130 "" +#line 16109 "" lnote += 10; -#line 16131 "" +#line 16110 "" } /* Compute horiz and vert offsets */ /* nolev = igetbits(isdat2(isdat),7,19) */ -#line 16136 "" +#line 16115 "" islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14); -#line 16137 "" +#line 16116 "" ilb12 = 0; -#line 16138 "" +#line 16117 "" if (*ispstie) { -#line 16138 "" +#line 16117 "" ilb12 = 1; -#line 16138 "" +#line 16117 "" } -#line 16139 "" +#line 16118 "" i__1 = ilb12 << 4; -#line 16139 "" +#line 16118 "" ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32; -#line 16140 "" +#line 16119 "" if (ivoff == -32) { -#line 16140 "" +#line 16119 "" ivoff = 0; -#line 16140 "" +#line 16119 "" } /* nolev = nolev+ivoff */ -#line 16142 "" +#line 16121 "" islhgt += ivoff; -#line 16143 "" +#line 16122 "" i__1 = (ilb12 << 4) + 6; -#line 16143 "" +#line 16122 "" ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64; /* This is 10X */ -#line 16144 "" +#line 16123 "" if (ihoff == -64) { -#line 16144 "" +#line 16123 "" ihoff = 0; -#line 16144 "" +#line 16123 "" } /* Add starting stuff for command */ -#line 16148 "" +#line 16127 "" if (! (*ispstie)) { /* End 1st segment */ /* Writing concatenation */ -#line 16149 "" +#line 16128 "" i__3[0] = lnote, a__2[0] = notexq; -#line 16149 "" +#line 16128 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16149 "" +#line 16128 "" i__3[1] = 1, a__2[1] = ch__1; -#line 16149 "" +#line 16128 "" i__3[2] = 8, a__2[2] = "roffset{"; -#line 16149 "" +#line 16128 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16150 "" +#line 16129 "" lnote += 9; /* hoff = ihoff*.1-.5 */ /* hoff = ihoff*.1-.8 */ -#line 16153 "" +#line 16132 "" hoff = ihoff * .1f - .4f; -#line 16154 "" +#line 16133 "" if (hoff < 0.f) { -#line 16155 "" +#line 16134 "" hoff = -hoff; /* Writing concatenation */ -#line 16156 "" +#line 16135 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16156 "" +#line 16135 "" i__2[1] = 1, a__1[1] = "-"; -#line 16156 "" +#line 16135 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16157 "" +#line 16136 "" ++lnote; -#line 16158 "" +#line 16137 "" } -#line 16159 "" +#line 16138 "" writflot_(&hoff, notexq, &lnote, (ftnlen)128); /* Writing concatenation */ -#line 16160 "" +#line 16139 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16160 "" +#line 16139 "" i__2[1] = 2, a__1[1] = "}{"; -#line 16160 "" +#line 16139 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16161 "" +#line 16140 "" lnote += 2; -#line 16162 "" +#line 16141 "" } else { /* Writing concatenation */ -#line 16163 "" +#line 16142 "" i__4[0] = lnote, a__3[0] = notexq; -#line 16163 "" +#line 16142 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16163 "" +#line 16142 "" i__4[1] = 1, a__3[1] = ch__1; -#line 16163 "" +#line 16142 "" i__4[2] = 5, a__3[2] = "off{-"; -#line 16163 "" +#line 16142 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 16163 "" +#line 16142 "" i__4[3] = 1, a__3[3] = ch__2; -#line 16163 "" +#line 16142 "" i__4[4] = 14, a__3[4] = "afterruleskip}"; -#line 16163 "" +#line 16142 "" s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); -#line 16165 "" +#line 16144 "" lnote += 21; /* 091025 add dotting for 2nd segment if needed */ -#line 16169 "" +#line 16148 "" if (bit_test(isdat2[isdat],4)) { /* Writing concatenation */ -#line 16170 "" +#line 16149 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16170 "" +#line 16149 "" i__3[0] = 1, a__2[0] = ch__1; -#line 16170 "" +#line 16149 "" i__3[1] = 6, a__2[1] = "dotted"; -#line 16170 "" +#line 16149 "" i__3[2] = lnote, a__2[2] = notexq; -#line 16170 "" +#line 16149 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16171 "" +#line 16150 "" lnote += 7; -#line 16172 "" +#line 16151 "" } -#line 16173 "" +#line 16152 "" } -#line 16174 "" +#line 16153 "" if (*ispstie && tie) { /* Writing concatenation */ -#line 16175 "" +#line 16154 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16175 "" +#line 16154 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16175 "" +#line 16154 "" i__5[1] = 1, a__4[1] = ch__1; -#line 16175 "" +#line 16154 "" i__5[2] = 8, a__4[2] = "tieforis"; -#line 16175 "" +#line 16154 "" i__5[3] = 1, a__4[3] = udq; -#line 16175 "" +#line 16154 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16176 "" +#line 16155 "" lnote += 10; -#line 16177 "" +#line 16156 "" } -#line 16178 "" +#line 16157 "" if (bit_test(isdat3[isdat],0)) { /* Curvature tweak on termination of 1st seg */ -#line 16182 "" +#line 16161 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; /* Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: */ @@ -38424,82 +38668,82 @@ L5: /* 6 HH */ /* Writing concatenation */ -#line 16191 "" +#line 16170 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16191 "" +#line 16170 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16191 "" +#line 16170 "" i__5[1] = 1, a__4[1] = ch__1; -#line 16191 "" +#line 16170 "" i__5[2] = 7, a__4[2] = "psforts"; -#line 16191 "" +#line 16170 "" i__1 = imid + 48; -#line 16191 "" +#line 16170 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 16191 "" +#line 16170 "" i__5[3] = 1, a__4[3] = ch__2; -#line 16191 "" +#line 16170 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16192 "" +#line 16171 "" lnote += 9; /* Zero out the flag in case there's a different curv on term of 2nd, */ -#line 16196 "" +#line 16175 "" isdat3[isdat] = bit_clear(isdat3[isdat],0); -#line 16197 "" +#line 16176 "" } /* Add the command name */ -#line 16201 "" +#line 16180 "" if (*ispstie) { /* Writing concatenation */ -#line 16202 "" +#line 16181 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16202 "" +#line 16181 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16202 "" +#line 16181 "" i__5[1] = 1, a__4[1] = ch__1; -#line 16202 "" +#line 16181 "" i__5[2] = 2, a__4[2] = "is"; -#line 16202 "" +#line 16181 "" i__5[3] = 1, a__4[3] = udq; -#line 16202 "" +#line 16181 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16203 "" +#line 16182 "" lnote += 4; -#line 16204 "" +#line 16183 "" } else if (tie) { /* Writing concatenation */ -#line 16205 "" +#line 16184 "" i__3[0] = lnote, a__2[0] = notexq; -#line 16205 "" +#line 16184 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16205 "" +#line 16184 "" i__3[1] = 1, a__2[1] = ch__1; -#line 16205 "" +#line 16184 "" i__3[2] = 4, a__2[2] = "ttie"; -#line 16205 "" +#line 16184 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16206 "" +#line 16185 "" lnote += 5; -#line 16207 "" +#line 16186 "" } else { /* Writing concatenation */ -#line 16208 "" +#line 16187 "" i__3[0] = lnote, a__2[0] = notexq; -#line 16208 "" +#line 16187 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16208 "" +#line 16187 "" i__3[1] = 1, a__2[1] = ch__1; -#line 16208 "" +#line 16187 "" i__3[2] = 5, a__2[2] = "tslur"; -#line 16208 "" +#line 16187 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16209 "" +#line 16188 "" lnote += 6; -#line 16210 "" +#line 16189 "" } /* Add index */ @@ -38511,214 +38755,214 @@ L5: /* notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */ /* lnote = lnote+4 */ /* end if */ -#line 16221 "" +#line 16200 "" if (23 - ndx < 10) { /* Writing concatenation */ -#line 16222 "" +#line 16201 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16222 "" +#line 16201 "" i__1 = 71 - ndx; -#line 16222 "" +#line 16201 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 16222 "" +#line 16201 "" i__2[1] = 1, a__1[1] = ch__1; -#line 16222 "" +#line 16201 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16223 "" +#line 16202 "" ++lnote; -#line 16224 "" +#line 16203 "" } else if (23 - ndx < 20) { /* Writing concatenation */ -#line 16225 "" +#line 16204 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16225 "" +#line 16204 "" i__5[1] = 2, a__4[1] = "{1"; -#line 16225 "" +#line 16204 "" i__1 = 61 - ndx; -#line 16225 "" +#line 16204 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 16225 "" +#line 16204 "" i__5[2] = 1, a__4[2] = ch__1; -#line 16225 "" +#line 16204 "" i__5[3] = 1, a__4[3] = "}"; -#line 16225 "" +#line 16204 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16226 "" +#line 16205 "" lnote += 4; -#line 16227 "" +#line 16206 "" } else { /* Writing concatenation */ -#line 16228 "" +#line 16207 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16228 "" +#line 16207 "" i__5[1] = 2, a__4[1] = "{2"; -#line 16228 "" +#line 16207 "" i__1 = 51 - ndx; -#line 16228 "" +#line 16207 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 16228 "" +#line 16207 "" i__5[2] = 1, a__4[2] = ch__1; -#line 16228 "" +#line 16207 "" i__5[3] = 1, a__4[3] = "}"; -#line 16228 "" +#line 16207 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16229 "" +#line 16208 "" lnote += 4; -#line 16230 "" +#line 16209 "" } -#line 16231 "" +#line 16210 "" if (*ispstie || ! tie) { /* Add note name for slur height */ -#line 16235 "" +#line 16214 "" comoct_1.noctup = 0; -#line 16236 "" +#line 16215 "" ncm = igetbits_(&isdat3[isdat], &c__8, &c__22); -#line 16237 "" +#line 16216 "" if (ncm == 23) { -#line 16237 "" +#line 16216 "" comoct_1.noctup = -2; -#line 16237 "" +#line 16216 "" } /* call notefq(noteq,lnoten,nolev,ncm) */ -#line 16239 "" +#line 16218 "" notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8); /* Writing concatenation */ -#line 16240 "" +#line 16219 "" i__5[0] = lnote, a__4[0] = notexq; -#line 16240 "" +#line 16219 "" i__5[1] = 1, a__4[1] = "{"; -#line 16240 "" +#line 16219 "" i__5[2] = lnoten, a__4[2] = noteq; -#line 16240 "" +#line 16219 "" i__5[3] = 1, a__4[3] = "}"; -#line 16240 "" +#line 16219 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); -#line 16241 "" +#line 16220 "" lnote = lnote + 1 + lnoten + 1; -#line 16242 "" +#line 16221 "" } -#line 16243 "" +#line 16222 "" if (*ispstie) { /* Horizontal shift start of new thing */ /* Writing concatenation */ -#line 16247 "" +#line 16226 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16247 "" +#line 16226 "" i__2[1] = 1, a__1[1] = "{"; -#line 16247 "" +#line 16226 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16248 "" +#line 16227 "" ++lnote; /* ihoff = ihoff-13 */ -#line 16250 "" +#line 16229 "" if (tie) { -#line 16251 "" +#line 16230 "" ihoff += -12; -#line 16252 "" +#line 16231 "" } else { -#line 16253 "" +#line 16232 "" ihoff += -7; -#line 16254 "" +#line 16233 "" } -#line 16255 "" +#line 16234 "" if (ihoff < 0) { -#line 16256 "" +#line 16235 "" ihoff = -ihoff; /* Writing concatenation */ -#line 16257 "" +#line 16236 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16257 "" +#line 16236 "" i__2[1] = 1, a__1[1] = "-"; -#line 16257 "" +#line 16236 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16258 "" +#line 16237 "" ++lnote; -#line 16259 "" +#line 16238 "" } -#line 16260 "" +#line 16239 "" r__1 = ihoff * .1f; -#line 16260 "" +#line 16239 "" writflot_(&r__1, notexq, &lnote, (ftnlen)128); /* Writing concatenation */ -#line 16261 "" +#line 16240 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16261 "" +#line 16240 "" i__2[1] = 1, a__1[1] = "}"; -#line 16261 "" +#line 16240 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16262 "" +#line 16241 "" ++lnote; -#line 16263 "" +#line 16242 "" } /* Add closing stuff */ -#line 16267 "" +#line 16246 "" if (*ispstie) { /* Writing concatenation */ -#line 16268 "" +#line 16247 "" i__4[0] = lnote, a__3[0] = notexq; -#line 16268 "" +#line 16247 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16268 "" +#line 16247 "" i__4[1] = 1, a__3[1] = ch__1; -#line 16268 "" +#line 16247 "" i__4[2] = 4, a__3[2] = "off{"; -#line 16268 "" +#line 16247 "" chax_(ch__2, (ftnlen)1, &c__92); -#line 16268 "" +#line 16247 "" i__4[3] = 1, a__3[3] = ch__2; -#line 16268 "" +#line 16247 "" i__4[4] = 14, a__3[4] = "afterruleskip}"; -#line 16268 "" +#line 16247 "" s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); -#line 16270 "" +#line 16249 "" lnote += 20; -#line 16271 "" +#line 16250 "" } else { /* Writing concatenation */ -#line 16272 "" +#line 16251 "" i__2[0] = lnote, a__1[0] = notexq; -#line 16272 "" +#line 16251 "" i__2[1] = 1, a__1[1] = "}"; -#line 16272 "" +#line 16251 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); -#line 16273 "" +#line 16252 "" ++lnote; -#line 16274 "" +#line 16253 "" } /* Writing concatenation */ -#line 16275 "" +#line 16254 "" i__3[0] = lnote, a__2[0] = notexq; -#line 16275 "" +#line 16254 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16275 "" +#line 16254 "" i__3[1] = 1, a__2[1] = ch__1; -#line 16275 "" +#line 16254 "" i__3[2] = 3, a__2[2] = "en%"; -#line 16275 "" +#line 16254 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); -#line 16276 "" +#line 16255 "" lnote += 4; -#line 16277 "" +#line 16256 "" s_wsfe(&io___946); -#line 16277 "" +#line 16256 "" do_fio(&c__1, notexq, lnote); -#line 16277 "" +#line 16256 "" e_wsfe(); -#line 16278 "" +#line 16257 "" L1: -#line 16278 "" +#line 16257 "" ; -#line 16278 "" +#line 16257 "" } -#line 16279 "" +#line 16258 "" *ispstie = ! (*ispstie); -#line 16280 "" +#line 16259 "" return 0; } /* linebreakties_ */ @@ -38754,243 +38998,243 @@ L1: static cilist io___954 = { 0, 16, 0, "(a)", 0 }; -#line 16298 "" +#line 16277 "" /* Parameter adjustments */ -#line 16298 "" +#line 16277 "" islur -= 25; -#line 16298 "" +#line 16277 "" -#line 16298 "" +#line 16277 "" /* Function Body */ -#line 16298 "" +#line 16277 "" merge = FALSE_; -#line 16299 "" +#line 16278 "" if (comgrace_1.nlit > 0) { -#line 16300 "" +#line 16279 "" merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl == comgrace_1.iplit[comgrace_1.nlit - 1]; -#line 16301 "" +#line 16280 "" } -#line 16302 "" +#line 16281 "" ++comgrace_1.nlit; -#line 16303 "" +#line 16282 "" comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv; -#line 16304 "" +#line 16283 "" comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl; -#line 16305 "" +#line 16284 "" itype = 1; -#line 16306 "" +#line 16285 "" L17: -#line 16306 "" +#line 16285 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 16307 "" +#line 16286 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16307 "" +#line 16286 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { -#line 16308 "" +#line 16287 "" ++itype; -#line 16309 "" +#line 16288 "" goto L17; -#line 16310 "" +#line 16289 "" } /* Writing concatenation */ -#line 16311 "" +#line 16290 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16311 "" +#line 16290 "" i__1[0] = 1, a__1[0] = ch__1; -#line 16311 "" +#line 16290 "" i__1[1] = 1, a__1[1] = durq; -#line 16311 "" +#line 16290 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, ( ftnlen)128); -#line 16312 "" +#line 16291 "" comgrace_1.lenlit[comgrace_1.nlit - 1] = 2; -#line 16313 "" +#line 16292 "" L18: -#line 16313 "" +#line 16292 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 16314 "" +#line 16293 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16314 "" +#line 16293 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { -#line 16315 "" +#line 16294 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 16316 "" +#line 16295 "" if (*(unsigned char *)durq != ' ') { /* Starting a new tex command within the string */ /* Writing concatenation */ -#line 16320 "" +#line 16299 "" i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); -#line 16320 "" +#line 16299 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 16320 "" +#line 16299 "" i__2[1] = 1, a__2[1] = ch__1; -#line 16320 "" +#line 16299 "" i__2[2] = 1, a__2[2] = durq; -#line 16320 "" +#line 16299 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, & c__3, (ftnlen)128); -#line 16321 "" +#line 16300 "" comgrace_1.lenlit[comgrace_1.nlit - 1] += 2; -#line 16322 "" +#line 16301 "" goto L18; -#line 16323 "" +#line 16302 "" } -#line 16324 "" +#line 16303 "" } else { /* Writing concatenation */ -#line 16325 "" +#line 16304 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); -#line 16325 "" +#line 16304 "" i__1[1] = 1, a__1[1] = durq; -#line 16325 "" +#line 16304 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, (ftnlen)128); -#line 16326 "" +#line 16305 "" ++comgrace_1.lenlit[comgrace_1.nlit - 1]; -#line 16327 "" +#line 16306 "" goto L18; -#line 16328 "" +#line 16307 "" } /* If here, just read backslash-blank so string is done */ -#line 16332 "" +#line 16311 "" if (itype == 1) { -#line 16333 "" +#line 16312 "" islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16); -#line 16334 "" +#line 16313 "" if (merge) { /* There are 2 separate strings on the same note, so merge them. */ -#line 16338 "" +#line 16317 "" --comgrace_1.nlit; /* Writing concatenation */ -#line 16339 "" +#line 16318 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); -#line 16339 "" +#line 16318 "" i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] = comgrace_1.litq + (comgrace_1.nlit << 7); -#line 16339 "" +#line 16318 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, & c__2, (ftnlen)128); -#line 16341 "" +#line 16320 "" comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[ comgrace_1.nlit]; -#line 16342 "" +#line 16321 "" if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) { -#line 16343 "" +#line 16322 "" s_wsle(&io___950); -#line 16343 "" +#line 16322 "" e_wsle(); -#line 16344 "" +#line 16323 "" s_wsle(&io___951); -#line 16344 "" +#line 16323 "" do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "\ "128 characters", (ftnlen)52); -#line 16344 "" +#line 16323 "" e_wsle(); -#line 16346 "" +#line 16325 "" s_wsfe(&io___952); -#line 16346 "" +#line 16325 "" do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"\ "racters", (ftnlen)52); -#line 16346 "" +#line 16325 "" e_wsfe(); -#line 16348 "" +#line 16327 "" stop1_(); -#line 16349 "" +#line 16328 "" } -#line 16350 "" +#line 16329 "" } -#line 16351 "" +#line 16330 "" } else { /* Type 2 or 3. */ -#line 16355 "" +#line 16334 "" if (itype == 3) { /* Write the string NOW */ -#line 16359 "" +#line 16338 "" if (comlast_1.islast) { -#line 16359 "" +#line 16338 "" s_wsfe(&io___953); /* Writing concatenation */ -#line 16359 "" +#line 16338 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); -#line 16359 "" +#line 16338 "" i__1[1] = 1, a__1[1] = "%"; -#line 16359 "" +#line 16338 "" s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); -#line 16359 "" +#line 16338 "" do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1); -#line 16359 "" +#line 16338 "" e_wsfe(); -#line 16359 "" +#line 16338 "" } -#line 16361 "" +#line 16340 "" } else { /* Must go at top */ -#line 16365 "" +#line 16344 "" if (! (*topmods)) { -#line 16366 "" +#line 16345 "" *topmods = TRUE_; -#line 16367 "" +#line 16346 "" o__1.oerr = 0; -#line 16367 "" +#line 16346 "" o__1.ounit = 16; -#line 16367 "" +#line 16346 "" o__1.ofnm = 0; -#line 16367 "" +#line 16346 "" o__1.orl = 0; -#line 16367 "" +#line 16346 "" o__1.osta = "SCRATCH"; -#line 16367 "" +#line 16346 "" o__1.oacc = 0; -#line 16367 "" +#line 16346 "" o__1.ofm = 0; -#line 16367 "" +#line 16346 "" o__1.oblnk = 0; -#line 16367 "" +#line 16346 "" f_open(&o__1); -#line 16368 "" +#line 16347 "" } /* Must write '%' here rather than later, in case string ends with blank. */ -#line 16372 "" +#line 16351 "" s_wsfe(&io___954); /* Writing concatenation */ -#line 16372 "" +#line 16351 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); -#line 16372 "" +#line 16351 "" i__1[1] = 1, a__1[1] = "%"; -#line 16372 "" +#line 16351 "" s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); -#line 16372 "" +#line 16351 "" do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1); -#line 16372 "" +#line 16351 "" e_wsfe(); -#line 16373 "" +#line 16352 "" } -#line 16374 "" +#line 16353 "" --comgrace_1.nlit; -#line 16375 "" +#line 16354 "" } -#line 16376 "" +#line 16355 "" return 0; } /* littex_ */ @@ -38999,19 +39243,19 @@ integer llen_(char *strq, integer *n, ftnlen strq_len) /* System generated locals */ integer ret_val; -#line 16380 "" +#line 16359 "" for (ret_val = *n; ret_val >= 0; --ret_val) { -#line 16381 "" +#line 16360 "" if (*(unsigned char *)&strq[ret_val - 1] != ' ') { -#line 16381 "" +#line 16360 "" return ret_val; -#line 16381 "" +#line 16360 "" } -#line 16382 "" +#line 16361 "" /* L1: */ -#line 16382 "" +#line 16361 "" } -#line 16383 "" +#line 16362 "" return ret_val; } /* llen_ */ @@ -39028,9 +39272,9 @@ integer log2_(integer *n) /* log2 = alog(1.*n)/0.6931472+.0001 */ /* log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */ -#line 16390 "" +#line 16369 "" ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8); -#line 16391 "" +#line 16370 "" return ret_val; } /* log2_ */ @@ -39058,242 +39302,242 @@ integer log2_(integer *n) extern /* Subroutine */ int setbits_(integer *, integer *, integer *, integer *); -#line 16410 "" +#line 16389 "" all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1; -#line 16411 "" +#line 16390 "" all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2; -#line 16412 "" +#line 16391 "" numnow = *numnew; -#line 16413 "" +#line 16392 "" if (*numnew > 1) { /* If it starts before any others, must put it in order */ -#line 16417 "" +#line 16396 "" for (ib = *numnew - 1; ib >= 1; --ib) { -#line 16418 "" +#line 16397 "" if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) { -#line 16418 "" +#line 16397 "" goto L12; -#line 16418 "" +#line 16397 "" } -#line 16419 "" +#line 16398 "" all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[ commvl_1.ivx + ib * 24 - 25]; -#line 16420 "" +#line 16399 "" all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[ commvl_1.ivx + ib * 24 - 25]; -#line 16421 "" +#line 16400 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] = *(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25]; -#line 16422 "" +#line 16401 "" all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1; -#line 16423 "" +#line 16402 "" all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2; -#line 16424 "" +#line 16403 "" numnow = ib; -#line 16425 "" +#line 16404 "" /* L11: */ -#line 16425 "" +#line 16404 "" } -#line 16426 "" +#line 16405 "" L12: -#line 16427 "" +#line 16406 "" ; -#line 16427 "" +#line 16406 "" } -#line 16428 "" +#line 16407 "" sum = 0.f; /* Beam has non-xtup within */ -#line 16432 "" +#line 16411 "" nrests = 0; -#line 16433 "" +#line 16412 "" isxtup = FALSE_; -#line 16434 "" +#line 16413 "" i__1 = *nip2; -#line 16434 "" +#line 16413 "" for (iip = *nip1; iip <= i__1; ++iip) { -#line 16435 "" +#line 16414 "" if (bit_test(all_1.islur[commvl_1.ivx + *nip1 * 24 - 25],21)) { /* Forced multiplicity */ -#line 16439 "" +#line 16418 "" i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], & c__3, &c__22) + 8; -#line 16439 "" +#line 16418 "" setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0, &i__2); -#line 16441 "" +#line 16420 "" } else if (! isxtup) { -#line 16442 "" +#line 16421 "" if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { -#line 16443 "" +#line 16422 "" i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25]) + 8; -#line 16443 "" +#line 16422 "" setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, & c__0, &i__2); -#line 16444 "" +#line 16423 "" } else { /* Start xtup within forced beam */ -#line 16448 "" +#line 16427 "" isxtup = TRUE_; -#line 16449 "" +#line 16428 "" iip1 = iip; -#line 16450 "" +#line 16429 "" } -#line 16451 "" +#line 16430 "" } else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { /* End of xtup within forced beam. Must count doubled notes */ -#line 16455 "" +#line 16434 "" ndoub = 0; -#line 16456 "" +#line 16435 "" i__2 = iip; -#line 16456 "" +#line 16435 "" for (iiip = iip1; iiip <= i__2; ++iiip) { -#line 16457 "" +#line 16436 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { -#line 16457 "" +#line 16436 "" ++ndoub; -#line 16457 "" +#line 16436 "" } -#line 16458 "" +#line 16437 "" /* L1: */ -#line 16458 "" +#line 16437 "" } -#line 16459 "" +#line 16438 "" multx = (integer) ((log(iip + 1.f - iip1 + ndoub) * .952f - log( all_1.nodur[commvl_1.ivx + iip * 24 - 25] / 2.f)) / .69315f + 13.429f) - 10; -#line 16461 "" +#line 16440 "" i__2 = iip; -#line 16461 "" +#line 16440 "" for (iiip = iip1; iiip <= i__2; ++iiip) { -#line 16462 "" +#line 16441 "" i__3 = multx + 8; -#line 16462 "" +#line 16441 "" setbits_(&all_1.mult[commvl_1.ivx + iiip * 24 - 25], &c__4, & c__0, &i__3); /* Note the following still works after making mult only the 1st 4 bits. */ -#line 16466 "" +#line 16445 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { -#line 16466 "" +#line 16445 "" --all_1.mult[commvl_1.ivx + iiip * 24 - 25]; -#line 16466 "" +#line 16445 "" } -#line 16468 "" +#line 16447 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) { -#line 16469 "" +#line 16448 "" ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; -#line 16470 "" +#line 16449 "" } else if (iiip > 1) { -#line 16471 "" +#line 16450 "" if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 - 25],19)) { -#line 16471 "" +#line 16450 "" ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; -#line 16471 "" +#line 16450 "" } -#line 16473 "" +#line 16452 "" } -#line 16474 "" +#line 16453 "" /* L74: */ -#line 16474 "" +#line 16453 "" } -#line 16475 "" +#line 16454 "" isxtup = FALSE_; -#line 16476 "" +#line 16455 "" } -#line 16477 "" +#line 16456 "" if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) { -#line 16478 "" +#line 16457 "" ++nrests; -#line 16479 "" +#line 16458 "" } else { -#line 16480 "" +#line 16459 "" sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25]; -#line 16481 "" +#line 16460 "" } -#line 16482 "" +#line 16461 "" /* L9: */ -#line 16482 "" +#line 16461 "" } /* Set beam up-down-ness */ -#line 16486 "" +#line 16465 "" if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + max(1,comfb_1.ifb) * 24 - 25] != 'x') { -#line 16487 "" +#line 16466 "" if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25] == 'f') { /* Get default, then trade "l" and "u" */ -#line 16491 "" +#line 16470 "" r__1 = sum / (*nip2 - *nip1 + 1 - nrests); -#line 16491 "" +#line 16470 "" i__1 = ncmid_(&all_1.iv, nip1); -#line 16491 "" +#line 16470 "" ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); -#line 16491 "" +#line 16470 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = ( char) (225 - *(unsigned char *)&ch__1[0]); -#line 16493 "" +#line 16472 "" } else { -#line 16494 "" +#line 16473 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + comfb_1.ifb * 24 - 25] = *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25]; -#line 16495 "" +#line 16474 "" } /* This probably works only because forced beams are done first, so they */ /* don't have to be re-sorted within each voice. ???? */ -#line 16500 "" +#line 16479 "" } else if (commvl_1.nvmx[all_1.iv - 1] == 2) { /* Multi-voice per staff */ -#line 16504 "" +#line 16483 "" if (commvl_1.ivx <= all_1.nv) { -#line 16505 "" +#line 16484 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = 'l'; -#line 16506 "" +#line 16485 "" } else { -#line 16507 "" +#line 16486 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = 'u'; -#line 16508 "" +#line 16487 "" } -#line 16509 "" +#line 16488 "" } else { /* Defaults */ -#line 16513 "" +#line 16492 "" r__1 = sum / (*nip2 - *nip1 + 1 - nrests); -#line 16513 "" +#line 16492 "" i__1 = ncmid_(&all_1.iv, nip1); -#line 16513 "" +#line 16492 "" ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); -#line 16513 "" +#line 16492 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *( unsigned char *)&ch__1[0]; -#line 16515 "" +#line 16494 "" } -#line 16516 "" +#line 16495 "" return 0; } /* logbeam_ */ @@ -39316,73 +39560,73 @@ L12: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ -#line 16532 "" +#line 16511 "" inbuff_1.lbuf[0] = inbuff_1.lbuf[0]; -#line 16533 "" +#line 16512 "" if (! commac_1.mrecord) { /* Starting the macro */ -#line 16537 "" +#line 16516 "" c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; -#line 16538 "" +#line 16517 "" c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; -#line 16539 "" +#line 16518 "" c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; -#line 16540 "" +#line 16519 "" commac_1.mrecord = TRUE_; -#line 16541 "" +#line 16520 "" } -#line 16542 "" +#line 16521 "" if (*iccount < 128) { -#line 16543 "" +#line 16522 "" i__1 = *iccount; -#line 16543 "" +#line 16522 "" *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); -#line 16544 "" +#line 16523 "" if (*ndxm > 0) { -#line 16544 "" +#line 16523 "" i__1 = *iccount; -#line 16544 "" +#line 16523 "" i__2 = 128 - *iccount; -#line 16544 "" +#line 16523 "" *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); -#line 16544 "" +#line 16523 "" } -#line 16546 "" +#line 16525 "" if (*ndxm > 0) { /* This line ends the macro. */ -#line 16550 "" +#line 16529 "" i__1 = *iccount + *ndxm; -#line 16550 "" +#line 16529 "" if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen) 1) != 0) { -#line 16551 "" +#line 16530 "" i__1 = *iccount + *ndxm + 1; -#line 16551 "" +#line 16530 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; -#line 16551 "" +#line 16530 "" errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", ( ftnlen)128, (ftnlen)27); -#line 16553 "" +#line 16532 "" stop1_(); -#line 16554 "" +#line 16533 "" } -#line 16555 "" +#line 16534 "" c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; -#line 16556 "" +#line 16535 "" c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; -#line 16557 "" +#line 16536 "" commac_1.mrecord = FALSE_; -#line 16558 "" +#line 16537 "" } -#line 16559 "" +#line 16538 "" } -#line 16560 "" +#line 16539 "" return 0; } /* m1rec1_ */ @@ -39413,7 +39657,7 @@ L12: static real tglp2; extern /* Subroutine */ int addfb_(integer *, integer *, real *, real *, real *, char *, integer *, ftnlen); - static integer mapfb[16]; + static integer mapfb[24]; static real deskb; extern doublereal fnote_(integer *, integer *, integer *, integer *); static real eskzb; @@ -39440,173 +39684,177 @@ L12: /* Above are factors for grace note, clef spacing. (fraction of wheadpt) */ /* In 1.04, moved to block data subprogram */ -#line 16652 "" +#line 16631 "" /* Parameter adjustments */ -#line 16652 "" +#line 16631 "" --istart; -#line 16652 "" +#line 16631 "" --numbms; -#line 16652 "" +#line 16631 "" --istop; -#line 16652 "" +#line 16631 "" --squez; -#line 16652 "" +#line 16631 "" --cwrest; -#line 16652 "" +#line 16631 "" --tstart; -#line 16652 "" +#line 16631 "" -#line 16652 "" +#line 16631 "" /* Function Body */ -#line 16652 "" +#line 16631 "" if (commidi_1.ismidi) { /* Initialize for this bar the accidental counter for the midi file. */ /* naccim(icm) = # of accidentals from earlier in the bar */ -#line 16657 "" +#line 16636 "" i__1 = all_1.nv; -#line 16657 "" +#line 16636 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 16658 "" +#line 16637 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 16658 "" +#line 16637 "" for (kv = 1; kv <= i__2; ++kv) { -#line 16659 "" +#line 16638 "" commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] = 0; -#line 16660 "" -/* L45: */ -#line 16660 "" +#line 16639 "" +/* L4599: */ +#line 16639 "" } -#line 16660 "" +#line 16640 "" +/* L45: */ +#line 16640 "" } -#line 16661 "" +#line 16641 "" } /* Time from start of gulp to end of bar, used with forced beams */ -#line 16665 "" +#line 16645 "" tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1); -#line 16666 "" +#line 16646 "" if (all_1.lenb0 > 0) { -#line 16666 "" +#line 16646 "" tglp2 -= all_1.lenb1; -#line 16666 "" +#line 16646 "" } -#line 16667 "" +#line 16647 "" *tglp1 = tglp2 - all_1.lenbar; /* infbmx will only be true if in xtup that is NOT in explicit forced beam. */ -#line 16671 "" - i__2 = all_1.nv; -#line 16671 "" - for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { -#line 16672 "" - i__1 = commvl_1.nvmx[all_1.iv - 1]; -#line 16672 "" - for (kv = 1; kv <= i__1; ++kv) { -#line 16673 "" +#line 16651 "" + i__1 = all_1.nv; +#line 16651 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16652 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 16652 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 16653 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 16674 "" +#line 16654 "" cwrest[commvl_1.ivx] = FALSE_; -#line 16675 "" +#line 16655 "" infbmx[commvl_1.ivx - 1] = FALSE_; -#line 16676 "" +#line 16656 "" inxtup[commvl_1.ivx - 1] = FALSE_; -#line 16677 "" +#line 16657 "" if (all_1.ibar > 1) { -#line 16678 "" +#line 16658 "" all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] - all_1.nib[commvl_1.ivx + ( all_1.ibar - 1) * 24 - 25]; -#line 16679 "" +#line 16659 "" } else { -#line 16680 "" +#line 16660 "" all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25]; -#line 16681 "" +#line 16661 "" } -#line 16682 "" -/* L1: */ -#line 16682 "" +#line 16662 "" +/* L1999: */ +#line 16662 "" } -#line 16682 "" +#line 16663 "" +/* L1: */ +#line 16663 "" } /* initialize list note counter, time(iv), curr. note(iv). The loop to 4 */ /* ONLY initializes each voice. */ -#line 16687 "" +#line 16668 "" in = 1; -#line 16688 "" +#line 16669 "" nxtup = 0; -#line 16689 "" +#line 16670 "" comarp_1.narp = 0; -#line 16690 "" +#line 16671 "" i__1 = all_1.nv; -#line 16690 "" +#line 16671 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 16691 "" +#line 16672 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 16691 "" +#line 16672 "" for (kv = 1; kv <= i__2; ++kv) { -#line 16692 "" +#line 16673 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 16693 "" +#line 16674 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; -#line 16694 "" +#line 16675 "" cnn[commvl_1.ivx - 1] = 1; -#line 16695 "" +#line 16676 "" all_1.ivxo[in - 1] = commvl_1.ivx; -#line 16696 "" +#line 16677 "" all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; -#line 16697 "" +#line 16678 "" all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1, all_1.nacc); -#line 16698 "" +#line 16679 "" all_1.to[in - 1] = 0.f; -#line 16699 "" +#line 16680 "" xit[commvl_1.ivx - 1] = all_1.tnote[in - 1]; /* Note that xit(ivx) is to END of note in voice, but it1xtup is start time. */ -#line 16703 "" +#line 16684 "" if (all_1.nodur[commvl_1.ivx + all_1.ipo[in - 1] * 24 - 25] == 0) { /* First note of xtuplet at start of bar in voice ivx. */ -#line 16707 "" +#line 16688 "" ++nxtup; -#line 16708 "" +#line 16689 "" nxtnow[commvl_1.ivx - 1] = nxtup; -#line 16709 "" +#line 16690 "" inxtup[commvl_1.ivx - 1] = TRUE_; -#line 16710 "" +#line 16691 "" t1xtup[nxtup - 1] = 0.f; /* Xtup at start of bar. If no explicit forced beam, start one, set */ /* signal infbmx, and save number ifbnow for use at termination. */ -#line 16715 "" +#line 16696 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { -#line 16716 "" +#line 16697 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; -#line 16716 "" +#line 16697 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { -#line 16717 "" +#line 16698 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) { /* No explicit fb here; so exit loop and insert one. */ -#line 16721 "" +#line 16702 "" goto L61; -#line 16722 "" +#line 16703 "" } else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol && comfb_1.t2fb[commvl_1.ivx + @@ -39615,156 +39863,160 @@ L12: /* IS explicit fb here; must NOT insert one */ -#line 16727 "" +#line 16708 "" goto L62; -#line 16728 "" +#line 16709 "" } -#line 16729 "" +#line 16710 "" /* L60: */ -#line 16729 "" +#line 16710 "" } -#line 16730 "" +#line 16711 "" } -#line 16731 "" +#line 16712 "" L61: /* If here, xtup isn't in explicit fb, so must insert one */ -#line 16735 "" +#line 16716 "" infbmx[commvl_1.ivx - 1] = TRUE_; -#line 16736 "" +#line 16717 "" r__1 = t1xtup[nxtup - 1] + *tglp1; -#line 16736 "" +#line 16717 "" addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); -#line 16738 "" +#line 16719 "" ifbnow[commvl_1.ivx - 1] = ifbadd; -#line 16739 "" +#line 16720 "" } -#line 16740 "" +#line 16721 "" L62: -#line 16741 "" +#line 16722 "" if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) < comtol_1.tol) { -#line 16741 "" +#line 16722 "" xit[commvl_1.ivx - 1] = 1e3f; -#line 16741 "" +#line 16722 "" } -#line 16742 "" +#line 16723 "" ++in; -#line 16743 "" -/* L4: */ -#line 16743 "" +#line 16724 "" +/* L4999: */ +#line 16724 "" } -#line 16743 "" +#line 16725 "" +/* L4: */ +#line 16725 "" } /* Build the list: This is a manual loop starting at 5 */ -#line 16747 "" +#line 16729 "" L5: /* Determine which voice comes next from end of notes done so far. */ /* tmin is the earliest ending time of notes done so far */ -#line 16752 "" +#line 16734 "" tmin = 1e3f; -#line 16753 "" - i__2 = all_1.nv; -#line 16753 "" - for (iiv = 1; iiv <= i__2; ++iiv) { -#line 16754 "" - i__1 = commvl_1.nvmx[iiv - 1]; -#line 16754 "" - for (kv = 1; kv <= i__1; ++kv) { -#line 16755 "" +#line 16735 "" + i__1 = all_1.nv; +#line 16735 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 16736 "" + i__2 = commvl_1.nvmx[iiv - 1]; +#line 16736 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 16737 "" iivx = commvl_1.ivmx[iiv + kv * 24 - 25]; /* Computing MIN */ -#line 16756 "" +#line 16738 "" r__1 = tmin, r__2 = xit[iivx - 1]; -#line 16756 "" +#line 16738 "" tminn = dmin(r__1,r__2); -#line 16757 "" +#line 16739 "" if (tminn < tmin - comtol_1.tol) { -#line 16758 "" +#line 16740 "" tmin = tminn; -#line 16759 "" +#line 16741 "" commvl_1.ivx = iivx; -#line 16760 "" +#line 16742 "" } -#line 16761 "" -/* L6: */ -#line 16761 "" +#line 16743 "" +/* L6999: */ +#line 16743 "" } -#line 16761 "" +#line 16744 "" +/* L6: */ +#line 16744 "" } -#line 16762 "" +#line 16745 "" if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) { -#line 16762 "" +#line 16745 "" goto L7; -#line 16762 "" +#line 16745 "" } -#line 16763 "" +#line 16746 "" all_1.ivxo[in - 1] = commvl_1.ivx; -#line 16764 "" +#line 16747 "" ++cnn[commvl_1.ivx - 1]; -#line 16765 "" +#line 16748 "" all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; -#line 16766 "" +#line 16749 "" all_1.to[in - 1] = tmin; /* Check if this voice is done */ -#line 16770 "" +#line 16753 "" all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[ commvl_1.ivx - 1], all_1.nacc); -#line 16771 "" +#line 16754 "" if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) { -#line 16772 "" +#line 16755 "" xit[commvl_1.ivx - 1] = 1e3f; -#line 16773 "" +#line 16756 "" } else { -#line 16774 "" +#line 16757 "" xit[commvl_1.ivx - 1] += all_1.tnote[in - 1]; -#line 16775 "" +#line 16758 "" } /* Flag xtups */ -#line 16779 "" +#line 16762 "" if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) { -#line 16780 "" +#line 16763 "" if (! inxtup[commvl_1.ivx - 1]) { /* First note of xtup, not at start of bar. */ -#line 16784 "" +#line 16767 "" ++nxtup; -#line 16785 "" +#line 16768 "" nxtnow[commvl_1.ivx - 1] = nxtup; -#line 16786 "" +#line 16769 "" inxtup[commvl_1.ivx - 1] = TRUE_; -#line 16787 "" +#line 16770 "" t1xtup[nxtup - 1] = xit[commvl_1.ivx - 1] - all_1.tnote[in - 1]; /* (Note: can't be on last note in voice, so xit(ivx) <> 1000) */ /* Put xtuplet in a forced beam if not already in forced beam */ -#line 16792 "" +#line 16775 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { -#line 16793 "" +#line 16776 "" i__1 = comfb_1.nfb[commvl_1.ivx - 1]; -#line 16793 "" +#line 16776 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) { -#line 16794 "" +#line 16777 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > * tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) { /* NO explicit bm; put one in */ -#line 16798 "" +#line 16781 "" goto L71; -#line 16799 "" +#line 16782 "" } else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol && comfb_1.t2fb[commvl_1.ivx + @@ -39773,59 +40025,59 @@ L5: /* IS explicit bm. Don't put one */ -#line 16804 "" +#line 16787 "" goto L72; -#line 16805 "" +#line 16788 "" } -#line 16806 "" +#line 16789 "" /* L70: */ -#line 16806 "" +#line 16789 "" } -#line 16807 "" +#line 16790 "" } -#line 16808 "" +#line 16791 "" L71: /* If here, no explicit bm, so put one in */ -#line 16812 "" +#line 16795 "" infbmx[commvl_1.ivx - 1] = TRUE_; -#line 16813 "" +#line 16796 "" r__1 = t1xtup[nxtup - 1] + *tglp1; -#line 16813 "" +#line 16796 "" addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); -#line 16815 "" +#line 16798 "" ifbnow[commvl_1.ivx - 1] = ifbadd; -#line 16816 "" +#line 16799 "" } -#line 16817 "" +#line 16800 "" L72: -#line 16818 "" +#line 16801 "" ; -#line 16818 "" +#line 16801 "" } else if (inxtup[commvl_1.ivx - 1]) { /* This test is sufficient because already know nodur>0 */ -#line 16822 "" +#line 16805 "" inxtup[commvl_1.ivx - 1] = FALSE_; -#line 16823 "" +#line 16806 "" if (infbmx[commvl_1.ivx - 1]) { /* Xtup is in auto-forced beam, so end it */ -#line 16827 "" +#line 16810 "" comfb_1.t2fb[commvl_1.ivx + ifbnow[commvl_1.ivx - 1] * 24 - 25] = t1xtup[nxtnow[commvl_1.ivx - 1] - 1] + all_1.nodur[ commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] + *tglp1; -#line 16829 "" +#line 16812 "" infbmx[commvl_1.ivx - 1] = FALSE_; -#line 16830 "" +#line 16813 "" } -#line 16831 "" +#line 16814 "" } -#line 16832 "" +#line 16815 "" if (bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] ,24) || bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],30)) { @@ -39833,62 +40085,62 @@ L72: /* For staff jumped beam, flag the first note (lowest voice) at same time. */ /* Later will start new notes group here. */ -#line 16838 "" +#line 16821 "" inj = in; -#line 16839 "" +#line 16822 "" if (all_1.ivxo[in - 1] > 1) { -#line 16840 "" +#line 16823 "" for (iin = in - 1; iin >= 1; --iin) { -#line 16841 "" +#line 16824 "" if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) { -#line 16841 "" +#line 16824 "" goto L41; -#line 16841 "" +#line 16824 "" } -#line 16842 "" +#line 16825 "" if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1)) < comtol_1.tol) { -#line 16843 "" +#line 16826 "" inj = iin; -#line 16844 "" +#line 16827 "" goto L40; -#line 16845 "" +#line 16828 "" } -#line 16846 "" +#line 16829 "" L40: -#line 16846 "" +#line 16829 "" ; -#line 16846 "" +#line 16829 "" } -#line 16847 "" +#line 16830 "" } -#line 16848 "" +#line 16831 "" L41: -#line 16849 "" +#line 16832 "" all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25] = bit_set(all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25],29); -#line 16850 "" +#line 16833 "" } -#line 16851 "" +#line 16834 "" ++in; -#line 16852 "" +#line 16835 "" goto L5; -#line 16853 "" +#line 16836 "" L7: -#line 16854 "" +#line 16837 "" comntot_1.ntot = in - 1; -#line 16855 "" +#line 16838 "" i__1 = comntot_1.ntot - 1; -#line 16855 "" +#line 16838 "" for (in = 1; in <= i__1; ++in) { -#line 16856 "" +#line 16839 "" all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1]; -#line 16857 "" +#line 16840 "" /* L8: */ -#line 16857 "" +#line 16840 "" } -#line 16858 "" +#line 16841 "" all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1]; /* Debug writes */ @@ -39904,32 +40156,32 @@ L7: /* Done w/ list. Loop for parsing into note blocks: */ -#line 16873 "" +#line 16856 "" ib = 1; -#line 16874 "" +#line 16857 "" istart[1] = 1; -#line 16875 "" +#line 16858 "" comnsp_2.space[0] = 0.f; -#line 16876 "" +#line 16859 "" in = 1; /* A manual loop to set space(ib) and istop(ib) */ -#line 16880 "" +#line 16863 "" L9: /* Computing MIN */ -#line 16882 "" +#line 16865 "" i__1 = in + 1; -#line 16882 "" +#line 16865 "" commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1]; /* Computing MIN */ -#line 16883 "" +#line 16866 "" i__1 = in + 1; -#line 16883 "" +#line 16866 "" ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1]; -#line 16884 "" +#line 16867 "" isl = all_1.islur[commvl_1.ivx + ip * 24 - 25]; -#line 16885 "" +#line 16868 "" if (in == comntot_1.ntot || (commvl_1.ivx == 1 && ((isl & 67109216) > 0 || bit_test(all_1.ipl[ip * 24 - 24],28) || bit_test(all_1.iornq[ip * 24],4)) || bit_test(isl,15)) || bit_test(all_1.irest[ @@ -39951,353 +40203,357 @@ L9: /* 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */ /* changes on last note in the list? */ -#line 16906 "" +#line 16889 "" if (bit_test(isl,15) && in < comntot_1.ntot) { -#line 16907 "" +#line 16890 "" for (iin = in; iin >= 1; --iin) { -#line 16908 "" +#line 16891 "" if (all_1.tno[iin - 1] > comtol_1.tol) { -#line 16909 "" +#line 16892 "" in = iin; -#line 16910 "" +#line 16893 "" all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear( all_1.islur[commvl_1.ivx + ip * 24 - 25],15); -#line 16911 "" +#line 16894 "" all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25] = bit_set(all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25],15); -#line 16913 "" +#line 16896 "" goto L51; -#line 16914 "" +#line 16897 "" } -#line 16915 "" +#line 16898 "" /* L50: */ -#line 16915 "" +#line 16898 "" } -#line 16916 "" +#line 16899 "" L51: -#line 16917 "" +#line 16900 "" ; -#line 16917 "" +#line 16900 "" } -#line 16918 "" +#line 16901 "" if (comnsp_2.space[ib - 1] < comtol_1.tol) { -#line 16919 "" +#line 16902 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; -#line 16920 "" +#line 16903 "" squez[ib] = 1.f; -#line 16921 "" +#line 16904 "" } -#line 16922 "" +#line 16905 "" istop[ib] = in; -#line 16923 "" +#line 16906 "" } else if (comnsp_2.space[ib - 1] < comtol_1.tol) { /* space hasn't been set yet, so tentatively set: */ -#line 16927 "" +#line 16910 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; -#line 16928 "" +#line 16911 "" if (comnsp_2.space[ib - 1] < comtol_1.tol) { -#line 16929 "" +#line 16912 "" ++in; -#line 16930 "" +#line 16913 "" } else { -#line 16931 "" +#line 16914 "" squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); -#line 16932 "" +#line 16915 "" istop[ib] = in; -#line 16933 "" +#line 16916 "" } -#line 16934 "" +#line 16917 "" goto L9; -#line 16935 "" +#line 16918 "" } else if (all_1.tno[in] < comtol_1.tol) { /* This is not the last note in the group, so */ -#line 16939 "" +#line 16922 "" ++in; -#line 16940 "" +#line 16923 "" goto L9; -#line 16941 "" +#line 16924 "" } else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) < comtol_1.tol) { -#line 16942 "" +#line 16925 "" i__1 = in + 1; -#line 16942 "" +#line 16925 "" xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); -#line 16943 "" +#line 16926 "" if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) { /* Keep spacing the same, update tentative stop point */ -#line 16947 "" +#line 16930 "" ++in; -#line 16948 "" +#line 16931 "" istop[ib] = in; -#line 16949 "" +#line 16932 "" goto L9; -#line 16950 "" +#line 16933 "" } -#line 16951 "" +#line 16934 "" } /* At this point istart and istop are good, so finalize block */ -#line 16955 "" +#line 16938 "" tstart[ib] = all_1.to[istart[ib] - 1]; -#line 16956 "" +#line 16939 "" if (istop[ib] == comntot_1.ntot) { -#line 16956 "" +#line 16939 "" goto L15; -#line 16956 "" +#line 16939 "" } -#line 16957 "" +#line 16940 "" ++ib; -#line 16958 "" +#line 16941 "" istart[ib] = istop[ib - 1] + 1; -#line 16959 "" +#line 16942 "" in = istart[ib]; /* Set tentative block space and squeeze-factor for upcoming block */ -#line 16963 "" +#line 16946 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; -#line 16964 "" +#line 16947 "" if (comnsp_2.space[ib - 1] > comtol_1.tol) { -#line 16964 "" +#line 16947 "" squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); -#line 16964 "" +#line 16947 "" } -#line 16966 "" +#line 16949 "" istop[ib] = in; -#line 16967 "" +#line 16950 "" goto L9; -#line 16968 "" +#line 16951 "" L15: -#line 16969 "" +#line 16952 "" comnsp_2.nb = ib; /* Invert the list of places into ipl(0-7), making it easier to analyze a voice */ -#line 16973 "" +#line 16956 "" i__1 = comntot_1.ntot; -#line 16973 "" +#line 16956 "" for (in = 1; in <= i__1; ++in) { /* ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. */ /* ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) */ -#line 16978 "" +#line 16961 "" comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in; -#line 16979 "" +#line 16962 "" /* L13: */ -#line 16979 "" +#line 16962 "" } /* Compute elemskips from start of bar to each note in the bar, for beam slopes */ -#line 16983 "" +#line 16966 "" eskzb = 0.f; -#line 16984 "" +#line 16967 "" ib = 1; -#line 16985 "" +#line 16968 "" i__1 = comntot_1.ntot; -#line 16985 "" +#line 16968 "" for (in = 1; in <= i__1; ++in) { -#line 16986 "" +#line 16969 "" if (in == istart[ib]) { -#line 16987 "" +#line 16970 "" r__1 = comnsp_2.space[ib - 1] / squez[ib]; -#line 16987 "" +#line 16970 "" deskb = squez[ib] * feon_(&r__1); -#line 16988 "" +#line 16971 "" } else if (all_1.tno[in - 2] > comtol_1.tol) { -#line 16989 "" +#line 16972 "" eskzb += deskb; -#line 16990 "" +#line 16973 "" } -#line 16991 "" +#line 16974 "" all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb; -#line 16992 "" +#line 16975 "" comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb; -#line 16993 "" +#line 16976 "" if (in == istop[ib]) { -#line 16994 "" +#line 16977 "" eskzb += deskb; -#line 16995 "" +#line 16978 "" ++ib; -#line 16996 "" +#line 16979 "" } -#line 16997 "" +#line 16980 "" /* L30: */ -#line 16997 "" +#line 16980 "" } /* Analyze for beams. */ -#line 17001 "" +#line 16984 "" i__1 = all_1.nv; -#line 17001 "" +#line 16984 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 17002 "" +#line 16985 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 17002 "" +#line 16985 "" for (kv = 1; kv <= i__2; ++kv) { -#line 17003 "" +#line 16986 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 17004 "" +#line 16987 "" numbms[commvl_1.ivx] = 0; -#line 17005 "" +#line 16988 "" mapfb[0] = 0; -#line 17006 "" +#line 16989 "" mapfb[1] = 0; -#line 17007 "" +#line 16990 "" mapfb[2] = 0; -#line 17008 "" +#line 16991 "" mapfb[3] = 0; +#line 16992 "" + mapfb[4] = 0; +#line 16993 "" + mapfb[5] = 0; /* First forced beams. */ -#line 17012 "" +#line 16997 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { /* tglp2 is time from start of gulp to end of current bar. */ -#line 17016 "" +#line 17001 "" nfbbar = 0; -#line 17017 "" +#line 17002 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; -#line 17017 "" +#line 17002 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { -#line 17018 "" +#line 17003 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > tglp2 - comtol_1.tol) { -#line 17018 "" +#line 17003 "" goto L81; -#line 17018 "" +#line 17003 "" } -#line 17019 "" +#line 17004 "" ++nfbbar; -#line 17020 "" +#line 17005 "" ++numbms[commvl_1.ivx]; -#line 17021 "" +#line 17006 "" numnew = numbms[commvl_1.ivx]; /* Times from beginning of bar */ -#line 17025 "" +#line 17010 "" itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); -#line 17026 "" +#line 17011 "" itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); -#line 17027 "" +#line 17012 "" i__4 = all_1.nn[commvl_1.ivx - 1]; -#line 17027 "" +#line 17012 "" for (ip = 1; ip <= i__4; ++ip) { -#line 17028 "" +#line 17013 "" if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) { -#line 17029 "" +#line 17014 "" nip1fb = ip; -#line 17030 "" +#line 17015 "" i__5 = all_1.nn[commvl_1.ivx - 1]; -#line 17030 "" +#line 17015 "" for (ip1 = ip; ip1 <= i__5; ++ip1) { -#line 17031 "" +#line 17016 "" inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 * 24 - 25]; -#line 17032 "" +#line 17017 "" if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[ inip1 - 1] - itbb2, dabs(r__1)) < comtol_1.tol) { -#line 17033 "" +#line 17018 "" nip2fb = ip1; -#line 17034 "" +#line 17019 "" itbb3 = itbb2 - 2; -#line 17035 "" +#line 17020 "" goto L85; -#line 17036 "" +#line 17021 "" } -#line 17037 "" +#line 17022 "" /* L84: */ -#line 17037 "" +#line 17022 "" } -#line 17038 "" +#line 17023 "" } -#line 17039 "" +#line 17024 "" /* L83: */ -#line 17039 "" +#line 17024 "" } -#line 17040 "" +#line 17025 "" s_wsle(&io___999); -#line 17040 "" +#line 17025 "" e_wsle(); -#line 17041 "" +#line 17026 "" s_wsle(&io___1000); -#line 17041 "" +#line 17026 "" do_lio(&c__9, &c__1, "Timing problem w/ forced beams", ( ftnlen)30); -#line 17041 "" +#line 17026 "" e_wsle(); -#line 17042 "" +#line 17027 "" s_wsfe(&io___1001); -#line 17042 "" +#line 17027 "" do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen) 30); -#line 17042 "" +#line 17027 "" e_wsfe(); -#line 17043 "" +#line 17028 "" L85: -#line 17044 "" +#line 17029 "" logbeam_(&numnew, &nip1fb, &nip2fb); /* Set up mapfb for forced beam just logged: */ -#line 17048 "" +#line 17033 "" ib1 = itbb1 / 2; -#line 17049 "" +#line 17034 "" ib2 = itbb3 / 2; -#line 17050 "" +#line 17035 "" ibrep = all_1.lenbar / *ibmrep / 2; -#line 17051 "" +#line 17036 "" i__4 = *ibmrep; -#line 17051 "" +#line 17036 "" for (irep = 1; irep <= i__4; ++irep) { /* Computing MAX */ -#line 17052 "" +#line 17037 "" i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep; -#line 17052 "" +#line 17037 "" ib1now = max(i__5,i__6); /* Computing MIN */ -#line 17053 "" +#line 17038 "" i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) * ibrep; -#line 17053 "" +#line 17038 "" ib2now = min(i__5,i__6); -#line 17054 "" +#line 17039 "" mapnow = 0; -#line 17055 "" +#line 17040 "" i__5 = ib2now; -#line 17055 "" +#line 17040 "" for (ib = ib1now; ib <= i__5; ++ib) { -#line 17056 "" +#line 17041 "" mapnow = bit_set(mapnow,ib); -#line 17057 "" +#line 17042 "" /* L87: */ -#line 17057 "" +#line 17042 "" } -#line 17058 "" +#line 17043 "" mapfb[irep - 1] |= mapnow; -#line 17059 "" +#line 17044 "" /* L86: */ -#line 17059 "" +#line 17044 "" } /* Since we are cycling thru forced beams, for those that start with a rest and */ @@ -40305,91 +40561,93 @@ L85: /* 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */ /* start of beam */ -#line 17066 "" +#line 17051 "" if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25], 0)) { -#line 17067 "" +#line 17052 "" i__4 = nip2fb; -#line 17067 "" +#line 17052 "" for (kp = nip1fb + 1; kp <= i__4; ++kp) { -#line 17068 "" +#line 17053 "" i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb * 24 - 25], &c__6, &c__11); -#line 17068 "" +#line 17053 "" setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], &c__6, &c__11, &i__5); -#line 17070 "" +#line 17055 "" i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb * 24 - 25], &c__6, &c__17); -#line 17070 "" +#line 17055 "" setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], &c__6, &c__17, &i__5); -#line 17072 "" +#line 17057 "" i__5 = igetbits_(&all_1.islur[commvl_1.ivx + nip1fb * 24 - 25], &c__2, &c__27); -#line 17072 "" +#line 17057 "" setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25] , &c__2, &c__27, &i__5); -#line 17074 "" +#line 17059 "" /* L88: */ -#line 17074 "" +#line 17059 "" } -#line 17075 "" +#line 17060 "" } -#line 17076 "" +#line 17061 "" /* L80: */ -#line 17076 "" +#line 17061 "" } -#line 17077 "" +#line 17062 "" L81: /* Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar. */ /* Remember, makeabar is called 1/bar, and it calls findbeam once per voice. */ -#line 17082 "" +#line 17067 "" if (nfbbar > 0) { -#line 17083 "" +#line 17068 "" comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar; -#line 17084 "" +#line 17069 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; -#line 17084 "" +#line 17069 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { -#line 17085 "" +#line 17070 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; -#line 17086 "" +#line 17071 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; -#line 17087 "" +#line 17072 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25] = *(unsigned char *)& comfb_1.ulfbq[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; -#line 17088 "" +#line 17073 "" /* L82: */ -#line 17088 "" +#line 17073 "" } -#line 17089 "" +#line 17074 "" } -#line 17090 "" +#line 17075 "" } -#line 17091 "" +#line 17076 "" comfb_1.ifb = 0; /* Done with forced beam masks for this bar and voice. Now get normal beams. */ -#line 17095 "" +#line 17080 "" findbeam_(ibmrep, &numbms[1], mapfb); -#line 17096 "" -/* L20: */ -#line 17096 "" +#line 17081 "" +/* L2099: */ +#line 17081 "" } -#line 17096 "" +#line 17082 "" +/* L20: */ +#line 17082 "" } -#line 17097 "" +#line 17083 "" return 0; } /* make1bar_ */ @@ -40609,458 +40867,460 @@ L81: /* In 1.04, moved to block data subprogram */ /* 130316 */ -#line 17226 "" +#line 17212 "" /* Parameter adjustments */ -#line 17226 "" +#line 17212 "" --clefq; -#line 17226 "" +#line 17212 "" --istart; -#line 17226 "" +#line 17212 "" --numbms; -#line 17226 "" +#line 17212 "" --istop; -#line 17226 "" +#line 17212 "" --squez; -#line 17226 "" +#line 17212 "" --cwrest; -#line 17226 "" +#line 17212 "" --tstart; -#line 17226 "" +#line 17212 "" -#line 17226 "" +#line 17212 "" /* Function Body */ -#line 17226 "" +#line 17212 "" xjbeambrests_1.nbrests = 0; /* Set up main ib loop within which a block (notes group) is written */ -#line 17230 "" +#line 17216 "" i__1 = all_1.nv; -#line 17230 "" +#line 17216 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 17231 "" +#line 17217 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 17231 "" +#line 17217 "" for (kv = 1; kv <= i__2; ++kv) { -#line 17232 "" +#line 17218 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 17233 "" +#line 17219 "" all_1.ibmcnt[commvl_1.ivx - 1] = 1; -#line 17234 "" +#line 17220 "" ibmcnt1[commvl_1.ivx - 1] = 1; -#line 17235 "" +#line 17221 "" all_1.beamon[commvl_1.ivx - 1] = FALSE_; -#line 17236 "" +#line 17222 "" beamon1[commvl_1.ivx - 1] = FALSE_; -#line 17237 "" +#line 17223 "" nornb[commvl_1.ivx - 1] = 0; -#line 17238 "" +#line 17224 "" iaskb[commvl_1.ivx - 1] = 1; -#line 17239 "" +#line 17225 "" comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; -#line 17240 "" +#line 17226 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; -#line 17241 "" -/* L25: */ -#line 17241 "" +#line 17227 "" +/* L2599: */ +#line 17227 "" } -#line 17241 "" +#line 17228 "" +/* L25: */ +#line 17228 "" } -#line 17242 "" +#line 17229 "" comas1_1.naskb = 0; -#line 17243 "" +#line 17230 "" ifig[0] = 1; -#line 17244 "" +#line 17231 "" ifig[1] = 1; -#line 17245 "" +#line 17232 "" comxtup_1.ixtup = 0; -#line 17246 "" +#line 17233 "" bspend = FALSE_; -#line 17247 "" +#line 17234 "" iscwr = FALSE_; -#line 17248 "" +#line 17235 "" rpndot = FALSE_; -#line 17249 "" - i__2 = comnsp_2.nb; -#line 17249 "" - for (ib = 1; ib <= i__2; ++ib) { +#line 17236 "" + i__1 = comnsp_2.nb; +#line 17236 "" + for (ib = 1; ib <= i__1; ++ib) { /* Check for segno */ -#line 17253 "" +#line 17240 "" if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) && all_1.ivxo[istart[ib] - 1] == 1) { -#line 17255 "" +#line 17242 "" if (comgrace_1.noffseg <= -10) { -#line 17256 "" +#line 17243 "" s_wsfi(&io___1021); -#line 17256 "" +#line 17243 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); -#line 17256 "" +#line 17243 "" e_wsfi(); -#line 17257 "" +#line 17244 "" lnoten = 5; -#line 17258 "" +#line 17245 "" } else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) { -#line 17259 "" +#line 17246 "" s_wsfi(&io___1023); -#line 17259 "" +#line 17246 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); -#line 17259 "" +#line 17246 "" e_wsfi(); -#line 17260 "" +#line 17247 "" lnoten = 4; -#line 17261 "" +#line 17248 "" } else { -#line 17262 "" +#line 17249 "" s_wsfi(&io___1024); -#line 17262 "" +#line 17249 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); -#line 17262 "" +#line 17249 "" e_wsfi(); -#line 17263 "" +#line 17250 "" lnoten = 1; -#line 17264 "" +#line 17251 "" } /* Writing concatenation */ -#line 17265 "" +#line 17252 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 17265 "" +#line 17252 "" i__3[1] = 6, a__1[1] = "znotes"; -#line 17265 "" +#line 17252 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 17265 "" +#line 17252 "" i__3[3] = 6, a__1[3] = "segnoo"; -#line 17265 "" +#line 17252 "" i__3[4] = lnoten, a__1[4] = noteq; -#line 17265 "" +#line 17252 "" i__3[5] = 1, a__1[5] = "9"; -#line 17265 "" +#line 17252 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); -#line 17266 "" +#line 17253 "" lnote = lnoten + 15; -#line 17267 "" - i__1 = all_1.nv; -#line 17267 "" - for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) { -#line 17268 "" +#line 17254 "" + i__2 = all_1.nv; +#line 17254 "" + for (all_1.iv = 2; all_1.iv <= i__2; ++all_1.iv) { +#line 17255 "" if (lnote > 60) { -#line 17269 "" +#line 17256 "" if (comlast_1.islast) { -#line 17269 "" +#line 17256 "" s_wsfe(&io___1027); /* Writing concatenation */ -#line 17269 "" +#line 17256 "" i__4[0] = lnote, a__2[0] = notexq; -#line 17269 "" +#line 17256 "" i__4[1] = 1, a__2[1] = "%"; -#line 17269 "" +#line 17256 "" s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80); -#line 17269 "" +#line 17256 "" do_fio(&c__1, ch__1, lnote + 1); -#line 17269 "" +#line 17256 "" e_wsfe(); -#line 17269 "" +#line 17256 "" } /* Writing concatenation */ -#line 17270 "" +#line 17257 "" i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2); -#line 17270 "" +#line 17257 "" i__5[1] = 1, a__3[1] = all_1.sq; -#line 17270 "" +#line 17257 "" i__5[2] = 6, a__3[2] = "segnoo"; -#line 17270 "" +#line 17257 "" i__5[3] = lnoten, a__3[3] = noteq; -#line 17270 "" +#line 17257 "" i__5[4] = 1, a__3[4] = "9"; -#line 17270 "" +#line 17257 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 17272 "" +#line 17259 "" lnote = lnoten + 9; -#line 17273 "" +#line 17260 "" } else { /* Writing concatenation */ -#line 17274 "" +#line 17261 "" i__3[0] = lnote, a__1[0] = notexq; -#line 17274 "" +#line 17261 "" i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2); -#line 17274 "" +#line 17261 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 17274 "" +#line 17261 "" i__3[3] = 6, a__1[3] = "segnoo"; -#line 17274 "" +#line 17261 "" i__3[4] = lnoten, a__1[4] = noteq; -#line 17274 "" +#line 17261 "" i__3[5] = 1, a__1[5] = "9"; -#line 17274 "" +#line 17261 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); -#line 17276 "" +#line 17263 "" lnote = lnote + lnoten + 9; -#line 17277 "" +#line 17264 "" } -#line 17278 "" +#line 17265 "" /* L130: */ -#line 17278 "" +#line 17265 "" } -#line 17279 "" +#line 17266 "" if (comlast_1.islast) { -#line 17279 "" +#line 17266 "" s_wsfe(&io___1028); /* Writing concatenation */ -#line 17279 "" +#line 17266 "" i__6[0] = lnote, a__4[0] = notexq; -#line 17279 "" +#line 17266 "" i__6[1] = 1, a__4[1] = all_1.sq; -#line 17279 "" +#line 17266 "" i__6[2] = 2, a__4[2] = "en"; -#line 17279 "" +#line 17266 "" s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); -#line 17279 "" +#line 17266 "" do_fio(&c__1, ch__2, lnote + 3); -#line 17279 "" +#line 17266 "" e_wsfe(); -#line 17279 "" +#line 17266 "" } -#line 17280 "" +#line 17267 "" lnote = 0; -#line 17281 "" +#line 17268 "" } /* Check for new clefs */ -#line 17285 "" +#line 17272 "" isclef = FALSE_; -#line 17286 "" +#line 17273 "" if (bit_test(all_1.islur[all_1.ivxo[istart[ib] - 1] + all_1.ipo[ istart[ib] - 1] * 24 - 25],15)) { /* In preceding line, fl32 gave wrong result for ... .gt.0 !!! */ -#line 17291 "" - i__1 = istop[ib]; -#line 17291 "" - for (in = istart[ib]; in <= i__1; ++in) { -#line 17292 "" +#line 17278 "" + i__2 = istop[ib]; +#line 17278 "" + for (in = istart[ib]; in <= i__2; ++in) { +#line 17279 "" if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],11)) { -#line 17293 "" +#line 17280 "" i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7; -#line 17293 "" +#line 17280 "" wsclef_(&all_1.ivxo[in - 1], ninow, &i__7); /* If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% */ /* if (clefq(ivxo(in)) .eq. '8') then */ -#line 17299 "" +#line 17286 "" if (bit_test(all_1.ipl[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],2)) { /* Find instrument number for voice ivso(in) */ -#line 17303 "" +#line 17290 "" iv1 = 1; -#line 17304 "" +#line 17291 "" i__7 = *ninow; -#line 17304 "" +#line 17291 "" for (iinst = 1; iinst <= i__7; ++iinst) { -#line 17305 "" +#line 17292 "" if (all_1.ivxo[in - 1] < iv1 + comnvi_1.nspern[ iinst - 1]) { -#line 17305 "" +#line 17292 "" goto L2222; -#line 17305 "" +#line 17292 "" } -#line 17306 "" +#line 17293 "" iv1 += comnvi_1.nspern[iinst - 1]; -#line 17307 "" +#line 17294 "" /* L1111: */ -#line 17307 "" +#line 17294 "" } -#line 17308 "" +#line 17295 "" s_wsle(&io___1033); -#line 17308 "" +#line 17295 "" e_wsle(); -#line 17309 "" +#line 17296 "" s_wsle(&io___1034); -#line 17309 "" +#line 17296 "" do_lio(&c__9, &c__1, "Should not be here in make2bar!" , (ftnlen)31); -#line 17309 "" +#line 17296 "" e_wsle(); -#line 17310 "" +#line 17297 "" stop1_(); -#line 17311 "" +#line 17298 "" L2222: -#line 17312 "" +#line 17299 "" if (iinst <= 9) { -#line 17313 "" +#line 17300 "" s_wsfe(&io___1035); /* Writing concatenation */ -#line 17313 "" +#line 17300 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17313 "" +#line 17300 "" i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; -#line 17313 "" +#line 17300 "" s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); -#line 17313 "" +#line 17300 "" do_fio(&c__1, ch__3, (ftnlen)20); -#line 17313 "" +#line 17300 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ -#line 17313 "" +#line 17300 "" i__8[0] = 1, a__5[0] = all_1.sq; -#line 17313 "" +#line 17300 "" i__8[1] = 13, a__5[1] = "treblelowoct%"; -#line 17313 "" +#line 17300 "" s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); -#line 17313 "" +#line 17300 "" do_fio(&c__1, ch__4, (ftnlen)14); -#line 17313 "" +#line 17300 "" e_wsfe(); -#line 17315 "" +#line 17302 "" } else { -#line 17316 "" +#line 17303 "" s_wsfe(&io___1036); /* Writing concatenation */ -#line 17316 "" +#line 17303 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17316 "" +#line 17303 "" i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; -#line 17316 "" +#line 17303 "" s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); -#line 17316 "" +#line 17303 "" do_fio(&c__1, ch__3, (ftnlen)20); -#line 17316 "" +#line 17303 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ -#line 17316 "" +#line 17303 "" i__8[0] = 1, a__5[0] = all_1.sq; -#line 17316 "" +#line 17303 "" i__8[1] = 13, a__5[1] = "treblelowoct%"; -#line 17316 "" +#line 17303 "" s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); -#line 17316 "" +#line 17303 "" do_fio(&c__1, ch__4, (ftnlen)14); -#line 17316 "" +#line 17303 "" e_wsfe(); -#line 17318 "" +#line 17305 "" } -#line 17319 "" +#line 17306 "" comc8flag_1.c8flag[all_1.ivxo[in - 1] - 1] = TRUE_; -#line 17320 "" +#line 17307 "" } -#line 17321 "" +#line 17308 "" } -#line 17322 "" +#line 17309 "" /* L140: */ -#line 17322 "" +#line 17309 "" } -#line 17323 "" +#line 17310 "" if (comlast_1.islast) { -#line 17323 "" +#line 17310 "" s_wsfe(&io___1037); /* Writing concatenation */ -#line 17323 "" +#line 17310 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17323 "" +#line 17310 "" i__4[1] = 11, a__2[1] = "pmxnewclefs"; -#line 17323 "" +#line 17310 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); -#line 17323 "" +#line 17310 "" do_fio(&c__1, ch__5, (ftnlen)12); -#line 17323 "" +#line 17310 "" e_wsfe(); -#line 17323 "" +#line 17310 "" } -#line 17324 "" +#line 17311 "" isclef = TRUE_; -#line 17325 "" +#line 17312 "" } /* Start a notes group. We're just gonna define every one using pnotes{n}, */ /* where \def\pnotes#1{\vnotes#1\elemskip} */ /* Writing concatenation */ -#line 17330 "" +#line 17317 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17330 "" +#line 17317 "" i__4[1] = 7, a__2[1] = "pnotes{"; -#line 17330 "" +#line 17317 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 17331 "" +#line 17318 "" r__1 = comnsp_2.space[ib - 1] / squez[ib]; -#line 17331 "" +#line 17318 "" eonsqz = squez[ib] * feon_(&r__1); -#line 17332 "" +#line 17319 "" if (eonsqz > 9.995f) { -#line 17333 "" +#line 17320 "" s_wsfi(&io___1040); -#line 17333 "" +#line 17320 "" do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); -#line 17333 "" +#line 17320 "" e_wsfi(); -#line 17334 "" +#line 17321 "" } else if (eonsqz > .995f) { -#line 17335 "" +#line 17322 "" s_wsfi(&io___1041); -#line 17335 "" +#line 17322 "" do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); -#line 17335 "" +#line 17322 "" e_wsfi(); -#line 17336 "" +#line 17323 "" } else if (eonsqz > .095f) { /* Writing concatenation */ -#line 17337 "" +#line 17324 "" i__4[0] = 8, a__2[0] = soutq; -#line 17337 "" +#line 17324 "" i__4[1] = 2, a__2[1] = "0."; -#line 17337 "" +#line 17324 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 17338 "" +#line 17325 "" s_wsfi(&io___1042); -#line 17338 "" +#line 17325 "" r__1 = eonsqz * 100; -#line 17338 "" - i__1 = i_nint(&r__1); -#line 17338 "" - do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 17338 "" +#line 17325 "" + i__2 = i_nint(&r__1); +#line 17325 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 17325 "" e_wsfi(); -#line 17339 "" +#line 17326 "" } else { /* Writing concatenation */ -#line 17340 "" +#line 17327 "" i__4[0] = 8, a__2[0] = soutq; -#line 17340 "" +#line 17327 "" i__4[1] = 3, a__2[1] = "0.0"; -#line 17340 "" +#line 17327 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 17341 "" +#line 17328 "" s_wsfi(&io___1043); -#line 17341 "" +#line 17328 "" r__1 = eonsqz * 100; -#line 17341 "" - i__1 = i_nint(&r__1); -#line 17341 "" - do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 17341 "" +#line 17328 "" + i__2 = i_nint(&r__1); +#line 17328 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 17328 "" e_wsfi(); -#line 17342 "" +#line 17329 "" } /* Writing concatenation */ -#line 17343 "" +#line 17330 "" i__4[0] = 12, a__2[0] = soutq; -#line 17343 "" +#line 17330 "" i__4[1] = 1, a__2[1] = "}"; -#line 17343 "" +#line 17330 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 17344 "" +#line 17331 "" lsout = 13; /* Check whole block, flag accidentals etc that are too close, one per *time*. */ @@ -41068,87 +41328,87 @@ L2222: /* (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */ /* (dotsfac*wheadpt) is presumed to be filled up. */ -#line 17351 "" +#line 17338 "" in = istart[ib] - 1; -#line 17352 "" +#line 17339 "" itrpt = -1; -#line 17353 "" +#line 17340 "" itsig = -1; /* Begin big manual loop over notes in this block; ends at 112 */ -#line 17357 "" +#line 17344 "" L111: -#line 17357 "" +#line 17344 "" ++in; -#line 17358 "" +#line 17345 "" if (in > istop[ib]) { -#line 17358 "" +#line 17345 "" goto L112; -#line 17358 "" +#line 17345 "" } -#line 17359 "" +#line 17346 "" ip = all_1.ipo[in - 1]; -#line 17360 "" +#line 17347 "" commvl_1.ivx = all_1.ivxo[in - 1]; -#line 17361 "" +#line 17348 "" if (commvl_1.ivx <= all_1.nv) { -#line 17362 "" +#line 17349 "" all_1.iv = commvl_1.ivx; -#line 17363 "" +#line 17350 "" } else { -#line 17364 "" - i__1 = all_1.nv; -#line 17364 "" - for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 17365 "" +#line 17351 "" + i__2 = all_1.nv; +#line 17351 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 17352 "" if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[ all_1.iv + 23] == commvl_1.ivx) { -#line 17365 "" +#line 17352 "" goto L129; -#line 17365 "" +#line 17352 "" } -#line 17366 "" +#line 17353 "" /* L128: */ -#line 17366 "" +#line 17353 "" } -#line 17367 "" +#line 17354 "" s_wsle(&io___1048); -#line 17367 "" +#line 17354 "" do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", ( ftnlen)35); -#line 17367 "" +#line 17354 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); -#line 17367 "" +#line 17354 "" do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof( integer)); -#line 17367 "" +#line 17354 "" do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof( integer)); -#line 17367 "" +#line 17354 "" e_wsle(); -#line 17368 "" +#line 17355 "" s_wsle(&io___1049); -#line 17368 "" +#line 17355 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof( integer)); -#line 17368 "" +#line 17355 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof( integer)); -#line 17368 "" +#line 17355 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof( integer)); -#line 17368 "" +#line 17355 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof( integer)); -#line 17368 "" +#line 17355 "" e_wsle(); -#line 17369 "" +#line 17356 "" s_stop("", (ftnlen)0); -#line 17370 "" +#line 17357 "" } -#line 17371 "" +#line 17358 "" L129: /* Call precrd here so we know how much space to add for accid's in chords */ @@ -41162,65 +41422,65 @@ L129: /* * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */ /* * btest(nacc(ivx,ip),21)) then */ /* if (.not.btest(irest(ivx,ip),24)) then */ -#line 17384 "" +#line 17371 "" if (numbms[commvl_1.ivx] > 0 && ibmcnt1[commvl_1.ivx - 1] <= numbms[ commvl_1.ivx] && all_1.ibm1[commvl_1.ivx + ibmcnt1[ commvl_1.ivx - 1] * 24 - 25] == ip) { -#line 17386 "" +#line 17373 "" beamon1[commvl_1.ivx - 1] = TRUE_; -#line 17387 "" +#line 17374 "" } -#line 17388 "" +#line 17375 "" icashft = 0; -#line 17389 "" +#line 17376 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. */ -#line 17393 "" +#line 17380 "" if (beamon1[commvl_1.ivx - 1]) { -#line 17394 "" +#line 17381 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], & all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[ commvl_1.ivx + ip * 24 - 25], all_1.ulq + ( commvl_1.ivx + ibmcnt1[commvl_1.ivx - 1] * 24 - 25), & c_false, &icashft, (ftnlen)1); -#line 17397 "" +#line 17384 "" } else { -#line 17398 "" - i__1 = ncmid_(&all_1.iv, &ip); -#line 17398 "" +#line 17385 "" + i__2 = ncmid_(&all_1.iv, &ip); +#line 17385 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - - 25], &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25], + 25], &i__2, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); -#line 17398 "" +#line 17385 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], & all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[ commvl_1.ivx + ip * 24 - 25], ch__6, &c_false, & icashft, (ftnlen)1); -#line 17402 "" +#line 17389 "" } -#line 17403 "" +#line 17390 "" } /* Turn beam off? */ -#line 17407 "" +#line 17394 "" if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[ commvl_1.ivx - 1] * 24 - 25] == ip) { -#line 17408 "" +#line 17395 "" beamon1[commvl_1.ivx - 1] = FALSE_; -#line 17409 "" +#line 17396 "" ++ibmcnt1[commvl_1.ivx - 1]; -#line 17410 "" +#line 17397 "" } /* Remember, rpts & internal sigs can only come at start of (internal) block */ -#line 17414 "" +#line 17401 "" isacc = (all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10); @@ -41229,7 +41489,7 @@ L129: /* !!! Need to do this for chord notes too. Maybe in chkarp? */ -#line 17422 "" +#line 17409 "" isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0); /* 5/15/02 Add check for ) ornament of prior note. */ @@ -41237,154 +41497,154 @@ L129: /* if (ip .gt. 1) then */ /* isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */ /* end if */ -#line 17429 "" +#line 17416 "" isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27); -#line 17430 "" +#line 17417 "" iscacc = FALSE_; -#line 17431 "" +#line 17418 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord here; check for arpeggios and accidentals. Note accid shifts are */ /* not of concern here, only whether there's an accid, whick causes iscacc=.true. */ -#line 17436 "" +#line 17423 "" iscacc = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__3, &c__0) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17); -#line 17438 "" +#line 17425 "" chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, & iscacc, &isarp); -#line 17439 "" +#line 17426 "" } /* When we get motivated, will do spacing for arpeggios here. */ -#line 17443 "" +#line 17430 "" if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] & 96) > 0) { -#line 17443 "" +#line 17430 "" itrpt = i_nint(&all_1.to[in - 1]); -#line 17443 "" +#line 17430 "" } -#line 17445 "" +#line 17432 "" issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28); -#line 17446 "" +#line 17433 "" if (commvl_1.ivx == 1 && issig) { -#line 17446 "" +#line 17433 "" itsig = i_nint(&all_1.to[in - 1]); -#line 17446 "" +#line 17433 "" } -#line 17447 "" +#line 17434 "" isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31); -#line 17449 "" +#line 17436 "" isgaft = FALSE_; -#line 17450 "" +#line 17437 "" if (ip > 1) { -#line 17451 "" +#line 17438 "" xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 - 25] - 1]; -#line 17452 "" +#line 17439 "" isgaft = bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25], 31); -#line 17453 "" +#line 17440 "" isgrace = isgrace || isgaft; -#line 17454 "" +#line 17441 "" } -#line 17455 "" +#line 17442 "" iscln = isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 11); /* Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd */ -#line 17459 "" +#line 17446 "" isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol; -#line 17460 "" +#line 17447 "" if (isflag) { -#line 17460 "" +#line 17447 "" i__7 = ip - 1; -#line 17460 "" - i__1 = ncmid_(&all_1.iv, &i__7); -#line 17460 "" +#line 17447 "" + i__2 = ncmid_(&all_1.iv, &i__7); +#line 17447 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + (ip - 1) * 24 - - 25], &i__1, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 - + - 25], &i__2, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); -#line 17460 "" +#line 17447 "" isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25] ,0) && *(unsigned char *)&ch__6[0] == 'u'; -#line 17460 "" +#line 17447 "" } -#line 17464 "" +#line 17451 "" if (isflag) { -#line 17465 "" - i__1 = numbms[commvl_1.ivx]; -#line 17465 "" - for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) { -#line 17466 "" +#line 17452 "" + i__2 = numbms[commvl_1.ivx]; +#line 17452 "" + for (ibmchk = 1; ibmchk <= i__2; ++ibmchk) { +#line 17453 "" if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) { -#line 17467 "" +#line 17454 "" goto L117; /* Add check for non-beamed xtuplets. May be problem with stem direction. */ -#line 17471 "" +#line 17458 "" } else if (ip - 1 <= all_1.ibm2[commvl_1.ivx + ibmchk * 24 - 25] && ! bit_test(all_1.islur[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25] * 24 - 25] ,18)) { -#line 17473 "" +#line 17460 "" isflag = FALSE_; -#line 17474 "" +#line 17461 "" goto L117; -#line 17475 "" +#line 17462 "" } -#line 17476 "" +#line 17463 "" /* L116: */ -#line 17476 "" +#line 17463 "" } -#line 17477 "" +#line 17464 "" } -#line 17478 "" +#line 17465 "" L117: /* If isflag, then won't need to check for dot on prev. note. */ /* 5/16/02 ??? Try using this for ) ornament. */ -#line 17484 "" +#line 17471 "" isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24 - 1],13); -#line 17485 "" +#line 17472 "" isdot = ip > 1; -#line 17486 "" +#line 17473 "" if (isdot) { -#line 17486 "" - i__1 = ip - 1; -#line 17486 "" - isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1); -#line 17486 "" +#line 17473 "" + i__2 = ip - 1; +#line 17473 "" + isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__2); +#line 17473 "" } -#line 17487 "" +#line 17474 "" isrshft = ip > 1; -#line 17488 "" +#line 17475 "" if (isrshft) { -#line 17488 "" +#line 17475 "" isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], 20); -#line 17488 "" +#line 17475 "" } -#line 17489 "" +#line 17476 "" if (! (isaccs || isgrace || iscln || isflag || isrshft || isdot || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],21) || isarp || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27) || iscacc)) { -#line 17489 "" +#line 17476 "" goto L111; -#line 17489 "" +#line 17476 "" } /* Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */ @@ -41392,71 +41652,71 @@ L117: /* 130324 */ /* wheadpt1 = wheadpt*fullsize(iv) */ -#line 17499 "" +#line 17486 "" wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[ all_1.iv - 1] - 1]; -#line 17500 "" +#line 17487 "" pts = wheadpt1; /* Set up for possible cautionary accidental here */ -#line 17504 "" +#line 17491 "" if (isaccs || iscacc) { -#line 17505 "" +#line 17492 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) { -#line 17506 "" +#line 17493 "" taccfac = spfacs_1.accfac; -#line 17507 "" +#line 17494 "" } else { -#line 17508 "" +#line 17495 "" taccfac = spfacs_1.accfac * 1.4f; /* cautionary accidental */ -#line 17509 "" +#line 17496 "" } -#line 17510 "" +#line 17497 "" } -#line 17511 "" +#line 17498 "" if (isgrace) { -#line 17512 "" +#line 17499 "" secondgrace = FALSE_; -#line 17513 "" - i__1 = comgrace_1.ngrace; -#line 17513 "" - for (ig = 1; ig <= i__1; ++ig) { -#line 17514 "" +#line 17500 "" + i__2 = comgrace_1.ngrace; +#line 17500 "" + for (ig = 1; ig <= i__2; ++ig) { +#line 17501 "" if (! isgaft) { -#line 17515 "" +#line 17502 "" if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { -#line 17515 "" +#line 17502 "" goto L123; -#line 17515 "" +#line 17502 "" } -#line 17516 "" +#line 17503 "" } else if (ip > 1) { -#line 17517 "" +#line 17504 "" if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { -#line 17517 "" +#line 17504 "" goto L123; -#line 17517 "" +#line 17504 "" } -#line 17518 "" +#line 17505 "" } -#line 17519 "" +#line 17506 "" /* L122: */ -#line 17519 "" +#line 17506 "" } -#line 17520 "" +#line 17507 "" s_wsle(&io___1069); -#line 17520 "" +#line 17507 "" do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", ( ftnlen)39); -#line 17520 "" +#line 17507 "" e_wsle(); -#line 17521 "" +#line 17508 "" s_stop("", (ftnlen)0); -#line 17522 "" +#line 17509 "" L123: /* wgr = distance to backspace (in headwidths), less main acc. */ @@ -41464,146 +41724,146 @@ L123: /* spgr = total space needed (w/o main acc). */ /* Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. */ -#line 17529 "" +#line 17516 "" if (comgrace_1.nng[ig - 1] == 1) { -#line 17530 "" +#line 17517 "" wgr = spfacs_1.grafac; -#line 17531 "" +#line 17518 "" if (comgrace_1.multg[ig - 1] == 0) { -#line 17531 "" +#line 17518 "" wgr += -.4f; -#line 17531 "" +#line 17518 "" } -#line 17532 "" +#line 17519 "" } else { -#line 17533 "" +#line 17520 "" wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; -#line 17534 "" - i__1 = comgrace_1.nng[ig - 1]; -#line 17534 "" - for (ing = 2; ing <= i__1; ++ing) { -#line 17535 "" +#line 17521 "" + i__2 = comgrace_1.nng[ig - 1]; +#line 17521 "" + for (ing = 2; ing <= i__2; ++ing) { +#line 17522 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing - 1] > 0) { -#line 17535 "" +#line 17522 "" wgr += spfacs_1.acgfac; -#line 17535 "" +#line 17522 "" } -#line 17536 "" +#line 17523 "" /* L126: */ -#line 17536 "" +#line 17523 "" } -#line 17537 "" +#line 17524 "" } -#line 17538 "" +#line 17525 "" if (comgrace_1.graspace[ig - 1] > 0.f) { /* User-defined space before grace */ -#line 17542 "" +#line 17529 "" wgr += comgrace_1.graspace[ig - 1]; -#line 17543 "" +#line 17530 "" } -#line 17544 "" +#line 17531 "" ptgr[ig - 1] = wgr * wheadpt1; -#line 17545 "" +#line 17532 "" spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1; /* !!! May need to mod for chord accid's */ -#line 17549 "" +#line 17536 "" if (isaccs || iscacc) { -#line 17549 "" +#line 17536 "" ptgr[ig - 1] += taccfac * wheadpt1; -#line 17549 "" +#line 17536 "" } -#line 17550 "" +#line 17537 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) { -#line 17550 "" +#line 17537 "" spgr += wheadpt1 * spfacs_1.agc1fac; -#line 17550 "" +#line 17537 "" } -#line 17551 "" +#line 17538 "" pts += spgr; /* Special check for after-grace on ip-1 and normal on ip. Must go back thru */ /* loop again for the normal grace. */ -#line 17556 "" +#line 17543 "" if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) { -#line 17557 "" +#line 17544 "" if (comgrace_1.ipg[ig] == ip) { -#line 17558 "" +#line 17545 "" secondgrace = TRUE_; -#line 17559 "" +#line 17546 "" ++ig; -#line 17560 "" +#line 17547 "" goto L123; -#line 17561 "" +#line 17548 "" } -#line 17562 "" +#line 17549 "" } -#line 17563 "" +#line 17550 "" } -#line 17564 "" +#line 17551 "" if (iscln) { -#line 17565 "" +#line 17552 "" pts += spfacs_1.clefac * wheadpt1; /* How far to backspace when printing the clef */ -#line 17569 "" +#line 17556 "" ptclef[commvl_1.ivx - 1] = 0.f; /* !!! May need to mod for chord accid's */ -#line 17573 "" +#line 17560 "" if (isaccs || iscacc) { -#line 17573 "" +#line 17560 "" ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1; -#line 17573 "" +#line 17560 "" } -#line 17575 "" +#line 17562 "" if (isgrace) { -#line 17575 "" +#line 17562 "" ptclef[commvl_1.ivx - 1] += spgr; -#line 17575 "" +#line 17562 "" } -#line 17576 "" +#line 17563 "" } -#line 17577 "" +#line 17564 "" if (isrshft) { -#line 17578 "" +#line 17565 "" pts += spfacs_1.rtshfac * wheadpt1; -#line 17579 "" +#line 17566 "" } else if (isflag) { -#line 17580 "" +#line 17567 "" pts += spfacs_1.flagfac * wheadpt1; -#line 17581 "" +#line 17568 "" } else if (isdot) { -#line 17582 "" +#line 17569 "" pts += spfacs_1.dotfac * wheadpt1; -#line 17583 "" +#line 17570 "" } -#line 17584 "" +#line 17571 "" if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) { /* Repeat, need a little extra space */ -#line 17588 "" +#line 17575 "" pts += spfacs_1.dotsfac * wheadpt1; -#line 17589 "" +#line 17576 "" } -#line 17590 "" +#line 17577 "" if (isarp) { -#line 17591 "" +#line 17578 "" pts += spfacs_1.arpfac * wheadpt1; -#line 17592 "" +#line 17579 "" } /* Add in padding space */ -#line 17596 "" +#line 17583 "" pts += spfacs_1.xspfac * wheadpt1; /* Now done with all items needing space except accidentals, */ @@ -41612,37 +41872,37 @@ L123: /* Get available space in elemskips (esk) */ -#line 17604 "" +#line 17591 "" isfirst = ip == 1 || (r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol || (r__2 = all_1.to[in - 1] - itsig, dabs(r__2)) < comtol_1.tol; -#line 17606 "" +#line 17593 "" if (isfirst) { /* At start of bar or after repeat sign or new signature */ -#line 17610 "" +#line 17597 "" if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol) { -#line 17611 "" +#line 17598 "" esk = 0.f; -#line 17612 "" +#line 17599 "" } else { -#line 17613 "" +#line 17600 "" esk = comask_1.fbar; -#line 17614 "" +#line 17601 "" } -#line 17615 "" +#line 17602 "" } else { /* Not 1st note of bar */ -#line 17619 "" +#line 17606 "" esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ commvl_1.ivx + (ip - 1) * 24 - 25]; -#line 17620 "" +#line 17607 "" } -#line 17621 "" +#line 17608 "" if (isgrace) { /* Since graces can be very long, cannot assume no interference if prior */ @@ -41652,1062 +41912,1062 @@ L123: /* 10/8/05 Kluge to not zero out esk if in xtup */ -#line 17630 "" +#line 17617 "" esksav = esk; /* Computing MAX */ -#line 17631 "" - i__1 = 1, i__7 = ip - 2; -#line 17631 "" - if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__1,i__7) * 24 - +#line 17618 "" + i__2 = 1, i__7 = ip - 2; +#line 17618 "" + if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__2,i__7) * 24 - 25] > 0) && (r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) > comtol_1.tol) { -#line 17631 "" +#line 17618 "" eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[ 1], &comask_1.fbar, &itrpt, &esk); -#line 17631 "" +#line 17618 "" } /* * to(in).ne.itsig) */ -#line 17635 "" +#line 17622 "" if (dabs(esk) < comtol_1.tol) { -#line 17635 "" +#line 17622 "" esk = esksav; -#line 17635 "" +#line 17622 "" } -#line 17636 "" +#line 17623 "" } /* Done getting available elemskips. Remove headwidth if first. Must do here */ /* rather than earlier since check uses isfirst */ -#line 17641 "" +#line 17628 "" if (isfirst) { -#line 17641 "" +#line 17628 "" pts -= wheadpt1; -#line 17641 "" +#line 17628 "" } /* Deal with accidental shifts and left-notehead shifts */ -#line 17645 "" +#line 17632 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* In a chord */ -#line 17649 "" +#line 17636 "" ptsl = 0.f; -#line 17650 "" +#line 17637 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) { -#line 17650 "" +#line 17637 "" ptsl = wheadpt1; -#line 17650 "" +#line 17637 "" } /* Computing MAX */ -#line 17651 "" +#line 17638 "" r__1 = ptsl, r__2 = icashft * .05f * wheadpt1; -#line 17651 "" +#line 17638 "" ptsadd = dmax(r__1,r__2); /* Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */ -#line 17655 "" +#line 17642 "" } else { /* Not in a chord */ -#line 17659 "" +#line 17646 "" ihshft = 0; -#line 17660 "" +#line 17647 "" if (isaccs) { -#line 17661 "" +#line 17648 "" ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__7, &c__10); /* if (ihshft .ne. 0) ihshft = max(0,64-ihshft) */ -#line 17663 "" +#line 17650 "" if (ihshft != 0) { /* Computing MAX */ -#line 17663 "" - i__1 = 0, i__7 = 107 - ihshft; -#line 17663 "" - ihshft = max(i__1,i__7); -#line 17663 "" +#line 17650 "" + i__2 = 0, i__7 = 107 - ihshft; +#line 17650 "" + ihshft = max(i__2,i__7); +#line 17650 "" } -#line 17664 "" +#line 17651 "" } /* Check for left-shifted main note */ -#line 17668 "" +#line 17655 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { -#line 17668 "" +#line 17655 "" ihshft = max(20,ihshft); -#line 17668 "" +#line 17655 "" } -#line 17669 "" +#line 17656 "" ptsadd = ihshft * .05f * wheadpt1; -#line 17670 "" +#line 17657 "" } -#line 17671 "" +#line 17658 "" pts += ptsadd; -#line 17672 "" +#line 17659 "" if (isgrace) { -#line 17672 "" +#line 17659 "" ptgr[ig - 1] += ptsadd; -#line 17672 "" +#line 17659 "" } -#line 17673 "" +#line 17660 "" if (iscln) { -#line 17673 "" +#line 17660 "" ptclef[commvl_1.ivx - 1] += ptsadd; -#line 17673 "" +#line 17660 "" } /* Left-shifted, non-chord note before? */ -#line 17677 "" +#line 17664 "" if (ip > 1) { -#line 17678 "" +#line 17665 "" if (! bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],10) && bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], 27)) { -#line 17678 "" +#line 17665 "" pts -= wheadpt1; -#line 17678 "" +#line 17665 "" } -#line 17680 "" +#line 17667 "" } /* Try big accidentals first */ -#line 17684 "" +#line 17671 "" ptbneed = pts; -#line 17685 "" +#line 17672 "" if (isaccs || iscacc) { -#line 17686 "" +#line 17673 "" ptbneed += wheadpt1 * spfacs_1.bacfac; -#line 17687 "" +#line 17674 "" } -#line 17688 "" +#line 17675 "" if (comshort_1.poefa[all_1.iline - 1] * comask_1.poenom * esk > ptbneed) { /* Set flag for big accidental */ -#line 17692 "" +#line 17679 "" if (isacc) { -#line 17692 "" +#line 17679 "" all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],3); -#line 17692 "" +#line 17679 "" } -#line 17693 "" +#line 17680 "" goto L99; -#line 17694 "" +#line 17681 "" } /* Cannot use big, so try small */ -#line 17698 "" +#line 17685 "" ptsneed = pts; -#line 17699 "" +#line 17686 "" if (isaccs || iscacc) { -#line 17700 "" +#line 17687 "" ptsneed += taccfac * wheadpt1; -#line 17701 "" +#line 17688 "" } -#line 17702 "" +#line 17689 "" if (comshort_1.poefa[all_1.iline - 1] * comask_1.poenom * esk < ptsneed) { -#line 17703 "" +#line 17690 "" r__1 = comshort_1.poefa[all_1.iline - 1] * esk; -#line 17703 "" +#line 17690 "" addask_(&all_1.to[in - 1], &ptsneed, &r__1, &comask_1.fixednew, & comask_1.scaldold, &c_b1008, &comshort_1.poefa[ all_1.iline - 1], &c_false); -#line 17705 "" +#line 17692 "" } -#line 17706 "" +#line 17693 "" L99: -#line 17707 "" +#line 17694 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) { /* User-defined space. Warning, "zero" may change value in addask! */ -#line 17711 "" +#line 17698 "" zero = 0.f; -#line 17712 "" +#line 17699 "" addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, & comask_1.scaldold, tglp1, &c_b1053, &c_true); -#line 17714 "" +#line 17701 "" } /* End of big manual loop over "in" for accidental checking */ -#line 17718 "" +#line 17705 "" goto L111; -#line 17719 "" +#line 17706 "" L112: /* End of ask analysis for this block. */ /* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */ -#line 17725 "" +#line 17712 "" if (comas1_1.naskb > 0) { -#line 17725 "" +#line 17712 "" adjusteskz_(&ib, &istart[1], &comask_1.poenom); -#line 17725 "" +#line 17712 "" } /* Check for internal repeat or sig change. */ -#line 17729 "" +#line 17716 "" if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) { -#line 17730 "" +#line 17717 "" iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] & 67109216; -#line 17731 "" +#line 17718 "" if (iirpt > 0) { /* Internal repeat */ -#line 17735 "" +#line 17722 "" if (comlast_1.islast) { -#line 17735 "" +#line 17722 "" s_wsfe(&io___1085); /* Writing concatenation */ -#line 17735 "" +#line 17722 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 17735 "" +#line 17722 "" i__9[1] = 7, a__6[1] = "advance"; -#line 17735 "" +#line 17722 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 17735 "" +#line 17722 "" i__9[3] = 8, a__6[3] = "barno-1%"; -#line 17735 "" +#line 17722 "" s_cat(ch__7, a__6, i__9, &c__4, (ftnlen)17); -#line 17735 "" +#line 17722 "" do_fio(&c__1, ch__7, (ftnlen)17); -#line 17735 "" +#line 17722 "" e_wsfe(); -#line 17735 "" +#line 17722 "" } -#line 17736 "" +#line 17723 "" if (iirpt == 96) { -#line 17737 "" +#line 17724 "" if (comlast_1.islast) { -#line 17737 "" +#line 17724 "" s_wsfe(&io___1086); /* Writing concatenation */ -#line 17737 "" +#line 17724 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17737 "" +#line 17724 "" i__4[1] = 15, a__2[1] = "leftrightrepeat"; -#line 17737 "" +#line 17724 "" s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)16); -#line 17737 "" +#line 17724 "" do_fio(&c__1, ch__8, (ftnlen)16); -#line 17737 "" +#line 17724 "" e_wsfe(); -#line 17737 "" +#line 17724 "" } -#line 17738 "" +#line 17725 "" comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt; -#line 17739 "" +#line 17726 "" } else if (bit_test(iirpt,5)) { -#line 17740 "" +#line 17727 "" if (comlast_1.islast) { -#line 17740 "" +#line 17727 "" s_wsfe(&io___1087); /* Writing concatenation */ -#line 17740 "" +#line 17727 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17740 "" +#line 17727 "" i__4[1] = 10, a__2[1] = "leftrepeat"; -#line 17740 "" +#line 17727 "" s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); -#line 17740 "" +#line 17727 "" do_fio(&c__1, ch__9, (ftnlen)11); -#line 17740 "" +#line 17727 "" e_wsfe(); -#line 17740 "" +#line 17727 "" } -#line 17741 "" +#line 17728 "" comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; -#line 17742 "" +#line 17729 "" } else if (bit_test(iirpt,6)) { -#line 17743 "" +#line 17730 "" if (comlast_1.islast) { -#line 17743 "" +#line 17730 "" s_wsfe(&io___1088); /* Writing concatenation */ -#line 17743 "" +#line 17730 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17743 "" +#line 17730 "" i__4[1] = 11, a__2[1] = "rightrepeat"; -#line 17743 "" +#line 17730 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); -#line 17743 "" +#line 17730 "" do_fio(&c__1, ch__5, (ftnlen)12); -#line 17743 "" +#line 17730 "" e_wsfe(); -#line 17743 "" +#line 17730 "" } -#line 17744 "" +#line 17731 "" comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; -#line 17745 "" +#line 17732 "" } else if (bit_test(iirpt,8)) { -#line 17746 "" +#line 17733 "" if (comlast_1.islast) { -#line 17746 "" +#line 17733 "" s_wsfe(&io___1089); /* Writing concatenation */ -#line 17746 "" +#line 17733 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17746 "" +#line 17733 "" i__4[1] = 9, a__2[1] = "doublebar"; -#line 17746 "" +#line 17733 "" s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); -#line 17746 "" +#line 17733 "" do_fio(&c__1, ch__10, (ftnlen)10); -#line 17746 "" +#line 17733 "" e_wsfe(); -#line 17746 "" +#line 17733 "" } -#line 17747 "" +#line 17734 "" } else { -#line 17748 "" +#line 17735 "" s_wsle(&io___1090); -#line 17748 "" +#line 17735 "" do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "\ "R*", (ftnlen)36); -#line 17748 "" +#line 17735 "" e_wsle(); -#line 17749 "" +#line 17736 "" stop1_(); -#line 17750 "" +#line 17737 "" } -#line 17751 "" +#line 17738 "" comask_1.scaldold -= comask_1.fbar; -#line 17752 "" +#line 17739 "" } -#line 17753 "" +#line 17740 "" if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) { /* Internal signature change. */ /* Writing concatenation */ -#line 17757 "" +#line 17744 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17757 "" +#line 17744 "" i__4[1] = 17, a__2[1] = "generalsignature{"; -#line 17757 "" +#line 17744 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17758 "" +#line 17745 "" lnote = 18; -#line 17759 "" +#line 17746 "" if (comtop_1.isig < 0) { /* Writing concatenation */ -#line 17760 "" +#line 17747 "" i__4[0] = lnote, a__2[0] = notexq; -#line 17760 "" +#line 17747 "" i__4[1] = 1, a__2[1] = "-"; -#line 17760 "" +#line 17747 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17761 "" +#line 17748 "" ++lnote; -#line 17762 "" +#line 17749 "" } -#line 17763 "" +#line 17750 "" if (comlast_1.islast) { -#line 17763 "" +#line 17750 "" s_wsfe(&io___1091); /* Writing concatenation */ -#line 17763 "" +#line 17750 "" i__6[0] = lnote, a__4[0] = notexq; -#line 17763 "" - i__1 = abs(comtop_1.isig) + 48; -#line 17763 "" - chax_(ch__6, (ftnlen)1, &i__1); -#line 17763 "" +#line 17750 "" + i__2 = abs(comtop_1.isig) + 48; +#line 17750 "" + chax_(ch__6, (ftnlen)1, &i__2); +#line 17750 "" i__6[1] = 1, a__4[1] = ch__6; -#line 17763 "" +#line 17750 "" i__6[2] = 2, a__4[2] = "}%"; -#line 17763 "" +#line 17750 "" s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); -#line 17763 "" +#line 17750 "" do_fio(&c__1, ch__2, lnote + 3); -#line 17763 "" +#line 17750 "" e_wsfe(); -#line 17763 "" +#line 17750 "" } -#line 17765 "" +#line 17752 "" if (comlast_1.islast && comignorenats_1.ignorenats) { -#line 17765 "" +#line 17752 "" s_wsfe(&io___1092); /* Writing concatenation */ -#line 17765 "" +#line 17752 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17765 "" +#line 17752 "" i__4[1] = 11, a__2[1] = "ignorenats%"; -#line 17765 "" +#line 17752 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); -#line 17765 "" +#line 17752 "" do_fio(&c__1, ch__5, (ftnlen)12); -#line 17765 "" +#line 17752 "" e_wsfe(); -#line 17765 "" +#line 17752 "" } -#line 17767 "" +#line 17754 "" if (comlast_1.islast) { -#line 17767 "" +#line 17754 "" s_wsfe(&io___1093); /* Writing concatenation */ -#line 17767 "" +#line 17754 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 17767 "" +#line 17754 "" i__3[1] = 14, a__1[1] = "zchangecontext"; -#line 17767 "" +#line 17754 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 17767 "" +#line 17754 "" i__3[3] = 12, a__1[3] = "addspace{-.5"; -#line 17767 "" +#line 17754 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 17767 "" +#line 17754 "" i__3[5] = 15, a__1[5] = "afterruleskip}%"; -#line 17767 "" +#line 17754 "" s_cat(ch__11, a__1, i__3, &c__6, (ftnlen)44); -#line 17767 "" +#line 17754 "" do_fio(&c__1, ch__11, (ftnlen)44); -#line 17767 "" +#line 17754 "" e_wsfe(); -#line 17767 "" +#line 17754 "" } -#line 17769 "" +#line 17756 "" lnote = 0; -#line 17770 "" +#line 17757 "" } -#line 17771 "" +#line 17758 "" } -#line 17772 "" +#line 17759 "" comnsp_2.flgndb = FALSE_; /* Done with start-of-block stuff. Begin main loop over voices. */ -#line 17776 "" - i__1 = all_1.nv; -#line 17776 "" - for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 17777 "" +#line 17763 "" + i__2 = all_1.nv; +#line 17763 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 17764 "" i__7 = commvl_1.nvmx[all_1.iv - 1]; -#line 17777 "" +#line 17764 "" for (kv = 1; kv <= i__7; ++kv) { -#line 17778 "" +#line 17765 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 17779 "" +#line 17766 "" icm = commidi_1.midchan[all_1.iv + kv * 24 - 25]; /* A rather klugey way to set flag for figure in this voice */ /* Must always check figbass before figchk. */ -#line 17784 "" +#line 17771 "" if (all_1.figbass) { -#line 17785 "" +#line 17772 "" ivf = 0; -#line 17786 "" +#line 17773 "" if (commvl_1.ivx == 1) { -#line 17787 "" +#line 17774 "" ivf = 1; -#line 17788 "" +#line 17775 "" } else if (commvl_1.ivx == comfig_1.ivxfig2) { -#line 17789 "" +#line 17776 "" ivf = 2; -#line 17790 "" +#line 17777 "" } -#line 17791 "" +#line 17778 "" if (ivf > 0) { -#line 17791 "" +#line 17778 "" all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0; -#line 17791 "" +#line 17778 "" } -#line 17792 "" +#line 17779 "" } -#line 17793 "" +#line 17780 "" if (commvl_1.ivx > 1) { -#line 17794 "" +#line 17781 "" if (commvl_1.ivx <= all_1.nv) { -#line 17795 "" +#line 17782 "" addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); -#line 17796 "" +#line 17783 "" } else { /* Writing concatenation */ -#line 17797 "" +#line 17784 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17797 "" +#line 17784 "" i__4[1] = 9, a__2[1] = "nextvoice"; -#line 17797 "" +#line 17784 "" s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); -#line 17797 "" +#line 17784 "" addstr_(ch__10, &c__10, soutq, &lsout, (ftnlen)10, ( ftnlen)80); -#line 17798 "" +#line 17785 "" } -#line 17799 "" +#line 17786 "" } -#line 17800 "" +#line 17787 "" if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) { /* Write header. First adjust height if needed to miss barno. */ -#line 17804 "" +#line 17791 "" if (comask_1.bar1syst && all_1.iline != 1) { -#line 17805 "" +#line 17792 "" comhead_1.ihdht = comsln_1.irzbnd + 15 + comsln_1.isnx; -#line 17806 "" +#line 17793 "" } /* Add user-defined vertical shift */ -#line 17810 "" +#line 17797 "" comhead_1.ihdht += comhead_1.ihdvrt; -#line 17811 "" +#line 17798 "" lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80); /* Writing concatenation */ -#line 17812 "" +#line 17799 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17812 "" +#line 17799 "" i__4[1] = 10, a__2[1] = "zcharnote{"; -#line 17812 "" +#line 17799 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17813 "" +#line 17800 "" s_wsfi(&io___1097); -#line 17813 "" +#line 17800 "" do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof( integer)); -#line 17813 "" +#line 17800 "" e_wsfi(); /* Writing concatenation */ -#line 17814 "" +#line 17801 "" i__3[0] = 13, a__1[0] = notexq; -#line 17814 "" +#line 17801 "" i__3[1] = 2, a__1[1] = "}{"; -#line 17814 "" +#line 17801 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 17814 "" +#line 17801 "" i__3[3] = 7, a__1[3] = "bigfont"; -#line 17814 "" +#line 17801 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 17814 "" +#line 17801 "" i__3[5] = 10, a__1[5] = "kern-30pt "; -#line 17814 "" +#line 17801 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); -#line 17815 "" +#line 17802 "" addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, ( ftnlen)80); /* Writing concatenation */ -#line 17816 "" +#line 17803 "" i__4[0] = lchead, a__2[0] = comhead_1.headrq; -#line 17816 "" +#line 17803 "" i__4[1] = 1, a__2[1] = "}"; -#line 17816 "" +#line 17803 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); -#line 17816 "" +#line 17803 "" i__10 = lchead + 1; -#line 17816 "" +#line 17803 "" addstr_(ch__12, &i__10, soutq, &lsout, lchead + 1, ( ftnlen)80); -#line 17817 "" +#line 17804 "" comhead_1.ihdht = 0; -#line 17818 "" +#line 17805 "" } -#line 17819 "" +#line 17806 "" if (comhead_1.lower && commvl_1.ivx == all_1.nv) { -#line 17820 "" +#line 17807 "" lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80); /* Writing concatenation */ -#line 17821 "" +#line 17808 "" i__11[0] = 1, a__7[0] = all_1.sq; -#line 17821 "" +#line 17808 "" i__11[1] = 14, a__7[1] = "zcharnote{-6}{"; -#line 17821 "" +#line 17808 "" i__11[2] = 1, a__7[2] = all_1.sq; -#line 17821 "" +#line 17808 "" i__11[3] = 5, a__7[3] = "tempo"; -#line 17821 "" +#line 17808 "" i__11[4] = 1, a__7[4] = all_1.sq; -#line 17821 "" +#line 17808 "" i__11[5] = 10, a__7[5] = "kern-10pt "; -#line 17821 "" +#line 17808 "" i__11[6] = lclow, a__7[6] = comhead_1.lowerq; -#line 17821 "" +#line 17808 "" i__11[7] = 1, a__7[7] = "}"; -#line 17821 "" +#line 17808 "" s_cat(ch__13, a__7, i__11, &c__8, (ftnlen)113); -#line 17821 "" +#line 17808 "" i__10 = lclow + 33; -#line 17821 "" +#line 17808 "" addstr_(ch__13, &i__10, soutq, &lsout, lclow + 33, ( ftnlen)80); -#line 17824 "" +#line 17811 "" comhead_1.lower = FALSE_; -#line 17825 "" +#line 17812 "" } -#line 17826 "" +#line 17813 "" tnow = tstart[ib]; -#line 17827 "" +#line 17814 "" nofirst = TRUE_; /* Done setting up voice ivx for start of block ib. Loop over notes in voice. */ -#line 17831 "" +#line 17818 "" i__10 = istop[ib]; -#line 17831 "" +#line 17818 "" for (all_1.jn = istart[ib]; all_1.jn <= i__10; ++all_1.jn) { -#line 17832 "" +#line 17819 "" if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) { -#line 17832 "" +#line 17819 "" goto L10; -#line 17832 "" +#line 17819 "" } -#line 17833 "" +#line 17820 "" ip = all_1.ipo[all_1.jn - 1]; /* May have problem with not initializing islhgt, so do it here */ -#line 17837 "" +#line 17824 "" islhgt = 0; -#line 17839 "" +#line 17826 "" if (nofirst) { -#line 17840 "" +#line 17827 "" comoct_1.noctup = 0; -#line 17841 "" +#line 17828 "" if (ncmid_(&all_1.iv, &ip) == 23) { -#line 17841 "" +#line 17828 "" comoct_1.noctup = -2; -#line 17841 "" +#line 17828 "" } -#line 17842 "" +#line 17829 "" nofirst = FALSE_; -#line 17843 "" +#line 17830 "" } /* Check for internal floating figure (before last note of group). */ -#line 17847 "" +#line 17834 "" L12: -#line 17847 "" +#line 17834 "" if (all_1.figbass) { -#line 17848 "" +#line 17835 "" if (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { -#line 17849 "" +#line 17836 "" ivf = 1; -#line 17850 "" +#line 17837 "" if (commvl_1.ivx > 1) { -#line 17850 "" +#line 17837 "" ivf = 2; -#line 17850 "" +#line 17837 "" } -#line 17851 "" +#line 17838 "" if (all_1.figchk[ivf - 1] && (real) comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3] < tnow - comtol_1.tol) { /* Bypassed figure location. Backup, place fig, return. */ -#line 17856 "" +#line 17843 "" offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ ivf - 1] << 1) - 3]) / comnsp_2.space[ ib - 1]; -#line 17857 "" +#line 17844 "" putfig_(&ivf, &ifig[ivf - 1], &offnsk, & all_1.figchk[ivf - 1], soutq, &lsout, (ftnlen)80); -#line 17859 "" +#line 17846 "" goto L12; -#line 17860 "" +#line 17847 "" } -#line 17861 "" +#line 17848 "" } -#line 17862 "" +#line 17849 "" } /* Put in \sk if needed */ -#line 17866 "" +#line 17853 "" if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) { /* Writing concatenation */ -#line 17867 "" +#line 17854 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17867 "" +#line 17854 "" i__4[1] = 2, a__2[1] = "sk"; -#line 17867 "" +#line 17854 "" s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); -#line 17867 "" +#line 17854 "" addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, ( ftnlen)80); -#line 17868 "" +#line 17855 "" tnow += comnsp_2.space[ib - 1]; -#line 17869 "" +#line 17856 "" goto L12; -#line 17870 "" +#line 17857 "" } /* Check for user-defined shifts */ -#line 17874 "" +#line 17861 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],16)) { -#line 17874 "" +#line 17861 "" putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, ( ftnlen)80); -#line 17874 "" +#line 17861 "" } -#line 17876 "" +#line 17863 "" L21: -#line 17876 "" +#line 17863 "" if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow > comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] - comtol_1.tol) { -#line 17878 "" +#line 17865 "" if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] > tstart[ib] - comtol_1.tol) { /* Insert placeholder for accidental skip */ /* Writing concatenation */ -#line 17882 "" +#line 17869 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17882 "" +#line 17869 "" i__4[1] = 8, a__2[1] = "ask "; -#line 17882 "" +#line 17869 "" s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)9); -#line 17882 "" +#line 17869 "" addstr_(ch__15, &c__9, soutq, &lsout, (ftnlen)9, ( ftnlen)80); -#line 17883 "" +#line 17870 "" ++comas2_1.nasksys; -#line 17884 "" +#line 17871 "" comas2_1.wasksys[comas2_1.nasksys - 1] = comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] ; -#line 17885 "" +#line 17872 "" if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] > 0.f) { -#line 17886 "" +#line 17873 "" comas2_1.elasksys[comas2_1.nasksys - 1] = comas1_1.elask[iaskb[commvl_1.ivx - 1] - 1]; -#line 17887 "" +#line 17874 "" } else { /* This is a signal to permit negative ask's. Should really have elask>=0. */ -#line 17891 "" +#line 17878 "" comas2_1.elasksys[comas2_1.nasksys - 1] = -comas1_1.elask[iaskb[commvl_1.ivx - 1] - 1]; -#line 17892 "" +#line 17879 "" } -#line 17893 "" +#line 17880 "" } /* May have skipped some task's in earlier blocks (due to void voice) */ -#line 17897 "" +#line 17884 "" ++iaskb[commvl_1.ivx - 1]; -#line 17898 "" +#line 17885 "" goto L21; -#line 17899 "" +#line 17886 "" } -#line 17900 "" +#line 17887 "" if (all_1.figbass) { -#line 17901 "" +#line 17888 "" if (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { -#line 17902 "" +#line 17889 "" ivf = 1; -#line 17903 "" +#line 17890 "" if (commvl_1.ivx > 1) { -#line 17903 "" +#line 17890 "" ivf = 2; -#line 17903 "" +#line 17890 "" } -#line 17904 "" +#line 17891 "" if (all_1.figchk[ivf - 1] && (r__1 = comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3] - tnow, dabs(r__1)) < comtol_1.tol) { /* Figure on a note. NB: later special check for late figs. */ -#line 17909 "" +#line 17896 "" putfig_(&ivf, &ifig[ivf - 1], &c_b1008, & all_1.figchk[ivf - 1], soutq, &lsout, (ftnlen)80); -#line 17910 "" +#line 17897 "" } -#line 17911 "" +#line 17898 "" } -#line 17912 "" +#line 17899 "" } /* Check for new clef here. */ -#line 17916 "" +#line 17903 "" if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],11)) { -#line 17917 "" +#line 17904 "" if (ptclef[all_1.iv - 1] > 0.f) { /* Writing concatenation */ -#line 17918 "" +#line 17905 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17918 "" +#line 17905 "" i__4[1] = 5, a__2[1] = "off{-"; -#line 17918 "" +#line 17905 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17919 "" +#line 17906 "" if (ptclef[all_1.iv - 1] < 9.95f) { -#line 17920 "" +#line 17907 "" s_wsfi(&io___1103); -#line 17920 "" +#line 17907 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); -#line 17920 "" +#line 17907 "" e_wsfi(); -#line 17921 "" +#line 17908 "" lnote = 9; -#line 17922 "" +#line 17909 "" } else { -#line 17923 "" +#line 17910 "" s_wsfi(&io___1104); -#line 17923 "" +#line 17910 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); -#line 17923 "" +#line 17910 "" e_wsfi(); -#line 17924 "" +#line 17911 "" lnote = 10; -#line 17925 "" +#line 17912 "" } /* Writing concatenation */ -#line 17926 "" +#line 17913 "" i__4[0] = lnote, a__2[0] = notexq; -#line 17926 "" +#line 17913 "" i__4[1] = 3, a__2[1] = "pt}"; -#line 17926 "" +#line 17913 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17927 "" +#line 17914 "" lnote += 3; -#line 17928 "" +#line 17915 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); -#line 17929 "" +#line 17916 "" } -#line 17930 "" +#line 17917 "" clefsym_(&all_1.islur[all_1.iv + ip * 24 - 25], notexq, &lnote, &nclef, (ftnlen)79); /* 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' */ -#line 17934 "" +#line 17921 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],2) ) { /* Writing concatenation */ -#line 17934 "" +#line 17921 "" i__6[0] = 8, a__4[0] = notexq; -#line 17934 "" +#line 17921 "" i__6[1] = 1, a__4[1] = "8"; -#line 17934 "" +#line 17921 "" i__6[2] = 1, a__4[2] = notexq + 9; -#line 17934 "" +#line 17921 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); -#line 17934 "" +#line 17921 "" } -#line 17936 "" +#line 17923 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 17937 "" +#line 17924 "" if (ptclef[all_1.iv - 1] > 0.f) { /* Writing concatenation */ -#line 17938 "" +#line 17925 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 17938 "" +#line 17925 "" i__4[1] = 4, a__2[1] = "off{"; -#line 17938 "" +#line 17925 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17939 "" +#line 17926 "" if (ptclef[all_1.iv - 1] < 9.95f) { -#line 17940 "" +#line 17927 "" s_wsfi(&io___1106); -#line 17940 "" +#line 17927 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); -#line 17940 "" +#line 17927 "" e_wsfi(); -#line 17941 "" +#line 17928 "" lnote = 8; -#line 17942 "" +#line 17929 "" } else { -#line 17943 "" +#line 17930 "" s_wsfi(&io___1107); -#line 17943 "" +#line 17930 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); -#line 17943 "" +#line 17930 "" e_wsfi(); -#line 17944 "" +#line 17931 "" lnote = 9; -#line 17945 "" +#line 17932 "" } /* Writing concatenation */ -#line 17946 "" +#line 17933 "" i__4[0] = lnote, a__2[0] = notexq; -#line 17946 "" +#line 17933 "" i__4[1] = 3, a__2[1] = "pt}"; -#line 17946 "" +#line 17933 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 17947 "" +#line 17934 "" lnote += 3; -#line 17948 "" +#line 17935 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); -#line 17949 "" +#line 17936 "" } -#line 17950 "" +#line 17937 "" } /* Checking for literal TeX string BEFORE starting beams!! */ -#line 17954 "" +#line 17941 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16)) { -#line 17955 "" +#line 17942 "" i__12 = comgrace_1.nlit; -#line 17955 "" +#line 17942 "" for (il = 1; il <= i__12; ++il) { -#line 17956 "" +#line 17943 "" if (comgrace_1.iplit[il - 1] == ip && comgrace_1.ivlit[il - 1] == commvl_1.ivx) { -#line 17956 "" +#line 17943 "" goto L125; -#line 17956 "" +#line 17943 "" } -#line 17957 "" +#line 17944 "" /* L124: */ -#line 17957 "" +#line 17944 "" } -#line 17958 "" +#line 17945 "" s_wsle(&io___1109); -#line 17958 "" +#line 17945 "" do_lio(&c__9, &c__1, "Problem finding index for lite"\ "ral string", (ftnlen)40); -#line 17958 "" +#line 17945 "" e_wsle(); -#line 17959 "" +#line 17946 "" stop1_(); -#line 17960 "" +#line 17947 "" L125: /* Write a type 1 tex string. */ -#line 17964 "" +#line 17951 "" if (comgrace_1.lenlit[il - 1] < 71) { /* Add normally */ -#line 17968 "" +#line 17955 "" addstr_(comgrace_1.litq + (il - 1 << 7), & comgrace_1.lenlit[il - 1], soutq, &lsout, (ftnlen)128, (ftnlen)80); -#line 17969 "" +#line 17956 "" } else { /* Longer than 71. Write souq, Write string, start new soutq. */ -#line 17973 "" +#line 17960 "" if (comlast_1.islast) { -#line 17973 "" +#line 17960 "" s_wsfe(&io___1110); /* Writing concatenation */ -#line 17973 "" +#line 17960 "" i__4[0] = lsout, a__2[0] = soutq; -#line 17973 "" +#line 17960 "" i__4[1] = 1, a__2[1] = "%"; -#line 17973 "" +#line 17960 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); -#line 17973 "" +#line 17960 "" do_fio(&c__1, ch__12, lsout + 1); -#line 17973 "" +#line 17960 "" e_wsfe(); -#line 17973 "" +#line 17960 "" } -#line 17974 "" +#line 17961 "" if (comlast_1.islast) { -#line 17974 "" +#line 17961 "" s_wsfe(&io___1111); /* Writing concatenation */ -#line 17974 "" +#line 17961 "" i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] = comgrace_1.litq + (il - 1 << 7); -#line 17974 "" +#line 17961 "" i__4[1] = 1, a__2[1] = "%"; -#line 17974 "" +#line 17961 "" s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)129); -#line 17974 "" +#line 17961 "" do_fio(&c__1, ch__16, comgrace_1.lenlit[il - 1] + 1); -#line 17974 "" +#line 17961 "" e_wsfe(); -#line 17974 "" +#line 17961 "" } -#line 17975 "" +#line 17962 "" lsout = 0; -#line 17976 "" +#line 17963 "" } -#line 17977 "" +#line 17964 "" } /* Arpeggio on a main (non-chordal) note? */ -#line 17981 "" +#line 17968 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27)) { /* call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), */ -#line 17983 "" +#line 17970 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 17983 "" +#line 17970 "" putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, soutq, & lsout, (ftnlen)80); -#line 17985 "" +#line 17972 "" } /* See if a beam starts here */ -#line 17989 "" +#line 17976 "" if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && all_1.ibm1[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == ip || bit_test(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],21)) { -#line 17992 "" +#line 17979 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],24)) { /* Not a jump start */ -#line 17996 "" +#line 17983 "" if (comkbdrests_1.kbdrests && bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && ! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[ all_1.iv - 1] == 2 && all_1.nolev[ commvl_1.ivx + ip * 24 - 25] <= 50) { -#line 17996 "" +#line 17983 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, @@ -42716,117 +42976,117 @@ L125: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); -#line 17996 "" +#line 17983 "" } -#line 18002 "" +#line 17989 "" beamstrt_(notexq, &lnote, nornb, ihornb, comnsp_2.space, &squez[1], &ib, (ftnlen) 79); /* Shift beam start if notehead was shifted */ -#line 18006 "" +#line 17993 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { /* Writing concatenation */ -#line 18007 "" +#line 17994 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18007 "" +#line 17994 "" i__4[1] = 5, a__2[1] = "loff{"; -#line 18007 "" +#line 17994 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); -#line 18007 "" +#line 17994 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) 6, (ftnlen)80); -#line 18008 "" +#line 17995 "" } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)) { /* Writing concatenation */ -#line 18009 "" +#line 17996 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18009 "" +#line 17996 "" i__4[1] = 5, a__2[1] = "roff{"; -#line 18009 "" +#line 17996 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); -#line 18009 "" +#line 17996 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) 6, (ftnlen)80); -#line 18010 "" +#line 17997 "" } -#line 18011 "" +#line 17998 "" if (lnote > 0) { -#line 18011 "" +#line 17998 "" addstr_(notexq, &lnote, soutq, &lsout, ( ftnlen)79, (ftnlen)80); -#line 18011 "" +#line 17998 "" } -#line 18012 "" +#line 17999 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)) { -#line 18012 "" +#line 17999 "" addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); -#line 18012 "" +#line 17999 "" } -#line 18014 "" +#line 18001 "" } else { /* Jump start. Set marker for second part of a jump beam. Note ivbj2 was set */ /* to 0 at end of first part of jump beam */ -#line 18019 "" +#line 18006 "" combjmp_1.ivbj2 = commvl_1.ivx; /* Check for xtup since we bypassed beamstrt wherein vxtup is normally set */ -#line 18023 "" +#line 18010 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28) && strtmid_1.ixrest[commvl_1.ivx - 1] != 2) { -#line 18023 "" +#line 18010 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; -#line 18023 "" +#line 18010 "" } /* Since beamstrt is not called, and drawbm is normally set there, need to set */ /* it here. This could cause problems if someone tries a staff-jumping, */ /* unbarred beam, which I'll deal with when it comes up. */ -#line 18030 "" +#line 18017 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; -#line 18031 "" +#line 18018 "" } -#line 18032 "" +#line 18019 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { -#line 18033 "" +#line 18020 "" all_1.beamon[commvl_1.ivx - 1] = TRUE_; -#line 18034 "" +#line 18021 "" bspend = TRUE_; -#line 18035 "" +#line 18022 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],24)) { -#line 18035 "" +#line 18022 "" bspend = TRUE_; -#line 18035 "" +#line 18022 "" } -#line 18036 "" +#line 18023 "" } -#line 18037 "" +#line 18024 "" } /* Setup for chords and possible slurs in chords */ -#line 18041 "" +#line 18028 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord on this note. Just rerun precrd. Klunky, but saves */ /* me from tracking down errors instroduced when I moved 1st call */ /* forward for accidental spacing analysis. */ -#line 18047 "" +#line 18034 "" if (all_1.beamon[commvl_1.ivx - 1]) { -#line 18048 "" +#line 18035 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.ipl[ @@ -42835,57 +43095,57 @@ L125: all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &c_true, & icashft, (ftnlen)1); -#line 18051 "" +#line 18038 "" } else { -#line 18052 "" +#line 18039 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18052 "" +#line 18039 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], & commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); -#line 18052 "" +#line 18039 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.ipl[ commvl_1.ivx + ip * 24 - 25], & all_1.irest[commvl_1.ivx + ip * 24 - 25], ch__6, &c_true, &icashft, (ftnlen)1); -#line 18056 "" +#line 18043 "" } -#line 18057 "" +#line 18044 "" } /* Is there slur or grace activity? */ -#line 18061 "" +#line 18048 "" isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4); -#line 18062 "" +#line 18049 "" if (ip > 1) { -#line 18062 "" +#line 18049 "" isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],31); -#line 18062 "" +#line 18049 "" } /* isgrace if not 1st note in bar and previous note has Way-after grace. */ -#line 18066 "" +#line 18053 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0) || isgrace) { -#line 18067 "" +#line 18054 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 0)) { -#line 18068 "" +#line 18055 "" if (comslur_1.fontslur) { /* Call routine for non-postscript slurs */ -#line 18072 "" +#line 18059 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18072 "" +#line 18059 "" doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 - 25], all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, &ip, & @@ -42902,14 +43162,14 @@ L125: - 25] - 1], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], (ftnlen)80, (ftnlen) 1); -#line 18077 "" +#line 18064 "" } else { /* Postscript slurs */ -#line 18081 "" +#line 18068 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18081 "" +#line 18068 "" dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24 - 25], all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, & @@ -42926,33 +43186,33 @@ L125: commvl_1.ivx + ip * 24 - 25] - 1], & all_1.nacc[commvl_1.ivx + ip * 24 - 25], (ftnlen)80, (ftnlen)1); -#line 18087 "" +#line 18074 "" } -#line 18088 "" +#line 18075 "" } -#line 18089 "" +#line 18076 "" if (isgrace) { /* Grace note. */ -#line 18093 "" +#line 18080 "" iphold = ip; -#line 18094 "" +#line 18081 "" isgrace = FALSE_; -#line 18095 "" +#line 18082 "" if (ip > 1) { -#line 18095 "" +#line 18082 "" isgrace = bit_test(all_1.ipl[commvl_1.ivx + ( ip - 1) * 24 - 25],31); -#line 18095 "" +#line 18082 "" } -#line 18096 "" +#line 18083 "" if (isgrace) { -#line 18096 "" +#line 18083 "" --iphold; -#line 18096 "" +#line 18083 "" } -#line 18097 "" +#line 18084 "" isgrace = isgrace || ! bit_test(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],31) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 @@ -42961,13 +43221,13 @@ L125: /* Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace */ /* on current note. Do A-grace on current note, and W-grace at barend, later. */ -#line 18103 "" +#line 18090 "" if (isgrace) { -#line 18104 "" +#line 18091 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18104 "" +#line 18091 "" i__13 = ncmid_(&all_1.iv, &ip); -#line 18104 "" +#line 18091 "" dograce_(&commvl_1.ivx, &iphold, ptgr, soutq, &lsout, &i__12, &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &ig, & @@ -42984,233 +43244,233 @@ L125: all_1.iv - 1], (ftnlen)80, (ftnlen)1); /* 130324 */ /* * tnote(ipl2(ivx,ip)),ulq) */ -#line 18111 "" +#line 18098 "" if (comgrace_1.slurg[ig - 1]) { /* Terminate slur started in dograce. Get direction of main note stem */ -#line 18115 "" +#line 18102 "" if (! all_1.beamon[commvl_1.ivx - 1]) { /* Separate note. Get stem direction. */ -#line 18119 "" +#line 18106 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18119 "" +#line 18106 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &all_1.nv); -#line 18119 "" +#line 18106 "" stemup = *(unsigned char *)&ch__6[0] == 'u'; -#line 18121 "" +#line 18108 "" } else { /* In a beam */ -#line 18125 "" +#line 18112 "" stemup = *(unsigned char *)&all_1.ulq[ commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u'; -#line 18126 "" +#line 18113 "" } /* Stop the shift if whole note */ -#line 18130 "" +#line 18117 "" stemup = stemup || all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] > 63.f; -#line 18132 "" +#line 18119 "" L__1 = ! comgrace_1.upg[ig - 1]; -#line 18132 "" +#line 18119 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18132 "" +#line 18119 "" endslur_(&stemup, &L__1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], & c__0, &comslur_1.ndxslur, &c__0, & i__12, soutq, &lsout, & comslur_1.fontslur, (ftnlen)80); -#line 18134 "" +#line 18121 "" } -#line 18135 "" +#line 18122 "" } -#line 18136 "" +#line 18123 "" } -#line 18137 "" +#line 18124 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1], 24)) { /* Start slur on main note for After- or Way-after-grace. */ /* ???? ndxslur = log2(33554431-listslur) */ -#line 18142 "" +#line 18129 "" i__12 = 16777215 - comslur_1.listslur; -#line 18142 "" +#line 18129 "" comslur_1.ndxslur = log2_(&i__12); /* Get note name */ -#line 18146 "" +#line 18133 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18146 "" +#line 18133 "" notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, (ftnlen)8); /* Get slur direction */ -#line 18150 "" +#line 18137 "" *(unsigned char *)slurudq = 'u'; -#line 18151 "" +#line 18138 "" if (! all_1.beamon[commvl_1.ivx - 1]) { -#line 18152 "" +#line 18139 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18152 "" +#line 18139 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); -#line 18152 "" +#line 18139 "" if (*(unsigned char *)&ch__6[0] == 'u') { -#line 18152 "" +#line 18139 "" *(unsigned char *)slurudq = 'd'; -#line 18152 "" +#line 18139 "" } -#line 18154 "" +#line 18141 "" } else { -#line 18155 "" +#line 18142 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { -#line 18155 "" +#line 18142 "" *(unsigned char *)slurudq = 'd'; -#line 18155 "" +#line 18142 "" } -#line 18156 "" +#line 18143 "" } /* c Replace ndxslur by 11-ndxslur when printing only. */ /* Replace ndxslur by 23-ndxslur when printing only. */ /* if (11-ndxslur .lt. 10) then */ -#line 18162 "" +#line 18149 "" if (23 - comslur_1.ndxslur < 10) { /* notexq = sq//'islur'//slurudq//chax(59-ndxslur) */ /* Writing concatenation */ -#line 18164 "" +#line 18151 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 18164 "" +#line 18151 "" i__5[1] = 5, a__3[1] = "islur"; -#line 18164 "" +#line 18151 "" i__5[2] = 1, a__3[2] = slurudq; -#line 18164 "" +#line 18151 "" i__12 = 71 - comslur_1.ndxslur; -#line 18164 "" +#line 18151 "" chax_(ch__6, (ftnlen)1, &i__12); -#line 18164 "" +#line 18151 "" i__5[3] = 1, a__3[3] = ch__6; -#line 18164 "" +#line 18151 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 18164 "" +#line 18151 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 18166 "" +#line 18153 "" i__12 = lnoten + 8; -#line 18166 "" +#line 18153 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); -#line 18167 "" +#line 18154 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ -#line 18168 "" +#line 18155 "" i__14[0] = 1, a__8[0] = all_1.sq; -#line 18168 "" +#line 18155 "" i__14[1] = 5, a__8[1] = "islur"; -#line 18168 "" +#line 18155 "" i__14[2] = 1, a__8[2] = slurudq; -#line 18168 "" +#line 18155 "" i__14[3] = 2, a__8[3] = "{1"; -#line 18168 "" +#line 18155 "" i__12 = 61 - comslur_1.ndxslur; -#line 18168 "" +#line 18155 "" chax_(ch__6, (ftnlen)1, &i__12); -#line 18168 "" +#line 18155 "" i__14[4] = 1, a__8[4] = ch__6; -#line 18168 "" +#line 18155 "" i__14[5] = 1, a__8[5] = "}"; -#line 18168 "" +#line 18155 "" i__14[6] = lnoten, a__8[6] = noteq; -#line 18168 "" +#line 18155 "" s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); -#line 18170 "" +#line 18157 "" i__12 = lnoten + 11; -#line 18170 "" +#line 18157 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); -#line 18171 "" +#line 18158 "" } else { /* Writing concatenation */ -#line 18172 "" +#line 18159 "" i__14[0] = 1, a__8[0] = all_1.sq; -#line 18172 "" +#line 18159 "" i__14[1] = 5, a__8[1] = "islur"; -#line 18172 "" +#line 18159 "" i__14[2] = 1, a__8[2] = slurudq; -#line 18172 "" +#line 18159 "" i__14[3] = 2, a__8[3] = "{2"; -#line 18172 "" +#line 18159 "" i__12 = 51 - comslur_1.ndxslur; -#line 18172 "" +#line 18159 "" chax_(ch__6, (ftnlen)1, &i__12); -#line 18172 "" +#line 18159 "" i__14[4] = 1, a__8[4] = ch__6; -#line 18172 "" +#line 18159 "" i__14[5] = 1, a__8[5] = "}"; -#line 18172 "" +#line 18159 "" i__14[6] = lnoten, a__8[6] = noteq; -#line 18172 "" +#line 18159 "" s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); -#line 18174 "" +#line 18161 "" i__12 = lnoten + 11; -#line 18174 "" +#line 18161 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); -#line 18175 "" +#line 18162 "" } /* call setbits(ipl(ivx,ip),4,23,ndxslur) */ -#line 18177 "" +#line 18164 "" setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25], &c__5, &c__23, &comslur_1.ndxslur); -#line 18178 "" +#line 18165 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31)) { -#line 18178 "" +#line 18165 "" comslur_1.listslur = bit_set( comslur_1.listslur,comslur_1.ndxslur); -#line 18178 "" +#line 18165 "" } /* Starting slur on W-grace on THIS note. Record ndxslur. */ -#line 18183 "" +#line 18170 "" } -#line 18184 "" +#line 18171 "" } /* Process dynamic marks */ -#line 18188 "" +#line 18175 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26)) { -#line 18189 "" +#line 18176 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18189 "" +#line 18176 "" L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64; -#line 18189 "" +#line 18176 "" dodyn_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.ipl[ commvl_1.ivx + ip * 24 - 25], &all_1.islur[ @@ -43220,64 +43480,64 @@ L125: commvl_1.ivx - 1], ihornb, nornb, all_1.ulq, & all_1.ibmcnt[commvl_1.ivx - 1], &L__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); -#line 18193 "" +#line 18180 "" } /* Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. */ -#line 18197 "" +#line 18184 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* Need a duration to set type of note head */ /* Clumsy test, but vxtup is not set until main note is processed. */ -#line 18203 "" +#line 18190 "" if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25],28))) { -#line 18204 "" +#line 18191 "" nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 18205 "" +#line 18192 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],2) || ip > 1 && bit_test(all_1.irest[ commvl_1.ivx + (ip - 1) * 24 - 25],2)) { /* In a 2-note tremolo */ -#line 18210 "" +#line 18197 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],2)) { /* First note of tremolo, duration is on next note */ -#line 18214 "" +#line 18201 "" nodu = all_1.nodur[commvl_1.ivx + (ip + 1) * 24 - 25]; -#line 18215 "" +#line 18202 "" } else { -#line 18216 "" +#line 18203 "" nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 18217 "" +#line 18204 "" } -#line 18218 "" +#line 18205 "" } else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8 < 0) { -#line 18219 "" +#line 18206 "" nodu = 32; -#line 18220 "" +#line 18207 "" } else { -#line 18221 "" +#line 18208 "" nodu = 16; -#line 18222 "" +#line 18209 "" } -#line 18223 "" +#line 18210 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18223 "" +#line 18210 "" L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27); -#line 18223 "" +#line 18210 "" docrd_(&commvl_1.ivx, &ip, &nodu, &i__12, &all_1.iv, & tnow, soutq, &lsout, all_1.ulq, &all_1.ibmcnt[ commvl_1.ivx - 1], &all_1.islur[commvl_1.ivx @@ -43287,42 +43547,42 @@ L125: ihornb, nornb, &all_1.stemlen, &L__1, & all_1.nacc[commvl_1.ivx + ip * 24 - 25], all_1.irest, (ftnlen)80, (ftnlen)1); -#line 18228 "" +#line 18215 "" } /* Now that chords are done, add stuff to midi file */ -#line 18232 "" +#line 18219 "" if (commidi_1.ismidi) { -#line 18232 "" +#line 18219 "" i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + commvel_1.miditran[cominsttrans_1.instno[ all_1.iv - 1] - 1]; -#line 18232 "" +#line 18219 "" i__13 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; -#line 18232 "" +#line 18219 "" L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0); -#line 18232 "" +#line 18219 "" addmidi_(&icm, &i__12, &i__13, &commidisig_1.midisig, &all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1], &L__1, &c_false); -#line 18232 "" +#line 18219 "" } /* 130316 */ /* Check for breath or caesura */ -#line 18241 "" +#line 18228 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28)) { -#line 18242 "" +#line 18229 "" putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79) ; -#line 18243 "" +#line 18230 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 18244 "" +#line 18231 "" } /* Check for main-note ornaments. ')' on dotted notes go in with note, not here. */ @@ -43331,73 +43591,73 @@ L125: /* isacc = iand(iornq(ivx,ip),4194287) .gt. 0 */ /* isacc = iand(iornq(ivx,ip),541065199) .gt. 0 */ -#line 18252 "" +#line 18239 "" isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 1614807023) > 0; /* isacc=.true. if any ornament except segno */ -#line 18256 "" +#line 18243 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) { /* If ). is only ornament, bypass. If with others, temporarirly zero the bit. */ -#line 18260 "" +#line 18247 "" i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); -#line 18260 "" +#line 18247 "" if (pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx + ip * 24 - 25]) { -#line 18261 "" +#line 18248 "" if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 516079) == 0) { /* ). is the only non-segno ornament */ -#line 18265 "" +#line 18252 "" isacc = FALSE_; -#line 18266 "" +#line 18253 "" } else { /* There are other ornaments in addition */ -#line 18270 "" +#line 18257 "" rpndot = TRUE_; -#line 18271 "" +#line 18258 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13); -#line 18272 "" +#line 18259 "" } -#line 18273 "" +#line 18260 "" } -#line 18274 "" +#line 18261 "" } -#line 18275 "" +#line 18262 "" if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { /* Check for centered whole-bar rest with fermata (bits 10 or 14). */ -#line 18279 "" +#line 18266 "" if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 17408) > 0 && bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == all_1.lenbar && ! ( all_1.firstgulp && all_1.ibar == 1 && all_1.lenb0 > 0)) { -#line 18283 "" +#line 18270 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_; -#line 18284 "" +#line 18271 "" goto L30; -#line 18285 "" +#line 18272 "" } -#line 18286 "" +#line 18273 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18286 "" +#line 18273 "" L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] ,10); -#line 18286 "" +#line 18273 "" putorn_(&all_1.iornq[commvl_1.ivx + ip * 24 - 1], & all_1.nolev[commvl_1.ivx + ip * 24 - 25], & all_1.nolev[commvl_1.ivx + ip * 24 - 25], & @@ -43409,66 +43669,66 @@ L125: all_1.stemlen, notexq, &lnote, &ip, &islhgt, & all_1.beamon[commvl_1.ivx - 1], &L__1, ( ftnlen)1, (ftnlen)79); -#line 18291 "" +#line 18278 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 18292 "" +#line 18279 "" } -#line 18293 "" +#line 18280 "" if (rpndot) { -#line 18294 "" +#line 18281 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( all_1.iornq[commvl_1.ivx + ip * 24 - 1],13); -#line 18295 "" +#line 18282 "" rpndot = FALSE_; -#line 18296 "" +#line 18283 "" } -#line 18297 "" +#line 18284 "" L30: /* Check for main note accidental */ -#line 18301 "" +#line 18288 "" if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25], 17)) { -#line 18303 "" +#line 18290 "" ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__7, &c__10); -#line 18304 "" +#line 18291 "" if (ihshft != 0) { -#line 18304 "" +#line 18291 "" ihshft += -107; -#line 18304 "" +#line 18291 "" } -#line 18305 "" +#line 18292 "" if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 10) && bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { -#line 18305 "" +#line 18292 "" ihshft += -20; -#line 18305 "" +#line 18292 "" } /* Not a chord, and left-shifted main note, so left-shift accid */ -#line 18310 "" +#line 18297 "" i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__6, &c__4); -#line 18310 "" +#line 18297 "" i__13 = ncmid_(&all_1.iv, &ip); -#line 18310 "" +#line 18297 "" L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],31); -#line 18310 "" +#line 18297 "" doacc_(&ihshft, &i__12, notexq, &lnote, &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__13, &L__1, ( ftnlen)79); -#line 18313 "" +#line 18300 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 18314 "" +#line 18301 "" } /* Lower dot for lower-voice notes. Conditions are: */ @@ -43479,168 +43739,168 @@ L30: /* . 5. Flag (lowdot) is set to true */ /* 6. Not in an xtuplet */ -#line 18324 "" +#line 18311 "" if (comarp_1.lowdot && commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivx <= all_1.nv && all_1.nodur[ commvl_1.ivx + ip * 24 - 25] != 0) { -#line 18326 "" +#line 18313 "" i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); -#line 18326 "" +#line 18313 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx + ip * 24 - 25] && ( all_1.nolev[commvl_1.ivx + ip * 24 - 25] - ncmid_(&commvl_1.ivx, &ip)) % 2 == 0) { -#line 18329 "" +#line 18316 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19)) { /* Note already in movdot list. Drop by 2. */ -#line 18333 "" +#line 18320 "" comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[ commvl_1.ivx - 1] + 1) * 24 - 25] += -2.f; -#line 18335 "" +#line 18322 "" } else { /* Not in list so just move it right now */ -#line 18339 "" +#line 18326 "" i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 - 25], &c__1, &c__3); -#line 18339 "" +#line 18326 "" dotmov_(&c_b1007, &c_b1008, soutq, &lsout, & i__12, (ftnlen)80); -#line 18341 "" +#line 18328 "" } -#line 18342 "" +#line 18329 "" } -#line 18343 "" +#line 18330 "" } /* Check for dotted main notes with moved dots. Chord notes done elsewhere. */ /* Added check rules out special chordal 2nds, but later must check */ /* substituted chord note for dot shift that now applies to main note. */ -#line 18349 "" +#line 18336 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19)) { -#line 18350 "" +#line 18337 "" ++comcc_1.ndotmv[commvl_1.ivx - 1]; -#line 18351 "" +#line 18338 "" i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 - 25], &c__1, &c__3); -#line 18351 "" +#line 18338 "" dotmov_(&comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25], &comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], soutq, &lsout, &i__12, (ftnlen) 80); -#line 18353 "" +#line 18340 "" } /* Stemlength changes */ -#line 18357 "" +#line 18344 "" if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27)) { -#line 18358 "" +#line 18345 "" dstemlen = igetbits_(&all_1.mult[commvl_1.ivx + ip * 24 - 25], &c__6, &c__10) * .5f - 4.f; /* Writing concatenation */ -#line 18359 "" +#line 18346 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18359 "" +#line 18346 "" i__4[1] = 12, a__2[1] = "stdstemfalse"; -#line 18359 "" +#line 18346 "" s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)13); -#line 18359 "" +#line 18346 "" addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, ( ftnlen)80); -#line 18360 "" +#line 18347 "" stemshort = dstemlen * .667f + 4.66f; /* Writing concatenation */ -#line 18361 "" +#line 18348 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18361 "" +#line 18348 "" i__4[1] = 11, a__2[1] = "stemlength{"; -#line 18361 "" +#line 18348 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); -#line 18361 "" +#line 18348 "" addstr_(ch__5, &c__12, soutq, &lsout, (ftnlen)12, ( ftnlen)80); -#line 18362 "" +#line 18349 "" s_wsfi(&io___1119); -#line 18362 "" +#line 18349 "" do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real) ); -#line 18362 "" +#line 18349 "" e_wsfi(); /* Writing concatenation */ -#line 18363 "" +#line 18350 "" i__4[0] = 4, a__2[0] = notexq; -#line 18363 "" +#line 18350 "" i__4[1] = 1, a__2[1] = "}"; -#line 18363 "" +#line 18350 "" s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5); -#line 18363 "" +#line 18350 "" addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, ( ftnlen)80); -#line 18364 "" +#line 18351 "" } else if (ip > 1) { -#line 18365 "" +#line 18352 "" if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* Writing concatenation */ -#line 18365 "" +#line 18352 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18365 "" +#line 18352 "" i__4[1] = 16, a__2[1] = "stemlength{4.66}"; -#line 18365 "" +#line 18352 "" s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)17); -#line 18365 "" +#line 18352 "" addstr_(ch__7, &c__17, soutq, &lsout, (ftnlen)17, (ftnlen)80); -#line 18365 "" +#line 18352 "" } /* Cancel shortening. Looks like it gets automatically restored if new inst. or */ /* new line, so no need to worry about affecting other lines */ -#line 18371 "" +#line 18358 "" } /* Zero out slur-height marker for raising ornaments */ -#line 18375 "" +#line 18362 "" islhgt = 0; /* Now start with spacing notes. Is a beam start pending? */ -#line 18379 "" +#line 18366 "" if (bspend && all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] > all_1.ibm1[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]) { -#line 18381 "" +#line 18368 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) { /* Special path for single note at end of otherwise beamed xtup */ -#line 18385 "" +#line 18372 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; -#line 18386 "" +#line 18373 "" } else { -#line 18387 "" +#line 18374 "" if (comkbdrests_1.kbdrests && bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && ! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[ all_1.iv - 1] == 2 && all_1.nolev[ commvl_1.ivx + ip * 24 - 25] <= 50) { -#line 18387 "" +#line 18374 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, @@ -43649,29 +43909,29 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); -#line 18387 "" +#line 18374 "" } -#line 18393 "" +#line 18380 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],24)) { /* Writing concatenation */ -#line 18395 "" +#line 18382 "" chax_(ch__6, (ftnlen)1, &c__92); -#line 18395 "" +#line 18382 "" i__4[0] = 1, a__2[0] = ch__6; -#line 18395 "" +#line 18382 "" i__4[1] = 2, a__2[1] = "sk"; -#line 18395 "" +#line 18382 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18396 "" +#line 18383 "" lnote = 3; -#line 18397 "" +#line 18384 "" } else { -#line 18398 "" +#line 18385 "" beamn1_(notexq, &lnote, (ftnlen)79); /* if (isbjmp .and. */ -#line 18400 "" +#line 18387 "" if (combjmp_1.isbjmp && combjmp_1.ivbj2 != 0 && (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8 > combjmp_1.multbj1) { @@ -43682,263 +43942,263 @@ L30: /* Try adding e.g. \nbbu1 if needed to increase multiplicity. Add */ /* character in reverse order to start of notexq. */ -#line 18409 "" +#line 18396 "" if (combjmp_1.ivbj1 < 9) { /* Writing concatenation */ -#line 18410 "" +#line 18397 "" *(unsigned char *)&ch__6[0] = combjmp_1.ivbj1 + 48; -#line 18410 "" +#line 18397 "" i__4[0] = 1, a__2[0] = ch__6; -#line 18410 "" +#line 18397 "" i__4[1] = lnote, a__2[1] = notexq; -#line 18410 "" +#line 18397 "" s_cat(notexq, a__2, i__4, &c__2, ( ftnlen)79); -#line 18411 "" +#line 18398 "" ++lnote; -#line 18412 "" +#line 18399 "" } else { /* Writing concatenation */ -#line 18413 "" +#line 18400 "" i__9[0] = 2, a__6[0] = "{1"; -#line 18413 "" +#line 18400 "" *(unsigned char *)&ch__6[0] = combjmp_1.ivbj1 + 38; -#line 18413 "" +#line 18400 "" i__9[1] = 1, a__6[1] = ch__6; -#line 18413 "" +#line 18400 "" i__9[2] = 1, a__6[2] = "}"; -#line 18413 "" +#line 18400 "" i__9[3] = lnote, a__6[3] = notexq; -#line 18413 "" +#line 18400 "" s_cat(notexq, a__6, i__9, &c__4, ( ftnlen)79); -#line 18415 "" +#line 18402 "" lnote += 4; -#line 18416 "" +#line 18403 "" } /* Writing concatenation */ -#line 18417 "" +#line 18404 "" i__6[0] = 2, a__4[0] = "bb"; -#line 18417 "" +#line 18404 "" i__6[1] = 1, a__4[1] = all_1.ulq + ( combjmp_1.ivbj1 + (all_1.ibmcnt[ combjmp_1.ivbj1 - 1] - 1) * 24 - 25); -#line 18417 "" +#line 18404 "" i__6[2] = lnote, a__4[2] = notexq; -#line 18417 "" +#line 18404 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen) 79); -#line 18419 "" +#line 18406 "" lnote += 3; -#line 18420 "" +#line 18407 "" if ((15 & all_1.mult[commvl_1.ivx + ip * 24 - 25]) - 8 == 3) { /* Writing concatenation */ -#line 18421 "" +#line 18408 "" i__4[0] = 1, a__2[0] = "b"; -#line 18421 "" +#line 18408 "" i__4[1] = lnote, a__2[1] = notexq; -#line 18421 "" +#line 18408 "" s_cat(notexq, a__2, i__4, &c__2, ( ftnlen)79); -#line 18422 "" +#line 18409 "" ++lnote; -#line 18423 "" +#line 18410 "" } /* Writing concatenation */ -#line 18424 "" +#line 18411 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 18424 "" +#line 18411 "" i__6[1] = 1, a__4[1] = "n"; -#line 18424 "" +#line 18411 "" i__6[2] = lnote, a__4[2] = notexq; -#line 18424 "" +#line 18411 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen) 79); -#line 18425 "" +#line 18412 "" lnote += 2; -#line 18426 "" +#line 18413 "" } -#line 18427 "" +#line 18414 "" } -#line 18428 "" +#line 18415 "" } -#line 18429 "" +#line 18416 "" bspend = FALSE_; /* Is a beam ending? */ -#line 18433 "" +#line 18420 "" } else if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[ commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && ( all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == ip || bit_test( all_1.nacc[commvl_1.ivx + ip * 24 - 25],20))) { -#line 18436 "" +#line 18423 "" if (bspend) { /* Must be a single-note ending of a jump-beam */ -#line 18440 "" +#line 18427 "" bspend = FALSE_; -#line 18441 "" +#line 18428 "" } -#line 18442 "" +#line 18429 "" beamend_(notexq, &lnote, (ftnlen)79); -#line 18443 "" +#line 18430 "" if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj1) { /* Jump beam segment is ending, check if multiplicity DECREASES */ -#line 18447 "" +#line 18434 "" if (comnsp_2.space[ib] > comnsp_2.space[ib - 1]) { /* Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8. */ -#line 18451 "" +#line 18438 "" if (commvl_1.ivx < 10) { -#line 18452 "" +#line 18439 "" *(unsigned char *)&ch__6[0] = commvl_1.ivx + 48; -#line 18452 "" +#line 18439 "" s_copy(ivxq, ch__6, (ftnlen)4, (ftnlen)1); -#line 18453 "" +#line 18440 "" livx = 1; -#line 18454 "" +#line 18441 "" } else { /* Writing concatenation */ -#line 18455 "" +#line 18442 "" i__6[0] = 2, a__4[0] = "{1"; -#line 18455 "" +#line 18442 "" *(unsigned char *)&ch__6[0] = commvl_1.ivx - 10; -#line 18455 "" +#line 18442 "" i__6[1] = 1, a__4[1] = ch__6; -#line 18455 "" +#line 18442 "" i__6[2] = 1, a__4[2] = "}"; -#line 18455 "" +#line 18442 "" s_cat(ivxq, a__4, i__6, &c__3, (ftnlen)4); -#line 18456 "" +#line 18443 "" livx = 4; -#line 18457 "" +#line 18444 "" } /* Changes to get staffcrossall.pmx to work. Not clear how. */ /* if (nint(space(ib+1)-space(ib)) .eq. 6) then */ -#line 18460 "" +#line 18447 "" if (comnsp_2.space[ib] == 8.f && comnsp_2.space[ib - 1] == 2.f) { /* Writing concatenation */ -#line 18461 "" +#line 18448 "" i__15[0] = 1, a__9[0] = all_1.sq; -#line 18461 "" +#line 18448 "" i__15[1] = 4, a__9[1] = "tbbb"; -#line 18461 "" +#line 18448 "" i__15[2] = 1, a__9[2] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 18461 "" +#line 18448 "" i__15[3] = livx, a__9[3] = ivxq; -#line 18461 "" +#line 18448 "" i__15[4] = 1, a__9[4] = all_1.sq; -#line 18461 "" +#line 18448 "" i__15[5] = 3, a__9[5] = "tbb"; -#line 18461 "" +#line 18448 "" i__15[6] = 1, a__9[6] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 18461 "" +#line 18448 "" i__15[7] = livx, a__9[7] = ivxq; -#line 18461 "" +#line 18448 "" i__15[8] = lnote, a__9[8] = notexq; -#line 18461 "" +#line 18448 "" s_cat(notexq, a__9, i__15, &c__9, (ftnlen) 79); -#line 18464 "" +#line 18451 "" lnote = lnote + 11 + (livx << 1); /* else if (nint(space(ib+1)-space(ib)) .eq. 4) then */ -#line 18466 "" +#line 18453 "" } else if (comnsp_2.space[ib] == 8.f && comnsp_2.space[ib - 1] == 4.f) { /* Writing concatenation */ -#line 18467 "" +#line 18454 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 18467 "" +#line 18454 "" i__5[1] = 3, a__3[1] = "tbb"; -#line 18467 "" +#line 18454 "" i__5[2] = 1, a__3[2] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 18467 "" +#line 18454 "" i__5[3] = livx, a__3[3] = ivxq; -#line 18467 "" +#line 18454 "" i__5[4] = lnote, a__3[4] = notexq; -#line 18467 "" +#line 18454 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen) 79); -#line 18469 "" +#line 18456 "" lnote = lnote + 5 + livx; /* else */ -#line 18471 "" +#line 18458 "" } else if (comnsp_2.space[ib] == 4.f && comnsp_2.space[ib - 1] == 2.f) { /* Writing concatenation */ -#line 18472 "" +#line 18459 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 18472 "" +#line 18459 "" i__5[1] = 4, a__3[1] = "tbbb"; -#line 18472 "" +#line 18459 "" i__5[2] = 1, a__3[2] = all_1.ulq + ( commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25); -#line 18472 "" +#line 18459 "" i__5[3] = livx, a__3[3] = ivxq; -#line 18472 "" +#line 18459 "" i__5[4] = lnote, a__3[4] = notexq; -#line 18472 "" +#line 18459 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen) 79); -#line 18474 "" +#line 18461 "" lnote = lnote + 6 + livx; -#line 18475 "" +#line 18462 "" } -#line 18476 "" +#line 18463 "" } -#line 18477 "" +#line 18464 "" } -#line 18478 "" +#line 18465 "" if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25] ,20)) { -#line 18479 "" +#line 18466 "" comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; -#line 18480 "" +#line 18467 "" nornb[commvl_1.ivx - 1] = 0; -#line 18481 "" +#line 18468 "" ++all_1.ibmcnt[commvl_1.ivx - 1]; -#line 18482 "" +#line 18469 "" all_1.beamon[commvl_1.ivx - 1] = FALSE_; -#line 18483 "" +#line 18470 "" } /* Or if we're in the middle of a beam */ -#line 18487 "" +#line 18474 "" } else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[ commvl_1.ivx - 1]) { /* Added 130127 */ -#line 18491 "" +#line 18478 "" if (comkbdrests_1.kbdrests && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test( all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[all_1.iv - 1] == 2 && all_1.nolev[commvl_1.ivx + ip * 24 - 25] <= 50) { -#line 18491 "" +#line 18478 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, & @@ -43947,14 +44207,14 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); -#line 18491 "" +#line 18478 "" } -#line 18497 "" +#line 18484 "" beamid_(notexq, &lnote, (ftnlen)79); /* Or whole-bar rest */ -#line 18501 "" +#line 18488 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == all_1.lenbar && ! (all_1.firstgulp && @@ -43965,18 +44225,18 @@ L30: /* Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp */ -#line 18509 "" +#line 18496 "" cwrest[commvl_1.ivx] = TRUE_; -#line 18510 "" +#line 18497 "" iscwr = TRUE_; -#line 18511 "" +#line 18498 "" notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ commvl_1.ivx - 1], (ftnlen)79); -#line 18512 "" +#line 18499 "" tnow += all_1.lenbar; -#line 18513 "" +#line 18500 "" goto L10; -#line 18514 "" +#line 18501 "" } else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { /* Before writing note or rest, check for keyboard rest height adjustment. */ @@ -43985,14 +44245,14 @@ L30: /* 2. There are two voices on the staff */ /* 3. No user-def height adjustments have been applied (nolev<50) */ -#line 18522 "" +#line 18509 "" if (comkbdrests_1.kbdrests && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test( all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[all_1.iv - 1] == 2 && all_1.nolev[commvl_1.ivx + ip * 24 - 25] <= 50) { -#line 18525 "" +#line 18512 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, & @@ -44001,199 +44261,199 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); -#line 18528 "" +#line 18515 "" } -#line 18529 "" +#line 18516 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],4) ) { /* Deal with single stem tremolo */ /* Get up-downness, borrowed from notex */ -#line 18534 "" +#line 18521 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18534 "" +#line 18521 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], & commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); -#line 18534 "" +#line 18521 "" if (*(unsigned char *)&ch__6[0] == 'u') { -#line 18536 "" +#line 18523 "" *(unsigned char *)udq = 'u'; -#line 18537 "" +#line 18524 "" } else { -#line 18538 "" +#line 18525 "" *(unsigned char *)udq = 'l'; -#line 18539 "" +#line 18526 "" } -#line 18540 "" +#line 18527 "" multtrem = igetbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25], &c__2, &c__5) + 1; -#line 18541 "" +#line 18528 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] < 64) { /* Writing concatenation */ -#line 18542 "" +#line 18529 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18542 "" +#line 18529 "" i__4[1] = 2, a__2[1] = "tr"; -#line 18542 "" +#line 18529 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18543 "" +#line 18530 "" } else { /* Writing concatenation */ -#line 18544 "" +#line 18531 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18544 "" +#line 18531 "" i__4[1] = 2, a__2[1] = "Tr"; -#line 18544 "" +#line 18531 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18545 "" +#line 18532 "" } -#line 18546 "" +#line 18533 "" lnote = 3; -#line 18547 "" +#line 18534 "" if (multtrem == 2) { /* Writing concatenation */ -#line 18548 "" +#line 18535 "" i__4[0] = 3, a__2[0] = notexq; -#line 18548 "" +#line 18535 "" i__4[1] = 1, a__2[1] = "r"; -#line 18548 "" +#line 18535 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18549 "" +#line 18536 "" lnote = 4; -#line 18550 "" +#line 18537 "" } else if (multtrem == 3) { /* Writing concatenation */ -#line 18551 "" +#line 18538 "" i__4[0] = 3, a__2[0] = notexq; -#line 18551 "" +#line 18538 "" i__4[1] = 2, a__2[1] = "rr"; -#line 18551 "" +#line 18538 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18552 "" +#line 18539 "" lnote = 5; -#line 18553 "" +#line 18540 "" } /* Get a numerical pitch argument */ -#line 18557 "" +#line 18544 "" lineno = all_1.nolev[commvl_1.ivx + ip * 24 - 25] - ncmid_(&all_1.iv, &ip) + 4; -#line 18558 "" +#line 18545 "" if (lineno < 0 || lineno > 9) { -#line 18559 "" +#line 18546 "" s_wsfi(&io___1127); -#line 18559 "" +#line 18546 "" do_fio(&c__1, "{", (ftnlen)1); -#line 18559 "" +#line 18546 "" do_fio(&c__1, (char *)&lineno, (ftnlen)sizeof( integer)); -#line 18559 "" +#line 18546 "" do_fio(&c__1, "}", (ftnlen)1); -#line 18559 "" +#line 18546 "" e_wsfi(); -#line 18560 "" +#line 18547 "" lnoten = 4; -#line 18561 "" +#line 18548 "" } else { -#line 18562 "" +#line 18549 "" *(unsigned char *)&ch__6[0] = lineno + 48; -#line 18562 "" +#line 18549 "" s_copy(noteq, ch__6, (ftnlen)8, (ftnlen)1); -#line 18563 "" +#line 18550 "" lnoten = 1; -#line 18564 "" +#line 18551 "" } /* Writing concatenation */ -#line 18565 "" +#line 18552 "" i__9[0] = lnote, a__6[0] = notexq; -#line 18565 "" +#line 18552 "" i__9[1] = 1, a__6[1] = "m"; -#line 18565 "" +#line 18552 "" i__9[2] = 1, a__6[2] = udq; -#line 18565 "" +#line 18552 "" i__9[3] = lnoten, a__6[3] = noteq; -#line 18565 "" +#line 18552 "" s_cat(notexq, a__6, i__9, &c__4, (ftnlen)79); -#line 18566 "" +#line 18553 "" lnote = lnote + 2 + lnoten; -#line 18567 "" +#line 18554 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); -#line 18568 "" +#line 18555 "" } /* Get code for a separate note or rest */ /* If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), */ /* pitch will be shifted +/-1 inside notex. */ -#line 18574 "" +#line 18561 "" notex_(notexq, &lnote, (ftnlen)79); -#line 18575 "" +#line 18562 "" } /* Right offset? This may cause trouble */ -#line 18579 "" +#line 18566 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { /* Writing concatenation */ -#line 18580 "" +#line 18567 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18580 "" +#line 18567 "" i__4[1] = 5, a__2[1] = "loff{"; -#line 18580 "" +#line 18567 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); -#line 18580 "" +#line 18567 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( ftnlen)80); -#line 18581 "" +#line 18568 "" } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] ,9)) { /* Writing concatenation */ -#line 18582 "" +#line 18569 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18582 "" +#line 18569 "" i__4[1] = 5, a__2[1] = "roff{"; -#line 18582 "" +#line 18569 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); -#line 18582 "" +#line 18569 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( ftnlen)80); -#line 18583 "" +#line 18570 "" } -#line 18584 "" +#line 18571 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0) { -#line 18585 "" +#line 18572 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 18586 "" +#line 18573 "" } -#line 18587 "" +#line 18574 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9) ) { -#line 18587 "" +#line 18574 "" addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen) 80); -#line 18587 "" +#line 18574 "" } /* Terminate user-defined offsets. Fix format */ -#line 18592 "" +#line 18579 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],17)) { -#line 18592 "" +#line 18579 "" putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, ( ftnlen)80); -#line 18592 "" +#line 18579 "" } /* Deal with After- and Way-after-graces. First, if end of bar, compute space */ @@ -44201,137 +44461,137 @@ L30: /* rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. */ /* But will still need to add extra space as hardspace. */ -#line 18600 "" +#line 18587 "" if (ip == all_1.nn[commvl_1.ivx - 1] && (bit_test( all_1.ipl[commvl_1.ivx + ip * 24 - 25],31) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 29))) { -#line 18602 "" +#line 18589 "" i__12 = comgrace_1.ngrace; -#line 18602 "" +#line 18589 "" for (ig = 1; ig <= i__12; ++ig) { -#line 18603 "" +#line 18590 "" if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { -#line 18603 "" +#line 18590 "" goto L78; -#line 18603 "" +#line 18590 "" } -#line 18604 "" +#line 18591 "" /* L77: */ -#line 18604 "" +#line 18591 "" } -#line 18605 "" +#line 18592 "" s_wsle(&io___1128); -#line 18605 "" +#line 18592 "" do_lio(&c__9, &c__1, "Problem finding grace index "\ "at \"do 77\"", (ftnlen)38); -#line 18605 "" +#line 18592 "" e_wsle(); -#line 18606 "" +#line 18593 "" stop1_(); -#line 18607 "" +#line 18594 "" L78: /* Get elemskip to end of bar. WON'T WORK IF XTUPS !! */ -#line 18611 "" +#line 18598 "" esk = 0.f; -#line 18612 "" +#line 18599 "" i__12 = comnsp_2.nb; -#line 18612 "" +#line 18599 "" for (iib = ib; iib <= i__12; ++iib) { -#line 18613 "" +#line 18600 "" if (iib == ib) { -#line 18614 "" +#line 18601 "" itleft = i_nint(&all_1.to[comipl2_1.ipl2[ commvl_1.ivx + ip * 24 - 25] - 1]); -#line 18615 "" +#line 18602 "" } else { -#line 18616 "" +#line 18603 "" itleft = i_nint(&tstart[ib]); -#line 18617 "" +#line 18604 "" } -#line 18618 "" +#line 18605 "" if (iib < comnsp_2.nb) { -#line 18619 "" +#line 18606 "" itright = i_nint(&tstart[iib + 1]); -#line 18620 "" +#line 18607 "" } else { -#line 18621 "" +#line 18608 "" itright = all_1.lenbar; -#line 18622 "" +#line 18609 "" } -#line 18623 "" +#line 18610 "" esk += feon_(&comnsp_2.space[ib - 1]) * (itright - itleft) / comnsp_2.space[ib - 1]; -#line 18625 "" +#line 18612 "" /* L40: */ -#line 18625 "" +#line 18612 "" } -#line 18626 "" +#line 18613 "" ptsavail = comask_1.poenom * esk - comask_1.wheadpt; -#line 18627 "" +#line 18614 "" if (comgrace_1.nng[ig - 1] == 1) { -#line 18628 "" +#line 18615 "" wgr = spfacs_1.grafac; -#line 18629 "" +#line 18616 "" } else { -#line 18630 "" +#line 18617 "" wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; -#line 18631 "" +#line 18618 "" i__12 = comgrace_1.nng[ig - 1]; -#line 18631 "" +#line 18618 "" for (ing = 1; ing <= i__12; ++ing) { -#line 18632 "" +#line 18619 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing - 1] > 0) { -#line 18632 "" +#line 18619 "" wgr += spfacs_1.acgfac; -#line 18632 "" +#line 18619 "" } -#line 18633 "" +#line 18620 "" /* L41: */ -#line 18633 "" +#line 18620 "" } -#line 18634 "" +#line 18621 "" } -#line 18635 "" +#line 18622 "" ptgr[ig - 1] = wgr * comask_1.wheadpt; -#line 18636 "" +#line 18623 "" ptsneed = (wgr + .5f) * comask_1.wheadpt; -#line 18637 "" +#line 18624 "" ptsndg[commvl_1.ivx - 1] = 0.f; -#line 18638 "" +#line 18625 "" if (ptsavail < ptsneed) { -#line 18639 "" +#line 18626 "" ptsndg[commvl_1.ivx - 1] = ptsneed; -#line 18640 "" +#line 18627 "" eskndg[commvl_1.ivx - 1] = esk; -#line 18641 "" +#line 18628 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31)) { /* Convert GW to GA */ -#line 18645 "" +#line 18632 "" all_1.ipl[commvl_1.ivx + ip * 24 - 25] = bit_set(bit_clear(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],31),29); -#line 18646 "" +#line 18633 "" } -#line 18647 "" +#line 18634 "" } -#line 18648 "" +#line 18635 "" } /* Check for GA */ -#line 18652 "" +#line 18639 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) { -#line 18652 "" +#line 18639 "" i__12 = ncmid_(&all_1.iv, &ip); -#line 18652 "" +#line 18639 "" dograce_(&commvl_1.ivx, &ip, ptgr, soutq, &lsout, & i__12, &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &ig, &all_1.ipl[commvl_1.ivx + ip * 24 - @@ -44339,87 +44599,87 @@ L78: &c__0, &c__0, &c__0, &c_b1008, all_1.ulq, & cominsttrans_1.instno[all_1.iv - 1], (ftnlen) 80, (ftnlen)1); -#line 18652 "" +#line 18639 "" } /* 130324 */ /* * .false.,0,0,0,0,0,0,0.,ulq) */ /* Update running time */ -#line 18661 "" +#line 18648 "" tnow += comnsp_2.space[ib - 1]; -#line 18662 "" +#line 18649 "" L10: -#line 18662 "" +#line 18649 "" ; -#line 18662 "" +#line 18649 "" } /* Have finished last note in this voice and block */ -#line 18666 "" +#line 18653 "" r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1]; -#line 18666 "" +#line 18653 "" itendb = i_nint(&r__1); -#line 18667 "" +#line 18654 "" if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { -#line 18668 "" +#line 18655 "" ivf = 1; -#line 18669 "" +#line 18656 "" if (commvl_1.ivx > 1) { -#line 18669 "" +#line 18656 "" ivf = 2; -#line 18669 "" +#line 18656 "" } -#line 18670 "" +#line 18657 "" L17: -#line 18670 "" +#line 18657 "" if (all_1.figchk[ivf - 1] && comfig_1.itfig[ivf + (ifig[ ivf - 1] << 1) - 3] < itendb) { /* There's at least one figure left. offnsk could be <0 */ -#line 18674 "" +#line 18661 "" offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3]) / comnsp_2.space[ib - 1]; -#line 18675 "" +#line 18662 "" putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[ ivf - 1], soutq, &lsout, (ftnlen)80); -#line 18676 "" +#line 18663 "" goto L17; -#line 18677 "" +#line 18664 "" } -#line 18678 "" +#line 18665 "" } /* Check for flag, dot, or upstem on last note of bar. */ -#line 18682 "" +#line 18669 "" if (ib == comnsp_2.nb) { -#line 18683 "" +#line 18670 "" ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[ commvl_1.ivx - 1] * 24 - 25] - 1]; -#line 18684 "" +#line 18671 "" comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f; -#line 18685 "" +#line 18672 "" if ((r__1 = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] - comnsp_2.space[ib - 1], dabs( r__1)) < comtol_1.tol) { -#line 18686 "" +#line 18673 "" if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) { /* Note in last space, smaller than a quarter note. */ -#line 18690 "" +#line 18677 "" i__10 = ncmid_(&all_1.iv, &ip); -#line 18690 "" +#line 18677 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__10, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], & commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); -#line 18690 "" +#line 18677 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && *(unsigned char *)&ch__6[0] == 'u' || isdotted_(all_1.nodur, & @@ -44428,9 +44688,9 @@ L17: /* Upstem non-rest, or dotted */ /* Computing MAX */ -#line 18697 "" +#line 18684 "" i__10 = 1, i__12 = numbms[commvl_1.ivx]; -#line 18697 "" +#line 18684 "" if (numbms[commvl_1.ivx] > 0 && ip == all_1.ibm2[commvl_1.ivx + max(i__10, i__12) * 24 - 25] && ! isdotted_( @@ -44438,70 +44698,70 @@ L17: /* In beam and not dotted, so use smaller space */ -#line 18704 "" +#line 18691 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.upstmfac; -#line 18705 "" +#line 18692 "" } else { -#line 18706 "" +#line 18693 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.flagfac; -#line 18707 "" +#line 18694 "" } -#line 18708 "" +#line 18695 "" } -#line 18709 "" +#line 18696 "" } else { /* Last space, nonflagged (no beam) only worry dot or up */ -#line 18713 "" +#line 18700 "" if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { -#line 18714 "" +#line 18701 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.flagfac; -#line 18715 "" +#line 18702 "" } else /* if(complicated condition) */ { -#line 18715 "" +#line 18702 "" i__10 = ncmid_(&all_1.iv, &ip); -#line 18715 "" +#line 18702 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__10, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); -#line 18715 "" +#line 18702 "" if (all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] < 64.f && *( unsigned char *)&ch__6[0] == 'u') { /* Upstem on last note , non-flagged */ -#line 18721 "" +#line 18708 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.upstmfac; -#line 18722 "" +#line 18709 "" } -#line 18722 "" +#line 18709 "" } -#line 18723 "" +#line 18710 "" } -#line 18724 "" +#line 18711 "" } /* Check for right-shifted chordal note */ -#line 18728 "" +#line 18715 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20)) { -#line 18728 "" +#line 18715 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac; -#line 18728 "" +#line 18715 "" } -#line 18729 "" +#line 18716 "" comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[ commvl_1.ivx - 1] > 0.f; -#line 18730 "" +#line 18717 "" if (commidi_1.ismidi) { /* For midi, set flags for accidentals on last note of bar. Assume they affect */ @@ -44513,102 +44773,102 @@ L17: /* c Old old lbacc(icm) = iand(nacc(ivx,ip),7) */ /* New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) */ -#line 18741 "" +#line 18728 "" if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0) { /* Explicit accidental on last main note in bar */ -#line 18745 "" +#line 18732 "" i__10 = comslm_1.naccbl[icm]; -#line 18745 "" +#line 18732 "" for (kacc = 1; kacc <= i__10; ++kacc) { -#line 18746 "" +#line 18733 "" if (comslm_1.laccbl[icm + kacc * 25 - 25] == all_1.nolev[commvl_1.ivx + ip * 24 - 25]) { -#line 18746 "" +#line 18733 "" goto L56; -#line 18746 "" +#line 18733 "" } -#line 18747 "" +#line 18734 "" /* L55: */ -#line 18747 "" +#line 18734 "" } -#line 18748 "" +#line 18735 "" ++comslm_1.naccbl[icm]; -#line 18749 "" +#line 18736 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; -#line 18750 "" +#line 18737 "" i__10 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; -#line 18750 "" +#line 18737 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = iashft_(&i__10); -#line 18751 "" +#line 18738 "" } -#line 18752 "" +#line 18739 "" L56: -#line 18753 "" +#line 18740 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 10) && commidi_1.crdacc) { -#line 18754 "" +#line 18741 "" i__10 = comtrill_1.icrd2; -#line 18754 "" +#line 18741 "" for (icrd = comtrill_1.icrd1; icrd <= i__10; ++icrd) { -#line 18755 "" +#line 18742 "" iacc = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); -#line 18756 "" +#line 18743 "" if (iacc > 0) { /* Explicit accidental on chord note at end of bar */ -#line 18760 "" +#line 18747 "" nolevc = igetbits_(&comtrill_1.icrdat[ icrd - 1], &c__7, &c__12); -#line 18761 "" +#line 18748 "" i__12 = comslm_1.naccbl[icm]; -#line 18761 "" +#line 18748 "" for (kacc = 1; kacc <= i__12; ++kacc) { -#line 18762 "" +#line 18749 "" if (comslm_1.laccbl[icm + kacc * 25 - 25] == nolevc) { -#line 18762 "" +#line 18749 "" goto L59; -#line 18762 "" +#line 18749 "" } -#line 18763 "" +#line 18750 "" /* L58: */ -#line 18763 "" +#line 18750 "" } -#line 18764 "" +#line 18751 "" ++comslm_1.naccbl[icm]; -#line 18765 "" +#line 18752 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = nolevc; -#line 18766 "" +#line 18753 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = iashft_(&iacc); -#line 18767 "" +#line 18754 "" } -#line 18768 "" +#line 18755 "" L59: -#line 18769 "" +#line 18756 "" /* L57: */ -#line 18769 "" +#line 18756 "" ; -#line 18769 "" +#line 18756 "" } -#line 18770 "" +#line 18757 "" } /* if (lbacc(icm).eq.0 .and. accb4(icm)) then */ -#line 18772 "" +#line 18759 "" i__10 = commidi_1.naccim[icm]; -#line 18772 "" +#line 18759 "" for (kacc = 1; kacc <= i__10; ++kacc) { /* If naccim(icm)>0, */ @@ -44617,207 +44877,209 @@ L59: /* explicit action from just above. Assuming any accid on last note in bar, */ /* either explicit or implicit, has same effect on 1st note of next bar. */ -#line 18780 "" +#line 18767 "" if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] == commidi_1.laccim[icm + kacc * 25 - 25]) { -#line 18780 "" +#line 18767 "" goto L66; -#line 18780 "" +#line 18767 "" } -#line 18781 "" +#line 18768 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { -#line 18782 "" +#line 18769 "" i__12 = comtrill_1.icrd2; -#line 18782 "" +#line 18769 "" for (icrd = comtrill_1.icrd1; icrd <= i__12; ++icrd) { -#line 18783 "" +#line 18770 "" if ((lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-12) & 127) == commidi_1.laccim[icm + kacc * 25 - 25]) { -#line 18783 "" +#line 18770 "" goto L66; -#line 18783 "" +#line 18770 "" } -#line 18785 "" +#line 18772 "" /* L67: */ -#line 18785 "" +#line 18772 "" } -#line 18786 "" +#line 18773 "" } -#line 18787 "" +#line 18774 "" goto L65; -#line 18788 "" +#line 18775 "" L66: /* So far we know there is a main or chord note at level laccim(icm,kacc). So */ /* it will get a bl-accid if it didn't just already get one. */ -#line 18793 "" +#line 18780 "" i__12 = comslm_1.naccbl[icm]; -#line 18793 "" +#line 18780 "" for (macc = 1; macc <= i__12; ++macc) { -#line 18794 "" +#line 18781 "" if (comslm_1.laccbl[icm + macc * 25 - 25] == commidi_1.laccim[icm + kacc * 25 - 25] ) { -#line 18794 "" +#line 18781 "" goto L65; -#line 18794 "" +#line 18781 "" } -#line 18795 "" +#line 18782 "" /* L68: */ -#line 18795 "" +#line 18782 "" } -#line 18796 "" +#line 18783 "" ++comslm_1.naccbl[icm]; -#line 18797 "" +#line 18784 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = commidi_1.laccim[icm + kacc * 25 - 25]; -#line 18798 "" +#line 18785 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = commidi_1.jaccim[icm + kacc * 25 - 25]; -#line 18799 "" +#line 18786 "" L65: -#line 18799 "" +#line 18786 "" ; -#line 18799 "" +#line 18786 "" } -#line 18800 "" +#line 18787 "" } -#line 18801 "" +#line 18788 "" } -#line 18802 "" -/* L11: */ -#line 18802 "" +#line 18789 "" +/* L1199: */ +#line 18789 "" } -#line 18802 "" +#line 18790 "" +/* L11: */ +#line 18790 "" } /* Close out the notes group */ /* Writing concatenation */ -#line 18806 "" +#line 18794 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18806 "" +#line 18794 "" i__4[1] = 2, a__2[1] = "en"; -#line 18806 "" +#line 18794 "" s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); -#line 18806 "" +#line 18794 "" addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80); -#line 18807 "" +#line 18795 "" if (comlast_1.islast && lsout > 0) { -#line 18807 "" +#line 18795 "" s_wsfe(&io___1141); /* Writing concatenation */ -#line 18807 "" +#line 18795 "" i__4[0] = lsout, a__2[0] = soutq; -#line 18807 "" +#line 18795 "" i__4[1] = 1, a__2[1] = "%"; -#line 18807 "" +#line 18795 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); -#line 18807 "" +#line 18795 "" do_fio(&c__1, ch__12, lsout + 1); -#line 18807 "" +#line 18795 "" e_wsfe(); -#line 18807 "" +#line 18795 "" } -#line 18808 "" +#line 18796 "" /* L16: */ -#line 18808 "" +#line 18796 "" } /* Check for way-after graces at end of bar. We could not link these to notes */ /* as in midbar since there is no note following grace! Also, set flag if */ /* hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. */ -#line 18814 "" +#line 18802 "" isgrace = FALSE_; -#line 18815 "" - i__2 = all_1.nv; -#line 18815 "" - for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { -#line 18816 "" +#line 18803 "" + i__1 = all_1.nv; +#line 18803 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 18804 "" comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1]; -#line 18817 "" - i__7 = commvl_1.nvmx[all_1.iv - 1]; -#line 18817 "" - for (kv = 1; kv <= i__7; ++kv) { -#line 18818 "" +#line 18805 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 18805 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 18806 "" comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[ all_1.iv + kv * 24 - 25]; -#line 18819 "" +#line 18807 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 18820 "" +#line 18808 "" comnsp_2.ptsgnd = 0.f; -#line 18821 "" +#line 18809 "" if ((bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) && ptsndg[ commvl_1.ivx - 1] > 0.f) { -#line 18823 "" +#line 18811 "" comnsp_2.flgndb = TRUE_; -#line 18824 "" +#line 18812 "" if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) { -#line 18825 "" +#line 18813 "" comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1]; -#line 18826 "" +#line 18814 "" comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1]; -#line 18827 "" +#line 18815 "" } -#line 18828 "" +#line 18816 "" } -#line 18829 "" +#line 18817 "" if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) { /* This voice has a way-after grace here at end of bar */ -#line 18833 "" +#line 18821 "" if (! isgrace) { /* This is the first one, so set up the string */ -#line 18837 "" +#line 18825 "" isgrace = TRUE_; -#line 18838 "" +#line 18826 "" ivlast = 1; /* Writing concatenation */ -#line 18839 "" +#line 18827 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18839 "" +#line 18827 "" i__4[1] = 6, a__2[1] = "znotes"; -#line 18839 "" +#line 18827 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 18840 "" +#line 18828 "" lsout = 7; -#line 18841 "" +#line 18829 "" } -#line 18842 "" - i__1 = all_1.iv - 1; -#line 18842 "" - for (iiv = ivlast; iiv <= i__1; ++iiv) { -#line 18843 "" +#line 18830 "" + i__7 = all_1.iv - 1; +#line 18830 "" + for (iiv = ivlast; iiv <= i__7; ++iiv) { +#line 18831 "" addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, ( ftnlen)1, (ftnlen)80); -#line 18844 "" +#line 18832 "" /* L76: */ -#line 18844 "" +#line 18832 "" } -#line 18845 "" +#line 18833 "" ivlast = all_1.iv; /* No need to put in 'nextvoice', even if 2 lines/staff */ -#line 18849 "" - i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]); -#line 18849 "" +#line 18837 "" + i__7 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]); +#line 18837 "" dograce_(&commvl_1.ivx, &all_1.nn[commvl_1.ivx - 1], ptgr, - soutq, &lsout, &i__1, &all_1.nacc[commvl_1.ivx + + soutq, &lsout, &i__7, &all_1.nacc[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25], &ig, & all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25], &c_true, &c_false, &c__0, &c__0, &c__0, & @@ -44826,437 +45088,439 @@ L65: ftnlen)1); /* 130324 */ /* * .false.,0,0,0,0,0,0,0.,ulq) */ -#line 18854 "" +#line 18842 "" } -#line 18855 "" -/* L75: */ -#line 18855 "" +#line 18843 "" +/* L7599: */ +#line 18843 "" } -#line 18855 "" +#line 18844 "" +/* L75: */ +#line 18844 "" } -#line 18856 "" +#line 18845 "" if (isgrace) { /* Writing concatenation */ -#line 18857 "" +#line 18846 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18857 "" +#line 18846 "" i__4[1] = 3, a__2[1] = "en%"; -#line 18857 "" +#line 18846 "" s_cat(ch__20, a__2, i__4, &c__2, (ftnlen)4); -#line 18857 "" +#line 18846 "" addstr_(ch__20, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80); -#line 18858 "" +#line 18847 "" if (comlast_1.islast && lsout > 0) { -#line 18858 "" +#line 18847 "" s_wsfe(&io___1144); -#line 18858 "" +#line 18847 "" do_fio(&c__1, soutq, lsout); -#line 18858 "" +#line 18847 "" e_wsfe(); -#line 18858 "" +#line 18847 "" } -#line 18859 "" +#line 18848 "" } -#line 18860 "" +#line 18849 "" lsout = 0; /* Write multibar rest. Assuming nv = 1 and do not worry about cwbrest */ /* This has to be the only use of atnextbar */ -#line 18865 "" +#line 18854 "" if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) { -#line 18866 "" +#line 18855 "" if (comignorenats_1.newmbrhgt) { /* Writing concatenation */ -#line 18867 "" +#line 18856 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 18867 "" +#line 18856 "" i__9[1] = 3, a__6[1] = "def"; -#line 18867 "" +#line 18856 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 18867 "" +#line 18856 "" i__9[3] = 7, a__6[3] = "mbrhgt{"; -#line 18867 "" +#line 18856 "" s_cat(soutq, a__6, i__9, &c__4, (ftnlen)80); -#line 18868 "" +#line 18857 "" if (comignorenats_1.mbrhgt <= -10) { -#line 18869 "" +#line 18858 "" s_wsfi(&io___1145); -#line 18869 "" +#line 18858 "" do_fio(&c__1, (char *)&comignorenats_1.mbrhgt, (ftnlen)sizeof( integer)); -#line 18869 "" +#line 18858 "" e_wsfi(); -#line 18870 "" +#line 18859 "" lsout = 15; -#line 18871 "" +#line 18860 "" } else if (comignorenats_1.mbrhgt >= 10 || comignorenats_1.mbrhgt <= -1) { -#line 18872 "" +#line 18861 "" s_wsfi(&io___1146); -#line 18872 "" +#line 18861 "" do_fio(&c__1, (char *)&comignorenats_1.mbrhgt, (ftnlen)sizeof( integer)); -#line 18872 "" +#line 18861 "" e_wsfi(); -#line 18873 "" +#line 18862 "" lsout = 14; -#line 18874 "" +#line 18863 "" } else { /* Writing concatenation */ -#line 18875 "" +#line 18864 "" i__4[0] = 12, a__2[0] = soutq; -#line 18875 "" +#line 18864 "" *(unsigned char *)&ch__6[0] = comignorenats_1.mbrhgt + 48; -#line 18875 "" +#line 18864 "" i__4[1] = 1, a__2[1] = ch__6; -#line 18875 "" +#line 18864 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 18876 "" +#line 18865 "" lsout = 13; -#line 18877 "" +#line 18866 "" } /* Writing concatenation */ -#line 18878 "" +#line 18867 "" i__4[0] = lsout, a__2[0] = soutq; -#line 18878 "" +#line 18867 "" i__4[1] = 2, a__2[1] = "}%"; -#line 18878 "" +#line 18867 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); -#line 18879 "" +#line 18868 "" s_wsfe(&io___1147); -#line 18879 "" +#line 18868 "" do_fio(&c__1, soutq, lsout + 2); -#line 18879 "" +#line 18868 "" e_wsfe(); -#line 18880 "" +#line 18869 "" comignorenats_1.newmbrhgt = FALSE_; -#line 18881 "" +#line 18870 "" } /* Writing concatenation */ -#line 18882 "" +#line 18871 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 18882 "" +#line 18871 "" i__3[1] = 3, a__1[1] = "def"; -#line 18882 "" +#line 18871 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 18882 "" +#line 18871 "" i__3[3] = 10, a__1[3] = "atnextbar{"; -#line 18882 "" +#line 18871 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 18882 "" +#line 18871 "" i__3[5] = 6, a__1[5] = "znotes"; -#line 18882 "" +#line 18871 "" s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80); -#line 18883 "" +#line 18872 "" lsout = 22; /* Writing concatenation */ -#line 18884 "" +#line 18873 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18884 "" +#line 18873 "" i__4[1] = 6, a__2[1] = "mbrest"; -#line 18884 "" +#line 18873 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18885 "" +#line 18874 "" lnote = 7; -#line 18886 "" +#line 18875 "" istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8); /* Writing concatenation */ -#line 18887 "" +#line 18876 "" i__4[0] = lnote, a__2[0] = notexq; -#line 18887 "" +#line 18876 "" i__4[1] = len, a__2[1] = noteq; -#line 18887 "" +#line 18876 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); -#line 18888 "" +#line 18877 "" lnote += len; -#line 18889 "" +#line 18878 "" mtrspc = i_nint(&comgrace_1.xb4mbr); -#line 18890 "" +#line 18879 "" comgrace_1.xb4mbr = 0.f; -#line 18891 "" +#line 18880 "" istring_(&mtrspc, noteq, &len, (ftnlen)8); /* Writing concatenation */ -#line 18892 "" +#line 18881 "" i__6[0] = lnote, a__4[0] = notexq; -#line 18892 "" +#line 18881 "" i__6[1] = len, a__4[1] = noteq; -#line 18892 "" +#line 18881 "" i__6[2] = 1, a__4[2] = "0"; -#line 18892 "" +#line 18881 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); -#line 18893 "" +#line 18882 "" lnote = lnote + len + 1; -#line 18894 "" - i__7 = all_1.nv; -#line 18894 "" - for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { -#line 18895 "" +#line 18883 "" + i__1 = all_1.nv; +#line 18883 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 18884 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); -#line 18896 "" +#line 18885 "" if (all_1.iv < all_1.nv) { -#line 18896 "" +#line 18885 "" addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); -#line 18896 "" +#line 18885 "" } -#line 18897 "" +#line 18886 "" /* L62: */ -#line 18897 "" +#line 18886 "" } /* Writing concatenation */ -#line 18898 "" +#line 18887 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18898 "" +#line 18887 "" i__4[1] = 4, a__2[1] = "en}%"; -#line 18898 "" +#line 18887 "" s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5); -#line 18898 "" +#line 18887 "" addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); -#line 18899 "" +#line 18888 "" s_wsfe(&io___1150); -#line 18899 "" +#line 18888 "" do_fio(&c__1, soutq, lsout); -#line 18899 "" +#line 18888 "" e_wsfe(); -#line 18900 "" +#line 18889 "" lsout = 0; -#line 18901 "" +#line 18890 "" if (comshort_1.ishort > 0) { -#line 18902 "" +#line 18891 "" comshort_1.mbrsum += comgrace_1.mbrest; -#line 18903 "" +#line 18892 "" ++comshort_1.nmbr; -#line 18904 "" +#line 18893 "" } -#line 18905 "" +#line 18894 "" if (comgrace_1.mbrest > 1) { -#line 18906 "" +#line 18895 "" r__1 = comgrace_1.mbrest - 1 + .01f; -#line 18906 "" +#line 18895 "" ndig = (integer) r_lg10(&r__1) + 1; -#line 18907 "" +#line 18896 "" ci__1.cierr = 0; -#line 18907 "" +#line 18896 "" ci__1.ciunit = 11; /* Writing concatenation */ -#line 18907 "" +#line 18896 "" i__6[0] = 6, a__4[0] = "(a14,i"; -#line 18907 "" - i__7 = ndig + 48; -#line 18907 "" - chax_(ch__6, (ftnlen)1, &i__7); -#line 18907 "" +#line 18896 "" + i__1 = ndig + 48; +#line 18896 "" + chax_(ch__6, (ftnlen)1, &i__1); +#line 18896 "" i__6[1] = 1, a__4[1] = ch__6; -#line 18907 "" +#line 18896 "" i__6[2] = 4, a__4[2] = ",a1)"; -#line 18907 "" +#line 18896 "" ci__1.cifmt = (s_cat(ch__9, a__4, i__6, &c__3, (ftnlen)11), ch__9) ; -#line 18907 "" +#line 18896 "" s_wsfe(&ci__1); /* Writing concatenation */ -#line 18907 "" +#line 18896 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 18907 "" +#line 18896 "" i__9[1] = 7, a__6[1] = "advance"; -#line 18907 "" +#line 18896 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 18907 "" +#line 18896 "" i__9[3] = 5, a__6[3] = "barno"; -#line 18907 "" +#line 18896 "" s_cat(ch__4, a__6, i__9, &c__4, (ftnlen)14); -#line 18907 "" +#line 18896 "" do_fio(&c__1, ch__4, (ftnlen)14); -#line 18907 "" +#line 18896 "" i__2 = comgrace_1.mbrest - 1; -#line 18907 "" +#line 18896 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 18907 "" +#line 18896 "" do_fio(&c__1, "%", (ftnlen)1); -#line 18907 "" +#line 18896 "" e_wsfe(); -#line 18909 "" +#line 18898 "" } -#line 18910 "" +#line 18899 "" } else if (iscwr) { /* Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar */ /* to check for new clef and add space by redefining \CenterBar */ -#line 18915 "" +#line 18904 "" comclefrests_1.centrests = TRUE_; /* Writing concatenation */ -#line 18916 "" +#line 18905 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 18916 "" +#line 18905 "" i__9[1] = 3, a__6[1] = "def"; -#line 18916 "" +#line 18905 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 18916 "" +#line 18905 "" i__9[3] = 8, a__6[3] = "value{0}"; -#line 18916 "" +#line 18905 "" s_cat(ch__18, a__6, i__9, &c__4, (ftnlen)13); -#line 18916 "" +#line 18905 "" addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, (ftnlen)80); /* Writing concatenation */ -#line 18917 "" +#line 18906 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 18917 "" +#line 18906 "" i__3[1] = 3, a__1[1] = "def"; -#line 18917 "" +#line 18906 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 18917 "" +#line 18906 "" i__3[3] = 10, a__1[3] = "atnextbar{"; -#line 18917 "" +#line 18906 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 18917 "" +#line 18906 "" i__3[5] = 6, a__1[5] = "znotes"; -#line 18917 "" +#line 18906 "" s_cat(ch__21, a__1, i__3, &c__6, (ftnlen)22); -#line 18917 "" +#line 18906 "" addstr_(ch__21, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80); -#line 18919 "" - i__7 = all_1.nv; -#line 18919 "" - for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 18908 "" + i__1 = all_1.nv; +#line 18908 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { /* added */ -#line 18921 "" +#line 18910 "" lnote = 0; -#line 18923 "" +#line 18912 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 18923 "" +#line 18912 "" for (kv = 1; kv <= i__2; ++kv) { -#line 18924 "" +#line 18913 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 18925 "" +#line 18914 "" if (cwrest[commvl_1.ivx]) { /* Writing concatenation */ -#line 18926 "" +#line 18915 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18926 "" +#line 18915 "" i__4[1] = 10, a__2[1] = "CenterBar{"; -#line 18926 "" +#line 18915 "" s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); -#line 18926 "" +#line 18915 "" addstr_(ch__9, &c__11, soutq, &lsout, (ftnlen)11, (ftnlen) 80); -#line 18927 "" +#line 18916 "" if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { -#line 18928 "" +#line 18917 "" if (lcwr[commvl_1.ivx - 1] >= 11 && *(unsigned char *) &cwrq[(commvl_1.ivx - 1) * 79 + 10] != 'p') { /* Kluge to use new definitions for centered, stacked rests */ -#line 18932 "" +#line 18921 "" if (s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1), "liftpause", (ftnlen)9, (ftnlen)9) == 0 || s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1), "liftPAuse", (ftnlen)9, (ftnlen)9) == 0) { -#line 18932 "" +#line 18921 "" *(unsigned char *)&cwrq[(commvl_1.ivx - 1) * 79 + 9] = 'c'; -#line 18932 "" +#line 18921 "" } -#line 18935 "" +#line 18924 "" } -#line 18936 "" +#line 18925 "" addstr_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ commvl_1.ivx - 1], soutq, &lsout, lcwr[ commvl_1.ivx - 1], (ftnlen)80); /* Writing concatenation */ -#line 18938 "" +#line 18927 "" i__6[0] = 6, a__4[0] = "}{-2}{"; -#line 18938 "" +#line 18927 "" i__6[1] = 1, a__4[1] = all_1.sq; -#line 18938 "" +#line 18927 "" i__6[2] = 6, a__4[2] = "value}"; -#line 18938 "" +#line 18927 "" s_cat(ch__18, a__4, i__6, &c__3, (ftnlen)13); -#line 18938 "" +#line 18927 "" addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, ( ftnlen)80); -#line 18939 "" +#line 18928 "" } else { /* Fermata on centered rest. Will need to fix up level. */ /* 12/6/07 shift it left so it's centered over rest */ /* Writing concatenation */ -#line 18944 "" +#line 18933 "" i__15[0] = lnote, a__9[0] = notexq; -#line 18944 "" +#line 18933 "" i__15[1] = 1, a__9[1] = all_1.sq; -#line 18944 "" +#line 18933 "" i__15[2] = 13, a__9[2] = "loffset{.33}{"; -#line 18944 "" +#line 18933 "" i__15[3] = 1, a__9[3] = all_1.sq; -#line 18944 "" +#line 18933 "" i__15[4] = 11, a__9[4] = "fermataup7}"; -#line 18944 "" +#line 18933 "" i__15[5] = lcwr[commvl_1.ivx - 1], a__9[5] = cwrq + ( commvl_1.ivx - 1) * 79; -#line 18944 "" +#line 18933 "" i__15[6] = 6, a__9[6] = "}{-2}{"; -#line 18944 "" +#line 18933 "" i__15[7] = 1, a__9[7] = all_1.sq; -#line 18944 "" +#line 18933 "" i__15[8] = 6, a__9[8] = "value}"; -#line 18944 "" +#line 18933 "" s_cat(notexq, a__9, i__15, &c__9, (ftnlen)79); -#line 18947 "" +#line 18936 "" lnote = lnote + 26 + lcwr[commvl_1.ivx - 1] + 13; -#line 18948 "" +#line 18937 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); -#line 18949 "" +#line 18938 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; -#line 18950 "" +#line 18939 "" } -#line 18951 "" +#line 18940 "" } -#line 18952 "" +#line 18941 "" /* L61: */ -#line 18952 "" +#line 18941 "" } -#line 18953 "" +#line 18942 "" if (all_1.iv != all_1.nv) { -#line 18953 "" +#line 18942 "" addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); -#line 18953 "" +#line 18942 "" } -#line 18954 "" +#line 18943 "" /* L60: */ -#line 18954 "" +#line 18943 "" } -#line 18955 "" +#line 18944 "" if (comlast_1.islast) { /* Writing concatenation */ -#line 18956 "" +#line 18945 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 18956 "" +#line 18945 "" i__4[1] = 4, a__2[1] = "en}%"; -#line 18956 "" +#line 18945 "" s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5); -#line 18956 "" +#line 18945 "" addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); -#line 18957 "" +#line 18946 "" if (lsout > 0) { -#line 18957 "" +#line 18946 "" s_wsfe(&io___1152); -#line 18957 "" +#line 18946 "" do_fio(&c__1, soutq, lsout); -#line 18957 "" +#line 18946 "" e_wsfe(); -#line 18957 "" +#line 18946 "" } -#line 18958 "" +#line 18947 "" } -#line 18959 "" +#line 18948 "" } /* End of block for centered whole-bar rests and multi-bar rests */ @@ -45264,52 +45528,54 @@ L65: /* If at end of block, save durations of last notes in bar, for possible use */ /* if clef changes at start of next bar */ -#line 18966 "" +#line 18955 "" if (all_1.ibar == all_1.nbars) { -#line 18967 "" - i__7 = all_1.nv; -#line 18967 "" - for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { -#line 18968 "" +#line 18956 "" + i__1 = all_1.nv; +#line 18956 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 18957 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 18968 "" +#line 18957 "" for (kv = 1; kv <= i__2; ++kv) { -#line 18969 "" +#line 18958 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 18970 "" +#line 18959 "" comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25] - 1]; -#line 18971 "" -/* L63: */ -#line 18971 "" +#line 18960 "" +/* L6399: */ +#line 18960 "" } -#line 18971 "" +#line 18961 "" +/* L63: */ +#line 18961 "" } -#line 18972 "" +#line 18962 "" } /* Update time for midi. This is only used for the event track */ -#line 18976 "" +#line 18966 "" if (commidi_1.ismidi) { -#line 18977 "" +#line 18967 "" comevent_1.miditime += all_1.lenbar * 15; /* If pickup, write the real time signature to the event track. Cannot use */ /* mtrnuml since it was reset to 0, have to recompute it */ -#line 18982 "" +#line 18972 "" if (all_1.lenb0 == all_1.lenbar) { -#line 18982 "" - i__2 = all_1.mtrdenl * all_1.lenb1 / 64; -#line 18982 "" - midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1); -#line 18982 "" +#line 18972 "" + i__1 = all_1.mtrdenl * all_1.lenb1 / 64; +#line 18972 "" + midievent_("m", &i__1, &all_1.mtrdenl, (ftnlen)1); +#line 18972 "" } -#line 18984 "" +#line 18974 "" } -#line 18985 "" +#line 18975 "" return 0; } /* make2bar_ */ @@ -45373,187 +45639,191 @@ L65: /* i.e., with squez=1. Use after parsing into line to decide if */ /* spacing needs to be "flattened" among notes groups. */ -/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ -/* logical rest,firstline,newmeter,gotclef */ -#line 19034 "" +#line 19022 "" linecom_1.elskb = 0.f; -#line 19035 "" +#line 19023 "" linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f; -#line 19036 "" +#line 19024 "" i__1 = a1ll_2.nv; -#line 19036 "" +#line 19024 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { -#line 19037 "" +#line 19025 "" i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; -#line 19037 "" +#line 19025 "" for (kv = 1; kv <= i__2; ++kv) { -#line 19038 "" +#line 19026 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; -#line 19039 "" +#line 19027 "" if (a1ll_2.ibar > 1) { -#line 19040 "" +#line 19028 "" a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25] - a1ll_2.nib[c1ommvl_1.ivx + ( a1ll_2.ibar - 1) * 24 - 25]; -#line 19041 "" +#line 19029 "" } else { -#line 19042 "" +#line 19030 "" a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25]; -#line 19043 "" +#line 19031 "" } -#line 19044 "" -/* L1: */ -#line 19044 "" +#line 19032 "" +/* L1999: */ +#line 19032 "" } -#line 19044 "" +#line 19033 "" +/* L1: */ +#line 19033 "" } /* initialize list note counter, time(iv), curr. note(iv) */ -#line 19048 "" +#line 19037 "" ilnc = 1; -#line 19049 "" - i__2 = a1ll_2.nv; -#line 19049 "" - for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { -#line 19050 "" - i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; -#line 19050 "" - for (kv = 1; kv <= i__1; ++kv) { -#line 19051 "" +#line 19038 "" + i__1 = a1ll_2.nv; +#line 19038 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 19039 "" + i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 19039 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 19040 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; -#line 19052 "" +#line 19041 "" cnn[c1ommvl_1.ivx - 1] = 1; -#line 19053 "" +#line 19042 "" a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx; -#line 19054 "" +#line 19043 "" a1ll_2.ipo[ilnc - 1] = 1; -#line 19055 "" +#line 19044 "" a1ll_2.to[ilnc - 1] = 0.f; -#line 19056 "" +#line 19045 "" tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1, c1ommvl_1.nacc); -#line 19057 "" +#line 19046 "" xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1]; -#line 19058 "" +#line 19047 "" if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) < comtol_1.tol) { -#line 19058 "" +#line 19047 "" xit[c1ommvl_1.ivx - 1] = 1e3f; -#line 19058 "" +#line 19047 "" } -#line 19059 "" +#line 19048 "" ++ilnc; -#line 19060 "" -/* L4: */ -#line 19060 "" +#line 19049 "" +/* L4999: */ +#line 19049 "" } -#line 19060 "" +#line 19050 "" +/* L4: */ +#line 19050 "" } /* Build the list */ -#line 19064 "" +#line 19054 "" L5: /* Determine which voice comes next from end of notes done so far. */ /* tmin is the earliest ending time of notes done so far */ -#line 19069 "" +#line 19059 "" tmin = 1e3f; -#line 19070 "" +#line 19060 "" i__1 = a1ll_2.nv; -#line 19070 "" +#line 19060 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { -#line 19071 "" +#line 19061 "" i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; -#line 19071 "" +#line 19061 "" for (kv = 1; kv <= i__2; ++kv) { -#line 19072 "" +#line 19062 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; /* Computing MIN */ -#line 19073 "" +#line 19063 "" r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1]; -#line 19073 "" +#line 19063 "" tminn = dmin(r__1,r__2); -#line 19074 "" +#line 19064 "" if (tminn < tmin) { -#line 19075 "" +#line 19065 "" tmin = tminn; -#line 19076 "" +#line 19066 "" ivnext = c1ommvl_1.ivx; -#line 19077 "" +#line 19067 "" } -#line 19078 "" -/* L6: */ -#line 19078 "" +#line 19068 "" +/* L6999: */ +#line 19068 "" } -#line 19078 "" +#line 19069 "" +/* L6: */ +#line 19069 "" } -#line 19079 "" +#line 19070 "" if (tmin > 999.f) { -#line 19079 "" +#line 19070 "" goto L7; -#line 19079 "" +#line 19070 "" } -#line 19080 "" +#line 19071 "" a1ll_2.ivxo[ilnc - 1] = ivnext; -#line 19081 "" +#line 19072 "" ++cnn[ivnext - 1]; -#line 19082 "" +#line 19073 "" a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1]; -#line 19083 "" +#line 19074 "" a1ll_2.to[ilnc - 1] = tmin; /* Check if this voice is done */ -#line 19087 "" +#line 19078 "" tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1], c1ommvl_1.nacc); -#line 19088 "" +#line 19079 "" if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) { -#line 19089 "" +#line 19080 "" xit[ivnext - 1] = 1e3f; -#line 19090 "" +#line 19081 "" } else { -#line 19091 "" +#line 19082 "" xit[ivnext - 1] += tnote[ilnc - 1]; -#line 19092 "" +#line 19083 "" } -#line 19093 "" +#line 19084 "" ++ilnc; -#line 19094 "" +#line 19085 "" goto L5; -#line 19095 "" +#line 19086 "" L7: -#line 19096 "" +#line 19087 "" ntot = ilnc - 1; -#line 19097 "" +#line 19088 "" if (ntot > 600) { -#line 19098 "" +#line 19089 "" printl_(" ", (ftnlen)1); -#line 19099 "" +#line 19090 "" printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen) 49); -#line 19100 "" +#line 19091 "" stop1_(); -#line 19101 "" +#line 19092 "" } -#line 19102 "" - i__2 = ntot - 1; -#line 19102 "" - for (in = 1; in <= i__2; ++in) { -#line 19103 "" +#line 19093 "" + i__1 = ntot - 1; +#line 19093 "" + for (in = 1; in <= i__1; ++in) { +#line 19094 "" a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1]; -#line 19104 "" +#line 19095 "" /* L8: */ -#line 19104 "" +#line 19095 "" } -#line 19105 "" +#line 19096 "" a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], & a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc); -#line 19106 "" +#line 19097 "" tnote[ntot - 1] = a1ll_2.tno[ntot - 1]; /* Debug writes */ @@ -45568,198 +45838,198 @@ L7: /* Done w/ list. Initialize loop for building note blocks: */ -#line 19120 "" +#line 19111 "" ib = 1; -#line 19121 "" +#line 19112 "" istart[0] = 1; -#line 19122 "" +#line 19113 "" space[0] = 0.f; -#line 19123 "" +#line 19114 "" in = 1; /* Start the loop */ -#line 19127 "" +#line 19118 "" L9: -#line 19128 "" +#line 19119 "" if (in == ntot) { -#line 19129 "" +#line 19120 "" if (space[ib - 1] < comtol_1.tol) { -#line 19130 "" +#line 19121 "" space[ib - 1] = a1ll_2.tno[in - 1]; /* Last gap in bar is spanned by a note, so cannot need a squeeze. */ -#line 19134 "" +#line 19125 "" squez[ib - 1] = 1.f; -#line 19135 "" +#line 19126 "" } -#line 19136 "" +#line 19127 "" istop[ib - 1] = ntot; /* From here flow out of this if block and into block-setup */ -#line 19140 "" +#line 19131 "" } else if (space[ib - 1] < comtol_1.tol) { /* space hasn't been set yet, so tentatively set: */ -#line 19144 "" +#line 19135 "" space[ib - 1] = a1ll_2.tno[in - 1]; -#line 19145 "" +#line 19136 "" if (space[ib - 1] < comtol_1.tol) { -#line 19146 "" +#line 19137 "" ++in; -#line 19147 "" +#line 19138 "" } else { /* Tentative space tno(in) is non-zero. Set squez, which will be kept (since */ /* it is a unique property of the particular increment starting here) : */ -#line 19152 "" +#line 19143 "" squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, a1ll_2.to); -#line 19153 "" +#line 19144 "" istop[ib - 1] = in; -#line 19154 "" +#line 19145 "" } -#line 19155 "" +#line 19146 "" goto L9; -#line 19156 "" +#line 19147 "" } else if (a1ll_2.tno[in] < comtol_1.tol) { /* This is not the last note in the space, so */ -#line 19160 "" +#line 19151 "" ++in; -#line 19161 "" +#line 19152 "" goto L9; -#line 19162 "" +#line 19153 "" } else if ((r__1 = a1ll_2.tno[in] - space[ib - 1], dabs(r__1)) < comtol_1.tol) { /* Next increment has same space. Does it have same squez? */ -#line 19166 "" - i__2 = in + 1; -#line 19166 "" - xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to); +#line 19157 "" + i__1 = in + 1; +#line 19157 "" + xsquez = getsquez_(&i__1, &ntot, &space[ib - 1], tnote, a1ll_2.to); /* If it does have the same squez, loop, otherwise flow out */ -#line 19170 "" +#line 19161 "" if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) { /* Keep spacing the same, update tentative stop point */ -#line 19174 "" +#line 19165 "" ++in; -#line 19175 "" +#line 19166 "" istop[ib - 1] = in; -#line 19176 "" +#line 19167 "" goto L9; -#line 19177 "" +#line 19168 "" } -#line 19178 "" +#line 19169 "" } /* At this point istart, istop, space, and squez are good, so close out block */ -#line 19182 "" +#line 19173 "" tstart[ib - 1] = a1ll_2.to[istart[ib - 1] - 1]; /* Compute elemskips assuming no flattening to increase min space. The formula */ /* is only correct if f1eon(t) = sqrt(t/2); more generally (after possible */ /* flattening in pmxb), elsperns = squez*feon(space/squez) */ -#line 19188 "" +#line 19179 "" r__1 = space[ib - 1] * squez[ib - 1]; -#line 19188 "" +#line 19179 "" elsperns = f1eon_(&r__1); -#line 19189 "" +#line 19180 "" if (istop[ib - 1] == ntot) { -#line 19190 "" +#line 19181 "" r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1]; -#line 19190 "" +#line 19181 "" nnsk = i_nint(&r__1); -#line 19191 "" +#line 19182 "" } else { -#line 19192 "" +#line 19183 "" r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1]; -#line 19192 "" +#line 19183 "" nnsk = i_nint(&r__1); -#line 19193 "" +#line 19184 "" } -#line 19194 "" +#line 19185 "" linecom_1.elskb += elsperns * nnsk; -#line 19195 "" +#line 19186 "" if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[ c1omnotes_1.ibarcnt - 1]) { -#line 19196 "" +#line 19187 "" catspace_(&space[ib - 1], &squez[ib - 1], &nnsk); -#line 19197 "" +#line 19188 "" } else { /* This is the first entry for this bar */ -#line 19201 "" +#line 19192 "" c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = nnsk; -#line 19202 "" +#line 19193 "" c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = space[ib - 1]; -#line 19203 "" +#line 19194 "" c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = squez[ib - 1]; -#line 19204 "" +#line 19195 "" ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; -#line 19205 "" +#line 19196 "" } /* Update minimum space spanned by a note */ -#line 19209 "" +#line 19200 "" if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) { /* Computing MIN */ -#line 19209 "" +#line 19200 "" r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1] ; -#line 19209 "" +#line 19200 "" linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3); -#line 19209 "" +#line 19200 "" } -#line 19211 "" +#line 19202 "" if (istop[ib - 1] == ntot) { -#line 19211 "" +#line 19202 "" goto L15; -#line 19211 "" +#line 19202 "" } /* End of spatial accounting for now */ -#line 19215 "" +#line 19206 "" ++ib; -#line 19216 "" +#line 19207 "" istart[ib - 1] = istop[ib - 2] + 1; -#line 19217 "" +#line 19208 "" in = istart[ib - 1]; /* Set tentative block space for new block */ -#line 19221 "" +#line 19212 "" space[ib - 1] = a1ll_2.tno[in - 1]; -#line 19222 "" +#line 19213 "" if (space[ib - 1] > comtol_1.tol) { -#line 19222 "" +#line 19213 "" squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, a1ll_2.to); -#line 19222 "" +#line 19213 "" } -#line 19224 "" +#line 19215 "" istop[ib - 1] = in; -#line 19225 "" +#line 19216 "" goto L9; -#line 19226 "" +#line 19217 "" L15: /* nb = ib */ @@ -45770,7 +46040,7 @@ L15: /* write(*,'(16f5.1)')(space(ib),ib=1,nb) */ /* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */ -#line 19236 "" +#line 19227 "" return 0; } /* makeabar_ */ @@ -45800,129 +46070,129 @@ L15: /* We now store "conductor" events in mmidi(numchan,.), and count bytes */ /* with imidi(numchan) */ -#line 19255 "" +#line 19246 "" i__1 = comevent_1.miditime - comevent_1.lasttime; -#line 19255 "" +#line 19246 "" idur = isetvarlen_(&i__1, &nbytes); -#line 19256 "" +#line 19247 "" commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] + nbytes + 1; -#line 19257 "" +#line 19248 "" i__1 = nbytes; -#line 19257 "" +#line 19248 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 19258 "" +#line 19249 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256) ; -#line 19259 "" +#line 19250 "" idur = lbit_shift(idur, (ftnlen)-8); -#line 19260 "" +#line 19251 "" /* L1: */ -#line 19260 "" +#line 19251 "" } -#line 19261 "" +#line 19252 "" commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] * 25 - 25] = 255; -#line 19262 "" +#line 19253 "" if (*(unsigned char *)typeq == 't') { /* Tempo event. in1 = quarters per minute (integer) */ -#line 19266 "" +#line 19257 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 81; -#line 19267 "" +#line 19258 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 3; -#line 19268 "" +#line 19259 "" r__1 = 6e7f / *in1; -#line 19268 "" +#line 19259 "" misperq = i_nint(&r__1); -#line 19269 "" +#line 19260 "" for (i__ = 1; i__ <= 3; ++i__) { -#line 19270 "" +#line 19261 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) ( misperq % 256); -#line 19271 "" +#line 19262 "" misperq = lbit_shift(misperq, (ftnlen)-8); -#line 19272 "" +#line 19263 "" /* L2: */ -#line 19272 "" +#line 19263 "" } -#line 19273 "" +#line 19264 "" commidi_1.imidi[commidi_1.numchan] += 5; -#line 19274 "" +#line 19265 "" } else if (*(unsigned char *)typeq == 'm') { /* Meter event. in1=numerator, in2=denom (power of 2) */ -#line 19278 "" +#line 19269 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 88; -#line 19279 "" +#line 19270 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 4; -#line 19280 "" +#line 19271 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1); -#line 19281 "" +#line 19272 "" if (*in2 > 0) { -#line 19282 "" +#line 19273 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2) ; -#line 19283 "" +#line 19274 "" } else { -#line 19284 "" +#line 19275 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = 0; -#line 19285 "" +#line 19276 "" } -#line 19286 "" +#line 19277 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 5) * 25 - 25] = 24; -#line 19287 "" +#line 19278 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 6) * 25 - 25] = 8; -#line 19288 "" +#line 19279 "" commidi_1.imidi[commidi_1.numchan] += 6; -#line 19289 "" +#line 19280 "" } else if (*(unsigned char *)typeq == 'k') { /* Keychange event. in1 = isig */ -#line 19293 "" +#line 19284 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 89; -#line 19294 "" +#line 19285 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 2; -#line 19295 "" +#line 19286 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256) % 256); -#line 19296 "" +#line 19287 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = 0; -#line 19297 "" +#line 19288 "" commidi_1.imidi[commidi_1.numchan] += 4; -#line 19298 "" +#line 19289 "" } else { -#line 19299 "" +#line 19290 "" s_wsle(&io___1176); -#line 19299 "" +#line 19290 "" do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29); -#line 19299 "" +#line 19290 "" e_wsle(); -#line 19300 "" +#line 19291 "" stop1_(); -#line 19301 "" +#line 19292 "" } -#line 19302 "" +#line 19293 "" comevent_1.lasttime = comevent_1.miditime; -#line 19303 "" +#line 19294 "" return 0; } /* midievent_ */ @@ -45945,51 +46215,51 @@ L15: static cilist io___1180 = { 0, 0, 0, "(a)", 0 }; -#line 19308 "" +#line 19299 "" *done = FALSE_; -#line 19309 "" +#line 19300 "" io___1177.ciunit = *iuin; -#line 19309 "" +#line 19300 "" i__1 = s_rsfe(&io___1177); -#line 19309 "" +#line 19300 "" if (i__1 != 0) { -#line 19309 "" +#line 19300 "" goto L1; -#line 19309 "" +#line 19300 "" } -#line 19309 "" +#line 19300 "" i__1 = do_fio(&c__1, outq, (ftnlen)129); -#line 19309 "" +#line 19300 "" if (i__1 != 0) { -#line 19309 "" +#line 19300 "" goto L1; -#line 19309 "" +#line 19300 "" } -#line 19309 "" +#line 19300 "" i__1 = e_rsfe(); -#line 19309 "" +#line 19300 "" if (i__1 != 0) { -#line 19309 "" +#line 19300 "" goto L1; -#line 19309 "" +#line 19300 "" } -#line 19310 "" +#line 19301 "" lenout = llen_(outq, &c__129, (ftnlen)129); -#line 19311 "" +#line 19302 "" io___1180.ciunit = *iuout; -#line 19311 "" +#line 19302 "" s_wsfe(&io___1180); -#line 19311 "" +#line 19302 "" do_fio(&c__1, outq, lenout); -#line 19311 "" +#line 19302 "" e_wsfe(); -#line 19312 "" +#line 19303 "" return 0; -#line 19313 "" +#line 19304 "" L1: -#line 19313 "" +#line 19304 "" *done = TRUE_; -#line 19314 "" +#line 19305 "" return 0; } /* moveln_ */ @@ -46009,55 +46279,55 @@ L1: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ -#line 19330 "" +#line 19321 "" if (! commac_1.mrecord) { /* Starting the macro */ -#line 19334 "" +#line 19325 "" c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; -#line 19335 "" +#line 19326 "" c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; -#line 19336 "" +#line 19327 "" c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; -#line 19337 "" +#line 19328 "" commac_1.mrecord = TRUE_; -#line 19338 "" +#line 19329 "" } -#line 19339 "" +#line 19330 "" if (*iccount < 128) { -#line 19340 "" +#line 19331 "" i__1 = *iccount; -#line 19340 "" +#line 19331 "" *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); -#line 19341 "" +#line 19332 "" if (*ndxm > 0) { -#line 19341 "" +#line 19332 "" i__1 = *iccount; -#line 19341 "" +#line 19332 "" i__2 = 128 - *iccount; -#line 19341 "" +#line 19332 "" *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); -#line 19341 "" +#line 19332 "" } -#line 19343 "" +#line 19334 "" if (*ndxm > 0) { /* This line ends the macro. */ -#line 19347 "" +#line 19338 "" c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; -#line 19348 "" +#line 19339 "" c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; -#line 19349 "" +#line 19340 "" commac_1.mrecord = FALSE_; -#line 19350 "" +#line 19341 "" } -#line 19351 "" +#line 19342 "" } -#line 19352 "" +#line 19343 "" return 0; } /* mrec1_ */ @@ -46079,39 +46349,39 @@ integer ncmid_(integer *iv, integer *ip) static cilist io___1183 = { 0, 6, 0, 0, 0 }; -#line 19372 "" +#line 19363 "" if (comcc_1.ncc[*iv - 1] == 1) { -#line 19373 "" +#line 19364 "" ret_val = comcc_1.ncmidcc[*iv - 1]; -#line 19374 "" +#line 19365 "" } else { -#line 19375 "" +#line 19366 "" xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1]; -#line 19376 "" +#line 19367 "" for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) { -#line 19377 "" +#line 19368 "" if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) { -#line 19378 "" +#line 19369 "" ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25]; -#line 19379 "" +#line 19370 "" return ret_val; -#line 19380 "" +#line 19371 "" } -#line 19381 "" +#line 19372 "" /* L1: */ -#line 19381 "" +#line 19372 "" } -#line 19382 "" +#line 19373 "" s_wsle(&io___1183); -#line 19382 "" +#line 19373 "" do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18); -#line 19382 "" +#line 19373 "" e_wsle(); -#line 19383 "" +#line 19374 "" s_stop("", (ftnlen)0); -#line 19384 "" +#line 19375 "" } -#line 19385 "" +#line 19376 "" return ret_val; } /* ncmid_ */ @@ -46126,21 +46396,21 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* Return middle line of a clef */ -#line 19391 "" +#line 19382 "" if (*(unsigned char *)clefq == '8') { /* treblelowoct; will treat as treble for this purpose */ -#line 19395 "" +#line 19386 "" ret_val = 35; -#line 19396 "" +#line 19387 "" } else { -#line 19397 "" +#line 19388 "" ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) / 2 << 1) + 21; -#line 19398 "" +#line 19389 "" } -#line 19399 "" +#line 19390 "" return ret_val; } /* ncmidf_ */ @@ -46150,60 +46420,60 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) static integer j; extern integer ncmidf_(char *, ftnlen); -#line 19422 "" +#line 19413 "" commvl_1.nvmx[*jv - 1] = 1; -#line 19423 "" +#line 19414 "" commvl_1.ivmx[*jv - 1] = *jv; -#line 19424 "" +#line 19415 "" all_1.itsofar[*jv - 1] = 0; -#line 19425 "" +#line 19416 "" all_1.nnl[*jv - 1] = 0; -#line 19426 "" +#line 19417 "" comfb_1.nfb[*jv - 1] = 0; -#line 19427 "" +#line 19418 "" if (all_1.firstgulp || *change) { -#line 19428 "" +#line 19419 "" comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1); -#line 19429 "" +#line 19420 "" } else { -#line 19430 "" +#line 19421 "" comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1] * 24 - 25]; -#line 19431 "" +#line 19422 "" } -#line 19432 "" +#line 19423 "" comcc_1.tcc[*jv - 1] = 0.f; -#line 19433 "" +#line 19424 "" comcc_1.ncc[*jv - 1] = 1; -#line 19434 "" +#line 19425 "" comudsp_1.nudoff[*jv - 1] = 0; -#line 19435 "" +#line 19426 "" comcc_1.ndotmv[*jv - 1] = 0; -#line 19436 "" +#line 19427 "" for (j = 1; j <= 200; ++j) { -#line 19437 "" +#line 19428 "" all_1.irest[*jv + j * 24 - 25] = 0; -#line 19438 "" +#line 19429 "" all_1.islur[*jv + j * 24 - 25] = 0; -#line 19439 "" +#line 19430 "" all_1.ipl[*jv + j * 24 - 25] = 0; -#line 19440 "" +#line 19431 "" all_1.nacc[*jv + j * 24 - 25] = 0; -#line 19441 "" +#line 19432 "" all_1.iornq[*jv + j * 24 - 1] = 0; -#line 19442 "" +#line 19433 "" all_1.mult[*jv + j * 24 - 25] = 0; -#line 19443 "" +#line 19434 "" if (*jv <= 2) { -#line 19443 "" +#line 19434 "" all_1.isfig[*jv + (j << 1) - 3] = FALSE_; -#line 19443 "" +#line 19434 "" } -#line 19444 "" +#line 19435 "" /* L5: */ -#line 19444 "" +#line 19435 "" } -#line 19445 "" +#line 19436 "" return 0; } /* newvoice_ */ @@ -46230,118 +46500,118 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* Returns name of note level with octave transpositions, updates noctup. */ -#line 19454 "" +#line 19445 "" nupfroma = (*nolev + 1) % 7; -#line 19455 "" +#line 19446 "" iname = nupfroma + 97; -#line 19456 "" +#line 19447 "" ioctup = (*nolev + 1) / 7 - 4; -#line 19457 "" +#line 19448 "" chax_(ch__1, (ftnlen)1, &iname); -#line 19457 "" +#line 19448 "" *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; -#line 19458 "" +#line 19449 "" if (*ncmid == 23) { -#line 19458 "" +#line 19449 "" upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1); -#line 19458 "" +#line 19449 "" *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; -#line 19458 "" +#line 19449 "" } -#line 19459 "" +#line 19450 "" if (ioctup == comoct_1.noctup) { -#line 19460 "" +#line 19451 "" s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1); -#line 19461 "" +#line 19452 "" *lnote = 1; /* Must ALWAYS check if lnote=1 for use with functions requiring a blank */ -#line 19465 "" +#line 19456 "" } else if (ioctup > comoct_1.noctup) { /* Raise octave. Encase in {} */ -#line 19469 "" +#line 19460 "" ici__1.icierr = 0; -#line 19469 "" +#line 19460 "" ici__1.icirnum = 1; -#line 19469 "" +#line 19460 "" ici__1.icirlen = 8; -#line 19469 "" +#line 19460 "" ici__1.iciunit = noteq; -#line 19469 "" +#line 19460 "" ici__1.icifmt = "(8a1)"; -#line 19469 "" +#line 19460 "" s_wsfi(&ici__1); -#line 19469 "" +#line 19460 "" do_fio(&c__1, "{", (ftnlen)1); -#line 19469 "" +#line 19460 "" i__1 = ioctup - 1; -#line 19469 "" +#line 19460 "" for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) { -#line 19469 "" +#line 19460 "" chax_(ch__2, (ftnlen)1, &c__39); -#line 19469 "" +#line 19460 "" *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; -#line 19469 "" +#line 19460 "" do_fio(&c__1, ch__1, (ftnlen)1); -#line 19469 "" +#line 19460 "" } -#line 19469 "" +#line 19460 "" do_fio(&c__1, noteqt, (ftnlen)1); -#line 19469 "" +#line 19460 "" do_fio(&c__1, "}", (ftnlen)1); -#line 19469 "" +#line 19460 "" e_wsfi(); -#line 19471 "" +#line 19462 "" *lnote = ioctup + 3 - comoct_1.noctup; -#line 19472 "" +#line 19463 "" comoct_1.noctup = ioctup; -#line 19473 "" +#line 19464 "" } else { /* Lower octave */ -#line 19477 "" +#line 19468 "" ici__1.icierr = 0; -#line 19477 "" +#line 19468 "" ici__1.icirnum = 1; -#line 19477 "" +#line 19468 "" ici__1.icirlen = 8; -#line 19477 "" +#line 19468 "" ici__1.iciunit = noteq; -#line 19477 "" +#line 19468 "" ici__1.icifmt = "(8a1)"; -#line 19477 "" +#line 19468 "" s_wsfi(&ici__1); -#line 19477 "" +#line 19468 "" do_fio(&c__1, "{", (ftnlen)1); -#line 19477 "" +#line 19468 "" i__1 = comoct_1.noctup - 1; -#line 19477 "" +#line 19468 "" for (i__ = ioctup; i__ <= i__1; ++i__) { -#line 19477 "" +#line 19468 "" chax_(ch__2, (ftnlen)1, &c__96); -#line 19477 "" +#line 19468 "" *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; -#line 19477 "" +#line 19468 "" do_fio(&c__1, ch__1, (ftnlen)1); -#line 19477 "" +#line 19468 "" } -#line 19477 "" +#line 19468 "" do_fio(&c__1, noteqt, (ftnlen)1); -#line 19477 "" +#line 19468 "" do_fio(&c__1, "}", (ftnlen)1); -#line 19477 "" +#line 19468 "" e_wsfi(); -#line 19479 "" +#line 19470 "" *lnote = comoct_1.noctup + 3 - ioctup; -#line 19480 "" +#line 19471 "" comoct_1.noctup = ioctup; -#line 19481 "" +#line 19472 "" } -#line 19482 "" +#line 19473 "" return 0; } /* notefq_ */ @@ -46393,971 +46663,971 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* Returns non-beamed full note name */ -#line 19512 "" +#line 19503 "" ip = all_1.ipo[all_1.jn - 1]; -#line 19513 "" +#line 19504 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ -#line 19517 "" +#line 19508 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { -#line 19518 "" +#line 19509 "" --nole; -#line 19519 "" +#line 19510 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { -#line 19520 "" +#line 19511 "" ++nole; -#line 19521 "" +#line 19512 "" } -#line 19522 "" +#line 19513 "" nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -#line 19523 "" +#line 19514 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 19524 "" +#line 19515 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 19524 "" +#line 19515 "" udqq_(ch__1, (ftnlen)1, &nole, &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); -#line 19524 "" +#line 19515 "" *(unsigned char *)udq = *(unsigned char *)&ch__1[0]; -#line 19526 "" +#line 19517 "" } /* Check figure level */ /* if (figbass .and. isfig(ivx,ip) */ /* * .and. .not.btest(irest(ivx,ip),0)) then */ -#line 19532 "" +#line 19523 "" if (all_1.figbass && ! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && (commvl_1.ivx == 1 && all_1.isfig[(ip << 1) - 2] || commvl_1.ivx == comfig_1.ivxfig2 && all_1.isfig[(ip << 1) - 1])) { -#line 19535 "" +#line 19526 "" if (*(unsigned char *)udq == 'u' || nodu >= 64) { /* Upper or no stem, fnole (in noleunits) set by notehead */ -#line 19539 "" +#line 19530 "" fnole = (real) nole; -#line 19540 "" +#line 19531 "" } else { /* Lower stem, fnole set by bottom of stem */ -#line 19544 "" +#line 19535 "" fnole = nole - all_1.stemlen; -#line 19545 "" +#line 19536 "" } -#line 19546 "" +#line 19537 "" zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4; -#line 19547 "" +#line 19538 "" if (commvl_1.ivx == 1) { /* Computing MAX */ -#line 19548 "" +#line 19539 "" r__1 = 4 - zmin; -#line 19548 "" +#line 19539 "" i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1); -#line 19548 "" +#line 19539 "" all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2); -#line 19549 "" +#line 19540 "" } else { /* Computing MAX */ -#line 19550 "" +#line 19541 "" r__1 = 4 - zmin; -#line 19550 "" +#line 19541 "" i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1); -#line 19550 "" +#line 19541 "" all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2); -#line 19551 "" +#line 19542 "" } -#line 19552 "" +#line 19543 "" } -#line 19553 "" +#line 19544 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 19554 "" +#line 19545 "" i__1 = ncmid_(&all_1.iv, &ip); -#line 19554 "" +#line 19545 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); -#line 19555 "" +#line 19546 "" if (lnoten == 1) { -#line 19555 "" +#line 19546 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 19555 "" +#line 19546 "" } -#line 19556 "" +#line 19547 "" if (nodu == 1) { /* Writing concatenation */ -#line 19557 "" +#line 19548 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19557 "" +#line 19548 "" i__3[1] = 4, a__1[1] = "cccc"; -#line 19557 "" +#line 19548 "" i__3[2] = 1, a__1[2] = udq; -#line 19557 "" +#line 19548 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19557 "" +#line 19548 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19558 "" +#line 19549 "" *lnote = lnoten + 6; -#line 19559 "" +#line 19550 "" } else if (nodu == 2) { /* Writing concatenation */ -#line 19560 "" +#line 19551 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19560 "" +#line 19551 "" i__3[1] = 3, a__1[1] = "ccc"; -#line 19560 "" +#line 19551 "" i__3[2] = 1, a__1[2] = udq; -#line 19560 "" +#line 19551 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19560 "" +#line 19551 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19561 "" +#line 19552 "" *lnote = lnoten + 5; -#line 19562 "" +#line 19553 "" } else if (nodu == 4) { /* Writing concatenation */ -#line 19563 "" +#line 19554 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19563 "" +#line 19554 "" i__3[1] = 2, a__1[1] = "cc"; -#line 19563 "" +#line 19554 "" i__3[2] = 1, a__1[2] = udq; -#line 19563 "" +#line 19554 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19563 "" +#line 19554 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19564 "" +#line 19555 "" *lnote = lnoten + 4; -#line 19565 "" +#line 19556 "" } else if (nodu == 8) { /* Writing concatenation */ -#line 19566 "" +#line 19557 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19566 "" +#line 19557 "" i__3[1] = 1, a__1[1] = "c"; -#line 19566 "" +#line 19557 "" i__3[2] = 1, a__1[2] = udq; -#line 19566 "" +#line 19557 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19566 "" +#line 19557 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19567 "" +#line 19558 "" *lnote = lnoten + 3; -#line 19568 "" +#line 19559 "" } else if (nodu == 16) { /* Writing concatenation */ -#line 19569 "" +#line 19560 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19569 "" +#line 19560 "" i__3[1] = 1, a__1[1] = "q"; -#line 19569 "" +#line 19560 "" i__3[2] = 1, a__1[2] = udq; -#line 19569 "" +#line 19560 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19569 "" +#line 19560 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19570 "" +#line 19561 "" *lnote = lnoten + 3; -#line 19571 "" +#line 19562 "" } else if (nodu == 32) { /* Writing concatenation */ -#line 19572 "" +#line 19563 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19572 "" +#line 19563 "" i__3[1] = 1, a__1[1] = "h"; -#line 19572 "" +#line 19563 "" i__3[2] = 1, a__1[2] = udq; -#line 19572 "" +#line 19563 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19572 "" +#line 19563 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19573 "" +#line 19564 "" *lnote = lnoten + 3; -#line 19574 "" +#line 19565 "" } else if (nodu == 64) { /* Writing concatenation */ -#line 19575 "" +#line 19566 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 19575 "" +#line 19566 "" i__4[1] = 2, a__2[1] = "wh"; -#line 19575 "" +#line 19566 "" i__4[2] = lnoten, a__2[2] = noteq; -#line 19575 "" +#line 19566 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); -#line 19576 "" +#line 19567 "" *lnote = lnoten + 3; -#line 19577 "" +#line 19568 "" } else if (nodu == 128) { /* notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */ /* lnote = lnoten+10 */ /* Writing concatenation */ -#line 19580 "" +#line 19571 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 19580 "" +#line 19571 "" i__4[1] = 5, a__2[1] = "breve"; -#line 19580 "" +#line 19571 "" i__4[2] = lnoten, a__2[2] = noteq; -#line 19580 "" +#line 19571 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); -#line 19581 "" +#line 19572 "" *lnote = lnoten + 6; -#line 19582 "" +#line 19573 "" } else { -#line 19583 "" +#line 19574 "" s_copy(dotq, "p", (ftnlen)4, (ftnlen)1); -#line 19584 "" +#line 19575 "" ldot = 1; -#line 19585 "" +#line 19576 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { /* Dotted note with ')' ornament */ -#line 19589 "" +#line 19580 "" s_copy(dotq, "m", (ftnlen)4, (ftnlen)1); -#line 19590 "" +#line 19581 "" } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { /* Double dot */ -#line 19594 "" +#line 19585 "" s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2); -#line 19595 "" +#line 19586 "" ldot = 2; -#line 19596 "" +#line 19587 "" } -#line 19597 "" +#line 19588 "" if (nodu >= 192) { /* Writing concatenation */ -#line 19598 "" +#line 19589 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19598 "" +#line 19589 "" i__3[1] = 5, a__1[1] = "breve"; -#line 19598 "" +#line 19589 "" i__3[2] = ldot, a__1[2] = dotq; -#line 19598 "" +#line 19589 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19598 "" +#line 19589 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19599 "" +#line 19590 "" *lnote = lnoten + 6 + ldot; -#line 19600 "" +#line 19591 "" } else if (nodu >= 96) { /* Writing concatenation */ -#line 19601 "" +#line 19592 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 19601 "" +#line 19592 "" i__3[1] = 2, a__1[1] = "wh"; -#line 19601 "" +#line 19592 "" i__3[2] = ldot, a__1[2] = dotq; -#line 19601 "" +#line 19592 "" i__3[3] = lnoten, a__1[3] = noteq; -#line 19601 "" +#line 19592 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19602 "" +#line 19593 "" *lnote = lnoten + 3 + ldot; -#line 19603 "" +#line 19594 "" } else if (nodu >= 48) { /* Writing concatenation */ -#line 19604 "" +#line 19595 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19604 "" +#line 19595 "" i__5[1] = 1, a__3[1] = "h"; -#line 19604 "" +#line 19595 "" i__5[2] = 1, a__3[2] = udq; -#line 19604 "" +#line 19595 "" i__5[3] = ldot, a__3[3] = dotq; -#line 19604 "" +#line 19595 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 19604 "" +#line 19595 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19605 "" +#line 19596 "" *lnote = lnoten + 3 + ldot; -#line 19606 "" +#line 19597 "" } else if (nodu >= 24) { /* Writing concatenation */ -#line 19607 "" +#line 19598 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19607 "" +#line 19598 "" i__5[1] = 1, a__3[1] = "q"; -#line 19607 "" +#line 19598 "" i__5[2] = 1, a__3[2] = udq; -#line 19607 "" +#line 19598 "" i__5[3] = ldot, a__3[3] = dotq; -#line 19607 "" +#line 19598 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 19607 "" +#line 19598 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19608 "" +#line 19599 "" *lnote = lnoten + 3 + ldot; -#line 19609 "" +#line 19600 "" } else if (nodu >= 12) { /* Writing concatenation */ -#line 19610 "" +#line 19601 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19610 "" +#line 19601 "" i__5[1] = 1, a__3[1] = "c"; -#line 19610 "" +#line 19601 "" i__5[2] = 1, a__3[2] = udq; -#line 19610 "" +#line 19601 "" i__5[3] = ldot, a__3[3] = dotq; -#line 19610 "" +#line 19601 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 19610 "" +#line 19601 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19611 "" +#line 19602 "" *lnote = lnoten + 3 + ldot; -#line 19612 "" +#line 19603 "" } else if (nodu >= 6) { /* Writing concatenation */ -#line 19613 "" +#line 19604 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19613 "" +#line 19604 "" i__5[1] = 2, a__3[1] = "cc"; -#line 19613 "" +#line 19604 "" i__5[2] = 1, a__3[2] = udq; -#line 19613 "" +#line 19604 "" i__5[3] = ldot, a__3[3] = dotq; -#line 19613 "" +#line 19604 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 19613 "" +#line 19604 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19614 "" +#line 19605 "" *lnote = lnoten + 4 + ldot; -#line 19615 "" +#line 19606 "" compoi_1.ispoi = TRUE_; -#line 19616 "" +#line 19607 "" } else { /* Writing concatenation */ -#line 19617 "" +#line 19608 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19617 "" +#line 19608 "" i__5[1] = 3, a__3[1] = "ccc"; -#line 19617 "" +#line 19608 "" i__5[2] = 1, a__3[2] = udq; -#line 19617 "" +#line 19608 "" i__5[3] = ldot, a__3[3] = dotq; -#line 19617 "" +#line 19608 "" i__5[4] = lnoten, a__3[4] = noteq; -#line 19617 "" +#line 19608 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19618 "" +#line 19609 "" *lnote = lnoten + 5 + ldot; -#line 19619 "" +#line 19610 "" compoi_1.ispoi = TRUE_; -#line 19620 "" +#line 19611 "" } -#line 19621 "" +#line 19612 "" if (*(unsigned char *)dotq == 'm') { /* Need another call to the note, in case the first one has octave shifts */ -#line 19625 "" +#line 19616 "" if (lnoten == 2) { /* Writing concatenation */ -#line 19626 "" +#line 19617 "" i__3[0] = *lnote, a__1[0] = notexq; -#line 19626 "" +#line 19617 "" i__3[1] = 1, a__1[1] = "{"; -#line 19626 "" +#line 19617 "" i__3[2] = 1, a__1[2] = noteq + 1; -#line 19626 "" +#line 19617 "" i__3[3] = 1, a__1[3] = "}"; -#line 19626 "" +#line 19617 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); -#line 19627 "" +#line 19618 "" *lnote += 3; -#line 19628 "" +#line 19619 "" } else { -#line 19629 "" +#line 19620 "" i__1 = lnoten - 2; /* Writing concatenation */ -#line 19629 "" +#line 19620 "" i__6[0] = *lnote, a__4[0] = notexq; -#line 19629 "" +#line 19620 "" i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1; -#line 19629 "" +#line 19620 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19630 "" +#line 19621 "" ++(*lnote); -#line 19631 "" +#line 19622 "" } -#line 19632 "" +#line 19623 "" } -#line 19633 "" +#line 19624 "" } -#line 19634 "" +#line 19625 "" } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Blank rest */ /* Writing concatenation */ -#line 19638 "" +#line 19629 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19638 "" +#line 19629 "" i__6[1] = 2, a__4[1] = "sk"; -#line 19638 "" +#line 19629 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19639 "" +#line 19630 "" *lnote = 3; -#line 19640 "" +#line 19631 "" } else { /* Non-blank rest */ -#line 19644 "" +#line 19635 "" *lnote = 0; -#line 19645 "" +#line 19636 "" nole = (nole + 20) % 100 - 20; /* Kluge to get pause symbol for rp: */ -#line 19649 "" +#line 19640 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) { -#line 19649 "" +#line 19640 "" nodu = 64; -#line 19649 "" +#line 19640 "" } -#line 19650 "" +#line 19641 "" if (nodu <= 28) { /* Normal rest < or = double-dotted quarter */ -#line 19654 "" +#line 19645 "" lrest = 3; -#line 19655 "" +#line 19646 "" if (nodu > 14) { /* Writing concatenation */ -#line 19656 "" +#line 19647 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19656 "" +#line 19647 "" i__6[1] = 2, a__4[1] = "qp"; -#line 19656 "" +#line 19647 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19657 "" +#line 19648 "" } else if (nodu > 7) { /* Writing concatenation */ -#line 19658 "" +#line 19649 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19658 "" +#line 19649 "" i__6[1] = 2, a__4[1] = "ds"; -#line 19658 "" +#line 19649 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19659 "" +#line 19650 "" } else if (nodu > 3) { /* Writing concatenation */ -#line 19660 "" +#line 19651 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19660 "" +#line 19651 "" i__6[1] = 2, a__4[1] = "qs"; -#line 19660 "" +#line 19651 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19661 "" +#line 19652 "" } else if (nodu > 1) { /* Writing concatenation */ -#line 19662 "" +#line 19653 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19662 "" +#line 19653 "" i__6[1] = 2, a__4[1] = "hs"; -#line 19662 "" +#line 19653 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19663 "" +#line 19654 "" } else { /* Writing concatenation */ -#line 19664 "" +#line 19655 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19664 "" +#line 19655 "" i__6[1] = 3, a__4[1] = "qqs"; -#line 19664 "" +#line 19655 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19665 "" +#line 19656 "" lrest = 4; -#line 19666 "" +#line 19657 "" } /* Special case for rest at start of F-tuplet inside a forced beam */ -#line 19670 "" +#line 19661 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18) && bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19)) { /* Writing concatenation */ -#line 19672 "" +#line 19663 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 19672 "" +#line 19663 "" i__4[1] = 3, a__2[1] = "pt4"; -#line 19672 "" +#line 19663 "" i__4[2] = lrest, a__2[2] = restq; -#line 19672 "" +#line 19663 "" s_cat(restq, a__2, i__4, &c__3, (ftnlen)40); -#line 19673 "" +#line 19664 "" lrest += 4; -#line 19674 "" +#line 19665 "" } -#line 19675 "" +#line 19666 "" s_copy(notexq, restq, (ftnlen)79, (ftnlen)40); -#line 19676 "" +#line 19667 "" *lnote = lrest; /* At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. */ -#line 19680 "" +#line 19671 "" if (nole != 0) { -#line 19681 "" +#line 19672 "" if (abs(nole) < 10) { -#line 19682 "" +#line 19673 "" i__1 = abs(nole) + 48; -#line 19682 "" +#line 19673 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 19682 "" +#line 19673 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); -#line 19683 "" +#line 19674 "" lnoten = 1; -#line 19684 "" +#line 19675 "" } else { -#line 19685 "" +#line 19676 "" s_wsfi(&io___1202); -#line 19685 "" +#line 19676 "" i__1 = abs(nole); -#line 19685 "" +#line 19676 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 19685 "" +#line 19676 "" e_wsfi(); -#line 19686 "" +#line 19677 "" lnoten = 2; -#line 19687 "" +#line 19678 "" } -#line 19688 "" +#line 19679 "" if (nole > 0) { /* Writing concatenation */ -#line 19689 "" +#line 19680 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19689 "" +#line 19680 "" i__5[1] = 5, a__3[1] = "raise"; -#line 19689 "" +#line 19680 "" i__5[2] = lnoten, a__3[2] = noteq; -#line 19689 "" +#line 19680 "" i__5[3] = 1, a__3[3] = all_1.sq; -#line 19689 "" +#line 19680 "" i__5[4] = 9, a__3[4] = "internote"; -#line 19689 "" +#line 19680 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19690 "" +#line 19681 "" } else { /* Writing concatenation */ -#line 19691 "" +#line 19682 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 19691 "" +#line 19682 "" i__5[1] = 5, a__3[1] = "lower"; -#line 19691 "" +#line 19682 "" i__5[2] = lnoten, a__3[2] = noteq; -#line 19691 "" +#line 19682 "" i__5[3] = 1, a__3[3] = all_1.sq; -#line 19691 "" +#line 19682 "" i__5[4] = 9, a__3[4] = "internote"; -#line 19691 "" +#line 19682 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); -#line 19692 "" +#line 19683 "" } -#line 19693 "" +#line 19684 "" *lnote = lnoten + 16; /* Writing concatenation */ -#line 19694 "" +#line 19685 "" i__6[0] = *lnote, a__4[0] = notexq; -#line 19694 "" +#line 19685 "" i__6[1] = lrest, a__4[1] = restq; -#line 19694 "" +#line 19685 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19695 "" +#line 19686 "" *lnote += lrest; -#line 19696 "" +#line 19687 "" } -#line 19697 "" +#line 19688 "" i__1 = log2_(&nodu); -#line 19697 "" +#line 19688 "" if (pow_ii(&c__2, &i__1) != nodu) { /* Deal with dots (on rests shorter than half rest) */ /* Writing concatenation */ -#line 19701 "" +#line 19692 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19701 "" +#line 19692 "" i__6[1] = 2, a__4[1] = "pt"; -#line 19701 "" +#line 19692 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19702 "" +#line 19693 "" lrest = 3; -#line 19703 "" +#line 19694 "" i__1 = log2_(&nodu); -#line 19703 "" +#line 19694 "" if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { /* Writing concatenation */ -#line 19704 "" +#line 19695 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19704 "" +#line 19695 "" i__6[1] = 3, a__4[1] = "ppt"; -#line 19704 "" +#line 19695 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19705 "" +#line 19696 "" lrest = 4; -#line 19706 "" +#line 19697 "" } -#line 19707 "" +#line 19698 "" nole += 4; -#line 19708 "" +#line 19699 "" raisedot = 0.f; /* Tweak dot positions for special cases */ -#line 19712 "" +#line 19703 "" even = (nole + 100) % 2 == 0; /* if (.not.even.and.nodu.gt.8.and. */ /* * (nole.lt.0.or.nole.gt.8)) then */ -#line 19715 "" +#line 19706 "" if (! even && (nole < 0 || nole > 8)) { -#line 19716 "" +#line 19707 "" raisedot = 1.f; -#line 19717 "" +#line 19708 "" } -#line 19718 "" +#line 19709 "" if (nole >= 10 || nole <= -1) { -#line 19719 "" +#line 19710 "" s_wsfi(&io___1206); -#line 19719 "" +#line 19710 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); -#line 19719 "" +#line 19710 "" e_wsfi(); /* Writing concatenation */ -#line 19720 "" +#line 19711 "" i__3[0] = lrest, a__1[0] = restq; -#line 19720 "" +#line 19711 "" i__3[1] = 1, a__1[1] = "{"; -#line 19720 "" +#line 19711 "" i__3[2] = 2, a__1[2] = numq; -#line 19720 "" +#line 19711 "" i__3[3] = 1, a__1[3] = "}"; -#line 19720 "" +#line 19711 "" s_cat(restq, a__1, i__3, &c__4, (ftnlen)40); -#line 19721 "" +#line 19712 "" lrest += 4; -#line 19722 "" +#line 19713 "" } else { /* Writing concatenation */ -#line 19723 "" +#line 19714 "" i__6[0] = lrest, a__4[0] = restq; -#line 19723 "" +#line 19714 "" i__1 = nole + 48; -#line 19723 "" +#line 19714 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 19723 "" +#line 19714 "" i__6[1] = 1, a__4[1] = ch__1; -#line 19723 "" +#line 19714 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); -#line 19724 "" +#line 19715 "" ++lrest; -#line 19725 "" +#line 19716 "" } -#line 19726 "" +#line 19717 "" if (raisedot > 0.f) { /* Writing concatenation */ -#line 19727 "" +#line 19718 "" i__7[0] = 1, a__5[0] = all_1.sq; -#line 19727 "" +#line 19718 "" i__7[1] = 5, a__5[1] = "raise"; -#line 19727 "" +#line 19718 "" i__7[2] = 1, a__5[2] = all_1.sq; -#line 19727 "" +#line 19718 "" i__7[3] = 9, a__5[3] = "internote"; -#line 19727 "" +#line 19718 "" i__7[4] = 1, a__5[4] = all_1.sq; -#line 19727 "" +#line 19718 "" i__7[5] = 5, a__5[5] = "hbox{"; -#line 19727 "" +#line 19718 "" i__7[6] = lrest, a__5[6] = restq; -#line 19727 "" +#line 19718 "" i__7[7] = 1, a__5[7] = "}"; -#line 19727 "" +#line 19718 "" s_cat(restq, a__5, i__7, &c__8, (ftnlen)40); -#line 19729 "" +#line 19720 "" lrest += 23; -#line 19730 "" +#line 19721 "" } /* Writing concatenation */ -#line 19731 "" +#line 19722 "" i__6[0] = lrest, a__4[0] = restq; -#line 19731 "" +#line 19722 "" i__6[1] = *lnote, a__4[1] = notexq; -#line 19731 "" +#line 19722 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19732 "" +#line 19723 "" *lnote += lrest; -#line 19733 "" +#line 19724 "" } -#line 19734 "" +#line 19725 "" } else { /* Half rest or longer */ -#line 19738 "" +#line 19729 "" if (nole == 0) { /* Half or longer rest is not raised or lowered */ -#line 19742 "" +#line 19733 "" if (nodu <= 56) { /* Writing concatenation */ -#line 19743 "" +#line 19734 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19743 "" +#line 19734 "" i__6[1] = 6, a__4[1] = "hpause"; -#line 19743 "" +#line 19734 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19744 "" +#line 19735 "" *lnote = 7; -#line 19745 "" +#line 19736 "" } else if (nodu <= 112) { -#line 19746 "" +#line 19737 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 19) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],25)) { /* Writing concatenation */ -#line 19748 "" +#line 19739 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19748 "" +#line 19739 "" i__6[1] = 5, a__4[1] = "pause"; -#line 19748 "" +#line 19739 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19749 "" +#line 19740 "" } else { /* Writing concatenation */ -#line 19750 "" +#line 19741 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19750 "" +#line 19741 "" i__6[1] = 5, a__4[1] = "pausc"; -#line 19750 "" +#line 19741 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19751 "" +#line 19742 "" } -#line 19752 "" +#line 19743 "" *lnote = 6; -#line 19753 "" +#line 19744 "" } else { /* Writing concatenation */ -#line 19754 "" +#line 19745 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19754 "" +#line 19745 "" i__6[1] = 5, a__4[1] = "PAuse"; -#line 19754 "" +#line 19745 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19755 "" +#line 19746 "" *lnote = 6; -#line 19756 "" +#line 19747 "" } -#line 19757 "" +#line 19748 "" i__1 = log2_(&nodu); -#line 19757 "" +#line 19748 "" if (pow_ii(&c__2, &i__1) != nodu) { /* Dotted rest, hpause or longer */ /* Writing concatenation */ -#line 19761 "" +#line 19752 "" i__6[0] = *lnote, a__4[0] = notexq; -#line 19761 "" +#line 19752 "" i__6[1] = 1, a__4[1] = "p"; -#line 19761 "" +#line 19752 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19762 "" +#line 19753 "" ++(*lnote); -#line 19763 "" +#line 19754 "" i__1 = log2_(&nodu); -#line 19763 "" +#line 19754 "" if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { /* Double dotted long rest */ /* Writing concatenation */ -#line 19767 "" +#line 19758 "" i__6[0] = *lnote, a__4[0] = notexq; -#line 19767 "" +#line 19758 "" i__6[1] = 1, a__4[1] = "p"; -#line 19767 "" +#line 19758 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19768 "" +#line 19759 "" ++(*lnote); -#line 19769 "" +#line 19760 "" } -#line 19770 "" +#line 19761 "" } -#line 19771 "" +#line 19762 "" } else { /* Raised or lowered half or whole rest */ -#line 19775 "" +#line 19766 "" if (nodu == 32) { /* Writing concatenation */ -#line 19776 "" +#line 19767 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19776 "" +#line 19767 "" i__6[1] = 10, a__4[1] = "lifthpause"; -#line 19776 "" +#line 19767 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19777 "" +#line 19768 "" *lnote = 11; -#line 19778 "" +#line 19769 "" } else if (nodu == 48) { /* Writing concatenation */ -#line 19779 "" +#line 19770 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19779 "" +#line 19770 "" i__6[1] = 11, a__4[1] = "lifthpausep"; -#line 19779 "" +#line 19770 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19780 "" +#line 19771 "" *lnote = 12; -#line 19781 "" +#line 19772 "" } else if (nodu == 56) { /* Writing concatenation */ -#line 19782 "" +#line 19773 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19782 "" +#line 19773 "" i__6[1] = 12, a__4[1] = "lifthpausepp"; -#line 19782 "" +#line 19773 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19783 "" +#line 19774 "" *lnote = 13; -#line 19784 "" +#line 19775 "" } else if (nodu == 64) { /* Writing concatenation */ -#line 19785 "" +#line 19776 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19785 "" +#line 19776 "" i__6[1] = 9, a__4[1] = "liftpause"; -#line 19785 "" +#line 19776 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19786 "" +#line 19777 "" *lnote = 10; -#line 19787 "" +#line 19778 "" } else if (nodu == 96) { /* Writing concatenation */ -#line 19788 "" +#line 19779 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19788 "" +#line 19779 "" i__6[1] = 10, a__4[1] = "liftpausep"; -#line 19788 "" +#line 19779 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19789 "" +#line 19780 "" *lnote = 11; -#line 19790 "" +#line 19781 "" } else if (nodu == 112) { /* Writing concatenation */ -#line 19791 "" +#line 19782 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19791 "" +#line 19782 "" i__6[1] = 11, a__4[1] = "liftpausepp"; -#line 19791 "" +#line 19782 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19792 "" +#line 19783 "" *lnote = 12; -#line 19793 "" +#line 19784 "" } else if (nodu == 128) { /* Writing concatenation */ -#line 19794 "" +#line 19785 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19794 "" +#line 19785 "" i__6[1] = 9, a__4[1] = "liftPAuse"; -#line 19794 "" +#line 19785 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19795 "" +#line 19786 "" *lnote = 10; -#line 19796 "" +#line 19787 "" } else { /* Assume dotted double whole rest */ /* Writing concatenation */ -#line 19800 "" +#line 19791 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 19800 "" +#line 19791 "" i__6[1] = 10, a__4[1] = "liftPAusep"; -#line 19800 "" +#line 19791 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19801 "" +#line 19792 "" *lnote = 11; -#line 19802 "" +#line 19793 "" } /* Set up height spec */ -#line 19806 "" +#line 19797 "" i__1 = abs(nole) / 2; -#line 19806 "" +#line 19797 "" nole = i_sign(&i__1, &nole); -#line 19807 "" +#line 19798 "" if (nole <= 9 && nole >= 0) { -#line 19808 "" +#line 19799 "" i__1 = nole + 48; -#line 19808 "" +#line 19799 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 19808 "" +#line 19799 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); -#line 19809 "" +#line 19800 "" lnoten = 1; -#line 19810 "" +#line 19801 "" } else { -#line 19811 "" +#line 19802 "" s_copy(noteq, "{", (ftnlen)8, (ftnlen)1); -#line 19812 "" +#line 19803 "" if (nole >= -9) { -#line 19813 "" +#line 19804 "" s_wsfi(&io___1207); -#line 19813 "" +#line 19804 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); -#line 19813 "" +#line 19804 "" e_wsfi(); -#line 19814 "" +#line 19805 "" lnoten = 3; -#line 19815 "" +#line 19806 "" } else { -#line 19816 "" +#line 19807 "" s_wsfi(&io___1208); -#line 19816 "" +#line 19807 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); -#line 19816 "" +#line 19807 "" e_wsfi(); -#line 19817 "" +#line 19808 "" lnoten = 4; -#line 19818 "" +#line 19809 "" } /* Writing concatenation */ -#line 19819 "" +#line 19810 "" i__6[0] = lnoten, a__4[0] = noteq; -#line 19819 "" +#line 19810 "" i__6[1] = 1, a__4[1] = "}"; -#line 19819 "" +#line 19810 "" s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8); -#line 19820 "" +#line 19811 "" ++lnoten; -#line 19821 "" +#line 19812 "" } /* Writing concatenation */ -#line 19822 "" +#line 19813 "" i__6[0] = *lnote, a__4[0] = notexq; -#line 19822 "" +#line 19813 "" i__6[1] = lnoten, a__4[1] = noteq; -#line 19822 "" +#line 19813 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 19823 "" +#line 19814 "" *lnote += lnoten; -#line 19824 "" +#line 19815 "" } -#line 19825 "" +#line 19816 "" } -#line 19826 "" +#line 19817 "" } -#line 19827 "" +#line 19818 "" return 0; } /* notex_ */ @@ -47384,98 +47654,98 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */ -#line 19836 "" +#line 19827 "" ndxs2 = i_indx(line, s2q, line_len, s2q_len); -#line 19837 "" +#line 19828 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 19837 "" +#line 19828 "" ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1); -#line 19838 "" +#line 19829 "" if (ndxbs == 0 || ndxs2 < ndxbs) { -#line 19839 "" +#line 19830 "" ret_val = ndxs2; -#line 19840 "" +#line 19831 "" } else { /* There are both bs and s2q, and bs is to the left of sq2. So check bs's to */ /* right of first: End is '\ ', start is ' \' */ -#line 19845 "" +#line 19836 "" len = lenstr_(line, lenline, line_len); -#line 19846 "" +#line 19837 "" intex = TRUE_; -#line 19847 "" +#line 19838 "" i__1 = len; -#line 19847 "" +#line 19838 "" for (ic = ndxbs + 1; ic <= i__1; ++ic) { -#line 19848 "" +#line 19839 "" if (ic == ndxs2) { -#line 19849 "" +#line 19840 "" if (intex) { -#line 19850 "" +#line 19841 "" ret_val = 0; -#line 19851 "" +#line 19842 "" i__2 = ic; -#line 19851 "" +#line 19842 "" ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) + ic; -#line 19852 "" +#line 19843 "" } else { -#line 19853 "" +#line 19844 "" ret_val = ndxs2; -#line 19854 "" +#line 19845 "" return ret_val; -#line 19855 "" +#line 19846 "" } -#line 19856 "" +#line 19847 "" } else /* if(complicated condition) */ { -#line 19856 "" +#line 19847 "" i__2 = ic; /* Writing concatenation */ -#line 19856 "" +#line 19847 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 19856 "" +#line 19847 "" i__3[0] = 1, a__1[0] = ch__1; -#line 19856 "" +#line 19847 "" i__3[1] = 1, a__1[1] = " "; -#line 19856 "" +#line 19847 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); -#line 19856 "" +#line 19847 "" if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen) 2) == 0) { -#line 19857 "" +#line 19848 "" intex = FALSE_; -#line 19858 "" +#line 19849 "" } else /* if(complicated condition) */ { -#line 19858 "" +#line 19849 "" i__2 = ic; /* Writing concatenation */ -#line 19858 "" +#line 19849 "" i__3[0] = 1, a__1[0] = " "; -#line 19858 "" +#line 19849 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 19858 "" +#line 19849 "" i__3[1] = 1, a__1[1] = ch__1; -#line 19858 "" +#line 19849 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); -#line 19858 "" +#line 19849 "" if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, ( ftnlen)2) == 0) { -#line 19860 "" +#line 19851 "" intex = TRUE_; -#line 19861 "" +#line 19852 "" } -#line 19861 "" +#line 19852 "" } -#line 19861 "" +#line 19852 "" } -#line 19862 "" +#line 19853 "" /* L1: */ -#line 19862 "" +#line 19853 "" } -#line 19863 "" +#line 19854 "" } -#line 19864 "" +#line 19855 "" return ret_val; } /* ntindex_ */ @@ -47502,56 +47772,56 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* This appends to notexq e.g. '\ibbbu1' */ -#line 19875 "" +#line 19866 "" if (*n >= 5) { -#line 19875 "" +#line 19866 "" combbm_1.isbbm = TRUE_; -#line 19875 "" +#line 19866 "" } -#line 19876 "" +#line 19867 "" if (*lnote > 0) { /* Writing concatenation */ -#line 19877 "" +#line 19868 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 19877 "" +#line 19868 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 19877 "" +#line 19868 "" i__1[1] = 1, a__1[1] = ch__1; -#line 19877 "" +#line 19868 "" i__1[2] = 1, a__1[2] = char1q; -#line 19877 "" +#line 19868 "" s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); -#line 19878 "" +#line 19869 "" } else { /* Writing concatenation */ -#line 19879 "" +#line 19870 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 19879 "" +#line 19870 "" i__2[0] = 1, a__2[0] = ch__1; -#line 19879 "" +#line 19870 "" i__2[1] = 1, a__2[1] = char1q; -#line 19879 "" +#line 19870 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 19880 "" +#line 19871 "" } -#line 19881 "" +#line 19872 "" *lnote += 2; -#line 19882 "" +#line 19873 "" i__3 = *n; -#line 19882 "" +#line 19873 "" for (im = 1; im <= i__3; ++im) { /* Writing concatenation */ -#line 19883 "" +#line 19874 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 19883 "" +#line 19874 "" i__2[1] = 1, a__2[1] = "b"; -#line 19883 "" +#line 19874 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); -#line 19884 "" +#line 19875 "" ++(*lnote); -#line 19885 "" +#line 19876 "" /* L3: */ -#line 19885 "" +#line 19876 "" } /* add the number, 0 if 12 */ @@ -47559,36 +47829,36 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* 5/25/08 Allow >12 */ /* call istring(mod(iv,12),tempq,len) */ -#line 19892 "" +#line 19883 "" if (*iv < 24) { -#line 19893 "" +#line 19884 "" istring_(iv, tempq, &len, (ftnlen)4); -#line 19894 "" +#line 19885 "" } else if (*iv == 24) { -#line 19895 "" +#line 19886 "" *(unsigned char *)tempq = '0'; -#line 19896 "" +#line 19887 "" len = 1; -#line 19897 "" +#line 19888 "" } else { -#line 19898 "" +#line 19889 "" printl_("Sorry, too man open beams", (ftnlen)25); -#line 19899 "" +#line 19890 "" stop1_(); -#line 19900 "" +#line 19891 "" } /* Writing concatenation */ -#line 19901 "" +#line 19892 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 19901 "" +#line 19892 "" i__1[1] = 1, a__1[1] = ulqq; -#line 19901 "" +#line 19892 "" i__1[2] = len, a__1[2] = tempq; -#line 19901 "" +#line 19892 "" s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); -#line 19902 "" +#line 19893 "" *lnote = *lnote + 1 + len; -#line 19903 "" +#line 19894 "" return 0; } /* ntrbbb_ */ @@ -47606,27 +47876,27 @@ integer numclef_(char *clefq, ftnlen clefq_len) /* 7 f 9 */ /* 8 0 */ -#line 19913 "" +#line 19904 "" if (*(unsigned char *)clefq < 55) { /* if (ichar(clefq) .le. 55) then */ -#line 19915 "" +#line 19906 "" ret_val = *(unsigned char *)clefq - 48; /* if (numclef .eq. 7) numclef = 9 */ -#line 19917 "" +#line 19908 "" } else if (*(unsigned char *)clefq == '7') { -#line 19918 "" +#line 19909 "" ret_val = 9; -#line 19919 "" +#line 19910 "" } else if (*(unsigned char *)clefq == '8') { -#line 19920 "" +#line 19911 "" ret_val = 0; -#line 19921 "" +#line 19912 "" } else { -#line 19922 "" +#line 19913 "" ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1; -#line 19923 "" +#line 19914 "" } -#line 19924 "" +#line 19915 "" return ret_val; } /* numclef_ */ @@ -47648,121 +47918,121 @@ integer numclef_(char *clefq, ftnlen clefq_len) extern /* Character */ VOID chax_(char *, ftnlen, integer *); static integer nfmt; -#line 19928 "" +#line 19919 "" r__1 = *i__ + .5f; -#line 19928 "" +#line 19919 "" nfmt = r_lg10(&r__1) + 2; -#line 19929 "" +#line 19920 "" if (*jlast + 5 + nfmt < 80) { -#line 19930 "" +#line 19921 "" ci__1.cierr = 0; -#line 19930 "" +#line 19921 "" ci__1.ciunit = 6; /* Writing concatenation */ -#line 19930 "" +#line 19921 "" i__1[0] = 5, a__1[0] = "(a5,i"; -#line 19930 "" +#line 19921 "" i__2 = nfmt + 48; -#line 19930 "" +#line 19921 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 19930 "" +#line 19921 "" i__1[1] = 1, a__1[1] = ch__2; -#line 19930 "" +#line 19921 "" i__1[2] = 3, a__1[2] = ",$)"; -#line 19930 "" +#line 19921 "" ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); -#line 19930 "" +#line 19921 "" s_wsfe(&ci__1); -#line 19930 "" +#line 19921 "" do_fio(&c__1, " Bar", (ftnlen)5); -#line 19930 "" +#line 19921 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); -#line 19930 "" +#line 19921 "" e_wsfe(); -#line 19931 "" +#line 19922 "" ci__1.cierr = 0; -#line 19931 "" +#line 19922 "" ci__1.ciunit = 15; /* Writing concatenation */ -#line 19931 "" +#line 19922 "" i__1[0] = 5, a__1[0] = "(a5,i"; -#line 19931 "" +#line 19922 "" i__2 = nfmt + 48; -#line 19931 "" +#line 19922 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 19931 "" +#line 19922 "" i__1[1] = 1, a__1[1] = ch__2; -#line 19931 "" +#line 19922 "" i__1[2] = 3, a__1[2] = ",$)"; -#line 19931 "" +#line 19922 "" ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); -#line 19931 "" +#line 19922 "" s_wsfe(&ci__1); -#line 19931 "" +#line 19922 "" do_fio(&c__1, " Bar", (ftnlen)5); -#line 19931 "" +#line 19922 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); -#line 19931 "" +#line 19922 "" e_wsfe(); -#line 19932 "" +#line 19923 "" *jlast = *jlast + 5 + nfmt; -#line 19933 "" +#line 19924 "" } else { -#line 19934 "" +#line 19925 "" ci__1.cierr = 0; -#line 19934 "" +#line 19925 "" ci__1.ciunit = 6; /* Writing concatenation */ -#line 19934 "" +#line 19925 "" i__1[0] = 7, a__1[0] = "(/,a5,i"; -#line 19934 "" +#line 19925 "" i__2 = nfmt + 48; -#line 19934 "" +#line 19925 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 19934 "" +#line 19925 "" i__1[1] = 1, a__1[1] = ch__2; -#line 19934 "" +#line 19925 "" i__1[2] = 3, a__1[2] = ",$)"; -#line 19934 "" +#line 19925 "" ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); -#line 19934 "" +#line 19925 "" s_wsfe(&ci__1); -#line 19934 "" +#line 19925 "" do_fio(&c__1, " Bar", (ftnlen)5); -#line 19934 "" +#line 19925 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); -#line 19934 "" +#line 19925 "" e_wsfe(); -#line 19935 "" +#line 19926 "" ci__1.cierr = 0; -#line 19935 "" +#line 19926 "" ci__1.ciunit = 15; /* Writing concatenation */ -#line 19935 "" +#line 19926 "" i__1[0] = 7, a__1[0] = "(/,a5,i"; -#line 19935 "" +#line 19926 "" i__2 = nfmt + 48; -#line 19935 "" +#line 19926 "" chax_(ch__2, (ftnlen)1, &i__2); -#line 19935 "" +#line 19926 "" i__1[1] = 1, a__1[1] = ch__2; -#line 19935 "" +#line 19926 "" i__1[2] = 3, a__1[2] = ",$)"; -#line 19935 "" +#line 19926 "" ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); -#line 19935 "" +#line 19926 "" s_wsfe(&ci__1); -#line 19935 "" +#line 19926 "" do_fio(&c__1, " Bar", (ftnlen)5); -#line 19935 "" +#line 19926 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); -#line 19935 "" +#line 19926 "" e_wsfe(); -#line 19936 "" +#line 19927 "" *jlast = nfmt + 5; -#line 19937 "" +#line 19928 "" } -#line 19938 "" +#line 19929 "" return 0; } /* outbar_ */ @@ -47909,374 +48179,371 @@ integer numclef_(char *clefq, ftnlen clefq_len) /* c Check for nbars > nsyst */ /* c */ /* cccccccccccccccccccccccccccccccccc */ -/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ -/* logical mrecord,mplay,endmac,gotclef,cstuplet */ -#line 20027 "" +#line 20016 "" /* Parameter adjustments */ -#line 20027 "" +#line 20016 "" --nbarss; -#line 20027 "" +#line 20016 "" -#line 20027 "" +#line 20016 "" /* Function Body */ /* data poefa /125*1./ */ /* This corrected a problem in Bob Tennent's compilation of pmx2.94 */ -#line 20032 "" +#line 20021 "" for (i__ = 1; i__ <= 125; ++i__) { -#line 20033 "" +#line 20022 "" comshort_1.poefa[i__ - 1] = 1.f; -#line 20034 "" +#line 20023 "" /* L97: */ -#line 20034 "" +#line 20023 "" } -#line 20035 "" +#line 20024 "" comis4bignv_1.is4bignv = FALSE_; -#line 20036 "" +#line 20025 "" comis4bignv_1.aiset = FALSE_; -#line 20037 "" +#line 20026 "" commus_1.whead20 = .3f; -#line 20038 "" +#line 20027 "" comshort_1.ishort = 0; -#line 20039 "" +#line 20028 "" if (! (*optimize)) { -#line 20040 "" +#line 20029 "" s_wsle(&io___1222); -#line 20040 "" +#line 20029 "" e_wsle(); -#line 20041 "" +#line 20030 "" s_wsle(&io___1223); -#line 20041 "" +#line 20030 "" do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23); -#line 20041 "" +#line 20030 "" e_wsle(); -#line 20042 "" +#line 20031 "" s_wsfe(&io___1224); -#line 20042 "" +#line 20031 "" do_fio(&c__1, " Starting first PMX pass", (ftnlen)24); -#line 20042 "" +#line 20031 "" e_wsfe(); -#line 20043 "" +#line 20032 "" } -#line 20044 "" +#line 20033 "" if (*isfirst) { -#line 20045 "" +#line 20034 "" o__1.oerr = 0; -#line 20045 "" +#line 20034 "" o__1.ounit = 19; -#line 20045 "" +#line 20034 "" o__1.ofnmlen = 11; -#line 20045 "" +#line 20034 "" o__1.ofnm = "pmxaerr.dat"; -#line 20045 "" +#line 20034 "" o__1.orl = 0; -#line 20045 "" +#line 20034 "" o__1.osta = 0; -#line 20045 "" +#line 20034 "" o__1.oacc = 0; -#line 20045 "" +#line 20034 "" o__1.ofm = 0; -#line 20045 "" +#line 20034 "" o__1.oblnk = 0; -#line 20045 "" +#line 20034 "" f_open(&o__1); -#line 20046 "" +#line 20035 "" s_wsfe(&io___1225); -#line 20046 "" +#line 20035 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 20046 "" +#line 20035 "" e_wsfe(); -#line 20047 "" +#line 20036 "" cl__1.cerr = 0; -#line 20047 "" +#line 20036 "" cl__1.cunit = 19; -#line 20047 "" +#line 20036 "" cl__1.csta = 0; -#line 20047 "" +#line 20036 "" f_clos(&cl__1); -#line 20048 "" +#line 20037 "" } -#line 20049 "" +#line 20038 "" if (! (*optimize)) { -#line 20049 "" +#line 20038 "" jprntb = 81; -#line 20049 "" +#line 20038 "" } -#line 20050 "" +#line 20039 "" commac_1.macuse = 0; -#line 20051 "" +#line 20040 "" comkeys_1.ornrpt = FALSE_; -#line 20052 "" +#line 20041 "" comkeys_1.stickys = FALSE_; -#line 20053 "" +#line 20042 "" commac_1.mrecord = FALSE_; -#line 20054 "" +#line 20043 "" commac_1.mplay = FALSE_; -#line 20055 "" +#line 20044 "" c1omget_1.lastchar = FALSE_; -#line 20056 "" +#line 20045 "" comnvst_2.novshrinktop = FALSE_; -#line 20057 "" +#line 20046 "" cstuplet = FALSE_; -#line 20058 "" +#line 20047 "" comslur_1.fontslur = TRUE_; -#line 20059 "" +#line 20048 "" comligfont_1.isligfont = FALSE_; -#line 20060 "" +#line 20049 "" fulltrans = FALSE_; -#line 20061 "" +#line 20050 "" for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999; ++c1omnotes_1.ibarcnt) { -#line 20062 "" +#line 20051 "" c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f; -#line 20063 "" +#line 20052 "" c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f; -#line 20064 "" +#line 20053 "" /* L42: */ -#line 20064 "" +#line 20053 "" } /* Initialize input buffer */ -#line 20068 "" +#line 20057 "" c1omget_1.lenbuf0 = inbuff_1.ipbuf; -#line 20069 "" +#line 20058 "" inbuff_1.ipbuf = 0; -#line 20070 "" +#line 20059 "" inbuff_1.ilbuf = 1; -#line 20071 "" +#line 20060 "" g1etset_(&a1ll_2.nv, &comkeys_1.noinst, &a1ll_2.mtrnuml, &mtrdenl, & mtrnmp, &mtrdnp, &xmtrnum0, comkeys_1.newkey, &compage_1.npages, & compage_1.nsyst, &commus_1.musize, &bottreb); /* Set up list of instrument numbers (iv) */ -#line 20076 "" +#line 20065 "" ivnow = 0; -#line 20077 "" +#line 20066 "" i__1 = comkeys_1.noinst; -#line 20077 "" +#line 20066 "" for (instnow = 1; instnow <= i__1; ++instnow) { -#line 20078 "" +#line 20067 "" i__2 = c1omget_1.nsperi[instnow - 1]; -#line 20078 "" +#line 20067 "" for (iscount = 1; iscount <= i__2; ++iscount) { -#line 20079 "" +#line 20068 "" ++ivnow; -#line 20080 "" +#line 20069 "" cominsttrans_1.instno[ivnow - 1] = instnow; -#line 20081 "" +#line 20070 "" /* L14: */ -#line 20081 "" +#line 20070 "" } -#line 20082 "" +#line 20071 "" /* L13: */ -#line 20082 "" +#line 20071 "" } /* Save initial meter for midi */ -#line 20086 "" +#line 20075 "" if (! (*isfirst) && compage_1.npages == 0) { -#line 20087 "" +#line 20076 "" s_wsle(&io___1237); -#line 20087 "" +#line 20076 "" do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", ( ftnlen)43); -#line 20087 "" +#line 20076 "" e_wsle(); -#line 20088 "" +#line 20077 "" stop1_(); -#line 20089 "" +#line 20078 "" } -#line 20090 "" +#line 20079 "" *nsyout = compage_1.nsyst; /* isig1 will be changed in getnote if there is a transposition */ -#line 20094 "" +#line 20083 "" comkeys_1.isig1 = comkeys_1.newkey[0]; -#line 20095 "" +#line 20084 "" if (compage_1.npages > compage_1.nsyst) { -#line 20096 "" +#line 20085 "" printl_("npages > nsyst in input. Please fix the input.", (ftnlen)47) ; -#line 20097 "" +#line 20086 "" stop1_(); -#line 20098 "" +#line 20087 "" } /* fbar = afterruleskip/elemskip */ /* apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */ -#line 20103 "" +#line 20092 "" c1ommvl_1.fbar = 1.f; -#line 20104 "" +#line 20093 "" c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; -#line 20105 "" +#line 20094 "" ifig = 0; -#line 20106 "" +#line 20095 "" compage_1.usefig = TRUE_; -#line 20107 "" +#line 20096 "" lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); -#line 20108 "" +#line 20097 "" lenmult = 1; -#line 20109 "" +#line 20098 "" if (mtrdenl == 2) { -#line 20110 "" +#line 20099 "" lenbeat = 16; -#line 20111 "" +#line 20100 "" lenmult = 2; -#line 20112 "" +#line 20101 "" } -#line 20113 "" +#line 20102 "" a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat; -#line 20114 "" +#line 20103 "" r__1 = lenmult * xmtrnum0 * lenbeat; -#line 20114 "" +#line 20103 "" a1ll_2.lenbr0 = i_nint(&r__1); -#line 20115 "" +#line 20104 "" a1ll_2.mtrnuml = 0; -#line 20116 "" +#line 20105 "" if (a1ll_2.lenbr0 != 0) { -#line 20117 "" +#line 20106 "" c1omnotes_1.ibaroff = 1; -#line 20118 "" +#line 20107 "" a1ll_2.lenbar = a1ll_2.lenbr0; -#line 20119 "" +#line 20108 "" } else { -#line 20120 "" +#line 20109 "" c1omnotes_1.ibaroff = 0; -#line 20121 "" +#line 20110 "" a1ll_2.lenbar = a1ll_2.lenbr1; -#line 20122 "" +#line 20111 "" } -#line 20123 "" +#line 20112 "" c1omnotes_1.ibarcnt = 0; -#line 20124 "" +#line 20113 "" c1omnotes_1.nptr[0] = 1; -#line 20125 "" +#line 20114 "" a1ll_2.iccount = 128; -#line 20126 "" +#line 20115 "" compage_1.nmovbrk = 0; -#line 20127 "" +#line 20116 "" compage_1.nflb = 0; -#line 20128 "" +#line 20117 "" compage_1.nfpb = 0; -#line 20129 "" +#line 20118 "" compage_1.ipagfpb[0] = 1; -#line 20130 "" +#line 20119 "" compage_1.isysfpb[0] = 1; -#line 20131 "" +#line 20120 "" compage_1.ibarflb[0] = 1; -#line 20132 "" +#line 20121 "" compage_1.isysflb[0] = 1; -#line 20133 "" +#line 20122 "" compage_1.nistaff[0] = a1ll_2.nv - 1; /* Check for pmx.mod */ -#line 20137 "" +#line 20126 "" c1omget_1.linesinpmxmod = 0; /* line1pmxmod = ilbuf */ -#line 20139 "" +#line 20128 "" getpmxmod_(&c_true, " ", (ftnlen)1); -#line 20140 "" +#line 20129 "" if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) { -#line 20141 "" +#line 20130 "" s_wsle(&io___1241); -#line 20141 "" +#line 20130 "" do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"\ "ile", (ftnlen)49); -#line 20141 "" +#line 20130 "" e_wsle(); -#line 20142 "" +#line 20131 "" stop1_(); -#line 20143 "" +#line 20132 "" } /* Initialize for loop over lines */ -#line 20147 "" +#line 20136 "" comkeys_1.nkeys = 1; -#line 20148 "" +#line 20137 "" comkeys_1.ibrkch[0] = 1; -#line 20149 "" +#line 20138 "" comkeys_1.mbrestsav = 0; -#line 20150 "" +#line 20139 "" comkeys_1.shifton = FALSE_; -#line 20151 "" +#line 20140 "" a1ll_2.firstline = TRUE_; -#line 20152 "" +#line 20141 "" a1ll_2.newmeter = FALSE_; -#line 20153 "" +#line 20142 "" c1omget_1.ihead = 0; -#line 20154 "" +#line 20143 "" c1omget_1.isheadr = FALSE_; -/* gotclef = .false. */ -#line 20156 "" +#line 20144 "" comkeys_1.idsig = 0; -#line 20157 "" +#line 20145 "" c1omnotes_1.iddot = 0; -#line 20158 "" +#line 20146 "" compage_1.fintstf = -1.f; -#line 20159 "" +#line 20147 "" compage_1.gintstf = 1.f; -#line 20160 "" +#line 20148 "" listcresc = 0; -#line 20161 "" +#line 20149 "" listdecresc = 0; -#line 20162 "" +#line 20150 "" L30: -#line 20162 "" +#line 20150 "" loop = TRUE_; -#line 20163 "" +#line 20151 "" comkeys_1.iskchb = FALSE_; -#line 20164 "" +#line 20152 "" c1omget_1.issegno = FALSE_; -#line 20165 "" +#line 20153 "" a1ll_2.nbars = 0; -#line 20166 "" +#line 20154 "" c1omnotes_1.ibarmbr = 0; -#line 20167 "" +#line 20155 "" i__1 = a1ll_2.nv; -#line 20167 "" +#line 20155 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { -#line 20168 "" +#line 20156 "" c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1; -#line 20169 "" +#line 20157 "" c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv; -#line 20170 "" +#line 20158 "" a1ll_2.itsofar[a1ll_2.iv - 1] = 0; -#line 20171 "" +#line 20159 "" a1ll_2.nnl[a1ll_2.iv - 1] = 0; -#line 20172 "" +#line 20160 "" for (j = 1; j <= 200; ++j) { -#line 20173 "" +#line 20161 "" a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_; -#line 20174 "" +#line 20162 "" c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f; -#line 20175 "" +#line 20163 "" /* L5: */ -#line 20175 "" +#line 20163 "" } -#line 20176 "" +#line 20164 "" /* L4: */ -#line 20176 "" +#line 20164 "" } -#line 20177 "" +#line 20165 "" a1ll_2.iv = 1; -#line 20178 "" +#line 20166 "" c1ommvl_1.ivx = 1; -#line 20179 "" +#line 20167 "" c1omget_1.fbon = FALSE_; -#line 20180 "" +#line 20168 "" comkeys_1.barend = FALSE_; -#line 20181 "" +#line 20169 "" c1omget_1.isvolt = FALSE_; -#line 20182 "" +#line 20170 "" L2: -#line 20182 "" +#line 20170 "" if (loop) { /* Within this short loop, nv voices are filled up for the duration of a block. */ @@ -48284,525 +48551,529 @@ L2: /* nodur(..),rest(..). nnl will later be */ /* increased and things slid around as accidental skips are added. */ -#line 20189 "" +#line 20177 "" g1etnote_(&loop, &ifig, optimize, &fulltrans); -#line 20190 "" +#line 20178 "" if (c1omget_1.lastchar) { -#line 20190 "" +#line 20178 "" goto L20; -#line 20190 "" +#line 20178 "" } -#line 20191 "" +#line 20179 "" goto L2; -#line 20192 "" +#line 20180 "" } -#line 20193 "" +#line 20181 "" if (comkeys_1.mbrestsav > 0) { -#line 20194 "" +#line 20182 "" printl_(" ", (ftnlen)1); -#line 20195 "" +#line 20183 "" printl_("You must enter the same multibar rest in ALL parts", (ftnlen) 50); -#line 20197 "" +#line 20185 "" stop1_(); -#line 20198 "" +#line 20186 "" } -#line 20199 "" +#line 20187 "" i__1 = a1ll_2.nbars; -#line 20199 "" +#line 20187 "" for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { -#line 20200 "" +#line 20188 "" ++c1omnotes_1.ibarcnt; /* The following is just a signal to start a new bar when cataloging spaces */ /* for catspace(...) */ -#line 20205 "" +#line 20193 "" c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[ c1omnotes_1.ibarcnt - 1]; -#line 20206 "" +#line 20194 "" newmb[c1omnotes_1.ibarcnt - 1] = FALSE_; -#line 20207 "" +#line 20195 "" if (a1ll_2.newmeter && a1ll_2.ibar == 1) { -#line 20207 "" +#line 20195 "" newmb[c1omnotes_1.ibarcnt - 1] = TRUE_; -#line 20207 "" +#line 20195 "" } /* Above is only for spacing calcs later on. Remember new meter can only occur */ /* at START of a new input line (ibar = 1) */ -#line 20212 "" +#line 20200 "" if (a1ll_2.ibar != c1omnotes_1.ibarmbr) { -#line 20213 "" +#line 20201 "" if (! (*optimize)) { -#line 20213 "" +#line 20201 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; -#line 20213 "" +#line 20201 "" outbar_(&i__2, &jprntb); -#line 20213 "" +#line 20201 "" } -#line 20214 "" +#line 20202 "" } else { -#line 20215 "" +#line 20203 "" if (! (*optimize)) { -#line 20216 "" +#line 20204 "" s_wsfe(&io___1247); -#line 20216 "" +#line 20204 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); -#line 20216 "" +#line 20204 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; -#line 20216 "" +#line 20204 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 20216 "" +#line 20204 "" do_fio(&c__1, "-", (ftnlen)1); -#line 20216 "" +#line 20204 "" i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + c1omnotes_1.mbrest - 1; -#line 20216 "" +#line 20204 "" do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); -#line 20216 "" +#line 20204 "" e_wsfe(); -#line 20218 "" +#line 20206 "" s_wsfe(&io___1248); -#line 20218 "" +#line 20206 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); -#line 20218 "" +#line 20206 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; -#line 20218 "" +#line 20206 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 20218 "" +#line 20206 "" do_fio(&c__1, "-", (ftnlen)1); -#line 20218 "" +#line 20206 "" i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + c1omnotes_1.mbrest - 1; -#line 20218 "" +#line 20206 "" do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); -#line 20218 "" +#line 20206 "" e_wsfe(); -#line 20220 "" +#line 20208 "" jprntb = 0; -#line 20221 "" +#line 20209 "" } -#line 20222 "" +#line 20210 "" c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest + 1; -#line 20223 "" +#line 20211 "" } -#line 20224 "" +#line 20212 "" if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) { -#line 20225 "" +#line 20213 "" if (a1ll_2.ibar == 1) { -#line 20226 "" +#line 20214 "" a1ll_2.lenbar = a1ll_2.lenbr0; -#line 20227 "" +#line 20215 "" } else { -#line 20228 "" +#line 20216 "" a1ll_2.lenbar = a1ll_2.lenbr1; -#line 20229 "" +#line 20217 "" } -#line 20230 "" +#line 20218 "" } -#line 20231 "" +#line 20219 "" if (a1ll_2.ibar > 1) { /* For bars after first, slide all stuff down to beginning of arrays */ -#line 20235 "" +#line 20223 "" i__2 = a1ll_2.nv; -#line 20235 "" +#line 20223 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { -#line 20236 "" +#line 20224 "" i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; -#line 20236 "" +#line 20224 "" for (kv = 1; kv <= i__3; ++kv) { -#line 20237 "" +#line 20225 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; -#line 20238 "" +#line 20226 "" ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24 - 25]; -#line 20239 "" +#line 20227 "" i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25] - ioff; -#line 20239 "" +#line 20227 "" for (ip = 1; ip <= i__4; ++ip) { -#line 20240 "" +#line 20228 "" a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 20241 "" +#line 20229 "" a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] = a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 20242 "" +#line 20230 "" c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] = c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 20243 "" +#line 20231 "" /* L12: */ -#line 20243 "" +#line 20231 "" } -#line 20244 "" -/* L11: */ -#line 20244 "" +#line 20232 "" +/* L1199: */ +#line 20232 "" } -#line 20244 "" +#line 20233 "" +/* L11: */ +#line 20233 "" } -#line 20245 "" +#line 20234 "" } -#line 20246 "" - i__3 = a1ll_2.nv; -#line 20246 "" - for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) { -#line 20247 "" - i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; -#line 20247 "" - for (kv = 1; kv <= i__2; ++kv) { -#line 20248 "" +#line 20235 "" + i__2 = a1ll_2.nv; +#line 20235 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { +#line 20236 "" + i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 20236 "" + for (kv = 1; kv <= i__3; ++kv) { +#line 20237 "" ioff = 0; -#line 20249 "" +#line 20238 "" if (a1ll_2.ibar > 1) { -#line 20249 "" +#line 20238 "" ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25] + (a1ll_2.ibar - 1) * 24 - 25]; -#line 20249 "" +#line 20238 "" } -#line 20250 "" -/* L67: */ -#line 20250 "" +#line 20239 "" +/* L6799: */ +#line 20239 "" } -#line 20250 "" +#line 20240 "" +/* L67: */ +#line 20240 "" } -#line 20251 "" +#line 20241 "" makeabar_(); -#line 20252 "" +#line 20242 "" elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar; -#line 20253 "" +#line 20243 "" /* L10: */ -#line 20253 "" +#line 20243 "" } -#line 20254 "" +#line 20244 "" a1ll_2.newmeter = FALSE_; -#line 20255 "" +#line 20245 "" a1ll_2.firstline = FALSE_; -#line 20256 "" +#line 20246 "" goto L30; -#line 20257 "" +#line 20247 "" L20: /* Vertical analysis. */ -#line 20261 "" +#line 20251 "" if (compage_1.npages == 0) { -#line 20262 "" +#line 20252 "" if (compage_1.nsyst == 0) { -#line 20263 "" +#line 20253 "" s_wsle(&io___1253); -#line 20263 "" +#line 20253 "" do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"\ "ot 0", (ftnlen)46); -#line 20263 "" +#line 20253 "" e_wsle(); -#line 20264 "" +#line 20254 "" stop1_(); -#line 20265 "" +#line 20255 "" } -#line 20266 "" +#line 20256 "" compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1; -#line 20267 "" +#line 20257 "" if (a1ll_2.nv == 1) { -#line 20268 "" +#line 20258 "" nsystpp = 12; -#line 20269 "" +#line 20259 "" } else if (a1ll_2.nv == 2) { -#line 20270 "" +#line 20260 "" nsystpp = 7; -#line 20271 "" +#line 20261 "" } else if (a1ll_2.nv == 3) { -#line 20272 "" +#line 20262 "" nsystpp = 5; -#line 20273 "" +#line 20263 "" } else if (a1ll_2.nv == 4) { -#line 20274 "" +#line 20264 "" nsystpp = 3; -#line 20275 "" +#line 20265 "" } else if (a1ll_2.nv <= 7) { -#line 20276 "" +#line 20266 "" nsystpp = 2; -#line 20277 "" +#line 20267 "" } else { -#line 20278 "" +#line 20268 "" nsystpp = 1; -#line 20279 "" +#line 20269 "" } -#line 20280 "" +#line 20270 "" compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1; -#line 20281 "" +#line 20271 "" } /* Check nsyst vs ibarcnt */ -#line 20285 "" +#line 20275 "" if (compage_1.nsyst > c1omnotes_1.ibarcnt) { -#line 20286 "" +#line 20276 "" s_wsle(&io___1255); -#line 20286 "" +#line 20276 "" e_wsle(); -#line 20287 "" +#line 20277 "" s_wsle(&io___1256); -#line 20287 "" +#line 20277 "" do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14); -#line 20287 "" +#line 20277 "" do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer) ); -#line 20287 "" +#line 20277 "" do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof( integer)); -#line 20287 "" +#line 20277 "" e_wsle(); -#line 20288 "" +#line 20278 "" s_wsle(&io___1257); -#line 20288 "" +#line 20278 "" do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33); -#line 20288 "" +#line 20278 "" e_wsle(); -#line 20289 "" +#line 20279 "" s_wsfe(&io___1258); -#line 20289 "" +#line 20279 "" do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15); -#line 20289 "" +#line 20279 "" do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); -#line 20289 "" +#line 20279 "" do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer)); -#line 20289 "" +#line 20279 "" e_wsfe(); -#line 20290 "" +#line 20280 "" s_wsfe(&io___1259); -#line 20290 "" +#line 20280 "" do_fio(&c__1, " There are more systems than bars.", (ftnlen)34); -#line 20290 "" +#line 20280 "" e_wsfe(); -#line 20291 "" +#line 20281 "" stop1_(); -#line 20292 "" +#line 20282 "" } /* Set up dummy forced line & page breaks after last real one */ -#line 20296 "" +#line 20286 "" ++compage_1.nflb; -#line 20297 "" +#line 20287 "" compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1; -#line 20298 "" +#line 20288 "" compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1; -#line 20299 "" +#line 20289 "" ++compage_1.nfpb; -#line 20300 "" +#line 20290 "" compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1; -#line 20301 "" +#line 20291 "" compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1; -#line 20302 "" +#line 20292 "" heightil = compage_1.ptheight * 4.f / commus_1.musize; -#line 20303 "" +#line 20293 "" o__1.oerr = 0; -#line 20303 "" +#line 20293 "" o__1.ounit = 12; -#line 20303 "" +#line 20293 "" o__1.ofnm = 0; -#line 20303 "" +#line 20293 "" o__1.orl = 0; -#line 20303 "" +#line 20293 "" o__1.osta = "SCRATCH"; -#line 20303 "" +#line 20293 "" o__1.oacc = 0; -#line 20303 "" +#line 20293 "" o__1.ofm = 0; -#line 20303 "" +#line 20293 "" o__1.oblnk = 0; -#line 20303 "" +#line 20293 "" f_open(&o__1); -#line 20304 "" +#line 20294 "" s_wsfe(&io___1261); -#line 20304 "" +#line 20294 "" do_fio(&c__1, basenameq, (*lbase)); -#line 20304 "" +#line 20294 "" e_wsfe(); -#line 20305 "" +#line 20295 "" s_wsle(&io___1262); -#line 20305 "" +#line 20295 "" do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer)); -#line 20305 "" +#line 20295 "" e_wsle(); /* Pass to pmxb the initial signature, including effect of transposition. */ -#line 20309 "" +#line 20299 "" s_wsfe(&io___1263); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer)); -#line 20309 "" +#line 20299 "" do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer)); -#line 20309 "" +#line 20299 "" e_wsfe(); -#line 20311 "" +#line 20301 "" s_wsle(&io___1264); -#line 20311 "" +#line 20301 "" do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer)); -#line 20311 "" +#line 20301 "" do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real)); -#line 20311 "" +#line 20301 "" do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real)); -#line 20311 "" +#line 20301 "" do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real)); -#line 20311 "" +#line 20301 "" do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real)); -#line 20311 "" +#line 20301 "" do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); -#line 20311 "" +#line 20301 "" e_wsle(); -#line 20312 "" +#line 20302 "" iflbnow = -1; -#line 20313 "" +#line 20303 "" isysb4 = 0; -#line 20314 "" +#line 20304 "" i__1 = compage_1.nfpb; -#line 20314 "" +#line 20304 "" for (ifpb = 1; ifpb <= i__1; ++ifpb) { /* Each time thru this loop is like a single score with several pages */ -#line 20318 "" +#line 20308 "" compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb - 1]; -#line 20319 "" +#line 20309 "" compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb - 1]; -#line 20320 "" +#line 20310 "" nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1; -#line 20321 "" +#line 20311 "" nshort = nomnsystp * compage_1.npages - compage_1.nsyst; -#line 20322 "" +#line 20312 "" i__2 = compage_1.npages; -#line 20322 "" +#line 20312 "" for (ipage = 1; ipage <= i__2; ++ipage) { -#line 20323 "" +#line 20313 "" nsystp = nomnsystp; -#line 20324 "" +#line 20314 "" if (ipage <= nshort) { -#line 20324 "" +#line 20314 "" --nsystp; -#line 20324 "" +#line 20314 "" } /* Last system number on this page: */ -#line 20327 "" +#line 20317 "" isysendpg = isysb4 + nsystp; -#line 20328 "" +#line 20318 "" nintpg = 0; -#line 20329 "" +#line 20319 "" i__3 = isysendpg; -#line 20329 "" +#line 20319 "" for (isy = isysb4 + 1; isy <= i__3; ++isy) { -#line 20330 "" +#line 20320 "" if (compage_1.isysflb[iflbnow + 1] == isy) { -#line 20330 "" +#line 20320 "" ++iflbnow; -#line 20330 "" +#line 20320 "" } -#line 20331 "" +#line 20321 "" nintpg += compage_1.nistaff[iflbnow]; -#line 20332 "" +#line 20322 "" /* L15: */ -#line 20332 "" +#line 20322 "" } -#line 20333 "" +#line 20323 "" xilfrac = 0.f; -#line 20334 "" +#line 20324 "" xiltxt = 0.f; -#line 20335 "" +#line 20325 "" if (ipage == 1 && c1omget_1.ihead > 0) { /* Needn't zero out ihead after printing titles if we only allow titles at top? */ -#line 20339 "" +#line 20329 "" if ((c1omget_1.ihead & 1) == 1) { -#line 20340 "" +#line 20330 "" xiltxt += cblock_1.hgtin * 4 / commus_1.musize; -#line 20341 "" +#line 20331 "" xilfrac += cblock_1.etait; -#line 20342 "" +#line 20332 "" } -#line 20343 "" +#line 20333 "" if ((c1omget_1.ihead & 2) == 2) { -#line 20344 "" +#line 20334 "" xiltxt += cblock_1.hgtti * 4 / commus_1.musize; -#line 20345 "" +#line 20335 "" xilfrac += cblock_1.etatc; -#line 20346 "" +#line 20336 "" } -#line 20347 "" +#line 20337 "" if ((c1omget_1.ihead & 4) == 4) { -#line 20348 "" +#line 20338 "" xiltxt += cblock_1.hgtco * 4 / commus_1.musize; -#line 20349 "" +#line 20339 "" xilfrac += cblock_1.etacs1; -#line 20350 "" +#line 20340 "" } else { /* Use double the title-composer space if there is no composer */ -#line 20354 "" +#line 20344 "" xilfrac += cblock_1.etatc; -#line 20355 "" +#line 20345 "" } -#line 20356 "" +#line 20346 "" } -#line 20357 "" +#line 20347 "" d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot; /* C = nsystp*(nv-1) */ -#line 20359 "" +#line 20349 "" c__ = (real) nintpg; /* xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */ -#line 20361 "" +#line 20351 "" xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) * cblock_1.xilbn; -#line 20362 "" +#line 20352 "" if (bottreb) { -#line 20362 "" +#line 20352 "" xn -= (nsystp - 1) * cblock_1.xilbtc; -#line 20362 "" +#line 20352 "" } -#line 20363 "" +#line 20353 "" if (c1omget_1.ihead == 0 && c1omget_1.isheadr) { -#line 20363 "" +#line 20353 "" xn -= cblock_1.xilhdr; -#line 20363 "" +#line 20353 "" } -#line 20364 "" +#line 20354 "" if (ifig == 1) { -#line 20365 "" +#line 20355 "" xn -= nsystp * cblock_1.xilfig; -#line 20366 "" +#line 20356 "" } -#line 20367 "" +#line 20357 "" glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__); -#line 20368 "" +#line 20358 "" omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a * c__); @@ -48831,573 +49102,573 @@ L20: /* Only the first page will get local adjustment now if needed, others in pmxb */ -#line 20395 "" +#line 20385 "" if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) { -#line 20396 "" +#line 20386 "" facins = compage_1.fintstf; -#line 20397 "" +#line 20387 "" compage_1.fintstf = -1.f; -#line 20398 "" +#line 20388 "" } else { /* gintstf = 1.0 by default, but may be changed with AI */ -#line 20402 "" +#line 20392 "" facins = compage_1.gintstf; -#line 20403 "" +#line 20393 "" } -#line 20404 "" +#line 20394 "" s_wsle(&io___1283); -#line 20404 "" +#line 20394 "" do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer)); /* Computing MAX */ -#line 20404 "" +#line 20394 "" r__2 = 0.f, r__3 = cblock_1.etatop * glueil; -#line 20404 "" +#line 20394 "" r__1 = dmax(r__2,r__3); -#line 20404 "" +#line 20394 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 20404 "" +#line 20394 "" r__4 = facins * (omegag + 4); -#line 20404 "" +#line 20394 "" do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real)); -#line 20404 "" +#line 20394 "" e_wsle(); -#line 20405 "" +#line 20395 "" c1omget_1.ihead = 0; -#line 20406 "" +#line 20396 "" c1omget_1.isheadr = FALSE_; -#line 20407 "" +#line 20397 "" isysb4 = isysendpg; -#line 20408 "" +#line 20398 "" /* L7: */ -#line 20408 "" +#line 20398 "" } -#line 20409 "" +#line 20399 "" /* L8: */ -#line 20409 "" +#line 20399 "" } /* Done with vertical, now do horizontals */ -#line 20413 "" +#line 20403 "" celsk[1] = elsk[0]; -#line 20414 "" +#line 20404 "" i__1 = c1omnotes_1.ibarcnt; -#line 20414 "" +#line 20404 "" for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { -#line 20415 "" +#line 20405 "" celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1]; -#line 20416 "" +#line 20406 "" /* L21: */ -#line 20416 "" +#line 20406 "" } -#line 20417 "" +#line 20407 "" lastbar[0] = 0; -#line 20418 "" +#line 20408 "" ibar1 = 1; -#line 20419 "" +#line 20409 "" wmins = -1.f; -#line 20420 "" +#line 20410 "" iflb = 1; -#line 20421 "" +#line 20411 "" imovbrk = 0; -#line 20422 "" +#line 20412 "" ikey = 1; /* Return nsyst to its *total* value */ -#line 20426 "" +#line 20416 "" compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1; -#line 20427 "" +#line 20417 "" i__1 = compage_1.nsyst; -#line 20427 "" +#line 20417 "" for (isyst = 1; isyst <= i__1; ++isyst) { -#line 20428 "" +#line 20418 "" if (isyst == compage_1.isysflb[iflb]) { -#line 20428 "" +#line 20418 "" ++iflb; -#line 20428 "" +#line 20418 "" } -#line 20429 "" +#line 20419 "" if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) { -#line 20430 "" +#line 20420 "" if (isyst == compage_1.isysmb[imovbrk + 1]) { -#line 20430 "" +#line 20420 "" ++imovbrk; -#line 20430 "" +#line 20420 "" } -#line 20431 "" +#line 20421 "" } -#line 20432 "" +#line 20422 "" ibarb4 = lastbar[isyst - 1]; -#line 20433 "" +#line 20423 "" if (isyst == 1) { -#line 20434 "" +#line 20424 "" if (*isfirst) { -#line 20434 "" +#line 20424 "" elsstarg = celsk[compage_1.ibarflb[1] - 1] / ( compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1 - c1omget_1.fracindent); -#line 20434 "" +#line 20424 "" } -#line 20436 "" +#line 20426 "" celskb4 = 0.f; -#line 20437 "" +#line 20427 "" } else { -#line 20438 "" +#line 20428 "" celskb4 = celsk[ibarb4]; /* Must dimension isysmb(0:*) just so I can execute this test! */ -#line 20442 "" +#line 20432 "" if (*isfirst) { -#line 20443 "" +#line 20433 "" if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[ imovbrk]) { /* First syst after forced line break. There may be indentation. */ -#line 20447 "" +#line 20437 "" elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4) / (compage_1.isysflb[iflb] - isyst - compage_1.fracsys[imovbrk - 1]) * (1 - compage_1.fracsys[imovbrk - 1]); -#line 20450 "" +#line 20440 "" } else { /* There is no indentation to deal with */ -#line 20454 "" +#line 20444 "" elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4) / (compage_1.isysflb[iflb] - isyst); -#line 20456 "" +#line 20446 "" } -#line 20457 "" +#line 20447 "" } -#line 20458 "" +#line 20448 "" } -#line 20459 "" +#line 20449 "" if (*isfirst) { -#line 20460 "" +#line 20450 "" diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1)); -#line 20461 "" +#line 20451 "" i__2 = c1omnotes_1.ibarcnt; -#line 20461 "" +#line 20451 "" for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) { -#line 20462 "" +#line 20452 "" diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4); -#line 20463 "" +#line 20453 "" if (dabs(diff) >= diff1) { -#line 20463 "" +#line 20453 "" goto L24; -#line 20463 "" +#line 20453 "" } -#line 20464 "" +#line 20454 "" diff1 = dabs(diff); -#line 20465 "" +#line 20455 "" /* L23: */ -#line 20465 "" +#line 20455 "" } -#line 20466 "" +#line 20456 "" L24: -#line 20466 "" +#line 20456 "" --a1ll_2.ibar; -#line 20467 "" +#line 20457 "" lastbar[isyst] = a1ll_2.ibar; -#line 20468 "" +#line 20458 "" nbarss[isyst] = a1ll_2.ibar - ibarb4; -#line 20469 "" +#line 20459 "" } else { /* nbarss is given as an input, must compute lastbar and ibar */ -#line 20473 "" +#line 20463 "" lastbar[isyst] = nbarss[isyst] + ibarb4; -#line 20474 "" +#line 20464 "" a1ll_2.ibar = lastbar[isyst]; -#line 20475 "" +#line 20465 "" } /* elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */ -#line 20479 "" +#line 20469 "" elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4; -#line 20480 "" +#line 20470 "" s_wsfe(&io___1298); -#line 20480 "" +#line 20470 "" i__2 = lastbar[isyst - 1] + 1; -#line 20480 "" +#line 20470 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 20480 "" +#line 20470 "" e_wsfe(); /* Transposed sigs are isig1, newkey(2,3,...). */ -#line 20484 "" +#line 20474 "" if (ikey == 1) { -#line 20485 "" +#line 20475 "" key1 = comkeys_1.isig1; -#line 20486 "" +#line 20476 "" } else { -#line 20487 "" +#line 20477 "" key1 = comkeys_1.newkey[ikey - 1]; -#line 20488 "" +#line 20478 "" } -#line 20489 "" +#line 20479 "" fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize; -#line 20490 "" +#line 20480 "" xelsk = 0.f; -#line 20491 "" +#line 20481 "" L1: -#line 20491 "" +#line 20481 "" if (ikey < comkeys_1.nkeys) { -#line 20492 "" +#line 20482 "" if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) { /* Add space for all key changes */ -#line 20496 "" +#line 20486 "" ++ikey; -#line 20497 "" +#line 20487 "" key2 = comkeys_1.newkey[ikey - 1]; /* Computing MAX */ /* Computing MAX */ -#line 20498 "" +#line 20488 "" i__5 = abs(key1), i__6 = abs(key2); -#line 20498 "" +#line 20488 "" i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6); -#line 20498 "" +#line 20488 "" naccs = max(i__3,i__4); -#line 20499 "" +#line 20489 "" fsyst += naccs * wkeysig; /* Account for afterruleskips (fbar) */ -#line 20503 "" +#line 20493 "" xelsk += c1ommvl_1.fbar / 2; -#line 20504 "" +#line 20494 "" if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && ! comkeys_1.kchmid[ikey - 1]) { -#line 20504 "" +#line 20494 "" xelsk += -1.f; -#line 20504 "" +#line 20494 "" } -#line 20506 "" +#line 20496 "" key1 = key2; -#line 20507 "" +#line 20497 "" goto L1; -#line 20508 "" +#line 20498 "" } -#line 20509 "" +#line 20499 "" } /* Add extra fixed space for double bar */ -#line 20513 "" +#line 20503 "" if (isyst == compage_1.nsyst) { -#line 20514 "" +#line 20504 "" fsyst += 4.5f / commus_1.musize; -#line 20515 "" +#line 20505 "" } /* Add extra fixed space for initial time signature */ -#line 20519 "" +#line 20509 "" if (isyst == 1) { -#line 20520 "" +#line 20510 "" fsyst += wtimesig; -#line 20521 "" +#line 20511 "" } /* Add extra fixed space for time signature changes & user-defined spaces */ -#line 20525 "" +#line 20515 "" i__2 = lastbar[isyst]; -#line 20525 "" +#line 20515 "" for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) { -#line 20526 "" +#line 20516 "" if (newmb[ibars - 1]) { -#line 20526 "" +#line 20516 "" fsyst += wtimesig; -#line 20526 "" +#line 20516 "" } -#line 20527 "" +#line 20517 "" fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize; -#line 20528 "" +#line 20518 "" /* L26: */ -#line 20528 "" +#line 20518 "" } -#line 20529 "" +#line 20519 "" if (isyst == 1) { -#line 20530 "" +#line 20520 "" wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent); -#line 20531 "" +#line 20521 "" } else { -#line 20532 "" +#line 20522 "" if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == compage_1.isysmb[imovbrk]) { -#line 20534 "" +#line 20524 "" wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1] ); -#line 20535 "" +#line 20525 "" } else { -#line 20536 "" +#line 20526 "" wdpt = compage_1.widthpt; -#line 20537 "" +#line 20527 "" } -#line 20538 "" +#line 20528 "" } -#line 20539 "" +#line 20529 "" wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f; /* Checks for min spacing */ /* Get min allowable space */ -#line 20544 "" +#line 20534 "" dtmin = 1e3f; -#line 20545 "" +#line 20535 "" i__2 = ibar1 + nbarss[isyst] - 1; -#line 20545 "" +#line 20535 "" for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) { /* Computing MIN */ -#line 20546 "" +#line 20536 "" r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1]; -#line 20546 "" +#line 20536 "" dtmin = dmin(r__1,r__2); -#line 20547 "" +#line 20537 "" if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) { -#line 20547 "" +#line 20537 "" wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1]; -#line 20547 "" +#line 20537 "" } -#line 20548 "" +#line 20538 "" /* L45: */ -#line 20548 "" +#line 20538 "" } -#line 20549 "" +#line 20539 "" if (wmins < 0.f) { -#line 20549 "" +#line 20539 "" wmins = .3f; -#line 20549 "" +#line 20539 "" } -#line 20550 "" +#line 20540 "" wminpt = (wmins + 1) * .3f * commus_1.musize; /* Find max duration & # of notes for this system */ -#line 20554 "" +#line 20544 "" dtmax = 0.f; -#line 20555 "" +#line 20545 "" nns = 0; -#line 20556 "" +#line 20546 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; -#line 20556 "" +#line 20546 "" for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { /* Computing MAX */ -#line 20557 "" +#line 20547 "" r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1]; -#line 20557 "" +#line 20547 "" dtmax = dmax(r__1,r__2); -#line 20558 "" +#line 20548 "" nns += c1omnotes_1.nnpd[iptr - 1]; -#line 20559 "" +#line 20549 "" /* L43: */ -#line 20559 "" +#line 20549 "" } -#line 20560 "" +#line 20550 "" elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk); -#line 20561 "" +#line 20551 "" if (elmin0 >= wminpt) { /* Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */ /* there is no need to "flatten" */ -#line 20566 "" +#line 20556 "" sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst]; -#line 20567 "" +#line 20557 "" comeon_1.eonk = 0.f; -#line 20568 "" +#line 20558 "" comeon_1.ewmxk = 1.f; -#line 20569 "" +#line 20559 "" } else { -#line 20570 "" +#line 20560 "" elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) / f1eon_(&dtmax) + nns); -#line 20571 "" +#line 20561 "" if (elmin1 <= wminpt) { /* print* */ /* print*,'In system #',isyst,' cannot meet min. space rqmt' */ /* write(15,'(/a,i5,a)') */ /* * 'In system #',isyst,' cannot meet min. space rqmt' */ -#line 20576 "" +#line 20566 "" comeon_1.eonk = .9f; -#line 20577 "" +#line 20567 "" } else { /* Find eonk by Newton method */ -#line 20581 "" +#line 20571 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; -#line 20581 "" +#line 20571 "" r__1 = wsyspt / wminpt; -#line 20581 "" +#line 20571 "" r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk; -#line 20581 "" +#line 20571 "" r__3 = (wminpt - elmin0) / (elmin1 - elmin0); -#line 20581 "" +#line 20571 "" findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, & dtmin, &dtmax, &r__3); -#line 20584 "" +#line 20574 "" comeon_1.eonk = dmin(.9f,comeon_1.eonk); -#line 20585 "" +#line 20575 "" } -#line 20586 "" +#line 20576 "" d__1 = (doublereal) f1eon_(&dtmax); -#line 20586 "" +#line 20576 "" d__2 = (doublereal) comeon_1.eonk; -#line 20586 "" +#line 20576 "" comeon_1.ewmxk = pow_dd(&d__1, &d__2); /* Recompute poenom! */ -#line 20590 "" +#line 20580 "" sumelsk = 0.f; -#line 20591 "" +#line 20581 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; -#line 20591 "" +#line 20581 "" for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { -#line 20592 "" +#line 20582 "" r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1] ; -#line 20592 "" +#line 20582 "" sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * feon_(&r__1); -#line 20594 "" +#line 20584 "" /* L44: */ -#line 20594 "" +#line 20584 "" } -#line 20595 "" +#line 20585 "" } -#line 20596 "" +#line 20586 "" poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk); /* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */ -#line 20600 "" +#line 20590 "" if (isyst > 0) { -#line 20601 "" +#line 20591 "" if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == compage_1.isysmb[imovbrk]) { -#line 20603 "" +#line 20593 "" c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1]; -#line 20604 "" +#line 20594 "" } else { -#line 20605 "" +#line 20595 "" c1omget_1.fracindent = 0.f; -#line 20606 "" +#line 20596 "" } -#line 20607 "" +#line 20597 "" } -#line 20608 "" +#line 20598 "" s_wsfe(&io___1316); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)); -#line 20608 "" +#line 20598 "" e_wsfe(); -#line 20610 "" +#line 20600 "" ibar1 += nbarss[isyst]; -#line 20611 "" +#line 20601 "" /* L22: */ -#line 20611 "" +#line 20601 "" } -#line 20612 "" +#line 20602 "" al__1.aerr = 0; -#line 20612 "" +#line 20602 "" al__1.aunit = 12; -#line 20612 "" +#line 20602 "" f_rew(&al__1); -#line 20613 "" +#line 20603 "" o__1.oerr = 0; -#line 20613 "" +#line 20603 "" o__1.ounit = 13; -#line 20613 "" +#line 20603 "" o__1.ofnm = 0; -#line 20613 "" +#line 20603 "" o__1.orl = 0; -#line 20613 "" +#line 20603 "" o__1.osta = "SCRATCH"; -#line 20613 "" +#line 20603 "" o__1.oacc = 0; -#line 20613 "" +#line 20603 "" o__1.ofm = 0; -#line 20613 "" +#line 20603 "" o__1.oblnk = 0; -#line 20613 "" +#line 20603 "" f_open(&o__1); -#line 20614 "" +#line 20604 "" s_wsfe(&io___1317); -#line 20614 "" +#line 20604 "" do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer)); -#line 20614 "" +#line 20604 "" e_wsfe(); -#line 20615 "" +#line 20605 "" al__1.aerr = 0; -#line 20615 "" +#line 20605 "" al__1.aunit = 13; -#line 20615 "" +#line 20605 "" f_rew(&al__1); -#line 20616 "" +#line 20606 "" inbuff_1.ilbuf = 1; -#line 20617 "" +#line 20607 "" inbuff_1.ipbuf = 0; -#line 20618 "" +#line 20608 "" if (! (*optimize)) { -#line 20619 "" +#line 20609 "" s_wsfe(&io___1318); -#line 20619 "" +#line 20609 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); -#line 20619 "" +#line 20609 "" e_wsfe(); -#line 20620 "" +#line 20610 "" s_wsle(&io___1319); -#line 20620 "" +#line 20610 "" e_wsle(); -#line 20621 "" +#line 20611 "" s_wsfe(&io___1320); -#line 20621 "" +#line 20611 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); -#line 20621 "" +#line 20611 "" e_wsfe(); -#line 20622 "" +#line 20612 "" s_wsfe(&io___1321); -#line 20622 "" +#line 20612 "" e_wsfe(); -#line 20623 "" +#line 20613 "" } /* Following syntax is needed since pmxa is called with literal argument .false. */ -#line 20627 "" +#line 20617 "" if (*isfirst) { -#line 20627 "" +#line 20617 "" *isfirst = FALSE_; -#line 20627 "" +#line 20617 "" } -#line 20628 "" +#line 20618 "" return 0; } /* pmxa_ */ @@ -50033,124 +50304,124 @@ L1: /* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ /* ccccccccccccccccccccccccccccccc */ -#line 21094 "" +#line 21084 "" /* Parameter adjustments */ -#line 21094 "" +#line 21084 "" --poevec; -#line 21094 "" +#line 21084 "" -#line 21094 "" +#line 21084 "" /* Function Body */ -#line 21094 "" +#line 21084 "" combottop_1.bottopgap = FALSE_; -#line 21095 "" +#line 21085 "" comlyr_1.inputmlyr = FALSE_; -#line 21096 "" +#line 21086 "" comhair_2.idhairuse = 0; -#line 21097 "" +#line 21087 "" if (! (*optimize)) { -#line 21098 "" +#line 21088 "" s_wsle(&io___1322); -#line 21098 "" +#line 21088 "" e_wsle(); -#line 21099 "" +#line 21089 "" s_wsle(&io___1323); -#line 21099 "" +#line 21089 "" do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24); -#line 21099 "" +#line 21089 "" e_wsle(); -#line 21100 "" +#line 21090 "" s_wsle(&io___1324); -#line 21100 "" +#line 21090 "" e_wsle(); -#line 21101 "" +#line 21091 "" s_wsfe(&io___1325); -#line 21101 "" +#line 21091 "" do_fio(&c__1, "Starting second PMX pass", (ftnlen)24); -#line 21101 "" +#line 21091 "" e_wsfe(); -#line 21102 "" +#line 21092 "" } -#line 21103 "" +#line 21093 "" newclef = FALSE_; -#line 21104 "" +#line 21094 "" comclefrests_1.centrests = FALSE_; -#line 21105 "" +#line 21095 "" ++(*ncalls); -#line 21106 "" +#line 21096 "" comlast_1.islast = *inlast; -#line 21107 "" +#line 21097 "" commac_1.macuse = 0; -#line 21108 "" +#line 21098 "" isyscnt = 0; -#line 21109 "" +#line 21099 "" all_1.stemmax = 8.2f; -#line 21110 "" +#line 21100 "" all_1.stemmin = 3.9f; -#line 21111 "" +#line 21101 "" all_1.stemlen = 6.f; -#line 21112 "" +#line 21102 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 21112 "" +#line 21102 "" *(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0]; -#line 21113 "" +#line 21103 "" comignorenats_1.ignorenats = FALSE_; -#line 21114 "" +#line 21104 "" comignorenats_1.newmbrhgt = FALSE_; -#line 21115 "" +#line 21105 "" combc_1.bcspec = TRUE_; -#line 21116 "" +#line 21106 "" comas3_1.topmods = FALSE_; -#line 21117 "" +#line 21107 "" ismbr = FALSE_; -#line 21118 "" +#line 21108 "" s_rsfe(&io___1329); -#line 21118 "" +#line 21108 "" do_fio(&c__1, basenameq, (ftnlen)44); -#line 21118 "" +#line 21108 "" e_rsfe(); -#line 21119 "" +#line 21109 "" s_rsle(&io___1331); -#line 21119 "" +#line 21109 "" do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer)); -#line 21119 "" +#line 21109 "" e_rsle(); -#line 21120 "" +#line 21110 "" s_rsle(&io___1333); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real)); -#line 21120 "" +#line 21110 "" do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)) ; -#line 21120 "" +#line 21110 "" do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer)); -#line 21120 "" +#line 21110 "" do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); -#line 21120 "" +#line 21110 "" e_rsle(); -#line 21122 "" +#line 21112 "" inbuff_1.ilbuf = 1; -#line 21123 "" +#line 21113 "" inbuff_1.ipbuf = 0; -#line 21124 "" +#line 21114 "" getset_(&all_1.nv, &noinst, &all_1.mtrnuml, &all_1.mtrdenl, &all_1.mtrnmp, &all_1.mtrdnp, &xmtrnum0, &npages, &nsyst, &all_1.musicsize, & comtop_1.fracindent, &istype0, comtop_1.inameq, comclefq_1.clefq, all_1.sepsymq, pathnameq, &lpath, &comtop_1.isig0, (ftnlen)79, ( ftnlen)1, (ftnlen)1, (ftnlen)40); -#line 21127 "" +#line 21117 "" if (commidi_1.ismidi) { /* Initial key signature and meter for pickup bar */ @@ -50163,199 +50434,199 @@ L1: /* Above is probably cosmetic */ /* call midievent('k',midisig,0) */ -#line 21139 "" +#line 21129 "" if (xmtrnum0 > comtol_1.tol) { /* We have a pickup. Some tricky stuff to get a meter: */ -#line 21143 "" +#line 21133 "" xntrial = xmtrnum0; -#line 21144 "" +#line 21134 "" for (ip2 = 0; ip2 <= 5; ++ip2) { -#line 21145 "" +#line 21135 "" if ((r__1 = r_mod(&xntrial, &c_b1053), dabs(r__1)) < comtol_1.tol) { -#line 21145 "" +#line 21135 "" goto L6; -#line 21145 "" +#line 21135 "" } -#line 21146 "" +#line 21136 "" xntrial *= 2; -#line 21147 "" +#line 21137 "" /* L5: */ -#line 21147 "" +#line 21137 "" } -#line 21148 "" +#line 21138 "" s_wsle(&io___1349); -#line 21148 "" +#line 21138 "" do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", ( ftnlen)36); -#line 21148 "" +#line 21138 "" e_wsle(); -#line 21149 "" +#line 21139 "" xntrial = 1.f; -#line 21150 "" +#line 21140 "" ip2 = 0; -#line 21151 "" +#line 21141 "" L6: -#line 21152 "" +#line 21142 "" i__1 = i_nint(&xntrial); -#line 21152 "" +#line 21142 "" i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl; -#line 21152 "" +#line 21142 "" midievent_("m", &i__1, &i__2, (ftnlen)1); -#line 21153 "" +#line 21143 "" } else { /* No pickup, enter the starting meter */ -#line 21157 "" +#line 21147 "" midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); -#line 21158 "" +#line 21148 "" } -#line 21159 "" +#line 21149 "" } /* Set musicsize from value passed in common, due to possible reset by S[n]m16 */ -#line 21163 "" +#line 21153 "" all_1.musicsize = commus_1.musize; -#line 21164 "" +#line 21154 "" s_rsle(&io___1350); -#line 21164 "" +#line 21154 "" do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real)); -#line 21164 "" +#line 21154 "" do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer)); -#line 21164 "" +#line 21154 "" i__1 = npages; -#line 21164 "" +#line 21154 "" for (ipa = 1; ipa <= i__1; ++ipa) { -#line 21164 "" +#line 21154 "" do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen) sizeof(integer)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real)); -#line 21164 "" +#line 21154 "" do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real) ); -#line 21164 "" +#line 21154 "" } -#line 21164 "" +#line 21154 "" do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer)); -#line 21164 "" +#line 21154 "" e_rsle(); /* If default width ever changes, must adjust this stmt. */ -#line 21169 "" +#line 21159 "" slfac1 = 2.98156f / comtop_1.widthpt; -#line 21170 "" +#line 21160 "" all_1.figbass = FALSE_; -#line 21171 "" +#line 21161 "" s_rsle(&io___1356); -#line 21171 "" +#line 21161 "" do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer)); -#line 21171 "" +#line 21161 "" e_rsle(); -#line 21172 "" +#line 21162 "" if (ifig == 1) { -#line 21173 "" +#line 21163 "" all_1.figbass = TRUE_; -#line 21174 "" +#line 21164 "" o__1.oerr = 0; -#line 21174 "" +#line 21164 "" o__1.ounit = 14; -#line 21174 "" +#line 21164 "" o__1.ofnm = 0; -#line 21174 "" +#line 21164 "" o__1.orl = 0; -#line 21174 "" +#line 21164 "" o__1.osta = "SCRATCH"; -#line 21174 "" +#line 21164 "" o__1.oacc = 0; -#line 21174 "" +#line 21164 "" o__1.ofm = 0; -#line 21174 "" +#line 21164 "" o__1.oblnk = 0; -#line 21174 "" +#line 21164 "" f_open(&o__1); -#line 21175 "" +#line 21165 "" s_wsfe(&io___1358); /* Writing concatenation */ -#line 21175 "" +#line 21165 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[1] = 3, a__1[1] = "def"; -#line 21175 "" +#line 21165 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[3] = 8, a__1[3] = "fixdrop{"; -#line 21175 "" +#line 21165 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[5] = 7, a__1[5] = "advance"; -#line 21175 "" +#line 21165 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[7] = 10, a__1[7] = "sysno by 1"; -#line 21175 "" +#line 21165 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[9] = 6, a__1[9] = "ifcase"; -#line 21175 "" +#line 21165 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 21175 "" +#line 21165 "" i__3[11] = 6, a__1[11] = "sysno%"; -#line 21175 "" +#line 21165 "" s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46); -#line 21175 "" +#line 21165 "" do_fio(&c__1, ch__2, (ftnlen)46); -#line 21175 "" +#line 21165 "" e_wsfe(); -#line 21177 "" +#line 21167 "" } -#line 21178 "" +#line 21168 "" comget_1.lastchar = FALSE_; -#line 21179 "" +#line 21169 "" ibcoff = 0; -#line 21180 "" +#line 21170 "" if (xmtrnum0 > 0.f) { -#line 21180 "" +#line 21170 "" ibcoff = -1; -#line 21180 "" +#line 21170 "" } -#line 21181 "" +#line 21171 "" o__1.oerr = 0; -#line 21181 "" +#line 21171 "" o__1.ounit = 11; -#line 21181 "" +#line 21171 "" o__1.ofnm = 0; -#line 21181 "" +#line 21171 "" o__1.orl = 0; -#line 21181 "" +#line 21171 "" o__1.osta = "SCRATCH"; -#line 21181 "" +#line 21171 "" o__1.oacc = 0; -#line 21181 "" +#line 21171 "" o__1.ofm = 0; -#line 21181 "" +#line 21171 "" o__1.oblnk = 0; -#line 21181 "" +#line 21171 "" f_open(&o__1); /* vshrink for the first page is calculated in topfile, */ /* and if true set interstaff=10. vshrink affects Titles. */ /* Must also save vshrink for page ending. */ -#line 21187 "" +#line 21177 "" topfile_(basenameq, &lbase, &all_1.nv, comclefq_1.clefq, &noinst, & all_1.musicsize, xintstaff, &all_1.mtrnmp, &all_1.mtrdnp, & vshrink, &comask_1.fbar, &comslur_1.fontslur, (ftnlen)44, (ftnlen) @@ -50363,404 +50634,404 @@ L6: /* ninow is working value of # of instruments. noinst is max #, and # at start. */ -#line 21192 "" +#line 21182 "" comnotes_1.ninow = noinst; /* Save original printed meter in case movement breaks */ -#line 21196 "" +#line 21186 "" comget_1.movnmp = all_1.mtrnmp; -#line 21197 "" +#line 21187 "" comget_1.movdnp = all_1.mtrdnp; -#line 21199 "" +#line 21189 "" if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) { -#line 21199 "" +#line 21189 "" s_wsfe(&io___1361); /* Writing concatenation */ -#line 21199 "" +#line 21189 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 21199 "" +#line 21189 "" i__4[1] = 3, a__2[1] = "def"; -#line 21199 "" +#line 21189 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 21199 "" +#line 21189 "" i__4[3] = 8, a__2[3] = "figfont{"; -#line 21199 "" +#line 21189 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 21199 "" +#line 21189 "" i__4[5] = 9, a__2[5] = "eightrm}%"; -#line 21199 "" +#line 21189 "" s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23); -#line 21199 "" +#line 21189 "" do_fio(&c__1, ch__3, (ftnlen)23); -#line 21199 "" +#line 21189 "" e_wsfe(); -#line 21199 "" +#line 21189 "" } -#line 21202 "" +#line 21192 "" if (comlast_1.islast && comligfont_1.isligfont) { -#line 21203 "" +#line 21193 "" if (all_1.musicsize == 16) { -#line 21204 "" +#line 21194 "" s_wsfe(&io___1362); /* Writing concatenation */ -#line 21204 "" +#line 21194 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21204 "" +#line 21194 "" i__5[1] = 4, a__3[1] = "font"; -#line 21204 "" +#line 21194 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21204 "" +#line 21194 "" i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%"; -#line 21204 "" +#line 21194 "" s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26); -#line 21204 "" +#line 21194 "" do_fio(&c__1, ch__4, (ftnlen)26); -#line 21204 "" +#line 21194 "" e_wsfe(); -#line 21205 "" +#line 21195 "" } else { -#line 21206 "" +#line 21196 "" s_wsfe(&io___1363); /* Writing concatenation */ -#line 21206 "" +#line 21196 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21206 "" +#line 21196 "" i__5[1] = 4, a__3[1] = "font"; -#line 21206 "" +#line 21196 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21206 "" +#line 21196 "" i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%"; -#line 21206 "" +#line 21196 "" s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); -#line 21206 "" +#line 21196 "" do_fio(&c__1, ch__5, (ftnlen)27); -#line 21206 "" +#line 21196 "" e_wsfe(); -#line 21207 "" +#line 21197 "" } -#line 21208 "" +#line 21198 "" } -#line 21209 "" +#line 21199 "" lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); -#line 21210 "" +#line 21200 "" if (all_1.mtrdenl == 2) { -#line 21210 "" +#line 21200 "" lenbeat = 16; -#line 21210 "" +#line 21200 "" } -#line 21211 "" +#line 21201 "" all_1.lenb1 = all_1.mtrnuml * lenbeat; -#line 21212 "" +#line 21202 "" if (all_1.mtrdenl == 2) { -#line 21212 "" +#line 21202 "" all_1.lenb1 <<= 1; -#line 21212 "" +#line 21202 "" } -#line 21213 "" +#line 21203 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep); -#line 21214 "" +#line 21204 "" r__1 = xmtrnum0 * lenbeat; -#line 21214 "" +#line 21204 "" all_1.lenb0 = i_nint(&r__1); -#line 21215 "" +#line 21205 "" if (all_1.mtrdenl == 2) { -#line 21215 "" +#line 21205 "" all_1.lenb0 <<= 1; -#line 21215 "" +#line 21205 "" } -#line 21216 "" +#line 21206 "" if (all_1.lenb0 != 0) { -#line 21217 "" +#line 21207 "" if (comlast_1.islast) { -#line 21217 "" +#line 21207 "" s_wsfe(&io___1366); /* Writing concatenation */ -#line 21217 "" +#line 21207 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21217 "" +#line 21207 "" i__5[1] = 7, a__3[1] = "advance"; -#line 21217 "" +#line 21207 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21217 "" +#line 21207 "" i__5[3] = 11, a__3[3] = "barno by -1"; -#line 21217 "" +#line 21207 "" s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20); -#line 21217 "" +#line 21207 "" do_fio(&c__1, ch__6, (ftnlen)20); -#line 21217 "" +#line 21207 "" e_wsfe(); -#line 21217 "" +#line 21207 "" } -#line 21218 "" +#line 21208 "" all_1.lenbar = all_1.lenb0; -#line 21219 "" +#line 21209 "" } else { -#line 21220 "" +#line 21210 "" all_1.lenbar = all_1.lenb1; -#line 21221 "" +#line 21211 "" } /* Initialize full-program variables */ -#line 21225 "" +#line 21215 "" comask_1.fixednew = 0.f; -#line 21226 "" +#line 21216 "" comask_1.scaldold = 0.f; -#line 21227 "" +#line 21217 "" comget_1.fintstf = -1.f; -#line 21228 "" +#line 21218 "" comget_1.gintstf = 1.f; -#line 21229 "" +#line 21219 "" comas2_1.nasksys = 0; -#line 21230 "" +#line 21220 "" combibarcnt_1.ibarcnt = 0; -#line 21231 "" +#line 21221 "" all_1.iline = 0; -#line 21232 "" +#line 21222 "" comget_1.movbrk = 0; -#line 21233 "" +#line 21223 "" isystpg = 0; -#line 21234 "" +#line 21224 "" comnotes_1.ipage = 1; -#line 21235 "" +#line 21225 "" all_1.iccount = 128; -#line 21236 "" +#line 21226 "" comas3_1.iask = 0; -#line 21237 "" +#line 21227 "" nhstot = 0; -#line 21238 "" +#line 21228 "" comnsp_2.nb = 1; -#line 21239 "" +#line 21229 "" if (! (*optimize)) { -#line 21239 "" +#line 21229 "" jprntb = 81; -#line 21239 "" +#line 21229 "" } -#line 21240 "" +#line 21230 "" comtop_1.idsig = 0; -#line 21241 "" +#line 21231 "" iflagbot = 0; /* Next 5 are raise-barno parameters. irzbnd is integer part of default level. */ -#line 21245 "" +#line 21235 "" comsln_1.irzbnd = 3; -#line 21246 "" +#line 21236 "" if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv - 1] == 't') { -#line 21246 "" +#line 21236 "" comsln_1.irzbnd = 4; -#line 21246 "" +#line 21236 "" } -#line 21247 "" +#line 21237 "" comsln_1.is1n1 = 0; -#line 21248 "" +#line 21238 "" comsln_1.isnx = 0; -#line 21249 "" +#line 21239 "" comslur_1.slurcurve = 0.f; -#line 21250 "" +#line 21240 "" comshort_1.ishort = 0; -#line 21251 "" +#line 21241 "" comshort_1.nocodabn = FALSE_; -#line 21252 "" +#line 21242 "" comshort_1.mbrsum = 0; -#line 21253 "" +#line 21243 "" comshort_1.nmbr = 0; /* 111109 Made global rather than per gulp */ -#line 21257 "" +#line 21247 "" comdyn_1.ndyn = 0; -#line 21258 "" +#line 21248 "" compoi_1.ispoi = FALSE_; -#line 21259 "" +#line 21249 "" slint = FALSE_; -#line 21260 "" +#line 21250 "" lrptpend = FALSE_; -#line 21261 "" +#line 21251 "" comget_1.rptnd1 = FALSE_; -#line 21262 "" +#line 21252 "" *(unsigned char *)comget_1.rptfq2 = 'E'; -#line 21263 "" +#line 21253 "" comget_1.rptprev = FALSE_; -#line 21264 "" +#line 21254 "" onvolt = FALSE_; -#line 21265 "" +#line 21255 "" comnsp_2.flgndb = FALSE_; -#line 21266 "" +#line 21256 "" comget_1.fbon = FALSE_; -#line 21267 "" +#line 21257 "" comnotes_1.shifton = FALSE_; -#line 21268 "" +#line 21258 "" comget_1.ornrpt = FALSE_; -#line 21269 "" +#line 21259 "" comnotes_1.setis = FALSE_; -#line 21270 "" +#line 21260 "" comarp_1.lowdot = FALSE_; -#line 21271 "" +#line 21261 "" comnvi_1.rename = FALSE_; -#line 21272 "" +#line 21262 "" comnotes_1.nobar1 = FALSE_; -#line 21273 "" +#line 21263 "" comget_1.equalize = FALSE_; -#line 21274 "" +#line 21264 "" comlast_1.usevshrink = TRUE_; -#line 21275 "" +#line 21265 "" comslur_1.wrotepsslurdefaults = FALSE_; -#line 21276 "" +#line 21266 "" comnotes_1.optlinebreakties = FALSE_; -#line 21277 "" +#line 21267 "" comnotes_1.headerspecial = FALSE_; /* vshrink is initialized in topfile */ -#line 21281 "" +#line 21271 "" comget_1.stickys = FALSE_; /* ixrest = 1 or 2 if xtup has started with a rest */ -#line 21285 "" +#line 21275 "" for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) { -#line 21286 "" +#line 21276 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; -#line 21287 "" +#line 21277 "" comfig_1.fullsize[commvl_1.ivx - 1] = 1.f; /* Set legacy note level to middle c as default */ -#line 21291 "" +#line 21281 "" comnotes_1.ndlev[commvl_1.ivx - 1] = 29; -#line 21292 "" +#line 21282 "" comnotes_1.ndlev[commvl_1.ivx + 23] = 29; -#line 21293 "" +#line 21283 "" /* L1: */ -#line 21293 "" +#line 21283 "" } -#line 21294 "" +#line 21284 "" comnotes_1.npreslur = 0; -#line 21295 "" +#line 21285 "" nhssys = 0; -#line 21296 "" +#line 21286 "" comslur_1.listslur = 0; -#line 21297 "" +#line 21287 "" for (i__ = 1; i__ <= 202; ++i__) { -#line 21298 "" +#line 21288 "" all_1.isdat1[i__ - 1] = 0; -#line 21299 "" +#line 21289 "" all_1.isdat2[i__ - 1] = 0; -#line 21300 "" +#line 21290 "" /* L31: */ -#line 21300 "" +#line 21290 "" } -#line 21301 "" +#line 21291 "" all_1.nsdat = 0; /* Initialize flag for figures in any other voice than 1 */ -#line 21305 "" +#line 21295 "" comfig_1.ivxfig2 = 0; /* Initialize for loop over gulps */ -#line 21309 "" +#line 21299 "" all_1.firstgulp = TRUE_; /* Start a gulp */ -#line 21313 "" +#line 21303 "" L30: -#line 21313 "" +#line 21303 "" loop = TRUE_; -#line 21314 "" +#line 21304 "" comnotes_1.notcrd = TRUE_; -#line 21315 "" +#line 21305 "" combjmp_1.isbjmp = FALSE_; -#line 21316 "" +#line 21306 "" combjmp_1.isbj2 = FALSE_; -#line 21317 "" +#line 21307 "" comfb_1.autofbon = FALSE_; -#line 21318 "" +#line 21308 "" comfb_1.tautofb = 0.f; -#line 21319 "" +#line 21309 "" all_1.nbars = 0; -#line 21320 "" +#line 21310 "" comfig_1.nfigs[0] = 0; -#line 21321 "" +#line 21311 "" comfig_1.nfigs[1] = 0; -#line 21322 "" +#line 21312 "" comgrace_1.ngrace = 0; -#line 21323 "" +#line 21313 "" comtrill_1.ntrill = 0; -#line 21324 "" +#line 21314 "" comtrill_1.ncrd = 0; -#line 21325 "" +#line 21315 "" comtrill_1.nudorn = 0; -#line 21326 "" +#line 21316 "" comgrace_1.nlit = 0; -#line 21327 "" +#line 21317 "" comgrace_1.nvolt = 0; -#line 21328 "" +#line 21318 "" comgrace_1.ibarmbr = 0; -#line 21329 "" +#line 21319 "" comudsp_1.nudsp = 0; /* ndyn = 0 ! 111109 */ -#line 21331 "" +#line 21321 "" comdyn_1.ntxtdyn = 0; -#line 21332 "" +#line 21322 "" comcb_1.nbc = 0; -#line 21333 "" +#line 21323 "" comarpshift_1.numarpshift = 0; -#line 21334 "" +#line 21324 "" for (i__ = 1; i__ <= 37; ++i__) { -#line 21335 "" +#line 21325 "" comgrace_1.graspace[i__ - 1] = 0.f; -#line 21336 "" +#line 21326 "" /* L3: */ -#line 21336 "" +#line 21326 "" } /* Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst. */ /* and also if nv increases in an 'M' directive. */ -#line 21341 "" +#line 21331 "" i__1 = all_1.nv; -#line 21341 "" +#line 21331 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 21342 "" +#line 21332 "" newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, ( ftnlen)1); -#line 21343 "" +#line 21333 "" /* L4: */ -#line 21343 "" +#line 21333 "" } /* Check if endsymbol was set earlier */ -#line 21347 "" +#line 21337 "" if (comget_1.rptnd1) { -#line 21348 "" +#line 21338 "" comget_1.rptnd1 = FALSE_; -#line 21349 "" +#line 21339 "" *(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1; -#line 21350 "" +#line 21340 "" } else { /* Only use if movbrk>0, to signal default ('RD') */ -#line 21354 "" +#line 21344 "" *(unsigned char *)comget_1.rptfq2 = 'E'; -#line 21355 "" +#line 21345 "" } -#line 21356 "" +#line 21346 "" all_1.iv = 1; -#line 21357 "" +#line 21347 "" commvl_1.ivx = 1; -#line 21358 "" +#line 21348 "" L2: -#line 21358 "" +#line 21348 "" if (loop) { /* Within this loop, nv voices are filled up for the duration of the block. */ @@ -50770,212 +51041,212 @@ L2: /* Only at the beginning of an input block will there be a possible mtr change, */ /* signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) */ -#line 21367 "" +#line 21357 "" getnote_(&loop); -#line 21368 "" +#line 21358 "" if (comget_1.lastchar) { -#line 21368 "" +#line 21358 "" goto L40; -#line 21368 "" +#line 21358 "" } -#line 21369 "" +#line 21359 "" goto L2; -#line 21370 "" +#line 21360 "" } /* Finished an input block (gulp). */ -#line 21374 "" +#line 21364 "" if (commidi_1.ismidi) { /* Put rests into midi array for 2nd lines that were not used in this gulp. */ -#line 21378 "" +#line 21368 "" i__1 = all_1.nv; -#line 21378 "" +#line 21368 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { -#line 21379 "" +#line 21369 "" if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1] == 1) { -#line 21380 "" +#line 21370 "" if (all_1.firstgulp && all_1.lenb0 != 0) { -#line 21381 "" +#line 21371 "" r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0; -#line 21381 "" +#line 21371 "" addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); -#line 21383 "" +#line 21373 "" } else { -#line 21384 "" +#line 21374 "" r__1 = all_1.nbars * 1.f * all_1.lenbar; -#line 21384 "" +#line 21374 "" addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); -#line 21386 "" +#line 21376 "" } -#line 21387 "" +#line 21377 "" } -#line 21388 "" +#line 21378 "" /* L60: */ -#line 21388 "" +#line 21378 "" } -#line 21389 "" +#line 21379 "" } -#line 21390 "" +#line 21380 "" comgrace_1.nvolt = 0; -#line 21391 "" +#line 21381 "" for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) { -#line 21392 "" +#line 21382 "" comudsp_1.nudoff[all_1.iv - 1] = 0; -#line 21393 "" +#line 21383 "" comcc_1.maxdotmv[all_1.iv - 1] = comcc_1.ndotmv[all_1.iv - 1]; -#line 21394 "" +#line 21384 "" comcc_1.ndotmv[all_1.iv - 1] = 0; -#line 21395 "" +#line 21385 "" /* L28: */ -#line 21395 "" +#line 21385 "" } /* Put stuff at top of p.1. Must wait until now to have read title info. */ -#line 21399 "" +#line 21389 "" if (combibarcnt_1.ibarcnt == 0) { -#line 21400 "" +#line 21390 "" puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &etatop, all_1.sq, &etait, &etatc, &etacs1, &all_1.nv, &vshrink, all_1.sepsymq, ( ftnlen)1, (ftnlen)1); -#line 21402 "" +#line 21392 "" if (comnotes_1.headerspecial) { -#line 21402 "" +#line 21392 "" s_wsfe(&io___1377); /* Writing concatenation */ -#line 21402 "" +#line 21392 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 21402 "" +#line 21392 "" i__6[0] = 1, a__4[0] = ch__1; -#line 21402 "" +#line 21392 "" i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"; -#line 21402 "" +#line 21392 "" s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); -#line 21402 "" +#line 21392 "" do_fio(&c__1, ch__7, (ftnlen)29); -#line 21402 "" +#line 21392 "" e_wsfe(); -#line 21402 "" +#line 21392 "" } /* Write special header for first page */ -#line 21407 "" +#line 21397 "" } -#line 21408 "" +#line 21398 "" i__1 = all_1.nbars; -#line 21408 "" +#line 21398 "" for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) { -#line 21409 "" +#line 21399 "" ++combibarcnt_1.ibarcnt; -#line 21410 "" +#line 21400 "" comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto; /* Computing MAX */ -#line 21411 "" +#line 21401 "" r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff; -#line 21411 "" +#line 21401 "" i__2 = 0, i__7 = (integer) r_lg10(&r__1); -#line 21411 "" +#line 21401 "" ndig = max(i__2,i__7); -#line 21412 "" +#line 21402 "" if (comlast_1.islast) { -#line 21412 "" +#line 21402 "" ci__1.cierr = 0; -#line 21412 "" +#line 21402 "" ci__1.ciunit = 11; /* Writing concatenation */ -#line 21412 "" +#line 21402 "" i__8[0] = 6, a__5[0] = "(a11,i"; -#line 21412 "" +#line 21402 "" i__2 = ndig + 50; -#line 21412 "" +#line 21402 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 21412 "" +#line 21402 "" i__8[1] = 1, a__5[1] = ch__1; -#line 21412 "" +#line 21402 "" i__8[2] = 1, a__5[2] = ")"; -#line 21412 "" +#line 21402 "" ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8); -#line 21412 "" +#line 21402 "" s_wsfe(&ci__1); -#line 21412 "" +#line 21402 "" do_fio(&c__1, "% Bar count", (ftnlen)11); -#line 21412 "" +#line 21402 "" i__7 = combibarcnt_1.ibarcnt + ibcoff; -#line 21412 "" +#line 21402 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); -#line 21412 "" +#line 21402 "" e_wsfe(); -#line 21412 "" +#line 21402 "" } -#line 21415 "" +#line 21405 "" if (all_1.ibar != comgrace_1.ibarmbr) { -#line 21416 "" +#line 21406 "" if (! (*optimize)) { -#line 21416 "" +#line 21406 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; -#line 21416 "" +#line 21406 "" outbar_(&i__2, &jprntb); -#line 21416 "" +#line 21406 "" } -#line 21417 "" +#line 21407 "" } else { -#line 21418 "" +#line 21408 "" if (! (*optimize)) { -#line 21419 "" +#line 21409 "" s_wsfe(&io___1379); -#line 21419 "" +#line 21409 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); -#line 21419 "" +#line 21409 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; -#line 21419 "" +#line 21409 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 21419 "" +#line 21409 "" do_fio(&c__1, "-", (ftnlen)1); -#line 21419 "" +#line 21409 "" i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; -#line 21419 "" +#line 21409 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); -#line 21419 "" +#line 21409 "" e_wsfe(); -#line 21421 "" +#line 21411 "" s_wsfe(&io___1380); -#line 21421 "" +#line 21411 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); -#line 21421 "" +#line 21411 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; -#line 21421 "" +#line 21411 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 21421 "" +#line 21411 "" do_fio(&c__1, "-", (ftnlen)1); -#line 21421 "" +#line 21411 "" i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; -#line 21421 "" +#line 21411 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); -#line 21421 "" +#line 21411 "" e_wsfe(); -#line 21423 "" +#line 21413 "" jprntb = 0; -#line 21424 "" +#line 21414 "" } -#line 21425 "" +#line 21415 "" ibcoff = ibcoff + comgrace_1.mbrest - 1; /* if (ibar.eq.1 .and. firstgulp .and. */ /* * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize */ -#line 21428 "" +#line 21418 "" if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[ 0],5)) { -#line 21428 "" +#line 21418 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 21428 "" +#line 21418 "" } -#line 21430 "" +#line 21420 "" } /* Move the read to after end-of-bar hardspace checks, so we get right poenom */ @@ -50992,137 +51263,137 @@ L2: /* compute additional pts and store them in hpttot(1...nhstot). Finally in */ /* subroutine askfig, write true pts where placeholders are. */ -#line 21446 "" +#line 21436 "" ioff = 0; -#line 21447 "" +#line 21437 "" if (all_1.ibar > 1) { -#line 21447 "" +#line 21437 "" ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24]; -#line 21447 "" +#line 21437 "" } -#line 21448 "" +#line 21438 "" clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15); -#line 21449 "" +#line 21439 "" putmbr = FALSE_; -#line 21450 "" +#line 21440 "" if (ismbr) { -#line 21451 "" +#line 21441 "" if (clchb) { /* cc */ /* cc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */ /* cc */ -#line 21455 "" +#line 21445 "" s_wsfe(&io___1384); /* Writing concatenation */ -#line 21455 "" +#line 21445 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 21455 "" +#line 21445 "" i__9[1] = 3, a__6[1] = "let"; -#line 21455 "" +#line 21445 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 21455 "" +#line 21445 "" i__9[3] = 4, a__6[3] = "mbrt"; -#line 21455 "" +#line 21445 "" i__9[4] = 1, a__6[4] = all_1.sq; -#line 21455 "" +#line 21445 "" i__9[5] = 6, a__6[5] = "mbrest"; -#line 21455 "" +#line 21445 "" i__9[6] = 1, a__6[6] = all_1.sq; -#line 21455 "" +#line 21445 "" i__9[7] = 3, a__6[7] = "def"; -#line 21455 "" +#line 21445 "" i__9[8] = 1, a__6[8] = all_1.sq; -#line 21455 "" +#line 21445 "" i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%"; -#line 21455 "" +#line 21445 "" s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35); -#line 21455 "" +#line 21445 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 21455 "" +#line 21445 "" e_wsfe(); -#line 21457 "" +#line 21447 "" s_wsfe(&io___1385); /* Writing concatenation */ -#line 21457 "" +#line 21447 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21457 "" +#line 21447 "" i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{"; -#line 21457 "" +#line 21447 "" s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); -#line 21457 "" +#line 21447 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 21457 "" +#line 21447 "" r__1 = all_1.musicsize * .55f; -#line 21457 "" +#line 21447 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); /* Writing concatenation */ -#line 21457 "" +#line 21447 "" i__10[0] = 1, a__7[0] = "}"; -#line 21457 "" +#line 21447 "" i__10[1] = 1, a__7[1] = all_1.sq; -#line 21457 "" +#line 21447 "" i__10[2] = 6, a__7[2] = "global"; -#line 21457 "" +#line 21447 "" i__10[3] = 1, a__7[3] = all_1.sq; -#line 21457 "" +#line 21447 "" i__10[4] = 3, a__7[4] = "let"; -#line 21457 "" +#line 21447 "" i__10[5] = 1, a__7[5] = all_1.sq; -#line 21457 "" +#line 21447 "" i__10[6] = 6, a__7[6] = "mbrest"; -#line 21457 "" +#line 21447 "" i__10[7] = 1, a__7[7] = all_1.sq; -#line 21457 "" +#line 21447 "" i__10[8] = 6, a__7[8] = "mbrt}%"; -#line 21457 "" +#line 21447 "" s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26); -#line 21457 "" +#line 21447 "" do_fio(&c__1, ch__4, (ftnlen)26); -#line 21457 "" +#line 21447 "" e_wsfe(); /* c */ /* c RDT suggestion is inset blank barline - 160103 Abandoned */ /* c */ /* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' */ /* * //sq//'advance'//sq//'barno-1' */ -#line 21464 "" +#line 21454 "" } -#line 21465 "" +#line 21455 "" ismbr = FALSE_; -#line 21466 "" +#line 21456 "" putmbr = TRUE_; -#line 21467 "" +#line 21457 "" } -#line 21468 "" +#line 21458 "" if (all_1.ibar == comgrace_1.ibarmbr) { -#line 21468 "" +#line 21458 "" ismbr = TRUE_; -#line 21468 "" +#line 21458 "" } /* Set flag here so at start of next bar, if there's a clef change, can add space */ /* after the mbr with the above kluge */ -#line 21473 "" +#line 21463 "" if (! (clchb || comnsp_2.flgndb)) { -#line 21473 "" +#line 21463 "" goto L23; -#line 21473 "" +#line 21463 "" } /* Must check available space */ -#line 21477 "" +#line 21467 "" ptsndb = 0.f; /* Zero out block signal */ -#line 21481 "" +#line 21471 "" if (clchb) { -#line 21481 "" +#line 21471 "" all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff + 1) * 24 - 24],15); -#line 21481 "" +#line 21471 "" } /* In this loop, we determine how much hardspace is needed (if any) */ @@ -51132,239 +51403,241 @@ L2: /* one. */ /* 4/18/98 Apparently nmxsav was a solution to the above problem */ -#line 21490 "" +#line 21480 "" i__2 = all_1.nv; -#line 21490 "" +#line 21480 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { -#line 21491 "" +#line 21481 "" i__7 = comnsp_2.nvmxsav[all_1.iv - 1]; -#line 21491 "" +#line 21481 "" for (kv = 1; kv <= i__7; ++kv) { -#line 21492 "" +#line 21482 "" commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25]; -#line 21493 "" +#line 21483 "" ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt; -#line 21494 "" +#line 21484 "" ioff = 0; -#line 21495 "" +#line 21485 "" if (all_1.ibar > 1) { -#line 21496 "" +#line 21486 "" ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 21497 "" +#line 21487 "" ip = ioff; -#line 21498 "" +#line 21488 "" if (all_1.ibar > 2) { -#line 21498 "" +#line 21488 "" ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 21498 "" +#line 21488 "" } /* prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */ -#line 21500 "" +#line 21490 "" comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1]; /* If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. */ -#line 21504 "" +#line 21494 "" } /* Only allow clef changes when ivx <= nv */ -#line 21508 "" +#line 21498 "" if (commvl_1.ivx <= all_1.nv) { -#line 21509 "" +#line 21499 "" clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[ all_1.iv + (ioff + 1) * 24 - 25],11); -#line 21510 "" +#line 21500 "" if (clchv[all_1.iv - 1]) { /* Clef change in this voice. Turn off signal. Get space avail. */ -#line 21514 "" +#line 21504 "" all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] = bit_clear(all_1.islur[all_1.iv + (ioff + 1) * 24 - 25],11); -#line 21515 "" +#line 21505 "" if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] - comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) < comtol_1.tol) { -#line 21515 "" +#line 21505 "" ptsndv += combmh_1.clefend * comask_1.wheadpt; -#line 21515 "" +#line 21505 "" } -#line 21517 "" +#line 21507 "" } -#line 21518 "" +#line 21508 "" } /* Computing MAX */ -#line 21519 "" +#line 21509 "" r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt * spfacs_1.xspfac; -#line 21519 "" +#line 21509 "" ptsndb = dmax(r__1,r__2); -#line 21520 "" -/* L16: */ -#line 21520 "" +#line 21510 "" +/* L1699: */ +#line 21510 "" } -#line 21520 "" +#line 21511 "" +/* L16: */ +#line 21511 "" } /* ???? where is nb set??? nb probably in left over from makeabar */ -#line 21524 "" +#line 21515 "" r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1]; -#line 21524 "" +#line 21515 "" esk = feon_(&r__1); -#line 21525 "" +#line 21516 "" ptsdflt = esk * comask_1.poenom - comask_1.wheadpt; /* if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */ -#line 21527 "" +#line 21518 "" if ((ptsndb > ptsdflt || comnsp_2.ptsgnd > 0.f) && comget_1.movbrk == 0 && ! putmbr) { /* Must ADD hardspace! So put in a placeholder, and store params for later. */ -#line 21532 "" +#line 21523 "" if (comlast_1.islast) { -#line 21532 "" +#line 21523 "" s_wsfe(&io___1394); /* Writing concatenation */ -#line 21532 "" +#line 21523 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21532 "" +#line 21523 "" i__6[1] = 18, a__4[1] = "xardspace{ pt}%"; -#line 21532 "" +#line 21523 "" s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); -#line 21532 "" +#line 21523 "" do_fio(&c__1, ch__11, (ftnlen)19); -#line 21532 "" +#line 21523 "" e_wsfe(); -#line 21532 "" +#line 21523 "" } -#line 21533 "" +#line 21524 "" ++nhssys; -#line 21534 "" +#line 21525 "" if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom * comnsp_2.eskgnd) { -#line 21535 "" +#line 21526 "" hesk[nhssys - 1] = esk; -#line 21536 "" +#line 21527 "" hpts[nhssys - 1] = ptsndb + comask_1.wheadpt; -#line 21537 "" +#line 21528 "" } else { -#line 21538 "" +#line 21529 "" hesk[nhssys - 1] = comnsp_2.eskgnd; -#line 21539 "" +#line 21530 "" hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt; -#line 21540 "" +#line 21531 "" } -#line 21541 "" +#line 21532 "" comask_1.fixednew += hpts[nhssys - 1]; -#line 21542 "" +#line 21533 "" comask_1.scaldold += hesk[nhssys - 1]; -#line 21543 "" +#line 21534 "" } -#line 21544 "" +#line 21535 "" if (clchb) { -#line 21545 "" - i__7 = all_1.nv; -#line 21545 "" - for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { -#line 21546 "" +#line 21536 "" + i__2 = all_1.nv; +#line 21536 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 21537 "" if (clchv[all_1.iv - 1]) { /* Writing concatenation */ -#line 21547 "" +#line 21538 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21547 "" +#line 21538 "" i__6[1] = 6, a__4[1] = "znotes"; -#line 21547 "" +#line 21538 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 21548 "" +#line 21539 "" lnote = 7; -#line 21549 "" - i__2 = all_1.iv; -#line 21549 "" - for (iiv = 2; iiv <= i__2; ++iiv) { +#line 21540 "" + i__7 = all_1.iv; +#line 21540 "" + for (iiv = 2; iiv <= i__7; ++iiv) { /* Writing concatenation */ -#line 21550 "" +#line 21541 "" i__6[0] = lnote, a__4[0] = notexq; -#line 21550 "" +#line 21541 "" i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2); -#line 21550 "" +#line 21541 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 21551 "" +#line 21542 "" ++lnote; -#line 21552 "" +#line 21543 "" /* L24: */ -#line 21552 "" +#line 21543 "" } /* Recompute ioff since it will vary from voice to voice */ -#line 21556 "" +#line 21547 "" if (all_1.ibar == 1) { -#line 21557 "" +#line 21548 "" ioff = 0; -#line 21558 "" +#line 21549 "" } else { -#line 21559 "" +#line 21550 "" ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 - 25]; -#line 21560 "" +#line 21551 "" } /* Must call clefsym to get nclef, even if there is a movement break */ -#line 21564 "" +#line 21555 "" clefsym_(&all_1.islur[all_1.iv + (ioff + 1) * 24 - 25], fmtq, &lclef, &nclef, (ftnlen)24); /* If clefq = '8', must change '0' in pos'n 9 to '8' */ -#line 21568 "" +#line 21559 "" if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) ) { /* Writing concatenation */ -#line 21568 "" +#line 21559 "" i__8[0] = 8, a__5[0] = fmtq; -#line 21568 "" +#line 21559 "" i__8[1] = 1, a__5[1] = "8"; -#line 21568 "" +#line 21559 "" i__8[2] = 1, a__5[2] = fmtq + 9; -#line 21568 "" +#line 21559 "" s_cat(fmtq, a__5, i__8, &c__3, (ftnlen)24); -#line 21568 "" +#line 21559 "" } -#line 21570 "" +#line 21561 "" if (comget_1.movbrk == 0 && comlast_1.islast) { -#line 21570 "" +#line 21561 "" s_wsfe(&io___1403); /* Writing concatenation */ -#line 21570 "" +#line 21561 "" i__5[0] = lnote, a__3[0] = notexq; -#line 21570 "" +#line 21561 "" i__5[1] = lclef, a__3[1] = fmtq; -#line 21570 "" +#line 21561 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21570 "" +#line 21561 "" i__5[3] = 3, a__3[3] = "en%"; -#line 21570 "" +#line 21561 "" s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107); -#line 21570 "" +#line 21561 "" do_fio(&c__1, ch__12, lnote + lclef + 4); -#line 21570 "" +#line 21561 "" e_wsfe(); -#line 21570 "" +#line 21561 "" } -#line 21573 "" +#line 21564 "" wsclef_(&all_1.iv, &comnotes_1.ninow, &nclef); /* Set new flag to be used just outside this loop, to kluge */ /* any calls to \CenterBar for full-bar rests, to make room for clef. */ -#line 21578 "" +#line 21569 "" newclef = TRUE_; /* 151220 */ @@ -51374,614 +51647,614 @@ L2: /* and if we change from TLO to normal clef, need to resetclefsymbols */ /* if (clefq(iv) .eq. '8') then */ -#line 21587 "" +#line 21578 "" if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) ) { /* Find instrument number for voice iv */ -#line 21591 "" +#line 21582 "" iv1 = 1; -#line 21592 "" - i__2 = comnotes_1.ninow; -#line 21592 "" - for (iinst = 1; iinst <= i__2; ++iinst) { -#line 21593 "" +#line 21583 "" + i__7 = comnotes_1.ninow; +#line 21583 "" + for (iinst = 1; iinst <= i__7; ++iinst) { +#line 21584 "" if (all_1.iv < iv1 + comnvi_1.nspern[iinst - 1]) { -#line 21593 "" +#line 21584 "" goto L2222; -#line 21593 "" +#line 21584 "" } -#line 21594 "" +#line 21585 "" iv1 += comnvi_1.nspern[iinst - 1]; -#line 21595 "" +#line 21586 "" /* L1111: */ -#line 21595 "" +#line 21586 "" } -#line 21596 "" +#line 21587 "" s_wsle(&io___1406); -#line 21596 "" +#line 21587 "" e_wsle(); -#line 21597 "" +#line 21588 "" s_wsle(&io___1407); -#line 21597 "" +#line 21588 "" do_lio(&c__9, &c__1, "Should not be here in pmxb!", ( ftnlen)27); -#line 21597 "" +#line 21588 "" e_wsle(); -#line 21598 "" +#line 21589 "" stop1_(); -#line 21599 "" +#line 21590 "" L2222: -#line 21600 "" +#line 21591 "" if (iinst <= 9) { -#line 21601 "" +#line 21592 "" s_wsfe(&io___1408); /* Writing concatenation */ -#line 21601 "" +#line 21592 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21601 "" +#line 21592 "" i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; -#line 21601 "" +#line 21592 "" s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); -#line 21601 "" +#line 21592 "" do_fio(&c__1, ch__6, (ftnlen)20); -#line 21601 "" +#line 21592 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ -#line 21601 "" +#line 21592 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 21601 "" +#line 21592 "" i__11[1] = 13, a__8[1] = "treblelowoct%"; -#line 21601 "" +#line 21592 "" s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); -#line 21601 "" +#line 21592 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 21601 "" +#line 21592 "" e_wsfe(); -#line 21603 "" +#line 21594 "" } else { -#line 21604 "" +#line 21595 "" s_wsfe(&io___1409); /* Writing concatenation */ -#line 21604 "" +#line 21595 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21604 "" +#line 21595 "" i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; -#line 21604 "" +#line 21595 "" s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); -#line 21604 "" +#line 21595 "" do_fio(&c__1, ch__6, (ftnlen)20); -#line 21604 "" +#line 21595 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ -#line 21604 "" +#line 21595 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 21604 "" +#line 21595 "" i__11[1] = 13, a__8[1] = "treblelowoct%"; -#line 21604 "" +#line 21595 "" s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); -#line 21604 "" +#line 21595 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 21604 "" +#line 21595 "" e_wsfe(); -#line 21606 "" +#line 21597 "" } -#line 21607 "" +#line 21598 "" comc8flag_1.c8flag[all_1.iv - 1] = TRUE_; -#line 21608 "" +#line 21599 "" } else { -#line 21609 "" +#line 21600 "" if (*(unsigned char *)&comclefq_1.clefq[all_1.iv - 1] == '8') { -#line 21610 "" +#line 21601 "" s_wsfe(&io___1410); /* Writing concatenation */ -#line 21610 "" +#line 21601 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21610 "" +#line 21601 "" i__6[1] = 16, a__4[1] = "resetclefsymbols"; -#line 21610 "" +#line 21601 "" s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)17); -#line 21610 "" +#line 21601 "" do_fio(&c__1, ch__13, (ftnlen)17); -#line 21610 "" +#line 21601 "" e_wsfe(); -#line 21611 "" +#line 21602 "" } -#line 21612 "" +#line 21603 "" } -#line 21613 "" +#line 21604 "" } -#line 21614 "" +#line 21605 "" /* L17: */ -#line 21614 "" +#line 21605 "" } -#line 21615 "" +#line 21606 "" if (comlast_1.islast) { -#line 21615 "" +#line 21606 "" s_wsfe(&io___1411); /* Writing concatenation */ -#line 21615 "" +#line 21606 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21615 "" +#line 21606 "" i__6[1] = 11, a__4[1] = "pmxnewclefs"; -#line 21615 "" +#line 21606 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 21615 "" +#line 21606 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 21615 "" +#line 21606 "" e_wsfe(); -#line 21615 "" +#line 21606 "" } -#line 21616 "" +#line 21607 "" } -#line 21617 "" +#line 21608 "" L23: /* Kluge \CenterBar for whole bar rests if necessary */ -#line 21621 "" +#line 21612 "" if (newclef && comclefrests_1.centrests) { /* write(11,'(a)')sq//'def'//sq//'value{11}%' */ -#line 21623 "" +#line 21614 "" r__1 = all_1.musicsize * .55f; -#line 21623 "" +#line 21614 "" nvalue = i_nint(&r__1); -#line 21624 "" +#line 21615 "" if (nvalue > 10) { -#line 21625 "" +#line 21616 "" s_wsfe(&io___1413); /* Writing concatenation */ -#line 21625 "" +#line 21616 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21625 "" +#line 21616 "" i__5[1] = 3, a__3[1] = "def"; -#line 21625 "" +#line 21616 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21625 "" +#line 21616 "" i__5[3] = 6, a__3[3] = "value{"; -#line 21625 "" +#line 21616 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 21625 "" +#line 21616 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 21625 "" +#line 21616 "" do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); -#line 21625 "" +#line 21616 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 21625 "" +#line 21616 "" e_wsfe(); -#line 21627 "" +#line 21618 "" } else { -#line 21628 "" +#line 21619 "" s_wsfe(&io___1414); /* Writing concatenation */ -#line 21628 "" +#line 21619 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21628 "" +#line 21619 "" i__5[1] = 3, a__3[1] = "def"; -#line 21628 "" +#line 21619 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21628 "" +#line 21619 "" i__5[3] = 6, a__3[3] = "value{"; -#line 21628 "" +#line 21619 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 21628 "" +#line 21619 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 21628 "" +#line 21619 "" do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); -#line 21628 "" +#line 21619 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 21628 "" +#line 21619 "" e_wsfe(); -#line 21630 "" +#line 21621 "" } -#line 21631 "" +#line 21622 "" } -#line 21632 "" +#line 21623 "" newclef = FALSE_; -#line 21633 "" +#line 21624 "" comclefrests_1.centrests = FALSE_; /* End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */ -#line 21637 "" +#line 21628 "" if (comask_1.bar1syst) { -#line 21638 "" +#line 21629 "" s_rsle(&io___1415); -#line 21638 "" +#line 21629 "" do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof( real)); -#line 21638 "" +#line 21629 "" e_rsle(); -#line 21639 "" +#line 21630 "" } /* Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */ -#line 21643 "" +#line 21634 "" if (all_1.ibar == 1) { -#line 21644 "" +#line 21635 "" islnow = all_1.islur[0]; /* iornqnow = iornq(1,1) */ -#line 21646 "" +#line 21637 "" iplnow = all_1.ipl[0]; -#line 21647 "" +#line 21638 "" } else { -#line 21648 "" +#line 21639 "" islnow = all_1.islur[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) * 24 - 24]; /* iornqnow = iornq(1,nib(1,ibar-1)+1) */ -#line 21650 "" +#line 21641 "" iplnow = all_1.ipl[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) * 24 - 24]; -#line 21651 "" +#line 21642 "" } /* Check for R-symbols set at end of prior input block */ -#line 21655 "" +#line 21646 "" if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E') { -#line 21656 "" +#line 21647 "" if (*(unsigned char *)comget_1.rptfq2 == 'D') { -#line 21657 "" +#line 21648 "" islnow = bit_set(islnow,26); -#line 21658 "" +#line 21649 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'r') { -#line 21659 "" +#line 21650 "" islnow = bit_set(islnow,6); -#line 21660 "" +#line 21651 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { -#line 21661 "" +#line 21652 "" islnow = bit_set(islnow,8); -#line 21662 "" +#line 21653 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { -#line 21663 "" +#line 21654 "" islnow = bit_set(islnow,25); -#line 21664 "" +#line 21655 "" } else { -#line 21665 "" +#line 21656 "" s_wsle(&io___1418); -#line 21665 "" +#line 21656 "" e_wsle(); -#line 21666 "" +#line 21657 "" s_wsle(&io___1419); -#line 21666 "" +#line 21657 "" do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"\ "put block:", (ftnlen)46); -#line 21666 "" +#line 21657 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); -#line 21666 "" +#line 21657 "" e_wsle(); -#line 21668 "" +#line 21659 "" stop1_(); -#line 21669 "" +#line 21660 "" } -#line 21670 "" +#line 21661 "" *(unsigned char *)comget_1.rptfq2 = 'E'; -#line 21671 "" +#line 21662 "" } -#line 21672 "" +#line 21663 "" if ((islnow & 352) != 0) { /* Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */ -#line 21676 "" +#line 21667 "" lrpt = bit_test(islnow,5); -#line 21677 "" +#line 21668 "" rrpt = bit_test(islnow,6); -#line 21678 "" +#line 21669 "" lrptpend = lrpt && comask_1.bar1syst; -#line 21679 "" +#line 21670 "" if (lrpt && ! lrptpend) { -#line 21680 "" +#line 21671 "" if (rrpt) { -#line 21681 "" +#line 21672 "" if (comlast_1.islast) { -#line 21681 "" +#line 21672 "" s_wsfe(&io___1422); /* Writing concatenation */ -#line 21681 "" +#line 21672 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21681 "" +#line 21672 "" i__6[1] = 18, a__4[1] = "setleftrightrepeat"; -#line 21681 "" +#line 21672 "" s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); -#line 21681 "" +#line 21672 "" do_fio(&c__1, ch__11, (ftnlen)19); -#line 21681 "" +#line 21672 "" e_wsfe(); -#line 21681 "" +#line 21672 "" } -#line 21682 "" +#line 21673 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.lrrptfac - .4f; -#line 21683 "" +#line 21674 "" } else { -#line 21684 "" +#line 21675 "" if (comlast_1.islast) { -#line 21684 "" +#line 21675 "" s_wsfe(&io___1423); /* Writing concatenation */ -#line 21684 "" +#line 21675 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21684 "" +#line 21675 "" i__6[1] = 13, a__4[1] = "setleftrepeat"; -#line 21684 "" +#line 21675 "" s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); -#line 21684 "" +#line 21675 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 21684 "" +#line 21675 "" e_wsfe(); -#line 21684 "" +#line 21675 "" } -#line 21685 "" +#line 21676 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.rptfac - .4f; -#line 21686 "" +#line 21677 "" } -#line 21687 "" +#line 21678 "" } else if (rrpt) { -#line 21688 "" +#line 21679 "" if (comlast_1.islast) { -#line 21688 "" +#line 21679 "" s_wsfe(&io___1424); /* Writing concatenation */ -#line 21688 "" +#line 21679 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21688 "" +#line 21679 "" i__6[1] = 14, a__4[1] = "setrightrepeat"; -#line 21688 "" +#line 21679 "" s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); -#line 21688 "" +#line 21679 "" do_fio(&c__1, ch__16, (ftnlen)15); -#line 21688 "" +#line 21679 "" e_wsfe(); -#line 21688 "" +#line 21679 "" } -#line 21689 "" +#line 21680 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.rptfac - .4f; -#line 21690 "" +#line 21681 "" } else if (bit_test(islnow,8)) { -#line 21691 "" +#line 21682 "" if (comlast_1.islast) { -#line 21691 "" +#line 21682 "" s_wsfe(&io___1425); /* Writing concatenation */ -#line 21691 "" +#line 21682 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21691 "" +#line 21682 "" i__6[1] = 12, a__4[1] = "setdoublebar"; -#line 21691 "" +#line 21682 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); -#line 21691 "" +#line 21682 "" do_fio(&c__1, ch__17, (ftnlen)13); -#line 21691 "" +#line 21682 "" e_wsfe(); -#line 21691 "" +#line 21682 "" } -#line 21692 "" +#line 21683 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.dbarfac - .4f; -#line 21693 "" +#line 21684 "" } -#line 21694 "" +#line 21685 "" } else if (bit_test(islnow,26)) { /* doubleBAR */ -#line 21698 "" +#line 21689 "" if (comlast_1.islast) { -#line 21698 "" +#line 21689 "" s_wsfe(&io___1426); /* Writing concatenation */ -#line 21698 "" +#line 21689 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21698 "" +#line 21689 "" i__6[1] = 12, a__4[1] = "setdoubleBAR"; -#line 21698 "" +#line 21689 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); -#line 21698 "" +#line 21689 "" do_fio(&c__1, ch__17, (ftnlen)13); -#line 21698 "" +#line 21689 "" e_wsfe(); -#line 21698 "" +#line 21689 "" } -#line 21699 "" +#line 21690 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.ddbarfac - .4f; /* else if (btest(iornqnow,29)) then */ -#line 21701 "" +#line 21692 "" } else if (bit_test(iplnow,0)) { /* no bar line */ /* -- if (islast) write(11,'(a)')sq//'setzalaligne' */ /* ++ */ -#line 21707 "" +#line 21698 "" if (comlast_1.islast) { -#line 21708 "" +#line 21699 "" if (comget_1.movbrk == 0) { -#line 21709 "" +#line 21700 "" s_wsfe(&io___1427); /* Writing concatenation */ -#line 21709 "" +#line 21700 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21709 "" +#line 21700 "" i__6[1] = 12, a__4[1] = "setzalaligne"; -#line 21709 "" +#line 21700 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); -#line 21709 "" +#line 21700 "" do_fio(&c__1, ch__17, (ftnlen)13); -#line 21709 "" +#line 21700 "" e_wsfe(); -#line 21710 "" +#line 21701 "" } else { /* Encountered "Rz" at start of input block at start of new movement, Must */ /* use newmovement macro with arg 4 rather than setzalaligne, since former */ /* already redefines stoppiece. */ -#line 21716 "" +#line 21707 "" *(unsigned char *)comget_1.rptfq2 = 'z'; -#line 21717 "" +#line 21708 "" } -#line 21718 "" +#line 21709 "" } /* ++ */ -#line 21720 "" +#line 21711 "" comask_1.fixednew += -.4f; -#line 21721 "" +#line 21712 "" } /* 1st and 2nd endings */ -#line 21725 "" +#line 21716 "" svolta = bit_test(islnow,7); -#line 21726 "" +#line 21717 "" evolta = bit_test(islnow,9); -#line 21727 "" +#line 21718 "" if (evolta) { -#line 21728 "" +#line 21719 "" if (bit_test(islnow,10)) { -#line 21729 "" +#line 21720 "" if (comlast_1.islast) { -#line 21729 "" +#line 21720 "" s_wsfe(&io___1430); /* Writing concatenation */ -#line 21729 "" +#line 21720 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21729 "" +#line 21720 "" i__6[1] = 11, a__4[1] = "endvoltabox"; -#line 21729 "" +#line 21720 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 21729 "" +#line 21720 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 21729 "" +#line 21720 "" e_wsfe(); -#line 21729 "" +#line 21720 "" } -#line 21730 "" +#line 21721 "" } else { -#line 21731 "" +#line 21722 "" if (comlast_1.islast) { -#line 21731 "" +#line 21722 "" s_wsfe(&io___1431); /* Writing concatenation */ -#line 21731 "" +#line 21722 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21731 "" +#line 21722 "" i__6[1] = 8, a__4[1] = "endvolta"; -#line 21731 "" +#line 21722 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 21731 "" +#line 21722 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 21731 "" +#line 21722 "" e_wsfe(); -#line 21731 "" +#line 21722 "" } -#line 21732 "" +#line 21723 "" } -#line 21733 "" +#line 21724 "" onvolt = FALSE_; -#line 21734 "" +#line 21725 "" } -#line 21735 "" +#line 21726 "" if (svolta) { -#line 21736 "" +#line 21727 "" ++comgrace_1.nvolt; -#line 21737 "" +#line 21728 "" lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, " ", (ftnlen)20, (ftnlen)1) - 1; -#line 21738 "" +#line 21729 "" if (lvoltxt == 1) { -#line 21739 "" +#line 21730 "" if (comlast_1.islast) { -#line 21739 "" +#line 21730 "" s_wsfe(&io___1433); /* Writing concatenation */ -#line 21739 "" +#line 21730 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21739 "" +#line 21730 "" i__5[1] = 8, a__3[1] = "Setvolta"; -#line 21739 "" +#line 21730 "" i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; -#line 21739 "" +#line 21730 "" i__5[3] = 1, a__3[3] = "%"; -#line 21739 "" +#line 21730 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 21739 "" +#line 21730 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 21739 "" +#line 21730 "" e_wsfe(); -#line 21739 "" +#line 21730 "" } -#line 21741 "" +#line 21732 "" } else { -#line 21742 "" +#line 21733 "" if (comlast_1.islast) { -#line 21742 "" +#line 21733 "" s_wsfe(&io___1434); /* Writing concatenation */ -#line 21742 "" +#line 21733 "" i__12[0] = 1, a__9[0] = all_1.sq; -#line 21742 "" +#line 21733 "" i__12[1] = 8, a__9[1] = "Setvolta"; -#line 21742 "" +#line 21733 "" i__12[2] = 1, a__9[2] = "{"; -#line 21742 "" +#line 21733 "" i__12[3] = lvoltxt, a__9[3] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; -#line 21742 "" +#line 21733 "" i__12[4] = 2, a__9[4] = "}%"; -#line 21742 "" +#line 21733 "" s_cat(ch__19, a__9, i__12, &c__5, (ftnlen)32); -#line 21742 "" +#line 21733 "" do_fio(&c__1, ch__19, lvoltxt + 12); -#line 21742 "" +#line 21733 "" e_wsfe(); -#line 21742 "" +#line 21733 "" } -#line 21744 "" +#line 21735 "" } -#line 21745 "" +#line 21736 "" onvolt = TRUE_; -#line 21746 "" +#line 21737 "" } -#line 21747 "" +#line 21738 "" if (all_1.ibar > 1) { -#line 21748 "" +#line 21739 "" ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1; -#line 21749 "" +#line 21740 "" } else { -#line 21750 "" +#line 21741 "" ipnow = 1; -#line 21751 "" +#line 21742 "" } -#line 21752 "" +#line 21743 "" iplnow = all_1.ipl[ipnow * 24 - 24]; -#line 21753 "" +#line 21744 "" if (comask_1.bar1syst) { /* If listslur>0, then there is at least one slur or tie carried over the break */ -#line 21757 "" +#line 21748 "" ispstie = FALSE_; -#line 21758 "" +#line 21749 "" if (comnotes_1.optlinebreakties && ! comslur_1.fontslur && comslur_1.listslur != 0 && comlast_1.islast) { -#line 21758 "" +#line 21749 "" linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( ftnlen)1); -#line 21758 "" +#line 21749 "" } -#line 21762 "" +#line 21753 "" ++all_1.iline; /* End an old system, Start a new system */ @@ -51989,225 +52262,225 @@ L23: /* Reduce space before mbrest at start of system */ /* Need this even if no accidentals in key signature */ -#line 21769 "" +#line 21760 "" if (all_1.ibar == comgrace_1.ibarmbr) { -#line 21769 "" +#line 21760 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 21769 "" +#line 21760 "" } -#line 21771 "" +#line 21762 "" if (all_1.iline != 1) { /* Not first line. */ /* Get corrected poe = points/elemskip for *previous* system */ -#line 21776 "" +#line 21767 "" wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); -#line 21777 "" +#line 21768 "" poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew) / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold); -#line 21779 "" +#line 21770 "" ++isyscnt; -#line 21780 "" +#line 21771 "" poevec[isyscnt] = poe; /* Transfer data for system into global arrays to hold until very end */ -#line 21784 "" - i__7 = comas2_1.nasksys; -#line 21784 "" - for (ia = 1; ia <= i__7; ++ia) { -#line 21785 "" +#line 21775 "" + i__2 = comas2_1.nasksys; +#line 21775 "" + for (ia = 1; ia <= i__2; ++ia) { +#line 21776 "" ++comas3_1.iask; -#line 21786 "" +#line 21777 "" comas3_1.ask[comas3_1.iask - 1] = (comas2_1.wasksys[ia - 1] / poe - (r__1 = comas2_1.elasksys[ia - 1], dabs(r__1))) / comshort_1.poefa[all_1.iline - 2]; /* Only admit negative ask if it was user-defined space, signalled by elask<=0. */ -#line 21791 "" +#line 21782 "" if (comas2_1.elasksys[ia - 1] > 0.f) { -#line 21791 "" +#line 21782 "" comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ comas3_1.iask - 1], &c_b1008); -#line 21791 "" +#line 21782 "" } -#line 21792 "" +#line 21783 "" /* L9: */ -#line 21792 "" +#line 21783 "" } -#line 21793 "" - i__7 = nhssys; -#line 21793 "" - for (ia = 1; ia <= i__7; ++ia) { -#line 21794 "" +#line 21784 "" + i__2 = nhssys; +#line 21784 "" + for (ia = 1; ia <= i__2; ++ia) { +#line 21785 "" ++nhstot; /* Computing MAX */ -#line 21795 "" +#line 21786 "" r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; -#line 21795 "" +#line 21786 "" comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); -#line 21796 "" +#line 21787 "" /* L25: */ -#line 21796 "" +#line 21787 "" } /* Reset counters for new system */ -#line 21800 "" +#line 21791 "" comask_1.scaldold = 0.f; -#line 21801 "" +#line 21792 "" comask_1.fixednew = 0.f; -#line 21802 "" +#line 21793 "" comas2_1.nasksys = 0; -#line 21803 "" +#line 21794 "" nhssys = 0; -#line 21804 "" +#line 21795 "" } /* End of if block for first bar of non-first system. Still 1st bar, any system */ -#line 21808 "" +#line 21799 "" if (comlast_1.islast && all_1.figbass) { -#line 21808 "" +#line 21799 "" s_wsfe(&io___1443); /* Writing concatenation */ -#line 21808 "" +#line 21799 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21808 "" +#line 21799 "" i__6[1] = 8, a__4[1] = "fixdrop%"; -#line 21808 "" +#line 21799 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 21808 "" +#line 21799 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 21808 "" +#line 21799 "" e_wsfe(); -#line 21808 "" +#line 21799 "" } -#line 21809 "" +#line 21800 "" ++isystpg; /* Try moving the next stmt way down, to fix a bug and get \eject printed at */ /* end of single-system page. */ /* if (isystpg .eq. nsystp(ipage)) isystpg = 0 */ -#line 21814 "" +#line 21805 "" s_rsle(&io___1444); -#line 21814 "" +#line 21805 "" do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer)); -#line 21814 "" +#line 21805 "" do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real)); -#line 21814 "" +#line 21805 "" do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real)); -#line 21814 "" +#line 21805 "" do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real)); -#line 21814 "" +#line 21805 "" do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)) ; -#line 21814 "" +#line 21805 "" do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real) ); -#line 21814 "" +#line 21805 "" e_rsle(); -#line 21815 "" +#line 21806 "" if (all_1.iline > 1) { -#line 21815 "" +#line 21806 "" comtop_1.fracindent = frac; -#line 21815 "" +#line 21806 "" } -#line 21816 "" +#line 21807 "" if (all_1.figbass) { -#line 21817 "" +#line 21808 "" all_1.ifigdr[(all_1.iline << 1) - 2] = 4; -#line 21818 "" +#line 21809 "" all_1.ifigdr[(all_1.iline << 1) - 1] = 4; -#line 21819 "" +#line 21810 "" } -#line 21820 "" +#line 21811 "" all_1.slfac = slfac1 * all_1.musicsize * elsktot; -#line 21821 "" +#line 21812 "" if (all_1.iline != 1) { /* For the line just _finished_, put figdrop in separate file. */ -#line 21825 "" +#line 21816 "" if (all_1.figbass) { -#line 21825 "" +#line 21816 "" s_wsfe(&io___1446); /* Writing concatenation */ -#line 21825 "" +#line 21816 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21825 "" +#line 21816 "" i__6[1] = 8, a__4[1] = "figdrop="; -#line 21825 "" +#line 21816 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 21825 "" +#line 21816 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 21825 "" +#line 21816 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) - 2], (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 21825 "" +#line 21816 "" i__8[0] = 1, a__5[0] = " "; -#line 21825 "" +#line 21816 "" i__8[1] = 1, a__5[1] = all_1.sq; -#line 21825 "" +#line 21816 "" i__8[2] = 8, a__5[2] = "figdtwo="; -#line 21825 "" +#line 21816 "" s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); -#line 21825 "" +#line 21816 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 21825 "" +#line 21816 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) - 1], (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 21825 "" +#line 21816 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 21825 "" +#line 21816 "" i__11[1] = 3, a__8[1] = "or%"; -#line 21825 "" +#line 21816 "" s_cat(ch__21, a__8, i__11, &c__2, (ftnlen)4); -#line 21825 "" +#line 21816 "" do_fio(&c__1, ch__21, (ftnlen)4); -#line 21825 "" +#line 21816 "" e_wsfe(); -#line 21825 "" +#line 21816 "" } /* Check slurs in top staff for interference w/ barno. Only check when */ /* # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS */ /* keep track of ons and offs when |isig|<=3. */ -#line 21833 "" +#line 21824 "" r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f; -#line 21833 "" +#line 21824 "" ndigbn = (integer) r_lg10(&r__1) + 1; -#line 21834 "" +#line 21825 "" comsln_1.isnx = 0; -#line 21835 "" +#line 21826 "" if (ndigbn >= abs(comtop_1.isig) && comsln_1.is1n1 > 0) { /* There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 */ /* Look for termination in remainder of this input block. If not found, */ /* just use is1n1. Remember, haven't slid down yet. */ -#line 21841 "" +#line 21832 "" ioff = 0; -#line 21842 "" +#line 21833 "" if (all_1.ibar > 1) { -#line 21842 "" +#line 21833 "" ioff = all_1.nib[commvl_1.ivmx[all_1.nv + commvl_1.nvmx[all_1.nv - 1] * 24 - 25] + ( all_1.ibar - 1) * 24 - 25]; -#line 21842 "" +#line 21833 "" } -#line 21843 "" - i__7 = all_1.nsdat; -#line 21843 "" - for (isdat = 1; isdat <= i__7; ++isdat) { -#line 21844 "" +#line 21834 "" + i__2 = all_1.nsdat; +#line 21834 "" + for (isdat = 1; isdat <= i__2; ++isdat) { +#line 21835 "" if (igetbits_(&all_1.isdat1[isdat - 1], &c__5, &c__13) == commvl_1.ivmx[all_1.nv + commvl_1.nvmx[ all_1.nv - 1] * 24 - 25] && ! bit_test( @@ -52219,82 +52492,82 @@ L23: /* is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */ /* Computing MAX */ -#line 21851 "" - i__2 = comsln_1.is1n1, i__13 = igetbits_(& +#line 21842 "" + i__7 = comsln_1.is1n1, i__13 = igetbits_(& all_1.isdat2[isdat - 1], &c__7, &c__19); -#line 21851 "" - comsln_1.is1n1 = max(i__2,i__13); -#line 21852 "" +#line 21842 "" + comsln_1.is1n1 = max(i__7,i__13); +#line 21843 "" goto L51; -#line 21853 "" +#line 21844 "" } -#line 21854 "" +#line 21845 "" /* L50: */ -#line 21854 "" +#line 21845 "" } /* If exiting loop normally, did not find end of slur. c'est la vie. */ -#line 21858 "" +#line 21849 "" L51: -#line 21859 "" - i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd; -#line 21859 "" - comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7); -#line 21860 "" +#line 21850 "" + i__2 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd; +#line 21850 "" + comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__2); +#line 21851 "" if (comsln_1.isnx > 0) { /* AHA! Slur likely to interfere with barno. */ /* Modified 090525 to use \bnrs */ -#line 21866 "" +#line 21857 "" slint = TRUE_; -#line 21867 "" +#line 21858 "" s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12); -#line 21868 "" +#line 21859 "" if (comsln_1.irzbnd + comsln_1.isnx > 9) { -#line 21868 "" +#line 21859 "" s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen) 12); -#line 21868 "" +#line 21859 "" } -#line 21869 "" +#line 21860 "" if (comlast_1.islast) { -#line 21869 "" +#line 21860 "" s_wsfe(&io___1449); /* Writing concatenation */ -#line 21869 "" +#line 21860 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 21869 "" +#line 21860 "" i__5[1] = 3, a__3[1] = "def"; -#line 21869 "" +#line 21860 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 21869 "" +#line 21860 "" i__5[3] = 11, a__3[3] = "raisebarno{"; -#line 21869 "" +#line 21860 "" s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); -#line 21869 "" +#line 21860 "" do_fio(&c__1, ch__22, (ftnlen)16); -#line 21869 "" - i__7 = comsln_1.irzbnd + comsln_1.isnx; -#line 21869 "" - do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof( +#line 21860 "" + i__2 = comsln_1.irzbnd + comsln_1.isnx; +#line 21860 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof( integer)); /* Writing concatenation */ -#line 21869 "" +#line 21860 "" i__8[0] = 2, a__5[0] = ".5"; -#line 21869 "" +#line 21860 "" i__8[1] = 1, a__5[1] = all_1.sq; -#line 21869 "" +#line 21860 "" i__8[2] = 11, a__5[2] = "internote}%"; -#line 21869 "" +#line 21860 "" s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); -#line 21869 "" +#line 21860 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 21869 "" +#line 21860 "" e_wsfe(); -#line 21869 "" +#line 21860 "" } /* if (islast) then */ /* if (isnx .le. 9) then */ @@ -52304,11 +52577,11 @@ L51: /* end if */ /* end if */ -#line 21879 "" +#line 21870 "" } -#line 21880 "" +#line 21871 "" } -#line 21881 "" +#line 21872 "" if (comget_1.movbrk > 0) { /* movbrk = 0 */ @@ -52319,85 +52592,85 @@ L51: /* indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */ /* This is passed to \newmovement. */ -#line 21891 "" +#line 21882 "" if (*(unsigned char *)comget_1.rptfq2 == 'E') { -#line 21891 "" +#line 21882 "" *(unsigned char *)comget_1.rptfq2 = 'D'; -#line 21891 "" +#line 21882 "" } -#line 21892 "" +#line 21883 "" indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, ( ftnlen)1) - 1; -#line 21893 "" +#line 21884 "" *(unsigned char *)comget_1.rptfq2 = 'E'; /* Also check for Rd or Rr set the normal way */ -#line 21897 "" +#line 21888 "" if (bit_test(islnow,8)) { -#line 21898 "" +#line 21889 "" indsym = 1; -#line 21899 "" +#line 21890 "" } else if (bit_test(islnow,6)) { -#line 21900 "" +#line 21891 "" indsym = 2; -#line 21901 "" +#line 21892 "" } -#line 21902 "" +#line 21893 "" if (indsym < 0) { -#line 21903 "" +#line 21894 "" s_wsle(&io___1451); -#line 21903 "" +#line 21894 "" e_wsle(); -#line 21904 "" +#line 21895 "" s_wsle(&io___1452); -#line 21904 "" +#line 21895 "" do_lio(&c__9, &c__1, "Illegal end symbol before \"/\"" , (ftnlen)29); -#line 21904 "" +#line 21895 "" e_wsle(); -#line 21905 "" +#line 21896 "" stop1_(); -#line 21906 "" +#line 21897 "" } /* Check for continuation (no bar number reset) */ -#line 21910 "" +#line 21901 "" if (comlast_1.islast && comnotes_1.nobar1) { -#line 21911 "" +#line 21902 "" s_wsfe(&io___1453); /* Writing concatenation */ -#line 21911 "" +#line 21902 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 21911 "" +#line 21902 "" i__9[1] = 7, a__6[1] = "advance"; -#line 21911 "" +#line 21902 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 21911 "" +#line 21902 "" i__9[3] = 6, a__6[3] = "barno1"; -#line 21911 "" +#line 21902 "" i__9[4] = 1, a__6[4] = all_1.sq; -#line 21911 "" +#line 21902 "" i__9[5] = 6, a__6[5] = "global"; -#line 21911 "" +#line 21902 "" i__9[6] = 1, a__6[6] = all_1.sq; -#line 21911 "" +#line 21902 "" i__9[7] = 10, a__6[7] = "startbarno"; -#line 21911 "" +#line 21902 "" i__9[8] = 1, a__6[8] = all_1.sq; -#line 21911 "" +#line 21902 "" i__9[9] = 6, a__6[9] = "barno%"; -#line 21911 "" +#line 21902 "" s_cat(ch__23, a__6, i__9, &c__10, (ftnlen)40); -#line 21911 "" +#line 21902 "" do_fio(&c__1, ch__23, (ftnlen)40); -#line 21911 "" +#line 21902 "" e_wsfe(); /* Need above for shortening case mcm with Mc */ -#line 21916 "" +#line 21907 "" } /* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */ @@ -52409,528 +52682,528 @@ L51: /* if (islast) write(11,'(a13,i2,a1,i1,a1)') */ /* * sq//'newmovement{',movgap,'}',indsym,'%' */ /* end if */ -#line 21927 "" +#line 21918 "" if (comlast_1.islast) { /* Writing concatenation */ -#line 21928 "" +#line 21919 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21928 "" +#line 21919 "" i__6[1] = 11, a__4[1] = "newmovement"; -#line 21928 "" +#line 21919 "" s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40); -#line 21929 "" +#line 21920 "" lnmq = 12; -#line 21930 "" +#line 21921 "" if (comget_1.movgap < 10) { -#line 21931 "" +#line 21922 "" lnmq = 14; -#line 21932 "" +#line 21923 "" s_wsfi(&io___1456); -#line 21932 "" +#line 21923 "" do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) sizeof(integer)); -#line 21932 "" +#line 21923 "" do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( integer)); -#line 21932 "" +#line 21923 "" e_wsfi(); -#line 21933 "" +#line 21924 "" } else { -#line 21934 "" +#line 21925 "" lnmq = 17; -#line 21935 "" +#line 21926 "" s_wsfi(&io___1457); -#line 21935 "" +#line 21926 "" do_fio(&c__1, "{", (ftnlen)1); -#line 21935 "" +#line 21926 "" do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) sizeof(integer)); -#line 21935 "" +#line 21926 "" do_fio(&c__1, "}", (ftnlen)1); -#line 21935 "" +#line 21926 "" do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( integer)); -#line 21935 "" +#line 21926 "" e_wsfi(); -#line 21936 "" +#line 21927 "" } -#line 21937 "" +#line 21928 "" if (comnotes_1.ninow < 10) { -#line 21938 "" +#line 21929 "" ++lnmq; -#line 21939 "" +#line 21930 "" ici__1.icierr = 0; -#line 21939 "" +#line 21930 "" ici__1.icirnum = 1; -#line 21939 "" +#line 21930 "" ici__1.icirlen = 1; -#line 21939 "" +#line 21930 "" ici__1.iciunit = nmq + (lnmq - 1); -#line 21939 "" +#line 21930 "" ici__1.icifmt = "(i1)"; -#line 21939 "" +#line 21930 "" s_wsfi(&ici__1); -#line 21939 "" +#line 21930 "" do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) sizeof(integer)); -#line 21939 "" +#line 21930 "" e_wsfi(); -#line 21940 "" +#line 21931 "" } else { -#line 21941 "" +#line 21932 "" lnmq += 4; -#line 21942 "" - i__7 = lnmq - 4; -#line 21942 "" +#line 21933 "" + i__2 = lnmq - 4; +#line 21933 "" ici__1.icierr = 0; -#line 21942 "" +#line 21933 "" ici__1.icirnum = 1; -#line 21942 "" - ici__1.icirlen = lnmq - i__7; -#line 21942 "" - ici__1.iciunit = nmq + i__7; -#line 21942 "" +#line 21933 "" + ici__1.icirlen = lnmq - i__2; +#line 21933 "" + ici__1.iciunit = nmq + i__2; +#line 21933 "" ici__1.icifmt = "(a1,i2,a1)"; -#line 21942 "" +#line 21933 "" s_wsfi(&ici__1); -#line 21942 "" +#line 21933 "" do_fio(&c__1, "{", (ftnlen)1); -#line 21942 "" +#line 21933 "" do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) sizeof(integer)); -#line 21942 "" +#line 21933 "" do_fio(&c__1, "}", (ftnlen)1); -#line 21942 "" +#line 21933 "" e_wsfi(); -#line 21943 "" +#line 21934 "" } -#line 21944 "" +#line 21935 "" ++lnmq; -#line 21945 "" +#line 21936 "" ici__1.icierr = 0; -#line 21945 "" +#line 21936 "" ici__1.icirnum = 1; -#line 21945 "" +#line 21936 "" ici__1.icirlen = 1; -#line 21945 "" +#line 21936 "" ici__1.iciunit = nmq + (lnmq - 1); -#line 21945 "" +#line 21936 "" ici__1.icifmt = "(a1)"; -#line 21945 "" +#line 21936 "" s_wsfi(&ici__1); -#line 21945 "" +#line 21936 "" do_fio(&c__1, "%", (ftnlen)1); -#line 21945 "" +#line 21936 "" e_wsfi(); -#line 21946 "" +#line 21937 "" if (comshort_1.ishort == 4) { /* Ending Short-blank-coda */ -#line 21950 "" +#line 21941 "" s_wsfe(&io___1458); /* Writing concatenation */ -#line 21950 "" +#line 21941 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21950 "" +#line 21941 "" i__6[1] = 11, a__4[1] = "Endpiece}}%"; -#line 21950 "" +#line 21941 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 21950 "" +#line 21941 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 21950 "" +#line 21941 "" e_wsfe(); -#line 21951 "" +#line 21942 "" } -#line 21952 "" +#line 21943 "" s_wsfe(&io___1459); -#line 21952 "" +#line 21943 "" do_fio(&c__1, nmq, lnmq); -#line 21952 "" +#line 21943 "" e_wsfe(); -#line 21953 "" +#line 21944 "" if (comshort_1.ishort == 2) { -#line 21954 "" +#line 21945 "" s_wsfe(&io___1460); /* Writing concatenation */ -#line 21954 "" +#line 21945 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21954 "" +#line 21945 "" i__6[1] = 12, a__4[1] = "stoppiece}}%"; -#line 21954 "" +#line 21945 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); -#line 21954 "" +#line 21945 "" do_fio(&c__1, ch__17, (ftnlen)13); -#line 21954 "" +#line 21945 "" e_wsfe(); -#line 21955 "" +#line 21946 "" comshort_1.ishort = 5; -#line 21956 "" +#line 21947 "" } else if (comshort_1.ishort == 4) { -#line 21957 "" +#line 21948 "" s_wsfe(&io___1461); /* Writing concatenation */ -#line 21957 "" +#line 21948 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 21957 "" +#line 21948 "" i__4[1] = 3, a__2[1] = "let"; -#line 21957 "" +#line 21948 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 21957 "" +#line 21948 "" i__4[3] = 9, a__2[3] = "stoppiece"; -#line 21957 "" +#line 21948 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 21957 "" +#line 21948 "" i__4[5] = 9, a__2[5] = "holdstop%"; -#line 21957 "" +#line 21948 "" s_cat(ch__24, a__2, i__4, &c__6, (ftnlen)24); -#line 21957 "" +#line 21948 "" do_fio(&c__1, ch__24, (ftnlen)24); -#line 21957 "" +#line 21948 "" e_wsfe(); /* Since we bypass newmovement, need to set the vertical gap. */ -#line 21962 "" +#line 21953 "" if (comget_1.movgap > 10) { -#line 21963 "" +#line 21954 "" s_wsfe(&io___1462); /* Writing concatenation */ -#line 21963 "" +#line 21954 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21963 "" +#line 21954 "" i__6[1] = 5, a__4[1] = "vskip"; -#line 21963 "" +#line 21954 "" s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6); -#line 21963 "" +#line 21954 "" do_fio(&c__1, ch__25, (ftnlen)6); -#line 21963 "" +#line 21954 "" do_fio(&c__1, (char *)&comget_1.movgap, ( ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 21963 "" +#line 21954 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 21963 "" +#line 21954 "" i__11[1] = 10, a__8[1] = "internote%"; -#line 21963 "" +#line 21954 "" s_cat(ch__15, a__8, i__11, &c__2, (ftnlen)11); -#line 21963 "" +#line 21954 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 21963 "" +#line 21954 "" e_wsfe(); -#line 21965 "" +#line 21956 "" } else if (comget_1.movgap > 0) { -#line 21966 "" +#line 21957 "" s_wsfe(&io___1463); /* Writing concatenation */ -#line 21966 "" +#line 21957 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21966 "" +#line 21957 "" i__6[1] = 5, a__4[1] = "vskip"; -#line 21966 "" +#line 21957 "" s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6); -#line 21966 "" +#line 21957 "" do_fio(&c__1, ch__25, (ftnlen)6); -#line 21966 "" +#line 21957 "" do_fio(&c__1, (char *)&comget_1.movgap, ( ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 21966 "" +#line 21957 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 21966 "" +#line 21957 "" i__11[1] = 10, a__8[1] = "internote%"; -#line 21966 "" +#line 21957 "" s_cat(ch__15, a__8, i__11, &c__2, (ftnlen)11); -#line 21966 "" +#line 21957 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 21966 "" +#line 21957 "" e_wsfe(); -#line 21968 "" +#line 21959 "" } -#line 21969 "" +#line 21960 "" comshort_1.ishort = 6; -#line 21970 "" +#line 21961 "" } -#line 21971 "" +#line 21962 "" if ((comshort_1.ishort == 5 || comshort_1.ishort == 6) && ! comnvi_1.rename) { -#line 21972 "" - i__7 = comnotes_1.ninow; -#line 21972 "" - for (iinst = 1; iinst <= i__7; ++iinst) { -#line 21973 "" +#line 21963 "" + i__2 = comnotes_1.ninow; +#line 21963 "" + for (iinst = 1; iinst <= i__2; ++iinst) { +#line 21964 "" if (comlast_1.islast) { -#line 21974 "" +#line 21965 "" if (iinst < 10) { -#line 21975 "" +#line 21966 "" s_wsfe(&io___1464); /* Writing concatenation */ -#line 21975 "" +#line 21966 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21975 "" +#line 21966 "" i__6[1] = 7, a__4[1] = "setname"; -#line 21975 "" +#line 21966 "" s_cat(ch__8, a__4, i__6, &c__2, ( ftnlen)8); -#line 21975 "" +#line 21966 "" do_fio(&c__1, ch__8, (ftnlen)8); -#line 21975 "" +#line 21966 "" do_fio(&c__1, (char *)&iinst, (ftnlen) sizeof(integer)); -#line 21975 "" +#line 21966 "" do_fio(&c__1, "{}%", (ftnlen)3); -#line 21975 "" +#line 21966 "" e_wsfe(); -#line 21976 "" +#line 21967 "" } else { -#line 21977 "" +#line 21968 "" s_wsfe(&io___1465); /* Writing concatenation */ -#line 21977 "" +#line 21968 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 21977 "" +#line 21968 "" i__6[1] = 8, a__4[1] = "setname{"; -#line 21977 "" +#line 21968 "" s_cat(ch__18, a__4, i__6, &c__2, ( ftnlen)9); -#line 21977 "" +#line 21968 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 21977 "" +#line 21968 "" do_fio(&c__1, (char *)&iinst, (ftnlen) sizeof(integer)); -#line 21977 "" +#line 21968 "" do_fio(&c__1, "}{}%", (ftnlen)4); -#line 21977 "" +#line 21968 "" e_wsfe(); -#line 21979 "" +#line 21970 "" } -#line 21980 "" +#line 21971 "" } -#line 21981 "" +#line 21972 "" /* L62: */ -#line 21981 "" +#line 21972 "" } -#line 21982 "" +#line 21973 "" } -#line 21983 "" +#line 21974 "" comnvi_1.rename = FALSE_; -#line 21984 "" +#line 21975 "" } /* Change generalmeter if necessary */ -#line 21988 "" +#line 21979 "" if (comlast_1.islast) { -#line 21989 "" +#line 21980 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 21990 "" +#line 21981 "" } -#line 21991 "" - all_1.mtrnuml = 0; +/* Removed next line 211207 to fix beaming problem at new movement+meter change. */ +/* mtrnuml = 0 */ /* (Moved all name-writing to getnote, right when 'M' is detected) */ -#line 21995 "" +#line 21987 "" if (bit_test(iplnow,28)) { /* Key signature at movement break */ -#line 21999 "" +#line 21991 "" iplnow = bit_clear(iplnow,28); -#line 22000 "" +#line 21992 "" if (comtop_1.isig > 0) { -#line 22001 "" +#line 21993 "" if (comlast_1.islast) { -#line 22001 "" +#line 21993 "" s_wsfe(&io___1466); /* Writing concatenation */ -#line 22001 "" +#line 21993 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22001 "" +#line 21993 "" i__6[1] = 17, a__4[1] = "generalsignature{"; -#line 22001 "" +#line 21993 "" s_cat(ch__26, a__4, i__6, &c__2, (ftnlen)18); -#line 22001 "" +#line 21993 "" do_fio(&c__1, ch__26, (ftnlen)18); -#line 22001 "" +#line 21993 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) sizeof(integer)); -#line 22001 "" +#line 21993 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 22001 "" +#line 21993 "" e_wsfe(); -#line 22001 "" +#line 21993 "" } -#line 22003 "" +#line 21995 "" } else { -#line 22004 "" +#line 21996 "" if (comlast_1.islast) { -#line 22004 "" +#line 21996 "" s_wsfe(&io___1467); /* Writing concatenation */ -#line 22004 "" +#line 21996 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22004 "" +#line 21996 "" i__6[1] = 17, a__4[1] = "generalsignature{"; -#line 22004 "" +#line 21996 "" s_cat(ch__26, a__4, i__6, &c__2, (ftnlen)18); -#line 22004 "" +#line 21996 "" do_fio(&c__1, ch__26, (ftnlen)18); -#line 22004 "" +#line 21996 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) sizeof(integer)); -#line 22004 "" +#line 21996 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 22004 "" +#line 21996 "" e_wsfe(); -#line 22004 "" +#line 21996 "" } -#line 22006 "" +#line 21998 "" } -#line 22007 "" +#line 21999 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { -#line 22008 "" +#line 22000 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); -#line 22010 "" +#line 22002 "" } -#line 22011 "" +#line 22003 "" } -#line 22012 "" +#line 22004 "" if (comget_1.parmov >= -.1f) { /* Resent paragraph indentation */ -#line 22016 "" +#line 22008 "" ipi = comget_1.parmov * comtop_1.widthpt + .1f; -#line 22017 "" +#line 22009 "" if (ipi < 10) { -#line 22018 "" +#line 22010 "" if (comlast_1.islast) { -#line 22018 "" +#line 22010 "" s_wsfe(&io___1469); /* Writing concatenation */ -#line 22018 "" +#line 22010 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22018 "" +#line 22010 "" i__6[1] = 10, a__4[1] = "parindent "; -#line 22018 "" +#line 22010 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22018 "" +#line 22010 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22018 "" +#line 22010 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); -#line 22018 "" +#line 22010 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 22018 "" +#line 22010 "" e_wsfe(); -#line 22018 "" +#line 22010 "" } -#line 22020 "" +#line 22012 "" } else if (ipi < 100) { -#line 22021 "" +#line 22013 "" if (comlast_1.islast) { -#line 22021 "" +#line 22013 "" s_wsfe(&io___1470); /* Writing concatenation */ -#line 22021 "" +#line 22013 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22021 "" +#line 22013 "" i__6[1] = 10, a__4[1] = "parindent "; -#line 22021 "" +#line 22013 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22021 "" +#line 22013 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22021 "" +#line 22013 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); -#line 22021 "" +#line 22013 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 22021 "" +#line 22013 "" e_wsfe(); -#line 22021 "" +#line 22013 "" } -#line 22023 "" +#line 22015 "" } else { -#line 22024 "" +#line 22016 "" if (comlast_1.islast) { -#line 22024 "" +#line 22016 "" s_wsfe(&io___1471); /* Writing concatenation */ -#line 22024 "" +#line 22016 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22024 "" +#line 22016 "" i__6[1] = 10, a__4[1] = "parindent "; -#line 22024 "" +#line 22016 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22024 "" +#line 22016 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22024 "" +#line 22016 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); -#line 22024 "" +#line 22016 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 22024 "" +#line 22016 "" e_wsfe(); -#line 22024 "" +#line 22016 "" } -#line 22026 "" +#line 22018 "" } -#line 22027 "" +#line 22019 "" } -#line 22028 "" +#line 22020 "" if (comshort_1.ishort == 6) { -#line 22029 "" +#line 22021 "" if (iflagbot == 1) { -#line 22030 "" +#line 22022 "" s_wsfe(&io___1472); /* Writing concatenation */ -#line 22030 "" +#line 22022 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22030 "" +#line 22022 "" i__5[1] = 5, a__3[1] = "vfill"; -#line 22030 "" +#line 22022 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22030 "" +#line 22022 "" i__5[3] = 5, a__3[3] = "eject"; -#line 22030 "" +#line 22022 "" s_cat(ch__14, a__3, i__5, &c__4, (ftnlen)12); -#line 22030 "" +#line 22022 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22030 "" +#line 22022 "" e_wsfe(); /* iflagbot = 0 */ /* ishort = 0 */ -#line 22033 "" +#line 22025 "" } else { -#line 22034 "" +#line 22026 "" s_wsfe(&io___1473); /* Writing concatenation */ -#line 22034 "" +#line 22026 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22034 "" +#line 22026 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22034 "" +#line 22026 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22034 "" +#line 22026 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22034 "" +#line 22026 "" e_wsfe(); -#line 22035 "" +#line 22027 "" } /* Zero ishort later trying to write alaligne */ -#line 22039 "" +#line 22031 "" } -#line 22040 "" +#line 22032 "" } /* End of movement break stuff */ -#line 22041 "" +#line 22033 "" if (isystpg == 1) { /* First line on a page (not 1st page, still first bar). Tidy up old page */ @@ -52946,307 +53219,307 @@ L51: /* Check for meter change at start of a new PAGE */ -#line 22056 "" +#line 22048 "" if (all_1.mtrnuml > 0) { /* Meter change at start of a new page. Ugly repeated coding here. */ -#line 22060 "" +#line 22052 "" mtrnms = all_1.mtrnuml; -#line 22061 "" +#line 22053 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); -#line 22062 "" +#line 22054 "" all_1.mtrnuml = mtrnms; -#line 22063 "" +#line 22055 "" if (comget_1.movbrk == 0 && comlast_1.islast) { -#line 22064 "" +#line 22056 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22065 "" +#line 22057 "" } -#line 22066 "" +#line 22058 "" } /* Key signature change? */ -#line 22070 "" +#line 22062 "" if (bit_test(iplnow,28) && comget_1.movbrk == 0) { /* Writing concatenation */ -#line 22071 "" +#line 22063 "" i__14[0] = 1, a__10[0] = all_1.sq; -#line 22071 "" +#line 22063 "" i__14[1] = 4, a__10[1] = "xbar"; -#line 22071 "" +#line 22063 "" i__14[2] = 1, a__10[2] = all_1.sq; -#line 22071 "" +#line 22063 "" i__14[3] = 10, a__10[3] = "addspace{-"; -#line 22071 "" +#line 22063 "" i__14[4] = 1, a__10[4] = all_1.sq; -#line 22071 "" +#line 22063 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; -#line 22071 "" +#line 22063 "" i__14[6] = 1, a__10[6] = all_1.sq; -#line 22071 "" +#line 22063 "" i__14[7] = 17, a__10[7] = "generalsignature{"; -#line 22071 "" +#line 22063 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); -#line 22073 "" +#line 22065 "" lnote = 49; -#line 22074 "" +#line 22066 "" if (comtop_1.isig < 0) { /* Writing concatenation */ -#line 22075 "" +#line 22067 "" i__6[0] = 49, a__4[0] = notexq; -#line 22075 "" +#line 22067 "" i__6[1] = 1, a__4[1] = "-"; -#line 22075 "" +#line 22067 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 22076 "" +#line 22068 "" lnote = 50; -#line 22077 "" +#line 22069 "" } -#line 22078 "" +#line 22070 "" if (comlast_1.islast) { -#line 22078 "" +#line 22070 "" s_wsfe(&io___1475); /* Writing concatenation */ -#line 22078 "" +#line 22070 "" i__8[0] = lnote, a__5[0] = notexq; -#line 22078 "" - i__7 = abs(comtop_1.isig) + 48; -#line 22078 "" - chax_(ch__1, (ftnlen)1, &i__7); -#line 22078 "" +#line 22070 "" + i__2 = abs(comtop_1.isig) + 48; +#line 22070 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 22070 "" i__8[1] = 1, a__5[1] = ch__1; -#line 22078 "" +#line 22070 "" i__8[2] = 2, a__5[2] = "}%"; -#line 22078 "" +#line 22070 "" s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82); -#line 22078 "" +#line 22070 "" do_fio(&c__1, ch__27, lnote + 3); -#line 22078 "" +#line 22070 "" e_wsfe(); -#line 22078 "" +#line 22070 "" } -#line 22080 "" +#line 22072 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { -#line 22081 "" +#line 22073 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); -#line 22083 "" +#line 22075 "" } -#line 22084 "" +#line 22076 "" if (comlast_1.islast && comignorenats_1.ignorenats) { -#line 22084 "" +#line 22076 "" s_wsfe(&io___1476); /* Writing concatenation */ -#line 22084 "" +#line 22076 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22084 "" +#line 22076 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22084 "" +#line 22076 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22084 "" +#line 22076 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22084 "" +#line 22076 "" e_wsfe(); -#line 22084 "" +#line 22076 "" } -#line 22086 "" +#line 22078 "" if (comlast_1.islast) { -#line 22086 "" +#line 22078 "" s_wsfe(&io___1477); /* Writing concatenation */ -#line 22086 "" +#line 22078 "" i__9[0] = 1, a__6[0] = all_1.sq; -#line 22086 "" +#line 22078 "" i__9[1] = 14, a__6[1] = "zchangecontext"; -#line 22086 "" +#line 22078 "" i__9[2] = 1, a__6[2] = all_1.sq; -#line 22086 "" +#line 22078 "" i__9[3] = 10, a__6[3] = "addspace{-"; -#line 22086 "" +#line 22078 "" i__9[4] = 1, a__6[4] = all_1.sq; -#line 22086 "" +#line 22078 "" i__9[5] = 14, a__6[5] = "afterruleskip}"; -#line 22086 "" +#line 22078 "" i__9[6] = 1, a__6[6] = all_1.sq; -#line 22086 "" +#line 22078 "" i__9[7] = 10, a__6[7] = "zstoppiece"; -#line 22086 "" +#line 22078 "" i__9[8] = 1, a__6[8] = all_1.sq; -#line 22086 "" +#line 22078 "" i__9[9] = 13, a__6[9] = "PMXbarnotrue%"; -#line 22086 "" +#line 22078 "" s_cat(ch__28, a__6, i__9, &c__10, (ftnlen)66); -#line 22086 "" +#line 22078 "" do_fio(&c__1, ch__28, (ftnlen)66); -#line 22086 "" +#line 22078 "" e_wsfe(); -#line 22086 "" +#line 22078 "" } -#line 22089 "" +#line 22081 "" } else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) { /* Meter change but no signature change */ -#line 22093 "" +#line 22085 "" if (comlast_1.islast) { -#line 22093 "" +#line 22085 "" s_wsfe(&io___1478); /* Writing concatenation */ -#line 22093 "" +#line 22085 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[1] = 14, a__1[1] = "xchangecontext"; -#line 22093 "" +#line 22085 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[3] = 10, a__1[3] = "addspace{-"; -#line 22093 "" +#line 22085 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; -#line 22093 "" +#line 22085 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[7] = 3, a__1[7] = "let"; -#line 22093 "" +#line 22085 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[9] = 4, a__1[9] = "bnat"; -#line 22093 "" +#line 22085 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 22093 "" +#line 22085 "" i__3[11] = 9, a__1[11] = "barnoadd%"; -#line 22093 "" +#line 22085 "" s_cat(ch__29, a__1, i__3, &c__12, (ftnlen)60); -#line 22093 "" +#line 22085 "" do_fio(&c__1, ch__29, (ftnlen)60); -#line 22093 "" +#line 22085 "" e_wsfe(); -#line 22093 "" +#line 22085 "" } -#line 22097 "" +#line 22089 "" if (comlast_1.islast) { -#line 22097 "" +#line 22089 "" s_wsfe(&io___1479); /* Writing concatenation */ -#line 22097 "" +#line 22089 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[1] = 3, a__1[1] = "def"; -#line 22097 "" +#line 22089 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[3] = 9, a__1[3] = "barnoadd{"; -#line 22097 "" +#line 22089 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[5] = 3, a__1[5] = "let"; -#line 22097 "" +#line 22089 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[7] = 8, a__1[7] = "barnoadd"; -#line 22097 "" +#line 22089 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[9] = 5, a__1[9] = "bnat}"; -#line 22097 "" +#line 22089 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 22097 "" +#line 22089 "" i__3[11] = 11, a__1[11] = "zstoppiece%"; -#line 22097 "" +#line 22089 "" s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)45); -#line 22097 "" +#line 22089 "" do_fio(&c__1, ch__30, (ftnlen)45); -#line 22097 "" +#line 22089 "" e_wsfe(); -#line 22097 "" +#line 22089 "" } -#line 22100 "" +#line 22092 "" } else { -#line 22101 "" +#line 22093 "" if (comlast_1.islast) { -#line 22102 "" +#line 22094 "" if ((comshort_1.ishort == 4 || comshort_1.ishort == 2) && iflagbot == 1) { -#line 22104 "" +#line 22096 "" ntmp = combibarcnt_1.ibarcnt - ibarcnt0 - comshort_1.nmbr + comshort_1.mbrsum; -#line 22105 "" +#line 22097 "" if (ntmp <= 9) { -#line 22106 "" +#line 22098 "" *(unsigned char *)shortfraq = (char) ( ntmp + 48); -#line 22107 "" +#line 22099 "" lntmp = 1; -#line 22108 "" +#line 22100 "" } else { -#line 22109 "" +#line 22101 "" s_wsfi(&io___1484); -#line 22109 "" +#line 22101 "" do_fio(&c__1, (char *)&ntmp, (ftnlen) sizeof(integer)); -#line 22109 "" +#line 22101 "" e_wsfi(); -#line 22110 "" +#line 22102 "" lntmp = 2; -#line 22111 "" +#line 22103 "" } -#line 22112 "" +#line 22104 "" s_wsfe(&io___1485); /* Writing concatenation */ -#line 22112 "" +#line 22104 "" i__15[0] = 1, a__11[0] = all_1.sq; -#line 22112 "" +#line 22104 "" i__15[1] = 10, a__11[1] = "endpiece}}"; -#line 22112 "" +#line 22104 "" i__15[2] = 1, a__11[2] = all_1.sq; -#line 22112 "" +#line 22104 "" i__15[3] = 7, a__11[3] = "advance"; -#line 22112 "" +#line 22104 "" i__15[4] = 1, a__11[4] = all_1.sq; -#line 22112 "" +#line 22104 "" i__15[5] = 5, a__11[5] = "barno"; -#line 22112 "" +#line 22104 "" i__15[6] = lntmp, a__11[6] = shortfraq; -#line 22112 "" +#line 22104 "" s_cat(ch__31, a__11, i__15, &c__7, (ftnlen)28) ; -#line 22112 "" +#line 22104 "" do_fio(&c__1, ch__31, lntmp + 25); -#line 22112 "" +#line 22104 "" e_wsfe(); /* Move down so can insert fil@begin */ /* iflagbot = 0 */ /* ishort = 0 */ -#line 22119 "" +#line 22111 "" } else if (comshort_1.ishort != 6 && comshort_1.ishort != 2 || iflagbot != 1) { -#line 22121 "" +#line 22113 "" s_wsfe(&io___1486); /* Writing concatenation */ -#line 22121 "" +#line 22113 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22121 "" +#line 22113 "" i__6[1] = 10, a__4[1] = "stoppiece%"; -#line 22121 "" +#line 22113 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22121 "" +#line 22113 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22121 "" +#line 22113 "" e_wsfe(); -#line 22122 "" +#line 22114 "" } -#line 22123 "" +#line 22115 "" } -#line 22124 "" +#line 22116 "" } /* This is the key spot when vshrink is used. Value of vshrink here comes from */ @@ -53260,1211 +53533,1211 @@ L51: /* second pass, vshrink at top of page one is dealt with in topfile, which is called */ /* *before* any reading in any "Av" at the top of the first input block. */ -#line 22137 "" +#line 22129 "" if (! vshrink) { -#line 22138 "" +#line 22130 "" if (comlast_1.islast && combottop_1.bottopgap) { -#line 22139 "" +#line 22131 "" if (dabs(combottop_1.botamt) > 1e-6f) { -#line 22140 "" +#line 22132 "" if (combottop_1.botamt > 9.95f) { -#line 22141 "" +#line 22133 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22142 "" +#line 22134 "" } else if (combottop_1.botamt > 0.f) { -#line 22143 "" +#line 22135 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22144 "" +#line 22136 "" } else if (combottop_1.botamt > -9.95f) { -#line 22145 "" +#line 22137 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22146 "" +#line 22138 "" } else { -#line 22147 "" +#line 22139 "" s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22148 "" +#line 22140 "" } -#line 22149 "" +#line 22141 "" s_wsfe(&io___1487); /* Writing concatenation */ -#line 22149 "" +#line 22141 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22149 "" +#line 22141 "" i__5[1] = 4, a__3[1] = "null"; -#line 22149 "" +#line 22141 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22149 "" +#line 22141 "" i__5[3] = 5, a__3[3] = "vskip"; -#line 22149 "" +#line 22141 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 22149 "" +#line 22141 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22149 "" +#line 22141 "" do_fio(&c__1, (char *)&combottop_1.botamt, ( ftnlen)sizeof(real)); /* Writing concatenation */ -#line 22149 "" +#line 22141 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22149 "" +#line 22141 "" i__6[1] = 10, a__4[1] = "Internote%"; -#line 22149 "" +#line 22141 "" s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11); -#line 22149 "" +#line 22141 "" do_fio(&c__1, ch__32, (ftnlen)11); -#line 22149 "" +#line 22141 "" e_wsfe(); -#line 22151 "" +#line 22143 "" } -#line 22152 "" +#line 22144 "" } -#line 22153 "" +#line 22145 "" xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop; -#line 22154 "" +#line 22146 "" if (xnstbot < 9.95f) { -#line 22155 "" +#line 22147 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10) ; -#line 22156 "" +#line 22148 "" } else { -#line 22157 "" +#line 22149 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10) ; -#line 22158 "" +#line 22150 "" } -#line 22159 "" +#line 22151 "" if (comlast_1.islast) { -#line 22159 "" +#line 22151 "" s_wsfe(&io___1489); /* Writing concatenation */ -#line 22159 "" +#line 22151 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22159 "" +#line 22151 "" i__6[1] = 5, a__4[1] = "vskip"; -#line 22159 "" +#line 22151 "" s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6); -#line 22159 "" +#line 22151 "" do_fio(&c__1, ch__25, (ftnlen)6); -#line 22159 "" +#line 22151 "" do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof( real)); /* Writing concatenation */ -#line 22159 "" +#line 22151 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22159 "" +#line 22151 "" i__5[1] = 10, a__3[1] = "Interligne"; -#line 22159 "" +#line 22151 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22159 "" +#line 22151 "" i__5[3] = 6, a__3[3] = "eject%"; -#line 22159 "" +#line 22151 "" s_cat(ch__26, a__3, i__5, &c__4, (ftnlen)18); -#line 22159 "" +#line 22151 "" do_fio(&c__1, ch__26, (ftnlen)18); -#line 22159 "" +#line 22151 "" e_wsfe(); -#line 22159 "" +#line 22151 "" } -#line 22161 "" +#line 22153 "" if (comlast_1.islast && combottop_1.bottopgap) { -#line 22162 "" +#line 22154 "" if (dabs(combottop_1.topamt) > 1e-6f) { -#line 22163 "" +#line 22155 "" if (combottop_1.topamt > 9.95f) { -#line 22164 "" +#line 22156 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22165 "" +#line 22157 "" } else if (combottop_1.topamt > 0.f) { -#line 22166 "" +#line 22158 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22167 "" +#line 22159 "" } else if (combottop_1.topamt > -9.95f) { -#line 22168 "" +#line 22160 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22169 "" +#line 22161 "" } else { -#line 22170 "" +#line 22162 "" s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, ( ftnlen)10); -#line 22171 "" +#line 22163 "" } -#line 22172 "" +#line 22164 "" s_wsfe(&io___1490); /* Writing concatenation */ -#line 22172 "" +#line 22164 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22172 "" +#line 22164 "" i__5[1] = 4, a__3[1] = "null"; -#line 22172 "" +#line 22164 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22172 "" +#line 22164 "" i__5[3] = 5, a__3[3] = "vskip"; -#line 22172 "" +#line 22164 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 22172 "" +#line 22164 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22172 "" +#line 22164 "" do_fio(&c__1, (char *)&combottop_1.topamt, ( ftnlen)sizeof(real)); /* Writing concatenation */ -#line 22172 "" +#line 22164 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22172 "" +#line 22164 "" i__6[1] = 10, a__4[1] = "Internote%"; -#line 22172 "" +#line 22164 "" s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11); -#line 22172 "" +#line 22164 "" do_fio(&c__1, ch__32, (ftnlen)11); -#line 22172 "" +#line 22164 "" e_wsfe(); -#line 22174 "" +#line 22166 "" } -#line 22175 "" +#line 22167 "" combottop_1.bottopgap = FALSE_; -#line 22176 "" +#line 22168 "" } -#line 22177 "" +#line 22169 "" } else { -#line 22178 "" +#line 22170 "" if (comlast_1.islast) { -#line 22179 "" +#line 22171 "" if (iflagbot == 1 && comshort_1.ishort == 6) { /* cleanup for case bcm only */ -#line 22183 "" +#line 22175 "" iflagbot = 0; -#line 22184 "" +#line 22176 "" comshort_1.ishort = 0; -#line 22185 "" +#line 22177 "" } else { -#line 22186 "" +#line 22178 "" s_wsfe(&io___1491); /* Writing concatenation */ -#line 22186 "" +#line 22178 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22186 "" +#line 22178 "" i__5[1] = 5, a__3[1] = "vfill"; -#line 22186 "" +#line 22178 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22186 "" +#line 22178 "" i__5[3] = 6, a__3[3] = "eject%"; -#line 22186 "" +#line 22178 "" s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)13); -#line 22186 "" +#line 22178 "" do_fio(&c__1, ch__17, (ftnlen)13); -#line 22186 "" +#line 22178 "" e_wsfe(); -#line 22187 "" +#line 22179 "" if (iflagbot == 1 && comshort_1.ishort == 2) { /* Clean up case bsl only */ -#line 22189 "" +#line 22181 "" s_wsfe(&io___1492); /* Writing concatenation */ -#line 22189 "" +#line 22181 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22189 "" +#line 22181 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22189 "" +#line 22181 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22189 "" +#line 22181 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22189 "" +#line 22181 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22189 "" +#line 22181 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22189 "" +#line 22181 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen) 35); -#line 22189 "" +#line 22181 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22189 "" +#line 22181 "" e_wsfe(); -#line 22191 "" +#line 22183 "" iflagbot = 0; -#line 22192 "" +#line 22184 "" comshort_1.ishort = 0; -#line 22193 "" +#line 22185 "" } -#line 22194 "" +#line 22186 "" } -#line 22195 "" +#line 22187 "" } -#line 22196 "" +#line 22188 "" } -#line 22197 "" +#line 22189 "" ++comnotes_1.ipage; /* Now that page is ejected, compute new vshrink */ -#line 22201 "" +#line 22193 "" vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f && comlast_1.usevshrink; -#line 22202 "" +#line 22194 "" if (vshrink) { -#line 22203 "" +#line 22195 "" comarp_1.xinsnow = 10.f; -#line 22204 "" +#line 22196 "" } else { -#line 22205 "" +#line 22197 "" comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1]; -#line 22206 "" +#line 22198 "" } -#line 22207 "" +#line 22199 "" if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) { -#line 22208 "" +#line 22200 "" comarp_1.xinsnow = comarp_1.xinsnow * comget_1.fintstf / comget_1.gintstf; -#line 22209 "" +#line 22201 "" comget_1.fintstf = -1.f; -#line 22210 "" +#line 22202 "" } -#line 22211 "" +#line 22203 "" if (comarp_1.xinsnow < 9.95f) { -#line 22212 "" +#line 22204 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); -#line 22213 "" +#line 22205 "" } else if (comarp_1.xinsnow < 99.95f) { -#line 22214 "" +#line 22206 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); -#line 22215 "" +#line 22207 "" } else { -#line 22216 "" +#line 22208 "" s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10); -#line 22217 "" +#line 22209 "" } /* Vertical spacing parameters, then restart */ -#line 22221 "" +#line 22213 "" if (comis4bignv_1.is4bignv) { -#line 22221 "" +#line 22213 "" comarp_1.xinsnow *= .95f; -#line 22221 "" +#line 22213 "" } -#line 22222 "" +#line 22214 "" if (comlast_1.islast) { -#line 22223 "" +#line 22215 "" s_wsfe(&io___1493); /* Writing concatenation */ -#line 22223 "" +#line 22215 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22223 "" +#line 22215 "" i__6[1] = 11, a__4[1] = "interstaff{"; -#line 22223 "" +#line 22215 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22223 "" +#line 22215 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22223 "" +#line 22215 "" do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen) sizeof(real)); /* Writing concatenation */ -#line 22223 "" +#line 22215 "" i__8[0] = 1, a__5[0] = "}"; -#line 22223 "" +#line 22215 "" i__8[1] = 1, a__5[1] = all_1.sq; -#line 22223 "" +#line 22215 "" i__8[2] = 9, a__5[2] = "contpiece"; -#line 22223 "" +#line 22215 "" s_cat(ch__15, a__5, i__8, &c__3, (ftnlen)11); -#line 22223 "" +#line 22215 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22223 "" +#line 22215 "" e_wsfe(); -#line 22225 "" +#line 22217 "" } /* Check for meter change at start of a new PAGE */ -#line 22229 "" +#line 22221 "" if (all_1.mtrnuml > 0) { /* Meter change at start of a new page */ -#line 22233 "" +#line 22225 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); -#line 22234 "" +#line 22226 "" if (comget_1.movbrk == 0) { -#line 22235 "" +#line 22227 "" if (comlast_1.islast) { -#line 22236 "" +#line 22228 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22237 "" +#line 22229 "" } -#line 22238 "" +#line 22230 "" if (all_1.mtrdnp > 0) { -#line 22239 "" +#line 22231 "" if (comlast_1.islast) { -#line 22239 "" +#line 22231 "" s_wsfe(&io___1494); /* Writing concatenation */ -#line 22239 "" +#line 22231 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22239 "" +#line 22231 "" i__6[1] = 10, a__4[1] = "newtimes2%"; -#line 22239 "" +#line 22231 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen) 11); -#line 22239 "" +#line 22231 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22239 "" +#line 22231 "" e_wsfe(); -#line 22239 "" +#line 22231 "" } -#line 22240 "" +#line 22232 "" if (all_1.ibar == comgrace_1.ibarmbr) { -#line 22240 "" +#line 22232 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 22240 "" +#line 22232 "" } -#line 22241 "" +#line 22233 "" } -#line 22242 "" +#line 22234 "" } -#line 22243 "" +#line 22235 "" } /* If no real titles here, which there probably will never be, make vertical */ /* space at page top with \titles{...}. headlog=.false.<=>no real titles */ -#line 22248 "" +#line 22240 "" if (comshort_1.ishort == 4 && iflagbot == 1) { -#line 22249 "" +#line 22241 "" comshort_1.ishort = 0; -#line 22250 "" +#line 22242 "" iflagbot = 0; -#line 22251 "" +#line 22243 "" s_wsfe(&io___1495); /* Writing concatenation */ -#line 22251 "" +#line 22243 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22251 "" +#line 22243 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22251 "" +#line 22243 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22251 "" +#line 22243 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22251 "" +#line 22243 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22251 "" +#line 22243 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22251 "" +#line 22243 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22251 "" +#line 22243 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22251 "" +#line 22243 "" e_wsfe(); -#line 22253 "" +#line 22245 "" } -#line 22254 "" +#line 22246 "" puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], & etatop, all_1.sq, &etait, &etatc, &etacs1, & all_1.nv, &vshrink, all_1.sepsymq, (ftnlen)1, ( ftnlen)1); -#line 22256 "" +#line 22248 "" if (comnotes_1.headerspecial) { -#line 22256 "" +#line 22248 "" s_wsfe(&io___1496); /* Writing concatenation */ -#line 22256 "" +#line 22248 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 22256 "" +#line 22248 "" i__6[0] = 1, a__4[0] = ch__1; -#line 22256 "" +#line 22248 "" i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%" ; -#line 22256 "" +#line 22248 "" s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); -#line 22256 "" +#line 22248 "" do_fio(&c__1, ch__7, (ftnlen)29); -#line 22256 "" +#line 22248 "" e_wsfe(); -#line 22256 "" +#line 22248 "" } /* Write special header for first page */ -#line 22261 "" +#line 22253 "" } else { /* First bar of system, not a new page, force line break */ -#line 22265 "" +#line 22257 "" if (bit_test(iplnow,28)) { /* Signature change */ /* Writing concatenation */ -#line 22269 "" +#line 22261 "" i__14[0] = 1, a__10[0] = all_1.sq; -#line 22269 "" +#line 22261 "" i__14[1] = 4, a__10[1] = "xbar"; -#line 22269 "" +#line 22261 "" i__14[2] = 1, a__10[2] = all_1.sq; -#line 22269 "" +#line 22261 "" i__14[3] = 10, a__10[3] = "addspace{-"; -#line 22269 "" +#line 22261 "" i__14[4] = 1, a__10[4] = all_1.sq; -#line 22269 "" +#line 22261 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; -#line 22269 "" +#line 22261 "" i__14[6] = 1, a__10[6] = all_1.sq; -#line 22269 "" +#line 22261 "" i__14[7] = 17, a__10[7] = "generalsignature{"; -#line 22269 "" +#line 22261 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); -#line 22271 "" +#line 22263 "" lnote = 49; -#line 22272 "" +#line 22264 "" if (comtop_1.isig < 0) { /* Writing concatenation */ -#line 22273 "" +#line 22265 "" i__6[0] = 49, a__4[0] = notexq; -#line 22273 "" +#line 22265 "" i__6[1] = 1, a__4[1] = "-"; -#line 22273 "" +#line 22265 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 22274 "" +#line 22266 "" lnote = 50; -#line 22275 "" +#line 22267 "" } -#line 22276 "" +#line 22268 "" if (comlast_1.islast) { -#line 22276 "" +#line 22268 "" s_wsfe(&io___1497); /* Writing concatenation */ -#line 22276 "" +#line 22268 "" i__8[0] = lnote, a__5[0] = notexq; -#line 22276 "" - i__7 = abs(comtop_1.isig) + 48; -#line 22276 "" - chax_(ch__1, (ftnlen)1, &i__7); -#line 22276 "" +#line 22268 "" + i__2 = abs(comtop_1.isig) + 48; +#line 22268 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 22268 "" i__8[1] = 1, a__5[1] = ch__1; -#line 22276 "" +#line 22268 "" i__8[2] = 2, a__5[2] = "}%"; -#line 22276 "" +#line 22268 "" s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82); -#line 22276 "" +#line 22268 "" do_fio(&c__1, ch__27, lnote + 3); -#line 22276 "" +#line 22268 "" e_wsfe(); -#line 22276 "" +#line 22268 "" } -#line 22278 "" +#line 22270 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { -#line 22279 "" +#line 22271 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); -#line 22281 "" +#line 22273 "" } -#line 22282 "" +#line 22274 "" if (comlast_1.islast) { -#line 22282 "" +#line 22274 "" s_wsfe(&io___1498); /* Writing concatenation */ -#line 22282 "" +#line 22274 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22282 "" +#line 22274 "" i__5[1] = 7, a__3[1] = "advance"; -#line 22282 "" +#line 22274 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22282 "" +#line 22274 "" i__5[3] = 8, a__3[3] = "barno-1%"; -#line 22282 "" +#line 22274 "" s_cat(ch__13, a__3, i__5, &c__4, (ftnlen)17); -#line 22282 "" +#line 22274 "" do_fio(&c__1, ch__13, (ftnlen)17); -#line 22282 "" +#line 22274 "" e_wsfe(); -#line 22282 "" +#line 22274 "" } -#line 22283 "" +#line 22275 "" if (all_1.mtrnuml != 0) { /* Meter+sig change, new line, may need mods if movement break here. */ -#line 22287 "" +#line 22279 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); -#line 22288 "" +#line 22280 "" if (comlast_1.islast) { -#line 22289 "" +#line 22281 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22290 "" +#line 22282 "" if (comignorenats_1.ignorenats) { -#line 22290 "" +#line 22282 "" s_wsfe(&io___1499); /* Writing concatenation */ -#line 22290 "" +#line 22282 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22290 "" +#line 22282 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22290 "" +#line 22282 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); -#line 22290 "" +#line 22282 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22290 "" +#line 22282 "" e_wsfe(); -#line 22290 "" +#line 22282 "" } -#line 22291 "" +#line 22283 "" s_wsfe(&io___1500); /* Writing concatenation */ -#line 22291 "" +#line 22283 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[1] = 14, a__1[1] = "xchangecontext"; -#line 22291 "" +#line 22283 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[3] = 10, a__1[3] = "addspace{-"; -#line 22291 "" +#line 22283 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; -#line 22291 "" +#line 22283 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[7] = 10, a__1[7] = "zstoppiece"; -#line 22291 "" +#line 22283 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[9] = 12, a__1[9] = "PMXbarnotrue"; -#line 22291 "" +#line 22283 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 22291 "" +#line 22283 "" i__3[11] = 10, a__1[11] = "contpiece%"; -#line 22291 "" +#line 22283 "" s_cat(ch__33, a__1, i__3, &c__12, (ftnlen)76); -#line 22291 "" +#line 22283 "" do_fio(&c__1, ch__33, (ftnlen)76); -#line 22291 "" +#line 22283 "" e_wsfe(); -#line 22294 "" +#line 22286 "" s_wsfe(&io___1501); /* Writing concatenation */ -#line 22294 "" +#line 22286 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22294 "" +#line 22286 "" i__5[1] = 10, a__3[1] = "addspace{-"; -#line 22294 "" +#line 22286 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22294 "" +#line 22286 "" i__5[3] = 15, a__3[3] = "afterruleskip}%"; -#line 22294 "" +#line 22286 "" s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); -#line 22294 "" +#line 22286 "" do_fio(&c__1, ch__5, (ftnlen)27); -#line 22294 "" +#line 22286 "" e_wsfe(); -#line 22296 "" +#line 22288 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22297 "" +#line 22289 "" if (comignorenats_1.ignorenats) { -#line 22297 "" +#line 22289 "" s_wsfe(&io___1502); /* Writing concatenation */ -#line 22297 "" +#line 22289 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22297 "" +#line 22289 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22297 "" +#line 22289 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); -#line 22297 "" +#line 22289 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22297 "" +#line 22289 "" e_wsfe(); -#line 22297 "" +#line 22289 "" } -#line 22298 "" +#line 22290 "" s_wsfe(&io___1503); /* Writing concatenation */ -#line 22298 "" +#line 22290 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22298 "" +#line 22290 "" i__6[1] = 14, a__4[1] = "zchangecontext"; -#line 22298 "" +#line 22290 "" s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); -#line 22298 "" +#line 22290 "" do_fio(&c__1, ch__16, (ftnlen)15); -#line 22298 "" +#line 22290 "" e_wsfe(); -#line 22299 "" +#line 22291 "" } -#line 22300 "" +#line 22292 "" } else { -#line 22301 "" +#line 22293 "" if (comlast_1.islast && comignorenats_1.ignorenats) { -#line 22301 "" +#line 22293 "" s_wsfe(&io___1504); /* Writing concatenation */ -#line 22301 "" +#line 22293 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22301 "" +#line 22293 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22301 "" +#line 22293 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22301 "" +#line 22293 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22301 "" +#line 22293 "" e_wsfe(); -#line 22301 "" +#line 22293 "" } -#line 22303 "" +#line 22295 "" if (comlast_1.islast) { -#line 22303 "" +#line 22295 "" s_wsfe(&io___1505); /* Writing concatenation */ -#line 22303 "" +#line 22295 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[1] = 14, a__1[1] = "xchangecontext"; -#line 22303 "" +#line 22295 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[3] = 10, a__1[3] = "addspace{-"; -#line 22303 "" +#line 22295 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; -#line 22303 "" +#line 22295 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[7] = 10, a__1[7] = "zstoppiece"; -#line 22303 "" +#line 22295 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[9] = 12, a__1[9] = "PMXbarnotrue"; -#line 22303 "" +#line 22295 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 22303 "" +#line 22295 "" i__3[11] = 10, a__1[11] = "contpiece%"; -#line 22303 "" +#line 22295 "" s_cat(ch__33, a__1, i__3, &c__12, (ftnlen)76); -#line 22303 "" +#line 22295 "" do_fio(&c__1, ch__33, (ftnlen)76); -#line 22303 "" +#line 22295 "" e_wsfe(); -#line 22303 "" +#line 22295 "" } -#line 22306 "" +#line 22298 "" } -#line 22307 "" +#line 22299 "" } else if (all_1.mtrnuml == 0 && (comshort_1.ishort == 0 || comshort_1.ishort == 6)) { /* No meter change */ -#line 22312 "" +#line 22304 "" if (comlast_1.islast) { -#line 22313 "" +#line 22305 "" if (comshort_1.ishort != 6) { -#line 22314 "" +#line 22306 "" s_wsfe(&io___1506); /* Writing concatenation */ -#line 22314 "" +#line 22306 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22314 "" +#line 22306 "" i__6[1] = 8, a__4[1] = "alaligne"; -#line 22314 "" +#line 22306 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 22314 "" +#line 22306 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22314 "" +#line 22306 "" e_wsfe(); -#line 22315 "" +#line 22307 "" } else { -#line 22316 "" +#line 22308 "" comshort_1.ishort = 0; -#line 22317 "" +#line 22309 "" } -#line 22318 "" +#line 22310 "" } -#line 22319 "" +#line 22311 "" } else if (comshort_1.ishort != 0) { -#line 22320 "" +#line 22312 "" if (comshort_1.ishort == 1) { /* Start short line */ -#line 22321 "" +#line 22313 "" s_wsfi(&io___1507); -#line 22321 "" +#line 22313 "" do_fio(&c__1, (char *)&comshort_1.shortfrac, ( ftnlen)sizeof(real)); -#line 22321 "" +#line 22313 "" e_wsfi(); -#line 22322 "" +#line 22314 "" s_wsfe(&io___1508); /* Writing concatenation */ -#line 22322 "" +#line 22314 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22322 "" +#line 22314 "" i__5[1] = 9, a__3[1] = "stoppiece"; -#line 22322 "" +#line 22314 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22322 "" +#line 22314 "" i__5[3] = 13, a__3[3] = "parindent 0pt"; -#line 22322 "" +#line 22314 "" s_cat(ch__24, a__3, i__5, &c__4, (ftnlen)24); -#line 22322 "" +#line 22314 "" do_fio(&c__1, ch__24, (ftnlen)24); -#line 22322 "" +#line 22314 "" e_wsfe(); -#line 22323 "" +#line 22315 "" s_wsfe(&io___1509); /* Writing concatenation */ -#line 22323 "" +#line 22315 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22323 "" +#line 22315 "" i__5[1] = 5, a__3[1] = "vskip"; -#line 22323 "" +#line 22315 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22323 "" +#line 22315 "" i__5[3] = 7, a__3[3] = "parskip"; -#line 22323 "" +#line 22315 "" s_cat(ch__10, a__3, i__5, &c__4, (ftnlen)14); -#line 22323 "" +#line 22315 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 22323 "" +#line 22315 "" e_wsfe(); -#line 22324 "" +#line 22316 "" s_wsfe(&io___1510); /* Writing concatenation */ -#line 22324 "" +#line 22316 "" i__16[0] = 1, a__12[0] = all_1.sq; -#line 22324 "" +#line 22316 "" i__16[1] = 7, a__12[1] = "hbox to"; -#line 22324 "" +#line 22316 "" i__16[2] = 1, a__12[2] = all_1.sq; -#line 22324 "" +#line 22316 "" i__16[3] = 6, a__12[3] = "hsize{"; -#line 22324 "" +#line 22316 "" i__16[4] = 1, a__12[4] = all_1.sq; -#line 22324 "" +#line 22316 "" i__16[5] = 5, a__12[5] = "vbox{"; -#line 22324 "" +#line 22316 "" i__16[6] = 1, a__12[6] = all_1.sq; -#line 22324 "" +#line 22316 "" i__16[7] = 6, a__12[7] = "hsize="; -#line 22324 "" +#line 22316 "" i__16[8] = 3, a__12[8] = shortfraq; -#line 22324 "" +#line 22316 "" i__16[9] = 1, a__12[9] = all_1.sq; -#line 22324 "" +#line 22316 "" i__16[10] = 6, a__12[10] = "hsize%"; -#line 22324 "" +#line 22316 "" s_cat(ch__34, a__12, i__16, &c__11, (ftnlen)38); -#line 22324 "" +#line 22316 "" do_fio(&c__1, ch__34, (ftnlen)38); -#line 22324 "" +#line 22316 "" e_wsfe(); -#line 22327 "" +#line 22319 "" s_wsfe(&io___1511); /* Writing concatenation */ -#line 22327 "" +#line 22319 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22327 "" +#line 22319 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22327 "" +#line 22319 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22327 "" +#line 22319 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22327 "" +#line 22319 "" e_wsfe(); -#line 22328 "" +#line 22320 "" s_wsfe(&io___1512); /* Writing concatenation */ -#line 22328 "" +#line 22320 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22328 "" +#line 22320 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22328 "" +#line 22320 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22328 "" +#line 22320 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22328 "" +#line 22320 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22328 "" +#line 22320 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22328 "" +#line 22320 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22328 "" +#line 22320 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22328 "" +#line 22320 "" e_wsfe(); -#line 22330 "" +#line 22322 "" ibarcnt0 = combibarcnt_1.ibarcnt; -#line 22331 "" +#line 22323 "" comshort_1.mbrsum = 0; -#line 22332 "" +#line 22324 "" comshort_1.ishort = 2; -#line 22333 "" +#line 22325 "" comshort_1.nmbr = 0; -#line 22334 "" +#line 22326 "" } else if (comshort_1.ishort == 2) { /* End short line, no new mv */ -#line 22335 "" +#line 22327 "" ntmp = combibarcnt_1.ibarcnt - ibarcnt0 - comshort_1.nmbr + comshort_1.mbrsum; -#line 22336 "" +#line 22328 "" if (ntmp <= 9) { -#line 22337 "" +#line 22329 "" *(unsigned char *)shortfraq = (char) (ntmp + 48); -#line 22338 "" +#line 22330 "" lntmp = 1; -#line 22339 "" +#line 22331 "" } else { -#line 22340 "" +#line 22332 "" s_wsfi(&io___1513); -#line 22340 "" +#line 22332 "" do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof( integer)); -#line 22340 "" +#line 22332 "" e_wsfi(); -#line 22341 "" +#line 22333 "" lntmp = 2; -#line 22342 "" +#line 22334 "" } -#line 22343 "" +#line 22335 "" s_wsfe(&io___1514); /* Writing concatenation */ -#line 22343 "" +#line 22335 "" i__15[0] = 1, a__11[0] = all_1.sq; -#line 22343 "" +#line 22335 "" i__15[1] = 11, a__11[1] = "stoppiece}}"; -#line 22343 "" +#line 22335 "" i__15[2] = 1, a__11[2] = all_1.sq; -#line 22343 "" +#line 22335 "" i__15[3] = 7, a__11[3] = "advance"; -#line 22343 "" +#line 22335 "" i__15[4] = 1, a__11[4] = all_1.sq; -#line 22343 "" +#line 22335 "" i__15[5] = 5, a__11[5] = "barno"; -#line 22343 "" +#line 22335 "" i__15[6] = lntmp, a__11[6] = shortfraq; -#line 22343 "" +#line 22335 "" s_cat(ch__7, a__11, i__15, &c__7, (ftnlen)29); -#line 22343 "" +#line 22335 "" do_fio(&c__1, ch__7, lntmp + 26); -#line 22343 "" +#line 22335 "" e_wsfe(); /* Not clear why we needed this */ /* //sq//'startbarno'//sq//'barno%' */ -#line 22348 "" +#line 22340 "" s_wsfe(&io___1515); /* Writing concatenation */ -#line 22348 "" +#line 22340 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22348 "" +#line 22340 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22348 "" +#line 22340 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22348 "" +#line 22340 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22348 "" +#line 22340 "" e_wsfe(); -#line 22349 "" +#line 22341 "" s_wsfe(&io___1516); /* Writing concatenation */ -#line 22349 "" +#line 22341 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22349 "" +#line 22341 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22349 "" +#line 22341 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22349 "" +#line 22341 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22349 "" +#line 22341 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22349 "" +#line 22341 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22349 "" +#line 22341 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22349 "" +#line 22341 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22349 "" +#line 22341 "" e_wsfe(); -#line 22351 "" +#line 22343 "" comshort_1.ishort = 0; -#line 22352 "" +#line 22344 "" } else if (comshort_1.ishort == 5) { /* End short line, new mvt */ -#line 22353 "" +#line 22345 "" if (comnotes_1.nobar1) { /* Continue bar numbering */ -#line 22354 "" +#line 22346 "" s_wsfe(&io___1517); /* Writing concatenation */ -#line 22354 "" +#line 22346 "" i__10[0] = 1, a__7[0] = all_1.sq; -#line 22354 "" +#line 22346 "" i__10[1] = 7, a__7[1] = "advance"; -#line 22354 "" +#line 22346 "" i__10[2] = 1, a__7[2] = all_1.sq; -#line 22354 "" +#line 22346 "" i__10[3] = 5, a__7[3] = "barno"; -#line 22354 "" +#line 22346 "" *(unsigned char *)&ch__1[0] = combibarcnt_1.ibarcnt - ibarcnt0 + 48; -#line 22354 "" +#line 22346 "" i__10[4] = 1, a__7[4] = ch__1; -#line 22354 "" +#line 22346 "" i__10[5] = 1, a__7[5] = all_1.sq; -#line 22354 "" +#line 22346 "" i__10[6] = 10, a__7[6] = "startbarno"; -#line 22354 "" +#line 22346 "" i__10[7] = 1, a__7[7] = all_1.sq; -#line 22354 "" +#line 22346 "" i__10[8] = 6, a__7[8] = "barno%"; -#line 22354 "" +#line 22346 "" s_cat(ch__35, a__7, i__10, &c__9, (ftnlen)33); -#line 22354 "" +#line 22346 "" do_fio(&c__1, ch__35, (ftnlen)33); -#line 22354 "" +#line 22346 "" e_wsfe(); /* Must leave in \startbarno to get msm with LMc to work. */ -#line 22360 "" +#line 22352 "" } -#line 22361 "" +#line 22353 "" s_wsfe(&io___1518); /* Writing concatenation */ -#line 22361 "" +#line 22353 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22361 "" +#line 22353 "" i__4[1] = 10, a__2[1] = "startpiece"; -#line 22361 "" +#line 22353 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22361 "" +#line 22353 "" i__4[3] = 8, a__2[3] = "addspace"; -#line 22361 "" +#line 22353 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22361 "" +#line 22353 "" i__4[5] = 14, a__2[5] = "afterruleskip%"; -#line 22361 "" +#line 22353 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22361 "" +#line 22353 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22361 "" +#line 22353 "" e_wsfe(); -#line 22363 "" +#line 22355 "" comshort_1.ishort = 0; -#line 22364 "" +#line 22356 "" } else if (comshort_1.ishort == 3) { /* May never come thru here. Stuff is done later at least for mcl.pmx */ /* Mid line gap, start coda */ -#line 22366 "" +#line 22358 "" s_wsfi(&io___1519); -#line 22366 "" +#line 22358 "" do_fio(&c__1, (char *)&comshort_1.codafrac, ( ftnlen)sizeof(real)); -#line 22366 "" +#line 22358 "" e_wsfi(); -#line 22367 "" +#line 22359 "" s_wsfe(&io___1520); /* Writing concatenation */ -#line 22367 "" +#line 22359 "" i__16[0] = 1, a__12[0] = all_1.sq; -#line 22367 "" +#line 22359 "" i__16[1] = 9, a__12[1] = "endpiece}"; -#line 22367 "" +#line 22359 "" i__16[2] = 1, a__12[2] = all_1.sq; -#line 22367 "" +#line 22359 "" i__16[3] = 7, a__12[3] = "advance"; -#line 22367 "" +#line 22359 "" i__16[4] = 1, a__12[4] = all_1.sq; -#line 22367 "" +#line 22359 "" i__16[5] = 5, a__12[5] = "barno"; -#line 22367 "" +#line 22359 "" *(unsigned char *)&ch__1[0] = combibarcnt_1.ibarcnt - ibarcnt0 + 48; -#line 22367 "" +#line 22359 "" i__16[6] = 1, a__12[6] = ch__1; -#line 22367 "" +#line 22359 "" i__16[7] = 1, a__12[7] = all_1.sq; -#line 22367 "" +#line 22359 "" i__16[8] = 10, a__12[8] = "startbarno"; -#line 22367 "" +#line 22359 "" i__16[9] = 1, a__12[9] = all_1.sq; -#line 22367 "" +#line 22359 "" i__16[10] = 6, a__12[10] = "barno%"; -#line 22367 "" +#line 22359 "" s_cat(ch__36, a__12, i__16, &c__11, (ftnlen)43); -#line 22367 "" +#line 22359 "" do_fio(&c__1, ch__36, (ftnlen)43); -#line 22367 "" +#line 22359 "" e_wsfe(); -#line 22370 "" +#line 22362 "" s_wsfe(&io___1521); /* Writing concatenation */ -#line 22370 "" +#line 22362 "" i__14[0] = 1, a__10[0] = all_1.sq; -#line 22370 "" +#line 22362 "" i__14[1] = 5, a__10[1] = "hfill"; -#line 22370 "" +#line 22362 "" i__14[2] = 1, a__10[2] = all_1.sq; -#line 22370 "" +#line 22362 "" i__14[3] = 5, a__10[3] = "vbox{"; -#line 22370 "" +#line 22362 "" i__14[4] = 1, a__10[4] = all_1.sq; -#line 22370 "" +#line 22362 "" i__14[5] = 6, a__10[5] = "hsize="; -#line 22370 "" +#line 22362 "" i__14[6] = 3, a__10[6] = shortfraq; -#line 22370 "" +#line 22362 "" i__14[7] = 1, a__10[7] = "%"; -#line 22370 "" +#line 22362 "" s_cat(ch__3, a__10, i__14, &c__8, (ftnlen)23); -#line 22370 "" +#line 22362 "" do_fio(&c__1, ch__3, (ftnlen)23); -#line 22370 "" +#line 22362 "" e_wsfe(); -#line 22372 "" +#line 22364 "" s_wsfe(&io___1522); /* Writing concatenation */ -#line 22372 "" +#line 22364 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22372 "" +#line 22364 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22372 "" +#line 22364 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22372 "" +#line 22364 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22372 "" +#line 22364 "" e_wsfe(); -#line 22373 "" +#line 22365 "" s_wsfe(&io___1523); /* Writing concatenation */ -#line 22373 "" +#line 22365 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22373 "" +#line 22365 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22373 "" +#line 22365 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22373 "" +#line 22365 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22373 "" +#line 22365 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22373 "" +#line 22365 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22373 "" +#line 22365 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22373 "" +#line 22365 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22373 "" +#line 22365 "" e_wsfe(); -#line 22375 "" +#line 22367 "" comshort_1.ishort = 4; -#line 22376 "" +#line 22368 "" } else if (comshort_1.ishort == 4) { /* End coda */ -#line 22377 "" +#line 22369 "" ntmp = combibarcnt_1.ibarcnt - ibarcnt0 - comshort_1.nmbr + comshort_1.mbrsum; -#line 22378 "" +#line 22370 "" if (ntmp <= 9) { -#line 22379 "" +#line 22371 "" *(unsigned char *)shortfraq = (char) (ntmp + 48); -#line 22380 "" +#line 22372 "" lntmp = 1; -#line 22381 "" +#line 22373 "" } else { -#line 22382 "" +#line 22374 "" s_wsfi(&io___1524); -#line 22382 "" +#line 22374 "" do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof( integer)); -#line 22382 "" +#line 22374 "" e_wsfi(); -#line 22383 "" +#line 22375 "" lntmp = 2; -#line 22384 "" +#line 22376 "" } -#line 22385 "" +#line 22377 "" s_wsfe(&io___1525); /* Writing concatenation */ -#line 22385 "" +#line 22377 "" i__15[0] = 1, a__11[0] = all_1.sq; -#line 22385 "" +#line 22377 "" i__15[1] = 10, a__11[1] = "endpiece}}"; -#line 22385 "" +#line 22377 "" i__15[2] = 1, a__11[2] = all_1.sq; -#line 22385 "" +#line 22377 "" i__15[3] = 7, a__11[3] = "advance"; -#line 22385 "" +#line 22377 "" i__15[4] = 1, a__11[4] = all_1.sq; -#line 22385 "" +#line 22377 "" i__15[5] = 5, a__11[5] = "barno"; -#line 22385 "" +#line 22377 "" i__15[6] = lntmp, a__11[6] = shortfraq; -#line 22385 "" +#line 22377 "" s_cat(ch__31, a__11, i__15, &c__7, (ftnlen)28); -#line 22385 "" +#line 22377 "" do_fio(&c__1, ch__31, lntmp + 25); -#line 22385 "" +#line 22377 "" e_wsfe(); -#line 22387 "" +#line 22379 "" s_wsfe(&io___1526); /* Writing concatenation */ -#line 22387 "" +#line 22379 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22387 "" +#line 22379 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22387 "" +#line 22379 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22387 "" +#line 22379 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22387 "" +#line 22379 "" e_wsfe(); -#line 22388 "" +#line 22380 "" s_wsfe(&io___1527); /* Writing concatenation */ -#line 22388 "" +#line 22380 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22388 "" +#line 22380 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22388 "" +#line 22380 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22388 "" +#line 22380 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22388 "" +#line 22380 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22388 "" +#line 22380 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22388 "" +#line 22380 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22388 "" +#line 22380 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22388 "" +#line 22380 "" e_wsfe(); -#line 22390 "" +#line 22382 "" comshort_1.ishort = 0; -#line 22391 "" +#line 22383 "" comshort_1.mbrsum = 0; -#line 22392 "" +#line 22384 "" comshort_1.nmbr = 0; -#line 22393 "" +#line 22385 "" } -#line 22394 "" +#line 22386 "" } else if (all_1.mtrnuml != 0) { /* New meter, no new sig, end of line, not new page. */ @@ -54474,2003 +54747,2007 @@ L51: /* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */ /* \zchangecontext */ -#line 22404 "" +#line 22396 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); -#line 22405 "" +#line 22397 "" if (comget_1.movbrk == 0) { -#line 22406 "" +#line 22398 "" if (comlast_1.islast) { -#line 22407 "" +#line 22399 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22408 "" +#line 22400 "" } -#line 22409 "" +#line 22401 "" if (all_1.mtrdnp > 0) { -#line 22410 "" +#line 22402 "" if (comlast_1.islast) { -#line 22411 "" +#line 22403 "" s_wsfe(&io___1528); /* Writing concatenation */ -#line 22411 "" +#line 22403 "" i__3[0] = 1, a__1[0] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[1] = 3, a__1[1] = "let"; -#line 22411 "" +#line 22403 "" i__3[2] = 1, a__1[2] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[3] = 4, a__1[3] = "bnat"; -#line 22411 "" +#line 22403 "" i__3[4] = 1, a__1[4] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[5] = 8, a__1[5] = "barnoadd"; -#line 22411 "" +#line 22403 "" i__3[6] = 1, a__1[6] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[7] = 3, a__1[7] = "def"; -#line 22411 "" +#line 22403 "" i__3[8] = 1, a__1[8] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[9] = 9, a__1[9] = "barnoadd{"; -#line 22411 "" +#line 22403 "" i__3[10] = 1, a__1[10] = all_1.sq; -#line 22411 "" +#line 22403 "" i__3[11] = 7, a__1[11] = "empty}%"; -#line 22411 "" +#line 22403 "" s_cat(ch__23, a__1, i__3, &c__12, (ftnlen) 40); -#line 22411 "" +#line 22403 "" do_fio(&c__1, ch__23, (ftnlen)40); -#line 22411 "" +#line 22403 "" e_wsfe(); -#line 22414 "" +#line 22406 "" s_wsfe(&io___1529); /* Writing concatenation */ -#line 22414 "" +#line 22406 "" i__17[0] = 1, a__13[0] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[1] = 14, a__13[1] = "xchangecontext" ; -#line 22414 "" +#line 22406 "" i__17[2] = 1, a__13[2] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[3] = 10, a__13[3] = "addspace{-"; -#line 22414 "" +#line 22406 "" i__17[4] = 1, a__13[4] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[5] = 14, a__13[5] = "afterruleskip}" ; -#line 22414 "" +#line 22406 "" i__17[6] = 1, a__13[6] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[7] = 9, a__13[7] = "zalaligne"; -#line 22414 "" +#line 22406 "" i__17[8] = 1, a__13[8] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[9] = 3, a__13[9] = "let"; -#line 22414 "" +#line 22406 "" i__17[10] = 1, a__13[10] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[11] = 8, a__13[11] = "barnoadd"; -#line 22414 "" +#line 22406 "" i__17[12] = 1, a__13[12] = all_1.sq; -#line 22414 "" +#line 22406 "" i__17[13] = 4, a__13[13] = "bnat"; -#line 22414 "" +#line 22406 "" s_cat(ch__37, a__13, i__17, &c__14, ( ftnlen)69); -#line 22414 "" +#line 22406 "" do_fio(&c__1, ch__37, (ftnlen)69); -#line 22414 "" +#line 22406 "" e_wsfe(); -#line 22417 "" +#line 22409 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22418 "" +#line 22410 "" s_wsfe(&io___1530); /* Writing concatenation */ -#line 22418 "" +#line 22410 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22418 "" +#line 22410 "" i__4[1] = 10, a__2[1] = "addspace{-"; -#line 22418 "" +#line 22410 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22418 "" +#line 22410 "" i__4[3] = 14, a__2[3] = "afterruleskip}"; -#line 22418 "" +#line 22410 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22418 "" +#line 22410 "" i__4[5] = 14, a__2[5] = "zchangecontext"; -#line 22418 "" +#line 22410 "" s_cat(ch__38, a__2, i__4, &c__6, (ftnlen) 41); -#line 22418 "" +#line 22410 "" do_fio(&c__1, ch__38, (ftnlen)41); -#line 22418 "" +#line 22410 "" e_wsfe(); -#line 22420 "" +#line 22412 "" } -#line 22421 "" +#line 22413 "" if (all_1.ibar == comgrace_1.ibarmbr) { -#line 22421 "" +#line 22413 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 22421 "" +#line 22413 "" } -#line 22422 "" +#line 22414 "" } else { -#line 22423 "" +#line 22415 "" if (comlast_1.islast) { -#line 22423 "" +#line 22415 "" s_wsfe(&io___1531); /* Writing concatenation */ -#line 22423 "" +#line 22415 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22423 "" +#line 22415 "" i__6[1] = 8, a__4[1] = "alaligne"; -#line 22423 "" +#line 22415 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen) 9); -#line 22423 "" +#line 22415 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22423 "" +#line 22415 "" e_wsfe(); -#line 22423 "" +#line 22415 "" } -#line 22424 "" +#line 22416 "" } -#line 22425 "" +#line 22417 "" } else { -#line 22426 "" +#line 22418 "" if (comlast_1.islast) { -#line 22426 "" +#line 22418 "" s_wsfe(&io___1532); /* Writing concatenation */ -#line 22426 "" +#line 22418 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22426 "" +#line 22418 "" i__6[1] = 8, a__4[1] = "alaligne"; -#line 22426 "" +#line 22418 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 22426 "" +#line 22418 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22426 "" +#line 22418 "" e_wsfe(); -#line 22426 "" +#line 22418 "" } -#line 22427 "" +#line 22419 "" } -#line 22428 "" +#line 22420 "" } -#line 22429 "" +#line 22421 "" } /* Modified 090525 to use \bnrs */ -#line 22433 "" +#line 22425 "" if (slint) { -#line 22434 "" +#line 22426 "" slint = FALSE_; -#line 22435 "" +#line 22427 "" if (comlast_1.islast) { -#line 22435 "" +#line 22427 "" s_wsfe(&io___1533); /* Writing concatenation */ -#line 22435 "" +#line 22427 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22435 "" +#line 22427 "" i__5[1] = 3, a__3[1] = "def"; -#line 22435 "" +#line 22427 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22435 "" +#line 22427 "" i__5[3] = 11, a__3[3] = "raisebarno{"; -#line 22435 "" +#line 22427 "" s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); -#line 22435 "" +#line 22427 "" do_fio(&c__1, ch__22, (ftnlen)16); -#line 22435 "" +#line 22427 "" do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen) sizeof(integer)); /* Writing concatenation */ -#line 22435 "" +#line 22427 "" i__8[0] = 2, a__5[0] = ".5"; -#line 22435 "" +#line 22427 "" i__8[1] = 1, a__5[1] = all_1.sq; -#line 22435 "" +#line 22427 "" i__8[2] = 11, a__5[2] = "internote}%"; -#line 22435 "" +#line 22427 "" s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); -#line 22435 "" +#line 22427 "" do_fio(&c__1, ch__10, (ftnlen)14); -#line 22435 "" +#line 22427 "" e_wsfe(); -#line 22435 "" +#line 22427 "" } -#line 22437 "" +#line 22429 "" } -#line 22438 "" +#line 22430 "" comget_1.movbrk = 0; -#line 22439 "" +#line 22431 "" } /* Clean up if we squelched bar number reset at movement break */ -#line 22443 "" +#line 22435 "" if (comnotes_1.nobar1) { -#line 22444 "" +#line 22436 "" if (comlast_1.islast) { -#line 22444 "" +#line 22436 "" s_wsfe(&io___1534); /* Writing concatenation */ -#line 22444 "" +#line 22436 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22444 "" +#line 22436 "" i__6[1] = 11, a__4[1] = "startbarno1"; -#line 22444 "" +#line 22436 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22444 "" +#line 22436 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22444 "" +#line 22436 "" e_wsfe(); -#line 22444 "" +#line 22436 "" } -#line 22445 "" +#line 22437 "" comnotes_1.nobar1 = FALSE_; -#line 22446 "" +#line 22438 "" } -#line 22447 "" - i__7 = s_rsle(&io___1535); -#line 22447 "" - if (i__7 != 0) { -#line 22447 "" +#line 22439 "" + i__2 = s_rsle(&io___1535); +#line 22439 "" + if (i__2 != 0) { +#line 22439 "" goto L14; -#line 22447 "" +#line 22439 "" } -#line 22447 "" - i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof( +#line 22439 "" + i__2 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof( integer)); -#line 22447 "" - if (i__7 != 0) { -#line 22447 "" +#line 22439 "" + if (i__2 != 0) { +#line 22439 "" goto L14; -#line 22447 "" +#line 22439 "" } -#line 22447 "" - i__7 = e_rsle(); -#line 22447 "" - if (i__7 != 0) { -#line 22447 "" +#line 22439 "" + i__2 = e_rsle(); +#line 22439 "" + if (i__2 != 0) { +#line 22439 "" goto L14; -#line 22447 "" +#line 22439 "" } -#line 22448 "" +#line 22440 "" L14: /* We come thru here for the 1st bar of every system, so initialize is1n1 */ -#line 22452 "" +#line 22444 "" comsln_1.is1n1 = 0; /* Brought down from above */ -#line 22456 "" +#line 22448 "" if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) { -#line 22457 "" +#line 22449 "" isystpg = 0; /* The following is to avoid moving this reset of isystpg, but still send a signal */ /* down below for last system shortening events */ -#line 22462 "" +#line 22454 "" if (comshort_1.ishort == 2) { -#line 22462 "" +#line 22454 "" iflagbot = 1; -#line 22462 "" +#line 22454 "" } -#line 22463 "" +#line 22455 "" } /* Check for linebreak ties */ -#line 22467 "" +#line 22459 "" if (ispstie) { -#line 22467 "" +#line 22459 "" linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( ftnlen)1); -#line 22467 "" +#line 22459 "" } -#line 22470 "" +#line 22462 "" } else { /* Not first bar of system */ -#line 22474 "" +#line 22466 "" if (bit_test(iplnow,28)) { /* Signature change */ -#line 22478 "" +#line 22470 "" if (all_1.mtrnuml != 0) { /* Meter+signature change mid line, assume no movement break */ -#line 22482 "" +#line 22474 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); -#line 22483 "" +#line 22475 "" if (comlast_1.islast) { -#line 22483 "" +#line 22475 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22483 "" +#line 22475 "" } /* Writing concatenation */ -#line 22484 "" +#line 22476 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22484 "" +#line 22476 "" i__6[1] = 17, a__4[1] = "generalsignature{"; -#line 22484 "" +#line 22476 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 22485 "" +#line 22477 "" lnote = 18; -#line 22486 "" +#line 22478 "" if (comtop_1.isig < 0) { /* Writing concatenation */ -#line 22487 "" +#line 22479 "" i__6[0] = 18, a__4[0] = notexq; -#line 22487 "" +#line 22479 "" i__6[1] = 1, a__4[1] = "-"; -#line 22487 "" +#line 22479 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 22488 "" +#line 22480 "" lnote = 19; -#line 22489 "" +#line 22481 "" } -#line 22490 "" +#line 22482 "" if (comlast_1.islast) { -#line 22491 "" +#line 22483 "" iptemp = abs(comtop_1.isig) + 48; -#line 22492 "" +#line 22484 "" chax_(ch__1, (ftnlen)1, &iptemp); -#line 22492 "" +#line 22484 "" *(unsigned char *)charq = *(unsigned char *)&ch__1[0]; /* Writing concatenation */ -#line 22493 "" +#line 22485 "" i__8[0] = lnote, a__5[0] = notexq; -#line 22493 "" +#line 22485 "" i__8[1] = 1, a__5[1] = charq; -#line 22493 "" +#line 22485 "" i__8[2] = 2, a__5[2] = "}%"; -#line 22493 "" +#line 22485 "" s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79); -#line 22494 "" +#line 22486 "" lnote += 3; -#line 22495 "" +#line 22487 "" s_wsfe(&io___1538); -#line 22495 "" +#line 22487 "" do_fio(&c__1, notexq, lnote); -#line 22495 "" +#line 22487 "" e_wsfe(); -#line 22496 "" +#line 22488 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { -#line 22497 "" +#line 22489 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); -#line 22499 "" +#line 22491 "" } -#line 22500 "" +#line 22492 "" if (comignorenats_1.ignorenats) { -#line 22500 "" +#line 22492 "" s_wsfe(&io___1539); /* Writing concatenation */ -#line 22500 "" +#line 22492 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22500 "" +#line 22492 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22500 "" +#line 22492 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22500 "" +#line 22492 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22500 "" +#line 22492 "" e_wsfe(); -#line 22500 "" +#line 22492 "" } -#line 22501 "" +#line 22493 "" s_wsfe(&io___1540); /* Writing concatenation */ -#line 22501 "" +#line 22493 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22501 "" +#line 22493 "" i__6[1] = 15, a__4[1] = "xchangecontext%"; -#line 22501 "" +#line 22493 "" s_cat(ch__22, a__4, i__6, &c__2, (ftnlen)16); -#line 22501 "" +#line 22493 "" do_fio(&c__1, ch__22, (ftnlen)16); -#line 22501 "" +#line 22493 "" e_wsfe(); -#line 22502 "" +#line 22494 "" } -#line 22503 "" +#line 22495 "" if (all_1.ibar == comgrace_1.ibarmbr) { /* Compute space for multibar rest */ -#line 22507 "" +#line 22499 "" if (comtop_1.lastisig * comtop_1.isig >= 0) { /* Computing MAX */ -#line 22508 "" - i__7 = abs(comtop_1.lastisig), i__2 = abs( +#line 22500 "" + i__2 = abs(comtop_1.lastisig), i__7 = abs( comtop_1.isig); -#line 22508 "" - naccs = max(i__7,i__2); -#line 22509 "" +#line 22500 "" + naccs = max(i__2,i__7); +#line 22501 "" } else { -#line 22510 "" - naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, - abs(i__7)); -#line 22511 "" +#line 22502 "" + naccs = (i__2 = comtop_1.lastisig - comtop_1.isig, + abs(i__2)); +#line 22503 "" } /* xb4mbr = (facmtr+naccs*.24)*musicsize */ -#line 22513 "" +#line 22505 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 22514 "" +#line 22506 "" } -#line 22515 "" +#line 22507 "" } else { /* Signature change only */ /* Writing concatenation */ -#line 22519 "" +#line 22511 "" i__14[0] = 1, a__10[0] = all_1.sq; -#line 22519 "" +#line 22511 "" i__14[1] = 4, a__10[1] = "xbar"; -#line 22519 "" +#line 22511 "" i__14[2] = 1, a__10[2] = all_1.sq; -#line 22519 "" +#line 22511 "" i__14[3] = 10, a__10[3] = "addspace{-"; -#line 22519 "" +#line 22511 "" i__14[4] = 1, a__10[4] = all_1.sq; -#line 22519 "" +#line 22511 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; -#line 22519 "" +#line 22511 "" i__14[6] = 1, a__10[6] = all_1.sq; -#line 22519 "" +#line 22511 "" i__14[7] = 17, a__10[7] = "generalsignature{"; -#line 22519 "" +#line 22511 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); -#line 22521 "" +#line 22513 "" lnote = 49; -#line 22522 "" +#line 22514 "" if (comtop_1.isig < 0) { /* Writing concatenation */ -#line 22523 "" +#line 22515 "" i__6[0] = 49, a__4[0] = notexq; -#line 22523 "" +#line 22515 "" i__6[1] = 1, a__4[1] = "-"; -#line 22523 "" +#line 22515 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); -#line 22524 "" +#line 22516 "" lnote = 50; -#line 22525 "" +#line 22517 "" } -#line 22526 "" +#line 22518 "" if (comlast_1.islast) { -#line 22526 "" +#line 22518 "" s_wsfe(&io___1542); /* Writing concatenation */ -#line 22526 "" +#line 22518 "" i__8[0] = lnote, a__5[0] = notexq; -#line 22526 "" - i__7 = abs(comtop_1.isig) + 48; -#line 22526 "" - chax_(ch__1, (ftnlen)1, &i__7); -#line 22526 "" +#line 22518 "" + i__2 = abs(comtop_1.isig) + 48; +#line 22518 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 22518 "" i__8[1] = 1, a__5[1] = ch__1; -#line 22526 "" +#line 22518 "" i__8[2] = 2, a__5[2] = "}%"; -#line 22526 "" +#line 22518 "" s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82); -#line 22526 "" +#line 22518 "" do_fio(&c__1, ch__27, lnote + 3); -#line 22526 "" +#line 22518 "" e_wsfe(); -#line 22526 "" +#line 22518 "" } -#line 22528 "" +#line 22520 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { -#line 22529 "" +#line 22521 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); -#line 22531 "" +#line 22523 "" } -#line 22532 "" +#line 22524 "" if (comlast_1.islast && comignorenats_1.ignorenats) { -#line 22532 "" +#line 22524 "" s_wsfe(&io___1543); /* Writing concatenation */ -#line 22532 "" +#line 22524 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22532 "" +#line 22524 "" i__6[1] = 11, a__4[1] = "ignorenats%"; -#line 22532 "" +#line 22524 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22532 "" +#line 22524 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22532 "" +#line 22524 "" e_wsfe(); -#line 22532 "" +#line 22524 "" } -#line 22534 "" +#line 22526 "" if (comlast_1.islast) { -#line 22534 "" +#line 22526 "" s_wsfe(&io___1544); /* Writing concatenation */ -#line 22534 "" +#line 22526 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22534 "" +#line 22526 "" i__4[1] = 14, a__2[1] = "zchangecontext"; -#line 22534 "" +#line 22526 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22534 "" +#line 22526 "" i__4[3] = 12, a__2[3] = "addspace{-.5"; -#line 22534 "" +#line 22526 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22534 "" +#line 22526 "" i__4[5] = 15, a__2[5] = "afterruleskip}%"; -#line 22534 "" +#line 22526 "" s_cat(ch__39, a__2, i__4, &c__6, (ftnlen)44); -#line 22534 "" +#line 22526 "" do_fio(&c__1, ch__39, (ftnlen)44); -#line 22534 "" +#line 22526 "" e_wsfe(); -#line 22534 "" +#line 22526 "" } -#line 22536 "" +#line 22528 "" if (all_1.ibar == comgrace_1.ibarmbr) { /* Compute space for multibar rest */ -#line 22540 "" +#line 22532 "" if (comtop_1.lastisig * comtop_1.isig >= 0) { /* Computing MAX */ -#line 22541 "" - i__7 = abs(comtop_1.lastisig), i__2 = abs( +#line 22533 "" + i__2 = abs(comtop_1.lastisig), i__7 = abs( comtop_1.isig); -#line 22541 "" - naccs = max(i__7,i__2); -#line 22542 "" +#line 22533 "" + naccs = max(i__2,i__7); +#line 22534 "" } else { -#line 22543 "" - naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, - abs(i__7)); -#line 22544 "" +#line 22535 "" + naccs = (i__2 = comtop_1.lastisig - comtop_1.isig, + abs(i__2)); +#line 22536 "" } /* xb4mbr = naccs*.24*musicsize */ -#line 22546 "" +#line 22538 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 22547 "" +#line 22539 "" } -#line 22548 "" +#line 22540 "" } -#line 22549 "" +#line 22541 "" } else if (comshort_1.ishort == 3) { /* Gap before coda, assumed no signature change! */ -#line 22553 "" +#line 22545 "" ntmp = combibarcnt_1.ibarcnt - ibarcnt0 - comshort_1.nmbr + comshort_1.mbrsum; -#line 22554 "" +#line 22546 "" if (ntmp <= 9) { -#line 22555 "" +#line 22547 "" *(unsigned char *)shortfraq = (char) (ntmp + 48); -#line 22556 "" +#line 22548 "" lntmp = 1; -#line 22557 "" +#line 22549 "" } else { -#line 22558 "" +#line 22550 "" s_wsfi(&io___1545); -#line 22558 "" +#line 22550 "" do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof(integer)); -#line 22558 "" +#line 22550 "" e_wsfi(); -#line 22559 "" +#line 22551 "" lntmp = 2; -#line 22560 "" +#line 22552 "" } -#line 22561 "" +#line 22553 "" s_wsfe(&io___1546); /* Writing concatenation */ -#line 22561 "" +#line 22553 "" i__15[0] = 1, a__11[0] = all_1.sq; -#line 22561 "" +#line 22553 "" i__15[1] = 9, a__11[1] = "endpiece}"; -#line 22561 "" +#line 22553 "" i__15[2] = 1, a__11[2] = all_1.sq; -#line 22561 "" +#line 22553 "" i__15[3] = 7, a__11[3] = "advance"; -#line 22561 "" +#line 22553 "" i__15[4] = 1, a__11[4] = all_1.sq; -#line 22561 "" +#line 22553 "" i__15[5] = 5, a__11[5] = "barno"; -#line 22561 "" +#line 22553 "" i__15[6] = lntmp, a__11[6] = shortfraq; -#line 22561 "" +#line 22553 "" s_cat(ch__5, a__11, i__15, &c__7, (ftnlen)27); -#line 22561 "" +#line 22553 "" do_fio(&c__1, ch__5, lntmp + 24); -#line 22561 "" +#line 22553 "" e_wsfe(); -#line 22563 "" +#line 22555 "" if (comshort_1.nocodabn) { -#line 22564 "" +#line 22556 "" s_wsfe(&io___1547); /* Writing concatenation */ -#line 22564 "" +#line 22556 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22564 "" +#line 22556 "" i__6[1] = 7, a__4[1] = "nobarno"; -#line 22564 "" +#line 22556 "" s_cat(ch__8, a__4, i__6, &c__2, (ftnlen)8); -#line 22564 "" +#line 22556 "" do_fio(&c__1, ch__8, (ftnlen)8); -#line 22564 "" +#line 22556 "" e_wsfe(); -#line 22565 "" +#line 22557 "" comshort_1.nocodabn = FALSE_; -#line 22566 "" +#line 22558 "" } -#line 22567 "" +#line 22559 "" s_wsfi(&io___1548); -#line 22567 "" +#line 22559 "" do_fio(&c__1, (char *)&comshort_1.codafrac, (ftnlen)sizeof( real)); -#line 22567 "" +#line 22559 "" e_wsfi(); -#line 22568 "" +#line 22560 "" s_wsfe(&io___1549); /* Writing concatenation */ -#line 22568 "" +#line 22560 "" i__10[0] = 1, a__7[0] = all_1.sq; -#line 22568 "" +#line 22560 "" i__10[1] = 5, a__7[1] = "hfill"; -#line 22568 "" +#line 22560 "" i__10[2] = 1, a__7[2] = all_1.sq; -#line 22568 "" +#line 22560 "" i__10[3] = 5, a__7[3] = "vbox{"; -#line 22568 "" +#line 22560 "" i__10[4] = 1, a__7[4] = all_1.sq; -#line 22568 "" +#line 22560 "" i__10[5] = 6, a__7[5] = "hsize="; -#line 22568 "" +#line 22560 "" i__10[6] = 3, a__7[6] = shortfraq; -#line 22568 "" +#line 22560 "" i__10[7] = 1, a__7[7] = all_1.sq; -#line 22568 "" +#line 22560 "" i__10[8] = 6, a__7[8] = "hsize%"; -#line 22568 "" +#line 22560 "" s_cat(ch__7, a__7, i__10, &c__9, (ftnlen)29); -#line 22568 "" +#line 22560 "" do_fio(&c__1, ch__7, (ftnlen)29); -#line 22568 "" +#line 22560 "" e_wsfe(); -#line 22570 "" +#line 22562 "" s_wsfe(&io___1550); /* Writing concatenation */ -#line 22570 "" +#line 22562 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22570 "" +#line 22562 "" i__6[1] = 9, a__4[1] = "contpiece"; -#line 22570 "" +#line 22562 "" s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10); -#line 22570 "" +#line 22562 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22570 "" +#line 22562 "" e_wsfe(); -#line 22571 "" +#line 22563 "" s_wsfe(&io___1551); /* Writing concatenation */ -#line 22571 "" +#line 22563 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22571 "" +#line 22563 "" i__4[1] = 12, a__2[1] = "makeatletter"; -#line 22571 "" +#line 22563 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22571 "" +#line 22563 "" i__4[3] = 9, a__2[3] = "fil@begin"; -#line 22571 "" +#line 22563 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22571 "" +#line 22563 "" i__4[5] = 11, a__2[5] = "makeatother"; -#line 22571 "" +#line 22563 "" s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35); -#line 22571 "" +#line 22563 "" do_fio(&c__1, ch__9, (ftnlen)35); -#line 22571 "" +#line 22563 "" e_wsfe(); -#line 22573 "" +#line 22565 "" comshort_1.ishort = 4; -#line 22574 "" +#line 22566 "" } else if (all_1.mtrnuml == 0) { /* No meter change */ -#line 22578 "" +#line 22570 "" if (comlast_1.islast) { -#line 22578 "" +#line 22570 "" s_wsfe(&io___1552); /* Writing concatenation */ -#line 22578 "" +#line 22570 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22578 "" +#line 22570 "" i__6[1] = 4, a__4[1] = "xbar"; -#line 22578 "" +#line 22570 "" s_cat(ch__40, a__4, i__6, &c__2, (ftnlen)5); -#line 22578 "" +#line 22570 "" do_fio(&c__1, ch__40, (ftnlen)5); -#line 22578 "" +#line 22570 "" e_wsfe(); -#line 22578 "" +#line 22570 "" } -#line 22579 "" +#line 22571 "" } else { /* Change meter midline */ -#line 22583 "" +#line 22575 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, & ibmrep); -#line 22584 "" +#line 22576 "" if (comget_1.movbrk == 0) { -#line 22585 "" +#line 22577 "" if (comlast_1.islast) { -#line 22586 "" +#line 22578 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); -#line 22587 "" +#line 22579 "" } -#line 22588 "" +#line 22580 "" if (all_1.mtrdnp > 0) { -#line 22589 "" +#line 22581 "" if (comlast_1.islast) { -#line 22590 "" +#line 22582 "" s_wsfe(&io___1553); /* Writing concatenation */ -#line 22590 "" +#line 22582 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22590 "" +#line 22582 "" i__6[1] = 10, a__4[1] = "newtimes0%"; -#line 22590 "" +#line 22582 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22590 "" +#line 22582 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22590 "" +#line 22582 "" e_wsfe(); -#line 22591 "" +#line 22583 "" } /* if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize */ -#line 22593 "" +#line 22585 "" if (all_1.ibar == comgrace_1.ibarmbr) { -#line 22593 "" +#line 22585 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; -#line 22593 "" +#line 22585 "" } -#line 22594 "" +#line 22586 "" } else { -#line 22595 "" +#line 22587 "" if (comlast_1.islast) { -#line 22595 "" +#line 22587 "" s_wsfe(&io___1554); /* Writing concatenation */ -#line 22595 "" +#line 22587 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22595 "" +#line 22587 "" i__6[1] = 4, a__4[1] = "xbar"; -#line 22595 "" +#line 22587 "" s_cat(ch__40, a__4, i__6, &c__2, (ftnlen)5); -#line 22595 "" +#line 22587 "" do_fio(&c__1, ch__40, (ftnlen)5); -#line 22595 "" +#line 22587 "" e_wsfe(); -#line 22595 "" +#line 22587 "" } -#line 22596 "" +#line 22588 "" } -#line 22597 "" +#line 22589 "" } -#line 22598 "" +#line 22590 "" } -#line 22599 "" +#line 22591 "" } /* Now that xbar's are written, can put in left-repeats at line beginnings */ -#line 22603 "" +#line 22595 "" if (lrptpend) { -#line 22604 "" +#line 22596 "" if (comlast_1.islast) { -#line 22604 "" +#line 22596 "" s_wsfe(&io___1555); /* Writing concatenation */ -#line 22604 "" +#line 22596 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22604 "" +#line 22596 "" i__4[1] = 7, a__2[1] = "advance"; -#line 22604 "" +#line 22596 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22604 "" +#line 22596 "" i__4[3] = 7, a__2[3] = "barno-1"; -#line 22604 "" +#line 22596 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22604 "" +#line 22596 "" i__4[5] = 10, a__2[5] = "leftrepeat"; -#line 22604 "" +#line 22596 "" s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); -#line 22604 "" +#line 22596 "" do_fio(&c__1, ch__5, (ftnlen)27); -#line 22604 "" +#line 22596 "" e_wsfe(); -#line 22604 "" +#line 22596 "" } -#line 22606 "" +#line 22598 "" lrptpend = FALSE_; -#line 22607 "" +#line 22599 "" } -#line 22608 "" +#line 22600 "" if (all_1.ibar > 1) { /* For bars after first, slide all stuff down to beginning of arrays */ -#line 22612 "" - i__7 = all_1.nv; -#line 22612 "" - for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { -#line 22613 "" - i__2 = commvl_1.nvmx[all_1.iv - 1]; -#line 22613 "" - for (kv = 1; kv <= i__2; ++kv) { -#line 22614 "" +#line 22604 "" + i__2 = all_1.nv; +#line 22604 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 22605 "" + i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 22605 "" + for (kv = 1; kv <= i__7; ++kv) { +#line 22606 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 22615 "" +#line 22607 "" ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22616 "" +#line 22608 "" i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] - ioff; -#line 22616 "" +#line 22608 "" for (ip = 1; ip <= i__13; ++ip) { -#line 22617 "" +#line 22609 "" all_1.nolev[commvl_1.ivx + ip * 24 - 25] = all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22618 "" +#line 22610 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22619 "" +#line 22611 "" all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[ commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22620 "" +#line 22612 "" all_1.irest[commvl_1.ivx + ip * 24 - 25] = all_1.irest[commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22621 "" +#line 22613 "" all_1.islur[commvl_1.ivx + ip * 24 - 25] = all_1.islur[commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22622 "" +#line 22614 "" all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[ commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22623 "" +#line 22615 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[ commvl_1.ivx + (ip + ioff) * 24 - 1]; -#line 22624 "" +#line 22616 "" all_1.mult[commvl_1.ivx + ip * 24 - 25] = all_1.mult[ commvl_1.ivx + (ip + ioff) * 24 - 25]; -#line 22625 "" +#line 22617 "" if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { -#line 22626 "" +#line 22618 "" if (commvl_1.ivx == 1) { -#line 22627 "" +#line 22619 "" all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip + ioff << 1) - 2]; -#line 22628 "" +#line 22620 "" } else { -#line 22629 "" +#line 22621 "" all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip + ioff << 1) - 1]; -#line 22630 "" +#line 22622 "" } -#line 22631 "" +#line 22623 "" } -#line 22632 "" +#line 22624 "" /* L12: */ -#line 22632 "" +#line 22624 "" } -#line 22633 "" +#line 22625 "" if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1] > 1) { -#line 22634 "" +#line 22626 "" islide = 0; -#line 22635 "" +#line 22627 "" i__13 = comcc_1.ncc[all_1.iv - 1]; -#line 22635 "" +#line 22627 "" for (icc = 1; icc <= i__13; ++icc) { -#line 22636 "" +#line 22628 "" if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= ( real) all_1.lenbar) { /* This time will drop <=0 when slid. */ -#line 22640 "" +#line 22632 "" islide = icc - 1; -#line 22641 "" +#line 22633 "" comcc_1.ncmidcc[all_1.iv - 1] = comcc_1.ncmidcc[all_1.iv + icc * 24 - 25]; -#line 22642 "" +#line 22634 "" } else { -#line 22643 "" +#line 22635 "" comcc_1.tcc[all_1.iv + (icc - islide) * 24 - 25] = comcc_1.tcc[all_1.iv + icc * 24 - 25] - all_1.lenbar; -#line 22644 "" +#line 22636 "" comcc_1.ncmidcc[all_1.iv + (icc - islide) * 24 - 25] = comcc_1.ncmidcc[all_1.iv + icc * 24 - 25]; -#line 22645 "" +#line 22637 "" } -#line 22646 "" +#line 22638 "" /* L13: */ -#line 22646 "" +#line 22638 "" } -#line 22647 "" +#line 22639 "" comcc_1.ncc[all_1.iv - 1] -= islide; -#line 22648 "" +#line 22640 "" comcc_1.tcc[all_1.iv - 1] = 0.f; -#line 22649 "" +#line 22641 "" } -#line 22650 "" -/* L11: */ -#line 22650 "" +#line 22642 "" +/* L1199: */ +#line 22642 "" } -#line 22650 "" +#line 22643 "" +/* L11: */ +#line 22643 "" } -#line 22651 "" +#line 22644 "" i__2 = comgrace_1.ngrace; -#line 22651 "" +#line 22644 "" for (ig = 1; ig <= i__2; ++ig) { -#line 22652 "" +#line 22645 "" comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + ( all_1.ibar - 1) * 24 - 25]; -#line 22653 "" +#line 22646 "" if (all_1.ibar > 2) { -#line 22653 "" +#line 22646 "" comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1] + (all_1.ibar - 2) * 24 - 25]; -#line 22653 "" +#line 22646 "" } -#line 22654 "" +#line 22647 "" /* L15: */ -#line 22654 "" +#line 22647 "" } -#line 22655 "" +#line 22648 "" i__2 = comgrace_1.nlit; -#line 22655 "" +#line 22648 "" for (il = 1; il <= i__2; ++il) { -#line 22656 "" +#line 22649 "" comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1] + (all_1.ibar - 1) * 24 - 25]; -#line 22657 "" +#line 22650 "" if (all_1.ibar > 2) { -#line 22657 "" +#line 22650 "" comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il - 1] + (all_1.ibar - 2) * 24 - 25]; -#line 22657 "" +#line 22650 "" } -#line 22658 "" +#line 22651 "" /* L21: */ -#line 22658 "" +#line 22651 "" } -#line 22659 "" +#line 22652 "" i__2 = comtrill_1.ntrill; -#line 22659 "" +#line 22652 "" for (it = 1; it <= i__2; ++it) { -#line 22660 "" +#line 22653 "" comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it - 1] + (all_1.ibar - 1) * 24 - 25]; -#line 22661 "" +#line 22654 "" if (all_1.ibar > 2) { -#line 22661 "" +#line 22654 "" comtrill_1.iptrill[it - 1] += all_1.nib[ comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) * 24 - 25]; -#line 22661 "" +#line 22654 "" } -#line 22663 "" +#line 22656 "" /* L22: */ -#line 22663 "" +#line 22656 "" } -#line 22664 "" +#line 22657 "" i__2 = comtrill_1.ncrd; -#line 22664 "" +#line 22657 "" for (icrd = 1; icrd <= i__2; ++icrd) { -#line 22665 "" +#line 22658 "" commvl_1.ivx = (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], ( ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__28) << 4); -#line 22667 "" +#line 22660 "" ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22668 "" +#line 22661 "" if (all_1.ibar > 2) { -#line 22668 "" +#line 22661 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22668 "" +#line 22661 "" } -#line 22669 "" +#line 22662 "" comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd - 1]; -#line 22670 "" +#line 22663 "" comtrill_1.icrdat[icrd - 1] = max(0,ipnew) | comtrill_1.icrdat[icrd - 1]; -#line 22671 "" +#line 22664 "" /* L27: */ -#line 22671 "" +#line 22664 "" } -#line 22672 "" +#line 22665 "" i__2 = comtrill_1.nudorn; -#line 22672 "" +#line 22665 "" for (iudorn = 1; iudorn <= i__2; ++iudorn) { -#line 22673 "" +#line 22666 "" commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1]; -#line 22674 "" +#line 22667 "" ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22675 "" +#line 22668 "" if (all_1.ibar > 2) { -#line 22675 "" +#line 22668 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22675 "" +#line 22668 "" } -#line 22676 "" +#line 22669 "" comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[ iudorn - 1]; -#line 22677 "" +#line 22670 "" comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) | comtrill_1.kudorn[iudorn - 1]; -#line 22678 "" +#line 22671 "" /* L29: */ -#line 22678 "" +#line 22671 "" } -#line 22679 "" +#line 22672 "" i__2 = comdyn_1.ndyn; -#line 22679 "" +#line 22672 "" for (idyn = 1; idyn <= i__2; ++idyn) { -#line 22680 "" +#line 22673 "" idynd = comdyn_1.idyndat[idyn - 1]; -#line 22681 "" +#line 22674 "" commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[ idyn - 1], &c__1, &c__10) << 4); -#line 22682 "" +#line 22675 "" ipnew = igetbits_(&idynd, &c__8, &c__4) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; /* The following construction avoids array bound errors in some compilers */ -#line 22686 "" +#line 22679 "" if (all_1.ibar > 2) { -#line 22687 "" +#line 22680 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22688 "" +#line 22681 "" } -#line 22689 "" +#line 22682 "" ipnew = i_dim(&ipnew, &c__0); -#line 22690 "" +#line 22683 "" setbits_(&idynd, &c__8, &c__4, &ipnew); -#line 22691 "" +#line 22684 "" comdyn_1.idyndat[idyn - 1] = idynd; -#line 22692 "" +#line 22685 "" /* L42: */ -#line 22692 "" +#line 22685 "" } -#line 22693 "" +#line 22686 "" i__2 = comdyn_1.ntxtdyn; -#line 22693 "" +#line 22686 "" for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) { -#line 22694 "" +#line 22687 "" idynd = comdyn_1.ivxiptxt[itxtdyn - 1]; -#line 22695 "" +#line 22688 "" commvl_1.ivx = 31 & idynd; -#line 22696 "" +#line 22689 "" ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22697 "" +#line 22690 "" if (all_1.ibar > 2) { -#line 22698 "" +#line 22691 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22699 "" +#line 22692 "" } -#line 22700 "" +#line 22693 "" ipnew = i_dim(&ipnew, &c__0); /* call setbits(idynd,8,4,ipnew) */ -#line 22702 "" +#line 22695 "" setbits_(&idynd, &c__8, &c__5, &ipnew); -#line 22703 "" +#line 22696 "" comdyn_1.ivxiptxt[itxtdyn - 1] = idynd; -#line 22704 "" +#line 22697 "" /* L43: */ -#line 22704 "" +#line 22697 "" } -#line 22705 "" +#line 22698 "" i__2 = all_1.nsdat; -#line 22705 "" +#line 22698 "" for (isdat = 1; isdat <= i__2; ++isdat) { -#line 22706 "" +#line 22699 "" isdata = all_1.isdat1[isdat - 1]; -#line 22707 "" +#line 22700 "" commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13) + (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25]; -#line 22708 "" +#line 22701 "" ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22709 "" +#line 22702 "" if (all_1.ibar > 2) { -#line 22710 "" +#line 22703 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22711 "" +#line 22704 "" } -#line 22712 "" +#line 22705 "" ipnew = i_dim(&ipnew, &c__0); -#line 22713 "" +#line 22706 "" setbits_(&isdata, &c__8, &c__3, &ipnew); -#line 22714 "" +#line 22707 "" all_1.isdat1[isdat - 1] = isdata; -#line 22715 "" +#line 22708 "" /* L41: */ -#line 22715 "" +#line 22708 "" } -#line 22716 "" +#line 22709 "" i__2 = comcb_1.nbc; -#line 22716 "" +#line 22709 "" for (ibc = 1; ibc <= i__2; ++ibc) { -#line 22717 "" +#line 22710 "" commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(& comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4); -#line 22718 "" +#line 22711 "" ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) - all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; -#line 22719 "" +#line 22712 "" if (all_1.ibar > 2) { -#line 22720 "" +#line 22713 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; -#line 22721 "" +#line 22714 "" } -#line 22722 "" +#line 22715 "" ipnew = i_dim(&ipnew, &c__0); -#line 22723 "" +#line 22716 "" setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew); -#line 22724 "" +#line 22717 "" /* L44: */ -#line 22724 "" +#line 22717 "" } -#line 22725 "" +#line 22718 "" i__2 = comarpshift_1.numarpshift; -#line 22725 "" +#line 22718 "" for (iarps = 1; iarps <= i__2; ++iarps) { -#line 22726 "" +#line 22719 "" comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[ comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1) * 24 - 25]; -#line 22728 "" +#line 22721 "" if (all_1.ibar > 2) { -#line 22729 "" +#line 22722 "" comarpshift_1.iparpshift[iarps - 1] += all_1.nib[ comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 2) * 24 - 25]; -#line 22731 "" +#line 22724 "" } -#line 22732 "" +#line 22725 "" /* L45: */ -#line 22732 "" +#line 22725 "" } /* Bookkeeping for figures. This will set nfigs = 0 if there are no figs left. */ /* If there are figs left, it will reset all times relative to start of */ /* current bar. */ -#line 22738 "" +#line 22731 "" for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) { -#line 22739 "" +#line 22732 "" if (all_1.figbass) { -#line 22740 "" +#line 22733 "" islide = 0; -#line 22741 "" +#line 22734 "" i__2 = comfig_1.nfigs[commvl_1.ivx - 1]; -#line 22741 "" +#line 22734 "" for (jfig = 1; jfig <= i__2; ++jfig) { -#line 22742 "" +#line 22735 "" if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] < all_1.lenbar) { /* This figure was already used */ -#line 22746 "" +#line 22739 "" islide = jfig; -#line 22747 "" +#line 22740 "" } else { -#line 22748 "" +#line 22741 "" comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.itfig[commvl_1.ivx + ( jfig << 1) - 3] - all_1.lenbar; -#line 22749 "" +#line 22742 "" s_copy(comfig_1.figq + (commvl_1.ivx + (jfig - islide << 1) - 3) * 10, comfig_1.figq + ( commvl_1.ivx + (jfig << 1) - 3) * 10, ( ftnlen)10, (ftnlen)10); -#line 22750 "" +#line 22743 "" comgrace_1.itoff[commvl_1.ivx + (jfig - islide << 1) - 3] = comgrace_1.itoff[commvl_1.ivx + (jfig << 1) - 3]; -#line 22751 "" +#line 22744 "" comfig_1.ivupfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.ivupfig[commvl_1.ivx + (jfig << 1) - 3]; -#line 22752 "" +#line 22745 "" comfig_1.ivvfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.ivvfig[commvl_1.ivx + ( jfig << 1) - 3]; -#line 22753 "" +#line 22746 "" } -#line 22754 "" +#line 22747 "" /* L20: */ -#line 22754 "" +#line 22747 "" } -#line 22755 "" +#line 22748 "" comfig_1.nfigs[commvl_1.ivx - 1] -= islide; -#line 22756 "" +#line 22749 "" } -#line 22757 "" +#line 22750 "" if (comfig_1.nfigs[1] == 0) { -#line 22757 "" +#line 22750 "" goto L47; -#line 22757 "" +#line 22750 "" } -#line 22758 "" +#line 22751 "" /* L46: */ -#line 22758 "" +#line 22751 "" } -#line 22759 "" +#line 22752 "" L47: -#line 22760 "" +#line 22753 "" ; -#line 22760 "" +#line 22753 "" } /* End of sliding down for bars after first in gulp. */ /* The following may not be needed by makeabar, but just in case... */ -#line 22766 "" +#line 22759 "" if (all_1.firstgulp && all_1.lenb0 != 0) { -#line 22767 "" +#line 22760 "" if (all_1.ibar == 1) { -#line 22768 "" +#line 22761 "" all_1.lenbar = all_1.lenb0; -#line 22769 "" +#line 22762 "" } else { -#line 22770 "" +#line 22763 "" all_1.lenbar = all_1.lenb1; -#line 22771 "" +#line 22764 "" } -#line 22772 "" +#line 22765 "" } /* Equal line spacing stuff */ -#line 22776 "" +#line 22769 "" if (comget_1.equalize && comask_1.bar1syst) { -#line 22777 "" +#line 22770 "" if (isystpg == 1) { -#line 22778 "" +#line 22771 "" s_wsfe(&io___1571); /* Writing concatenation */ -#line 22778 "" +#line 22771 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22778 "" +#line 22771 "" i__6[1] = 8, a__4[1] = "starteq%"; -#line 22778 "" +#line 22771 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 22778 "" +#line 22771 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22778 "" +#line 22771 "" e_wsfe(); -#line 22779 "" +#line 22772 "" } else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1) { -#line 22780 "" +#line 22773 "" s_wsfe(&io___1572); /* Writing concatenation */ -#line 22780 "" +#line 22773 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22780 "" +#line 22773 "" i__6[1] = 6, a__4[1] = "endeq%"; -#line 22780 "" +#line 22773 "" s_cat(ch__41, a__4, i__6, &c__2, (ftnlen)7); -#line 22780 "" +#line 22773 "" do_fio(&c__1, ch__41, (ftnlen)7); -#line 22780 "" +#line 22773 "" e_wsfe(); -#line 22781 "" +#line 22774 "" } -#line 22782 "" +#line 22775 "" } -#line 22783 "" +#line 22776 "" make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms, istart); -#line 22785 "" +#line 22778 "" make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop, numbms, istart, comclefq_1.clefq, (ftnlen)1); /* Hardspace before barline? */ -#line 22790 "" +#line 22783 "" hardb4 = 0.f; -#line 22791 "" +#line 22784 "" i__2 = all_1.nv; -#line 22791 "" +#line 22784 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { -#line 22792 "" +#line 22785 "" i__7 = commvl_1.nvmx[all_1.iv - 1]; -#line 22792 "" +#line 22785 "" for (kv = 1; kv <= i__7; ++kv) { -#line 22793 "" +#line 22786 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; -#line 22794 "" +#line 22787 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],18)) { -#line 22795 "" +#line 22788 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; /* Computing MAX */ -#line 22796 "" +#line 22789 "" r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25]; -#line 22796 "" +#line 22789 "" hardb4 = dmax(r__1,r__2); -#line 22797 "" +#line 22790 "" } -#line 22798 "" -/* L35: */ -#line 22798 "" +#line 22791 "" +/* L3599: */ +#line 22791 "" } -#line 22798 "" +#line 22792 "" +/* L35: */ +#line 22792 "" } -#line 22799 "" +#line 22793 "" if (hardb4 > 0.f) { -#line 22800 "" +#line 22794 "" if (comlast_1.islast) { -#line 22800 "" +#line 22794 "" s_wsfe(&io___1580); /* Writing concatenation */ -#line 22800 "" +#line 22794 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22800 "" +#line 22794 "" i__6[1] = 10, a__4[1] = "hardspace{"; -#line 22800 "" +#line 22794 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); -#line 22800 "" +#line 22794 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22800 "" +#line 22794 "" do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real)); -#line 22800 "" +#line 22794 "" do_fio(&c__1, "pt}%", (ftnlen)4); -#line 22800 "" +#line 22794 "" e_wsfe(); -#line 22800 "" +#line 22794 "" } /* This was causing an incorrect poe in an example, which did not affect main */ /* spacing, but did cause an extra accidental space to be too small */ -#line 22806 "" +#line 22800 "" comask_1.fixednew -= hardb4; -#line 22807 "" +#line 22801 "" } -#line 22808 "" +#line 22802 "" /* L10: */ -#line 22808 "" +#line 22802 "" } -#line 22809 "" +#line 22803 "" all_1.firstgulp = FALSE_; -#line 22810 "" +#line 22804 "" all_1.lenb0 = 0; -#line 22811 "" +#line 22805 "" goto L30; -#line 22812 "" +#line 22806 "" L40: -#line 22812 "" +#line 22806 "" cl__1.cerr = 0; -#line 22812 "" +#line 22806 "" cl__1.cunit = 12; -#line 22812 "" +#line 22806 "" cl__1.csta = 0; -#line 22812 "" +#line 22806 "" f_clos(&cl__1); -#line 22813 "" +#line 22807 "" cl__1.cerr = 0; -#line 22813 "" +#line 22807 "" cl__1.cunit = 13; -#line 22813 "" +#line 22807 "" cl__1.csta = 0; -#line 22813 "" +#line 22807 "" f_clos(&cl__1); -#line 22814 "" +#line 22808 "" inbuff_1.ilbuf = 1; -#line 22815 "" +#line 22809 "" inbuff_1.ipbuf = 0; -#line 22816 "" +#line 22810 "" wdpt = comtop_1.widthpt; -#line 22817 "" +#line 22811 "" if (all_1.iline == 1) { -#line 22817 "" +#line 22811 "" wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); -#line 22817 "" +#line 22811 "" } -#line 22818 "" +#line 22812 "" poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew) / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold); -#line 22820 "" +#line 22814 "" poevec[nsyst] = poe; -#line 22821 "" +#line 22815 "" if (! comlast_1.islast) { -#line 22822 "" +#line 22816 "" cl__1.cerr = 0; -#line 22822 "" +#line 22816 "" cl__1.cunit = 11; -#line 22822 "" +#line 22816 "" cl__1.csta = 0; -#line 22822 "" +#line 22816 "" f_clos(&cl__1); -#line 22823 "" +#line 22817 "" cl__1.cerr = 0; -#line 22823 "" +#line 22817 "" cl__1.cunit = 16; -#line 22823 "" +#line 22817 "" cl__1.csta = 0; -#line 22823 "" +#line 22817 "" f_clos(&cl__1); -#line 22824 "" +#line 22818 "" if (all_1.figbass) { -#line 22824 "" +#line 22818 "" cl__1.cerr = 0; -#line 22824 "" +#line 22818 "" cl__1.cunit = 14; -#line 22824 "" +#line 22818 "" cl__1.csta = 0; -#line 22824 "" +#line 22818 "" f_clos(&cl__1); -#line 22824 "" +#line 22818 "" } -#line 22825 "" +#line 22819 "" return 0; -#line 22826 "" +#line 22820 "" } -#line 22827 "" +#line 22821 "" i__1 = comas2_1.nasksys; -#line 22827 "" +#line 22821 "" for (ia = 1; ia <= i__1; ++ia) { -#line 22828 "" +#line 22822 "" ++comas3_1.iask; -#line 22829 "" +#line 22823 "" comas3_1.ask[comas3_1.iask - 1] = (comas2_1.wasksys[ia - 1] / poe - ( r__1 = comas2_1.elasksys[ia - 1], dabs(r__1))) / comshort_1.poefa[all_1.iline - 1]; -#line 22830 "" +#line 22824 "" if (comas2_1.elasksys[ia - 1] > 0.f) { -#line 22830 "" +#line 22824 "" comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ comas3_1.iask - 1], &c_b1008); -#line 22830 "" +#line 22824 "" } -#line 22831 "" +#line 22825 "" /* L19: */ -#line 22831 "" +#line 22825 "" } -#line 22832 "" +#line 22826 "" i__1 = nhssys; -#line 22832 "" +#line 22826 "" for (ia = 1; ia <= i__1; ++ia) { -#line 22833 "" +#line 22827 "" ++nhstot; /* Computing MAX */ -#line 22834 "" +#line 22828 "" r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; -#line 22834 "" +#line 22828 "" comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); -#line 22835 "" +#line 22829 "" /* L26: */ -#line 22835 "" +#line 22829 "" } -#line 22836 "" +#line 22830 "" if (comlast_1.islast && onvolt) { -#line 22836 "" +#line 22830 "" s_wsfe(&io___1581); /* Writing concatenation */ -#line 22836 "" +#line 22830 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22836 "" +#line 22830 "" i__6[1] = 11, a__4[1] = "endvoltabox"; -#line 22836 "" +#line 22830 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); -#line 22836 "" +#line 22830 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22836 "" +#line 22830 "" e_wsfe(); -#line 22836 "" +#line 22830 "" } -#line 22838 "" +#line 22832 "" s_copy(rendq, "% ", (ftnlen)3, (ftnlen)3); -#line 22839 "" +#line 22833 "" if (comshort_1.ishort != 0) { -#line 22839 "" +#line 22833 "" s_copy(rendq, "}}%", (ftnlen)3, (ftnlen)3); -#line 22839 "" +#line 22833 "" } -#line 22840 "" +#line 22834 "" if (*(unsigned char *)comget_1.rptfq2 != 'E') { /* Terminal repeat. Right or double? */ -#line 22844 "" +#line 22838 "" if (*(unsigned char *)comget_1.rptfq2 == 'r') { -#line 22845 "" +#line 22839 "" if (comlast_1.islast) { -#line 22845 "" +#line 22839 "" s_wsfe(&io___1583); /* Writing concatenation */ -#line 22845 "" +#line 22839 "" i__12[0] = 1, a__9[0] = all_1.sq; -#line 22845 "" +#line 22839 "" i__12[1] = 14, a__9[1] = "setrightrepeat"; -#line 22845 "" +#line 22839 "" i__12[2] = 1, a__9[2] = all_1.sq; -#line 22845 "" +#line 22839 "" i__12[3] = 8, a__9[3] = "endpiece"; -#line 22845 "" +#line 22839 "" i__12[4] = 3, a__9[4] = rendq; -#line 22845 "" +#line 22839 "" s_cat(ch__5, a__9, i__12, &c__5, (ftnlen)27); -#line 22845 "" +#line 22839 "" do_fio(&c__1, ch__5, (ftnlen)27); -#line 22845 "" +#line 22839 "" e_wsfe(); -#line 22845 "" +#line 22839 "" } -#line 22847 "" +#line 22841 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { -#line 22848 "" +#line 22842 "" if (comlast_1.islast) { -#line 22848 "" +#line 22842 "" s_wsfe(&io___1584); /* Writing concatenation */ -#line 22848 "" +#line 22842 "" i__12[0] = 1, a__9[0] = all_1.sq; -#line 22848 "" +#line 22842 "" i__12[1] = 12, a__9[1] = "setdoublebar"; -#line 22848 "" +#line 22842 "" i__12[2] = 1, a__9[2] = all_1.sq; -#line 22848 "" +#line 22842 "" i__12[3] = 8, a__9[3] = "endpiece"; -#line 22848 "" +#line 22842 "" i__12[4] = 3, a__9[4] = rendq; -#line 22848 "" +#line 22842 "" s_cat(ch__42, a__9, i__12, &c__5, (ftnlen)25); -#line 22848 "" +#line 22842 "" do_fio(&c__1, ch__42, (ftnlen)25); -#line 22848 "" +#line 22842 "" e_wsfe(); -#line 22848 "" +#line 22842 "" } -#line 22850 "" +#line 22844 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { -#line 22851 "" +#line 22845 "" if (comlast_1.islast) { -#line 22851 "" +#line 22845 "" s_wsfe(&io___1585); /* Writing concatenation */ -#line 22851 "" +#line 22845 "" i__8[0] = 1, a__5[0] = all_1.sq; -#line 22851 "" +#line 22845 "" i__8[1] = 8, a__5[1] = "endpiece"; -#line 22851 "" +#line 22845 "" i__8[2] = 3, a__5[2] = rendq; -#line 22851 "" +#line 22845 "" s_cat(ch__14, a__5, i__8, &c__3, (ftnlen)12); -#line 22851 "" +#line 22845 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22851 "" +#line 22845 "" e_wsfe(); -#line 22851 "" +#line 22845 "" } -#line 22852 "" +#line 22846 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'z') { -#line 22853 "" +#line 22847 "" if (comlast_1.islast) { -#line 22853 "" +#line 22847 "" s_wsfe(&io___1586); /* Writing concatenation */ -#line 22853 "" +#line 22847 "" i__12[0] = 1, a__9[0] = all_1.sq; -#line 22853 "" +#line 22847 "" i__12[1] = 12, a__9[1] = "setzalaligne"; -#line 22853 "" +#line 22847 "" i__12[2] = 1, a__9[2] = all_1.sq; -#line 22853 "" +#line 22847 "" i__12[3] = 8, a__9[3] = "Endpiece"; -#line 22853 "" +#line 22847 "" i__12[4] = 3, a__9[4] = rendq; -#line 22853 "" +#line 22847 "" s_cat(ch__42, a__9, i__12, &c__5, (ftnlen)25); -#line 22853 "" +#line 22847 "" do_fio(&c__1, ch__42, (ftnlen)25); -#line 22853 "" +#line 22847 "" e_wsfe(); -#line 22853 "" +#line 22847 "" } -#line 22855 "" +#line 22849 "" } else { -#line 22856 "" +#line 22850 "" s_wsle(&io___1587); -#line 22856 "" +#line 22850 "" e_wsle(); -#line 22857 "" +#line 22851 "" s_wsle(&io___1588); -#line 22857 "" +#line 22851 "" do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ "q2:", (ftnlen)37); -#line 22857 "" +#line 22851 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); -#line 22857 "" +#line 22851 "" e_wsle(); -#line 22858 "" +#line 22852 "" s_wsle(&io___1589); -#line 22858 "" +#line 22852 "" do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ "q2:", (ftnlen)37); -#line 22858 "" +#line 22852 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); -#line 22858 "" +#line 22852 "" e_wsle(); -#line 22859 "" +#line 22853 "" if (comlast_1.islast) { -#line 22859 "" +#line 22853 "" s_wsfe(&io___1590); /* Writing concatenation */ -#line 22859 "" +#line 22853 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22859 "" +#line 22853 "" i__6[1] = 8, a__4[1] = "Endpiece"; -#line 22859 "" +#line 22853 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 22859 "" +#line 22853 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22859 "" +#line 22853 "" e_wsfe(); -#line 22859 "" +#line 22853 "" } -#line 22860 "" +#line 22854 "" } -#line 22861 "" +#line 22855 "" } else { -#line 22862 "" +#line 22856 "" s_wsfe(&io___1591); /* Writing concatenation */ -#line 22862 "" +#line 22856 "" i__8[0] = 1, a__5[0] = all_1.sq; -#line 22862 "" +#line 22856 "" i__8[1] = 8, a__5[1] = "Endpiece"; -#line 22862 "" +#line 22856 "" i__8[2] = 3, a__5[2] = rendq; -#line 22862 "" +#line 22856 "" s_cat(ch__14, a__5, i__8, &c__3, (ftnlen)12); -#line 22862 "" +#line 22856 "" do_fio(&c__1, ch__14, (ftnlen)12); -#line 22862 "" +#line 22856 "" e_wsfe(); -#line 22863 "" +#line 22857 "" } -#line 22864 "" +#line 22858 "" if (! vshrink) { -#line 22865 "" +#line 22859 "" if (comlast_1.islast && combottop_1.bottopgap) { -#line 22866 "" +#line 22860 "" if (dabs(combottop_1.botamt) > 1e-6f) { -#line 22867 "" +#line 22861 "" if (combottop_1.botamt > 9.95f) { -#line 22868 "" +#line 22862 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); -#line 22869 "" +#line 22863 "" } else if (combottop_1.botamt > 0.f) { -#line 22870 "" +#line 22864 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); -#line 22871 "" +#line 22865 "" } else if (combottop_1.botamt > -9.95f) { -#line 22872 "" +#line 22866 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); -#line 22873 "" +#line 22867 "" } else { -#line 22874 "" +#line 22868 "" s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10); -#line 22875 "" +#line 22869 "" } -#line 22876 "" +#line 22870 "" s_wsfe(&io___1592); /* Writing concatenation */ -#line 22876 "" +#line 22870 "" i__5[0] = 1, a__3[0] = all_1.sq; -#line 22876 "" +#line 22870 "" i__5[1] = 4, a__3[1] = "null"; -#line 22876 "" +#line 22870 "" i__5[2] = 1, a__3[2] = all_1.sq; -#line 22876 "" +#line 22870 "" i__5[3] = 5, a__3[3] = "vskip"; -#line 22876 "" +#line 22870 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); -#line 22876 "" +#line 22870 "" do_fio(&c__1, ch__15, (ftnlen)11); -#line 22876 "" +#line 22870 "" do_fio(&c__1, (char *)&combottop_1.botamt, (ftnlen)sizeof( real)); /* Writing concatenation */ -#line 22876 "" +#line 22870 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22876 "" +#line 22870 "" i__6[1] = 10, a__4[1] = "Internote%"; -#line 22876 "" +#line 22870 "" s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11); -#line 22876 "" +#line 22870 "" do_fio(&c__1, ch__32, (ftnlen)11); -#line 22876 "" +#line 22870 "" e_wsfe(); -#line 22878 "" +#line 22872 "" } -#line 22879 "" +#line 22873 "" } -#line 22880 "" +#line 22874 "" xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop; -#line 22881 "" +#line 22875 "" if (xnstbot < 9.95f) { -#line 22882 "" +#line 22876 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); -#line 22883 "" +#line 22877 "" } else { -#line 22884 "" +#line 22878 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); -#line 22885 "" +#line 22879 "" } -#line 22886 "" +#line 22880 "" if (comlast_1.islast) { -#line 22886 "" +#line 22880 "" s_wsfe(&io___1593); /* Writing concatenation */ -#line 22886 "" +#line 22880 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22886 "" +#line 22880 "" i__6[1] = 5, a__4[1] = "vskip"; -#line 22886 "" +#line 22880 "" s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6); -#line 22886 "" +#line 22880 "" do_fio(&c__1, ch__25, (ftnlen)6); -#line 22886 "" +#line 22880 "" do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real)); /* Writing concatenation */ -#line 22886 "" +#line 22880 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22886 "" +#line 22880 "" i__4[1] = 10, a__2[1] = "Interligne"; -#line 22886 "" +#line 22880 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22886 "" +#line 22880 "" i__4[3] = 5, a__2[3] = "eject"; -#line 22886 "" +#line 22880 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22886 "" +#line 22880 "" i__4[5] = 9, a__2[5] = "endmuflex"; -#line 22886 "" +#line 22880 "" s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); -#line 22886 "" +#line 22880 "" do_fio(&c__1, ch__5, (ftnlen)27); -#line 22886 "" +#line 22880 "" e_wsfe(); -#line 22886 "" +#line 22880 "" } -#line 22888 "" +#line 22882 "" if (comlast_1.islast) { -#line 22888 "" +#line 22882 "" s_wsfe(&io___1594); /* Writing concatenation */ -#line 22888 "" +#line 22882 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22888 "" +#line 22882 "" i__6[1] = 3, a__4[1] = "bye"; -#line 22888 "" +#line 22882 "" s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); -#line 22888 "" +#line 22882 "" do_fio(&c__1, ch__21, (ftnlen)4); -#line 22888 "" +#line 22882 "" e_wsfe(); -#line 22888 "" +#line 22882 "" } -#line 22889 "" +#line 22883 "" } else { -#line 22890 "" +#line 22884 "" if (comlast_1.islast) { -#line 22890 "" +#line 22884 "" s_wsfe(&io___1595); /* Writing concatenation */ -#line 22890 "" +#line 22884 "" i__4[0] = 1, a__2[0] = all_1.sq; -#line 22890 "" +#line 22884 "" i__4[1] = 5, a__2[1] = "vfill"; -#line 22890 "" +#line 22884 "" i__4[2] = 1, a__2[2] = all_1.sq; -#line 22890 "" +#line 22884 "" i__4[3] = 5, a__2[3] = "eject"; -#line 22890 "" +#line 22884 "" i__4[4] = 1, a__2[4] = all_1.sq; -#line 22890 "" +#line 22884 "" i__4[5] = 9, a__2[5] = "endmuflex"; -#line 22890 "" +#line 22884 "" s_cat(ch__43, a__2, i__4, &c__6, (ftnlen)22); -#line 22890 "" +#line 22884 "" do_fio(&c__1, ch__43, (ftnlen)22); -#line 22890 "" +#line 22884 "" e_wsfe(); -#line 22890 "" +#line 22884 "" } -#line 22892 "" +#line 22886 "" if (comlast_1.islast) { -#line 22892 "" +#line 22886 "" s_wsfe(&io___1596); /* Writing concatenation */ -#line 22892 "" +#line 22886 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22892 "" +#line 22886 "" i__6[1] = 3, a__4[1] = "bye"; -#line 22892 "" +#line 22886 "" s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); -#line 22892 "" +#line 22886 "" do_fio(&c__1, ch__21, (ftnlen)4); -#line 22892 "" +#line 22886 "" e_wsfe(); -#line 22892 "" +#line 22886 "" } -#line 22893 "" +#line 22887 "" } -#line 22894 "" +#line 22888 "" al__1.aerr = 0; -#line 22894 "" +#line 22888 "" al__1.aunit = 11; -#line 22894 "" +#line 22888 "" f_rew(&al__1); -#line 22895 "" +#line 22889 "" if (all_1.figbass) { -#line 22896 "" +#line 22890 "" s_wsfe(&io___1597); /* Writing concatenation */ -#line 22896 "" +#line 22890 "" i__6[0] = 1, a__4[0] = all_1.sq; -#line 22896 "" +#line 22890 "" i__6[1] = 8, a__4[1] = "figdrop="; -#line 22896 "" +#line 22890 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); -#line 22896 "" +#line 22890 "" do_fio(&c__1, ch__18, (ftnlen)9); -#line 22896 "" +#line 22890 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen) sizeof(integer)); /* Writing concatenation */ -#line 22896 "" +#line 22890 "" i__8[0] = 1, a__5[0] = " "; -#line 22896 "" +#line 22890 "" i__8[1] = 1, a__5[1] = all_1.sq; -#line 22896 "" +#line 22890 "" i__8[2] = 8, a__5[2] = "figdtwo="; -#line 22896 "" +#line 22890 "" s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); -#line 22896 "" +#line 22890 "" do_fio(&c__1, ch__20, (ftnlen)10); -#line 22896 "" +#line 22890 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen) sizeof(integer)); /* Writing concatenation */ -#line 22896 "" +#line 22890 "" i__11[0] = 1, a__8[0] = all_1.sq; -#line 22896 "" +#line 22890 "" i__11[1] = 4, a__8[1] = "fi}%"; -#line 22896 "" +#line 22890 "" s_cat(ch__40, a__8, i__11, &c__2, (ftnlen)5); -#line 22896 "" +#line 22890 "" do_fio(&c__1, ch__40, (ftnlen)5); -#line 22896 "" +#line 22890 "" e_wsfe(); -#line 22899 "" +#line 22893 "" al__1.aerr = 0; -#line 22899 "" +#line 22893 "" al__1.aunit = 14; -#line 22899 "" +#line 22893 "" f_rew(&al__1); -#line 22900 "" +#line 22894 "" } -#line 22901 "" +#line 22895 "" askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, ( ftnlen)40, (ftnlen)44); -#line 22902 "" +#line 22896 "" if (! (*optimize)) { -#line 22903 "" +#line 22897 "" s_wsle(&io___1598); -#line 22903 "" +#line 22897 "" e_wsle(); -#line 22904 "" +#line 22898 "" s_wsle(&io___1599); /* Writing concatenation */ -#line 22904 "" +#line 22898 "" i__5[0] = 8, a__3[0] = "Writing "; -#line 22904 "" +#line 22898 "" i__5[1] = lpath, a__3[1] = pathnameq; -#line 22904 "" +#line 22898 "" i__5[2] = lbase, a__3[2] = basenameq; -#line 22904 "" +#line 22898 "" i__5[3] = 4, a__3[3] = ".tex"; -#line 22904 "" +#line 22898 "" s_cat(ch__44, a__3, i__5, &c__4, (ftnlen)96); -#line 22904 "" +#line 22898 "" do_lio(&c__9, &c__1, ch__44, lpath + 8 + lbase + 4); -#line 22904 "" +#line 22898 "" e_wsle(); -#line 22906 "" +#line 22900 "" s_wsle(&io___1600); -#line 22906 "" +#line 22900 "" do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26); -#line 22906 "" +#line 22900 "" e_wsle(); -#line 22907 "" +#line 22901 "" s_wsfe(&io___1601); /* Writing concatenation */ -#line 22907 "" +#line 22901 "" i__5[0] = 8, a__3[0] = "Writing "; -#line 22907 "" +#line 22901 "" i__5[1] = lpath, a__3[1] = pathnameq; -#line 22907 "" +#line 22901 "" i__5[2] = lbase, a__3[2] = basenameq; -#line 22907 "" +#line 22901 "" i__5[3] = 4, a__3[3] = ".tex"; -#line 22907 "" +#line 22901 "" s_cat(ch__44, a__3, i__5, &c__4, (ftnlen)96); -#line 22907 "" +#line 22901 "" do_fio(&c__1, ch__44, lpath + 8 + lbase + 4); -#line 22907 "" +#line 22901 "" e_wsfe(); -#line 22909 "" +#line 22903 "" s_wsfe(&io___1602); -#line 22909 "" +#line 22903 "" do_fio(&c__1, " Done with second PMX pass. Now run TeX", (ftnlen)40); -#line 22909 "" +#line 22903 "" e_wsfe(); -#line 22910 "" +#line 22904 "" } -#line 22911 "" +#line 22905 "" return 0; } /* pmxb_ */ @@ -56492,41 +56769,41 @@ L40: /* Compute avg. & norm. std. dev. of poe. */ -#line 22919 "" +#line 22913 "" /* Parameter adjustments */ -#line 22919 "" +#line 22913 "" --poe; -#line 22919 "" +#line 22913 "" -#line 22919 "" +#line 22913 "" /* Function Body */ -#line 22919 "" +#line 22913 "" sumx = 0.f; -#line 22920 "" +#line 22914 "" sumxx = 0.f; -#line 22921 "" +#line 22915 "" i__1 = *nsyst; -#line 22921 "" +#line 22915 "" for (isyst = 1; isyst <= i__1; ++isyst) { -#line 22922 "" +#line 22916 "" sumx += poe[isyst]; /* Computing 2nd power */ -#line 22923 "" +#line 22917 "" r__1 = poe[isyst]; -#line 22923 "" +#line 22917 "" sumxx += r__1 * r__1; -#line 22924 "" +#line 22918 "" /* L1: */ -#line 22924 "" +#line 22918 "" } /* Computing 2nd power */ -#line 22925 "" +#line 22919 "" r__1 = sumx; -#line 22925 "" +#line 22919 "" *devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1); -#line 22926 "" +#line 22920 "" *poebar = sumx / *nsyst; -#line 22927 "" +#line 22921 "" return 0; } /* poestats_ */ @@ -56573,308 +56850,308 @@ L40: /* levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. */ /* icrdot(icrd)(27-29) sequence order of chord note if accid, top down */ -#line 22949 "" +#line 22943 "" for (i__ = 1; i__ <= 88; ++i__) { -#line 22950 "" +#line 22944 "" levtabl[i__ - 1] = 0; -#line 22951 "" +#line 22945 "" /* L11: */ -#line 22951 "" +#line 22945 "" } -#line 22952 "" +#line 22946 "" i__1 = comtrill_1.ncrd; -#line 22952 "" +#line 22946 "" for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) { -#line 22953 "" +#line 22947 "" ivx1 = (15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], ( ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd1 - 1], &c__1, &c__28) << 4); -#line 22955 "" +#line 22949 "" ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]; -#line 22956 "" +#line 22950 "" if (ip1 == *ip && ivx1 == *ivx) { -#line 22956 "" +#line 22950 "" goto L2; -#line 22956 "" +#line 22950 "" } -#line 22957 "" +#line 22951 "" /* L1: */ -#line 22957 "" +#line 22951 "" } -#line 22958 "" +#line 22952 "" s_wsle(&io___1610); -#line 22958 "" +#line 22952 "" e_wsle(); -#line 22959 "" +#line 22953 "" s_wsle(&io___1611); -#line 22959 "" +#line 22953 "" do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"\ "e to Dr. Don!", (ftnlen)63); -#line 22959 "" +#line 22953 "" e_wsle(); -#line 22961 "" +#line 22955 "" stop1_(); -#line 22962 "" +#line 22956 "" L2: -#line 22963 "" +#line 22957 "" comtrill_1.maxlev = *nolevm; -#line 22964 "" +#line 22958 "" comtrill_1.minlev = *nolevm; -#line 22965 "" +#line 22959 "" levtabl[*nolevm - 1] = -1; -#line 22966 "" +#line 22960 "" is2nd = FALSE_; -#line 22967 "" +#line 22961 "" naccid = 0; -#line 22968 "" +#line 22962 "" levmaxacc = -100; -#line 22969 "" +#line 22963 "" levminacc = 1000; /* Check 1st 3 bits of nacc for accid on main note of chord. */ -#line 22973 "" +#line 22967 "" if ((7 & *nacc) > 0) { -#line 22974 "" +#line 22968 "" naccid = 1; /* Start list of notes with accid's. There will be naccid of them. kicrd=0 if main, */ /* otherwise icrd value for note with accidental. */ -#line 22979 "" +#line 22973 "" kicrd[0] = 0; -#line 22980 "" +#line 22974 "" levmaxacc = *nolevm; -#line 22981 "" +#line 22975 "" levminacc = *nolevm; /* Start the level-ranking */ -#line 22985 "" +#line 22979 "" icrdot0 = 1; -#line 22986 "" +#line 22980 "" } -#line 22987 "" +#line 22981 "" i__1 = comtrill_1.ncrd; -#line 22987 "" +#line 22981 "" for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1; ++comtrill_1.icrd2) { -#line 22988 "" +#line 22982 "" nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, & c__12); -#line 22989 "" +#line 22983 "" levtabl[nolev - 1] = comtrill_1.icrd2; -#line 22990 "" +#line 22984 "" comtrill_1.maxlev = max(comtrill_1.maxlev,nolev); -#line 22991 "" +#line 22985 "" comtrill_1.minlev = min(comtrill_1.minlev,nolev); /* Check for accidental */ -#line 22995 "" +#line 22989 "" if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) { -#line 22996 "" +#line 22990 "" ++naccid; -#line 22997 "" +#line 22991 "" levmaxacc = max(levmaxacc,nolev); -#line 22998 "" +#line 22992 "" levminacc = min(levminacc,nolev); /* Add this icrd to list of values for notes with accid's. */ -#line 23002 "" +#line 22996 "" kicrd[naccid - 1] = comtrill_1.icrd2; -#line 23003 "" +#line 22997 "" if (! bit_test(*nacc,28)) { /* Order not forced, so get the level-ranking, top down */ -#line 23007 "" +#line 23001 "" iorder = 1; -#line 23008 "" +#line 23002 "" i__2 = naccid - 1; -#line 23008 "" +#line 23002 "" for (iaccid = 1; iaccid <= i__2; ++iaccid) { -#line 23009 "" +#line 23003 "" if (kicrd[iaccid - 1] == 0) { -#line 23010 "" +#line 23004 "" if (*nolevm > nolev) { -#line 23011 "" +#line 23005 "" ++iorder; -#line 23012 "" +#line 23006 "" } else { -#line 23013 "" +#line 23007 "" ++icrdot0; -#line 23014 "" +#line 23008 "" } -#line 23015 "" +#line 23009 "" } else { -#line 23016 "" +#line 23010 "" if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] - 1], &c__7, &c__12) > nolev) { -#line 23018 "" +#line 23012 "" ++iorder; -#line 23019 "" +#line 23013 "" } else { -#line 23020 "" +#line 23014 "" iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1], &c__3, &c__27); -#line 23021 "" +#line 23015 "" i__3 = iold + 1; -#line 23021 "" +#line 23015 "" setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1] , &c__3, &c__27, &i__3); -#line 23022 "" +#line 23016 "" } -#line 23023 "" +#line 23017 "" } -#line 23024 "" +#line 23018 "" /* L12: */ -#line 23024 "" +#line 23018 "" } -#line 23025 "" +#line 23019 "" setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, & c__27, &iorder); -#line 23026 "" +#line 23020 "" } -#line 23027 "" +#line 23021 "" } /* Exit loop if last note in this chord */ -#line 23031 "" +#line 23025 "" if (comtrill_1.icrd2 == comtrill_1.ncrd) { -#line 23031 "" +#line 23025 "" goto L4; -#line 23031 "" +#line 23025 "" } -#line 23032 "" +#line 23026 "" if (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__8, &c__0) != * ip || igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__4, & c__8) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], & c__1, &c__28) << 4) != *ivx) { -#line 23032 "" +#line 23026 "" goto L4; -#line 23032 "" +#line 23026 "" } /* * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */ -#line 23036 "" +#line 23030 "" /* L3: */ -#line 23036 "" +#line 23030 "" } -#line 23037 "" +#line 23031 "" s_wsle(&io___1622); -#line 23037 "" +#line 23031 "" e_wsle(); -#line 23038 "" +#line 23032 "" s_wsle(&io___1623); -#line 23038 "" +#line 23032 "" do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."\ " Don!", (ftnlen)55); -#line 23038 "" +#line 23032 "" e_wsle(); -#line 23039 "" +#line 23033 "" stop1_(); -#line 23040 "" +#line 23034 "" L4: /* Now icrd1, icrd2 define range of icrd for this chord. */ /* Bypass autos-shifting if any manual shifts are present */ -#line 23046 "" +#line 23040 "" if (bit_test(*irest,20) || bit_test(*irest,27)) { -#line 23046 "" +#line 23040 "" goto L10; -#line 23046 "" +#line 23040 "" } /* Check for 2nds */ -#line 23050 "" +#line 23044 "" for (ilev = 1; ilev <= 87; ++ilev) { -#line 23051 "" +#line 23045 "" if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) { /* There is at least one 2nd.. */ -#line 23055 "" +#line 23049 "" if (*(unsigned char *)udq == 'u') { /* Upstem. Start with 2nd just found and go up, rt-shifting upper */ /* member of each pair */ -#line 23060 "" +#line 23054 "" ile = ilev; /* Set main-note flag for ANY right-shift */ -#line 23064 "" +#line 23058 "" *irest = bit_set(*irest,20); -#line 23065 "" +#line 23059 "" L7: -#line 23066 "" +#line 23060 "" if (levtabl[ile] < 0) { /* Upstem, & upper member is main so must be rt-shifted. This would move */ /* stem too, so we rt-shift the OTHER note, and set flag that signals */ /* to interchange pitches just when these two notes are placed. */ -#line 23072 "" +#line 23066 "" *nacc = bit_set(*nacc,30); -#line 23073 "" +#line 23067 "" comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 1] - 1],24); -#line 23074 "" +#line 23068 "" } else { /* Upper member is chord note, must be rt-shifted */ -#line 23078 "" +#line 23072 "" comtrill_1.icrdat[levtabl[ile] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile] - 1],24); -#line 23079 "" +#line 23073 "" } -#line 23080 "" +#line 23074 "" ++ile; -#line 23081 "" +#line 23075 "" L8: -#line 23082 "" +#line 23076 "" ++ile; -#line 23083 "" +#line 23077 "" if (ile < 87) { -#line 23084 "" +#line 23078 "" if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) { -#line 23085 "" +#line 23079 "" goto L7; -#line 23086 "" +#line 23080 "" } else { -#line 23087 "" +#line 23081 "" goto L8; -#line 23088 "" +#line 23082 "" } -#line 23089 "" +#line 23083 "" } -#line 23090 "" +#line 23084 "" goto L10; -#line 23091 "" +#line 23085 "" } else { /* Downstem. Start at top and work down, left-shifting lower member of each pair. */ /* We know that lowest pair is at (ilev,ilev+1). */ -#line 23096 "" +#line 23090 "" ile = 88; /* Set main-note flag for ANY right-shift */ -#line 23100 "" +#line 23094 "" *irest = bit_set(*irest,27); -#line 23101 "" +#line 23095 "" L9: -#line 23102 "" +#line 23096 "" if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) { -#line 23103 "" +#line 23097 "" if (levtabl[ile - 2] < 0) { /* ipl = ibset(ipl,8) */ @@ -56882,57 +57159,57 @@ L9: /* stem too, so we left-shift the OTHER note, and set flag that signals */ /* to interchange pitches just when these two notes are placed. */ -#line 23110 "" +#line 23104 "" *nacc = bit_set(*nacc,31); -#line 23111 "" +#line 23105 "" comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 1] - 1],23); -#line 23112 "" +#line 23106 "" } else { /* Lower member is chord note, must be shifted */ -#line 23116 "" +#line 23110 "" comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 2] - 1],23); -#line 23118 "" +#line 23112 "" } -#line 23119 "" +#line 23113 "" --ile; -#line 23120 "" +#line 23114 "" } -#line 23121 "" +#line 23115 "" --ile; -#line 23122 "" +#line 23116 "" if (ile >= ilev + 1) { -#line 23122 "" +#line 23116 "" goto L9; -#line 23122 "" +#line 23116 "" } -#line 23123 "" +#line 23117 "" goto L10; -#line 23124 "" +#line 23118 "" } -#line 23125 "" +#line 23119 "" } -#line 23126 "" +#line 23120 "" /* L5: */ -#line 23126 "" +#line 23120 "" } -#line 23127 "" +#line 23121 "" L10: /* Done with 2nds, now do accid's. Call even if just one, in case left shifts. */ /* if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, */ -#line 23132 "" +#line 23126 "" if (naccid >= 1) { -#line 23132 "" +#line 23126 "" crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, & levminacc, &icrdot0, twooftwo, icashft); -#line 23132 "" +#line 23126 "" } -#line 23134 "" +#line 23128 "" return 0; } /* precrd_ */ @@ -56951,19 +57228,19 @@ L10: /* Send string to console and to log file */ -#line 23141 "" +#line 23135 "" s_wsle(&io___1626); -#line 23141 "" +#line 23135 "" do_lio(&c__9, &c__1, string, string_len); -#line 23141 "" +#line 23135 "" e_wsle(); -#line 23142 "" +#line 23136 "" s_wsfe(&io___1627); -#line 23142 "" +#line 23136 "" do_fio(&c__1, string, string_len); -#line 23142 "" +#line 23136 "" e_wsfe(); -#line 23143 "" +#line 23137 "" return 0; } /* printl_ */ @@ -57011,320 +57288,320 @@ L10: /* Find which iarp, if any */ -#line 23164 "" +#line 23158 "" i__1 = comarp_1.narp; -#line 23164 "" +#line 23158 "" for (iarp = 1; iarp <= i__1; ++iarp) { -#line 23165 "" +#line 23159 "" if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) < comtol_1.tol) { -#line 23165 "" +#line 23159 "" goto L2; -#line 23165 "" +#line 23159 "" } -#line 23166 "" +#line 23160 "" /* L1: */ -#line 23166 "" +#line 23160 "" } /* If here, this is the *first* call for this arp. */ -#line 23170 "" +#line 23164 "" ++comarp_1.narp; -#line 23171 "" +#line 23165 "" comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f; -#line 23172 "" +#line 23166 "" comarp_1.ivar1[comarp_1.narp - 1] = *iv; -#line 23173 "" +#line 23167 "" comarp_1.ipar1[comarp_1.narp - 1] = *ip; -#line 23174 "" +#line 23168 "" comarp_1.levar1[comarp_1.narp - 1] = *nolev; -#line 23175 "" +#line 23169 "" comarp_1.ncmar1[comarp_1.narp - 1] = *ncm; -#line 23176 "" +#line 23170 "" return 0; -#line 23177 "" +#line 23171 "" L2: /* If here, this is *second* call at this time, narp points to values from 1st. */ /* Check for shift. Set IsArpShift and iarps */ -#line 23183 "" +#line 23177 "" i__1 = comarpshift_1.numarpshift; -#line 23183 "" +#line 23177 "" for (iarps = 1; iarps <= i__1; ++iarps) { -#line 23184 "" +#line 23178 "" if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] && comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp - 1]) { -#line 23186 "" +#line 23180 "" isarpshift = TRUE_; /* Writing concatenation */ -#line 23187 "" +#line 23181 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23187 "" +#line 23181 "" i__2[0] = 1, a__1[0] = ch__1; -#line 23187 "" +#line 23181 "" i__2[1] = 8, a__1[1] = "loffset{"; -#line 23187 "" +#line 23181 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23188 "" +#line 23182 "" s_wsfi(&io___1633); -#line 23188 "" +#line 23182 "" do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen) sizeof(real)); -#line 23188 "" +#line 23182 "" do_fio(&c__1, "}{", (ftnlen)2); -#line 23188 "" +#line 23182 "" e_wsfi(); -#line 23189 "" +#line 23183 "" lnote = 14; -#line 23190 "" +#line 23184 "" goto L4; -#line 23191 "" +#line 23185 "" } -#line 23192 "" +#line 23186 "" /* L3: */ -#line 23192 "" +#line 23186 "" } -#line 23193 "" +#line 23187 "" isarpshift = FALSE_; -#line 23194 "" +#line 23188 "" lnote = 0; -#line 23195 "" +#line 23189 "" L4: -#line 23196 "" +#line 23190 "" if (*iv == comarp_1.ivar1[iarp - 1]) { /* Arp is in a single voice. */ /* Computing MIN */ -#line 23200 "" +#line 23194 "" i__1 = comarp_1.levar1[iarp - 1]; -#line 23200 "" +#line 23194 "" levbot = min(i__1,*nolev) - *ncm + 3; -#line 23201 "" +#line 23195 "" invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1; -#line 23202 "" +#line 23196 "" } else { /* Arp covers >1 voice. Lower voice has to be the first, upper is current and */ /* is where the symbol will be written. */ /* Check whether ivx's ivar1(iarp) & iv are in same staff */ -#line 23208 "" +#line 23202 "" for (iiv = 1; iiv <= 24; ++iiv) { -#line 23209 "" +#line 23203 "" if (commvl_1.ivmx[iiv - 1] == comarp_1.ivar1[iarp - 1] || commvl_1.nvmx[iiv - 1] == 2 && commvl_1.ivmx[iiv + 23] == comarp_1.ivar1[iarp - 1]) { -#line 23211 "" +#line 23205 "" iivivx1 = iiv; -#line 23212 "" +#line 23206 "" goto L6; -#line 23213 "" +#line 23207 "" } -#line 23214 "" +#line 23208 "" /* L5: */ -#line 23214 "" +#line 23208 "" } -#line 23215 "" +#line 23209 "" s_wsle(&io___1639); -#line 23215 "" +#line 23209 "" do_lio(&c__9, &c__1, "Screwup#1 in putarp", (ftnlen)19); -#line 23215 "" +#line 23209 "" e_wsle(); -#line 23216 "" +#line 23210 "" s_stop("", (ftnlen)0); -#line 23217 "" +#line 23211 "" L6: -#line 23218 "" +#line 23212 "" for (iiv = 1; iiv <= 24; ++iiv) { -#line 23219 "" +#line 23213 "" if (commvl_1.ivmx[iiv - 1] == *iv || commvl_1.nvmx[iiv - 1] == 2 && commvl_1.ivmx[iiv + 23] == *iv) { -#line 23219 "" +#line 23213 "" goto L8; -#line 23219 "" +#line 23213 "" } /* Found iv for both voices (iivivx1, iiv), done looking */ -#line 23224 "" +#line 23218 "" /* L7: */ -#line 23224 "" +#line 23218 "" } -#line 23225 "" +#line 23219 "" s_wsle(&io___1640); -#line 23225 "" +#line 23219 "" do_lio(&c__9, &c__1, "Screwup#2 in putarp", (ftnlen)19); -#line 23225 "" +#line 23219 "" e_wsle(); -#line 23226 "" +#line 23220 "" s_stop("", (ftnlen)0); -#line 23227 "" +#line 23221 "" L8: -#line 23228 "" +#line 23222 "" if (iivivx1 == iiv) { -#line 23229 "" +#line 23223 "" nstaffshift = 0; -#line 23230 "" +#line 23224 "" } else { -#line 23231 "" +#line 23225 "" r__1 = comarp_1.xinsnow * 2; -#line 23231 "" +#line 23225 "" nstaffshift = -i_nint(&r__1); -#line 23232 "" +#line 23226 "" } /* levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) */ -#line 23234 "" +#line 23228 "" levbot = nstaffshift + 3 + comarp_1.levar1[iarp - 1] - comarp_1.ncmar1[iarp - 1]; -#line 23235 "" +#line 23229 "" invert = -levbot + 4 + *nolev - *ncm; -#line 23236 "" +#line 23230 "" } /* isym will be (1,2) if invert is (even,odd). If even, raise .5\internote */ -#line 23240 "" +#line 23234 "" isym = invert % 2 + 1; -#line 23241 "" +#line 23235 "" ilvert = (invert + 1) / 2; -#line 23242 "" +#line 23236 "" if (levbot >= 0 && levbot <= 9) { /* Single digit */ -#line 23246 "" +#line 23240 "" if (! isarpshift) { /* Writing concatenation */ -#line 23247 "" +#line 23241 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23247 "" +#line 23241 "" i__3[0] = 1, a__2[0] = ch__1; -#line 23247 "" +#line 23241 "" i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); -#line 23247 "" +#line 23241 "" i__1 = levbot + 48; -#line 23247 "" +#line 23241 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 23247 "" +#line 23241 "" i__3[2] = 1, a__2[2] = ch__2; -#line 23247 "" +#line 23241 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 23248 "" +#line 23242 "" } else { /* Writing concatenation */ -#line 23249 "" +#line 23243 "" i__4[0] = lnote, a__3[0] = notexq; -#line 23249 "" +#line 23243 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23249 "" +#line 23243 "" i__4[1] = 1, a__3[1] = ch__1; -#line 23249 "" +#line 23243 "" i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); -#line 23249 "" +#line 23243 "" i__1 = levbot + 48; -#line 23249 "" +#line 23243 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 23249 "" +#line 23243 "" i__4[3] = 1, a__3[3] = ch__2; -#line 23249 "" +#line 23243 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 23251 "" +#line 23245 "" } -#line 23252 "" +#line 23246 "" lnote += 10; -#line 23253 "" +#line 23247 "" } else { -#line 23254 "" +#line 23248 "" if (! isarpshift) { /* Writing concatenation */ -#line 23255 "" +#line 23249 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23255 "" +#line 23249 "" i__3[0] = 1, a__2[0] = ch__1; -#line 23255 "" +#line 23249 "" i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); -#line 23255 "" +#line 23249 "" i__3[2] = 1, a__2[2] = "{"; -#line 23255 "" +#line 23249 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); -#line 23256 "" +#line 23250 "" } else { /* Writing concatenation */ -#line 23257 "" +#line 23251 "" i__4[0] = lnote, a__3[0] = notexq; -#line 23257 "" +#line 23251 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23257 "" +#line 23251 "" i__4[1] = 1, a__3[1] = ch__1; -#line 23257 "" +#line 23251 "" i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); -#line 23257 "" +#line 23251 "" i__4[3] = 1, a__3[3] = "{"; -#line 23257 "" +#line 23251 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); -#line 23258 "" +#line 23252 "" } -#line 23259 "" +#line 23253 "" lnote += 10; -#line 23260 "" +#line 23254 "" if (levbot >= -9) { /* Need two spaces for number */ -#line 23264 "" +#line 23258 "" i__1 = lnote; -#line 23264 "" +#line 23258 "" ici__1.icierr = 0; -#line 23264 "" +#line 23258 "" ici__1.icirnum = 1; -#line 23264 "" +#line 23258 "" ici__1.icirlen = lnote + 3 - i__1; -#line 23264 "" +#line 23258 "" ici__1.iciunit = notexq + i__1; -#line 23264 "" +#line 23258 "" ici__1.icifmt = "(i2,a1)"; -#line 23264 "" +#line 23258 "" s_wsfi(&ici__1); -#line 23264 "" +#line 23258 "" do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); -#line 23264 "" +#line 23258 "" do_fio(&c__1, "}", (ftnlen)1); -#line 23264 "" +#line 23258 "" e_wsfi(); -#line 23265 "" +#line 23259 "" lnote += 3; -#line 23266 "" +#line 23260 "" } else { -#line 23267 "" +#line 23261 "" i__1 = lnote; -#line 23267 "" +#line 23261 "" ici__1.icierr = 0; -#line 23267 "" +#line 23261 "" ici__1.icirnum = 1; -#line 23267 "" +#line 23261 "" ici__1.icirlen = lnote + 4 - i__1; -#line 23267 "" +#line 23261 "" ici__1.iciunit = notexq + i__1; -#line 23267 "" +#line 23261 "" ici__1.icifmt = "(i3,a1)"; -#line 23267 "" +#line 23261 "" s_wsfi(&ici__1); -#line 23267 "" +#line 23261 "" do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); -#line 23267 "" +#line 23261 "" do_fio(&c__1, "}", (ftnlen)1); -#line 23267 "" +#line 23261 "" e_wsfi(); -#line 23268 "" +#line 23262 "" lnote += 4; -#line 23269 "" +#line 23263 "" } -#line 23270 "" +#line 23264 "" } /* if (ilvert .le. 9) then */ /* call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */ @@ -57333,70 +57610,70 @@ L8: /* write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' */ /* call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) */ /* end if */ -#line 23279 "" +#line 23273 "" if (ilvert > 9) { -#line 23280 "" +#line 23274 "" i__1 = lnote; -#line 23280 "" +#line 23274 "" ici__1.icierr = 0; -#line 23280 "" +#line 23274 "" ici__1.icirnum = 1; -#line 23280 "" +#line 23274 "" ici__1.icirlen = lnote + 4 - i__1; -#line 23280 "" +#line 23274 "" ici__1.iciunit = notexq + i__1; -#line 23280 "" +#line 23274 "" ici__1.icifmt = "(a1,i2,a1)"; -#line 23280 "" +#line 23274 "" s_wsfi(&ici__1); -#line 23280 "" +#line 23274 "" do_fio(&c__1, "{", (ftnlen)1); -#line 23280 "" +#line 23274 "" do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer)); -#line 23280 "" +#line 23274 "" do_fio(&c__1, "}", (ftnlen)1); -#line 23280 "" +#line 23274 "" e_wsfi(); -#line 23281 "" +#line 23275 "" lnote += 4; -#line 23282 "" +#line 23276 "" } else { /* Writing concatenation */ -#line 23283 "" +#line 23277 "" i__2[0] = lnote, a__1[0] = notexq; -#line 23283 "" +#line 23277 "" i__1 = ilvert + 48; -#line 23283 "" +#line 23277 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 23283 "" +#line 23277 "" i__2[1] = 1, a__1[1] = ch__1; -#line 23283 "" +#line 23277 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23284 "" +#line 23278 "" ++lnote; -#line 23285 "" +#line 23279 "" } -#line 23286 "" +#line 23280 "" if (isarpshift) { /* Writing concatenation */ -#line 23287 "" +#line 23281 "" i__2[0] = lnote, a__1[0] = notexq; -#line 23287 "" +#line 23281 "" i__2[1] = 1, a__1[1] = "}"; -#line 23287 "" +#line 23281 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23288 "" +#line 23282 "" ++lnote; -#line 23289 "" +#line 23283 "" } -#line 23290 "" +#line 23284 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); /* cancel out the stored time, to permit two arps at same time! */ -#line 23294 "" +#line 23288 "" comarp_1.tar[iarp - 1] = -1.f; -#line 23295 "" +#line 23289 "" return 0; } /* putarp_ */ @@ -57422,39 +57699,39 @@ L8: static icilist io___1646 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 }; -#line 23300 "" +#line 23294 "" if (*elask >= 0.f) { -#line 23301 "" +#line 23295 "" if (*elask < .995f) { -#line 23302 "" +#line 23296 "" lp = 3; -#line 23303 "" +#line 23297 "" } else if (*elask < 9.995f) { -#line 23304 "" +#line 23298 "" lp = 4; -#line 23305 "" +#line 23299 "" } else { -#line 23306 "" +#line 23300 "" lp = 5; -#line 23307 "" +#line 23301 "" } -#line 23308 "" +#line 23302 "" s_wsfi(&io___1646); -#line 23308 "" +#line 23302 "" do_fio(&c__1, "(a2,f", (ftnlen)5); -#line 23308 "" +#line 23302 "" do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer)); -#line 23308 "" +#line 23302 "" do_fio(&c__1, ".2)", (ftnlen)3); -#line 23308 "" +#line 23302 "" e_wsfi(); -#line 23309 "" +#line 23303 "" } else { -#line 23310 "" +#line 23304 "" lp = 5; -#line 23311 "" +#line 23305 "" s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9); -#line 23312 "" +#line 23306 "" } /* Overwrite as follows: ...xyz*ask *lmnop... -> */ @@ -57462,40 +57739,40 @@ L8: /* ...xyz*ast{n.nn}*lmnop... */ /* ...xyz*ast{nn.nn}*lmnop... */ /* or for negative, ...xyz*ast{-nn.n}*lmnop... */ -#line 23319 "" +#line 23313 "" i__1 = *indxask + 8; -#line 23319 "" +#line 23313 "" s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1); -#line 23320 "" +#line 23314 "" i__1 = *indxask + 2; -#line 23320 "" +#line 23314 "" ici__1.icierr = 0; -#line 23320 "" +#line 23314 "" ici__1.icirnum = 1; -#line 23320 "" +#line 23314 "" ici__1.icirlen = 129 - i__1; -#line 23320 "" +#line 23314 "" ici__1.iciunit = outq + i__1; -#line 23320 "" +#line 23314 "" ici__1.icifmt = fmtq; -#line 23320 "" +#line 23314 "" s_wsfi(&ici__1); -#line 23320 "" +#line 23314 "" do_fio(&c__1, "t{", (ftnlen)2); -#line 23320 "" +#line 23314 "" do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real)); -#line 23320 "" +#line 23314 "" e_wsfi(); /* Writing concatenation */ -#line 23321 "" +#line 23315 "" i__2[0] = *indxask + 4 + lp, a__1[0] = outq; -#line 23321 "" +#line 23315 "" i__2[1] = 1, a__1[1] = "}"; -#line 23321 "" +#line 23315 "" i__2[2] = 129, a__1[2] = tag; -#line 23321 "" +#line 23315 "" s_cat(outq, a__1, i__2, &c__3, (ftnlen)129); -#line 23322 "" +#line 23316 "" return 0; } /* putast_ */ @@ -57523,247 +57800,247 @@ L8: extern /* Subroutine */ int printl_(char *, ftnlen); /* ivxip = ivx+16*ip */ -#line 23329 "" +#line 23323 "" i__1 = comcb_1.nbc; -#line 23329 "" +#line 23323 "" for (ibc = 1; ibc <= i__1; ++ibc) { /* if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 */ /* if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) */ /* * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 */ -#line 23333 "" +#line 23327 "" ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[ ibc - 1], &c__1, &c__28) << 4); -#line 23334 "" +#line 23328 "" ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4); -#line 23335 "" +#line 23329 "" if (*ivx == ivxbc && *ip == ipbc) { -#line 23335 "" +#line 23329 "" goto L2; -#line 23335 "" +#line 23329 "" } -#line 23336 "" +#line 23330 "" /* L1: */ -#line 23336 "" +#line 23330 "" } -#line 23337 "" +#line 23331 "" printl_("Error in putbc, Call Dr. Don", (ftnlen)28); -#line 23338 "" +#line 23332 "" s_stop("", (ftnlen)0); -#line 23339 "" +#line 23333 "" L2: -#line 23340 "" +#line 23334 "" if (bit_test(comcb_1.ibcdata[ibc - 1],27)) { -#line 23341 "" +#line 23335 "" *lnote = 8; -#line 23342 "" +#line 23336 "" s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8); -#line 23343 "" +#line 23337 "" } else { -#line 23344 "" +#line 23338 "" *lnote = 9; -#line 23345 "" +#line 23339 "" s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9); -#line 23346 "" +#line 23340 "" } -#line 23347 "" +#line 23341 "" ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13); /* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */ -#line 23349 "" +#line 23343 "" if (ivshft > 0) { -#line 23349 "" +#line 23343 "" ivshft += -32; -#line 23349 "" +#line 23343 "" } -#line 23350 "" +#line 23344 "" if (ivshft < 0 || ivshft > 9) { /* Writing concatenation */ -#line 23351 "" +#line 23345 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 23351 "" +#line 23345 "" i__2[1] = 1, a__1[1] = "{"; -#line 23351 "" +#line 23345 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23352 "" +#line 23346 "" ++(*lnote); -#line 23353 "" +#line 23347 "" if (ivshft < -9) { -#line 23354 "" +#line 23348 "" i__1 = *lnote; -#line 23354 "" +#line 23348 "" ici__1.icierr = 0; -#line 23354 "" +#line 23348 "" ici__1.icirnum = 1; -#line 23354 "" +#line 23348 "" ici__1.icirlen = *lnote + 3 - i__1; -#line 23354 "" +#line 23348 "" ici__1.iciunit = notexq + i__1; -#line 23354 "" +#line 23348 "" ici__1.icifmt = "(i3)"; -#line 23354 "" +#line 23348 "" s_wsfi(&ici__1); -#line 23354 "" +#line 23348 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); -#line 23354 "" +#line 23348 "" e_wsfi(); -#line 23355 "" +#line 23349 "" *lnote += 3; -#line 23356 "" +#line 23350 "" } else { -#line 23357 "" +#line 23351 "" i__1 = *lnote; -#line 23357 "" +#line 23351 "" ici__1.icierr = 0; -#line 23357 "" +#line 23351 "" ici__1.icirnum = 1; -#line 23357 "" +#line 23351 "" ici__1.icirlen = *lnote + 2 - i__1; -#line 23357 "" +#line 23351 "" ici__1.iciunit = notexq + i__1; -#line 23357 "" +#line 23351 "" ici__1.icifmt = "(i2)"; -#line 23357 "" +#line 23351 "" s_wsfi(&ici__1); -#line 23357 "" +#line 23351 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); -#line 23357 "" +#line 23351 "" e_wsfi(); -#line 23358 "" +#line 23352 "" *lnote += 2; -#line 23359 "" +#line 23353 "" } /* Writing concatenation */ -#line 23360 "" +#line 23354 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 23360 "" +#line 23354 "" i__2[1] = 1, a__1[1] = "}"; -#line 23360 "" +#line 23354 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23361 "" +#line 23355 "" ++(*lnote); -#line 23362 "" +#line 23356 "" } else { /* Writing concatenation */ -#line 23363 "" +#line 23357 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 23363 "" +#line 23357 "" *(unsigned char *)&ch__1[0] = ivshft + 48; -#line 23363 "" +#line 23357 "" i__2[1] = 1, a__1[1] = ch__1; -#line 23363 "" +#line 23357 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23364 "" +#line 23358 "" ++(*lnote); -#line 23365 "" +#line 23359 "" } -#line 23366 "" +#line 23360 "" ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19); -#line 23367 "" +#line 23361 "" if (ihshft == 0) { /* Writing concatenation */ -#line 23368 "" +#line 23362 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 23368 "" +#line 23362 "" i__2[1] = 1, a__1[1] = "0"; -#line 23368 "" +#line 23362 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23369 "" +#line 23363 "" ++(*lnote); -#line 23370 "" +#line 23364 "" } else { -#line 23371 "" +#line 23365 "" hshft = (ihshft - 128) * .1f; /* -12.8 9.95f) { -#line 23381 "" +#line 23375 "" i__1 = *lnote; -#line 23381 "" +#line 23375 "" ici__1.icierr = 0; -#line 23381 "" +#line 23375 "" ici__1.icirnum = 1; -#line 23381 "" +#line 23375 "" ici__1.icirlen = *lnote + 4 - i__1; -#line 23381 "" +#line 23375 "" ici__1.iciunit = notexq + i__1; -#line 23381 "" +#line 23375 "" ici__1.icifmt = "(f4.1)"; -#line 23381 "" +#line 23375 "" s_wsfi(&ici__1); -#line 23381 "" +#line 23375 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); -#line 23381 "" +#line 23375 "" e_wsfi(); -#line 23382 "" +#line 23376 "" *lnote += 4; -#line 23383 "" +#line 23377 "" } else { -#line 23384 "" +#line 23378 "" i__1 = *lnote; -#line 23384 "" +#line 23378 "" ici__1.icierr = 0; -#line 23384 "" +#line 23378 "" ici__1.icirnum = 1; -#line 23384 "" +#line 23378 "" ici__1.icirlen = *lnote + 3 - i__1; -#line 23384 "" +#line 23378 "" ici__1.iciunit = notexq + i__1; -#line 23384 "" +#line 23378 "" ici__1.icifmt = "(f3.1)"; -#line 23384 "" +#line 23378 "" s_wsfi(&ici__1); -#line 23384 "" +#line 23378 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); -#line 23384 "" +#line 23378 "" e_wsfi(); -#line 23385 "" +#line 23379 "" *lnote += 3; -#line 23386 "" +#line 23380 "" } /* Writing concatenation */ -#line 23387 "" +#line 23381 "" i__2[0] = *lnote, a__1[0] = notexq; -#line 23387 "" +#line 23381 "" i__2[1] = 1, a__1[1] = "}"; -#line 23387 "" +#line 23381 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 23388 "" +#line 23382 "" ++(*lnote); -#line 23389 "" +#line 23383 "" } -#line 23390 "" +#line 23384 "" return 0; } /* putcb_ */ @@ -57813,178 +58090,178 @@ L2: static icilist io___1678 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; -#line 23402 "" +#line 23396 "" if (*ivx == 1) { -#line 23403 "" +#line 23397 "" s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4); -#line 23404 "" +#line 23398 "" s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4); -#line 23405 "" +#line 23399 "" } else { -#line 23406 "" +#line 23400 "" s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4); -#line 23407 "" +#line 23401 "" s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4); -#line 23408 "" +#line 23402 "" } -#line 23409 "" +#line 23403 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23409 "" +#line 23403 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 23410 "" +#line 23404 "" if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] != 0) { /* Alter figdrop */ /* Writing concatenation */ -#line 23414 "" +#line 23408 "" i__1[0] = 1, a__1[0] = sq; -#line 23414 "" +#line 23408 "" i__1[1] = 6, a__1[1] = "global"; -#line 23414 "" +#line 23408 "" i__1[2] = 1, a__1[2] = sq; -#line 23414 "" +#line 23408 "" i__1[3] = 7, a__1[3] = "advance"; -#line 23414 "" +#line 23408 "" i__1[4] = 1, a__1[4] = sq; -#line 23414 "" +#line 23408 "" i__1[5] = 7, a__1[5] = "figdrop"; -#line 23414 "" +#line 23408 "" s_cat(notexq, a__1, i__1, &c__6, (ftnlen)80); -#line 23415 "" +#line 23409 "" lnote = 23; -#line 23416 "" +#line 23410 "" if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] < 0) { /* Writing concatenation */ -#line 23417 "" +#line 23411 "" i__2[0] = lnote, a__2[0] = notexq; -#line 23417 "" +#line 23411 "" i__2[1] = 1, a__2[1] = "-"; -#line 23417 "" +#line 23411 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); -#line 23418 "" +#line 23412 "" ++lnote; -#line 23419 "" +#line 23413 "" } /* Writing concatenation */ -#line 23420 "" +#line 23414 "" i__2[0] = lnote, a__2[0] = notexq; -#line 23420 "" +#line 23414 "" *(unsigned char *)&ch__1[0] = (i__3 = comfig_2.ivvfig[*ivx + (*ifig << 1) - 3], abs(i__3)) + 48; -#line 23420 "" +#line 23414 "" i__2[1] = 1, a__2[1] = ch__1; -#line 23420 "" +#line 23414 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); -#line 23421 "" +#line 23415 "" ++lnote; -#line 23422 "" +#line 23416 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)80, (ftnlen)80); -#line 23423 "" +#line 23417 "" } -#line 23424 "" +#line 23418 "" if (dabs(*offnsk) > 1e-4f) { /* Write offset for floating figure, to two decimal places */ /* Writing concatenation */ -#line 23428 "" +#line 23422 "" i__2[0] = 1, a__2[0] = sq; -#line 23428 "" +#line 23422 "" i__2[1] = 4, a__2[1] = "off{"; -#line 23428 "" +#line 23422 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); -#line 23429 "" +#line 23423 "" if (-(*offnsk) < -9.995f) { -#line 23430 "" +#line 23424 "" s_wsfi(&io___1659); -#line 23430 "" +#line 23424 "" r__1 = -(*offnsk); -#line 23430 "" +#line 23424 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 23430 "" +#line 23424 "" e_wsfi(); -#line 23431 "" +#line 23425 "" lnote = 11; -#line 23432 "" +#line 23426 "" } else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) { -#line 23433 "" +#line 23427 "" s_wsfi(&io___1660); -#line 23433 "" +#line 23427 "" r__1 = -(*offnsk); -#line 23433 "" +#line 23427 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 23433 "" +#line 23427 "" e_wsfi(); -#line 23434 "" +#line 23428 "" lnote = 10; -#line 23435 "" +#line 23429 "" } else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) { -#line 23436 "" +#line 23430 "" s_wsfi(&io___1661); -#line 23436 "" +#line 23430 "" r__1 = -(*offnsk); -#line 23436 "" +#line 23430 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 23436 "" +#line 23430 "" e_wsfi(); -#line 23437 "" +#line 23431 "" lnote = 9; -#line 23438 "" +#line 23432 "" } else { -#line 23439 "" +#line 23433 "" s_wsfi(&io___1662); -#line 23439 "" +#line 23433 "" r__1 = -(*offnsk); -#line 23439 "" +#line 23433 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); -#line 23439 "" +#line 23433 "" e_wsfi(); -#line 23440 "" +#line 23434 "" lnote = 8; -#line 23441 "" +#line 23435 "" } /* Writing concatenation */ -#line 23442 "" +#line 23436 "" i__4[0] = lnote, a__3[0] = notexq; -#line 23442 "" +#line 23436 "" i__4[1] = 1, a__3[1] = sq; -#line 23442 "" +#line 23436 "" i__4[2] = 9, a__3[2] = "noteskip}"; -#line 23442 "" +#line 23436 "" s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); -#line 23443 "" +#line 23437 "" i__3 = lnote + 10; -#line 23443 "" +#line 23437 "" addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); -#line 23444 "" +#line 23438 "" } -#line 23445 "" +#line 23439 "" s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10, (ftnlen)10); -#line 23446 "" +#line 23440 "" ic = 1; /* nof = 0 */ /* nofa = -1 */ -#line 23449 "" +#line 23443 "" nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3]; -#line 23450 "" +#line 23444 "" nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1; /* Beginning of manual loop */ -#line 23454 "" +#line 23448 "" L1: -#line 23454 "" +#line 23448 "" *(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1]; /* Exit when first blank is encountered */ -#line 23458 "" +#line 23452 "" if (*(unsigned char *)ch1q == ' ') { -#line 23458 "" +#line 23452 "" goto L2; -#line 23458 "" +#line 23452 "" } /* Starting a level. Set up vertical offset. */ @@ -58005,387 +58282,387 @@ L1: /* lnofa = 2 */ /* nofaq = '1'//chax(nofa+38) */ /* end if */ -#line 23478 "" +#line 23472 "" istring_(&nof, nofq, &lnof, (ftnlen)5); -#line 23479 "" +#line 23473 "" istring_(&nofa, nofaq, &lnofa, (ftnlen)5); -#line 23480 "" +#line 23474 "" if (*(unsigned char *)ch1q == '0') { /* Continuation figure. Next number is length (in noteskips). The number will */ /* end at the first blank or char that is not digit or decimal point. If */ /* colon, it is a separator and must be skipped */ -#line 23486 "" +#line 23480 "" icnum = ic + 1; -#line 23487 "" +#line 23481 "" L3: -#line 23488 "" +#line 23482 "" ++ic; -#line 23489 "" +#line 23483 "" if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0) { -#line 23489 "" +#line 23483 "" goto L3; -#line 23489 "" +#line 23483 "" } -#line 23490 "" +#line 23484 "" lnum = ic - icnum; /* Writing concatenation */ -#line 23491 "" +#line 23485 "" i__1[0] = 1, a__1[0] = sq; -#line 23491 "" +#line 23485 "" i__1[1] = 4, a__1[1] = conttq; -#line 23491 "" +#line 23485 "" i__1[2] = lnof, a__1[2] = nofq; -#line 23491 "" +#line 23485 "" i__1[3] = 1, a__1[3] = "{"; -#line 23491 "" +#line 23485 "" i__1[4] = ic - 1 - (icnum - 1), a__1[4] = figq + (icnum - 1); -#line 23491 "" +#line 23485 "" i__1[5] = 1, a__1[5] = "}"; -#line 23491 "" +#line 23485 "" s_cat(ch__2, a__1, i__1, &c__6, (ftnlen)22); -#line 23491 "" +#line 23485 "" i__3 = ic + 7 - icnum + lnof; -#line 23491 "" +#line 23485 "" addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1)) + 1, (ftnlen)80); -#line 23493 "" +#line 23487 "" if (*(unsigned char *)&figq[ic - 1] != ':') { -#line 23493 "" +#line 23487 "" --ic; -#line 23493 "" +#line 23487 "" } -#line 23494 "" +#line 23488 "" } else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-' || *(unsigned char *)ch1q == 'n') { -#line 23495 "" +#line 23489 "" ++ic; -#line 23496 "" +#line 23490 "" *(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1]; -#line 23497 "" +#line 23491 "" if (*(unsigned char *)ch2q == ' ') { /* Figure is a stand-alone accidental, so must be centered */ -#line 23501 "" +#line 23495 "" if (*(unsigned char *)ch1q == '#') { /* Writing concatenation */ -#line 23502 "" +#line 23496 "" i__1[0] = 1, a__1[0] = sq; -#line 23502 "" +#line 23496 "" i__1[1] = 4, a__1[1] = figutq; -#line 23502 "" +#line 23496 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23502 "" +#line 23496 "" i__1[3] = 1, a__1[3] = "{"; -#line 23502 "" +#line 23496 "" i__1[4] = 1, a__1[4] = sq; -#line 23502 "" +#line 23496 "" i__1[5] = 9, a__1[5] = "sharpfig}"; -#line 23502 "" +#line 23496 "" s_cat(ch__3, a__1, i__1, &c__6, (ftnlen)21); -#line 23502 "" +#line 23496 "" i__3 = lnofa + 16; -#line 23502 "" +#line 23496 "" addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80); -#line 23504 "" +#line 23498 "" } else if (*(unsigned char *)ch1q == '-') { /* Writing concatenation */ -#line 23505 "" +#line 23499 "" i__1[0] = 1, a__1[0] = sq; -#line 23505 "" +#line 23499 "" i__1[1] = 4, a__1[1] = figutq; -#line 23505 "" +#line 23499 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23505 "" +#line 23499 "" i__1[3] = 1, a__1[3] = "{"; -#line 23505 "" +#line 23499 "" i__1[4] = 1, a__1[4] = sq; -#line 23505 "" +#line 23499 "" i__1[5] = 8, a__1[5] = "flatfig}"; -#line 23505 "" +#line 23499 "" s_cat(ch__4, a__1, i__1, &c__6, (ftnlen)20); -#line 23505 "" +#line 23499 "" i__3 = lnofa + 15; -#line 23505 "" +#line 23499 "" addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80); -#line 23507 "" +#line 23501 "" } else if (*(unsigned char *)ch1q == 'n') { /* Writing concatenation */ -#line 23508 "" +#line 23502 "" i__1[0] = 1, a__1[0] = sq; -#line 23508 "" +#line 23502 "" i__1[1] = 4, a__1[1] = figutq; -#line 23508 "" +#line 23502 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23508 "" +#line 23502 "" i__1[3] = 1, a__1[3] = "{"; -#line 23508 "" +#line 23502 "" i__1[4] = 1, a__1[4] = sq; -#line 23508 "" +#line 23502 "" i__1[5] = 7, a__1[5] = "natfig}"; -#line 23508 "" +#line 23502 "" s_cat(ch__5, a__1, i__1, &c__6, (ftnlen)19); -#line 23508 "" +#line 23502 "" i__3 = lnofa + 14; -#line 23508 "" +#line 23502 "" addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80); -#line 23510 "" +#line 23504 "" } -#line 23511 "" +#line 23505 "" goto L2; -#line 23512 "" +#line 23506 "" } else { /* Figure is an accidental followed by a number */ /* First put the accidental (offset to the left) */ -#line 23517 "" +#line 23511 "" if (*(unsigned char *)ch1q == '#') { /* Writing concatenation */ -#line 23518 "" +#line 23512 "" i__1[0] = 1, a__1[0] = sq; -#line 23518 "" +#line 23512 "" i__1[1] = 4, a__1[1] = figutq; -#line 23518 "" +#line 23512 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23518 "" +#line 23512 "" i__1[3] = 1, a__1[3] = "{"; -#line 23518 "" +#line 23512 "" i__1[4] = 1, a__1[4] = sq; -#line 23518 "" +#line 23512 "" i__1[5] = 6, a__1[5] = "fsmsh}"; -#line 23518 "" +#line 23512 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); -#line 23518 "" +#line 23512 "" i__3 = lnofa + 13; -#line 23518 "" +#line 23512 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); -#line 23521 "" +#line 23515 "" } else if (*(unsigned char *)ch1q == '-') { /* Writing concatenation */ -#line 23522 "" +#line 23516 "" i__1[0] = 1, a__1[0] = sq; -#line 23522 "" +#line 23516 "" i__1[1] = 4, a__1[1] = figutq; -#line 23522 "" +#line 23516 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23522 "" +#line 23516 "" i__1[3] = 1, a__1[3] = "{"; -#line 23522 "" +#line 23516 "" i__1[4] = 1, a__1[4] = sq; -#line 23522 "" +#line 23516 "" i__1[5] = 6, a__1[5] = "fsmfl}"; -#line 23522 "" +#line 23516 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); -#line 23522 "" +#line 23516 "" i__3 = lnofa + 13; -#line 23522 "" +#line 23516 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); -#line 23525 "" +#line 23519 "" } else if (*(unsigned char *)ch1q == 'n') { /* Writing concatenation */ -#line 23526 "" +#line 23520 "" i__1[0] = 1, a__1[0] = sq; -#line 23526 "" +#line 23520 "" i__1[1] = 4, a__1[1] = figutq; -#line 23526 "" +#line 23520 "" i__1[2] = lnofa, a__1[2] = nofaq; -#line 23526 "" +#line 23520 "" i__1[3] = 1, a__1[3] = "{"; -#line 23526 "" +#line 23520 "" i__1[4] = 1, a__1[4] = sq; -#line 23526 "" +#line 23520 "" i__1[5] = 6, a__1[5] = "fsmna}"; -#line 23526 "" +#line 23520 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); -#line 23526 "" +#line 23520 "" i__3 = lnofa + 13; -#line 23526 "" +#line 23520 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); -#line 23529 "" +#line 23523 "" } /* Now put the number */ /* Writing concatenation */ -#line 23533 "" +#line 23527 "" i__1[0] = 1, a__1[0] = sq; -#line 23533 "" +#line 23527 "" i__1[1] = 4, a__1[1] = figutq; -#line 23533 "" +#line 23527 "" i__1[2] = lnof, a__1[2] = nofq; -#line 23533 "" +#line 23527 "" i__1[3] = 1, a__1[3] = "{"; -#line 23533 "" +#line 23527 "" i__1[4] = 1, a__1[4] = ch2q; -#line 23533 "" +#line 23527 "" i__1[5] = 1, a__1[5] = "}"; -#line 23533 "" +#line 23527 "" s_cat(ch__7, a__1, i__1, &c__6, (ftnlen)13); -#line 23533 "" +#line 23527 "" i__3 = lnof + 8; -#line 23533 "" +#line 23527 "" addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80); -#line 23535 "" +#line 23529 "" } -#line 23536 "" +#line 23530 "" } else if (*(unsigned char *)ch1q == '_') { /* Placeholder only (for lowering a figure). Don't do anything! */ -#line 23541 "" +#line 23535 "" } else { /* Figure is a single number, maybe with s after */ /* Writing concatenation */ -#line 23545 "" +#line 23539 "" i__5[0] = 1, a__4[0] = sq; -#line 23545 "" +#line 23539 "" i__5[1] = 4, a__4[1] = figutq; -#line 23545 "" +#line 23539 "" i__5[2] = lnof, a__4[2] = nofq; -#line 23545 "" +#line 23539 "" i__5[3] = 1, a__4[3] = "{"; -#line 23545 "" +#line 23539 "" s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11); -#line 23545 "" +#line 23539 "" i__3 = lnof + 6; -#line 23545 "" +#line 23539 "" addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80); -#line 23547 "" +#line 23541 "" i__3 = ic; -#line 23547 "" +#line 23541 "" s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3); -#line 23548 "" +#line 23542 "" if (*(unsigned char *)ch2q == 's') { /* Use a special character. Insert font call */ -#line 23552 "" +#line 23546 "" ++ic; /* Writing concatenation */ -#line 23553 "" +#line 23547 "" i__2[0] = 1, a__2[0] = sq; -#line 23553 "" +#line 23547 "" i__2[1] = 7, a__2[1] = "ligfont"; -#line 23553 "" +#line 23547 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 23553 "" +#line 23547 "" addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80); -#line 23554 "" +#line 23548 "" } /* Writing concatenation */ -#line 23555 "" +#line 23549 "" i__2[0] = 1, a__2[0] = ch1q; -#line 23555 "" +#line 23549 "" i__2[1] = 1, a__2[1] = "}"; -#line 23555 "" +#line 23549 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)2); -#line 23555 "" +#line 23549 "" addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); /* call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */ /* * 8+lnof,soutq,lsout) */ -#line 23558 "" +#line 23552 "" } -#line 23559 "" +#line 23553 "" if (ic >= 10) { -#line 23559 "" +#line 23553 "" goto L2; -#line 23559 "" +#line 23553 "" } -#line 23560 "" +#line 23554 "" ++ic; -#line 23561 "" +#line 23555 "" nof += 4; -#line 23562 "" +#line 23556 "" nofa += 4; -#line 23563 "" +#line 23557 "" goto L1; -#line 23564 "" +#line 23558 "" L2: -#line 23565 "" +#line 23559 "" if (dabs(*offnsk) > 1e-4f) { /* Writing concatenation */ -#line 23566 "" +#line 23560 "" i__2[0] = 1, a__2[0] = sq; -#line 23566 "" +#line 23560 "" i__2[1] = 4, a__2[1] = "off{"; -#line 23566 "" +#line 23560 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); -#line 23567 "" +#line 23561 "" if (*offnsk < -9.995f) { -#line 23568 "" +#line 23562 "" s_wsfi(&io___1675); -#line 23568 "" +#line 23562 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); -#line 23568 "" +#line 23562 "" e_wsfi(); -#line 23569 "" +#line 23563 "" lnote = 11; -#line 23570 "" +#line 23564 "" } else if (*offnsk < -.995f || *offnsk > 9.995f) { -#line 23571 "" +#line 23565 "" s_wsfi(&io___1676); -#line 23571 "" +#line 23565 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); -#line 23571 "" +#line 23565 "" e_wsfi(); -#line 23572 "" +#line 23566 "" lnote = 10; -#line 23573 "" +#line 23567 "" } else if (*offnsk < -1e-4f || *offnsk > .995f) { -#line 23574 "" +#line 23568 "" s_wsfi(&io___1677); -#line 23574 "" +#line 23568 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); -#line 23574 "" +#line 23568 "" e_wsfi(); -#line 23575 "" +#line 23569 "" lnote = 9; -#line 23576 "" +#line 23570 "" } else { -#line 23577 "" +#line 23571 "" s_wsfi(&io___1678); -#line 23577 "" +#line 23571 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); -#line 23577 "" +#line 23571 "" e_wsfi(); -#line 23578 "" +#line 23572 "" lnote = 8; -#line 23579 "" +#line 23573 "" } /* Writing concatenation */ -#line 23580 "" +#line 23574 "" i__4[0] = lnote, a__3[0] = notexq; -#line 23580 "" +#line 23574 "" i__4[1] = 1, a__3[1] = sq; -#line 23580 "" +#line 23574 "" i__4[2] = 9, a__3[2] = "noteskip}"; -#line 23580 "" +#line 23574 "" s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); -#line 23581 "" +#line 23575 "" i__3 = lnote + 10; -#line 23581 "" +#line 23575 "" addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); -#line 23582 "" +#line 23576 "" } -#line 23583 "" +#line 23577 "" if (*ifig < comfig_2.nfigs[*ivx - 1]) { -#line 23584 "" +#line 23578 "" ++(*ifig); -#line 23585 "" +#line 23579 "" } else { -#line 23586 "" +#line 23580 "" comfig_2.nfigs[*ivx - 1] = 0; -#line 23587 "" +#line 23581 "" *figcheck = FALSE_; -#line 23588 "" +#line 23582 "" } -#line 23589 "" +#line 23583 "" return 0; } /* putfig_ */ @@ -58438,95 +58715,95 @@ L2: /* notcrd = .true. if ornament is on main note. */ /* nolevm is level of main note (for chords) */ -#line 23609 "" +#line 23603 "" /* Parameter adjustments */ -#line 23609 "" +#line 23603 "" ihornb -= 25; -#line 23609 "" +#line 23603 "" ulq -= 25; -#line 23609 "" +#line 23603 "" --nornb; -#line 23609 "" +#line 23603 "" -#line 23609 "" +#line 23603 "" /* Function Body */ -#line 23609 "" +#line 23603 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23609 "" +#line 23603 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 23610 "" +#line 23604 "" *lout = 0; -#line 23611 "" +#line 23605 "" usehornb = FALSE_; -#line 23612 "" +#line 23606 "" if (*nodur < 64) { -#line 23613 "" +#line 23607 "" stemlen = *stemlin; -#line 23614 "" +#line 23608 "" } else { -#line 23615 "" +#line 23609 "" stemlen = 0.f; -#line 23616 "" +#line 23610 "" } /* Get up-downness. ulpzq is opposite from stem direction for both beams and */ /* non beams. Can use in name of ornament [ . or _ ] */ -#line 23621 "" +#line 23615 "" if (*beamon) { -#line 23622 "" +#line 23616 "" if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { -#line 23623 "" +#line 23617 "" *(unsigned char *)ulpzq = 'l'; -#line 23624 "" +#line 23618 "" } else { -#line 23625 "" +#line 23619 "" *(unsigned char *)ulpzq = 'u'; -#line 23626 "" +#line 23620 "" } -#line 23627 "" +#line 23621 "" } else { -#line 23628 "" +#line 23622 "" udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv); -#line 23628 "" +#line 23622 "" if (*(unsigned char *)&ch__1[0] == 'l') { -#line 23629 "" +#line 23623 "" *(unsigned char *)ulpzq = 'u'; -#line 23630 "" +#line 23624 "" } else { -#line 23631 "" +#line 23625 "" *(unsigned char *)ulpzq = 'l'; -#line 23632 "" +#line 23626 "" } -#line 23633 "" +#line 23627 "" } /* To enable >1 ornament on a note, next line is top of manual loop. */ -#line 23637 "" +#line 23631 "" L2: /* c Bit # of last ornament (last of bits 0-21) */ /* c Bit # of last ornament (last of bits 0-24) */ /* Bit # of last ornament (last of bits 0-24,29-30) */ -#line 23642 "" +#line 23636 "" if (bit_test(*iornq,29)) { -#line 23643 "" +#line 23637 "" ibit = 29; -#line 23644 "" +#line 23638 "" } else if (bit_test(*iornq,30)) { -#line 23645 "" +#line 23639 "" ibit = 30; -#line 23646 "" +#line 23640 "" } else { -#line 23647 "" +#line 23641 "" i__1 = *iornq & 4194303; -#line 23647 "" +#line 23641 "" ibit = log2_(&i__1); /* ibit = log2(iand(iornq,33554431)) */ -#line 23649 "" +#line 23643 "" } -#line 23650 "" +#line 23644 "" iornt = pow_ii(&c__2, &ibit); /* Begin routine to set height. Bits 0-13: (stmgx+Tupf._) */ @@ -58536,568 +58813,568 @@ L2: /* Do not use beam height for . or _ */ -#line 23659 "" +#line 23653 "" if (bit_test(*iornq,22) && (iornt & 6144) == 0) { /* Height is set by special beam stuff. */ /* Do not leave ihorn set, do separately for every ornament */ -#line 23664 "" +#line 23658 "" ihorn = ihornb[*ivx + nornb[*ivx] * 24]; -#line 23665 "" +#line 23659 "" if (*(unsigned char *)ulpzq == 'u') { -#line 23665 "" +#line 23659 "" ihorn += -2; -#line 23665 "" +#line 23659 "" } /* Following flag tells whether to increment nornb when exiting the subroutine. */ -#line 23669 "" +#line 23663 "" usehornb = TRUE_; -#line 23670 "" +#line 23664 "" } else if (ibit == 14) { /* Down fermata. Don't worry about upper chord notes. */ -#line 23674 "" +#line 23668 "" if (*(unsigned char *)ulpzq == 'l') { /* Computing MIN */ -#line 23675 "" +#line 23669 "" i__1 = *nolev, i__2 = *ncm - 3; -#line 23675 "" +#line 23669 "" ihorn = min(i__1,i__2); -#line 23676 "" +#line 23670 "" } else { /* Computing MIN */ -#line 23677 "" +#line 23671 "" r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; -#line 23677 "" +#line 23671 "" ihorn = dmin(r__1,r__2); -#line 23678 "" +#line 23672 "" } -#line 23679 "" +#line 23673 "" } else if (bit_test(iornt,13) || bit_test(iornt,0)) { /* ( or ) */ -#line 23683 "" +#line 23677 "" ihorn = *nolev; -#line 23684 "" +#line 23678 "" } else if ((iornt & 6144) > 0) { /* c Staccato . or tenuto _ , but not special beam stuff. Need up-down info */ /* NOTE: removed .&_ from special beam treatment. */ /* Staccato . or tenuto _ Need up-down info */ -#line 23690 "" +#line 23684 "" if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *) ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned char *)ulpzq == 'u') { -#line 23692 "" +#line 23686 "" ihorn = *nolev; -#line 23693 "" +#line 23687 "" } else if (comtrill_1.maxlev == *nolev) { -#line 23694 "" +#line 23688 "" *(unsigned char *)ulpzq = 'u'; /* Computing MAX */ -#line 23695 "" +#line 23689 "" r__1 = *nolev + stemlen, r__2 = *ncm + 3.f; -#line 23695 "" +#line 23689 "" ihorn = dmax(r__1,r__2); -#line 23696 "" +#line 23690 "" } else { -#line 23697 "" +#line 23691 "" *(unsigned char *)ulpzq = 'l'; /* Computing MIN */ -#line 23698 "" +#line 23692 "" r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; -#line 23698 "" +#line 23692 "" ihorn = dmin(r__1,r__2); -#line 23699 "" +#line 23693 "" } -#line 23700 "" +#line 23694 "" } else if (*iscrd && *nolev == comtrill_1.minlev) { -#line 23701 "" +#line 23695 "" if (*(unsigned char *)ulpzq == 'l') { /* Computing MIN */ -#line 23702 "" +#line 23696 "" i__1 = *nolev - 3, i__2 = *ncm - 6; -#line 23702 "" +#line 23696 "" ihorn = min(i__1,i__2); -#line 23703 "" +#line 23697 "" } else { /* Computing MIN */ -#line 23704 "" +#line 23698 "" i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6; -#line 23704 "" +#line 23698 "" ihorn = min(i__1,i__2); -#line 23705 "" +#line 23699 "" } -#line 23706 "" +#line 23700 "" } else if (ibit == 10 && *nolev > 90) { /* Special treatment for fermata on a shifted rest */ -#line 23710 "" +#line 23704 "" ihorn = *ncm + 5; -#line 23711 "" +#line 23705 "" } else if (*(unsigned char *)ulpzq == 'l') { /* (iscrd and nolev=maxlev) or (.not.iscrd) */ /* Computing MAX */ -#line 23715 "" +#line 23709 "" r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f; -#line 23715 "" +#line 23709 "" ihorn = dmax(r__1,r__2); -#line 23716 "" +#line 23710 "" } else if (ibit == 29 || ibit == 30) { /* coda or new segno, no height tweak */ -#line 23720 "" +#line 23714 "" ihorn = *ncm + 5; -#line 23721 "" +#line 23715 "" } else { /* Computing MAX */ -#line 23722 "" +#line 23716 "" i__1 = *nolev + 2, i__2 = *ncm + 5; -#line 23722 "" +#line 23716 "" ihorn = max(i__1,i__2); -#line 23723 "" +#line 23717 "" } -#line 23724 "" +#line 23718 "" ioff = 0; -#line 23725 "" +#line 23719 "" iclracc = 0; /* Begin routine to set name. Bits 0-13: (stmgx+Tupf._) */ /* 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n */ -#line 23730 "" +#line 23724 "" if (bit_test(iornt,2)) { /* Writing concatenation */ +#line 23725 "" + i__3[0] = 1, a__1[0] = sq; +#line 23725 "" + i__3[1] = 5, a__1[1] = "shake"; +#line 23725 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23726 "" + lnote = 6; +#line 23727 "" + } else if (bit_test(iornt,3)) { +/* Writing concatenation */ +#line 23728 "" + i__3[0] = 1, a__1[0] = sq; +#line 23728 "" + i__3[1] = 7, a__1[1] = "mordent"; +#line 23728 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23729 "" + lnote = 8; +#line 23730 "" + } else if (bit_test(iornt,1)) { +/* Writing concatenation */ #line 23731 "" i__3[0] = 1, a__1[0] = sq; #line 23731 "" - i__3[1] = 5, a__1[1] = "shake"; + i__3[1] = 3, a__1[1] = "mtr"; #line 23731 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); #line 23732 "" - lnote = 6; + lnote = 4; #line 23733 "" - } else if (bit_test(iornt,3)) { + } else if (bit_test(iornt,5)) { /* Writing concatenation */ #line 23734 "" i__3[0] = 1, a__1[0] = sq; #line 23734 "" - i__3[1] = 7, a__1[1] = "mordent"; + i__3[1] = 3, a__1[1] = "xtr"; #line 23734 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); #line 23735 "" - lnote = 8; + lnote = 4; #line 23736 "" - } else if (bit_test(iornt,1)) { + } else if (bit_test(iornt,6)) { /* Writing concatenation */ #line 23737 "" i__3[0] = 1, a__1[0] = sq; #line 23737 "" - i__3[1] = 3, a__1[1] = "mtr"; + i__3[1] = 3, a__1[1] = "ptr"; #line 23737 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); #line 23738 "" lnote = 4; #line 23739 "" - } else if (bit_test(iornt,5)) { + } else if (bit_test(iornt,13)) { /* Writing concatenation */ #line 23740 "" i__3[0] = 1, a__1[0] = sq; #line 23740 "" - i__3[1] = 3, a__1[1] = "xtr"; + i__3[1] = 3, a__1[1] = "rpn"; #line 23740 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); #line 23741 "" lnote = 4; #line 23742 "" - } else if (bit_test(iornt,6)) { + } else if (bit_test(iornt,0)) { /* Writing concatenation */ #line 23743 "" i__3[0] = 1, a__1[0] = sq; #line 23743 "" - i__3[1] = 3, a__1[1] = "ptr"; + i__3[1] = 3, a__1[1] = "lpn"; #line 23743 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); #line 23744 "" lnote = 4; -#line 23745 "" - } else if (bit_test(iornt,13)) { -/* Writing concatenation */ -#line 23746 "" - i__3[0] = 1, a__1[0] = sq; -#line 23746 "" - i__3[1] = 3, a__1[1] = "rpn"; -#line 23746 "" - s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23747 "" - lnote = 4; -#line 23748 "" - } else if (bit_test(iornt,0)) { -/* Writing concatenation */ -#line 23749 "" - i__3[0] = 1, a__1[0] = sq; -#line 23749 "" - i__3[1] = 3, a__1[1] = "lpn"; -#line 23749 "" - s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23750 "" - lnote = 4; -#line 23751 "" +#line 23745 "" } else if (bit_test(iornt,12)) { /* Writing concatenation */ -#line 23752 "" +#line 23746 "" i__4[0] = 1, a__2[0] = sq; -#line 23752 "" +#line 23746 "" i__4[1] = 1, a__2[1] = ulpzq; -#line 23752 "" +#line 23746 "" i__4[2] = 2, a__2[2] = "st"; -#line 23752 "" +#line 23746 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); -#line 23753 "" +#line 23747 "" lnote = 4; -#line 23754 "" +#line 23748 "" } else if (bit_test(iornt,11)) { /* Writing concatenation */ -#line 23755 "" +#line 23749 "" i__4[0] = 1, a__2[0] = sq; -#line 23755 "" +#line 23749 "" i__4[1] = 1, a__2[1] = ulpzq; -#line 23755 "" +#line 23749 "" i__4[2] = 2, a__2[2] = "pz"; -#line 23755 "" +#line 23749 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); -#line 23756 "" +#line 23750 "" lnote = 4; -#line 23757 "" +#line 23751 "" } else if (bit_test(iornt,8)) { /* Writing concatenation */ -#line 23758 "" +#line 23752 "" i__3[0] = 1, a__1[0] = sq; -#line 23758 "" +#line 23752 "" i__3[1] = 3, a__1[1] = "upz"; -#line 23758 "" +#line 23752 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23759 "" +#line 23753 "" lnote = 4; -#line 23760 "" +#line 23754 "" ioff = -2; -#line 23761 "" +#line 23755 "" } else if (bit_test(iornt,9)) { /* Writing concatenation */ -#line 23762 "" +#line 23756 "" i__3[0] = 1, a__1[0] = sq; -#line 23762 "" +#line 23756 "" i__3[1] = 4, a__1[1] = "uppz"; -#line 23762 "" +#line 23756 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23763 "" +#line 23757 "" lnote = 5; -#line 23764 "" +#line 23758 "" ioff = -2; -#line 23765 "" +#line 23759 "" } else if (bit_test(iornt,10)) { -#line 23766 "" +#line 23760 "" if (*nodur < 48) { /* Writing concatenation */ -#line 23767 "" +#line 23761 "" i__3[0] = 1, a__1[0] = sq; -#line 23767 "" +#line 23761 "" i__3[1] = 9, a__1[1] = "fermataup"; -#line 23767 "" +#line 23761 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23768 "" +#line 23762 "" } else { /* Writing concatenation */ -#line 23769 "" +#line 23763 "" i__3[0] = 1, a__1[0] = sq; -#line 23769 "" +#line 23763 "" i__3[1] = 9, a__1[1] = "Fermataup"; -#line 23769 "" +#line 23763 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23770 "" +#line 23764 "" } -#line 23771 "" +#line 23765 "" lnote = 10; -#line 23772 "" +#line 23766 "" ioff = -2; -#line 23773 "" +#line 23767 "" } else if (bit_test(iornt,14)) { -#line 23774 "" +#line 23768 "" if (*nodur < 48) { /* Writing concatenation */ -#line 23775 "" +#line 23769 "" i__3[0] = 1, a__1[0] = sq; -#line 23775 "" +#line 23769 "" i__3[1] = 11, a__1[1] = "fermatadown"; -#line 23775 "" +#line 23769 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23776 "" +#line 23770 "" } else { /* Writing concatenation */ -#line 23777 "" +#line 23771 "" i__3[0] = 1, a__1[0] = sq; -#line 23777 "" +#line 23771 "" i__3[1] = 11, a__1[1] = "Fermatadown"; -#line 23777 "" +#line 23771 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23778 "" +#line 23772 "" } -#line 23779 "" +#line 23773 "" lnote = 12; -#line 23780 "" +#line 23774 "" } else if (bit_test(iornt,21)) { /* "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 */ -#line 23784 "" +#line 23778 "" if (bit_test(*iornq,16)) { /* Writing concatenation */ -#line 23785 "" +#line 23779 "" i__3[0] = 1, a__1[0] = sq; -#line 23785 "" +#line 23779 "" i__3[1] = 6, a__1[1] = "qsharp"; -#line 23785 "" +#line 23779 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23786 "" +#line 23780 "" lnote = 7; -#line 23787 "" +#line 23781 "" ioff = 2; -#line 23788 "" +#line 23782 "" *iornq = bit_clear(*iornq,16); -#line 23789 "" +#line 23783 "" iclracc = 16; -#line 23790 "" +#line 23784 "" } else if (bit_test(*iornq,17)) { /* Writing concatenation */ -#line 23791 "" +#line 23785 "" i__3[0] = 1, a__1[0] = sq; -#line 23791 "" +#line 23785 "" i__3[1] = 5, a__1[1] = "qflat"; -#line 23791 "" +#line 23785 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23792 "" +#line 23786 "" lnote = 6; -#line 23793 "" +#line 23787 "" ioff = 1; -#line 23794 "" +#line 23788 "" *iornq = bit_clear(*iornq,17); -#line 23795 "" +#line 23789 "" iclracc = 17; -#line 23796 "" +#line 23790 "" } else if (bit_test(*iornq,18)) { /* Writing concatenation */ -#line 23797 "" +#line 23791 "" i__3[0] = 1, a__1[0] = sq; -#line 23797 "" +#line 23791 "" i__3[1] = 4, a__1[1] = "qnat"; -#line 23797 "" +#line 23791 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23798 "" +#line 23792 "" lnote = 5; -#line 23799 "" +#line 23793 "" ioff = 2; -#line 23800 "" +#line 23794 "" *iornq = bit_clear(*iornq,18); -#line 23801 "" +#line 23795 "" iclracc = 18; -#line 23802 "" +#line 23796 "" } else { /* Writing concatenation */ -#line 23803 "" +#line 23797 "" i__3[0] = 1, a__1[0] = sq; -#line 23803 "" +#line 23797 "" i__3[1] = 5, a__1[1] = "qedit"; -#line 23803 "" +#line 23797 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23804 "" +#line 23798 "" lnote = 6; -#line 23805 "" +#line 23799 "" ioff = 0; -#line 23806 "" +#line 23800 "" } -#line 23807 "" +#line 23801 "" } else if (bit_test(iornt,16)) { /* Writing concatenation */ -#line 23808 "" +#line 23802 "" i__3[0] = 1, a__1[0] = sq; -#line 23808 "" +#line 23802 "" i__3[1] = 6, a__1[1] = "esharp"; -#line 23808 "" +#line 23802 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23809 "" +#line 23803 "" lnote = 7; -#line 23810 "" +#line 23804 "" ioff = 2; -#line 23811 "" +#line 23805 "" } else if (bit_test(iornt,17)) { /* Writing concatenation */ -#line 23812 "" +#line 23806 "" i__3[0] = 1, a__1[0] = sq; -#line 23812 "" +#line 23806 "" i__3[1] = 5, a__1[1] = "eflat"; -#line 23812 "" +#line 23806 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23813 "" +#line 23807 "" lnote = 6; -#line 23814 "" +#line 23808 "" ioff = 1; -#line 23815 "" +#line 23809 "" } else if (bit_test(iornt,18)) { /* Writing concatenation */ -#line 23816 "" +#line 23810 "" i__3[0] = 1, a__1[0] = sq; -#line 23816 "" +#line 23810 "" i__3[1] = 4, a__1[1] = "enat"; -#line 23816 "" +#line 23810 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23817 "" +#line 23811 "" lnote = 5; -#line 23818 "" +#line 23812 "" ioff = 2; -#line 23819 "" +#line 23813 "" } else if (bit_test(iornt,19)) { /* Writing concatenation */ -#line 23820 "" +#line 23814 "" i__3[0] = 1, a__1[0] = sq; -#line 23820 "" +#line 23814 "" i__3[1] = 3, a__1[1] = "usf"; -#line 23820 "" +#line 23814 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23821 "" +#line 23815 "" lnote = 4; -#line 23822 "" +#line 23816 "" ioff = -2; -#line 23823 "" +#line 23817 "" } else if (bit_test(iornt,20)) { /* Writing concatenation */ -#line 23824 "" +#line 23818 "" i__3[0] = 1, a__1[0] = sq; -#line 23824 "" +#line 23818 "" i__3[1] = 4, a__1[1] = "usfz"; -#line 23824 "" +#line 23818 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23825 "" +#line 23819 "" lnote = 5; -#line 23826 "" +#line 23820 "" ioff = -2; -#line 23827 "" +#line 23821 "" } else if (bit_test(iornt,29)) { /* Writing concatenation */ -#line 23828 "" +#line 23822 "" i__3[0] = 1, a__1[0] = sq; -#line 23828 "" +#line 23822 "" i__3[1] = 5, a__1[1] = "ccoda"; -#line 23828 "" +#line 23822 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23829 "" +#line 23823 "" lnote = 6; -#line 23830 "" +#line 23824 "" } else if (bit_test(iornt,30)) { /* Writing concatenation */ -#line 23831 "" +#line 23825 "" i__3[0] = 1, a__1[0] = sq; -#line 23831 "" +#line 23825 "" i__3[1] = 6, a__1[1] = "ssegno"; -#line 23831 "" +#line 23825 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23832 "" +#line 23826 "" lnote = 7; -#line 23833 "" +#line 23827 "" } -#line 23834 "" +#line 23828 "" iudorn = 0; /* User-defined level shift of ornament from default? */ -#line 23838 "" +#line 23832 "" if (bit_test(*iornq,25)) { /* Find which (if any) element of kudorn has the shift. */ -#line 23842 "" +#line 23836 "" i__1 = comtrill_1.nudorn; -#line 23842 "" +#line 23836 "" for (iudorn = 1; iudorn <= i__1; ++iudorn) { /* if (ibit .lt. 21) then */ /* if (ibit.lt.21 .or. ibit.eq.29) then */ -#line 23845 "" +#line 23839 "" if (ibit < 21 || ibit == 29 || ibit == 30) { -#line 23846 "" +#line 23840 "" ibitt = ibit; /* Could have oes, but not oe? or oes? */ -#line 23850 "" +#line 23844 "" } else if (iclracc > 0) { /* Earlier cleared edit. accid, meaning it was oes? */ -#line 23854 "" +#line 23848 "" ibitt = iclracc + 6; -#line 23855 "" +#line 23849 "" } else { -#line 23856 "" +#line 23850 "" ibitt = 21; -#line 23857 "" +#line 23851 "" } -#line 23858 "" +#line 23852 "" ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19); /* if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */ -#line 23860 "" +#line 23854 "" if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx == comivxudorn_1.ivxudorn[iudorn - 1]) { -#line 23860 "" +#line 23854 "" goto L4; -#line 23860 "" +#line 23854 "" } -#line 23862 "" +#line 23856 "" /* L3: */ -#line 23862 "" +#line 23856 "" } /* Nothing shifted on this note; exit this if block */ -#line 23866 "" +#line 23860 "" iudorn = 0; -#line 23867 "" +#line 23861 "" goto L5; -#line 23868 "" +#line 23862 "" L4: -#line 23869 "" +#line 23863 "" ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25) ) - 32; -#line 23870 "" +#line 23864 "" if (ibit == 19 && ioffinc < -7) { /* Convert usf to lsf. The reason has to do with positioning being impossile */ /* for some mysterious reason when you drop \usf below the staff */ /* Writing concatenation */ -#line 23875 "" +#line 23869 "" i__3[0] = 1, a__1[0] = sq; -#line 23875 "" +#line 23869 "" i__3[1] = 3, a__1[1] = "lsf"; -#line 23875 "" +#line 23869 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23876 "" +#line 23870 "" ioffinc += 6; -#line 23877 "" +#line 23871 "" } -#line 23878 "" +#line 23872 "" ioff += ioffinc; -#line 23879 "" +#line 23873 "" } -#line 23880 "" +#line 23874 "" L5: /* Shift level to avoid slur. Conditions are */ @@ -59107,149 +59384,149 @@ L5: /* 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */ /* 5. islhgt+3 >= height already computed. */ -#line 23889 "" +#line 23883 "" if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) { -#line 23889 "" +#line 23883 "" i__1 = *islhgt + 3; -#line 23889 "" +#line 23883 "" ioff += i_dim(&i__1, &ihorn); -#line 23889 "" +#line 23883 "" } -#line 23892 "" +#line 23886 "" i__1 = ihorn + ioff; -#line 23892 "" +#line 23886 "" notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8); -#line 23893 "" +#line 23887 "" if (lnoten == 1) { -#line 23893 "" +#line 23887 "" addblank_(noteq, &lnoten, (ftnlen)8); -#line 23893 "" +#line 23887 "" } -#line 23894 "" +#line 23888 "" if ((iornt & 32896) > 0) { /* T-trill or trill w/o "tr" */ -#line 23898 "" +#line 23892 "" dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, ( ftnlen)79); -#line 23899 "" +#line 23893 "" } else { /* Writing concatenation */ -#line 23900 "" +#line 23894 "" i__3[0] = lnote, a__1[0] = notexq; -#line 23900 "" +#line 23894 "" i__3[1] = lnoten, a__1[1] = noteq; -#line 23900 "" +#line 23894 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); -#line 23901 "" +#line 23895 "" lnote += lnoten; -#line 23902 "" +#line 23896 "" } -#line 23903 "" +#line 23897 "" if (iudorn > 0) { -#line 23904 "" +#line 23898 "" if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) { /* Horizontal shift */ -#line 23908 "" +#line 23902 "" lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]); -#line 23909 "" +#line 23903 "" ici__1.icierr = 0; -#line 23909 "" +#line 23903 "" ici__1.icirnum = 1; -#line 23909 "" +#line 23903 "" ici__1.icirlen = lform; -#line 23909 "" +#line 23903 "" ici__1.iciunit = noteq; /* Writing concatenation */ -#line 23909 "" +#line 23903 "" i__4[0] = 2, a__2[0] = "(f"; -#line 23909 "" +#line 23903 "" i__1 = lform + 48; -#line 23909 "" +#line 23903 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 23909 "" +#line 23903 "" i__4[1] = 1, a__2[1] = ch__1; -#line 23909 "" +#line 23903 "" i__4[2] = 3, a__2[2] = ".1)"; -#line 23909 "" +#line 23903 "" ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6), ch__2); -#line 23909 "" +#line 23903 "" s_wsfi(&ici__1); -#line 23909 "" +#line 23903 "" do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen) sizeof(real)); -#line 23909 "" +#line 23903 "" e_wsfi(); /* Writing concatenation */ -#line 23911 "" +#line 23905 "" i__5[0] = 1, a__3[0] = sq; -#line 23911 "" +#line 23905 "" i__5[1] = 8, a__3[1] = "roffset{"; -#line 23911 "" +#line 23905 "" i__5[2] = lform, a__3[2] = noteq; -#line 23911 "" +#line 23905 "" i__5[3] = 2, a__3[3] = "}{"; -#line 23911 "" +#line 23905 "" i__5[4] = lnote, a__3[4] = notexq; -#line 23911 "" +#line 23905 "" i__5[5] = 1, a__3[5] = "}"; -#line 23911 "" +#line 23905 "" s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79); -#line 23913 "" +#line 23907 "" lnote = lnote + lform + 12; -#line 23914 "" +#line 23908 "" comtrill_1.ornhshft[iudorn - 1] = 0.f; -#line 23915 "" +#line 23909 "" comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[ iudorn - 1],31); -#line 23916 "" +#line 23910 "" } -#line 23917 "" +#line 23911 "" } /* Zero out the bit for ornament just dealt with. */ -#line 23921 "" +#line 23915 "" *iornq = bit_clear(*iornq,ibit); -#line 23922 "" +#line 23916 "" if (*lout == 0) { -#line 23923 "" +#line 23917 "" s_copy(outq, notexq, (ftnlen)79, lnote); -#line 23924 "" +#line 23918 "" } else { /* Writing concatenation */ -#line 23925 "" +#line 23919 "" i__3[0] = *lout, a__1[0] = outq; -#line 23925 "" +#line 23919 "" i__3[1] = lnote, a__1[1] = notexq; -#line 23925 "" +#line 23919 "" s_cat(outq, a__1, i__3, &c__2, (ftnlen)79); -#line 23926 "" +#line 23920 "" } -#line 23927 "" +#line 23921 "" *lout += lnote; /* Check bits 0-21, go back if any are still set */ /* If bit 29 or 30 had been set, would have been used first time thru, */ /* and you wouldn't use both coda and segno on same note */ -#line 23933 "" +#line 23927 "" if ((*iornq & 4194303) > 0) { -#line 23933 "" +#line 23927 "" goto L2; -#line 23933 "" +#line 23927 "" } -#line 23934 "" +#line 23928 "" if (usehornb) { -#line 23934 "" +#line 23928 "" ++nornb[*ivx]; -#line 23934 "" +#line 23928 "" } -#line 23935 "" +#line 23929 "" return 0; } /* putorn_ */ @@ -59278,91 +59555,91 @@ L5: ftnlen, ftnlen); static char notexq[80]; -#line 23943 "" +#line 23937 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 23943 "" +#line 23937 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; /* Start user-defined offsets X(...): or X(...)S */ -#line 23947 "" +#line 23941 "" if (*onoff) { -#line 23947 "" +#line 23941 "" ++comudsp_1.nudoff[*ivx - 1]; -#line 23947 "" +#line 23941 "" } /* Xoff is in pts. Round off to nearest .1. Will use at end of shift. */ -#line 23951 "" +#line 23945 "" xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25]; -#line 23952 "" +#line 23946 "" r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f; -#line 23952 "" +#line 23946 "" xoff = r_sign(&r__1, &xoff); -#line 23953 "" +#line 23947 "" if (! (*onoff)) { -#line 23953 "" +#line 23947 "" xoff = -xoff; -#line 23953 "" +#line 23947 "" } -#line 23954 "" +#line 23948 "" if (xoff < -9.95f) { -#line 23955 "" +#line 23949 "" ifmt = 5; -#line 23956 "" +#line 23950 "" } else if (xoff < -.95f || xoff > 9.95f) { -#line 23957 "" +#line 23951 "" ifmt = 4; -#line 23958 "" +#line 23952 "" } else { -#line 23959 "" +#line 23953 "" ifmt = 3; -#line 23960 "" +#line 23954 "" } -#line 23961 "" +#line 23955 "" ici__1.icierr = 0; -#line 23961 "" +#line 23955 "" ici__1.icirnum = 1; -#line 23961 "" +#line 23955 "" ici__1.icirlen = 80; -#line 23961 "" +#line 23955 "" ici__1.iciunit = notexq; /* Writing concatenation */ -#line 23961 "" +#line 23955 "" i__1[0] = 2, a__1[0] = "(f"; -#line 23961 "" +#line 23955 "" i__2 = ifmt + 48; -#line 23961 "" +#line 23955 "" chax_(ch__1, (ftnlen)1, &i__2); -#line 23961 "" +#line 23955 "" i__1[1] = 1, a__1[1] = ch__1; -#line 23961 "" +#line 23955 "" i__1[2] = 3, a__1[2] = ".1)"; -#line 23961 "" +#line 23955 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); -#line 23961 "" +#line 23955 "" s_wsfi(&ici__1); -#line 23961 "" +#line 23955 "" do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real)); -#line 23961 "" +#line 23955 "" e_wsfi(); /* Writing concatenation */ -#line 23962 "" +#line 23956 "" i__3[0] = 1, a__2[0] = sq; -#line 23962 "" +#line 23956 "" i__3[1] = 4, a__2[1] = "off{"; -#line 23962 "" +#line 23956 "" i__3[2] = ifmt, a__2[2] = notexq; -#line 23962 "" +#line 23956 "" i__3[3] = 3, a__2[3] = "pt}"; -#line 23962 "" +#line 23956 "" s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88); -#line 23962 "" +#line 23956 "" i__2 = ifmt + 8; -#line 23962 "" +#line 23956 "" addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80); -#line 23964 "" +#line 23958 "" return 0; } /* putshft_ */ @@ -59405,352 +59682,352 @@ L5: /* Actual titles only allowed on p.1. (set by headlog). */ /* 3/18/01: The above comment is probably bogus...can use Tt on later pages. */ -#line 23983 "" +#line 23977 "" /* Parameter adjustments */ -#line 23983 "" +#line 23977 "" --sepsymq; -#line 23983 "" +#line 23977 "" -#line 23983 "" +#line 23977 "" /* Function Body */ /* Writing concatenation */ -#line 23983 "" +#line 23977 "" i__1[0] = 1, a__1[0] = sq; -#line 23983 "" +#line 23977 "" i__1[1] = 6, a__1[1] = "znotes"; -#line 23983 "" +#line 23977 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 23984 "" +#line 23978 "" lenline = 7; -#line 23985 "" +#line 23979 "" i__2 = *nv - 1; -#line 23985 "" +#line 23979 "" for (iv = 1; iv <= i__2; ++iv) { /* Writing concatenation */ -#line 23986 "" +#line 23980 "" i__1[0] = lenline, a__1[0] = notexq; -#line 23986 "" +#line 23980 "" i__1[1] = 1, a__1[1] = sepsymq + iv; -#line 23986 "" +#line 23980 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 23987 "" +#line 23981 "" ++lenline; -#line 23988 "" +#line 23982 "" /* L22: */ -#line 23988 "" +#line 23982 "" } /* Writing concatenation */ -#line 23989 "" +#line 23983 "" i__3[0] = lenline, a__2[0] = notexq; -#line 23989 "" +#line 23983 "" i__3[1] = 1, a__2[1] = sq; -#line 23989 "" +#line 23983 "" i__3[2] = 10, a__2[2] = "zcharnote{"; -#line 23989 "" +#line 23983 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); -#line 23990 "" +#line 23984 "" lenline += 11; -#line 23991 "" +#line 23985 "" if (! comtitl_1.headlog) { -#line 23992 "" +#line 23986 "" comtitl_1.inhead = *inhnoh; -#line 23993 "" +#line 23987 "" } -#line 23994 "" +#line 23988 "" if (*vshrink && comlast_1.usevshrink) { -#line 23995 "" +#line 23989 "" comtitl_1.inhead = 16; -#line 23996 "" +#line 23990 "" } -#line 23997 "" +#line 23991 "" r__1 = comtitl_1.inhead + .01f; -#line 23997 "" +#line 23991 "" ndig = (integer) r_lg10(&r__1) + 1; -#line 23998 "" +#line 23992 "" i__2 = lenline; -#line 23998 "" +#line 23992 "" ici__1.icierr = 0; -#line 23998 "" +#line 23992 "" ici__1.icirnum = 1; -#line 23998 "" +#line 23992 "" ici__1.icirlen = lenline + ndig + 10 - i__2; -#line 23998 "" +#line 23992 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ -#line 23998 "" +#line 23992 "" i__3[0] = 2, a__2[0] = "(i"; -#line 23998 "" +#line 23992 "" i__4 = ndig + 48; -#line 23998 "" +#line 23992 "" chax_(ch__2, (ftnlen)1, &i__4); -#line 23998 "" +#line 23992 "" i__3[1] = 1, a__2[1] = ch__2; -#line 23998 "" +#line 23992 "" i__3[2] = 5, a__2[2] = ",a10)"; -#line 23998 "" +#line 23992 "" ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1); -#line 23998 "" +#line 23992 "" s_wsfi(&ici__1); -#line 23998 "" +#line 23992 "" do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 23998 "" +#line 23992 "" i__5[0] = 2, a__3[0] = "}{"; -#line 23998 "" +#line 23992 "" i__5[1] = 1, a__3[1] = sq; -#line 23998 "" +#line 23992 "" i__5[2] = 7, a__3[2] = "titles{"; -#line 23998 "" +#line 23992 "" s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10); -#line 23998 "" +#line 23992 "" do_fio(&c__1, ch__3, (ftnlen)10); -#line 23998 "" +#line 23992 "" e_wsfi(); -#line 24000 "" +#line 23994 "" lenline = lenline + ndig + 10; /* Vertical skip at top of page (\Il) = etatop*glueil. Needed whether */ /* headers are present or not. */ -#line 24005 "" +#line 23999 "" glueil = *xnsttop / *etatop; -#line 24006 "" +#line 24000 "" vskil = *etatop * glueil; -#line 24007 "" +#line 24001 "" if (*vshrink && comlast_1.usevshrink) { -#line 24007 "" +#line 24001 "" vskil = 2.f; -#line 24007 "" +#line 24001 "" } -#line 24008 "" +#line 24002 "" writflot_(&vskil, notexq, &lenline, (ftnlen)127); -#line 24009 "" +#line 24003 "" if (! comtitl_1.headlog) { -#line 24010 "" +#line 24004 "" if (comlast_1.islast) { -#line 24010 "" +#line 24004 "" s_wsfe(&io___1706); /* Writing concatenation */ -#line 24010 "" +#line 24004 "" i__6[0] = lenline, a__4[0] = notexq; -#line 24010 "" +#line 24004 "" i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}"; -#line 24010 "" +#line 24004 "" i__6[2] = 1, a__4[2] = sq; -#line 24010 "" +#line 24004 "" i__6[3] = 3, a__4[3] = "en%"; -#line 24010 "" +#line 24004 "" s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148); -#line 24010 "" +#line 24004 "" do_fio(&c__1, ch__4, lenline + 21); -#line 24010 "" +#line 24004 "" e_wsfe(); -#line 24010 "" +#line 24004 "" } -#line 24012 "" +#line 24006 "" } else { /* Writing concatenation */ -#line 24013 "" +#line 24007 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24013 "" +#line 24007 "" i__1[1] = 2, a__1[1] = "}{"; -#line 24013 "" +#line 24007 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24014 "" +#line 24008 "" lenline += 2; -#line 24015 "" +#line 24009 "" lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120); -#line 24016 "" +#line 24010 "" if (lcq > 0) { -#line 24017 "" +#line 24011 "" xitil = *etait * glueil; -#line 24018 "" +#line 24012 "" if (*vshrink && comlast_1.usevshrink) { -#line 24018 "" +#line 24012 "" xitil = 2.f; -#line 24018 "" +#line 24012 "" } /* Writing concatenation */ -#line 24019 "" +#line 24013 "" i__3[0] = lenline, a__2[0] = notexq; -#line 24019 "" +#line 24013 "" i__3[1] = lcq, a__2[1] = comtitl_1.instrq; -#line 24019 "" +#line 24013 "" i__3[2] = 2, a__2[2] = "}{"; -#line 24019 "" +#line 24013 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); /* Null out instrument once used */ -#line 24023 "" +#line 24017 "" s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1); -#line 24024 "" +#line 24018 "" lenline = lenline + lcq + 2; -#line 24025 "" +#line 24019 "" writflot_(&xitil, notexq, &lenline, (ftnlen)127); -#line 24026 "" +#line 24020 "" } else { /* Writing concatenation */ -#line 24027 "" +#line 24021 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24027 "" +#line 24021 "" i__1[1] = 3, a__1[1] = "}{0"; -#line 24027 "" +#line 24021 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24028 "" +#line 24022 "" lenline += 3; -#line 24029 "" +#line 24023 "" } -#line 24030 "" +#line 24024 "" if (comlast_1.islast) { -#line 24030 "" +#line 24024 "" s_wsfe(&io___1709); /* Writing concatenation */ -#line 24030 "" +#line 24024 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24030 "" +#line 24024 "" i__1[1] = 2, a__1[1] = "}%"; -#line 24030 "" +#line 24024 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129); -#line 24030 "" +#line 24024 "" do_fio(&c__1, ch__5, lenline + 2); -#line 24030 "" +#line 24024 "" e_wsfe(); -#line 24030 "" +#line 24024 "" } -#line 24031 "" +#line 24025 "" s_copy(notexq, "{", (ftnlen)127, (ftnlen)1); -#line 24032 "" +#line 24026 "" lenline = 1; -#line 24033 "" +#line 24027 "" lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120); -#line 24034 "" +#line 24028 "" if (lcq > 0) { /* Writing concatenation */ -#line 24035 "" +#line 24029 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24035 "" +#line 24029 "" i__1[1] = lcq, a__1[1] = comtitl_1.titleq; -#line 24035 "" +#line 24029 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24036 "" +#line 24030 "" lenline += lcq; -#line 24037 "" +#line 24031 "" } else { -#line 24038 "" +#line 24032 "" printl_(" ", (ftnlen)1); -#line 24039 "" +#line 24033 "" printl_("WARNING", (ftnlen)7); -#line 24040 "" +#line 24034 "" printl_(" In a title block, you have specified instrument and/or" , (ftnlen)56); -#line 24042 "" +#line 24036 "" printl_(" composer but no title for the piece.", (ftnlen)38); -#line 24044 "" +#line 24038 "" } /* Writing concatenation */ -#line 24045 "" +#line 24039 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24045 "" +#line 24039 "" i__1[1] = 2, a__1[1] = "}{"; -#line 24045 "" +#line 24039 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24046 "" +#line 24040 "" lenline += 2; -#line 24047 "" +#line 24041 "" xtcil = *etatc * glueil; -#line 24048 "" +#line 24042 "" lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120); -#line 24049 "" +#line 24043 "" if (lcq == 0) { -#line 24049 "" +#line 24043 "" xtcil *= 2; -#line 24049 "" +#line 24043 "" } -#line 24050 "" +#line 24044 "" if (*vshrink && comlast_1.usevshrink) { -#line 24050 "" +#line 24044 "" xtcil = 2.f; -#line 24050 "" +#line 24044 "" } -#line 24051 "" +#line 24045 "" writflot_(&xtcil, notexq, &lenline, (ftnlen)127); /* Writing concatenation */ -#line 24052 "" +#line 24046 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24052 "" +#line 24046 "" i__1[1] = 2, a__1[1] = "}{"; -#line 24052 "" +#line 24046 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24053 "" +#line 24047 "" lenline += 2; -#line 24054 "" +#line 24048 "" if (lcq > 0) { /* Writing concatenation */ -#line 24055 "" +#line 24049 "" i__3[0] = lenline, a__2[0] = notexq; -#line 24055 "" +#line 24049 "" i__3[1] = lcq, a__2[1] = comtitl_1.compoq; -#line 24055 "" +#line 24049 "" i__3[2] = 2, a__2[2] = "}{"; -#line 24055 "" +#line 24049 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); -#line 24056 "" +#line 24050 "" lenline = lenline + 2 + lcq; /* Null out compoq so it does not get written later */ -#line 24060 "" +#line 24054 "" s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1); -#line 24061 "" +#line 24055 "" xcsil = *etacs1 * glueil; -#line 24062 "" +#line 24056 "" if (*vshrink && comlast_1.usevshrink) { -#line 24062 "" +#line 24056 "" xcsil = 2.f; -#line 24062 "" +#line 24056 "" } -#line 24063 "" +#line 24057 "" writflot_(&xcsil, notexq, &lenline, (ftnlen)127); -#line 24064 "" +#line 24058 "" } else { /* Writing concatenation */ -#line 24065 "" +#line 24059 "" i__1[0] = lenline, a__1[0] = notexq; -#line 24065 "" +#line 24059 "" i__1[1] = 3, a__1[1] = "}{0"; -#line 24065 "" +#line 24059 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); -#line 24066 "" +#line 24060 "" lenline += 3; -#line 24067 "" +#line 24061 "" } -#line 24068 "" +#line 24062 "" if (comlast_1.islast) { -#line 24068 "" +#line 24062 "" s_wsfe(&io___1712); /* Writing concatenation */ -#line 24068 "" +#line 24062 "" i__6[0] = lenline, a__4[0] = notexq; -#line 24068 "" +#line 24062 "" i__6[1] = 2, a__4[1] = "}}"; -#line 24068 "" +#line 24062 "" i__6[2] = 1, a__4[2] = sq; -#line 24068 "" +#line 24062 "" i__6[3] = 3, a__4[3] = "en%"; -#line 24068 "" +#line 24062 "" s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133); -#line 24068 "" +#line 24062 "" do_fio(&c__1, ch__6, lenline + 6); -#line 24068 "" +#line 24062 "" e_wsfe(); -#line 24068 "" +#line 24062 "" } -#line 24069 "" +#line 24063 "" comtitl_1.headlog = FALSE_; -#line 24070 "" +#line 24064 "" } -#line 24071 "" +#line 24065 "" return 0; } /* puttitle_ */ @@ -59786,218 +60063,218 @@ L5: /* Places digit for xtuplet. */ -#line 24084 "" +#line 24078 "" if (*iflop != 0 && *multb > 0) { /* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */ -#line 24088 "" +#line 24082 "" *eloff -= *iud * .5f * *wheadpt / *poenom; /* Number goes on beam side, must use beam parameters to set pos'n */ -#line 24092 "" +#line 24086 "" *nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8); -#line 24093 "" +#line 24087 "" if (*multb >= 2) { -#line 24093 "" +#line 24087 "" *nlnum += *iup; -#line 24093 "" +#line 24087 "" } -#line 24094 "" +#line 24088 "" } else { -#line 24095 "" +#line 24089 "" r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11; -#line 24095 "" +#line 24089 "" *nlnum = i_nint(&r__1); -#line 24096 "" +#line 24090 "" } -#line 24097 "" +#line 24091 "" if (! bit_test(*islur,31)) { /* Only print number when wanted. First check vert, horiz offset */ -#line 24101 "" +#line 24095 "" if (bit_test(*irest,1)) { -#line 24101 "" +#line 24095 "" *nlnum = *nlnum + igetbits_(mult, &c__8, &c__16) - 64; -#line 24101 "" +#line 24095 "" } -#line 24102 "" +#line 24096 "" if (bit_test(*irest,7)) { -#line 24102 "" +#line 24096 "" *eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * * wheadpt / *poenom; -#line 24102 "" +#line 24096 "" } -#line 24104 "" +#line 24098 "" if (! (*usexnumt)) { /* Writing concatenation */ -#line 24105 "" +#line 24099 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 24105 "" +#line 24099 "" i__1[0] = 1, a__1[0] = ch__1; -#line 24105 "" +#line 24099 "" i__1[1] = 5, a__1[1] = "xnum{"; -#line 24105 "" +#line 24099 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 24106 "" +#line 24100 "" *lnote = 10; -#line 24107 "" +#line 24101 "" istrtn = 7; -#line 24108 "" +#line 24102 "" } else { /* Writing concatenation */ -#line 24109 "" +#line 24103 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 24109 "" +#line 24103 "" i__1[0] = 1, a__1[0] = ch__1; -#line 24109 "" +#line 24103 "" i__1[1] = 6, a__1[1] = "xnumt{"; -#line 24109 "" +#line 24103 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 24110 "" +#line 24104 "" *lnote = 11; -#line 24111 "" +#line 24105 "" istrtn = 8; -#line 24112 "" +#line 24106 "" } -#line 24113 "" +#line 24107 "" if (*eloff < .995f) { -#line 24114 "" +#line 24108 "" ici__1.icierr = 0; -#line 24114 "" +#line 24108 "" ici__1.icirnum = 1; -#line 24114 "" +#line 24108 "" ici__1.icirlen = 4; -#line 24114 "" +#line 24108 "" ici__1.iciunit = notexq + (istrtn - 1); -#line 24114 "" +#line 24108 "" ici__1.icifmt = "(i1,f3.2)"; -#line 24114 "" +#line 24108 "" s_wsfi(&ici__1); -#line 24114 "" +#line 24108 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 24114 "" +#line 24108 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); -#line 24114 "" +#line 24108 "" e_wsfi(); -#line 24115 "" +#line 24109 "" } else if (*eloff < 9.995f) { -#line 24116 "" +#line 24110 "" ici__1.icierr = 0; -#line 24116 "" +#line 24110 "" ici__1.icirnum = 1; -#line 24116 "" +#line 24110 "" ici__1.icirlen = 4; -#line 24116 "" +#line 24110 "" ici__1.iciunit = notexq + (istrtn - 1); -#line 24116 "" +#line 24110 "" ici__1.icifmt = "(f4.2)"; -#line 24116 "" +#line 24110 "" s_wsfi(&ici__1); -#line 24116 "" +#line 24110 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); -#line 24116 "" +#line 24110 "" e_wsfi(); -#line 24117 "" +#line 24111 "" } else { -#line 24118 "" +#line 24112 "" ici__1.icierr = 0; -#line 24118 "" +#line 24112 "" ici__1.icirnum = 1; -#line 24118 "" +#line 24112 "" ici__1.icirlen = 5; -#line 24118 "" +#line 24112 "" ici__1.iciunit = notexq + (istrtn - 1); -#line 24118 "" +#line 24112 "" ici__1.icifmt = "(f5.2)"; -#line 24118 "" +#line 24112 "" s_wsfi(&ici__1); -#line 24118 "" +#line 24112 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); -#line 24118 "" +#line 24112 "" e_wsfi(); -#line 24119 "" +#line 24113 "" ++(*lnote); -#line 24120 "" +#line 24114 "" } -#line 24121 "" +#line 24115 "" notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8); /* Writing concatenation */ -#line 24122 "" +#line 24116 "" i__2[0] = *lnote, a__2[0] = notexq; -#line 24122 "" +#line 24116 "" i__2[1] = 1, a__2[1] = "}"; -#line 24122 "" +#line 24116 "" i__2[2] = lnoten, a__2[2] = noteq; -#line 24122 "" +#line 24116 "" s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); -#line 24123 "" +#line 24117 "" *lnote = *lnote + 1 + lnoten; -#line 24124 "" +#line 24118 "" if (*ntupv < 10) { -#line 24125 "" +#line 24119 "" i__3 = *lnote; -#line 24125 "" +#line 24119 "" ici__1.icierr = 0; -#line 24125 "" +#line 24119 "" ici__1.icirnum = 1; -#line 24125 "" +#line 24119 "" ici__1.icirlen = *lnote + 1 - i__3; -#line 24125 "" +#line 24119 "" ici__1.iciunit = notexq + i__3; -#line 24125 "" +#line 24119 "" ici__1.icifmt = "(i1)"; -#line 24125 "" +#line 24119 "" s_wsfi(&ici__1); -#line 24125 "" +#line 24119 "" do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); -#line 24125 "" +#line 24119 "" e_wsfi(); -#line 24126 "" +#line 24120 "" ++(*lnote); -#line 24127 "" +#line 24121 "" } else { /* Writing concatenation */ -#line 24128 "" +#line 24122 "" i__1[0] = *lnote, a__1[0] = notexq; -#line 24128 "" +#line 24122 "" i__1[1] = 1, a__1[1] = "{"; -#line 24128 "" +#line 24122 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 24129 "" +#line 24123 "" i__3 = *lnote + 1; -#line 24129 "" +#line 24123 "" ici__1.icierr = 0; -#line 24129 "" +#line 24123 "" ici__1.icirnum = 1; -#line 24129 "" +#line 24123 "" ici__1.icirlen = *lnote + 3 - i__3; -#line 24129 "" +#line 24123 "" ici__1.iciunit = notexq + i__3; -#line 24129 "" +#line 24123 "" ici__1.icifmt = "(i2)"; -#line 24129 "" +#line 24123 "" s_wsfi(&ici__1); -#line 24129 "" +#line 24123 "" do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); -#line 24129 "" +#line 24123 "" e_wsfi(); /* Writing concatenation */ -#line 24130 "" +#line 24124 "" i__1[0] = *lnote + 3, a__1[0] = notexq; -#line 24130 "" +#line 24124 "" i__1[1] = 1, a__1[1] = "}"; -#line 24130 "" +#line 24124 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); -#line 24131 "" +#line 24125 "" *lnote += 4; -#line 24132 "" +#line 24126 "" } -#line 24133 "" +#line 24127 "" } -#line 24134 "" +#line 24128 "" return 0; } /* putxtn_ */ @@ -60011,97 +60288,97 @@ L5: static integer ip1, ip2; extern /* Subroutine */ int getbuf_(char *, ftnlen); -#line 24148 "" +#line 24142 "" if (! commac_1.mplay) { -#line 24149 "" +#line 24143 "" if (inbuff_1.ilbuf > inbuff_1.nlbuf) { -#line 24149 "" +#line 24143 "" goto L999; -#line 24149 "" +#line 24143 "" } -#line 24150 "" +#line 24144 "" getbuf_(string, string_len); -#line 24151 "" +#line 24145 "" return 0; -#line 24152 "" +#line 24146 "" L999: -#line 24152 "" +#line 24146 "" *lastchar = TRUE_; -#line 24153 "" +#line 24147 "" return 0; -#line 24154 "" +#line 24148 "" } else { /* Play a macro. Set pointer to first character needed in buffer */ -#line 24158 "" +#line 24152 "" if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) { /* Getting first line of macro */ -#line 24162 "" +#line 24156 "" ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1]; -#line 24163 "" +#line 24157 "" c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1]; -#line 24164 "" +#line 24158 "" } else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) { /* Beyond first line of macro. Advance line-start pointer. */ -#line 24168 "" +#line 24162 "" c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2]; -#line 24169 "" +#line 24163 "" ip1 = c1ommac_1.iplmac + 1; -#line 24170 "" +#line 24164 "" } else { /* Beyond last line of macro. Terminate it! */ -#line 24174 "" +#line 24168 "" commac_1.mplay = FALSE_; -#line 24175 "" +#line 24169 "" commac_1.endmac = TRUE_; -#line 24176 "" +#line 24170 "" return 0; -#line 24177 "" +#line 24171 "" } -#line 24178 "" +#line 24172 "" if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) { /* Getting last line of macro. */ -#line 24182 "" +#line 24176 "" ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1]; -#line 24183 "" +#line 24177 "" } else { /* Getting line before last line of macro. */ -#line 24187 "" +#line 24181 "" ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1]; -#line 24188 "" +#line 24182 "" } -#line 24189 "" +#line 24183 "" if (ip2 >= ip1) { -#line 24190 "" +#line 24184 "" s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1 - 1)); -#line 24191 "" +#line 24185 "" } else { /* Kluge for when macro start is on a line by itself */ -#line 24195 "" +#line 24189 "" s_copy(string, " ", string_len, (ftnlen)1); -#line 24196 "" +#line 24190 "" } -#line 24197 "" +#line 24191 "" ++c1ommac_1.ilmac; -#line 24198 "" +#line 24192 "" return 0; -#line 24199 "" +#line 24193 "" } -#line 24200 "" +#line 24194 "" return 0; } /* read10_ */ @@ -60138,123 +60415,123 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen /* file 10 (jobname.pmx) and increments nline if needed, passes over */ /* comment lines */ -#line 24209 "" +#line 24203 "" L4: -#line 24209 "" +#line 24203 "" if (*iccount == 128) { -#line 24210 "" +#line 24204 "" L1: -#line 24210 "" +#line 24204 "" getbuf_(lineq, (ftnlen)128); -#line 24211 "" +#line 24205 "" ++(*nline); -#line 24212 "" +#line 24206 "" if (*(unsigned char *)lineq == '%') { -#line 24212 "" +#line 24206 "" goto L1; -#line 24212 "" +#line 24206 "" } -#line 24213 "" +#line 24207 "" *iccount = 0; -#line 24214 "" +#line 24208 "" } -#line 24215 "" +#line 24209 "" ++(*iccount); /* Find next non-blank or end of line */ -#line 24219 "" +#line 24213 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { -#line 24220 "" +#line 24214 "" if (*(unsigned char *)&lineq[*iccount - 1] != ' ') { -#line 24220 "" +#line 24214 "" goto L3; -#line 24220 "" +#line 24214 "" } -#line 24221 "" +#line 24215 "" /* L2: */ -#line 24221 "" +#line 24215 "" } /* If here, need to get a new line */ -#line 24225 "" +#line 24219 "" *iccount = 128; -#line 24226 "" +#line 24220 "" goto L4; -#line 24227 "" +#line 24221 "" L3: /* iccount now points to start of number to read */ -#line 24231 "" +#line 24225 "" i1 = *iccount; -#line 24232 "" +#line 24226 "" L5: -#line 24232 "" +#line 24226 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar increments iccount, then reads a character. */ -#line 24236 "" +#line 24230 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 24236 "" +#line 24230 "" goto L5; -#line 24236 "" +#line 24230 "" } -#line 24237 "" +#line 24231 "" i2 = *iccount - 1; -#line 24238 "" +#line 24232 "" if (i2 < i1) { -#line 24239 "" +#line 24233 "" s_wsle(&io___1721); /* Writing concatenation */ -#line 24239 "" +#line 24233 "" i__1[0] = 7, a__1[0] = "Found \""; -#line 24239 "" +#line 24233 "" i__1[1] = 1, a__1[1] = durq; -#line 24239 "" +#line 24233 "" i__1[2] = 19, a__1[2] = "\" instead of number"; -#line 24239 "" +#line 24233 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); -#line 24239 "" +#line 24233 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); -#line 24239 "" +#line 24233 "" e_wsle(); -#line 24240 "" +#line 24234 "" stop1_(); -#line 24241 "" +#line 24235 "" } -#line 24242 "" +#line 24236 "" icf = i2 - i1 + 49; -#line 24243 "" +#line 24237 "" ici__1.icierr = 0; -#line 24243 "" +#line 24237 "" ici__1.iciend = 0; -#line 24243 "" +#line 24237 "" ici__1.icirnum = 1; -#line 24243 "" +#line 24237 "" ici__1.icirlen = i2 - (i1 - 1); -#line 24243 "" +#line 24237 "" ici__1.iciunit = lineq + (i1 - 1); /* Writing concatenation */ -#line 24243 "" +#line 24237 "" i__1[0] = 2, a__1[0] = "(f"; -#line 24243 "" +#line 24237 "" chax_(ch__3, (ftnlen)1, &icf); -#line 24243 "" +#line 24237 "" i__1[1] = 1, a__1[1] = ch__3; -#line 24243 "" +#line 24237 "" i__1[2] = 3, a__1[2] = ".0)"; -#line 24243 "" +#line 24237 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); -#line 24243 "" +#line 24237 "" s_rsfi(&ici__1); -#line 24243 "" +#line 24237 "" do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); -#line 24243 "" +#line 24237 "" e_rsfi(); -#line 24244 "" +#line 24238 "" return ret_val; } /* readin_ */ @@ -60264,7 +60541,7 @@ L5: /* System generated locals */ address a__1[3]; integer i__1, i__2[3]; - char ch__1[4], ch__2[1]; + char ch__1[1], ch__2[4]; icilist ici__1; /* Builtin functions */ @@ -60280,160 +60557,166 @@ L5: extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, ftnlen); -#line 24249 "" +#line 24243 "" i__1 = *iccount; -#line 24249 "" - if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) { +#line 24243 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 24243 "" + if (i_indx(lineq + i__1, ch__1, *iccount + 3 - i__1, (ftnlen)1) == 0) { /* No slashes, so use old method */ -#line 24253 "" +#line 24247 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24254 "" +#line 24248 "" if (*(unsigned char *)durq == '-') { /* Negative numerator is used only to printed; signals vertical slash */ -#line 24258 "" +#line 24252 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24259 "" +#line 24253 "" *mtrnum = -(*(unsigned char *)durq - 48); -#line 24260 "" +#line 24254 "" } else if (*(unsigned char *)durq == 'o') { /* Numerator is EXACTLY 1 */ -#line 24264 "" +#line 24258 "" *mtrnum = 1; -#line 24265 "" +#line 24259 "" } else { -#line 24266 "" +#line 24260 "" *mtrnum = *(unsigned char *)durq - 48; -#line 24267 "" +#line 24261 "" if (*mtrnum == 1) { /* Numerator is >9 */ -#line 24271 "" +#line 24265 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24272 "" +#line 24266 "" *mtrnum = *(unsigned char *)durq - 38; -#line 24273 "" +#line 24267 "" } -#line 24274 "" +#line 24268 "" } -#line 24275 "" +#line 24269 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24276 "" +#line 24270 "" if (*(unsigned char *)durq == 'o') { -#line 24277 "" +#line 24271 "" *mtrden = 1; -#line 24278 "" +#line 24272 "" } else { -#line 24279 "" +#line 24273 "" *mtrden = *(unsigned char *)durq - 48; -#line 24280 "" +#line 24274 "" if (*mtrden == 1) { -#line 24281 "" +#line 24275 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24282 "" +#line 24276 "" *mtrden = *(unsigned char *)durq - 38; -#line 24283 "" +#line 24277 "" } -#line 24284 "" +#line 24278 "" } -#line 24285 "" +#line 24279 "" } else { /* Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */ -#line 24289 "" +#line 24283 "" ++(*iccount); -#line 24290 "" - ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), ( +#line 24284 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 24284 "" + ns = i_indx(lineq + (*iccount - 1), ch__1, 128 - (*iccount - 1), ( ftnlen)1); -#line 24291 "" +#line 24285 "" ici__1.icierr = 0; -#line 24291 "" +#line 24285 "" ici__1.iciend = 0; -#line 24291 "" +#line 24285 "" ici__1.icirnum = 1; -#line 24291 "" +#line 24285 "" ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); -#line 24291 "" +#line 24285 "" ici__1.iciunit = lineq + (*iccount - 1); /* Writing concatenation */ -#line 24291 "" +#line 24285 "" i__2[0] = 2, a__1[0] = "(i"; -#line 24291 "" +#line 24285 "" i__1 = ns + 47; -#line 24291 "" - chax_(ch__2, (ftnlen)1, &i__1); -#line 24291 "" - i__2[1] = 1, a__1[1] = ch__2; -#line 24291 "" +#line 24285 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 24285 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 24285 "" i__2[2] = 1, a__1[2] = ")"; -#line 24291 "" - ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); -#line 24291 "" +#line 24285 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2); +#line 24285 "" s_rsfi(&ici__1); -#line 24291 "" +#line 24285 "" do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer)); -#line 24291 "" +#line 24285 "" e_rsfi(); /* Reset iccount to start of second integer */ -#line 24295 "" +#line 24289 "" *iccount += ns; /* There must be either a slash or a blank at pos'n 2 or 3 */ -#line 24299 "" - ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1); -#line 24300 "" +#line 24293 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 24293 "" + ns = i_indx(lineq + (*iccount - 1), ch__1, (ftnlen)3, (ftnlen)1); +#line 24294 "" if (ns == 0) { -#line 24300 "" +#line 24294 "" ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1); -#line 24300 "" +#line 24294 "" } -#line 24301 "" +#line 24295 "" ici__1.icierr = 0; -#line 24301 "" +#line 24295 "" ici__1.iciend = 0; -#line 24301 "" +#line 24295 "" ici__1.icirnum = 1; -#line 24301 "" +#line 24295 "" ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); -#line 24301 "" +#line 24295 "" ici__1.iciunit = lineq + (*iccount - 1); /* Writing concatenation */ -#line 24301 "" +#line 24295 "" i__2[0] = 2, a__1[0] = "(i"; -#line 24301 "" +#line 24295 "" i__1 = ns + 47; -#line 24301 "" - chax_(ch__2, (ftnlen)1, &i__1); -#line 24301 "" - i__2[1] = 1, a__1[1] = ch__2; -#line 24301 "" +#line 24295 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 24295 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 24295 "" i__2[2] = 1, a__1[2] = ")"; -#line 24301 "" - ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); -#line 24301 "" +#line 24295 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2); +#line 24295 "" s_rsfi(&ici__1); -#line 24301 "" +#line 24295 "" do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer)); -#line 24301 "" +#line 24295 "" e_rsfi(); /* Set iccount to last character used */ -#line 24305 "" +#line 24299 "" *iccount = *iccount + ns - 1; -#line 24306 "" +#line 24300 "" } -#line 24307 "" +#line 24301 "" return 0; } /* readmeter_ */ @@ -60469,78 +60752,78 @@ L5: /* call this routine *after* detecting a number or decimal. */ /* On exit, durq is next character after end of number. */ -#line 24318 "" +#line 24312 "" i1 = *iccount; -#line 24319 "" +#line 24313 "" L1: -#line 24319 "" +#line 24313 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24320 "" +#line 24314 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { -#line 24320 "" +#line 24314 "" goto L1; -#line 24320 "" +#line 24314 "" } -#line 24321 "" +#line 24315 "" i2 = *iccount - 1; -#line 24322 "" +#line 24316 "" if (i2 < i1) { -#line 24323 "" +#line 24317 "" s_wsle(&io___1727); /* Writing concatenation */ -#line 24323 "" +#line 24317 "" i__1[0] = 7, a__1[0] = "Found \""; -#line 24323 "" +#line 24317 "" i__1[1] = 1, a__1[1] = durq; -#line 24323 "" +#line 24317 "" i__1[2] = 19, a__1[2] = "\" instead of number"; -#line 24323 "" +#line 24317 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); -#line 24323 "" +#line 24317 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); -#line 24323 "" +#line 24317 "" e_wsle(); -#line 24324 "" +#line 24318 "" stop1_(); -#line 24325 "" +#line 24319 "" } else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)& lineq[i2 - 1] == '.') { -#line 24326 "" +#line 24320 "" --i2; -#line 24327 "" +#line 24321 "" --(*iccount); -#line 24328 "" +#line 24322 "" } -#line 24329 "" +#line 24323 "" icf = i2 - i1 + 49; -#line 24330 "" +#line 24324 "" ici__1.icierr = 0; -#line 24330 "" +#line 24324 "" ici__1.iciend = 0; -#line 24330 "" +#line 24324 "" ici__1.icirnum = 1; -#line 24330 "" +#line 24324 "" ici__1.icirlen = i2 - (i1 - 1); -#line 24330 "" +#line 24324 "" ici__1.iciunit = lineq + (i1 - 1); /* Writing concatenation */ -#line 24330 "" +#line 24324 "" i__1[0] = 2, a__1[0] = "(f"; -#line 24330 "" +#line 24324 "" chax_(ch__3, (ftnlen)1, &icf); -#line 24330 "" +#line 24324 "" i__1[1] = 1, a__1[1] = ch__3; -#line 24330 "" +#line 24324 "" i__1[2] = 3, a__1[2] = ".0)"; -#line 24330 "" +#line 24324 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); -#line 24330 "" +#line 24324 "" s_rsfi(&ici__1); -#line 24330 "" +#line 24324 "" do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real)); -#line 24330 "" +#line 24324 "" e_rsfi(); -#line 24331 "" +#line 24325 "" return 0; } /* readnum_ */ @@ -60556,13 +60839,13 @@ L1: /* Sets iwidbits of isdata, shifted by ishift, to ivalue */ -#line 24337 "" +#line 24331 "" ibase = pow_ii(&c__2, iwidbit) - 1; -#line 24338 "" +#line 24332 "" *isdata = ~ lbit_shift(ibase, *ishift) & *isdata; -#line 24339 "" +#line 24333 "" *isdata |= lbit_shift(*ivalue, *ishift); -#line 24340 "" +#line 24334 "" return 0; } /* setbits_ */ @@ -60584,97 +60867,97 @@ L1: /* The MEAN SQUARE slope algorithm */ -#line 24362 "" +#line 24356 "" /* Parameter adjustments */ -#line 24362 "" +#line 24356 "" --ipb; -#line 24362 "" +#line 24356 "" --xelsk; -#line 24362 "" +#line 24356 "" -#line 24362 "" +#line 24356 "" /* Function Body */ -#line 24362 "" +#line 24356 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; -#line 24363 "" +#line 24357 "" sumxx = 0.f; -#line 24364 "" +#line 24358 "" sumxy = 0.f; -#line 24365 "" +#line 24359 "" i__1 = *nnb; -#line 24365 "" +#line 24359 "" for (inb = 1; inb <= i__1; ++inb) { /* Computing 2nd power */ -#line 24366 "" +#line 24360 "" r__1 = xelsk[inb]; -#line 24366 "" +#line 24360 "" sumxx += r__1 * r__1; -#line 24367 "" +#line 24361 "" sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; -#line 24368 "" +#line 24362 "" /* L2: */ -#line 24368 "" +#line 24362 "" } -#line 24369 "" +#line 24363 "" delta = *nnb * sumxx - *sumx * *sumx; -#line 24370 "" +#line 24364 "" em = (*nnb * sumxy - *sumx * *sumy) / delta; -#line 24371 "" +#line 24365 "" r__1 = em * .5f * all_1.slfac; -#line 24371 "" +#line 24365 "" *islope = i_nint(&r__1); -#line 24372 "" +#line 24366 "" if (abs(*islope) > 9) { -#line 24372 "" +#line 24366 "" *islope = i_sign(&c__9, islope); -#line 24372 "" +#line 24366 "" } -#line 24373 "" +#line 24367 "" beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb; -#line 24374 "" +#line 24368 "" *nolev1 = i_nint(&beta); /* Check if any stems are too short */ -#line 24378 "" +#line 24372 "" smin = 100.f; -#line 24379 "" +#line 24373 "" iul = -1; -#line 24380 "" +#line 24374 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { -#line 24380 "" +#line 24374 "" iul = 1; -#line 24380 "" +#line 24374 "" } -#line 24381 "" +#line 24375 "" i__1 = *nnb; -#line 24381 "" +#line 24375 "" for (inb = 1; inb <= i__1; ++inb) { -#line 24382 "" +#line 24376 "" ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] / all_1.slfac; -#line 24383 "" +#line 24377 "" ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; /* Computing MIN */ -#line 24384 "" +#line 24378 "" r__1 = smin, r__2 = iul * (ybeam - ynote); -#line 24384 "" +#line 24378 "" smin = dmin(r__1,r__2); -#line 24385 "" +#line 24379 "" /* L4: */ -#line 24385 "" +#line 24379 "" } -#line 24386 "" +#line 24380 "" if (smin < all_1.stemmin) { -#line 24387 "" +#line 24381 "" deficit = all_1.stemmin - smin; -#line 24388 "" +#line 24382 "" r__1 = *nolev1 + iul * deficit; -#line 24388 "" +#line 24382 "" *nolev1 = i_nint(&r__1); -#line 24389 "" +#line 24383 "" } -#line 24390 "" +#line 24384 "" return 0; } /* setbm2_ */ @@ -60710,157 +60993,157 @@ L1: /* Macro action */ -#line 24403 "" +#line 24397 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 24404 "" +#line 24398 "" if (*(unsigned char *)charq == 'S' && *ivx != 1) { -#line 24405 "" +#line 24399 "" s_wsle(&io___1742); -#line 24405 "" +#line 24399 "" e_wsle(); -#line 24406 "" +#line 24400 "" s_wsle(&io___1743); -#line 24406 "" +#line 24400 "" e_wsle(); -#line 24407 "" +#line 24401 "" s_wsle(&io___1744); -#line 24407 "" +#line 24401 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25); -#line 24407 "" +#line 24401 "" e_wsle(); -#line 24408 "" +#line 24402 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24408 "" +#line 24402 "" errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"\ "prt if in voice #1!", (ftnlen)128, (ftnlen)53); -#line 24410 "" +#line 24404 "" } -#line 24411 "" +#line 24405 "" if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) { -#line 24412 "" +#line 24406 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24412 "" +#line 24406 "" errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"\ ")!", (ftnlen)128, (ftnlen)36); -#line 24414 "" +#line 24408 "" stop1_(); -#line 24415 "" +#line 24409 "" } else if (*(unsigned char *)charq != ' ') { /* Record or playback a macro. Get the number of the macro. */ -#line 24419 "" +#line 24413 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24420 "" +#line 24414 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { -#line 24421 "" +#line 24415 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24421 "" +#line 24415 "" errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""\ ",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43); -#line 24423 "" +#line 24417 "" stop1_(); -#line 24424 "" +#line 24418 "" } -#line 24425 "" +#line 24419 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 24426 "" +#line 24420 "" commac_1.macnum = i_nint(&fnum); -#line 24427 "" +#line 24421 "" if (*(unsigned char *)durq != ' ') { -#line 24428 "" +#line 24422 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24428 "" +#line 24422 "" errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"\ " a blank!", (ftnlen)128, (ftnlen)41); -#line 24430 "" +#line 24424 "" stop1_(); -#line 24431 "" +#line 24425 "" } -#line 24432 "" +#line 24426 "" if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Record or save a macro */ -#line 24436 "" +#line 24430 "" if (commac_1.macnum < 1 || commac_1.macnum > 20) { -#line 24437 "" +#line 24431 "" i__1 = *iccount - 1; -#line 24437 "" +#line 24431 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24437 "" +#line 24431 "" errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!" , (ftnlen)128, (ftnlen)31); -#line 24439 "" +#line 24433 "" stop1_(); -#line 24440 "" +#line 24434 "" } -#line 24441 "" +#line 24435 "" commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); -#line 24442 "" +#line 24436 "" if (*(unsigned char *)charq == 'R') { -#line 24443 "" +#line 24437 "" m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( ftnlen)128); -#line 24444 "" +#line 24438 "" } else if (*(unsigned char *)charq == 'S') { /* Save (Record but don't activate) */ -#line 24448 "" +#line 24442 "" L1: -#line 24448 "" +#line 24442 "" m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( ftnlen)128); -#line 24449 "" +#line 24443 "" if (commac_1.mrecord) { -#line 24450 "" +#line 24444 "" getbuf_(lineq, (ftnlen)128); -#line 24451 "" +#line 24445 "" ++(*nline); -#line 24452 "" +#line 24446 "" *iccount = 0; -#line 24453 "" +#line 24447 "" goto L1; -#line 24454 "" +#line 24448 "" } -#line 24455 "" +#line 24449 "" *iccount = *iccount + ndxm + 1; -#line 24456 "" +#line 24450 "" } -#line 24457 "" +#line 24451 "" } else { /* Playback the macro */ -#line 24461 "" +#line 24455 "" if (! bit_test(commac_1.macuse,commac_1.macnum)) { -#line 24462 "" +#line 24456 "" i__1 = *iccount - 1; -#line 24462 "" +#line 24456 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; -#line 24462 "" +#line 24456 "" errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"\ "ot been recorded!", (ftnlen)128, (ftnlen)47); -#line 24464 "" +#line 24458 "" stop1_(); -#line 24465 "" +#line 24459 "" } -#line 24466 "" +#line 24460 "" commac_1.icchold = *iccount; -#line 24467 "" +#line 24461 "" s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); -#line 24468 "" +#line 24462 "" *iccount = 128; -#line 24469 "" +#line 24463 "" commac_1.mplay = TRUE_; -#line 24470 "" +#line 24464 "" c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; -#line 24471 "" +#line 24465 "" } -#line 24472 "" +#line 24466 "" } -#line 24473 "" +#line 24467 "" return 0; } /* setmac_ */ @@ -60875,67 +61158,67 @@ L1: /* 3: triple w/ denom=8, subdivide in groups of 3 8ths */ /* Note that lenbar is set at top or when 'm' symbol is read in getnote */ -#line 24484 "" +#line 24478 "" if (*mtrdenl == 4) { -#line 24485 "" +#line 24479 "" if (*mtrnuml % 3 == 0) { -#line 24486 "" +#line 24480 "" *ibmtyp = 2; -#line 24487 "" +#line 24481 "" *ibmrep = *mtrnuml / 3; -#line 24488 "" +#line 24482 "" } else { -#line 24489 "" +#line 24483 "" *ibmtyp = 1; -#line 24490 "" +#line 24484 "" *ibmrep = *mtrnuml / 2; -#line 24491 "" +#line 24485 "" } -#line 24492 "" +#line 24486 "" } else if (*mtrdenl == 2) { -#line 24493 "" +#line 24487 "" *ibmtyp = 1; -#line 24494 "" +#line 24488 "" if (*mtrnuml == 3) { -#line 24495 "" +#line 24489 "" *ibmrep = 3; -#line 24496 "" +#line 24490 "" } else { -#line 24497 "" +#line 24491 "" *ibmrep = (*mtrnuml << 1) / *mtrdenl; -#line 24498 "" +#line 24492 "" } -#line 24499 "" +#line 24493 "" } else if (*mtrdenl == 8 && (*mtrnuml == 8 || *mtrnuml == 4)) { /* Added 170726 */ -#line 24503 "" +#line 24497 "" *ibmtyp = 1; -#line 24504 "" +#line 24498 "" *ibmrep = *mtrnuml / 4; -#line 24505 "" +#line 24499 "" } else { /* Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */ -#line 24509 "" +#line 24503 "" *ibmtyp = 3; -#line 24510 "" +#line 24504 "" *ibmrep = *mtrnuml / 3; -#line 24511 "" +#line 24505 "" } /* Reset so we don't keep writing new meters */ -#line 24515 "" +#line 24509 "" *mtrnuml = 0; /* Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter */ -#line 24519 "" +#line 24513 "" *ibmrep = max(*ibmrep,1); -#line 24520 "" +#line 24514 "" return 0; } /* setmeter_ */ @@ -60980,86 +61263,86 @@ L1: /* The outer combo algorithm */ -#line 24554 "" +#line 24548 "" /* Parameter adjustments */ -#line 24554 "" +#line 24548 "" --ipb; -#line 24554 "" +#line 24548 "" --xelsk; -#line 24554 "" +#line 24548 "" -#line 24554 "" +#line 24548 "" /* Function Body */ -#line 24554 "" +#line 24548 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; -#line 24555 "" +#line 24549 "" comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; -#line 24556 "" +#line 24550 "" n1 = comipl2_1.ipl2[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; /* Initialize counters used in this subroutine, and then later during actual */ /* beam drawing, to count later segments of single-slope beam groups */ -#line 24561 "" +#line 24555 "" comxtup_2.nssb[commvl_1.ivx - 1] = 0; -#line 24562 "" +#line 24556 "" comxtup_2.issb[commvl_1.ivx - 1] = 0; /* Set flag for xtup beam starting with rest (no others can start with rest) */ -#line 24566 "" +#line 24560 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) { -#line 24566 "" +#line 24560 "" *ixrest = 1; -#line 24566 "" +#line 24560 "" } /* Figure how many elemskips to each note. Use the list, counting only non-rests. */ -#line 24570 "" +#line 24564 "" eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; -#line 24571 "" +#line 24565 "" *nnb = 0; -#line 24572 "" +#line 24566 "" *sumx = 0.f; -#line 24573 "" +#line 24567 "" *sumy = 0.f; -#line 24574 "" +#line 24568 "" ipxt1 = 0; -#line 24575 "" +#line 24569 "" iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; -#line 24576 "" +#line 24570 "" i__1 = iplast; -#line 24576 "" +#line 24570 "" for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) { -#line 24577 "" +#line 24571 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { -#line 24578 "" +#line 24572 "" ++(*nnb); -#line 24579 "" +#line 24573 "" ipb[*nnb] = ip; -#line 24580 "" +#line 24574 "" xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0; -#line 24581 "" +#line 24575 "" *sumx += xelsk[*nnb]; -#line 24582 "" +#line 24576 "" *sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25]; -#line 24583 "" +#line 24577 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) { /* This is the starting note of later segment of single-slope beam group */ /* Temporarily store ip here. */ -#line 24588 "" +#line 24582 "" ++comxtup_2.nssb[commvl_1.ivx - 1]; -#line 24589 "" +#line 24583 "" comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx - 1] * 24 - 25] = *nnb; -#line 24590 "" +#line 24584 "" } -#line 24591 "" +#line 24585 "" } /* New xtup stuff here. Final object is to get distance from start of xtup */ @@ -61067,220 +61350,224 @@ L1: /* number. ntupv is number of notes in xtup, and is only used to get */ /* eloff, the distance from start of xtup to the number. */ -#line 24598 "" +#line 24592 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { -#line 24598 "" +#line 24592 "" ++ndoub; -#line 24598 "" +#line 24592 "" } -#line 24599 "" +#line 24593 "" if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* Xtup is starting here */ -#line 24603 "" +#line 24597 "" ++comxtup_2.nxtinbm[commvl_1.ivx - 1]; -#line 24604 "" +#line 24598 "" ipxt1 = ip; -#line 24605 "" +#line 24599 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { -#line 24606 "" +#line 24600 "" ndoub = 1; -#line 24607 "" +#line 24601 "" } else { -#line 24608 "" +#line 24602 "" ndoub = 0; -#line 24609 "" +#line 24603 "" } -#line 24610 "" +#line 24604 "" } else if (ipxt1 > 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) { /* Xtup ends here. Set total number of notes in xtup. */ -#line 24614 "" +#line 24608 "" comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = ip + 1 - ipxt1; /* Set printed number for embedded xtup. */ -#line 24618 "" +#line 24612 "" comxtup_2.mtupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] + ndoub; /* Middle note of xtup if ntupv odd, note to left of gap if even. */ -#line 24622 "" +#line 24616 "" ipxtmid = (ip + ipxt1) / 2; -#line 24623 "" +#line 24617 "" comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = comeskz2_1.eskz2[commvl_1.ivx + ipxtmid * 24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipxt1 * 24 - 25]; -#line 24624 "" +#line 24618 "" if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { -#line 24624 "" +#line 24618 "" comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] += (comeskz2_1.eskz2[commvl_1.ivx + ( ipxtmid + 1) * 24 - 25] - comeskz2_1.eskz2[ commvl_1.ivx + ipxtmid * 24 - 25]) * .5f; -#line 24624 "" +#line 24618 "" } -#line 24627 "" +#line 24621 "" ipxt1 = 0; -#line 24628 "" +#line 24622 "" } -#line 24629 "" +#line 24623 "" /* L2: */ -#line 24629 "" +#line 24623 "" } /* Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */ -#line 24633 "" +#line 24627 "" comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; -#line 24634 "" +#line 24628 "" *smed = 0.f; /* if (.not.btest(islur(ivx,ipb(1)),2)) then */ -#line 24636 "" +#line 24630 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *nnb > 1) { /* No forced 0 slope */ /* if (nnb .eq. 1) go to 6 */ -#line 24641 "" +#line 24635 "" nsc = 0; -#line 24642 "" +#line 24636 "" i__1 = *nnb - 1; -#line 24642 "" +#line 24636 "" for (inb = 1; inb <= i__1; ++inb) { -#line 24643 "" +#line 24637 "" i__2 = *nnb; -#line 24643 "" +#line 24637 "" for (jnb = inb + 1; jnb <= i__2; ++jnb) { -#line 24644 "" +#line 24638 "" ++nsc; -#line 24645 "" +#line 24639 "" slope[nsc - 1] = (all_1.nolev[commvl_1.ivx + ipb[jnb] * 24 - 25] - all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]) / (xelsk[jnb] - xelsk[inb]); -#line 24647 "" +#line 24641 "" if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) { -#line 24648 "" +#line 24642 "" ++nsc; -#line 24649 "" +#line 24643 "" slope[nsc - 1] = slope[nsc - 2]; -#line 24650 "" +#line 24644 "" ++nsc; -#line 24651 "" +#line 24645 "" slope[nsc - 1] = slope[nsc - 2]; -#line 24652 "" +#line 24646 "" } -#line 24653 "" -/* L5: */ -#line 24653 "" +#line 24647 "" +/* L5999: */ +#line 24647 "" } -#line 24653 "" +#line 24648 "" +/* L5: */ +#line 24648 "" } -#line 24654 "" +#line 24649 "" if (nsc == 1) { -#line 24655 "" +#line 24650 "" *smed = slope[0]; -#line 24656 "" +#line 24651 "" goto L6; -#line 24657 "" +#line 24652 "" } -#line 24658 "" +#line 24653 "" nscmid = nsc / 2 + 1; -#line 24659 "" - i__2 = nscmid; -#line 24659 "" - for (i__ = 1; i__ <= i__2; ++i__) { -#line 24660 "" - i__1 = nsc; -#line 24660 "" - for (j = i__ + 1; j <= i__1; ++j) { -#line 24661 "" +#line 24654 "" + i__1 = nscmid; +#line 24654 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 24655 "" + i__2 = nsc; +#line 24655 "" + for (j = i__ + 1; j <= i__2; ++j) { +#line 24656 "" if (slope[j - 1] < slope[i__ - 1]) { -#line 24662 "" +#line 24657 "" t = slope[j - 1]; -#line 24663 "" +#line 24658 "" slope[j - 1] = slope[i__ - 1]; -#line 24664 "" +#line 24659 "" slope[i__ - 1] = t; -#line 24665 "" +#line 24660 "" } -#line 24666 "" -/* L7: */ -#line 24666 "" +#line 24661 "" +/* L7999: */ +#line 24661 "" } -#line 24666 "" +#line 24662 "" +/* L7: */ +#line 24662 "" } -#line 24667 "" +#line 24663 "" *smed = slope[nscmid - 1]; -#line 24668 "" +#line 24664 "" if (nsc == nsc / 2 << 1) { /* Even number of slopes in the list, so median is ambiguous */ -#line 24672 "" +#line 24668 "" if ((r__2 = slope[nscmid - 2], dabs(r__2)) < (r__1 = slope[nscmid - 1], dabs(r__1)) - comtol_1.tol) { /* Lower-numbered one is truly less in absolute value, so use it */ -#line 24676 "" +#line 24672 "" *smed = slope[nscmid - 2]; -#line 24677 "" +#line 24673 "" } else if ((r__1 = slope[nscmid - 2] + slope[nscmid - 1], dabs( r__1)) < comtol_1.tol) { /* Two slopes are effectively equal. Take the one with sign of the average */ -#line 24681 "" +#line 24677 "" sum = 0.f; -#line 24682 "" +#line 24678 "" i__1 = nsc; -#line 24682 "" +#line 24678 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 24683 "" +#line 24679 "" sum += slope[i__ - 1]; -#line 24684 "" +#line 24680 "" /* L1: */ -#line 24684 "" +#line 24680 "" } -#line 24685 "" +#line 24681 "" *smed = r_sign(smed, &sum); -#line 24686 "" +#line 24682 "" } -#line 24687 "" +#line 24683 "" } -#line 24688 "" +#line 24684 "" L6: -#line 24689 "" +#line 24685 "" r__1 = *smed * .5f * all_1.slfac; -#line 24689 "" +#line 24685 "" comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); -#line 24690 "" +#line 24686 "" if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) { -#line 24690 "" +#line 24686 "" comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, & comxtup_2.islope[commvl_1.ivx - 1]); -#line 24690 "" +#line 24686 "" } -#line 24692 "" +#line 24688 "" } else { /* Forced horizontal beam */ -#line 24696 "" +#line 24692 "" comxtup_2.islope[commvl_1.ivx - 1] = 0; -#line 24697 "" +#line 24693 "" } -#line 24698 "" +#line 24694 "" beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx) / *nnb; @@ -61288,90 +61575,90 @@ L6: /* as is for placing xtup number and/or bracket, then reset it for start of */ /* actual beam */ -#line 24704 "" +#line 24700 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta); /* Check if any stems are too short */ -#line 24708 "" +#line 24704 "" smin = 100.f; -#line 24709 "" +#line 24705 "" iul = -1; -#line 24710 "" +#line 24706 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { -#line 24710 "" +#line 24706 "" iul = 1; -#line 24710 "" +#line 24706 "" } -#line 24711 "" +#line 24707 "" ssq = 0.f; -#line 24712 "" +#line 24708 "" syb = 0.f; -#line 24713 "" +#line 24709 "" yb1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * (all_1.stemlen + combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 - 25]) - 9)); -#line 24715 "" +#line 24711 "" i__1 = *nnb; -#line 24715 "" +#line 24711 "" for (inb = 1; inb <= i__1; ++inb) { -#line 24716 "" +#line 24712 "" ybeam = yb1 + comxtup_2.islope[commvl_1.ivx - 1] * xelsk[inb] / all_1.slfac - iul * combmh_1.bmhgt * ((15 & all_1.mult[ commvl_1.ivx + ipb[inb] * 24 - 25]) - 9); -#line 24718 "" +#line 24714 "" syb += ybeam; -#line 24719 "" +#line 24715 "" ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; -#line 24720 "" +#line 24716 "" off = ybeam - ynote; -#line 24721 "" +#line 24717 "" if (inb == 1) { -#line 24722 "" +#line 24718 "" off1 = off; -#line 24723 "" +#line 24719 "" } else if (inb == *nnb) { -#line 24724 "" +#line 24720 "" off2 = off; -#line 24725 "" +#line 24721 "" } -#line 24726 "" +#line 24722 "" ssq += off * off; /* Computing MIN */ -#line 24727 "" +#line 24723 "" r__1 = smin, r__2 = iul * off; -#line 24727 "" +#line 24723 "" smin = dmin(r__1,r__2); -#line 24728 "" +#line 24724 "" /* L4: */ -#line 24728 "" +#line 24724 "" } -#line 24729 "" +#line 24725 "" dnolev = 0.f; -#line 24730 "" +#line 24726 "" if (smin < all_1.stemmin) { -#line 24731 "" +#line 24727 "" deficit = all_1.stemmin - smin; -#line 24732 "" +#line 24728 "" nolevo = comxtup_2.nolev1[commvl_1.ivx - 1]; -#line 24733 "" +#line 24729 "" r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit; -#line 24733 "" +#line 24729 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); -#line 24734 "" +#line 24730 "" dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo); -#line 24735 "" +#line 24731 "" off1 += dnolev; -#line 24736 "" +#line 24732 "" off2 += dnolev; -#line 24737 "" +#line 24733 "" } /* Computing 2nd power */ -#line 24738 "" +#line 24734 "" r__1 = dnolev; -#line 24738 "" +#line 24734 "" ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1; -#line 24739 "" +#line 24735 "" if (! comxtup_2.vxtup[commvl_1.ivx - 1] && sqrt(ssq / *nnb) > all_1.stemmax && (dabs(off1) < all_1.stemmax || dabs(off2) < all_1.stemmax) && ! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * @@ -61382,83 +61669,83 @@ L6: /* The penultimate check is that first and last stems aren't both excessive. */ /* The last check is that a 0 slope has not been forced */ -#line 24749 "" +#line 24745 "" setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[ commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]); -#line 24750 "" +#line 24746 "" } /* Check if beam starts or ends too high or low. */ -#line 24754 "" +#line 24750 "" xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 - 25]) - 9); -#line 24755 "" +#line 24751 "" l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[ 1])) + xboff + 7 < 0.f; -#line 24756 "" +#line 24752 "" xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[ commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb]; -#line 24757 "" +#line 24753 "" l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f; -#line 24758 "" +#line 24754 "" if (l1ng || l2ng) { /* Need to correct start or stop, also slope */ -#line 24762 "" +#line 24758 "" if (l1ng) { -#line 24763 "" +#line 24759 "" r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul; -#line 24763 "" +#line 24759 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); -#line 24764 "" +#line 24760 "" } -#line 24765 "" +#line 24761 "" if (l2ng) { -#line 24766 "" +#line 24762 "" r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul; -#line 24766 "" +#line 24762 "" xnolev2 = (real) i_nint(&r__1); -#line 24767 "" +#line 24763 "" } /* Since one or the other end has changed, need to change slope */ /* if (.not.btest(islur(ivx,ipb(1)),2)) */ -#line 24772 "" +#line 24768 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && * nnb != 1) { -#line 24772 "" +#line 24768 "" r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1] ) / xelsk[*nnb]; -#line 24772 "" +#line 24768 "" comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); -#line 24772 "" +#line 24768 "" } -#line 24774 "" +#line 24770 "" } -#line 24775 "" +#line 24771 "" if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) { /* This is a single-slope beam group. Store start heights for later segs. */ -#line 24779 "" +#line 24775 "" i__1 = comxtup_2.nssb[commvl_1.ivx - 1]; -#line 24779 "" +#line 24775 "" for (issbs = 1; issbs <= i__1; ++issbs) { -#line 24780 "" +#line 24776 "" comxtup_2.lev1ssb[commvl_1.ivx + issbs * 24 - 25] = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[ commvl_1.ivx - 1] / all_1.slfac * xelsk[comxtup_2.lev1ssb[ commvl_1.ivx + issbs * 24 - 25]]; -#line 24782 "" +#line 24778 "" /* L3: */ -#line 24782 "" +#line 24778 "" } -#line 24783 "" +#line 24779 "" } -#line 24784 "" +#line 24780 "" return 0; } /* setupb_ */ @@ -61473,60 +61760,60 @@ L6: /* Initialize ipoe: */ -#line 24793 "" +#line 24789 "" /* Parameter adjustments */ -#line 24793 "" +#line 24789 "" --ipoe; -#line 24793 "" +#line 24789 "" --poe; -#line 24793 "" +#line 24789 "" -#line 24793 "" +#line 24789 "" /* Function Body */ -#line 24793 "" +#line 24789 "" i__1 = *nsyst; -#line 24793 "" +#line 24789 "" for (iord = 1; iord <= i__1; ++iord) { -#line 24794 "" +#line 24790 "" ipoe[iord] = iord; -#line 24795 "" +#line 24791 "" /* L3: */ -#line 24795 "" +#line 24791 "" } /* Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will */ /* be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. */ -#line 24800 "" +#line 24796 "" i__1 = *nsyst - 1; -#line 24800 "" +#line 24796 "" for (io1 = 1; io1 <= i__1; ++io1) { -#line 24801 "" +#line 24797 "" i__2 = *nsyst; -#line 24801 "" +#line 24797 "" for (io2 = io1 + 1; io2 <= i__2; ++io2) { -#line 24802 "" +#line 24798 "" if (poe[ipoe[io1]] > poe[ipoe[io2]]) { /* Interchange the indices */ -#line 24806 "" +#line 24802 "" itemp = ipoe[io1]; -#line 24807 "" +#line 24803 "" ipoe[io1] = ipoe[io2]; -#line 24808 "" +#line 24804 "" ipoe[io2] = itemp; -#line 24809 "" +#line 24805 "" } -#line 24810 "" +#line 24806 "" /* L5: */ -#line 24810 "" +#line 24806 "" } -#line 24811 "" +#line 24807 "" /* L4: */ -#line 24811 "" +#line 24807 "" } -#line 24812 "" +#line 24808 "" return 0; } /* sortpoe_ */ @@ -61563,114 +61850,114 @@ L6: /* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ -#line 24837 "" +#line 24833 "" /* Parameter adjustments */ -#line 24837 "" +#line 24833 "" --isdat4; -#line 24837 "" +#line 24833 "" --isdat3; -#line 24837 "" +#line 24833 "" --isdat2; -#line 24837 "" +#line 24833 "" --isdat1; -#line 24837 "" +#line 24833 "" -#line 24837 "" +#line 24833 "" /* Function Body */ -#line 24837 "" +#line 24833 "" numint = 0; -#line 24838 "" +#line 24834 "" ivoff = 0; -#line 24839 "" +#line 24835 "" ihoff = 0; -#line 24840 "" +#line 24836 "" ++(*nsdat); -#line 24841 "" +#line 24837 "" if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') { -#line 24841 "" +#line 24837 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); -#line 24841 "" +#line 24837 "" } -#line 24843 "" +#line 24839 "" setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); -#line 24844 "" +#line 24840 "" i__1 = *kv - 1; -#line 24844 "" +#line 24840 "" setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); -#line 24845 "" +#line 24841 "" setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); -#line 24846 "" +#line 24842 "" isdat3[*nsdat] = 0; -#line 24847 "" +#line 24843 "" isdat4[*nsdat] = 0; -#line 24848 "" +#line 24844 "" ilb12 = 0; /* Get ID code */ /* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */ -#line 24852 "" +#line 24848 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* if (index('uldtb+-hfnHps ',durq) .gt. 0) then */ -#line 24854 "" +#line 24850 "" if (i_indx("uldtb+-hfnHpsv ", durq, (ftnlen)15, (ftnlen)1) > 0) { /* Null id. Note for ps slurs, 'H' cannot be an ID */ -#line 24858 "" +#line 24854 "" --(*iccount); -#line 24859 "" +#line 24855 "" if (*(unsigned char *)&lineq[*iccount - 1] == 't') { -#line 24860 "" +#line 24856 "" idcode = 1; -#line 24861 "" +#line 24857 "" } else { -#line 24862 "" +#line 24858 "" idcode = 32; -#line 24863 "" +#line 24859 "" } -#line 24864 "" +#line 24860 "" } else { /* Set explicit idcode */ -#line 24868 "" +#line 24864 "" idcode = *(unsigned char *)durq; -#line 24869 "" +#line 24865 "" i__1 = *iccount - 2; -#line 24869 "" +#line 24865 "" if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) { /* Make t[ID] look like s[ID]t */ -#line 24873 "" +#line 24869 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); -#line 24874 "" +#line 24870 "" } -#line 24875 "" +#line 24871 "" i__1 = *iccount; -#line 24875 "" +#line 24871 "" if (s_cmp(lineq + i__1, "x", *iccount + 1 - i__1, (ftnlen)1) == 0) { /* Flag for 2-voice, indexed slurs */ -#line 24879 "" +#line 24875 "" ++(*iccount); -#line 24880 "" +#line 24876 "" setbits_(&isdat1[*nsdat], &c__1, &c__1, &c__1); -#line 24881 "" +#line 24877 "" } -#line 24882 "" +#line 24878 "" } -#line 24883 "" +#line 24879 "" setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); /* Set start/stop: look thru list from end for same idcode,iv,kv */ -#line 24887 "" +#line 24883 "" for (isdat = *nsdat - 1; isdat >= 1; --isdat) { -#line 24888 "" +#line 24884 "" if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && (*kv - 1 == igetbits_(&isdat1[isdat], &c__1, &c__12) || bit_test(isdat1[ @@ -61679,372 +61966,372 @@ L6: /* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */ -#line 24896 "" +#line 24892 "" if (bit_test(isdat1[isdat],11)) { -#line 24896 "" +#line 24892 "" goto L3; -#line 24896 "" +#line 24892 "" } /* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ -#line 24900 "" +#line 24896 "" goto L4; -#line 24901 "" +#line 24897 "" } -#line 24902 "" +#line 24898 "" /* L2: */ -#line 24902 "" +#line 24898 "" } /* If here, this is turnon. */ -#line 24906 "" +#line 24902 "" L4: -#line 24907 "" +#line 24903 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); -#line 24908 "" +#line 24904 "" L3: /* Now done with initial turnon- or turnoff-specifics. */ -#line 24912 "" +#line 24908 "" if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) { /* There's a default curvature tweak */ -#line 24916 "" +#line 24912 "" icurv1 = i_nint(&comslur_1.slurcurve) + 3; -#line 24917 "" +#line 24913 "" if (icurv1 == 2) { -#line 24917 "" +#line 24913 "" icurv1 = 1; -#line 24917 "" +#line 24913 "" } -#line 24918 "" +#line 24914 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); -#line 24919 "" +#line 24915 "" i__1 = icurv1 + 32; -#line 24919 "" +#line 24915 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); -#line 24920 "" +#line 24916 "" } /* Loop for rest of input */ -#line 24924 "" +#line 24920 "" L1: -#line 24924 "" +#line 24920 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 24925 "" +#line 24921 "" if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Force direction */ -#line 24929 "" +#line 24925 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); -#line 24930 "" +#line 24926 "" if (*(unsigned char *)durq == 'u') { -#line 24930 "" +#line 24926 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); -#line 24930 "" +#line 24926 "" } -#line 24931 "" +#line 24927 "" goto L1; -#line 24932 "" +#line 24928 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 24933 "" +#line 24929 "" ++numint; -#line 24934 "" +#line 24930 "" if (numint == 1) { /* Vertical offset */ -#line 24938 "" +#line 24934 "" ++(*iccount); -#line 24939 "" +#line 24935 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 24940 "" +#line 24936 "" --(*iccount); -#line 24941 "" +#line 24937 "" ivoff = i_nint(&fnum); -#line 24942 "" +#line 24938 "" if (*(unsigned char *)durq == '-') { -#line 24942 "" +#line 24938 "" ivoff = -ivoff; -#line 24942 "" +#line 24938 "" } -#line 24943 "" +#line 24939 "" } else if (numint == 2) { /* Horizontal offset */ -#line 24947 "" +#line 24943 "" ++(*iccount); -#line 24948 "" +#line 24944 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 24949 "" +#line 24945 "" --(*iccount); /* fnum is abs(hshift), must be 0 to 6.3 */ -#line 24953 "" +#line 24949 "" ihoff = fnum * 10 + .5f; -#line 24954 "" +#line 24950 "" if (*(unsigned char *)durq == '-') { -#line 24954 "" +#line 24950 "" ihoff = -ihoff; -#line 24954 "" +#line 24950 "" } /* Later will set bits to 1...127 to represent -6.3,...+6.3 */ -#line 24958 "" +#line 24954 "" } else { /* Must be the 3rd signed integer, so it's a curve specification */ -#line 24962 "" +#line 24958 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); -#line 24963 "" +#line 24959 "" ++(*iccount); -#line 24964 "" +#line 24960 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 24965 "" +#line 24961 "" icurv1 = i_nint(&fnum); -#line 24966 "" +#line 24962 "" if (*(unsigned char *)durq == '-') { -#line 24966 "" +#line 24962 "" icurv1 = -icurv1; -#line 24966 "" +#line 24962 "" } -#line 24967 "" +#line 24963 "" i__1 = icurv1 + 32; -#line 24967 "" +#line 24963 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); -#line 24968 "" +#line 24964 "" if (*(unsigned char *)dumq != ':') { /* Back up the pointer and loop for more input */ -#line 24972 "" +#line 24968 "" --(*iccount); -#line 24973 "" +#line 24969 "" } else { /* Expect two single digits as parameters for curve */ -#line 24977 "" +#line 24973 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); -#line 24978 "" +#line 24974 "" i__1 = *iccount; -#line 24978 "" +#line 24974 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; -#line 24978 "" +#line 24974 "" setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); -#line 24980 "" +#line 24976 "" i__1 = *iccount + 1; -#line 24980 "" +#line 24976 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; -#line 24980 "" +#line 24976 "" setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); -#line 24982 "" +#line 24978 "" *iccount += 2; -#line 24983 "" +#line 24979 "" } -#line 24984 "" +#line 24980 "" } -#line 24985 "" +#line 24981 "" goto L1; -#line 24986 "" +#line 24982 "" } else if (*(unsigned char *)durq == 't') { -#line 24987 "" +#line 24983 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); -#line 24988 "" +#line 24984 "" goto L1; -#line 24989 "" +#line 24985 "" } else if (*(unsigned char *)durq == 'b') { -#line 24990 "" +#line 24986 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); -#line 24991 "" +#line 24987 "" goto L1; -#line 24992 "" +#line 24988 "" } else if (*(unsigned char *)durq == 's') { /* Endpoint tweaks for linebreak slurs. */ -#line 24996 "" +#line 24992 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Next is vertical offset */ /* Must be +|- */ -#line 25000 "" +#line 24996 "" ++(*iccount); -#line 25001 "" +#line 24997 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 25002 "" +#line 24998 "" if (*(unsigned char *)durq == '-') { -#line 25002 "" +#line 24998 "" fnum = -fnum; -#line 25002 "" +#line 24998 "" } -#line 25003 "" +#line 24999 "" i__1 = ilb12 << 4; -#line 25003 "" +#line 24999 "" i__2 = i_nint(&fnum) + 32; -#line 25003 "" +#line 24999 "" setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2); -#line 25004 "" +#line 25000 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Also a horizontal offset */ -#line 25008 "" +#line 25004 "" ++(*iccount); -#line 25009 "" +#line 25005 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); -#line 25010 "" +#line 25006 "" if (*(unsigned char *)dumq == '-') { -#line 25010 "" +#line 25006 "" fnum = -fnum; -#line 25010 "" +#line 25006 "" } -#line 25011 "" +#line 25007 "" i__1 = (ilb12 << 4) + 6; -#line 25011 "" +#line 25007 "" r__1 = fnum * 10; -#line 25011 "" +#line 25007 "" i__2 = i_nint(&r__1) + 64; -#line 25011 "" +#line 25007 "" setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2); -#line 25012 "" +#line 25008 "" } -#line 25013 "" +#line 25009 "" --(*iccount); -#line 25014 "" +#line 25010 "" ilb12 = 1; -#line 25015 "" +#line 25011 "" goto L1; -#line 25016 "" +#line 25012 "" } else if (i_indx("fnhH", durq, (ftnlen)4, (ftnlen)1) > 0) { /* Special ps slur curvatures. */ /* Translate to old \midslur args (1,4,5,6) */ -#line 25021 "" +#line 25017 "" icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1); -#line 25022 "" +#line 25018 "" if (icurv1 == 5) { /* check for 2nd H */ -#line 25026 "" +#line 25022 "" i__1 = *iccount; -#line 25026 "" +#line 25022 "" if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) { -#line 25027 "" +#line 25023 "" ++(*iccount); -#line 25028 "" +#line 25024 "" icurv1 = 6; -#line 25029 "" +#line 25025 "" } -#line 25030 "" +#line 25026 "" } -#line 25031 "" +#line 25027 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); -#line 25032 "" +#line 25028 "" i__1 = icurv1 + 32; -#line 25032 "" +#line 25028 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); -#line 25033 "" +#line 25029 "" goto L1; -#line 25034 "" +#line 25030 "" } else if (*(unsigned char *)durq == 'p') { /* Local adjustment */ -#line 25035 "" +#line 25031 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* +|- */ -#line 25036 "" +#line 25032 "" getchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1); /* 26 \sluradjust (p+s) */ /* 27 \nosluradjust (p-s) */ /* 28 \tieadjust (p+t) */ /* 29 \notieadjust (p-t) */ /* s|t */ -#line 25041 "" +#line 25037 "" if (*(unsigned char *)durq == '+') { -#line 25042 "" +#line 25038 "" if (*(unsigned char *)dumq == 's') { -#line 25043 "" +#line 25039 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],26); -#line 25044 "" +#line 25040 "" } else { -#line 25045 "" +#line 25041 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],28); -#line 25046 "" +#line 25042 "" } -#line 25047 "" +#line 25043 "" } else { -#line 25048 "" +#line 25044 "" if (*(unsigned char *)dumq == 's') { -#line 25049 "" +#line 25045 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],27); -#line 25050 "" +#line 25046 "" } else { -#line 25051 "" +#line 25047 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],29); -#line 25052 "" +#line 25048 "" } -#line 25053 "" +#line 25049 "" } -#line 25054 "" +#line 25050 "" goto L1; -#line 25055 "" +#line 25051 "" } else if (*(unsigned char *)durq == 'v') { /* Stem slur */ -#line 25056 "" +#line 25052 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],2); -#line 25057 "" +#line 25053 "" goto L1; -#line 25058 "" +#line 25054 "" } /* Record shifts */ -#line 25062 "" +#line 25058 "" i__1 = ivoff + 32; -#line 25062 "" +#line 25058 "" setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); -#line 25063 "" +#line 25059 "" i__1 = ihoff + 64; -#line 25063 "" +#line 25059 "" setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); /* Record chord flag, note level, notehead shift */ -#line 25067 "" +#line 25063 "" if (*notcrd) { -#line 25068 "" +#line 25064 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); -#line 25069 "" +#line 25065 "" } else { -#line 25070 "" +#line 25066 "" nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & c__12); -#line 25071 "" +#line 25067 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); -#line 25072 "" +#line 25068 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); -#line 25073 "" +#line 25069 "" i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & c__23); -#line 25073 "" +#line 25069 "" setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); -#line 25074 "" +#line 25070 "" } -#line 25075 "" +#line 25071 "" return 0; } /* spsslur_ */ @@ -62079,346 +62366,346 @@ L1: /* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ -#line 25100 "" +#line 25096 "" /* Parameter adjustments */ -#line 25100 "" +#line 25096 "" --isdat3; -#line 25100 "" +#line 25096 "" --isdat2; -#line 25100 "" +#line 25096 "" --isdat1; -#line 25100 "" +#line 25096 "" -#line 25100 "" +#line 25096 "" /* Function Body */ -#line 25100 "" +#line 25096 "" numint = 0; -#line 25101 "" +#line 25097 "" ivoff = 0; -#line 25102 "" +#line 25098 "" ihoff = 0; -#line 25103 "" +#line 25099 "" ++(*nsdat); -#line 25104 "" +#line 25100 "" if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') { -#line 25104 "" +#line 25100 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); -#line 25104 "" +#line 25100 "" } -#line 25106 "" +#line 25102 "" setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); -#line 25107 "" +#line 25103 "" i__1 = *kv - 1; -#line 25107 "" +#line 25103 "" setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); -#line 25108 "" +#line 25104 "" setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); -#line 25109 "" +#line 25105 "" isdat3[*nsdat] = 0; /* Get id letter */ -#line 25113 "" +#line 25109 "" if (*(unsigned char *)&lineq[*iccount - 1] == 't') { /* Old-style t-slur. Use special idcode = 1 */ -#line 25117 "" +#line 25113 "" idcode = 1; -#line 25118 "" +#line 25114 "" } else { -#line 25119 "" +#line 25115 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 25120 "" +#line 25116 "" if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) { /* Null id */ -#line 25124 "" +#line 25120 "" idcode = 32; -#line 25125 "" +#line 25121 "" --(*iccount); -#line 25126 "" +#line 25122 "" } else if (*(unsigned char *)durq == 'H') { /* Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */ -#line 25130 "" +#line 25126 "" idcode = 32; -#line 25131 "" +#line 25127 "" --(*iccount); /* There may be another "H", but no need to deal with it yet */ -#line 25135 "" +#line 25131 "" } else { /* Set explicit idcode */ -#line 25139 "" +#line 25135 "" idcode = *(unsigned char *)durq; -#line 25140 "" +#line 25136 "" } -#line 25141 "" +#line 25137 "" } -#line 25142 "" +#line 25138 "" setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); /* Set start/stop: look thru list from end for same idcode,iv,kv */ -#line 25146 "" +#line 25142 "" for (isdat = *nsdat - 1; isdat >= 1; --isdat) { -#line 25147 "" +#line 25143 "" if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 == igetbits_(&isdat1[isdat], &c__1, &c__12)) { /* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */ -#line 25153 "" +#line 25149 "" if (bit_test(isdat1[isdat],11)) { -#line 25153 "" +#line 25149 "" goto L3; -#line 25153 "" +#line 25149 "" } /* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ -#line 25157 "" +#line 25153 "" goto L4; -#line 25158 "" +#line 25154 "" } -#line 25159 "" +#line 25155 "" /* L2: */ -#line 25159 "" +#line 25155 "" } /* If here, this is turnon. */ -#line 25163 "" +#line 25159 "" L4: -#line 25164 "" +#line 25160 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); -#line 25165 "" +#line 25161 "" L3: /* Now done with initial turnon- or turnoff-specifics. Loop for rest of input */ -#line 25169 "" +#line 25165 "" L1: -#line 25169 "" +#line 25165 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); -#line 25170 "" +#line 25166 "" if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Force direction */ -#line 25174 "" +#line 25170 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); -#line 25175 "" +#line 25171 "" if (*(unsigned char *)durq == 'u') { -#line 25175 "" +#line 25171 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); -#line 25175 "" +#line 25171 "" } -#line 25176 "" +#line 25172 "" goto L1; -#line 25177 "" +#line 25173 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { -#line 25178 "" +#line 25174 "" ++numint; -#line 25179 "" +#line 25175 "" if (numint == 1) { /* Vertical offset */ -#line 25183 "" +#line 25179 "" ++(*iccount); -#line 25184 "" +#line 25180 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 25185 "" +#line 25181 "" --(*iccount); -#line 25186 "" +#line 25182 "" ivoff = i_nint(&fnum); -#line 25187 "" +#line 25183 "" if (*(unsigned char *)durq == '-') { -#line 25187 "" +#line 25183 "" ivoff = -ivoff; -#line 25187 "" +#line 25183 "" } -#line 25188 "" +#line 25184 "" } else if (numint == 2) { /* Horizontal offset */ -#line 25192 "" +#line 25188 "" ++(*iccount); -#line 25193 "" +#line 25189 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 25194 "" +#line 25190 "" --(*iccount); /* fnum is abs(hshift), must be 0 to 6.3 */ -#line 25198 "" +#line 25194 "" ihoff = fnum * 10 + .5f; -#line 25199 "" +#line 25195 "" if (*(unsigned char *)durq == '-') { -#line 25199 "" +#line 25195 "" ihoff = -ihoff; -#line 25199 "" +#line 25195 "" } /* Later will set bits to 1...127 to represent -6.3,...+6.3 */ -#line 25203 "" +#line 25199 "" } else { /* Must be the 3rd signed integer, so it's a curve specification */ -#line 25207 "" +#line 25203 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); -#line 25208 "" +#line 25204 "" ++(*iccount); -#line 25209 "" +#line 25205 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); -#line 25210 "" +#line 25206 "" icurv1 = i_nint(&fnum); -#line 25211 "" +#line 25207 "" if (*(unsigned char *)durq == '-') { -#line 25211 "" +#line 25207 "" icurv1 = -icurv1; -#line 25211 "" +#line 25207 "" } -#line 25212 "" +#line 25208 "" i__1 = icurv1 + 32; -#line 25212 "" +#line 25208 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); -#line 25213 "" +#line 25209 "" if (*(unsigned char *)dumq != ':') { /* Back up the pointer and loop for more input */ -#line 25217 "" +#line 25213 "" --(*iccount); -#line 25218 "" +#line 25214 "" } else { /* Expect two single digits as parameters for curve */ -#line 25222 "" +#line 25218 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); -#line 25223 "" +#line 25219 "" i__1 = *iccount; -#line 25223 "" +#line 25219 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; -#line 25223 "" +#line 25219 "" setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); -#line 25225 "" +#line 25221 "" i__1 = *iccount + 1; -#line 25225 "" +#line 25221 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; -#line 25225 "" +#line 25221 "" setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); -#line 25227 "" +#line 25223 "" *iccount += 2; -#line 25228 "" +#line 25224 "" } -#line 25229 "" +#line 25225 "" } -#line 25230 "" +#line 25226 "" goto L1; -#line 25231 "" +#line 25227 "" } else if (*(unsigned char *)durq == 't') { -#line 25232 "" +#line 25228 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); -#line 25233 "" +#line 25229 "" goto L1; -#line 25234 "" +#line 25230 "" } else if (*(unsigned char *)durq == 'b') { -#line 25235 "" +#line 25231 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); -#line 25236 "" +#line 25232 "" goto L1; -#line 25237 "" +#line 25233 "" } else if (i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Special ps slur curvatures. Translate to old \midslur args (1,4,5,6) */ -#line 25241 "" +#line 25237 "" icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2; -#line 25242 "" +#line 25238 "" if (icurv1 == 3) { -#line 25243 "" +#line 25239 "" icurv1 = 1; -#line 25244 "" +#line 25240 "" } else if (icurv1 == 5) { /* check for 2nd H */ -#line 25248 "" +#line 25244 "" i__1 = *iccount; -#line 25248 "" +#line 25244 "" if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) { -#line 25249 "" +#line 25245 "" ++(*iccount); -#line 25250 "" +#line 25246 "" icurv1 = 6; -#line 25251 "" +#line 25247 "" } -#line 25252 "" +#line 25248 "" } -#line 25253 "" +#line 25249 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); /* Must change sign if downslur, but cannot do it now since we don't know */ /* slur direction for sure. */ -#line 25258 "" +#line 25254 "" i__1 = icurv1 + 32; -#line 25258 "" +#line 25254 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); -#line 25259 "" +#line 25255 "" goto L1; -#line 25260 "" +#line 25256 "" } /* Record shifts */ -#line 25264 "" +#line 25260 "" i__1 = ivoff + 32; -#line 25264 "" +#line 25260 "" setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); -#line 25265 "" +#line 25261 "" i__1 = ihoff + 64; -#line 25265 "" +#line 25261 "" setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); /* Record chord flag, note level, notehead shift */ -#line 25269 "" +#line 25265 "" if (*notcrd) { -#line 25270 "" +#line 25266 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); -#line 25271 "" +#line 25267 "" } else { -#line 25272 "" +#line 25268 "" nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & c__12); -#line 25273 "" +#line 25269 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); -#line 25274 "" +#line 25270 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); -#line 25275 "" +#line 25271 "" i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & c__23); -#line 25275 "" +#line 25271 "" setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); -#line 25276 "" +#line 25272 "" } -#line 25277 "" +#line 25273 "" return 0; } /* sslur_ */ @@ -62426,9 +62713,9 @@ L1: { extern /* Subroutine */ int exit_(integer *); -#line 25280 "" +#line 25276 "" exit_(&c__1); -#line 25281 "" +#line 25277 "" return 0; } /* stop1_ */ @@ -62529,217 +62816,217 @@ L1: static cilist io___1872 = { 0, 11, 0, "(a)", 0 }; -#line 25310 "" +#line 25306 "" /* Parameter adjustments */ -#line 25310 "" +#line 25306 "" --clefq; -#line 25310 "" +#line 25306 "" -#line 25310 "" +#line 25306 "" /* Function Body */ -#line 25310 "" +#line 25306 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 25310 "" +#line 25306 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 25311 "" +#line 25307 "" *vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop; -#line 25312 "" +#line 25308 "" if (*vshrink) { -#line 25313 "" +#line 25309 "" comarp_1.xinsnow = 10.f; -#line 25314 "" +#line 25310 "" } else { -#line 25315 "" +#line 25311 "" comarp_1.xinsnow = *xinstf1; -#line 25316 "" +#line 25312 "" } -#line 25317 "" +#line 25313 "" if (! comlast_1.islast) { -#line 25317 "" +#line 25313 "" return 0; -#line 25317 "" +#line 25313 "" } /* Initialize octave treble clef tracker */ -#line 25321 "" +#line 25317 "" for (im = 1; im <= 24; ++im) { -#line 25322 "" +#line 25318 "" comc8flag_1.c8flag[im - 1] = FALSE_; -#line 25323 "" +#line 25319 "" /* L6: */ -#line 25323 "" +#line 25319 "" } -#line 25324 "" +#line 25320 "" s_wsfe(&io___1810); -#line 25324 "" +#line 25320 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17); -#line 25324 "" +#line 25320 "" e_wsfe(); -#line 25325 "" +#line 25321 "" s_wsfe(&io___1811); -#line 25325 "" +#line 25321 "" do_fio(&c__1, "%", (ftnlen)1); -#line 25325 "" +#line 25321 "" e_wsfe(); -#line 25326 "" +#line 25322 "" s_wsfe(&io___1812); /* Writing concatenation */ -#line 25326 "" +#line 25322 "" i__1[0] = 2, a__1[0] = "% "; -#line 25326 "" +#line 25322 "" i__1[1] = *lbase, a__1[1] = basenameq; -#line 25326 "" +#line 25322 "" i__1[2] = 4, a__1[2] = ".tex"; -#line 25326 "" +#line 25322 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50); -#line 25326 "" +#line 25322 "" do_fio(&c__1, ch__2, *lbase + 6); -#line 25326 "" +#line 25322 "" e_wsfe(); -#line 25327 "" +#line 25323 "" s_wsfe(&io___1813); -#line 25327 "" +#line 25323 "" do_fio(&c__1, "%", (ftnlen)1); -#line 25327 "" +#line 25323 "" e_wsfe(); -#line 25328 "" +#line 25324 "" s_wsfe(&io___1814); -#line 25328 "" +#line 25324 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16); -#line 25328 "" +#line 25324 "" e_wsfe(); -#line 25329 "" +#line 25325 "" s_wsfe(&io___1815); /* Writing concatenation */ -#line 25329 "" +#line 25325 "" i__2[0] = 1, a__2[0] = sq; -#line 25329 "" +#line 25325 "" i__2[1] = 14, a__2[1] = "input musixtex"; -#line 25329 "" +#line 25325 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); -#line 25329 "" +#line 25325 "" do_fio(&c__1, ch__3, (ftnlen)15); -#line 25329 "" +#line 25325 "" e_wsfe(); -#line 25330 "" +#line 25326 "" s_wsfe(&io___1816); /* Writing concatenation */ -#line 25330 "" +#line 25326 "" i__2[0] = 1, a__2[0] = sq; -#line 25330 "" +#line 25326 "" i__2[1] = 9, a__2[1] = "input pmx"; -#line 25330 "" +#line 25326 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10); -#line 25330 "" +#line 25326 "" do_fio(&c__1, ch__4, (ftnlen)10); -#line 25330 "" +#line 25326 "" e_wsfe(); -#line 25331 "" +#line 25327 "" s_wsfe(&io___1817); /* Writing concatenation */ -#line 25331 "" +#line 25327 "" i__3[0] = 1, a__3[0] = sq; -#line 25331 "" +#line 25327 "" i__3[1] = 15, a__3[1] = "setmaxslurs{24}"; -#line 25331 "" +#line 25327 "" i__3[2] = 1, a__3[2] = sq; -#line 25331 "" +#line 25327 "" i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%"; -#line 25331 "" +#line 25327 "" s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39); -#line 25331 "" +#line 25327 "" do_fio(&c__1, ch__5, (ftnlen)39); -#line 25331 "" +#line 25327 "" e_wsfe(); -#line 25333 "" +#line 25329 "" if (! (*fontslur)) { -#line 25333 "" +#line 25329 "" s_wsfe(&io___1818); /* Writing concatenation */ -#line 25333 "" +#line 25329 "" i__2[0] = 1, a__2[0] = sq; -#line 25333 "" +#line 25329 "" i__2[1] = 13, a__2[1] = "input musixps"; -#line 25333 "" +#line 25329 "" s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); -#line 25333 "" +#line 25329 "" do_fio(&c__1, ch__6, (ftnlen)14); -#line 25333 "" +#line 25329 "" e_wsfe(); -#line 25333 "" +#line 25329 "" } /* Need to input musixmad to permit more slurs. */ -#line 25337 "" +#line 25333 "" if (*musicsize == 20) { -#line 25338 "" +#line 25334 "" s_wsfe(&io___1819); /* Writing concatenation */ -#line 25338 "" +#line 25334 "" i__2[0] = 1, a__2[0] = sq; -#line 25338 "" +#line 25334 "" i__2[1] = 16, a__2[1] = "normalmusicsize%"; -#line 25338 "" +#line 25334 "" s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17); -#line 25338 "" +#line 25334 "" do_fio(&c__1, ch__7, (ftnlen)17); -#line 25338 "" +#line 25334 "" e_wsfe(); -#line 25339 "" +#line 25335 "" } else if (*musicsize == 16) { -#line 25340 "" +#line 25336 "" s_wsfe(&io___1820); /* Writing concatenation */ -#line 25340 "" +#line 25336 "" i__2[0] = 1, a__2[0] = sq; -#line 25340 "" +#line 25336 "" i__2[1] = 15, a__2[1] = "smallmusicsize%"; -#line 25340 "" +#line 25336 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); -#line 25340 "" +#line 25336 "" do_fio(&c__1, ch__8, (ftnlen)16); -#line 25340 "" +#line 25336 "" e_wsfe(); -#line 25341 "" +#line 25337 "" } else if (*musicsize == 24) { -#line 25342 "" +#line 25338 "" s_wsfe(&io___1821); /* Writing concatenation */ -#line 25342 "" +#line 25338 "" i__2[0] = 1, a__2[0] = sq; -#line 25342 "" +#line 25338 "" i__2[1] = 15, a__2[1] = "largemusicsize%"; -#line 25342 "" +#line 25338 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); -#line 25342 "" +#line 25338 "" do_fio(&c__1, ch__8, (ftnlen)16); -#line 25342 "" +#line 25338 "" e_wsfe(); /* Eliminate, per Tennent's analysis and musixtex changes since first input */ /* write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// */ /* * 'meterlargefont}%' */ -#line 25348 "" +#line 25344 "" } else if (*musicsize == 29) { -#line 25349 "" +#line 25345 "" s_wsfe(&io___1822); /* Writing concatenation */ -#line 25349 "" +#line 25345 "" i__2[0] = 1, a__2[0] = sq; -#line 25349 "" +#line 25345 "" i__2[1] = 15, a__2[1] = "Largemusicsize%"; -#line 25349 "" +#line 25345 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); -#line 25349 "" +#line 25345 "" do_fio(&c__1, ch__8, (ftnlen)16); -#line 25349 "" +#line 25345 "" e_wsfe(); /* write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// */ /* * 'meterLargefont}%' */ -#line 25352 "" +#line 25348 "" } /* Set sizes. Have sizes per staff in isize(.) and noinst per staff in */ @@ -62747,235 +63034,277 @@ L1: /* 130324 */ /* iiv = 1 */ -#line 25359 "" +#line 25355 "" i__4 = *noinst; -#line 25359 "" +#line 25355 "" for (iinst = 1; iinst <= i__4; ++iinst) { /* if (isize(iiv) .eq. 1) then */ -#line 25361 "" +#line 25357 "" if (comsize_1.isize[iinst - 1] == 1) { -#line 25362 "" +#line 25358 "" if (iinst <= 9) { -#line 25363 "" +#line 25359 "" s_wsfe(&io___1824); /* Writing concatenation */ -#line 25363 "" +#line 25359 "" i__2[0] = 1, a__2[0] = sq; -#line 25363 "" +#line 25359 "" i__2[1] = 7, a__2[1] = "setsize"; -#line 25363 "" +#line 25359 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25363 "" +#line 25359 "" do_fio(&c__1, ch__9, (ftnlen)8); -#line 25363 "" +#line 25359 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25363 "" +#line 25359 "" i__5[0] = 1, a__4[0] = sq; -#line 25363 "" +#line 25359 "" i__5[1] = 11, a__4[1] = "smallvalue%"; -#line 25363 "" +#line 25359 "" s_cat(ch__10, a__4, i__5, &c__2, (ftnlen)12); -#line 25363 "" +#line 25359 "" do_fio(&c__1, ch__10, (ftnlen)12); -#line 25363 "" +#line 25359 "" e_wsfe(); -#line 25365 "" +#line 25361 "" } else { -#line 25366 "" +#line 25362 "" s_wsfe(&io___1825); /* Writing concatenation */ -#line 25366 "" +#line 25362 "" i__2[0] = 1, a__2[0] = sq; -#line 25366 "" +#line 25362 "" i__2[1] = 8, a__2[1] = "setsize{"; -#line 25366 "" +#line 25362 "" s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9); -#line 25366 "" +#line 25362 "" do_fio(&c__1, ch__11, (ftnlen)9); -#line 25366 "" +#line 25362 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25366 "" +#line 25362 "" i__1[0] = 1, a__1[0] = "}"; -#line 25366 "" +#line 25362 "" i__1[1] = 1, a__1[1] = sq; -#line 25366 "" +#line 25362 "" i__1[2] = 11, a__1[2] = "smallvalue%"; -#line 25366 "" +#line 25362 "" s_cat(ch__12, a__1, i__1, &c__3, (ftnlen)13); -#line 25366 "" +#line 25362 "" do_fio(&c__1, ch__12, (ftnlen)13); -#line 25366 "" +#line 25362 "" e_wsfe(); -#line 25368 "" +#line 25364 "" } /* else if (isize(iiv) .eq. 2) then */ -#line 25370 "" +#line 25366 "" } else if (comsize_1.isize[iinst - 1] == 2) { -#line 25371 "" +#line 25367 "" if (iinst <= 9) { -#line 25372 "" +#line 25368 "" s_wsfe(&io___1826); /* Writing concatenation */ -#line 25372 "" +#line 25368 "" i__2[0] = 1, a__2[0] = sq; -#line 25372 "" +#line 25368 "" i__2[1] = 7, a__2[1] = "setsize"; -#line 25372 "" +#line 25368 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25372 "" +#line 25368 "" do_fio(&c__1, ch__9, (ftnlen)8); -#line 25372 "" +#line 25368 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25372 "" +#line 25368 "" i__5[0] = 1, a__4[0] = sq; -#line 25372 "" +#line 25368 "" i__5[1] = 10, a__4[1] = "tinyvalue%"; -#line 25372 "" +#line 25368 "" s_cat(ch__13, a__4, i__5, &c__2, (ftnlen)11); -#line 25372 "" +#line 25368 "" do_fio(&c__1, ch__13, (ftnlen)11); -#line 25372 "" +#line 25368 "" e_wsfe(); -#line 25374 "" +#line 25370 "" } else { -#line 25375 "" +#line 25371 "" s_wsfe(&io___1827); /* Writing concatenation */ -#line 25375 "" +#line 25371 "" i__2[0] = 1, a__2[0] = sq; -#line 25375 "" +#line 25371 "" i__2[1] = 8, a__2[1] = "setsize{"; -#line 25375 "" +#line 25371 "" s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9); -#line 25375 "" +#line 25371 "" do_fio(&c__1, ch__11, (ftnlen)9); -#line 25375 "" +#line 25371 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25375 "" +#line 25371 "" i__1[0] = 1, a__1[0] = "}"; -#line 25375 "" +#line 25371 "" i__1[1] = 1, a__1[1] = sq; -#line 25375 "" +#line 25371 "" i__1[2] = 10, a__1[2] = "tinyvalue%"; -#line 25375 "" +#line 25371 "" s_cat(ch__10, a__1, i__1, &c__3, (ftnlen)12); -#line 25375 "" +#line 25371 "" do_fio(&c__1, ch__10, (ftnlen)12); -#line 25375 "" +#line 25371 "" e_wsfe(); -#line 25377 "" +#line 25373 "" } -#line 25378 "" +#line 25374 "" } /* iiv = iiv+nsperi(iinst) */ -#line 25380 "" +#line 25376 "" /* L5: */ -#line 25380 "" +#line 25376 "" } -#line 25381 "" +#line 25377 "" s_wsfi(&io___1829); -#line 25381 "" +#line 25377 "" do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real)); -#line 25381 "" +#line 25377 "" e_wsfi(); -#line 25382 "" +#line 25378 "" s_wsfe(&io___1830); /* Writing concatenation */ -#line 25382 "" +#line 25378 "" i__2[0] = 1, a__2[0] = sq; -#line 25382 "" +#line 25378 "" i__2[1] = 13, a__2[1] = "nopagenumbers"; -#line 25382 "" +#line 25378 "" s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); -#line 25382 "" +#line 25378 "" do_fio(&c__1, ch__6, (ftnlen)14); -#line 25382 "" +#line 25378 "" e_wsfe(); -#line 25383 "" +#line 25379 "" s_wsfe(&io___1831); /* Writing concatenation */ -#line 25383 "" +#line 25379 "" i__3[0] = 1, a__3[0] = sq; -#line 25383 "" +#line 25379 "" i__3[1] = 14, a__3[1] = "tracingstats=2"; -#line 25383 "" +#line 25379 "" i__3[2] = 1, a__3[2] = sq; -#line 25383 "" +#line 25379 "" i__3[3] = 5, a__3[3] = "relax"; -#line 25383 "" +#line 25379 "" s_cat(ch__14, a__3, i__3, &c__4, (ftnlen)21); -#line 25383 "" +#line 25379 "" do_fio(&c__1, ch__14, (ftnlen)21); -#line 25383 "" +#line 25379 "" e_wsfe(); -#line 25384 "" +#line 25380 "" s_wsfe(&io___1832); /* Writing concatenation */ -#line 25384 "" +#line 25380 "" i__2[0] = 1, a__2[0] = sq; -#line 25384 "" +#line 25380 "" i__2[1] = 6, a__2[1] = "hsize="; -#line 25384 "" +#line 25380 "" s_cat(ch__15, a__2, i__2, &c__2, (ftnlen)7); -#line 25384 "" +#line 25380 "" do_fio(&c__1, ch__15, (ftnlen)7); -#line 25384 "" +#line 25380 "" i__4 = i_nint(&comtop_1.widthpt); -#line 25384 "" +#line 25380 "" do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 25384 "" +#line 25380 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25384 "" +#line 25380 "" e_wsfe(); -#line 25385 "" +#line 25381 "" ci__1.cierr = 0; -#line 25385 "" +#line 25381 "" ci__1.ciunit = 11; /* Writing concatenation */ -#line 25385 "" +#line 25381 "" i__1[0] = 5, a__1[0] = "(a6,i"; -#line 25385 "" +#line 25381 "" r__1 = comtop_1.height + .1f; -#line 25385 "" +#line 25381 "" i__4 = (integer) r_lg10(&r__1) + 49; -#line 25385 "" +#line 25381 "" chax_(ch__1, (ftnlen)1, &i__4); -#line 25385 "" +#line 25381 "" i__1[1] = 1, a__1[1] = ch__1; -#line 25385 "" +#line 25381 "" i__1[2] = 4, a__1[2] = ",a2)"; -#line 25385 "" +#line 25381 "" ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4); -#line 25385 "" +#line 25381 "" s_wsfe(&ci__1); /* Writing concatenation */ -#line 25385 "" +#line 25381 "" i__2[0] = 1, a__2[0] = sq; -#line 25385 "" +#line 25381 "" i__2[1] = 5, a__2[1] = "vsize"; -#line 25385 "" +#line 25381 "" s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)6); -#line 25385 "" +#line 25381 "" do_fio(&c__1, ch__16, (ftnlen)6); -#line 25385 "" +#line 25381 "" i__6 = (integer) (comtop_1.height + .1f); -#line 25385 "" +#line 25381 "" do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer)); -#line 25385 "" +#line 25381 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25385 "" +#line 25381 "" e_wsfe(); -#line 25387 "" +#line 25383 "" if (dabs(comtop_1.hoffpt) > .1f) { -#line 25388 "" +#line 25384 "" if (comtop_1.hoffpt <= -10.f) { -#line 25389 "" +#line 25385 "" s_wsfe(&io___1833); /* Writing concatenation */ +#line 25385 "" + i__2[0] = 1, a__2[0] = sq; +#line 25385 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 25385 "" + s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); +#line 25385 "" + do_fio(&c__1, ch__9, (ftnlen)8); +#line 25385 "" + i__4 = i_nint(&comtop_1.hoffpt); +#line 25385 "" + do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); +#line 25385 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 25385 "" + e_wsfe(); +#line 25386 "" + } else if (comtop_1.hoffpt < 0.f) { +#line 25387 "" + s_wsfe(&io___1834); +/* Writing concatenation */ +#line 25387 "" + i__2[0] = 1, a__2[0] = sq; +#line 25387 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 25387 "" + s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); +#line 25387 "" + do_fio(&c__1, ch__9, (ftnlen)8); +#line 25387 "" + i__4 = i_nint(&comtop_1.hoffpt); +#line 25387 "" + do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); +#line 25387 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 25387 "" + e_wsfe(); +#line 25388 "" + } else if (comtop_1.hoffpt < 10.f) { +#line 25389 "" + s_wsfe(&io___1835); +/* Writing concatenation */ #line 25389 "" i__2[0] = 1, a__2[0] = sq; #line 25389 "" @@ -62993,9 +63322,9 @@ L1: #line 25389 "" e_wsfe(); #line 25390 "" - } else if (comtop_1.hoffpt < 0.f) { + } else { #line 25391 "" - s_wsfe(&io___1834); + s_wsfe(&io___1836); /* Writing concatenation */ #line 25391 "" i__2[0] = 1, a__2[0] = sq; @@ -63014,57 +63343,57 @@ L1: #line 25391 "" e_wsfe(); #line 25392 "" - } else if (comtop_1.hoffpt < 10.f) { + } #line 25393 "" - s_wsfe(&io___1835); + } +#line 25394 "" + if (dabs(comtop_1.voffpt) > .1f) { +#line 25395 "" + if (comtop_1.voffpt <= -10.f) { +#line 25396 "" + s_wsfe(&io___1837); /* Writing concatenation */ -#line 25393 "" +#line 25396 "" i__2[0] = 1, a__2[0] = sq; -#line 25393 "" - i__2[1] = 7, a__2[1] = "hoffset"; -#line 25393 "" +#line 25396 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 25396 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25393 "" +#line 25396 "" do_fio(&c__1, ch__9, (ftnlen)8); -#line 25393 "" - i__4 = i_nint(&comtop_1.hoffpt); -#line 25393 "" +#line 25396 "" + i__4 = i_nint(&comtop_1.voffpt); +#line 25396 "" do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 25393 "" +#line 25396 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25393 "" +#line 25396 "" e_wsfe(); -#line 25394 "" - } else { -#line 25395 "" - s_wsfe(&io___1836); +#line 25397 "" + } else if (comtop_1.voffpt < 0.f) { +#line 25398 "" + s_wsfe(&io___1838); /* Writing concatenation */ -#line 25395 "" +#line 25398 "" i__2[0] = 1, a__2[0] = sq; -#line 25395 "" - i__2[1] = 7, a__2[1] = "hoffset"; -#line 25395 "" +#line 25398 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 25398 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25395 "" +#line 25398 "" do_fio(&c__1, ch__9, (ftnlen)8); -#line 25395 "" - i__4 = i_nint(&comtop_1.hoffpt); -#line 25395 "" +#line 25398 "" + i__4 = i_nint(&comtop_1.voffpt); +#line 25398 "" do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 25395 "" +#line 25398 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25395 "" - e_wsfe(); -#line 25396 "" - } -#line 25397 "" - } #line 25398 "" - if (dabs(comtop_1.voffpt) > .1f) { + e_wsfe(); #line 25399 "" - if (comtop_1.voffpt <= -10.f) { + } else if (comtop_1.voffpt < 10.f) { #line 25400 "" - s_wsfe(&io___1837); + s_wsfe(&io___1839); /* Writing concatenation */ #line 25400 "" i__2[0] = 1, a__2[0] = sq; @@ -63083,9 +63412,9 @@ L1: #line 25400 "" e_wsfe(); #line 25401 "" - } else if (comtop_1.voffpt < 0.f) { + } else { #line 25402 "" - s_wsfe(&io___1838); + s_wsfe(&io___1840); /* Writing concatenation */ #line 25402 "" i__2[0] = 1, a__2[0] = sq; @@ -63104,812 +63433,772 @@ L1: #line 25402 "" e_wsfe(); #line 25403 "" - } else if (comtop_1.voffpt < 10.f) { -#line 25404 "" - s_wsfe(&io___1839); -/* Writing concatenation */ -#line 25404 "" - i__2[0] = 1, a__2[0] = sq; -#line 25404 "" - i__2[1] = 7, a__2[1] = "voffset"; -#line 25404 "" - s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25404 "" - do_fio(&c__1, ch__9, (ftnlen)8); -#line 25404 "" - i__4 = i_nint(&comtop_1.voffpt); -#line 25404 "" - do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 25404 "" - do_fio(&c__1, "pt", (ftnlen)2); -#line 25404 "" - e_wsfe(); -#line 25405 "" - } else { -#line 25406 "" - s_wsfe(&io___1840); -/* Writing concatenation */ -#line 25406 "" - i__2[0] = 1, a__2[0] = sq; -#line 25406 "" - i__2[1] = 7, a__2[1] = "voffset"; -#line 25406 "" - s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25406 "" - do_fio(&c__1, ch__9, (ftnlen)8); -#line 25406 "" - i__4 = i_nint(&comtop_1.voffpt); -#line 25406 "" - do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); -#line 25406 "" - do_fio(&c__1, "pt", (ftnlen)2); -#line 25406 "" - e_wsfe(); -#line 25407 "" } -#line 25408 "" +#line 25404 "" } /* The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if */ /* 3 sharps and treble clef, to avoid vertical clash with top space g# */ -#line 25413 "" +#line 25409 "" if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') { -#line 25413 "" +#line 25409 "" s_wsfe(&io___1841); /* Writing concatenation */ -#line 25413 "" +#line 25409 "" i__7[0] = 1, a__5[0] = sq; -#line 25413 "" +#line 25409 "" i__7[1] = 3, a__5[1] = "def"; -#line 25413 "" +#line 25409 "" i__7[2] = 1, a__5[2] = sq; -#line 25413 "" +#line 25409 "" i__7[3] = 14, a__5[3] = "raisebarno{4.5"; -#line 25413 "" +#line 25409 "" i__7[4] = 1, a__5[4] = sq; -#line 25413 "" +#line 25409 "" i__7[5] = 10, a__5[5] = "internote}"; -#line 25413 "" +#line 25409 "" s_cat(ch__17, a__5, i__7, &c__6, (ftnlen)30); -#line 25413 "" +#line 25409 "" do_fio(&c__1, ch__17, (ftnlen)30); -#line 25413 "" +#line 25409 "" e_wsfe(); -#line 25413 "" +#line 25409 "" } -#line 25415 "" +#line 25411 "" if (*noinst < 10) { -#line 25416 "" +#line 25412 "" s_wsfe(&io___1842); /* Writing concatenation */ -#line 25416 "" +#line 25412 "" i__3[0] = 1, a__3[0] = sq; -#line 25416 "" +#line 25412 "" i__3[1] = 3, a__3[1] = "def"; -#line 25416 "" +#line 25412 "" i__3[2] = 1, a__3[2] = sq; -#line 25416 "" +#line 25412 "" i__3[3] = 14, a__3[3] = "nbinstruments{"; -#line 25416 "" +#line 25412 "" s_cat(ch__18, a__3, i__3, &c__4, (ftnlen)19); -#line 25416 "" +#line 25412 "" do_fio(&c__1, ch__18, (ftnlen)19); -#line 25416 "" +#line 25412 "" do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); -#line 25416 "" +#line 25412 "" do_fio(&c__1, "}", (ftnlen)1); -#line 25416 "" +#line 25412 "" e_wsfe(); -#line 25418 "" +#line 25414 "" } else { -#line 25419 "" +#line 25415 "" s_wsfe(&io___1843); /* Writing concatenation */ -#line 25419 "" +#line 25415 "" i__3[0] = 1, a__3[0] = sq; -#line 25419 "" +#line 25415 "" i__3[1] = 3, a__3[1] = "def"; -#line 25419 "" +#line 25415 "" i__3[2] = 1, a__3[2] = sq; -#line 25419 "" +#line 25415 "" i__3[3] = 14, a__3[3] = "nbinstruments{"; -#line 25419 "" +#line 25415 "" s_cat(ch__18, a__3, i__3, &c__4, (ftnlen)19); -#line 25419 "" +#line 25415 "" do_fio(&c__1, ch__18, (ftnlen)19); -#line 25419 "" +#line 25415 "" do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); -#line 25419 "" +#line 25415 "" do_fio(&c__1, "}", (ftnlen)1); -#line 25419 "" +#line 25415 "" e_wsfe(); -#line 25421 "" +#line 25417 "" } -#line 25422 "" +#line 25418 "" iv = 0; -#line 25423 "" +#line 25419 "" i__4 = *noinst; -#line 25423 "" +#line 25419 "" for (iinst = 1; iinst <= i__4; ++iinst) { -#line 25424 "" +#line 25420 "" nstaves = comnvi_1.nsperi[iinst - 1]; -#line 25425 "" +#line 25421 "" if (iinst < 10) { -#line 25426 "" +#line 25422 "" s_wsfe(&io___1846); /* Writing concatenation */ -#line 25426 "" +#line 25422 "" i__3[0] = 1, a__3[0] = sq; -#line 25426 "" +#line 25422 "" i__3[1] = 9, a__3[1] = "setstaffs"; -#line 25426 "" +#line 25422 "" i__6 = iinst + 48; -#line 25426 "" +#line 25422 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25426 "" +#line 25422 "" i__3[2] = 1, a__3[2] = ch__1; -#line 25426 "" +#line 25422 "" i__8 = nstaves + 48; -#line 25426 "" +#line 25422 "" chax_(ch__19, (ftnlen)1, &i__8); -#line 25426 "" +#line 25422 "" i__3[3] = 1, a__3[3] = ch__19; -#line 25426 "" +#line 25422 "" s_cat(ch__10, a__3, i__3, &c__4, (ftnlen)12); -#line 25426 "" +#line 25422 "" do_fio(&c__1, ch__10, (ftnlen)12); -#line 25426 "" +#line 25422 "" e_wsfe(); -#line 25428 "" +#line 25424 "" } else { -#line 25429 "" +#line 25425 "" s_wsfe(&io___1847); /* Writing concatenation */ -#line 25429 "" +#line 25425 "" i__2[0] = 1, a__2[0] = sq; -#line 25429 "" +#line 25425 "" i__2[1] = 10, a__2[1] = "setstaffs{"; -#line 25429 "" +#line 25425 "" s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11); -#line 25429 "" +#line 25425 "" do_fio(&c__1, ch__13, (ftnlen)11); -#line 25429 "" +#line 25425 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25429 "" +#line 25425 "" i__5[0] = 1, a__4[0] = "}"; -#line 25429 "" +#line 25425 "" i__6 = nstaves + 48; -#line 25429 "" +#line 25425 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25429 "" +#line 25425 "" i__5[1] = 1, a__4[1] = ch__1; -#line 25429 "" +#line 25425 "" s_cat(ch__20, a__4, i__5, &c__2, (ftnlen)2); -#line 25429 "" +#line 25425 "" do_fio(&c__1, ch__20, (ftnlen)2); -#line 25429 "" +#line 25425 "" e_wsfe(); -#line 25431 "" +#line 25427 "" } -#line 25432 "" +#line 25428 "" ++iv; -#line 25433 "" +#line 25429 "" *(unsigned char *)clefqiv = *(unsigned char *)&clefq[iv]; -#line 25434 "" +#line 25430 "" if (*(unsigned char *)clefqiv == '8') { -#line 25435 "" +#line 25431 "" *(unsigned char *)clefqiv = 't'; -#line 25436 "" +#line 25432 "" cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] += 7; -#line 25437 "" +#line 25433 "" comc8flag_1.c8flag[iv - 1] = TRUE_; -#line 25438 "" +#line 25434 "" } -#line 25439 "" +#line 25435 "" if (nstaves == 1) { -#line 25440 "" +#line 25436 "" i__6 = numclef_(clefq + iv, (ftnlen)1) + 48; -#line 25440 "" +#line 25436 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25440 "" +#line 25436 "" s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1); -#line 25441 "" +#line 25437 "" lfmtq = 1; -#line 25442 "" +#line 25438 "" } else { /* Writing concatenation */ -#line 25443 "" +#line 25439 "" i__2[0] = 1, a__2[0] = "{"; -#line 25443 "" +#line 25439 "" i__6 = numclef_(clefq + iv, (ftnlen)1) + 48; -#line 25443 "" +#line 25439 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25443 "" +#line 25439 "" i__2[1] = 1, a__2[1] = ch__1; -#line 25443 "" +#line 25439 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); -#line 25444 "" +#line 25440 "" lfmtq = 2; -#line 25445 "" +#line 25441 "" i__6 = nstaves; -#line 25445 "" +#line 25441 "" for (k = 2; k <= i__6; ++k) { -#line 25446 "" +#line 25442 "" ++iv; /* Writing concatenation */ -#line 25447 "" +#line 25443 "" i__2[0] = lfmtq, a__2[0] = fmtq; -#line 25447 "" +#line 25443 "" i__8 = numclef_(clefq + iv, (ftnlen)1) + 48; -#line 25447 "" +#line 25443 "" chax_(ch__1, (ftnlen)1, &i__8); -#line 25447 "" +#line 25443 "" i__2[1] = 1, a__2[1] = ch__1; -#line 25447 "" +#line 25443 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); -#line 25448 "" +#line 25444 "" ++lfmtq; -#line 25449 "" +#line 25445 "" /* L2: */ -#line 25449 "" +#line 25445 "" } /* Writing concatenation */ -#line 25450 "" +#line 25446 "" i__2[0] = lfmtq, a__2[0] = fmtq; -#line 25450 "" +#line 25446 "" i__2[1] = 1, a__2[1] = "}"; -#line 25450 "" +#line 25446 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); -#line 25451 "" +#line 25447 "" ++lfmtq; -#line 25452 "" +#line 25448 "" } -#line 25453 "" +#line 25449 "" if (iinst < 10) { -#line 25454 "" +#line 25450 "" s_wsfe(&io___1852); /* Writing concatenation */ -#line 25454 "" +#line 25450 "" i__3[0] = 1, a__3[0] = sq; -#line 25454 "" +#line 25450 "" i__3[1] = 7, a__3[1] = "setclef"; -#line 25454 "" +#line 25450 "" i__6 = iinst + 48; -#line 25454 "" +#line 25450 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25454 "" +#line 25450 "" i__3[2] = 1, a__3[2] = ch__1; -#line 25454 "" +#line 25450 "" i__3[3] = lfmtq, a__3[3] = fmtq; -#line 25454 "" +#line 25450 "" s_cat(ch__21, a__3, i__3, &c__4, (ftnlen)33); -#line 25454 "" +#line 25450 "" do_fio(&c__1, ch__21, lfmtq + 9); -#line 25454 "" +#line 25450 "" e_wsfe(); -#line 25455 "" +#line 25451 "" } else { -#line 25456 "" +#line 25452 "" s_wsfe(&io___1853); /* Writing concatenation */ -#line 25456 "" +#line 25452 "" i__2[0] = 1, a__2[0] = sq; -#line 25456 "" +#line 25452 "" i__2[1] = 8, a__2[1] = "setclef{"; -#line 25456 "" +#line 25452 "" s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9); -#line 25456 "" +#line 25452 "" do_fio(&c__1, ch__11, (ftnlen)9); -#line 25456 "" +#line 25452 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25456 "" +#line 25452 "" i__5[0] = 1, a__4[0] = "}"; -#line 25456 "" +#line 25452 "" i__5[1] = lfmtq, a__4[1] = fmtq; -#line 25456 "" +#line 25452 "" s_cat(ch__22, a__4, i__5, &c__2, (ftnlen)25); -#line 25456 "" +#line 25452 "" do_fio(&c__1, ch__22, lfmtq + 1); -#line 25456 "" +#line 25452 "" e_wsfe(); -#line 25457 "" +#line 25453 "" } -#line 25458 "" +#line 25454 "" if (*(unsigned char *)&clefq[iv] == '8') { -#line 25459 "" +#line 25455 "" if (iinst < 10) { -#line 25460 "" +#line 25456 "" s_wsfe(&io___1854); /* Writing concatenation */ -#line 25460 "" +#line 25456 "" i__9[0] = 1, a__6[0] = sq; -#line 25460 "" +#line 25456 "" i__9[1] = 19, a__6[1] = "settrebleclefsymbol"; -#line 25460 "" +#line 25456 "" i__6 = iinst + 48; -#line 25460 "" +#line 25456 "" chax_(ch__1, (ftnlen)1, &i__6); -#line 25460 "" +#line 25456 "" i__9[2] = 1, a__6[2] = ch__1; -#line 25460 "" +#line 25456 "" i__9[3] = 1, a__6[3] = sq; -#line 25460 "" +#line 25456 "" i__9[4] = 13, a__6[4] = "treblelowoct%"; -#line 25460 "" +#line 25456 "" s_cat(ch__23, a__6, i__9, &c__5, (ftnlen)35); -#line 25460 "" +#line 25456 "" do_fio(&c__1, ch__23, (ftnlen)35); -#line 25460 "" +#line 25456 "" e_wsfe(); -#line 25462 "" +#line 25458 "" } else { -#line 25463 "" +#line 25459 "" s_wsfe(&io___1855); /* Writing concatenation */ -#line 25463 "" +#line 25459 "" i__2[0] = 1, a__2[0] = sq; -#line 25463 "" +#line 25459 "" i__2[1] = 20, a__2[1] = "settrebleclefsymbol{"; -#line 25463 "" +#line 25459 "" s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)21); -#line 25463 "" +#line 25459 "" do_fio(&c__1, ch__14, (ftnlen)21); -#line 25463 "" +#line 25459 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25463 "" +#line 25459 "" i__1[0] = 1, a__1[0] = "}"; -#line 25463 "" +#line 25459 "" i__1[1] = 1, a__1[1] = sq; -#line 25463 "" +#line 25459 "" i__1[2] = 13, a__1[2] = "treblelowoct%"; -#line 25463 "" +#line 25459 "" s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)15); -#line 25463 "" +#line 25459 "" do_fio(&c__1, ch__3, (ftnlen)15); -#line 25463 "" +#line 25459 "" e_wsfe(); -#line 25465 "" +#line 25461 "" } -#line 25466 "" +#line 25462 "" comc8flag_1.c8flag[iv - 1] = TRUE_; -#line 25467 "" +#line 25463 "" } -#line 25468 "" +#line 25464 "" for (lname = 79; lname >= 2; --lname) { -#line 25469 "" +#line 25465 "" if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname - 1)] != ' ') { -#line 25469 "" +#line 25465 "" goto L4; -#line 25469 "" +#line 25465 "" } -#line 25470 "" +#line 25466 "" /* L3: */ -#line 25470 "" +#line 25466 "" } -#line 25471 "" +#line 25467 "" L4: -#line 25472 "" +#line 25468 "" comtop_1.lnam[iinst - 1] = lname; -#line 25473 "" +#line 25469 "" if (iinst < 10) { -#line 25474 "" +#line 25470 "" s_wsfe(&io___1857); /* Writing concatenation */ -#line 25474 "" +#line 25470 "" i__2[0] = 1, a__2[0] = sq; -#line 25474 "" +#line 25470 "" i__2[1] = 7, a__2[1] = "setname"; -#line 25474 "" +#line 25470 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); -#line 25474 "" +#line 25470 "" do_fio(&c__1, ch__9, (ftnlen)8); -#line 25474 "" +#line 25470 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25474 "" +#line 25470 "" i__1[0] = 1, a__1[0] = "{"; -#line 25474 "" +#line 25470 "" i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; -#line 25474 "" +#line 25470 "" i__1[2] = 1, a__1[2] = "}"; -#line 25474 "" +#line 25470 "" s_cat(ch__24, a__1, i__1, &c__3, (ftnlen)81); -#line 25474 "" +#line 25470 "" do_fio(&c__1, ch__24, lname + 2); -#line 25474 "" +#line 25470 "" e_wsfe(); -#line 25476 "" +#line 25472 "" } else { -#line 25477 "" +#line 25473 "" s_wsfe(&io___1858); /* Writing concatenation */ -#line 25477 "" +#line 25473 "" i__2[0] = 1, a__2[0] = sq; -#line 25477 "" +#line 25473 "" i__2[1] = 8, a__2[1] = "setname{"; -#line 25477 "" +#line 25473 "" s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9); -#line 25477 "" +#line 25473 "" do_fio(&c__1, ch__11, (ftnlen)9); -#line 25477 "" +#line 25473 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ -#line 25477 "" +#line 25473 "" i__1[0] = 2, a__1[0] = "}{"; -#line 25477 "" +#line 25473 "" i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; -#line 25477 "" +#line 25473 "" i__1[2] = 1, a__1[2] = "}"; -#line 25477 "" +#line 25473 "" s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)82); -#line 25477 "" +#line 25473 "" do_fio(&c__1, ch__25, lname + 3); -#line 25477 "" +#line 25473 "" e_wsfe(); -#line 25479 "" +#line 25475 "" } -#line 25480 "" +#line 25476 "" /* L1: */ -#line 25480 "" +#line 25476 "" } -#line 25481 "" +#line 25477 "" s_wsfe(&io___1859); /* Writing concatenation */ -#line 25481 "" +#line 25477 "" i__2[0] = 1, a__2[0] = sq; -#line 25481 "" +#line 25477 "" i__2[1] = 17, a__2[1] = "generalsignature{"; -#line 25481 "" +#line 25477 "" s_cat(ch__26, a__2, i__2, &c__2, (ftnlen)18); -#line 25481 "" +#line 25477 "" do_fio(&c__1, ch__26, (ftnlen)18); -#line 25481 "" +#line 25477 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); -#line 25481 "" +#line 25477 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 25481 "" +#line 25477 "" e_wsfe(); -#line 25482 "" +#line 25478 "" if (cominsttrans_1.earlytranson) { -#line 25482 "" +#line 25478 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, &cominsttrans_1.earlytranson); -#line 25482 "" +#line 25478 "" } -#line 25484 "" +#line 25480 "" wgmeter_(mtrnmp, mtrdnp); -#line 25485 "" +#line 25481 "" r__1 = comtop_1.fracindent * comtop_1.widthpt; -#line 25485 "" +#line 25481 "" ipi = i_nint(&r__1); -#line 25486 "" +#line 25482 "" if (ipi < 10) { -#line 25487 "" +#line 25483 "" s_wsfe(&io___1861); /* Writing concatenation */ -#line 25487 "" +#line 25483 "" i__2[0] = 1, a__2[0] = sq; -#line 25487 "" +#line 25483 "" i__2[1] = 10, a__2[1] = "parindent "; -#line 25487 "" +#line 25483 "" s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11); -#line 25487 "" +#line 25483 "" do_fio(&c__1, ch__13, (ftnlen)11); -#line 25487 "" +#line 25483 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); -#line 25487 "" +#line 25483 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25487 "" +#line 25483 "" e_wsfe(); -#line 25488 "" +#line 25484 "" } else if (ipi < 100) { -#line 25489 "" +#line 25485 "" s_wsfe(&io___1862); /* Writing concatenation */ -#line 25489 "" +#line 25485 "" i__2[0] = 1, a__2[0] = sq; -#line 25489 "" +#line 25485 "" i__2[1] = 10, a__2[1] = "parindent "; -#line 25489 "" +#line 25485 "" s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11); -#line 25489 "" +#line 25485 "" do_fio(&c__1, ch__13, (ftnlen)11); -#line 25489 "" +#line 25485 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); -#line 25489 "" +#line 25485 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25489 "" +#line 25485 "" e_wsfe(); -#line 25490 "" +#line 25486 "" } else { -#line 25491 "" +#line 25487 "" s_wsfe(&io___1863); /* Writing concatenation */ -#line 25491 "" +#line 25487 "" i__2[0] = 1, a__2[0] = sq; -#line 25491 "" +#line 25487 "" i__2[1] = 10, a__2[1] = "parindent "; -#line 25491 "" +#line 25487 "" s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11); -#line 25491 "" +#line 25487 "" do_fio(&c__1, ch__13, (ftnlen)11); -#line 25491 "" +#line 25487 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); -#line 25491 "" +#line 25487 "" do_fio(&c__1, "pt", (ftnlen)2); -#line 25491 "" +#line 25487 "" e_wsfe(); -#line 25492 "" +#line 25488 "" } -#line 25493 "" +#line 25489 "" s_wsfe(&io___1864); /* Writing concatenation */ -#line 25493 "" +#line 25489 "" i__10[0] = 1, a__7[0] = sq; -#line 25493 "" +#line 25489 "" i__10[1] = 11, a__7[1] = "elemskip1pt"; -#line 25493 "" +#line 25489 "" i__10[2] = 1, a__7[2] = sq; -#line 25493 "" +#line 25489 "" i__10[3] = 13, a__7[3] = "afterruleskip"; -#line 25493 "" +#line 25489 "" i__10[4] = 5, a__7[4] = fbarq; -#line 25493 "" +#line 25489 "" i__10[5] = 2, a__7[5] = "pt"; -#line 25493 "" +#line 25489 "" i__10[6] = 1, a__7[6] = sq; -#line 25493 "" +#line 25489 "" i__10[7] = 17, a__7[7] = "beforeruleskip0pt"; -#line 25493 "" +#line 25489 "" i__10[8] = 1, a__7[8] = sq; -#line 25493 "" +#line 25489 "" i__10[9] = 5, a__7[9] = "relax"; -#line 25493 "" +#line 25489 "" s_cat(ch__27, a__7, i__10, &c__10, (ftnlen)57); -#line 25493 "" +#line 25489 "" do_fio(&c__1, ch__27, (ftnlen)57); -#line 25493 "" +#line 25489 "" e_wsfe(); -#line 25495 "" +#line 25491 "" if (! (*vshrink)) { -#line 25496 "" +#line 25492 "" if (*xinstf1 < 9.95f) { -#line 25497 "" +#line 25493 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); -#line 25498 "" +#line 25494 "" } else { -#line 25499 "" +#line 25495 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); -#line 25500 "" +#line 25496 "" } -#line 25501 "" +#line 25497 "" facis = 1.f; -#line 25502 "" +#line 25498 "" if (comis4bignv_1.is4bignv) { -#line 25502 "" +#line 25498 "" facis = .95f; -#line 25502 "" +#line 25498 "" } -#line 25503 "" +#line 25499 "" s_wsfe(&io___1866); /* Writing concatenation */ -#line 25503 "" +#line 25499 "" i__7[0] = 1, a__5[0] = sq; -#line 25503 "" +#line 25499 "" i__7[1] = 15, a__5[1] = "stafftopmarg0pt"; -#line 25503 "" +#line 25499 "" i__7[2] = 1, a__5[2] = sq; -#line 25503 "" +#line 25499 "" i__7[3] = 15, a__5[3] = "staffbotmarg0pt"; -#line 25503 "" +#line 25499 "" i__7[4] = 1, a__5[4] = sq; -#line 25503 "" +#line 25499 "" i__7[5] = 11, a__5[5] = "interstaff{"; -#line 25503 "" +#line 25499 "" s_cat(ch__28, a__5, i__7, &c__6, (ftnlen)44); -#line 25503 "" +#line 25499 "" do_fio(&c__1, ch__28, (ftnlen)44); -#line 25503 "" +#line 25499 "" r__1 = *xinstf1 * facis; -#line 25503 "" +#line 25499 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); /* Writing concatenation */ -#line 25503 "" +#line 25499 "" i__1[0] = 1, a__1[0] = "}"; -#line 25503 "" +#line 25499 "" i__1[1] = 1, a__1[1] = sq; -#line 25503 "" +#line 25499 "" i__1[2] = 5, a__1[2] = "relax"; -#line 25503 "" +#line 25499 "" s_cat(ch__15, a__1, i__1, &c__3, (ftnlen)7); -#line 25503 "" +#line 25499 "" do_fio(&c__1, ch__15, (ftnlen)7); -#line 25503 "" +#line 25499 "" e_wsfe(); -#line 25505 "" +#line 25501 "" } else { -#line 25506 "" +#line 25502 "" s_wsfe(&io___1867); /* Writing concatenation */ -#line 25506 "" +#line 25502 "" i__10[0] = 1, a__7[0] = sq; -#line 25506 "" +#line 25502 "" i__10[1] = 15, a__7[1] = "stafftopmarg0pt"; -#line 25506 "" +#line 25502 "" i__10[2] = 1, a__7[2] = sq; -#line 25506 "" +#line 25502 "" i__10[3] = 13, a__7[3] = "staffbotmarg5"; -#line 25506 "" +#line 25502 "" i__10[4] = 1, a__7[4] = sq; -#line 25506 "" +#line 25502 "" i__10[5] = 10, a__7[5] = "Interligne"; -#line 25506 "" +#line 25502 "" i__10[6] = 1, a__7[6] = sq; -#line 25506 "" +#line 25502 "" i__10[7] = 14, a__7[7] = "interstaff{10}"; -#line 25506 "" +#line 25502 "" i__10[8] = 1, a__7[8] = sq; -#line 25506 "" +#line 25502 "" i__10[9] = 5, a__7[9] = "relax"; -#line 25506 "" +#line 25502 "" s_cat(ch__29, a__7, i__10, &c__10, (ftnlen)62); -#line 25506 "" +#line 25502 "" do_fio(&c__1, ch__29, (ftnlen)62); -#line 25506 "" +#line 25502 "" e_wsfe(); -#line 25509 "" +#line 25505 "" } -#line 25510 "" +#line 25506 "" if (*nv == 1) { -#line 25510 "" +#line 25506 "" s_wsfe(&io___1868); /* Writing concatenation */ -#line 25510 "" +#line 25506 "" i__2[0] = 1, a__2[0] = sq; -#line 25510 "" +#line 25506 "" i__2[1] = 11, a__2[1] = "nostartrule"; -#line 25510 "" +#line 25506 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)12); -#line 25510 "" +#line 25506 "" do_fio(&c__1, ch__10, (ftnlen)12); -#line 25510 "" +#line 25506 "" e_wsfe(); -#line 25510 "" +#line 25506 "" } -#line 25511 "" +#line 25507 "" s_wsfe(&io___1869); /* Writing concatenation */ -#line 25511 "" +#line 25507 "" i__3[0] = 1, a__3[0] = sq; -#line 25511 "" +#line 25507 "" i__3[1] = 8, a__3[1] = "readmod{"; -#line 25511 "" +#line 25507 "" i__3[2] = *lbase, a__3[2] = basenameq; -#line 25511 "" +#line 25507 "" i__3[3] = 1, a__3[3] = "}"; -#line 25511 "" +#line 25507 "" s_cat(ch__30, a__3, i__3, &c__4, (ftnlen)54); -#line 25511 "" +#line 25507 "" do_fio(&c__1, ch__30, *lbase + 10); -#line 25511 "" +#line 25507 "" e_wsfe(); -#line 25512 "" +#line 25508 "" if (comnvst_1.cstuplet) { -#line 25513 "" +#line 25509 "" s_wsfe(&io___1870); /* Writing concatenation */ -#line 25513 "" +#line 25509 "" i__11[0] = 1, a__8[0] = sq; -#line 25513 "" +#line 25509 "" i__11[1] = 12, a__8[1] = "input tuplet"; -#line 25513 "" +#line 25509 "" i__11[2] = 1, a__8[2] = sq; -#line 25513 "" +#line 25509 "" i__11[3] = 3, a__8[3] = "def"; -#line 25513 "" +#line 25509 "" i__11[4] = 1, a__8[4] = sq; -#line 25513 "" +#line 25509 "" i__11[5] = 12, a__8[5] = "xnumt#1#2#3{"; -#line 25513 "" +#line 25509 "" i__11[6] = 1, a__8[6] = sq; -#line 25513 "" +#line 25509 "" i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}"; -#line 25513 "" +#line 25509 "" i__11[8] = 1, a__8[8] = sq; -#line 25513 "" +#line 25509 "" i__11[9] = 3, a__8[9] = "def"; -#line 25513 "" +#line 25509 "" i__11[10] = 1, a__8[10] = sq; -#line 25513 "" +#line 25509 "" i__11[11] = 10, a__8[11] = "tuplettxt{"; -#line 25513 "" +#line 25509 "" i__11[12] = 1, a__8[12] = sq; -#line 25513 "" +#line 25509 "" i__11[13] = 9, a__8[13] = "smalltype"; -#line 25513 "" +#line 25509 "" i__11[14] = 1, a__8[14] = sq; -#line 25513 "" +#line 25509 "" i__11[15] = 6, a__8[15] = "it{#3}"; -#line 25513 "" +#line 25509 "" i__11[16] = 1, a__8[16] = sq; -#line 25513 "" - i__11[17] = 1, a__8[17] = "/"; -#line 25513 "" +#line 25509 "" + chax_(ch__1, (ftnlen)1, &c__47); +#line 25509 "" + i__11[17] = 1, a__8[17] = ch__1; +#line 25509 "" i__11[18] = 1, a__8[18] = sq; -#line 25513 "" +#line 25509 "" i__11[19] = 4, a__8[19] = "/}}%"; -#line 25513 "" +#line 25509 "" s_cat(ch__31, a__8, i__11, &c__20, (ftnlen)86); -#line 25513 "" +#line 25509 "" do_fio(&c__1, ch__31, (ftnlen)86); -#line 25513 "" +#line 25509 "" e_wsfe(); -#line 25517 "" +#line 25513 "" s_wsfe(&io___1871); /* Writing concatenation */ -#line 25517 "" +#line 25513 "" i__12[0] = 1, a__9[0] = sq; -#line 25517 "" +#line 25513 "" i__12[1] = 3, a__9[1] = "let"; -#line 25517 "" +#line 25513 "" i__12[2] = 1, a__9[2] = sq; -#line 25517 "" +#line 25513 "" i__12[3] = 5, a__9[3] = "ovbkt"; -#line 25517 "" +#line 25513 "" i__12[4] = 1, a__9[4] = sq; -#line 25517 "" +#line 25513 "" i__12[5] = 8, a__9[5] = "uptuplet"; -#line 25517 "" +#line 25513 "" i__12[6] = 1, a__9[6] = sq; -#line 25517 "" +#line 25513 "" i__12[7] = 3, a__9[7] = "let"; -#line 25517 "" +#line 25513 "" i__12[8] = 1, a__9[8] = sq; -#line 25517 "" +#line 25513 "" i__12[9] = 5, a__9[9] = "unbkt"; -#line 25517 "" +#line 25513 "" i__12[10] = 1, a__9[10] = sq; -#line 25517 "" +#line 25513 "" i__12[11] = 11, a__9[11] = "downtuplet%"; -#line 25517 "" +#line 25513 "" s_cat(ch__32, a__9, i__12, &c__12, (ftnlen)41); -#line 25517 "" +#line 25513 "" do_fio(&c__1, ch__32, (ftnlen)41); -#line 25517 "" +#line 25513 "" e_wsfe(); -#line 25519 "" +#line 25515 "" } -#line 25520 "" +#line 25516 "" s_wsfe(&io___1872); /* Writing concatenation */ -#line 25520 "" +#line 25516 "" i__13[0] = 1, a__10[0] = sq; -#line 25520 "" +#line 25516 "" i__13[1] = 11, a__10[1] = "startmuflex"; -#line 25520 "" +#line 25516 "" i__13[2] = 1, a__10[2] = sq; -#line 25520 "" +#line 25516 "" i__13[3] = 10, a__10[3] = "startpiece"; -#line 25520 "" +#line 25516 "" i__13[4] = 1, a__10[4] = sq; -#line 25520 "" +#line 25516 "" i__13[5] = 8, a__10[5] = "addspace"; -#line 25520 "" +#line 25516 "" i__13[6] = 1, a__10[6] = sq; -#line 25520 "" +#line 25516 "" i__13[7] = 14, a__10[7] = "afterruleskip%"; -#line 25520 "" +#line 25516 "" s_cat(ch__33, a__10, i__13, &c__8, (ftnlen)47); -#line 25520 "" +#line 25516 "" do_fio(&c__1, ch__33, (ftnlen)47); -#line 25520 "" +#line 25516 "" e_wsfe(); -#line 25522 "" +#line 25518 "" return 0; } /* topfile_ */ @@ -63921,19 +64210,19 @@ L4: /* Slur directions */ -#line 25530 "" +#line 25526 "" ntest = *nolev - *ncm; -#line 25531 "" +#line 25527 "" if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) { -#line 25533 "" +#line 25529 "" *(unsigned char *)ret_val = 'd'; -#line 25534 "" +#line 25530 "" } else { -#line 25535 "" +#line 25531 "" *(unsigned char *)ret_val = 'u'; -#line 25536 "" +#line 25532 "" } -#line 25537 "" +#line 25533 "" return ; } /* udfq_ */ @@ -63951,52 +64240,52 @@ L4: /* Stem direction for single notes */ -#line 25546 "" +#line 25542 "" if (bit_test(*isl,30)) { /* Absolute override */ -#line 25550 "" +#line 25546 "" if (bit_test(*isl,17)) { -#line 25551 "" +#line 25547 "" *(unsigned char *)udqqq = 'u'; -#line 25552 "" +#line 25548 "" } else { -#line 25553 "" +#line 25549 "" *(unsigned char *)udqqq = 'l'; -#line 25554 "" +#line 25550 "" } -#line 25555 "" +#line 25551 "" } else if (*nvmx == 1) { /* Single voice per staff, default */ -#line 25559 "" +#line 25555 "" r__1 = *nole * 1.f; -#line 25559 "" +#line 25555 "" ulfq_(ch__2, (ftnlen)1, &r__1, ncm); -#line 25559 "" +#line 25555 "" *(unsigned char *)udqqq = *(unsigned char *)&ch__2[0]; -#line 25560 "" +#line 25556 "" } else { /* Multi-voice per staff, 1st is lower, 2nd upper */ -#line 25564 "" +#line 25560 "" if (*ivx <= *nv) { -#line 25565 "" +#line 25561 "" *(unsigned char *)udqqq = 'l'; -#line 25566 "" +#line 25562 "" } else { -#line 25567 "" +#line 25563 "" *(unsigned char *)udqqq = 'u'; -#line 25568 "" +#line 25564 "" } -#line 25569 "" +#line 25565 "" } -#line 25570 "" +#line 25566 "" *(unsigned char *)ret_val = *(unsigned char *)udqqq; -#line 25571 "" +#line 25567 "" return ; } /* udqq_ */ @@ -64008,19 +64297,19 @@ L4: /* Stem directions */ -#line 25579 "" +#line 25575 "" test = *xnolev - *ncm; -#line 25580 "" +#line 25576 "" if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) { -#line 25582 "" +#line 25578 "" *(unsigned char *)ret_val = 'u'; -#line 25583 "" +#line 25579 "" } else { -#line 25584 "" +#line 25580 "" *(unsigned char *)ret_val = 'l'; -#line 25585 "" +#line 25581 "" } -#line 25586 "" +#line 25582 "" return ; } /* ulfq_ */ @@ -64045,37 +64334,37 @@ L4: static cilist io___1876 = { 0, 6, 0, 0, 0 }; -#line 25590 "" +#line 25586 "" if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) { -#line 25591 "" +#line 25587 "" i__1 = *(unsigned char *)chq - 32; -#line 25591 "" +#line 25587 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 25591 "" +#line 25587 "" *(unsigned char *)ret_val = *(unsigned char *)&ch__2[0]; -#line 25592 "" +#line 25588 "" } else { -#line 25593 "" +#line 25589 "" *(unsigned char *)ret_val = *(unsigned char *)chq; -#line 25594 "" +#line 25590 "" s_wsle(&io___1876); /* Writing concatenation */ -#line 25594 "" +#line 25590 "" i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"\ "rgument: "; -#line 25594 "" +#line 25590 "" i__2[1] = 1, a__1[1] = chq; -#line 25594 "" +#line 25590 "" s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53); -#line 25594 "" +#line 25590 "" do_lio(&c__9, &c__1, ch__3, (ftnlen)53); -#line 25594 "" +#line 25590 "" e_wsle(); -#line 25596 "" +#line 25592 "" s_stop("", (ftnlen)0); -#line 25597 "" +#line 25593 "" } -#line 25598 "" +#line 25594 "" return ; } /* upcaseq_ */ @@ -64110,23 +64399,50 @@ L4: /* Writes meter stuff to file 11, so only called if islast=.true. */ -#line 25605 "" +#line 25601 "" if (*mtrdnp == 0) { -#line 25605 "" +#line 25601 "" return 0; -#line 25605 "" +#line 25601 "" } -#line 25606 "" +#line 25602 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 25606 "" +#line 25602 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 25607 "" +#line 25603 "" if (*mtrnmp > 0 && *mtrnmp <= 9) { -#line 25608 "" +#line 25604 "" if (*mtrdnp < 10) { -#line 25609 "" +#line 25605 "" s_wsfe(&io___1878); /* Writing concatenation */ +#line 25605 "" + i__1[0] = 1, a__1[0] = sq; +#line 25605 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25605 "" + i__1[2] = 1, a__1[2] = sq; +#line 25605 "" + i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 25605 "" + s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 25605 "" + do_fio(&c__1, ch__2, (ftnlen)25); +#line 25605 "" + do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 25605 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 25605 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25605 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 25605 "" + e_wsfe(); +#line 25608 "" + } else { +#line 25609 "" + s_wsfe(&io___1879); +/* Writing concatenation */ #line 25609 "" i__1[0] = 1, a__1[0] = sq; #line 25609 "" @@ -64150,40 +64466,40 @@ L4: #line 25609 "" e_wsfe(); #line 25612 "" - } else { + } #line 25613 "" - s_wsfe(&io___1879); + } else if (*mtrnmp >= 10) { +#line 25614 "" + if (*mtrdnp < 10) { +#line 25615 "" + s_wsfe(&io___1880); /* Writing concatenation */ -#line 25613 "" +#line 25615 "" i__1[0] = 1, a__1[0] = sq; -#line 25613 "" +#line 25615 "" i__1[1] = 13, a__1[1] = "generalmeter{"; -#line 25613 "" +#line 25615 "" i__1[2] = 1, a__1[2] = sq; -#line 25613 "" +#line 25615 "" i__1[3] = 10, a__1[3] = "meterfrac{"; -#line 25613 "" +#line 25615 "" s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); -#line 25613 "" +#line 25615 "" do_fio(&c__1, ch__2, (ftnlen)25); -#line 25613 "" +#line 25615 "" do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); -#line 25613 "" +#line 25615 "" do_fio(&c__1, "}{", (ftnlen)2); -#line 25613 "" +#line 25615 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); -#line 25613 "" +#line 25615 "" do_fio(&c__1, "}}%", (ftnlen)3); -#line 25613 "" +#line 25615 "" e_wsfe(); -#line 25616 "" - } -#line 25617 "" - } else if (*mtrnmp >= 10) { #line 25618 "" - if (*mtrdnp < 10) { + } else { #line 25619 "" - s_wsfe(&io___1880); + s_wsfe(&io___1881); /* Writing concatenation */ #line 25619 "" i__1[0] = 1, a__1[0] = sq; @@ -64208,146 +64524,119 @@ L4: #line 25619 "" e_wsfe(); #line 25622 "" - } else { -#line 25623 "" - s_wsfe(&io___1881); -/* Writing concatenation */ -#line 25623 "" - i__1[0] = 1, a__1[0] = sq; -#line 25623 "" - i__1[1] = 13, a__1[1] = "generalmeter{"; -#line 25623 "" - i__1[2] = 1, a__1[2] = sq; -#line 25623 "" - i__1[3] = 10, a__1[3] = "meterfrac{"; -#line 25623 "" - s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); -#line 25623 "" - do_fio(&c__1, ch__2, (ftnlen)25); -#line 25623 "" - do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); -#line 25623 "" - do_fio(&c__1, "}{", (ftnlen)2); -#line 25623 "" - do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); -#line 25623 "" - do_fio(&c__1, "}}%", (ftnlen)3); -#line 25623 "" - e_wsfe(); -#line 25626 "" } -#line 25627 "" +#line 25623 "" } else if (*mtrnmp < 0) { -#line 25628 "" +#line 25624 "" s_wsfe(&io___1882); /* Writing concatenation */ -#line 25628 "" +#line 25624 "" i__1[0] = 1, a__1[0] = sq; -#line 25628 "" +#line 25624 "" i__1[1] = 13, a__1[1] = "generalmeter{"; -#line 25628 "" +#line 25624 "" i__1[2] = 1, a__1[2] = sq; -#line 25628 "" +#line 25624 "" i__1[3] = 11, a__1[3] = "meterfracS{"; -#line 25628 "" +#line 25624 "" s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26); -#line 25628 "" +#line 25624 "" do_fio(&c__1, ch__3, (ftnlen)26); -#line 25628 "" +#line 25624 "" i__2 = -(*mtrnmp); -#line 25628 "" +#line 25624 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 25628 "" +#line 25624 "" do_fio(&c__1, "}{", (ftnlen)2); -#line 25628 "" +#line 25624 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); -#line 25628 "" +#line 25624 "" do_fio(&c__1, "}}%", (ftnlen)3); -#line 25628 "" +#line 25624 "" e_wsfe(); -#line 25631 "" +#line 25627 "" } else if (*mtrdnp <= 4) { -#line 25632 "" +#line 25628 "" s_wsfe(&io___1883); /* Writing concatenation */ -#line 25632 "" +#line 25628 "" i__1[0] = 1, a__1[0] = sq; -#line 25632 "" +#line 25628 "" i__1[1] = 13, a__1[1] = "generalmeter{"; -#line 25632 "" +#line 25628 "" i__1[2] = 1, a__1[2] = sq; -#line 25632 "" +#line 25628 "" i__1[3] = 6, a__1[3] = "meterN"; -#line 25632 "" +#line 25628 "" s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); -#line 25632 "" +#line 25628 "" do_fio(&c__1, ch__4, (ftnlen)21); -#line 25632 "" +#line 25628 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); -#line 25632 "" +#line 25628 "" do_fio(&c__1, "}%", (ftnlen)2); -#line 25632 "" +#line 25628 "" e_wsfe(); -#line 25634 "" +#line 25630 "" } else if (*mtrdnp == 5) { -#line 25635 "" +#line 25631 "" s_wsfe(&io___1884); /* Writing concatenation */ -#line 25635 "" +#line 25631 "" i__1[0] = 1, a__1[0] = sq; -#line 25635 "" +#line 25631 "" i__1[1] = 12, a__1[1] = "generalmeter"; -#line 25635 "" +#line 25631 "" i__1[2] = 1, a__1[2] = sq; -#line 25635 "" +#line 25631 "" i__1[3] = 10, a__1[3] = "allabreve%"; -#line 25635 "" +#line 25631 "" s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); -#line 25635 "" +#line 25631 "" do_fio(&c__1, ch__5, (ftnlen)24); -#line 25635 "" +#line 25631 "" e_wsfe(); -#line 25636 "" +#line 25632 "" } else if (*mtrdnp == 6) { -#line 25637 "" +#line 25633 "" s_wsfe(&io___1885); /* Writing concatenation */ -#line 25637 "" +#line 25633 "" i__1[0] = 1, a__1[0] = sq; -#line 25637 "" +#line 25633 "" i__1[1] = 12, a__1[1] = "generalmeter"; -#line 25637 "" +#line 25633 "" i__1[2] = 1, a__1[2] = sq; -#line 25637 "" +#line 25633 "" i__1[3] = 7, a__1[3] = "meterC%"; -#line 25637 "" +#line 25633 "" s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); -#line 25637 "" +#line 25633 "" do_fio(&c__1, ch__4, (ftnlen)21); -#line 25637 "" +#line 25633 "" e_wsfe(); -#line 25638 "" +#line 25634 "" } else if (*mtrdnp == 7) { -#line 25639 "" +#line 25635 "" s_wsfe(&io___1886); /* Writing concatenation */ -#line 25639 "" +#line 25635 "" i__1[0] = 1, a__1[0] = sq; -#line 25639 "" +#line 25635 "" i__1[1] = 12, a__1[1] = "generalmeter"; -#line 25639 "" +#line 25635 "" i__1[2] = 1, a__1[2] = sq; -#line 25639 "" +#line 25635 "" i__1[3] = 10, a__1[3] = "meterIIIS%"; -#line 25639 "" +#line 25635 "" s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); -#line 25639 "" +#line 25635 "" do_fio(&c__1, ch__5, (ftnlen)24); -#line 25639 "" +#line 25635 "" e_wsfe(); -#line 25640 "" +#line 25636 "" } -#line 25641 "" +#line 25637 "" return 0; } /* wgmeter_ */ @@ -64406,8 +64695,6 @@ L4: static cilist io___1921 = { 0, 52, 0, "(z4)", 0 }; static cilist io___1922 = { 0, 51, 0, "(a,$)", 0 }; static cilist io___1923 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1924 = { 0, 6, 0, "(1x,a12,(10i6))", 0 }; - static cilist io___1925 = { 0, 15, 0, "(1x,a12,(10i6))", 0 }; @@ -64419,705 +64706,693 @@ L4: /* Write Header */ -#line 25694 "" +#line 25690 "" s_wsfe(&io___1888); /* Writing concatenation */ -#line 25694 "" +#line 25690 "" i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000"; -#line 25694 "" +#line 25690 "" *(unsigned char *)&ch__2[0] = commidi_1.numchan + 1; -#line 25694 "" +#line 25690 "" i__1[1] = 1, a__1[1] = ch__2; -#line 25694 "" +#line 25690 "" i__1[2] = 1, a__1[2] = "\000"; -#line 25694 "" +#line 25690 "" i__1[3] = 1, a__1[3] = "\360"; -#line 25694 "" +#line 25690 "" s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14); -#line 25694 "" +#line 25690 "" do_fio(&c__1, ch__1, (ftnlen)14); -#line 25694 "" +#line 25690 "" e_wsfe(); -#line 25696 "" +#line 25692 "" if (commidi_1.debugmidi) { -#line 25696 "" +#line 25692 "" s_wsfe(&io___1889); -#line 25696 "" +#line 25692 "" do_fio(&c__1, "\"MThd\"", (ftnlen)6); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" i__2 = commidi_1.numchan + 1; -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer)); -#line 25696 "" +#line 25692 "" e_wsfe(); -#line 25696 "" +#line 25692 "" } /* Write the "conductor" track, for keys, meter, and tempos */ /* Get the number of bytes in the conductor event stream */ -#line 25703 "" +#line 25699 "" ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[ commidi_1.numchan + commmac_1.nmidsec * 25 - 25]; -#line 25704 "" +#line 25700 "" i__2 = commmac_1.nmidsec - 1; -#line 25704 "" +#line 25700 "" for (isec = 1; isec <= i__2; ++isec) { -#line 25705 "" +#line 25701 "" ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 - 25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; -#line 25706 "" +#line 25702 "" /* L15: */ -#line 25706 "" +#line 25702 "" } /* ib1 = (4+ljob+26+ndata+4)/256 */ /* ib0 = 4+ljob+26+ndata+4-256*ib1 */ -#line 25709 "" +#line 25705 "" ib1 = (*ljob + 31 + ndata + 4) / 256; -#line 25710 "" +#line 25706 "" ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8); -#line 25711 "" +#line 25707 "" s_wsfe(&io___1894); /* Writing concatenation */ -#line 25711 "" +#line 25707 "" i__3[0] = 6, a__2[0] = "MTrk\000\000"; -#line 25711 "" +#line 25707 "" *(unsigned char *)&ch__2[0] = ib1; -#line 25711 "" +#line 25707 "" i__3[1] = 1, a__2[1] = ch__2; -#line 25711 "" +#line 25707 "" *(unsigned char *)&ch__4[0] = ib0; -#line 25711 "" +#line 25707 "" i__3[2] = 1, a__2[2] = ch__4; -#line 25711 "" +#line 25707 "" i__3[3] = 1, a__2[3] = "\000"; -#line 25711 "" +#line 25707 "" i__3[4] = 1, a__2[4] = "\377"; -#line 25711 "" +#line 25707 "" i__3[5] = 1, a__2[5] = "\001"; -#line 25711 "" +#line 25707 "" *(unsigned char *)&ch__5[0] = *ljob + 27; -#line 25711 "" +#line 25707 "" i__3[6] = 1, a__2[6] = ch__5; -#line 25711 "" +#line 25707 "" s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12); -#line 25711 "" +#line 25707 "" do_fio(&c__1, ch__3, (ftnlen)12); -#line 25711 "" +#line 25707 "" e_wsfe(); /* Text header */ /* * //char(0)//char(255)//char(1)//char(ljob+26) */ -#line 25717 "" +#line 25713 "" if (commidi_1.debugmidi) { -#line 25717 "" +#line 25713 "" s_wsfe(&io___1895); -#line 25717 "" +#line 25713 "" do_fio(&c__1, "\"MTrk\"", (ftnlen)6); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" i__2 = *ljob + 27; -#line 25717 "" +#line 25713 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 25717 "" +#line 25713 "" e_wsfe(); -#line 25717 "" +#line 25713 "" } -#line 25720 "" +#line 25716 "" s_wsfe(&io___1896); -#line 25720 "" +#line 25716 "" do_fio(&c__1, jobname, (*ljob)); -#line 25720 "" +#line 25716 "" e_wsfe(); -#line 25721 "" +#line 25717 "" if (commidi_1.debugmidi) { -#line 25721 "" +#line 25717 "" s_wsfe(&io___1897); /* Writing concatenation */ -#line 25721 "" - i__4[0] = 1, a__3[0] = "\""; -#line 25721 "" +#line 25717 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 25717 "" + i__4[0] = 1, a__3[0] = ch__2; +#line 25717 "" i__4[1] = *ljob, a__3[1] = jobname; -#line 25721 "" - i__4[2] = 1, a__3[2] = "\""; -#line 25721 "" +#line 25717 "" + chax_(ch__4, (ftnlen)1, &c__34); +#line 25717 "" + i__4[2] = 1, a__3[2] = ch__4; +#line 25717 "" s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46); -#line 25721 "" +#line 25717 "" do_fio(&c__1, ch__6, *ljob + 2); -#line 25721 "" +#line 25717 "" e_wsfe(); -#line 25721 "" +#line 25717 "" } /* (separate writes are needed to defeat compiler BUG!!!) */ -/* write(51,'(a,$)')'.mid, produced by PMX 2.30' */ -#line 25726 "" +#line 25721 "" s_wsfe(&io___1898); /* Writing concatenation */ -#line 25726 "" +#line 25721 "" i__5[0] = 22, a__4[0] = ".mid, produced by PMX "; -#line 25726 "" +#line 25721 "" i__5[1] = 5, a__4[1] = comver_1.versionc; -#line 25726 "" +#line 25721 "" s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27); -#line 25726 "" +#line 25721 "" do_fio(&c__1, ch__7, (ftnlen)27); -#line 25726 "" +#line 25721 "" e_wsfe(); -#line 25727 "" +#line 25722 "" if (commidi_1.debugmidi) { -#line 25727 "" +#line 25722 "" s_wsfe(&io___1899); /* Writing concatenation */ -#line 25727 "" - i__4[0] = 23, a__3[0] = "\".mid, produced by PMX "; -#line 25727 "" - i__4[1] = 5, a__3[1] = comver_1.versionc; -#line 25727 "" - i__4[2] = 1, a__3[2] = "\""; -#line 25727 "" - s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29); -#line 25727 "" +#line 25722 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 25722 "" + i__1[0] = 1, a__1[0] = ch__2; +#line 25722 "" + i__1[1] = 22, a__1[1] = ".mid, produced by PMX "; +#line 25722 "" + i__1[2] = 5, a__1[2] = comver_1.versionc; +#line 25722 "" + chax_(ch__4, (ftnlen)1, &c__34); +#line 25722 "" + i__1[3] = 1, a__1[3] = ch__4; +#line 25722 "" + s_cat(ch__8, a__1, i__1, &c__4, (ftnlen)29); +#line 25722 "" do_fio(&c__1, ch__8, (ftnlen)29); -#line 25727 "" +#line 25722 "" e_wsfe(); -#line 25727 "" +#line 25722 "" } /* Conductor event data: Loop over sections. */ -#line 25732 "" +#line 25727 "" i__2 = commmac_1.nmidsec; -#line 25732 "" +#line 25727 "" for (isec = 1; isec <= i__2; ++isec) { -#line 25733 "" +#line 25728 "" if (isec < commmac_1.nmidsec) { -#line 25734 "" +#line 25729 "" mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25]; -#line 25735 "" +#line 25730 "" } else { -#line 25736 "" +#line 25731 "" mend = commidi_1.imidi[commidi_1.numchan]; -#line 25737 "" +#line 25732 "" } -#line 25738 "" +#line 25733 "" i__6 = mend; -#line 25738 "" +#line 25733 "" for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; i__ <= i__6; ++i__) { -#line 25739 "" +#line 25734 "" s_wsfe(&io___1902); -#line 25739 "" +#line 25734 "" *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[ commidi_1.numchan + i__ * 25 - 25]; -#line 25739 "" +#line 25734 "" do_fio(&c__1, ch__2, (ftnlen)1); -#line 25739 "" +#line 25734 "" e_wsfe(); -#line 25740 "" +#line 25735 "" if (commidi_1.debugmidi) { -#line 25740 "" +#line 25735 "" s_wsfe(&io___1903); -#line 25740 "" +#line 25735 "" do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan + i__ * 25 - 25], (ftnlen)sizeof(shortint)); -#line 25740 "" +#line 25735 "" e_wsfe(); -#line 25740 "" +#line 25735 "" } -#line 25741 "" +#line 25736 "" /* L17: */ -#line 25741 "" +#line 25736 "" } -#line 25742 "" +#line 25737 "" /* L16: */ -#line 25742 "" +#line 25737 "" } /* And close out the time sig / tempo track. */ -#line 25746 "" +#line 25741 "" s_wsfe(&io___1904); -#line 25746 "" +#line 25741 "" do_fio(&c__1, "\000\377/\000", (ftnlen)4); -#line 25746 "" +#line 25741 "" e_wsfe(); -#line 25747 "" +#line 25742 "" if (commidi_1.debugmidi) { -#line 25747 "" +#line 25742 "" s_wsfe(&io___1905); -#line 25747 "" +#line 25742 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25747 "" +#line 25742 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); -#line 25747 "" +#line 25742 "" do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); -#line 25747 "" +#line 25742 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25747 "" +#line 25742 "" e_wsfe(); -#line 25747 "" +#line 25742 "" } /* Loop over track for each voice: The following sets up iv. */ -#line 25751 "" +#line 25746 "" all_1.iv = all_1.nv; -#line 25752 "" +#line 25747 "" if (commidi_1.twoline[all_1.nv - 1]) { -#line 25753 "" +#line 25748 "" kv = 2; -#line 25754 "" +#line 25749 "" } else { -#line 25755 "" +#line 25750 "" kv = 1; -#line 25756 "" +#line 25751 "" } -#line 25758 "" +#line 25753 "" i__2 = commidi_1.numchan - 1; -#line 25758 "" +#line 25753 "" for (icm = 0; icm <= i__2; ++icm) { /* Get the number of bytes in the data stream */ -#line 25762 "" +#line 25757 "" ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm + commmac_1.nmidsec * 25 - 25]; -#line 25763 "" +#line 25758 "" i__6 = commmac_1.nmidsec - 1; -#line 25763 "" +#line 25758 "" for (isec = 1; isec <= i__6; ++isec) { -#line 25764 "" +#line 25759 "" ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] - commmac_1.msecstrt[icm + isec * 25 - 25]; -#line 25765 "" +#line 25760 "" /* L11: */ -#line 25765 "" +#line 25760 "" } /* Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, */ -#line 25769 "" +#line 25764 "" ndata += 11; /* Add 4+lnam(iinsiv(iv)) if lnam>0 , */ -#line 25773 "" +#line 25768 "" if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { -#line 25773 "" +#line 25768 "" ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1]; -#line 25773 "" +#line 25768 "" } /* Separate total byte counts into 4 bytes */ -#line 25777 "" +#line 25772 "" for (ibyte = 1; ibyte <= 4; ++ibyte) { -#line 25778 "" +#line 25773 "" if (ndata > 0) { -#line 25779 "" +#line 25774 "" *(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256); -#line 25780 "" +#line 25775 "" ndata = lbit_shift(ndata, (ftnlen)-8); -#line 25781 "" +#line 25776 "" } else { -#line 25782 "" +#line 25777 "" *(unsigned char *)&byteq[ibyte - 1] = '\0'; -#line 25783 "" +#line 25778 "" } -#line 25784 "" +#line 25779 "" /* L2: */ -#line 25784 "" +#line 25779 "" } /* Now write front stuff for this track */ -#line 25788 "" +#line 25783 "" s_wsfe(&io___1910); /* Writing concatenation */ -#line 25788 "" +#line 25783 "" i__7[0] = 4, a__5[0] = "MTrk"; -#line 25788 "" +#line 25783 "" i__7[1] = 1, a__5[1] = byteq + 3; -#line 25788 "" +#line 25783 "" i__7[2] = 1, a__5[2] = byteq + 2; -#line 25788 "" +#line 25783 "" i__7[3] = 1, a__5[3] = byteq + 1; -#line 25788 "" +#line 25783 "" i__7[4] = 1, a__5[4] = byteq; -#line 25788 "" +#line 25783 "" i__7[5] = 1, a__5[5] = "\000"; -#line 25788 "" +#line 25783 "" *(unsigned char *)&ch__2[0] = icmm[icm] + 192; -#line 25788 "" +#line 25783 "" i__7[6] = 1, a__5[6] = ch__2; -#line 25788 "" +#line 25783 "" *(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[ all_1.iv - 1] - 1]; -#line 25788 "" +#line 25783 "" i__7[7] = 1, a__5[7] = ch__4; -#line 25788 "" +#line 25783 "" i__7[8] = 1, a__5[8] = "\000"; -#line 25788 "" +#line 25783 "" *(unsigned char *)&ch__5[0] = icmm[icm] + 176; -#line 25788 "" +#line 25783 "" i__7[9] = 1, a__5[9] = ch__5; -#line 25788 "" +#line 25783 "" i__7[10] = 1, a__5[10] = "\n"; -#line 25788 "" +#line 25783 "" *(unsigned char *)&ch__10[0] = commvel_1.midbc[icm]; -#line 25788 "" +#line 25783 "" i__7[11] = 1, a__5[11] = ch__10; -#line 25788 "" +#line 25783 "" s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15); -#line 25788 "" +#line 25783 "" do_fio(&c__1, ch__9, (ftnlen)15); -#line 25788 "" +#line 25783 "" e_wsfe(); -#line 25791 "" +#line 25786 "" if (commidi_1.debugmidi) { -#line 25791 "" +#line 25786 "" s_wsfe(&io___1911); -#line 25791 "" +#line 25786 "" do_fio(&c__1, "icm=", (ftnlen)4); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, " \"MTrk\"", (ftnlen)7); -#line 25791 "" +#line 25786 "" i__6 = *(unsigned char *)&byteq[3]; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" i__8 = *(unsigned char *)&byteq[2]; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" i__9 = *(unsigned char *)&byteq[1]; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" i__10 = *(unsigned char *)&byteq[0]; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" i__11 = icmm[icm] + 192; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[ all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" i__12 = icmm[icm] + 176; -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer)); -#line 25791 "" +#line 25786 "" do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof( integer)); -#line 25791 "" +#line 25786 "" e_wsfe(); -#line 25791 "" +#line 25786 "" } -#line 25795 "" +#line 25790 "" if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { /* Add instrument name as sequence name */ -#line 25799 "" +#line 25794 "" s_wsfe(&io___1912); /* Writing concatenation */ -#line 25799 "" +#line 25794 "" i__5[0] = 3, a__4[0] = "\000\377\003"; -#line 25799 "" +#line 25794 "" *(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[ all_1.iv - 1] - 1]; -#line 25799 "" +#line 25794 "" i__5[1] = 1, a__4[1] = ch__2; -#line 25799 "" +#line 25794 "" s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4); -#line 25799 "" +#line 25794 "" do_fio(&c__1, ch__11, (ftnlen)4); -#line 25799 "" +#line 25794 "" e_wsfe(); -#line 25801 "" +#line 25796 "" if (commidi_1.debugmidi) { -#line 25801 "" +#line 25796 "" s_wsfe(&io___1913); -#line 25801 "" +#line 25796 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25801 "" +#line 25796 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); -#line 25801 "" +#line 25796 "" do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer)); -#line 25801 "" +#line 25796 "" do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[ all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); -#line 25801 "" +#line 25796 "" e_wsfe(); -#line 25801 "" +#line 25796 "" } -#line 25802 "" +#line 25797 "" s_wsfe(&io___1914); -#line 25802 "" +#line 25797 "" do_fio(&c__1, comtop_1.inameq + (commvel_1.iinsiv[all_1.iv - 1] - 1) * 79, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] ); -#line 25802 "" +#line 25797 "" e_wsfe(); -#line 25804 "" +#line 25799 "" if (commidi_1.debugmidi) { -#line 25804 "" +#line 25799 "" s_wsfe(&io___1915); /* Writing concatenation */ -#line 25804 "" - i__4[0] = 1, a__3[0] = "\""; -#line 25804 "" +#line 25799 "" + chax_(ch__2, (ftnlen)1, &c__34); +#line 25799 "" + i__4[0] = 1, a__3[0] = ch__2; +#line 25799 "" i__4[1] = comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1], a__3[1] = comtop_1.inameq + (commvel_1.iinsiv[ all_1.iv - 1] - 1) * 79; -#line 25804 "" - i__4[2] = 1, a__3[2] = "\""; -#line 25804 "" +#line 25799 "" + chax_(ch__4, (ftnlen)1, &c__34); +#line 25799 "" + i__4[2] = 1, a__3[2] = ch__4; +#line 25799 "" s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81); -#line 25804 "" +#line 25799 "" do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] + 2); -#line 25804 "" +#line 25799 "" e_wsfe(); -#line 25804 "" +#line 25799 "" } -#line 25806 "" +#line 25801 "" } -#line 25807 "" +#line 25802 "" s_wsfi(&io___1917); -#line 25807 "" +#line 25802 "" do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); -#line 25807 "" +#line 25802 "" e_wsfi(); -#line 25808 "" +#line 25803 "" s_wsfi(&io___1919); -#line 25808 "" +#line 25803 "" do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); -#line 25808 "" +#line 25803 "" e_wsfi(); /* Writing concatenation */ -#line 25809 "" +#line 25804 "" i__1[0] = 16, a__1[0] = "MIDI instrument "; -#line 25809 "" +#line 25804 "" i__1[1] = 2, a__1[1] = tempoq; -#line 25809 "" +#line 25804 "" i__1[2] = 4, a__1[2] = " is "; -#line 25809 "" +#line 25804 "" i__1[3] = 3, a__1[3] = instq; -#line 25809 "" +#line 25804 "" s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25); -#line 25809 "" +#line 25804 "" printl_(ch__13, (ftnlen)25); /* Notes: Loop over sections. */ -#line 25813 "" +#line 25808 "" i__6 = commmac_1.nmidsec; -#line 25813 "" +#line 25808 "" for (isec = 1; isec <= i__6; ++isec) { -#line 25814 "" +#line 25809 "" if (isec < commmac_1.nmidsec) { -#line 25815 "" +#line 25810 "" mend = commmac_1.msecend[icm + isec * 25 - 25]; -#line 25816 "" +#line 25811 "" } else { -#line 25817 "" +#line 25812 "" mend = commidi_1.imidi[icm]; -#line 25818 "" +#line 25813 "" } -#line 25819 "" +#line 25814 "" i__8 = mend; -#line 25819 "" +#line 25814 "" for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8; ++i__) { -#line 25820 "" +#line 25815 "" s_wsfe(&io___1920); -#line 25820 "" +#line 25815 "" *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm + i__ * 25 - 25]; -#line 25820 "" +#line 25815 "" do_fio(&c__1, ch__2, (ftnlen)1); -#line 25820 "" +#line 25815 "" e_wsfe(); -#line 25821 "" +#line 25816 "" if (commidi_1.debugmidi) { -#line 25821 "" +#line 25816 "" s_wsfe(&io___1921); -#line 25821 "" +#line 25816 "" do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 - 25], (ftnlen)sizeof(shortint)); -#line 25821 "" +#line 25816 "" e_wsfe(); -#line 25821 "" +#line 25816 "" } -#line 25822 "" +#line 25817 "" /* L10: */ -#line 25822 "" +#line 25817 "" } -#line 25823 "" +#line 25818 "" /* L9: */ -#line 25823 "" +#line 25818 "" } /* Closing 4 bytes */ -#line 25827 "" +#line 25822 "" s_wsfe(&io___1922); /* Writing concatenation */ -#line 25827 "" +#line 25822 "" chax_(ch__2, (ftnlen)1, &c__0); -#line 25827 "" +#line 25822 "" i__1[0] = 1, a__1[0] = ch__2; -#line 25827 "" +#line 25822 "" i__1[1] = 1, a__1[1] = "\377"; -#line 25827 "" +#line 25822 "" i__1[2] = 1, a__1[2] = "/"; -#line 25827 "" +#line 25822 "" i__1[3] = 1, a__1[3] = "\000"; -#line 25827 "" +#line 25822 "" s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4); -#line 25827 "" +#line 25822 "" do_fio(&c__1, ch__11, (ftnlen)4); -#line 25827 "" +#line 25822 "" e_wsfe(); -#line 25828 "" +#line 25823 "" if (commidi_1.debugmidi) { -#line 25828 "" +#line 25823 "" s_wsfe(&io___1923); -#line 25828 "" +#line 25823 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25828 "" +#line 25823 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); -#line 25828 "" +#line 25823 "" do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); -#line 25828 "" +#line 25823 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); -#line 25828 "" +#line 25823 "" e_wsfe(); -#line 25828 "" +#line 25823 "" } -#line 25829 "" +#line 25824 "" if (kv == 2) { -#line 25830 "" +#line 25825 "" kv = 1; -#line 25831 "" +#line 25826 "" } else if (all_1.iv == 1) { -#line 25832 "" +#line 25827 "" goto L5; -#line 25833 "" +#line 25828 "" } else { -#line 25834 "" +#line 25829 "" --all_1.iv; -#line 25835 "" +#line 25830 "" if (commidi_1.twoline[all_1.iv - 1]) { -#line 25835 "" +#line 25830 "" kv = 2; -#line 25835 "" +#line 25830 "" } -#line 25836 "" +#line 25831 "" } -#line 25837 "" +#line 25832 "" L5: -#line 25837 "" +#line 25832 "" ; -#line 25837 "" - } -#line 25838 "" - s_wsfe(&io___1924); -#line 25838 "" - do_fio(&c__1, "Bytes used:", (ftnlen)11); -#line 25838 "" - i__2 = commidi_1.numchan; -#line 25838 "" - for (icm = 0; icm <= i__2; ++icm) { -#line 25838 "" - do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); -#line 25838 "" - } -#line 25838 "" - e_wsfe(); -#line 25839 "" - s_wsfe(&io___1925); -#line 25839 "" - do_fio(&c__1, "Bytes used:", (ftnlen)11); -#line 25839 "" - i__2 = commidi_1.numchan; -#line 25839 "" - for (icm = 0; icm <= i__2; ++icm) { -#line 25839 "" - do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); -#line 25839 "" +#line 25832 "" } -#line 25839 "" - e_wsfe(); -#line 25841 "" +/* write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan) */ +/* write(15,'(1x,a12,(10i6))') */ +/* * 'Bytes used:',(imidi(icm),icm=0,numchan) */ +#line 25836 "" cl__1.cerr = 0; -#line 25841 "" +#line 25836 "" cl__1.cunit = 51; -#line 25841 "" +#line 25836 "" cl__1.csta = 0; -#line 25841 "" +#line 25836 "" f_clos(&cl__1); -#line 25842 "" +#line 25837 "" if (commidi_1.debugmidi) { -#line 25842 "" +#line 25837 "" cl__1.cerr = 0; -#line 25842 "" +#line 25837 "" cl__1.cunit = 52; -#line 25842 "" +#line 25837 "" cl__1.csta = 0; -#line 25842 "" +#line 25837 "" f_clos(&cl__1); -#line 25842 "" +#line 25837 "" } -#line 25843 "" +#line 25838 "" return 0; } /* writemidi_ */ @@ -65142,143 +65417,143 @@ L5: static char notexq[79]; /* Fortran I/O blocks */ - static cilist io___1929 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1927 = { 0, 11, 0, "(a)", 0 }; /* Assumes notexq is blank */ -#line 25854 "" +#line 25849 "" /* Parameter adjustments */ -#line 25854 "" +#line 25849 "" --itranskey; -#line 25854 "" +#line 25849 "" --iinsttrans; -#line 25854 "" +#line 25849 "" -#line 25854 "" +#line 25849 "" /* Function Body */ -#line 25854 "" +#line 25849 "" i__1 = *ninsttrans; -#line 25854 "" +#line 25849 "" for (i__ = 1; i__ <= i__1; ++i__) { /* Writing concatenation */ -#line 25855 "" +#line 25850 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 25855 "" +#line 25850 "" i__2[0] = 1, a__1[0] = ch__1; -#line 25855 "" +#line 25850 "" i__2[1] = 7, a__1[1] = "setsign"; -#line 25855 "" +#line 25850 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 25856 "" +#line 25851 "" lnote = 8; -#line 25857 "" +#line 25852 "" if (iinsttrans[i__] < 10) { /* Writing concatenation */ -#line 25858 "" +#line 25853 "" i__2[0] = lnote, a__1[0] = notexq; -#line 25858 "" +#line 25853 "" i__3 = iinsttrans[i__] + 48; -#line 25858 "" +#line 25853 "" chax_(ch__1, (ftnlen)1, &i__3); -#line 25858 "" +#line 25853 "" i__2[1] = 1, a__1[1] = ch__1; -#line 25858 "" +#line 25853 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 25859 "" +#line 25854 "" ++lnote; -#line 25860 "" +#line 25855 "" } else { -#line 25861 "" +#line 25856 "" i__3 = lnote; -#line 25861 "" +#line 25856 "" ici__1.icierr = 0; -#line 25861 "" +#line 25856 "" ici__1.icirnum = 1; -#line 25861 "" +#line 25856 "" ici__1.icirlen = lnote + 4 - i__3; -#line 25861 "" +#line 25856 "" ici__1.iciunit = notexq + i__3; -#line 25861 "" +#line 25856 "" ici__1.icifmt = "(a1,i2,a1)"; -#line 25861 "" +#line 25856 "" s_wsfi(&ici__1); -#line 25861 "" +#line 25856 "" do_fio(&c__1, "{", (ftnlen)1); -#line 25861 "" +#line 25856 "" do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer)); -#line 25861 "" +#line 25856 "" do_fio(&c__1, "}", (ftnlen)1); -#line 25861 "" +#line 25856 "" e_wsfi(); -#line 25863 "" +#line 25858 "" lnote += 4; -#line 25864 "" +#line 25859 "" } -#line 25865 "" +#line 25860 "" if (itranskey[i__] < 0) { -#line 25866 "" +#line 25861 "" i__3 = lnote; -#line 25866 "" +#line 25861 "" ici__1.icierr = 0; -#line 25866 "" +#line 25861 "" ici__1.icirnum = 1; -#line 25866 "" +#line 25861 "" ici__1.icirlen = lnote + 4 - i__3; -#line 25866 "" +#line 25861 "" ici__1.iciunit = notexq + i__3; -#line 25866 "" +#line 25861 "" ici__1.icifmt = "(a1,i2,a1)"; -#line 25866 "" +#line 25861 "" s_wsfi(&ici__1); -#line 25866 "" +#line 25861 "" do_fio(&c__1, "{", (ftnlen)1); -#line 25866 "" +#line 25861 "" do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer)); -#line 25866 "" +#line 25861 "" do_fio(&c__1, "}", (ftnlen)1); -#line 25866 "" +#line 25861 "" e_wsfi(); -#line 25868 "" +#line 25863 "" lnote += 4; -#line 25869 "" +#line 25864 "" } else { /* Writing concatenation */ -#line 25870 "" +#line 25865 "" i__2[0] = lnote, a__1[0] = notexq; -#line 25870 "" +#line 25865 "" i__3 = itranskey[i__] + 48; -#line 25870 "" +#line 25865 "" chax_(ch__1, (ftnlen)1, &i__3); -#line 25870 "" +#line 25865 "" i__2[1] = 1, a__1[1] = ch__1; -#line 25870 "" +#line 25865 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); -#line 25871 "" +#line 25866 "" ++lnote; -#line 25872 "" +#line 25867 "" } -#line 25873 "" - s_wsfe(&io___1929); +#line 25868 "" + s_wsfe(&io___1927); /* Writing concatenation */ -#line 25873 "" +#line 25868 "" i__2[0] = lnote, a__1[0] = notexq; -#line 25873 "" +#line 25868 "" i__2[1] = 1, a__1[1] = "%"; -#line 25873 "" +#line 25868 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80); -#line 25873 "" +#line 25868 "" do_fio(&c__1, ch__2, lnote + 1); -#line 25873 "" +#line 25868 "" e_wsfe(); -#line 25874 "" +#line 25869 "" /* L1: */ -#line 25874 "" +#line 25869 "" } -#line 25875 "" +#line 25870 "" *flag__ = FALSE_; -#line 25876 "" +#line 25871 "" return 0; } /* writesetsign_ */ @@ -65293,75 +65568,75 @@ L5: integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) ; -#line 25880 "" +#line 25875 "" if (*x < .95f) { -#line 25881 "" +#line 25876 "" i__1 = *lenline; -#line 25881 "" +#line 25876 "" ici__1.icierr = 0; -#line 25881 "" +#line 25876 "" ici__1.icirnum = 1; -#line 25881 "" +#line 25876 "" ici__1.icirlen = *lenline + 2 - i__1; -#line 25881 "" +#line 25876 "" ici__1.iciunit = notexq + i__1; -#line 25881 "" +#line 25876 "" ici__1.icifmt = "(f2.1)"; -#line 25881 "" +#line 25876 "" s_wsfi(&ici__1); -#line 25881 "" +#line 25876 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); -#line 25881 "" +#line 25876 "" e_wsfi(); -#line 25882 "" +#line 25877 "" *lenline += 2; -#line 25883 "" +#line 25878 "" } else if (*x < 9.95f) { -#line 25884 "" +#line 25879 "" i__1 = *lenline; -#line 25884 "" +#line 25879 "" ici__1.icierr = 0; -#line 25884 "" +#line 25879 "" ici__1.icirnum = 1; -#line 25884 "" +#line 25879 "" ici__1.icirlen = *lenline + 3 - i__1; -#line 25884 "" +#line 25879 "" ici__1.iciunit = notexq + i__1; -#line 25884 "" +#line 25879 "" ici__1.icifmt = "(f3.1)"; -#line 25884 "" +#line 25879 "" s_wsfi(&ici__1); -#line 25884 "" +#line 25879 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); -#line 25884 "" +#line 25879 "" e_wsfi(); -#line 25885 "" +#line 25880 "" *lenline += 3; -#line 25886 "" +#line 25881 "" } else { -#line 25887 "" +#line 25882 "" i__1 = *lenline; -#line 25887 "" +#line 25882 "" ici__1.icierr = 0; -#line 25887 "" +#line 25882 "" ici__1.icirnum = 1; -#line 25887 "" +#line 25882 "" ici__1.icirlen = *lenline + 4 - i__1; -#line 25887 "" +#line 25882 "" ici__1.iciunit = notexq + i__1; -#line 25887 "" +#line 25882 "" ici__1.icifmt = "(f4.1)"; -#line 25887 "" +#line 25882 "" s_wsfi(&ici__1); -#line 25887 "" +#line 25882 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); -#line 25887 "" +#line 25882 "" e_wsfi(); -#line 25888 "" +#line 25883 "" *lenline += 4; -#line 25889 "" +#line 25884 "" } -#line 25890 "" +#line 25885 "" return 0; } /* writflot_ */ @@ -65389,12 +65664,12 @@ L5: extern integer numclef_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1932 = { 0, 6, 0, 0, 0 }; - static cilist io___1933 = { 0, 6, 0, 0, 0 }; - static icilist io___1937 = { 0, temq, 0, "(a9,i2,a1)", 40, 1 }; + static cilist io___1930 = { 0, 6, 0, 0, 0 }; + static cilist io___1931 = { 0, 6, 0, 0, 0 }; + static icilist io___1935 = { 0, temq, 0, "(a9,i2,a1)", 40, 1 }; + static cilist io___1936 = { 0, 11, 0, "(a)", 0 }; static cilist io___1938 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1940 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1941 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1939 = { 0, 11, 0, "(a)", 0 }; /* subroutine wsclef(iv,ninow,clefq,nclef) */ @@ -65405,209 +65680,209 @@ L5: /* In pmx271, had removed clefq, so with 2 or more staves in */ /* an instrument, had problems. So replace in 272 */ -#line 25911 "" +#line 25906 "" if (*nclef < 7) { -#line 25912 "" +#line 25907 "" i__1 = *nclef + 48; -#line 25912 "" +#line 25907 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 25912 "" +#line 25907 "" *(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)& ch__1[0]; -#line 25913 "" +#line 25908 "" } else { -#line 25914 "" +#line 25909 "" *(unsigned char *)&comclefq_1.clefq[*iv - 1] = '9'; -#line 25915 "" +#line 25910 "" } -#line 25916 "" +#line 25911 "" if (! comlast_1.islast) { -#line 25916 "" +#line 25911 "" return 0; -#line 25916 "" +#line 25911 "" } -#line 25917 "" +#line 25912 "" iv1 = 1; -#line 25918 "" +#line 25913 "" i__1 = *ninow; -#line 25918 "" +#line 25913 "" for (iinst = 1; iinst <= i__1; ++iinst) { -#line 25919 "" +#line 25914 "" if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) { -#line 25919 "" +#line 25914 "" goto L2; -#line 25919 "" +#line 25914 "" } -#line 25920 "" +#line 25915 "" iv1 += comnvi_1.nspern[iinst - 1]; -#line 25921 "" +#line 25916 "" /* L1: */ -#line 25921 "" +#line 25916 "" } -#line 25922 "" - s_wsle(&io___1932); -#line 25922 "" +#line 25917 "" + s_wsle(&io___1930); +#line 25917 "" e_wsle(); -#line 25923 "" - s_wsle(&io___1933); -#line 25923 "" +#line 25918 "" + s_wsle(&io___1931); +#line 25918 "" do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29); -#line 25923 "" +#line 25918 "" e_wsle(); -#line 25924 "" +#line 25919 "" stop1_(); -#line 25925 "" +#line 25920 "" L2: /* Here, iinst is the instrument number with staff of clef change */ -#line 25929 "" +#line 25924 "" iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1; -#line 25930 "" +#line 25925 "" if (iinst < 10) { /* Writing concatenation */ -#line 25931 "" +#line 25926 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 25931 "" +#line 25926 "" i__2[0] = 1, a__1[0] = ch__1; -#line 25931 "" +#line 25926 "" i__2[1] = 7, a__1[1] = "setclef"; -#line 25931 "" +#line 25926 "" i__1 = iinst + 48; -#line 25931 "" +#line 25926 "" chax_(ch__2, (ftnlen)1, &i__1); -#line 25931 "" +#line 25926 "" i__2[2] = 1, a__1[2] = ch__2; -#line 25931 "" +#line 25926 "" s_cat(temq, a__1, i__2, &c__3, (ftnlen)40); -#line 25932 "" +#line 25927 "" ltem = 9; -#line 25933 "" +#line 25928 "" } else { -#line 25934 "" - s_wsfi(&io___1937); +#line 25929 "" + s_wsfi(&io___1935); /* Writing concatenation */ -#line 25934 "" +#line 25929 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 25934 "" +#line 25929 "" i__3[0] = 1, a__2[0] = ch__1; -#line 25934 "" +#line 25929 "" i__3[1] = 8, a__2[1] = "setclef{"; -#line 25934 "" +#line 25929 "" s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9); -#line 25934 "" +#line 25929 "" do_fio(&c__1, ch__3, (ftnlen)9); -#line 25934 "" +#line 25929 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); -#line 25934 "" +#line 25929 "" do_fio(&c__1, "}", (ftnlen)1); -#line 25934 "" +#line 25929 "" e_wsfi(); -#line 25935 "" +#line 25930 "" ltem = 12; -#line 25936 "" +#line 25931 "" } -#line 25937 "" +#line 25932 "" if (iv1 == iv2) { /* Only one staff (iv) in instrument with clef change */ -#line 25941 "" - s_wsfe(&io___1938); +#line 25936 "" + s_wsfe(&io___1936); /* Writing concatenation */ -#line 25941 "" +#line 25936 "" i__2[0] = ltem, a__1[0] = temq; -#line 25941 "" +#line 25936 "" i__2[1] = 1, a__1[1] = comclefq_1.clefq + (*iv - 1); -#line 25941 "" +#line 25936 "" i__2[2] = 1, a__1[2] = "%"; -#line 25941 "" +#line 25936 "" s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)42); -#line 25941 "" +#line 25936 "" do_fio(&c__1, ch__4, ltem + 2); -#line 25941 "" +#line 25936 "" e_wsfe(); -#line 25942 "" +#line 25937 "" } else { /* Writing concatenation */ -#line 25943 "" +#line 25938 "" i__3[0] = ltem, a__2[0] = temq; -#line 25943 "" +#line 25938 "" i__3[1] = 1, a__2[1] = "{"; -#line 25943 "" +#line 25938 "" s_cat(temq, a__2, i__3, &c__2, (ftnlen)40); -#line 25944 "" +#line 25939 "" ++ltem; /* Loop over staves, but clefq has only changed for one of them */ -#line 25948 "" +#line 25943 "" i__1 = iv2; -#line 25948 "" +#line 25943 "" for (iiv = iv1; iiv <= i__1; ++iiv) { /* Writing concatenation */ -#line 25949 "" +#line 25944 "" i__3[0] = ltem, a__2[0] = temq; -#line 25949 "" +#line 25944 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (ftnlen)1) + 48; -#line 25949 "" +#line 25944 "" chax_(ch__1, (ftnlen)1, &i__4); -#line 25949 "" +#line 25944 "" i__3[1] = 1, a__2[1] = ch__1; -#line 25949 "" +#line 25944 "" s_cat(temq, a__2, i__3, &c__2, (ftnlen)40); -#line 25950 "" +#line 25945 "" ++ltem; -#line 25951 "" +#line 25946 "" /* L3: */ -#line 25951 "" +#line 25946 "" } -#line 25952 "" - s_wsfe(&io___1940); +#line 25947 "" + s_wsfe(&io___1938); /* Writing concatenation */ -#line 25952 "" +#line 25947 "" i__3[0] = ltem, a__2[0] = temq; -#line 25952 "" +#line 25947 "" i__3[1] = 2, a__2[1] = "}%"; -#line 25952 "" +#line 25947 "" s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)42); -#line 25952 "" +#line 25947 "" do_fio(&c__1, ch__4, ltem + 2); -#line 25952 "" +#line 25947 "" e_wsfe(); -#line 25953 "" +#line 25948 "" } -#line 25954 "" +#line 25949 "" if (comc8flag_1.c8flag[*iv - 1]) { /* If we change FROM octave treble clef to some other, need the following. */ -#line 25958 "" - s_wsfe(&io___1941); +#line 25953 "" + s_wsfe(&io___1939); /* Writing concatenation */ -#line 25958 "" +#line 25953 "" i__5[0] = 20, a__3[0] = "\\settrebleclefsymbol"; -#line 25958 "" +#line 25953 "" i__1 = iinst + 48; -#line 25958 "" +#line 25953 "" chax_(ch__1, (ftnlen)1, &i__1); -#line 25958 "" +#line 25953 "" i__5[1] = 1, a__3[1] = ch__1; -#line 25958 "" +#line 25953 "" i__5[2] = 1, a__3[2] = "\\"; -#line 25958 "" +#line 25953 "" i__5[3] = 11, a__3[3] = "trebleclef%"; -#line 25958 "" +#line 25953 "" s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)33); -#line 25958 "" +#line 25953 "" do_fio(&c__1, ch__5, (ftnlen)33); -#line 25958 "" +#line 25953 "" e_wsfe(); -#line 25960 "" +#line 25955 "" comc8flag_1.c8flag[*iv - 1] = FALSE_; -#line 25961 "" +#line 25956 "" } -#line 25962 "" +#line 25957 "" return 0; } /* wsclef_ */ @@ -65616,99 +65891,103 @@ L2: { /* System generated locals */ integer i__1; + char ch__1[1]; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, ftnlen, ftnlen); /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); static char charq[1]; extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, ftnlen); -#line 25967 "" +#line 25962 "" *lyrerr = 0; /* On entry, last char was " */ -#line 25971 "" +#line 25966 "" L18: -#line 25971 "" +#line 25966 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 25972 "" +#line 25967 "" if (*iccount == 121) { -#line 25973 "" +#line 25968 "" *lyrerr = 2; -#line 25974 "" +#line 25969 "" return 0; -/* else if (charq.eq.'"') then */ -#line 25976 "" +#line 25970 "" } else /* if(complicated condition) */ { -#line 25976 "" +#line 25970 "" i__1 = *iccount - 2; -#line 25976 "" - if (*(unsigned char *)charq == '"' && ! (s_cmp(lineq + i__1, "\\", * - iccount - 1 - i__1, (ftnlen)1) == 0)) { -#line 25978 "" +#line 25970 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 25970 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0] && ! ( + s_cmp(lineq + i__1, "\\", *iccount - 1 - i__1, (ftnlen)1) == + 0)) { +#line 25972 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); /* Check for raise/lower command */ -#line 25982 "" +#line 25976 "" if (*(unsigned char *)charq == '@') { /* @ positions lyrics vertically for current voice */ /* [a,b] above or below of the staff */ /* +/- i offset, \internotes */ -#line 25988 "" +#line 25982 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 25989 "" +#line 25983 "" if (i_indx("ab", charq, (ftnlen)2, (ftnlen)1) == 0) { -#line 25990 "" +#line 25984 "" *lyrerr = 3; -#line 25991 "" +#line 25985 "" return 0; -#line 25992 "" +#line 25986 "" } -#line 25993 "" +#line 25987 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 25994 "" +#line 25988 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) == 0) { -#line 25995 "" +#line 25989 "" *lyrerr = 4; -#line 25996 "" +#line 25990 "" return 0; -#line 25997 "" +#line 25991 "" } -#line 25998 "" +#line 25992 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); -#line 25999 "" +#line 25993 "" if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) == 0) { -#line 26000 "" +#line 25994 "" *lyrerr = 5; -#line 26001 "" +#line 25995 "" return 0; -#line 26002 "" +#line 25996 "" } -#line 26003 "" +#line 25997 "" } else if (*(unsigned char *)charq != ' ') { /* 2nd " must be followed by ' ' */ -#line 26007 "" +#line 26001 "" *lyrerr = 1; -#line 26008 "" +#line 26002 "" return 0; -#line 26009 "" +#line 26003 "" } -#line 26010 "" +#line 26004 "" return 0; -#line 26011 "" +#line 26005 "" } -#line 26011 "" +#line 26005 "" } -#line 26012 "" +#line 26006 "" goto L18; } /* chkpmxlyr_ */ @@ -65738,7 +66017,7 @@ L18: extern integer lenstr_(char *, integer *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1948 = { 0, 6, 0, 0, 0 }; + static cilist io___1946 = { 0, 6, 0, 0, 0 }; @@ -65746,171 +66025,175 @@ L18: /* with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', */ /* (unless preceded with '\'), check length */ -#line 26022 "" +#line 26016 "" chax_(ch__1, (ftnlen)1, &c__92); -#line 26022 "" +#line 26016 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; -#line 26023 "" +#line 26017 "" iend = lenstr_(lineq, &c__128, (ftnlen)128); /* i2nd = iccount+index(lineq(iccount+1:128),'"') */ /* Find position of closing '"'; must bypass any \" which is used for umlaut */ -#line 26028 "" +#line 26022 "" i__1 = *iccount; -#line 26028 "" - i2nd = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); -#line 26029 "" +#line 26022 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 26022 "" + i2nd = *iccount + i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1); +#line 26023 "" L2: -#line 26030 "" +#line 26024 "" i__1 = i2nd - 2; -#line 26030 "" +#line 26024 "" if (s_cmp(lineq + i__1, "\\", i2nd - 1 - i__1, (ftnlen)1) == 0) { -#line 26031 "" +#line 26025 "" i__1 = i2nd; -#line 26031 "" - i2nd += i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); -#line 26032 "" +#line 26025 "" + chax_(ch__1, (ftnlen)1, &c__34); +#line 26025 "" + i2nd += i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1); +#line 26026 "" goto L2; -#line 26033 "" +#line 26027 "" } -#line 26034 "" +#line 26028 "" istart = *iccount; -#line 26035 "" +#line 26029 "" L1: -#line 26035 "" +#line 26029 "" i__1 = istart; -#line 26035 "" +#line 26029 "" itilde = istart + i_indx(lineq + i__1, "~", i2nd - 1 - i__1, (ftnlen)1); -#line 26036 "" +#line 26030 "" if (itilde > istart && itilde < i2nd) { /* Replace tilde if not preceded by \ */ -#line 26040 "" +#line 26034 "" if (iend >= 117) { -#line 26041 "" - s_wsle(&io___1948); -#line 26041 "" +#line 26035 "" + s_wsle(&io___1946); +#line 26035 "" do_lio(&c__9, &c__1, "Sorry, lyric string is too long, stopping", (ftnlen)41); -#line 26041 "" +#line 26035 "" e_wsle(); -#line 26042 "" +#line 26036 "" stop1_(); -#line 26043 "" +#line 26037 "" } else /* if(complicated condition) */ { -#line 26043 "" +#line 26037 "" i__1 = itilde - 2; -#line 26043 "" +#line 26037 "" if (s_cmp(lineq + i__1, sq, itilde - 1 - i__1, (ftnlen)1) == 0) { -#line 26044 "" +#line 26038 "" istart = itilde; -#line 26045 "" +#line 26039 "" goto L1; -#line 26046 "" +#line 26040 "" } -#line 26046 "" +#line 26040 "" } -#line 26047 "" +#line 26041 "" i__1 = itilde; /* Writing concatenation */ -#line 26047 "" +#line 26041 "" i__2[0] = itilde - 1, a__1[0] = lineq; -#line 26047 "" +#line 26041 "" i__2[1] = 1, a__1[1] = sq; -#line 26047 "" +#line 26041 "" i__2[2] = 3, a__1[2] = "lk "; -#line 26047 "" +#line 26041 "" i__2[3] = iend - i__1, a__1[3] = lineq + i__1; -#line 26047 "" +#line 26041 "" s_cat(lineqt, a__1, i__2, &c__4, (ftnlen)128); -#line 26049 "" +#line 26043 "" iend = lenstr_(lineqt, &c__128, (ftnlen)128); -#line 26050 "" +#line 26044 "" i2nd += 3; -#line 26051 "" +#line 26045 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); -#line 26052 "" +#line 26046 "" goto L1; -#line 26053 "" +#line 26047 "" } -#line 26054 "" +#line 26048 "" if (*iccount == 1) { -#line 26055 "" +#line 26049 "" i__1 = i2nd; /* Writing concatenation */ -#line 26055 "" +#line 26049 "" i__3[0] = 1, a__2[0] = sq; -#line 26055 "" +#line 26049 "" i__3[1] = 7, a__2[1] = "pmxlyr{"; -#line 26055 "" +#line 26049 "" i__3[2] = i2nd - 2, a__2[2] = lineq + 1; -#line 26055 "" +#line 26049 "" i__3[3] = 1, a__2[3] = "}"; -#line 26055 "" +#line 26049 "" i__3[4] = 1, a__2[4] = sq; -#line 26055 "" +#line 26049 "" i__3[5] = 128 - i__1, a__2[5] = lineq + i__1; -#line 26055 "" +#line 26049 "" s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); -#line 26057 "" +#line 26051 "" } else { -#line 26058 "" +#line 26052 "" i__1 = *iccount; -#line 26058 "" +#line 26052 "" i__4 = i2nd; /* Writing concatenation */ -#line 26058 "" +#line 26052 "" i__5[0] = *iccount - 1, a__3[0] = lineq; -#line 26058 "" +#line 26052 "" i__5[1] = 1, a__3[1] = sq; -#line 26058 "" +#line 26052 "" i__5[2] = 7, a__3[2] = "pmxlyr{"; -#line 26058 "" +#line 26052 "" i__5[3] = i2nd - 1 - i__1, a__3[3] = lineq + i__1; -#line 26058 "" +#line 26052 "" i__5[4] = 1, a__3[4] = "}"; -#line 26058 "" +#line 26052 "" i__5[5] = 1, a__3[5] = sq; -#line 26058 "" +#line 26052 "" i__5[6] = 128 - i__4, a__3[6] = lineq + i__4; -#line 26058 "" +#line 26052 "" s_cat(lineqt, a__3, i__5, &c__7, (ftnlen)128); -#line 26061 "" +#line 26055 "" } -#line 26062 "" +#line 26056 "" i2nd += 8; -#line 26063 "" +#line 26057 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); -#line 26064 "" +#line 26058 "" i__1 = i2nd; -#line 26064 "" +#line 26058 "" if (s_cmp(lineq + i__1, "@", i2nd + 1 - i__1, (ftnlen)1) == 0) { -#line 26065 "" +#line 26059 "" i__1 = i2nd + 1; -#line 26065 "" +#line 26059 "" i__4 = i2nd + 4; /* Writing concatenation */ -#line 26065 "" +#line 26059 "" i__3[0] = i2nd, a__2[0] = lineq; -#line 26065 "" +#line 26059 "" i__3[1] = 3, a__2[1] = "at{"; -#line 26065 "" +#line 26059 "" i__3[2] = i2nd + 4 - i__1, a__2[2] = lineq + i__1; -#line 26065 "" +#line 26059 "" i__3[3] = 1, a__2[3] = "}"; -#line 26065 "" +#line 26059 "" i__3[4] = 1, a__2[4] = sq; -#line 26065 "" +#line 26059 "" i__3[5] = 128 - i__4, a__2[5] = lineq + i__4; -#line 26065 "" +#line 26059 "" s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); -#line 26067 "" +#line 26061 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); -#line 26068 "" +#line 26062 "" } -#line 26069 "" +#line 26063 "" return 0; } /* dopmxlyr_ */ @@ -65920,33 +66203,33 @@ L1: static integer iv; /* propagate per-instrument quantities to per-channel ones */ -#line 26077 "" +#line 26071 "" /* Parameter adjustments */ -#line 26077 "" +#line 26071 "" --twoline; -#line 26077 "" +#line 26071 "" --iinsiv; -#line 26077 "" +#line 26071 "" midchan -= 25; -#line 26077 "" +#line 26071 "" --midi; -#line 26077 "" +#line 26071 "" -#line 26077 "" +#line 26071 "" /* Function Body */ -#line 26077 "" +#line 26071 "" for (iv = *nv; iv >= 1; --iv) { -#line 26078 "" +#line 26072 "" if (twoline[iv]) { -#line 26079 "" +#line 26073 "" midc[midchan[iv + 48]] = midi[iinsiv[iv]]; -#line 26080 "" +#line 26074 "" } -#line 26081 "" +#line 26075 "" midc[midchan[iv + 24]] = midi[iinsiv[iv]]; -#line 26082 "" +#line 26076 "" } -#line 26083 "" +#line 26077 "" return 0; } /* inst2chan_ */ diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.c b/Build/source/utils/pmx/pmx-src/scor2prt.c index 4873c52314d..36f2ebcf453 100644 --- a/Build/source/utils/pmx/pmx-src/scor2prt.c +++ b/Build/source/utils/pmx/pmx-src/scor2prt.c @@ -60,7 +60,7 @@ static integer c__125 = 125; /* ccccccccccccccccccccccccc */ /* c */ -/* c scor2prt 2/19/16 for PMX 2.74 */ +/* c scor2prt 1/29/21 for PMX 2.94 */ /* ccccccccccccccccccccccccc */ /* This program, developed by Don Simons (dsimons@roadrunner.com), is */ /* part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert */ @@ -82,6 +82,9 @@ static integer c__125 = 125; /* You should have received a copy of the GNU General Public License */ /* along with this program. If not, see . */ +/* 1/29/21 */ +/* Reformat output statement for warning about full bar rests to */ +/* eliminate use of H format specifier */ /* 2/19/16 */ /* Exit gracefully when last input line is comment, with mods in */ /* subroutine chkcom, adding logical argument goto999 */ @@ -270,465 +273,465 @@ static integer c__125 = 125; static cilist io___104 = { 0, 0, 0, "(a)", 0 }; -#line 104 "" +#line 107 "" clefpend = FALSE_; -#line 105 "" +#line 108 "" all_1.insetup = TRUE_; -#line 106 "" +#line 109 "" all_1.replacing = FALSE_; -#line 107 "" +#line 110 "" frstln = TRUE_; -#line 108 "" +#line 111 "" lenhold = 0; -#line 109 "" +#line 112 "" *(unsigned char *)sq = '\\'; -#line 110 "" +#line 113 "" s_wsle(&io___6); -#line 110 "" - do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.74, 19 February 2016", ( - ftnlen)47); -#line 110 "" +#line 113 "" + do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.94, 29 January 2021", ( + ftnlen)46); +#line 113 "" e_wsle(); -#line 111 "" +#line 114 "" numargs = iargc_(); -#line 112 "" +#line 115 "" if (numargs == 0) { -#line 113 "" +#line 116 "" s_wsle(&io___8); -#line 113 "" +#line 116 "" do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\ "d line,", (ftnlen)53); -#line 113 "" +#line 116 "" e_wsle(); -#line 114 "" +#line 117 "" s_wsle(&io___9); -#line 114 "" +#line 117 "" do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); -#line 114 "" +#line 117 "" e_wsle(); -#line 115 "" +#line 118 "" s_rsfe(&io___10); -#line 115 "" +#line 118 "" do_fio(&c__1, jobname, (ftnlen)27); -#line 115 "" +#line 118 "" e_rsfe(); -#line 116 "" +#line 119 "" numargs = 1; -#line 117 "" +#line 120 "" } else { /* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ -#line 119 "" +#line 122 "" getarg_(&c__1, jobname, (ftnlen)27); -#line 120 "" +#line 123 "" } -#line 121 "" +#line 124 "" ljob = lenstr_(jobname, &c__27, (ftnlen)27); -#line 122 "" +#line 125 "" if (ljob == 0) { -#line 123 "" +#line 126 "" s_wsle(&io___13); -#line 123 "" +#line 126 "" do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.", (ftnlen)46); -#line 123 "" +#line 126 "" e_wsle(); -#line 124 "" +#line 127 "" s_stop("", (ftnlen)0); -#line 125 "" +#line 128 "" } /* Strip ".pmx" if necessary */ /* Computing MAX */ -#line 129 "" +#line 132 "" i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx( jobname, ".PMX", (ftnlen)27, (ftnlen)4); -#line 129 "" +#line 132 "" ndxpmx = max(i__1,i__2); -#line 130 "" +#line 133 "" if (ndxpmx > 0) { -#line 131 "" +#line 134 "" s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1); -#line 132 "" +#line 135 "" ljob += -4; -#line 133 "" +#line 136 "" } /* Check for existence of input file */ /* Writing concatenation */ -#line 137 "" +#line 140 "" i__3[0] = ljob, a__1[0] = jobname; -#line 137 "" +#line 140 "" i__3[1] = 4, a__1[1] = ".pmx"; -#line 137 "" +#line 140 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27); -#line 138 "" +#line 141 "" ioin__1.inerr = 0; -#line 138 "" +#line 141 "" ioin__1.infilen = 27; -#line 138 "" +#line 141 "" ioin__1.infile = infileq; -#line 138 "" +#line 141 "" ioin__1.inex = &fexist; -#line 138 "" +#line 141 "" ioin__1.inopen = 0; -#line 138 "" +#line 141 "" ioin__1.innum = 0; -#line 138 "" +#line 141 "" ioin__1.innamed = 0; -#line 138 "" +#line 141 "" ioin__1.inname = 0; -#line 138 "" +#line 141 "" ioin__1.inacc = 0; -#line 138 "" +#line 141 "" ioin__1.inseq = 0; -#line 138 "" +#line 141 "" ioin__1.indir = 0; -#line 138 "" +#line 141 "" ioin__1.infmt = 0; -#line 138 "" +#line 141 "" ioin__1.inform = 0; -#line 138 "" +#line 141 "" ioin__1.inunf = 0; -#line 138 "" +#line 141 "" ioin__1.inrecl = 0; -#line 138 "" +#line 141 "" ioin__1.innrec = 0; -#line 138 "" +#line 141 "" ioin__1.inblank = 0; -#line 138 "" +#line 141 "" f_inqu(&ioin__1); -#line 139 "" +#line 142 "" if (! fexist) { -#line 140 "" +#line 143 "" s_wsle(&io___17); /* Writing concatenation */ -#line 140 "" +#line 143 "" i__3[0] = 17, a__1[0] = "Cannot find file "; -#line 140 "" +#line 143 "" i__3[1] = 27, a__1[1] = infileq; -#line 140 "" +#line 143 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44); -#line 140 "" +#line 143 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)44); -#line 140 "" +#line 143 "" e_wsle(); -#line 141 "" +#line 144 "" s_stop("", (ftnlen)0); -#line 142 "" +#line 145 "" } -#line 143 "" +#line 146 "" o__1.oerr = 0; -#line 143 "" +#line 146 "" o__1.ounit = 10; -#line 143 "" +#line 146 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ -#line 143 "" +#line 146 "" i__3[0] = ljob, a__1[0] = jobname; -#line 143 "" +#line 146 "" i__3[1] = 4, a__1[1] = ".pmx"; -#line 143 "" +#line 146 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31); -#line 143 "" +#line 146 "" o__1.ofnm = ch__2; -#line 143 "" +#line 146 "" o__1.orl = 0; -#line 143 "" +#line 146 "" o__1.osta = 0; -#line 143 "" +#line 146 "" o__1.oacc = 0; -#line 143 "" +#line 146 "" o__1.ofm = 0; -#line 143 "" +#line 146 "" o__1.oblnk = 0; -#line 143 "" +#line 146 "" f_open(&o__1); /* Open all instrument files now for allparts stuff. Later disgard those >nv */ -#line 147 "" +#line 150 "" for (iv = 1; iv <= 24; ++iv) { -#line 148 "" +#line 151 "" all_1.iorig[iv - 1] = iv; -#line 149 "" +#line 152 "" o__1.oerr = 0; -#line 149 "" +#line 152 "" o__1.ounit = iv + 10; -#line 149 "" +#line 152 "" o__1.ofnm = 0; -#line 149 "" +#line 152 "" o__1.orl = 0; -#line 149 "" +#line 152 "" o__1.osta = "SCRATCH"; -#line 149 "" +#line 152 "" o__1.oacc = 0; -#line 149 "" +#line 152 "" o__1.ofm = 0; -#line 149 "" +#line 152 "" o__1.oblnk = 0; -#line 149 "" +#line 152 "" f_open(&o__1); -#line 150 "" +#line 153 "" ludpfn[iv - 1] = 0; -#line 151 "" +#line 154 "" /* L19: */ -#line 151 "" +#line 154 "" } -#line 152 "" +#line 155 "" s_rsfe(&io___20); -#line 152 "" +#line 155 "" do_fio(&c__1, line, (ftnlen)128); -#line 152 "" +#line 155 "" e_rsfe(); -#line 153 "" +#line 156 "" chkcom_(line, &goto999, (ftnlen)128); -#line 154 "" +#line 157 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { -#line 155 "" +#line 158 "" allparts_(line, &c__128, (ftnlen)128); -#line 156 "" +#line 159 "" L31: -#line 156 "" +#line 159 "" s_rsfe(&io___23); -#line 156 "" +#line 159 "" do_fio(&c__1, line, (ftnlen)128); -#line 156 "" +#line 159 "" e_rsfe(); -#line 157 "" +#line 160 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) { -#line 158 "" +#line 161 "" allparts_(line, &c__128, (ftnlen)128); -#line 159 "" +#line 162 "" goto L31; -#line 160 "" +#line 163 "" } -#line 161 "" +#line 164 "" allparts_(line, &c__128, (ftnlen)128); -#line 162 "" +#line 165 "" s_rsfe(&io___24); -#line 162 "" +#line 165 "" do_fio(&c__1, line, (ftnlen)128); -#line 162 "" +#line 165 "" e_rsfe(); -#line 163 "" +#line 166 "" chkcom_(line, &goto999, (ftnlen)128); -#line 164 "" +#line 167 "" } -#line 165 "" +#line 168 "" iccount = 0; -#line 166 "" +#line 169 "" nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f; -#line 167 "" +#line 170 "" all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f; -#line 168 "" +#line 171 "" if (all_1.noinst > 0) { -#line 169 "" +#line 172 "" all_1.nvi[0] = nv - all_1.noinst + 1; -#line 170 "" +#line 173 "" } else { -#line 171 "" +#line 174 "" all_1.noinst = 1 - all_1.noinst; -#line 172 "" +#line 175 "" i__1 = all_1.noinst; -#line 172 "" +#line 175 "" for (iinst = 1; iinst <= i__1; ++iinst) { -#line 173 "" +#line 176 "" all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128) + .1f; -#line 174 "" +#line 177 "" /* L21: */ -#line 174 "" +#line 177 "" } -#line 175 "" +#line 178 "" } -#line 176 "" +#line 179 "" all_1.noinow = all_1.noinst; -#line 177 "" +#line 180 "" insnow = 1; /* ivlast is last iv in current inst. instnum(iv) is iinst for current voice. */ -#line 181 "" +#line 184 "" ivlast = all_1.nvi[0]; -#line 182 "" +#line 185 "" i__1 = nv; -#line 182 "" +#line 185 "" for (iv = 1; iv <= i__1; ++iv) { -#line 183 "" +#line 186 "" all_1.instnum[iv - 1] = insnow; -#line 184 "" +#line 187 "" if (iv == ivlast) { -#line 185 "" +#line 188 "" if (iv < nv) { -#line 185 "" +#line 188 "" all_1.botv[iv] = TRUE_; -#line 185 "" +#line 188 "" } /* The previous stmt will set botv true only for bot voice of iinst>1. It is */ /* used when writing termrpts, but the one in voice one is handled differently, */ /* so botv(1) is left .false. */ -#line 191 "" +#line 194 "" if (insnow < all_1.noinst) { -#line 192 "" +#line 195 "" ++insnow; -#line 193 "" +#line 196 "" ivlast += all_1.nvi[insnow - 1]; -#line 194 "" +#line 197 "" } -#line 195 "" +#line 198 "" } -#line 196 "" +#line 199 "" /* L22: */ -#line 196 "" +#line 199 "" } -#line 197 "" +#line 200 "" mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 198 "" +#line 201 "" mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 199 "" +#line 202 "" mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 200 "" +#line 203 "" mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 201 "" +#line 204 "" xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128); -#line 202 "" +#line 205 "" isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 203 "" +#line 206 "" npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f; -#line 204 "" +#line 207 "" all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; -#line 205 "" +#line 208 "" musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f; -#line 206 "" +#line 209 "" fracindent = readin_(line, &iccount, &c__5, (ftnlen)128); -#line 207 "" +#line 210 "" if (npages == 0) { -#line 208 "" +#line 211 "" s_wsle(&io___39); -#line 208 "" +#line 211 "" do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not"\ " the total number", (ftnlen)63); -#line 208 "" +#line 211 "" e_wsle(); -#line 210 "" +#line 213 "" s_wsle(&io___40); -#line 210 "" +#line 213 "" do_lio(&c__9, &c__1, "of systems. Scor2prt has to know the total nu"\ "mber of systems.", (ftnlen)62); -#line 210 "" +#line 213 "" e_wsle(); -#line 212 "" +#line 215 "" s_wsle(&io___41); -#line 212 "" +#line 215 "" do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu"\ "es.", (ftnlen)49); -#line 212 "" +#line 215 "" e_wsle(); -#line 214 "" +#line 217 "" s_stop("", (ftnlen)0); -#line 215 "" +#line 218 "" } /* Must leave insetup=.true. else could bypass ALL instrument names. */ -#line 219 "" +#line 222 "" s_rsfe(&io___42); -#line 219 "" +#line 222 "" do_fio(&c__1, line, (ftnlen)128); -#line 219 "" +#line 222 "" e_rsfe(); -#line 220 "" +#line 223 "" chkcom_(line, &goto999, (ftnlen)128); -#line 221 "" +#line 224 "" al__1.aerr = 0; -#line 221 "" +#line 224 "" al__1.aunit = 10; -#line 221 "" +#line 224 "" f_back(&al__1); /* Normally this puts pointer at start of line with 1st inst name */ /* Check if prior line was "%%" */ -#line 226 "" +#line 229 "" al__1.aerr = 0; -#line 226 "" +#line 229 "" al__1.aunit = 10; -#line 226 "" +#line 229 "" f_back(&al__1); -#line 227 "" +#line 230 "" s_rsfe(&io___43); -#line 227 "" +#line 230 "" do_fio(&c__1, line, (ftnlen)128); -#line 227 "" +#line 230 "" e_rsfe(); -#line 228 "" +#line 231 "" if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) { -#line 228 "" +#line 231 "" al__1.aerr = 0; -#line 228 "" +#line 231 "" al__1.aunit = 10; -#line 228 "" +#line 231 "" f_back(&al__1); -#line 228 "" +#line 231 "" } -#line 229 "" +#line 232 "" i__1 = all_1.noinst; -#line 229 "" +#line 232 "" for (iv = 1; iv <= i__1; ++iv) { -#line 230 "" +#line 233 "" gotname = FALSE_; -#line 231 "" +#line 234 "" L16: -#line 231 "" +#line 234 "" s_rsfe(&io___45); -#line 231 "" +#line 234 "" do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128); -#line 231 "" +#line 234 "" e_rsfe(); -#line 232 "" +#line 235 "" if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) { -#line 233 "" +#line 236 "" s_rsfe(&io___47); -#line 233 "" +#line 236 "" do_fio(&c__1, line, (ftnlen)128); -#line 233 "" +#line 236 "" e_rsfe(); -#line 234 "" +#line 237 "" goto L16; -#line 235 "" +#line 238 "" } else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') { -#line 236 "" +#line 239 "" ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48; -#line 237 "" +#line 240 "" if (ivq != iv) { /* It's really a comment. Copy to parts, then get another trial name. */ -#line 241 "" +#line 244 "" allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128); -#line 242 "" +#line 245 "" goto L16; -#line 243 "" +#line 246 "" } else { -#line 244 "" +#line 247 "" s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, ( ftnlen)126); -#line 245 "" +#line 248 "" s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen) 128); -#line 246 "" +#line 249 "" gotname = TRUE_; -#line 247 "" +#line 250 "" } -#line 248 "" +#line 251 "" } else { -#line 249 "" +#line 252 "" gotname = TRUE_; -#line 250 "" +#line 253 "" } /* c */ /* c The following checks for macro that write original C-clef as part of */ @@ -744,117 +747,117 @@ L16: /* * char(iy1+49)//char(iy2+49) */ /* instrum(iv) = instrum(iv)(inm1:inm2) */ /* end if */ -#line 265 "" +#line 268 "" if (! gotname) { -#line 266 "" +#line 269 "" s_wsle(&io___49); -#line 266 "" +#line 269 "" do_lio(&c__9, &c__1, "You must provide a replacement instrument "\ "name", (ftnlen)46); -#line 266 "" +#line 269 "" e_wsle(); -#line 267 "" +#line 270 "" s_stop("", (ftnlen)0); -#line 268 "" +#line 271 "" } -#line 269 "" +#line 272 "" io___50.ciunit = iv + 10; -#line 269 "" +#line 272 "" s_wsfe(&io___50); -#line 269 "" +#line 272 "" do_fio(&c__1, " ", (ftnlen)1); -#line 269 "" +#line 272 "" e_wsfe(); -#line 270 "" +#line 273 "" /* L14: */ -#line 270 "" +#line 273 "" } -#line 271 "" +#line 274 "" all_1.replacing = FALSE_; -#line 272 "" +#line 275 "" all_1.nvnow = nv; /* Clef string: Note insetup is still T, so "%%" will be treated specially */ -#line 276 "" +#line 279 "" s_rsfe(&io___51); -#line 276 "" +#line 279 "" do_fio(&c__1, line, (ftnlen)128); -#line 276 "" +#line 279 "" e_rsfe(); -#line 277 "" +#line 280 "" chkcom_(line, &goto999, (ftnlen)128); -#line 278 "" +#line 281 "" if (all_1.replacing) { /* If here, we have next line after "%%", containing score's clef string */ /* Assume all clefs are handled with instrument comments. */ -#line 283 "" +#line 286 "" s_rsfe(&io___52); -#line 283 "" +#line 286 "" do_fio(&c__1, line, (ftnlen)128); -#line 283 "" +#line 286 "" e_rsfe(); -#line 284 "" +#line 287 "" chkcom_(line, &goto999, (ftnlen)128); -#line 285 "" +#line 288 "" al__1.aerr = 0; -#line 285 "" +#line 288 "" al__1.aunit = 10; -#line 285 "" +#line 288 "" f_back(&al__1); -#line 286 "" +#line 289 "" } else { /* If here, line has the clef string in it. Handle the old way */ -#line 290 "" +#line 293 "" kvstart = 1; -#line 291 "" +#line 294 "" kvend = all_1.nvi[0]; -#line 292 "" +#line 295 "" i__1 = all_1.noinst; -#line 292 "" +#line 295 "" for (inst = 1; inst <= i__1; ++inst) { -#line 293 "" +#line 296 "" ci__1.cierr = 0; -#line 293 "" +#line 296 "" ci__1.ciunit = inst + 10; /* Writing concatenation */ -#line 293 "" +#line 296 "" i__4[0] = 2, a__2[0] = "(a"; -#line 293 "" +#line 296 "" *(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48; -#line 293 "" +#line 296 "" i__4[1] = 1, a__2[1] = ch__4; -#line 293 "" +#line 296 "" i__4[2] = 1, a__2[2] = ")"; -#line 293 "" +#line 296 "" ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3); -#line 293 "" +#line 296 "" s_wsfe(&ci__1); -#line 293 "" +#line 296 "" do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1)); -#line 293 "" +#line 296 "" e_wsfe(); -#line 295 "" +#line 298 "" if (inst < all_1.noinst) { -#line 296 "" +#line 299 "" kvstart = kvend + 1; -#line 297 "" +#line 300 "" kvend = kvstart + all_1.nvi[inst] - 1; -#line 298 "" +#line 301 "" } -#line 299 "" +#line 302 "" /* L2: */ -#line 299 "" +#line 302 "" } -#line 300 "" +#line 303 "" } -#line 301 "" +#line 304 "" all_1.replacing = FALSE_; -#line 302 "" +#line 305 "" all_1.insetup = FALSE_; /* *****NOTE*****This comment applies to stuff done earlier! */ @@ -865,50 +868,50 @@ L16: /* Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */ -#line 312 "" +#line 315 "" L18: -#line 312 "" +#line 315 "" s_rsfe(&io___56); -#line 312 "" +#line 315 "" do_fio(&c__1, line, (ftnlen)128); -#line 312 "" +#line 315 "" e_rsfe(); -#line 313 "" +#line 316 "" if (*(unsigned char *)line == '%') { -#line 314 "" +#line 317 "" allparts_(line, &c__128, (ftnlen)128); -#line 315 "" +#line 318 "" goto L18; -#line 316 "" +#line 319 "" } -#line 317 "" +#line 320 "" allparts_(line, &c__128, (ftnlen)128); /* Write instrument names. Will be blank if later part of a score. */ -#line 321 "" +#line 324 "" if (*(unsigned char *)&instrum[0] != ' ') { -#line 322 "" +#line 325 "" i__1 = all_1.noinst; -#line 322 "" +#line 325 "" for (iv = 1; iv <= i__1; ++iv) { -#line 323 "" +#line 326 "" len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128); -#line 324 "" +#line 327 "" io___58.ciunit = iv + 10; -#line 324 "" +#line 327 "" s_wsfe(&io___58); -#line 324 "" +#line 327 "" do_fio(&c__1, "Ti", (ftnlen)2); -#line 324 "" +#line 327 "" do_fio(&c__1, instrum + (iv - 1 << 7), len); -#line 324 "" +#line 327 "" e_wsfe(); -#line 325 "" +#line 328 "" /* L3: */ -#line 325 "" +#line 328 "" } -#line 326 "" +#line 329 "" } /* The big loop. Except for '%%', put all comment lines in all parts. */ @@ -921,481 +924,481 @@ L18: /* Check for "P"; ignore in parts. */ /* Check for consecutive full-bar rests; if found, replace with rm[nn] */ -#line 338 "" +#line 341 "" iv = 1; -#line 339 "" +#line 342 "" iinst = 1; -#line 340 "" +#line 343 "" termrpt = FALSE_; -#line 341 "" +#line 344 "" L4: -#line 342 "" +#line 345 "" i__1 = s_rsfe(&io___60); -#line 342 "" +#line 345 "" if (i__1 != 0) { -#line 342 "" +#line 345 "" goto L999; -#line 342 "" +#line 345 "" } -#line 342 "" +#line 345 "" i__1 = do_fio(&c__1, line, (ftnlen)128); -#line 342 "" +#line 345 "" if (i__1 != 0) { -#line 342 "" +#line 345 "" goto L999; -#line 342 "" +#line 345 "" } -#line 342 "" +#line 345 "" i__1 = e_rsfe(); -#line 342 "" +#line 345 "" if (i__1 != 0) { -#line 342 "" +#line 345 "" goto L999; -#line 342 "" +#line 345 "" } -#line 343 "" +#line 346 "" lenline = lenstr_(line, &c__128, (ftnlen)128); -#line 344 "" +#line 347 "" if (lenline == 0) { -#line 344 "" +#line 347 "" goto L4; -#line 344 "" +#line 347 "" } -#line 345 "" +#line 348 "" zapbl_(line, &c__128, (ftnlen)128); -#line 346 "" +#line 349 "" chkcom_(line, &goto999, (ftnlen)128); -#line 347 "" +#line 350 "" if (goto999) { -#line 347 "" +#line 350 "" goto L999; -#line 347 "" +#line 350 "" } -#line 348 "" +#line 351 "" lenline = lenstr_(line, &c__128, (ftnlen)128); -#line 349 "" +#line 352 "" if (lenline == 0) { -#line 349 "" +#line 352 "" goto L4; -#line 349 "" +#line 352 "" } -#line 350 "" +#line 353 "" if (*(unsigned char *)line == 'T') { -#line 351 "" +#line 354 "" allparts_(line, &c__128, (ftnlen)128); -#line 352 "" +#line 355 "" s_rsfe(&io___62); -#line 352 "" +#line 355 "" do_fio(&c__1, line, (ftnlen)128); -#line 352 "" +#line 355 "" e_rsfe(); -#line 353 "" +#line 356 "" allparts_(line, &c__128, (ftnlen)128); -#line 354 "" +#line 357 "" goto L4; -#line 355 "" +#line 358 "" } else /* if(complicated condition) */ { /* Writing concatenation */ -#line 355 "" +#line 358 "" i__3[0] = 1, a__1[0] = sq; -#line 355 "" +#line 358 "" i__3[1] = 1, a__1[1] = sq; -#line 355 "" +#line 358 "" s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2); -#line 355 "" +#line 358 "" if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) { -#line 356 "" +#line 359 "" allparts_(line, &c__128, (ftnlen)128); -#line 357 "" +#line 360 "" goto L4; -#line 358 "" +#line 361 "" } else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx( " +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) { -#line 360 "" +#line 363 "" allparts_(line, &c__128, (ftnlen)128); -#line 361 "" +#line 364 "" s_rsfe(&io___63); -#line 361 "" +#line 364 "" do_fio(&c__1, line, (ftnlen)128); -#line 361 "" +#line 364 "" e_rsfe(); -#line 362 "" +#line 365 "" allparts_(line, &c__128, (ftnlen)128); -#line 363 "" +#line 366 "" goto L4; -#line 364 "" +#line 367 "" } else if (iv == 1) { -#line 365 "" +#line 368 "" for (ia = 1; ia <= 10; ++ia) { -#line 366 "" +#line 369 "" L24: -#line 367 "" +#line 370 "" idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen) 1); -#line 368 "" +#line 371 "" isachar = idxa > 0; -#line 369 "" +#line 372 "" if (idxa > 1) { -#line 369 "" +#line 372 "" i__1 = idxa - 2; -#line 369 "" +#line 372 "" isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, ( ftnlen)1) == 0; -#line 369 "" +#line 372 "" } /* 1 2 3 4 5 6 7 8 9 10 */ /* data achar /'P','m','V','R','A','h','w','K','M','I'/ */ -#line 374 "" +#line 377 "" if (ia == 9) { -#line 374 "" +#line 377 "" i__1 = idxa; -#line 374 "" +#line 377 "" isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 - i__1, (ftnlen)1) == 0; -#line 374 "" +#line 377 "" } -#line 376 "" +#line 379 "" if (isachar) { /* Check whether character is inside a quoted string by counting */ /* how many quotes precede it in the line */ -#line 382 "" +#line 385 "" oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128); -#line 383 "" +#line 386 "" if (yesodd) { -#line 383 "" +#line 386 "" isachar = FALSE_; -#line 383 "" +#line 386 "" } -#line 384 "" +#line 387 "" } -#line 385 "" +#line 388 "" if (isachar) { /* Find next blank */ -#line 389 "" +#line 392 "" for (ib = idxa + 1; ib <= 128; ++ib) { -#line 390 "" +#line 393 "" if (*(unsigned char *)&line[ib - 1] == ' ') { -#line 390 "" +#line 393 "" goto L7; -#line 390 "" +#line 393 "" } -#line 391 "" +#line 394 "" /* L6: */ -#line 391 "" +#line 394 "" } -#line 392 "" +#line 395 "" s_wsle(&io___69); -#line 392 "" +#line 395 "" do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o"\ "r w\"", (ftnlen)35); -#line 392 "" +#line 395 "" e_wsle(); -#line 393 "" +#line 396 "" s_wsle(&io___70); -#line 393 "" +#line 396 "" do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a"\ "t roadrunner dot com", (ftnlen)54); -#line 393 "" +#line 396 "" e_wsle(); -#line 395 "" +#line 398 "" s_stop("1", (ftnlen)1); -#line 396 "" +#line 399 "" L7: /* Next blank is at position ib. Later, if ia=1, must check for Pc" " ; */ /* i.e., look for '"' between P and blank */ -#line 401 "" +#line 404 "" if (ia == 4) { /* Check for terminal repeat. Note if there's a term rpt, there can't be any */ /* others. Also, must process repeats LAST, after m's and 'V's */ -#line 406 "" +#line 409 "" for (ic = ib + 1; ic <= 128; ++ic) { /* If any subsequent character on this line is neither blank nor "/", get out */ -#line 410 "" +#line 413 "" if (i_indx(" /", line + (ic - 1), (ftnlen)2, ( ftnlen)1) == 0) { -#line 410 "" +#line 413 "" goto L9; -#line 410 "" +#line 413 "" } -#line 411 "" +#line 414 "" if (*(unsigned char *)&line[ic - 1] == '/') { -#line 412 "" +#line 415 "" termrpt = TRUE_; -#line 413 "" +#line 416 "" i__1 = ib - 3; -#line 413 "" +#line 416 "" s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - i__1); /* Process the line as if there were no "R" */ -#line 417 "" +#line 420 "" goto L10; -#line 418 "" +#line 421 "" } -#line 419 "" +#line 422 "" /* L8: */ -#line 419 "" +#line 422 "" } /* +++ 060812 */ /* If here, all chars after "R" symbol are blanks, so process the line normally, */ /* but only IF next line is not the M-Tx line " /" */ -#line 425 "" +#line 428 "" s_rsfe(&io___73); -#line 425 "" +#line 428 "" do_fio(&c__1, templine, (ftnlen)128); -#line 425 "" +#line 428 "" e_rsfe(); -#line 426 "" +#line 429 "" if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0) { -#line 427 "" +#line 430 "" al__1.aerr = 0; -#line 427 "" +#line 430 "" al__1.aunit = 10; -#line 427 "" +#line 430 "" f_back(&al__1); /* and flow out */ -#line 428 "" +#line 431 "" } else { /* We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, */ /* and proceed as above */ /* Writing concatenation */ -#line 433 "" +#line 436 "" i__3[0] = ib, a__1[0] = line; -#line 433 "" +#line 436 "" i__3[1] = 1, a__1[1] = "/"; -#line 433 "" +#line 436 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 434 "" +#line 437 "" lenline += 2; -#line 435 "" +#line 438 "" termrpt = TRUE_; -#line 436 "" +#line 439 "" i__1 = ib - 3; -#line 436 "" +#line 439 "" s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - i__1); -#line 437 "" +#line 440 "" goto L10; -#line 438 "" +#line 441 "" } /* +++ 060812 */ -#line 441 "" +#line 444 "" } else if (ia == 1) { -#line 442 "" +#line 445 "" idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1); -#line 443 "" +#line 446 "" if (idxq > idxa && idxq < ib) { /* Quote is between P and next blank. Find 2nd quote, starting at the blank. */ -#line 447 "" +#line 450 "" idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128, (ftnlen)1); -#line 448 "" +#line 451 "" i__1 = idxq2; -#line 448 "" +#line 451 "" if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 + 1 - i__1, (ftnlen)1) != 0) { -#line 449 "" +#line 452 "" s_wsle(&io___77); -#line 449 "" +#line 452 "" e_wsle(); -#line 450 "" +#line 453 "" s_wsle(&io___78); -#line 450 "" +#line 453 "" do_lio(&c__9, &c__1, "Error copying P with q"\ "uotes, idxq2:", (ftnlen)35); -#line 450 "" +#line 453 "" do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen) sizeof(integer)); -#line 450 "" +#line 453 "" e_wsle(); -#line 451 "" +#line 454 "" s_wsle(&io___79); -#line 451 "" +#line 454 "" do_lio(&c__9, &c__1, line, (ftnlen)60); -#line 451 "" +#line 454 "" e_wsle(); -#line 452 "" +#line 455 "" s_stop("1", (ftnlen)1); -#line 453 "" +#line 456 "" } -#line 454 "" +#line 457 "" ib = idxq2 + 1; -#line 455 "" +#line 458 "" } /* Do not transfer P into parts. */ -#line 459 "" +#line 462 "" goto L12; -#line 460 "" +#line 463 "" } else if (ia == 9) { /* Start Saving a macro. After leaving here, a symbol will be sent to all parts, */ /* If all on this line, set ib to end and exit normally. */ -#line 465 "" +#line 468 "" i__1 = ib; -#line 465 "" +#line 468 "" ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1) ; -#line 466 "" +#line 469 "" i__1 = ib + ndxm - 2; -#line 466 "" +#line 469 "" if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1 - i__1, (ftnlen)1) == 0) { /* Macro ends on this line */ -#line 470 "" +#line 473 "" ib = ib + ndxm + 1; -#line 471 "" +#line 474 "" } else { /* Save leading part of current line */ -#line 475 "" +#line 478 "" lenhold = idxa - 1; -#line 476 "" +#line 479 "" if (lenhold > 0) { -#line 476 "" +#line 479 "" s_copy(holdln, line, (ftnlen)128, lenhold); -#line 476 "" +#line 479 "" } /* Transfer rest of line */ -#line 480 "" +#line 483 "" i__1 = 129 - idxa; -#line 480 "" +#line 483 "" allparts_(line + (idxa - 1), &i__1, 128 - (idxa - 1)); /* Read next line */ -#line 484 "" +#line 487 "" L20: -#line 484 "" +#line 487 "" s_rsfe(&io___82); -#line 484 "" +#line 487 "" do_fio(&c__1, line, (ftnlen)128); -#line 484 "" +#line 487 "" e_rsfe(); /* Check for comment, transfer and loop if so */ /* if (line(1:1) .eq.'%') then */ -#line 489 "" +#line 492 "" L23: -#line 489 "" +#line 492 "" if (*(unsigned char *)line == '%') { /* call allparts(line,128) */ /* go to 20 */ -#line 492 "" +#line 495 "" chkcom_(line, &goto999, (ftnlen)128); -#line 493 "" +#line 496 "" goto L23; -#line 494 "" +#line 497 "" } /* Look for terminal ' M' */ -#line 498 "" +#line 501 "" if (*(unsigned char *)line == 'M') { -#line 499 "" +#line 502 "" ndxm = 1; -#line 500 "" +#line 503 "" } else { -#line 501 "" +#line 504 "" ndxm = i_indx(line, " M", (ftnlen)128, ( ftnlen)2); -#line 502 "" +#line 505 "" if (ndxm > 0) { -#line 502 "" +#line 505 "" ++ndxm; -#line 502 "" +#line 505 "" } -#line 503 "" +#line 506 "" } -#line 504 "" +#line 507 "" if (ndxm > 0) { /* Set parameters, exit normally (but later check for leading part of 1st line */ -#line 508 "" +#line 511 "" idxa = 1; -#line 509 "" +#line 512 "" ib = ndxm + 1; -#line 510 "" +#line 513 "" } else { /* No "M", transfer entire line, loop */ -#line 514 "" +#line 517 "" allparts_(line, &c__128, (ftnlen)128); -#line 515 "" +#line 518 "" goto L20; -#line 516 "" +#line 519 "" } -#line 517 "" +#line 520 "" } -#line 518 "" +#line 521 "" } else if (ia == 10) { /* Do not transfer MIDI command into parts */ -#line 522 "" +#line 525 "" goto L12; -#line 523 "" +#line 526 "" } else if (ia == 5) { /* First check for "AS", but S may come after other "A" options */ -#line 527 "" +#line 530 "" i__1 = idxa; -#line 527 "" +#line 530 "" idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1); -#line 528 "" +#line 531 "" if (idxs > 0) { /* Get rid of the string. First check if that's all there is in A. */ -#line 532 "" +#line 535 "" if (ib - idxa == nv + 2) { -#line 532 "" +#line 535 "" goto L12; -#line 532 "" +#line 535 "" } -#line 533 "" +#line 536 "" i__1 = idxa + idxs + nv; /* Writing concatenation */ -#line 533 "" +#line 536 "" i__3[0] = idxa + idxs - 1, a__1[0] = line; -#line 533 "" +#line 536 "" i__3[1] = ib - i__1, a__1[1] = line + i__1; -#line 533 "" +#line 536 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 534 "" +#line 537 "" } /* Check for user-defined part file name. Must start in column 1 and have */ @@ -1404,353 +1407,353 @@ L23: /* ib is position of the next blank after "A" */ /* Don't allow any blanks in user */ -#line 542 "" +#line 545 "" i__1 = idxa; -#line 542 "" +#line 545 "" if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen) 1) != 0) { -#line 542 "" +#line 545 "" goto L9; -#line 542 "" +#line 545 "" } /* bail out */ -#line 543 "" +#line 546 "" if (idxa != 1) { -#line 544 "" +#line 547 "" s_wsle(&io___84); -#line 544 "" +#line 547 "" e_wsle(); -#line 545 "" +#line 548 "" s_wsle(&io___85); -#line 545 "" +#line 548 "" do_lio(&c__9, &c__1, "You entered \"AN...\" some"\ "where beyond first column; stopping.", ( ftnlen)60); -#line 545 "" +#line 548 "" e_wsle(); -#line 547 "" +#line 550 "" s_stop("1", (ftnlen)1); -#line 548 "" +#line 551 "" } /* pmxa already checked for valid one- or 2-digit number, so get it */ -#line 552 "" +#line 555 "" if (*(unsigned char *)&line[3] == '"') { /* Single digit instrument number */ -#line 556 "" +#line 559 "" s_rsfi(&io___86); -#line 556 "" +#line 559 "" do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( integer)); -#line 556 "" +#line 559 "" e_rsfi(); -#line 557 "" +#line 560 "" idxstartname = 5; -#line 558 "" +#line 561 "" } else { -#line 559 "" +#line 562 "" s_rsfi(&io___89); -#line 559 "" +#line 562 "" do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( integer)); -#line 559 "" +#line 562 "" e_rsfi(); -#line 560 "" +#line 563 "" idxstartname = 6; -#line 561 "" +#line 564 "" } -#line 562 "" +#line 565 "" ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1), "\"", 128 - (idxstartname - 1), (ftnlen)1) - 1; -#line 563 "" +#line 566 "" if (ludpfn[iudpfn - 1] < 0) { -#line 564 "" +#line 567 "" s_wsle(&io___90); -#line 564 "" +#line 567 "" e_wsle(); -#line 565 "" +#line 568 "" s_wsle(&io___91); -#line 565 "" +#line 568 "" do_lio(&c__9, &c__1, "User-defined part file nam"\ "e must be in quotes", (ftnlen)45); -#line 565 "" +#line 568 "" e_wsle(); -#line 566 "" +#line 569 "" s_stop("1", (ftnlen)1); -#line 567 "" +#line 570 "" } -#line 568 "" +#line 571 "" idxendname = idxstartname + ludpfn[iudpfn - 1] - 1; -#line 569 "" +#line 572 "" s_copy(udpfnq + (iudpfn - 1 << 7), line + ( idxstartname - 1), (ftnlen)128, idxendname - ( idxstartname - 1)); /* Get a new line! */ -#line 573 "" +#line 576 "" goto L4; -#line 574 "" +#line 577 "" } else if (ia == 8) { /* Key change/transposition. */ /* If not instrument specific, copy to all parts */ -#line 579 "" +#line 582 "" i__1 = idxa; -#line 579 "" +#line 582 "" if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen) 1) != 0) { -#line 579 "" +#line 582 "" goto L9; -#line 579 "" +#line 582 "" } /* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */ -#line 583 "" +#line 586 "" ibb = idxa + 2; /* Starts on digit after 'i' */ -#line 584 "" +#line 587 "" L40: -#line 585 "" +#line 588 "" ici__1.icierr = 0; -#line 585 "" +#line 588 "" ici__1.iciend = 0; -#line 585 "" +#line 588 "" ici__1.icirnum = 1; -#line 585 "" +#line 588 "" ici__1.icirlen = 1; -#line 585 "" +#line 588 "" ici__1.iciunit = line + (ibb - 1); -#line 585 "" +#line 588 "" ici__1.icifmt = "(i1)"; -#line 585 "" +#line 588 "" s_rsfi(&ici__1); -#line 585 "" +#line 588 "" do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer) ); -#line 585 "" +#line 588 "" e_rsfi(); /* 1st digit of iinst */ -#line 586 "" +#line 589 "" i__1 = ibb; -#line 586 "" +#line 589 "" itemp = i_indx("01234567890", line + i__1, (ftnlen)11, ibb + 1 - i__1); -#line 587 "" +#line 590 "" if (itemp > 0) { -#line 588 "" +#line 591 "" ++ibb; -#line 589 "" +#line 592 "" iiinst = iiinst * 10 + itemp - 1; -#line 590 "" +#line 593 "" } -#line 591 "" +#line 594 "" ++ibb; /* now at first +/-. Need end of 2nd number */ -#line 592 "" +#line 595 "" i__1 = ibb; -#line 592 "" +#line 595 "" itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1) ; /* Rel pos'n of next 'i' */ -#line 593 "" +#line 596 "" if (itemp > 0) { -#line 594 "" +#line 597 "" iend = ibb + itemp - 1; -#line 595 "" +#line 598 "" } else { -#line 596 "" +#line 599 "" iend = ib - 1; -#line 597 "" +#line 600 "" } -#line 598 "" +#line 601 "" io___98.ciunit = all_1.iorig[iiinst - 1] + 10; -#line 598 "" +#line 601 "" s_wsfe(&io___98); /* Writing concatenation */ -#line 598 "" +#line 601 "" i__3[0] = 3, a__1[0] = "Ki1"; -#line 598 "" +#line 601 "" i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1) ; -#line 598 "" +#line 601 "" s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131); -#line 598 "" +#line 601 "" do_fio(&c__1, ch__6, iend - (ibb - 1) + 3); -#line 598 "" +#line 601 "" e_wsfe(); -#line 599 "" +#line 602 "" if (itemp > 0) { -#line 600 "" +#line 603 "" ibb = iend + 2; -#line 601 "" +#line 604 "" goto L40; -#line 602 "" +#line 605 "" } -#line 603 "" +#line 606 "" goto L12; /* Remove K command from string, go to next ia */ -#line 604 "" +#line 607 "" } -#line 605 "" +#line 608 "" L9: -#line 606 "" +#line 609 "" i__1 = ib - idxa; -#line 606 "" +#line 609 "" allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1)); -#line 607 "" +#line 610 "" L12: /* Remove the string from line */ -#line 611 "" +#line 614 "" if (idxa == 1) { -#line 612 "" +#line 615 "" s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib - 1)); -#line 613 "" +#line 616 "" } else { /* Writing concatenation */ -#line 614 "" +#line 617 "" i__3[0] = idxa - 1, a__1[0] = line; -#line 614 "" +#line 617 "" i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1); -#line 614 "" +#line 617 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 615 "" +#line 618 "" } -#line 616 "" +#line 619 "" lenline = lenstr_(line, &c__128, (ftnlen)128); /* Loop if only blanks are left */ -#line 620 "" +#line 623 "" if (lenline == 0) { -#line 620 "" +#line 623 "" goto L4; -#line 620 "" +#line 623 "" } /* Must check for multiple "I" commands, so go to just after start of ia loop */ -#line 624 "" +#line 627 "" if (ia == 10) { -#line 624 "" +#line 627 "" goto L24; -#line 624 "" +#line 627 "" } /* Tack on front part from 1st line of saved macro */ -#line 628 "" +#line 631 "" if (lenhold > 0) { /* Writing concatenation */ -#line 629 "" +#line 632 "" i__4[0] = lenhold, a__2[0] = holdln; -#line 629 "" +#line 632 "" i__4[1] = 1, a__2[1] = " "; -#line 629 "" +#line 632 "" i__4[2] = lenline, a__2[2] = line; -#line 629 "" +#line 632 "" s_cat(line, a__2, i__4, &c__3, (ftnlen)128); -#line 630 "" +#line 633 "" lenhold = 0; -#line 631 "" +#line 634 "" } -#line 632 "" +#line 635 "" } -#line 633 "" +#line 636 "" /* L5: */ -#line 633 "" +#line 636 "" } -#line 634 "" +#line 637 "" } -#line 634 "" +#line 637 "" } /* Now a special loop to deal with 'X'. If it was %[n]X..., will have been */ /* copied into part [n] already. If no "B" or "P", remove. If "P", just */ /* remove the "P" so pmxa/b will process. If "B". do nothing. */ -#line 640 "" +#line 643 "" L10: -#line 641 "" +#line 644 "" nchk = 1; -#line 642 "" +#line 645 "" L13: -#line 642 "" +#line 645 "" ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), ( ftnlen)1); -#line 643 "" +#line 646 "" if (ntinx > nchk - 1) { /* There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. */ -#line 647 "" +#line 650 "" if (ntinx > 1) { -#line 648 "" +#line 651 "" i__1 = ntinx - 2; -#line 648 "" +#line 651 "" if (s_cmp(line + i__1, " ", ntinx - 1 - i__1, (ftnlen)1) != 0) { /* The X is not 1st char of PMX command. Advance starting point, loop. */ -#line 652 "" +#line 655 "" nchk = ntinx + 1; -#line 653 "" +#line 656 "" goto L13; -#line 654 "" +#line 657 "" } -#line 655 "" +#line 658 "" } /* We now know the X at ntinx starts a PMX command. Find next blank */ -#line 659 "" +#line 662 "" i__1 = ntinx; -#line 659 "" +#line 662 "" ib = ntinx + i_indx(line + i__1, " ", 128 - i__1, (ftnlen)1); /* There must be a blank to right of "X", so ib>ntinx */ /* locp = nchk-1+index(line(nchk:ib),'P') */ -#line 664 "" +#line 667 "" i__1 = ntinx; -#line 664 "" +#line 667 "" locp = ntinx + i_indx(line + i__1, "P", ib - i__1, (ftnlen)1); /* Did not need to use ntindex because we already know bounds of PMX command. */ /* if (locp .gt. nchk-1) then */ -#line 669 "" +#line 672 "" if (locp > ntinx) { /* Strip out the 'P' */ -#line 673 "" +#line 676 "" s_copy(templine, line, (ftnlen)128, locp - 1); -#line 674 "" +#line 677 "" i__1 = locp; /* Writing concatenation */ -#line 674 "" +#line 677 "" i__3[0] = locp - 1, a__1[0] = templine; -#line 674 "" +#line 677 "" i__3[1] = lenline - i__1, a__1[1] = line + i__1; -#line 674 "" +#line 677 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 675 "" +#line 678 "" --lenline; -#line 676 "" +#line 679 "" --ib; -#line 677 "" +#line 680 "" } -#line 678 "" +#line 681 "" if (i_indx(line + (ntinx - 1), ":", ib - (ntinx - 1), (ftnlen)1) > 0 || i_indx(line + (ntinx - 1), "S", ib - (ntinx - 1), (ftnlen) 1) > 0 || i_indx(line + (ntinx - 1), "B", ib - (ntinx - 1), ( @@ -1758,177 +1761,177 @@ L13: /* The X command is a shift, "Both", or "Part". Do not remove. */ -#line 684 "" +#line 687 "" nchk = ib + 1; -#line 685 "" +#line 688 "" goto L13; -#line 686 "" +#line 689 "" } /* Remove the X command. */ -#line 690 "" +#line 693 "" if (ntinx == 1) { -#line 691 "" +#line 694 "" if (ib < lenline) { -#line 692 "" +#line 695 "" i__1 = ib; -#line 692 "" +#line 695 "" s_copy(line, line + i__1, (ftnlen)128, lenline - i__1); -#line 693 "" +#line 696 "" } else { /* line contains ONLY the "X" command, so get a new line */ -#line 697 "" +#line 700 "" goto L4; -#line 698 "" +#line 701 "" } -#line 699 "" +#line 702 "" } else { -#line 700 "" +#line 703 "" s_copy(templine, line, (ftnlen)128, ntinx - 1); -#line 701 "" +#line 704 "" if (ib < lenline) { -#line 702 "" +#line 705 "" i__1 = ib; /* Writing concatenation */ -#line 702 "" +#line 705 "" i__3[0] = ntinx - 1, a__1[0] = templine; -#line 702 "" +#line 705 "" i__3[1] = lenline - i__1, a__1[1] = line + i__1; -#line 702 "" +#line 705 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 703 "" +#line 706 "" } else { -#line 704 "" +#line 707 "" s_copy(line, templine, (ftnlen)128, ntinx - 1); -#line 705 "" +#line 708 "" } -#line 706 "" +#line 709 "" } /* Recompute lenline */ -#line 710 "" +#line 713 "" lenline = lenstr_(line, &c__128, (ftnlen)128); /* Resume checking after location of removed command. */ -#line 714 "" +#line 717 "" nchk = ntinx; -#line 715 "" +#line 718 "" goto L13; -#line 716 "" +#line 719 "" } /* End of loop for X-checks */ -#line 720 "" +#line 723 "" oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0; -#line 721 "" +#line 724 "" if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[ lenline - 1] == '/') { /* Must add a terminal repeat before the slash */ -#line 726 "" +#line 729 "" if (oneof2) { -#line 726 "" +#line 729 "" --lenline; -#line 726 "" +#line 729 "" } -#line 727 "" +#line 730 "" if (lenline > 1) { -#line 727 "" +#line 730 "" io___103.ciunit = all_1.iorig[iinst - 1] + 10; -#line 727 "" +#line 730 "" s_wsfe(&io___103); -#line 727 "" +#line 730 "" do_fio(&c__1, line, lenline - 1); -#line 727 "" +#line 730 "" e_wsfe(); -#line 727 "" +#line 730 "" } -#line 728 "" +#line 731 "" if (! oneof2) { /* Writing concatenation */ -#line 729 "" +#line 732 "" i__3[0] = 2, a__1[0] = termsym; -#line 729 "" +#line 732 "" i__3[1] = 2, a__1[1] = " /"; -#line 729 "" +#line 732 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 730 "" +#line 733 "" lenline = 4; -#line 731 "" +#line 734 "" } else { /* Writing concatenation */ -#line 732 "" +#line 735 "" i__3[0] = 2, a__1[0] = termsym; -#line 732 "" +#line 735 "" i__3[1] = 3, a__1[1] = " //"; -#line 732 "" +#line 735 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); -#line 733 "" +#line 736 "" lenline = 5; -#line 734 "" +#line 737 "" } -#line 735 "" +#line 738 "" } -#line 736 "" +#line 739 "" if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' && iv == all_1.nvnow) { -#line 736 "" +#line 739 "" termrpt = FALSE_; -#line 736 "" +#line 739 "" } -#line 738 "" +#line 741 "" io___104.ciunit = all_1.iorig[iinst - 1] + 10; -#line 738 "" +#line 741 "" s_wsfe(&io___104); -#line 738 "" +#line 741 "" do_fio(&c__1, line, lenline); -#line 738 "" +#line 741 "" e_wsfe(); -#line 739 "" +#line 742 "" if (oneof2) { -#line 740 "" +#line 743 "" frstln = FALSE_; -#line 741 "" +#line 744 "" } else if (! frstln) { -#line 742 "" +#line 745 "" frstln = TRUE_; -#line 743 "" +#line 746 "" } /* if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */ -#line 745 "" +#line 748 "" if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line, "//", (ftnlen)128, (ftnlen)2) == 0) { -#line 746 "" +#line 749 "" iv = iv % all_1.nvnow + 1; -#line 747 "" +#line 750 "" iinst = all_1.instnum[iv - 1]; -#line 748 "" +#line 751 "" } -#line 749 "" +#line 752 "" goto L4; -#line 750 "" +#line 753 "" L999: -#line 751 "" +#line 754 "" cl__1.cerr = 0; -#line 751 "" +#line 754 "" cl__1.cunit = 10; -#line 751 "" +#line 754 "" cl__1.csta = 0; -#line 751 "" +#line 754 "" f_clos(&cl__1); /* In the mbrest checks, must run through ALL noinst files (not just noinow) */ -#line 755 "" +#line 758 "" i__1 = all_1.noinst; -#line 755 "" +#line 758 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* cc+++ */ /* c */ @@ -1948,28 +1951,28 @@ L999: /* 51 continue */ /* close(40) */ /* cc+++ */ -#line 774 "" +#line 777 "" if (all_1.nvi[iinst - 1] == 1) { -#line 775 "" +#line 778 "" mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + ( iinst - 1 << 7), (ftnlen)27, (ftnlen)128); -#line 776 "" +#line 779 "" } else { /* Send a signal with ljob to bypass most mbrest processing */ -#line 780 "" +#line 783 "" i__2 = -ljob; -#line 780 "" +#line 783 "" mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + ( iinst - 1 << 7), (ftnlen)27, (ftnlen)128); -#line 781 "" +#line 784 "" } -#line 782 "" +#line 785 "" /* L11: */ -#line 782 "" +#line 785 "" } -#line 783 "" +#line 786 "" return 0; } /* MAIN__ */ @@ -1978,21 +1981,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) /* System generated locals */ integer ret_val; -#line 786 "" +#line 789 "" for (ret_val = *n; ret_val >= 1; --ret_val) { -#line 787 "" +#line 790 "" if (*(unsigned char *)&string[ret_val - 1] != ' ') { -#line 787 "" +#line 790 "" return ret_val; -#line 787 "" +#line 790 "" } -#line 788 "" +#line 791 "" /* L1: */ -#line 788 "" +#line 791 "" } -#line 789 "" +#line 792 "" ret_val = 0; -#line 790 "" +#line 793 "" return ret_val; } /* lenstr_ */ @@ -2013,33 +2016,33 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) static cilist io___107 = { 0, 0, 0, "(a)", 0 }; -#line 798 "" +#line 801 "" len = lenstr_(string, n, string_len); -#line 799 "" +#line 802 "" if (len == 0) { -#line 800 "" +#line 803 "" len = 1; -#line 801 "" +#line 804 "" s_copy(string, " ", string_len, (ftnlen)1); -#line 802 "" +#line 805 "" } -#line 803 "" +#line 806 "" i__1 = all_1.noinow; -#line 803 "" +#line 806 "" for (iinst = 1; iinst <= i__1; ++iinst) { -#line 804 "" +#line 807 "" io___107.ciunit = all_1.iorig[iinst - 1] + 10; -#line 804 "" +#line 807 "" s_wsfe(&io___107); -#line 804 "" +#line 807 "" do_fio(&c__1, string, len); -#line 804 "" +#line 807 "" e_wsfe(); -#line 805 "" +#line 808 "" /* L1: */ -#line 805 "" +#line 808 "" } -#line 806 "" +#line 809 "" return 0; } /* allparts_ */ @@ -2123,731 +2126,731 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) static cilist io___162 = { 0, 40, 0, "(a)", 0 }; -#line 816 "" +#line 819 "" type4 = FALSE_; -#line 817 "" +#line 820 "" *(unsigned char *)sq = '\\'; -#line 818 "" +#line 821 "" alldone = FALSE_; -#line 819 "" +#line 822 "" al__1.aerr = 0; -#line 819 "" +#line 822 "" al__1.aunit = *iv + 10; -#line 819 "" +#line 822 "" f_rew(&al__1); -#line 820 "" +#line 823 "" if (*iv < 10) { -#line 821 "" +#line 824 "" *(unsigned char *)partq = (char) (*iv + 48); -#line 822 "" +#line 825 "" lpart = 1; -#line 823 "" +#line 826 "" } else { -#line 824 "" +#line 827 "" lpart = 2; -#line 825 "" +#line 828 "" if (*iv < 20) { /* Writing concatenation */ -#line 826 "" +#line 829 "" i__1[0] = 1, a__1[0] = "1"; -#line 826 "" +#line 829 "" *(unsigned char *)&ch__1[0] = *iv + 38; -#line 826 "" +#line 829 "" i__1[1] = 1, a__1[1] = ch__1; -#line 826 "" +#line 829 "" s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); -#line 827 "" +#line 830 "" } else { /* Writing concatenation */ -#line 828 "" +#line 831 "" i__1[0] = 1, a__1[0] = "2"; -#line 828 "" +#line 831 "" *(unsigned char *)&ch__1[0] = *iv + 28; -#line 828 "" +#line 831 "" i__1[1] = 1, a__1[1] = ch__1; -#line 828 "" +#line 831 "" s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); -#line 829 "" +#line 832 "" } -#line 830 "" +#line 833 "" } /* 130327 */ /* open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') */ -#line 833 "" +#line 836 "" if (*ludpfn == 0) { -#line 834 "" +#line 837 "" o__1.oerr = 0; -#line 834 "" +#line 837 "" o__1.ounit = 40; -#line 834 "" +#line 837 "" o__1.ofnmlen = abs(*ljob) + lpart + 4; /* Writing concatenation */ -#line 834 "" +#line 837 "" i__2[0] = abs(*ljob), a__2[0] = jobname; -#line 834 "" +#line 837 "" i__2[1] = lpart, a__2[1] = partq; -#line 834 "" +#line 837 "" i__2[2] = 4, a__2[2] = ".pmx"; -#line 834 "" +#line 837 "" s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18); -#line 834 "" +#line 837 "" o__1.ofnm = ch__2; -#line 834 "" +#line 837 "" o__1.orl = 0; -#line 834 "" +#line 837 "" o__1.osta = 0; -#line 834 "" +#line 837 "" o__1.oacc = 0; -#line 834 "" +#line 837 "" o__1.ofm = 0; -#line 834 "" +#line 837 "" o__1.oblnk = 0; -#line 834 "" +#line 837 "" f_open(&o__1); -#line 835 "" +#line 838 "" } else { -#line 836 "" +#line 839 "" o__1.oerr = 0; -#line 836 "" +#line 839 "" o__1.ounit = 40; -#line 836 "" +#line 839 "" o__1.ofnmlen = *ludpfn + 4; /* Writing concatenation */ -#line 836 "" +#line 839 "" i__1[0] = *ludpfn, a__1[0] = udpfnq; -#line 836 "" +#line 839 "" i__1[1] = 4, a__1[1] = ".pmx"; -#line 836 "" +#line 839 "" s_cat(ch__3, a__1, i__1, &c__2, (ftnlen)132); -#line 836 "" +#line 839 "" o__1.ofnm = ch__3; -#line 836 "" +#line 839 "" o__1.orl = 0; -#line 836 "" +#line 839 "" o__1.osta = 0; -#line 836 "" +#line 839 "" o__1.oacc = 0; -#line 836 "" +#line 839 "" o__1.ofm = 0; -#line 836 "" +#line 839 "" o__1.oblnk = 0; -#line 836 "" +#line 839 "" f_open(&o__1); -#line 837 "" +#line 840 "" } -#line 838 "" +#line 841 "" for (i__ = 1; i__ <= 10000; ++i__) { -#line 839 "" +#line 842 "" io___114.ciunit = *iv + 10; -#line 839 "" +#line 842 "" s_rsfe(&io___114); -#line 839 "" +#line 842 "" do_fio(&c__1, line, (ftnlen)128); -#line 839 "" +#line 842 "" e_rsfe(); -#line 840 "" +#line 843 "" if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0 || type4) { -#line 842 "" +#line 845 "" len = lenstr_(line, &c__128, (ftnlen)128); -#line 843 "" +#line 846 "" if (len > 0) { -#line 844 "" +#line 847 "" s_wsfe(&io___117); -#line 844 "" +#line 847 "" do_fio(&c__1, line, len); -#line 844 "" +#line 847 "" e_wsfe(); -#line 845 "" +#line 848 "" } else { -#line 846 "" +#line 849 "" s_wsfe(&io___118); -#line 846 "" +#line 849 "" do_fio(&c__1, " ", (ftnlen)1); -#line 846 "" +#line 849 "" e_wsfe(); -#line 847 "" +#line 850 "" } -#line 848 "" +#line 851 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { -#line 848 "" +#line 851 "" type4 = ! type4; -#line 848 "" +#line 851 "" } -#line 849 "" +#line 852 "" } else { -#line 850 "" +#line 853 "" goto L11; -#line 851 "" +#line 854 "" } -#line 852 "" +#line 855 "" /* L10: */ -#line 852 "" +#line 855 "" } -#line 853 "" +#line 856 "" s_wsle(&io___119); -#line 853 "" +#line 856 "" do_lio(&c__9, &c__1, "You should not be here in scor2prt. Call Dr. Don", (ftnlen)49); -#line 853 "" +#line 856 "" e_wsle(); -#line 854 "" +#line 857 "" s_stop("", (ftnlen)0); -#line 855 "" +#line 858 "" L11: /* Finished reading opening type4 TeX and comments. Next line to be read */ /* will contain the first of the input numbers */ -#line 860 "" +#line 863 "" dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128); -#line 861 "" +#line 864 "" for (i__ = 1; i__ <= 10000; ++i__) { -#line 862 "" +#line 865 "" L13: -#line 862 "" +#line 865 "" io___122.ciunit = *iv + 10; -#line 862 "" +#line 865 "" i__3 = s_rsfe(&io___122); -#line 862 "" +#line 865 "" if (i__3 != 0) { -#line 862 "" +#line 865 "" goto L999; -#line 862 "" +#line 865 "" } -#line 862 "" +#line 865 "" i__3 = do_fio(&c__1, line, (ftnlen)128); -#line 862 "" +#line 865 "" if (i__3 != 0) { -#line 862 "" +#line 865 "" goto L999; -#line 862 "" +#line 865 "" } -#line 862 "" +#line 865 "" i__3 = e_rsfe(); -#line 862 "" +#line 865 "" if (i__3 != 0) { -#line 862 "" +#line 865 "" goto L999; -#line 862 "" +#line 865 "" } -#line 863 "" +#line 866 "" L7: -#line 863 "" +#line 866 "" len = lenstr_(line, &c__128, (ftnlen)128); /* Pass-through (and copy into part file) if instrumnet has >1 voice. */ -#line 867 "" +#line 870 "" if (*ljob < 0) { -#line 867 "" +#line 870 "" goto L2; -#line 867 "" +#line 870 "" } -#line 868 "" +#line 871 "" if (i_indx("TtTiTch+h-h l ", line, (ftnlen)14, (ftnlen)2) > 0) { /* Traps titles, instruments, composers, headers, lower strings. Read 2 lines. */ -#line 872 "" +#line 875 "" s_wsfe(&io___123); -#line 872 "" +#line 875 "" do_fio(&c__1, line, len); -#line 872 "" +#line 875 "" e_wsfe(); -#line 873 "" +#line 876 "" io___124.ciunit = *iv + 10; -#line 873 "" +#line 876 "" s_rsfe(&io___124); -#line 873 "" +#line 876 "" do_fio(&c__1, line, (ftnlen)128); -#line 873 "" +#line 876 "" e_rsfe(); -#line 874 "" +#line 877 "" len = lenstr_(line, &c__128, (ftnlen)128); -#line 875 "" +#line 878 "" goto L2; -#line 876 "" +#line 879 "" } -#line 877 "" +#line 880 "" if (i__ == 1 || i__ > 5 && *(unsigned char *)&line[0] == 'm') { /* Either just starting, or a new meter is defined. */ /* NOTE! The above test may be bogus. */ -#line 882 "" +#line 885 "" if (*(unsigned char *)&line[0] == '%') { -#line 883 "" +#line 886 "" s_wsfe(&io___125); -#line 883 "" +#line 886 "" do_fio(&c__1, line, len); -#line 883 "" +#line 886 "" e_wsfe(); -#line 884 "" +#line 887 "" goto L13; -#line 885 "" +#line 888 "" } -#line 886 "" +#line 889 "" if (i__ != 1) { /* New meter. Check for slashes (new meter change syntax) */ -#line 890 "" +#line 893 "" idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1); -#line 891 "" +#line 894 "" idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); -#line 892 "" +#line 895 "" newmtr = idxs > 0 && (idxb == 0 || idxs < idxb); -#line 893 "" +#line 896 "" if (! newmtr) { /* Old way, no slashes, uses 'o' for lonesome '1' */ -#line 897 "" +#line 900 "" icden = 3; -#line 898 "" +#line 901 "" if (*(unsigned char *)&line[1] == 'o') { -#line 899 "" +#line 902 "" mtrnum = 1; -#line 900 "" +#line 903 "" } else { -#line 901 "" +#line 904 "" mtrnum = *(unsigned char *)&line[1] - 48; -#line 902 "" +#line 905 "" if (mtrnum == 1) { -#line 903 "" +#line 906 "" icden = 4; -#line 904 "" +#line 907 "" mtrnum = *(unsigned char *)&line[2] - 38; -#line 905 "" +#line 908 "" } -#line 906 "" +#line 909 "" } -#line 907 "" +#line 910 "" mtrden = *(unsigned char *)&line[icden - 1] - 48; -#line 908 "" +#line 911 "" } else { /* New way with slashes: idxs is index of 1st slash! */ -#line 912 "" +#line 915 "" ici__1.icierr = 0; -#line 912 "" +#line 915 "" ici__1.iciend = 0; -#line 912 "" +#line 915 "" ici__1.icirnum = 1; -#line 912 "" +#line 915 "" ici__1.icirlen = idxs - 2; -#line 912 "" +#line 915 "" ici__1.iciunit = line + 1; /* Writing concatenation */ -#line 912 "" +#line 915 "" i__2[0] = 2, a__2[0] = "(i"; -#line 912 "" +#line 915 "" *(unsigned char *)&ch__1[0] = idxs + 46; -#line 912 "" +#line 915 "" i__2[1] = 1, a__2[1] = ch__1; -#line 912 "" +#line 915 "" i__2[2] = 1, a__2[2] = ")"; -#line 912 "" +#line 915 "" ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen) 4), ch__4); -#line 912 "" +#line 915 "" s_rsfi(&ici__1); -#line 912 "" +#line 915 "" do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer)); -#line 912 "" +#line 915 "" e_rsfi(); -#line 913 "" +#line 916 "" i__3 = idxs; -#line 913 "" +#line 916 "" idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1); -#line 914 "" +#line 917 "" i__3 = idxs; -#line 914 "" +#line 917 "" ici__1.icierr = 0; -#line 914 "" +#line 917 "" ici__1.iciend = 0; -#line 914 "" +#line 917 "" ici__1.icirnum = 1; -#line 914 "" +#line 917 "" ici__1.icirlen = idxs + idxb - 1 - i__3; -#line 914 "" +#line 917 "" ici__1.iciunit = line + i__3; /* Writing concatenation */ -#line 914 "" +#line 917 "" i__2[0] = 2, a__2[0] = "(i"; -#line 914 "" +#line 917 "" *(unsigned char *)&ch__1[0] = idxb + 47; -#line 914 "" +#line 917 "" i__2[1] = 1, a__2[1] = ch__1; -#line 914 "" +#line 917 "" i__2[2] = 1, a__2[2] = ")"; -#line 914 "" +#line 917 "" ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen) 4), ch__4); -#line 914 "" +#line 917 "" s_rsfi(&ici__1); -#line 914 "" +#line 917 "" do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer)); -#line 914 "" +#line 917 "" e_rsfi(); -#line 916 "" +#line 919 "" } -#line 917 "" +#line 920 "" } -#line 918 "" +#line 921 "" lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1); -#line 919 "" +#line 922 "" lenmult = 1; -#line 920 "" +#line 923 "" if (mtrden == 2) { -#line 921 "" +#line 924 "" lenbeat = 16; -#line 922 "" +#line 925 "" lenmult = 2; -#line 923 "" +#line 926 "" } -#line 924 "" +#line 927 "" lenbar = lenmult * mtrnum * lenbeat; -#line 925 "" +#line 928 "" fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3); -#line 926 "" +#line 929 "" } /* Finished setting up meter stuff and defining whole-bar rest symbols */ -#line 930 "" +#line 933 "" ip1 = 0; -#line 931 "" +#line 934 "" s_copy(line1, line, (ftnlen)128, (ftnlen)128); -#line 932 "" +#line 935 "" i__3 = nwbrs; -#line 932 "" +#line 935 "" for (iw = 0; iw <= i__3; ++iw) { -#line 933 "" +#line 936 "" if (iw > 0) { -#line 934 "" +#line 937 "" idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128, lwbrs); -#line 935 "" +#line 938 "" if (idx > 0) { /* Check for blank or shifted rest, discount it if it's there */ -#line 939 "" +#line 942 "" i__4 = idx + lwbrs - 1; -#line 939 "" +#line 942 "" if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen) 1) != 0) { -#line 939 "" +#line 942 "" idx = 0; -#line 939 "" +#line 942 "" } -#line 940 "" +#line 943 "" } -#line 941 "" +#line 944 "" } else { -#line 942 "" +#line 945 "" idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2); /* Check for raised rest */ -#line 946 "" +#line 949 "" if (idx > 0) { -#line 947 "" +#line 950 "" i__4 = idx + 1; -#line 947 "" +#line 950 "" if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) != 0) { -#line 947 "" +#line 950 "" idx = 0; -#line 947 "" +#line 950 "" } -#line 948 "" +#line 951 "" } -#line 949 "" +#line 952 "" } -#line 950 "" +#line 953 "" if (idx > 0) { -#line 951 "" +#line 954 "" if (ip1 == 0) { -#line 952 "" +#line 955 "" ip1 = idx; -#line 953 "" +#line 956 "" } else { -#line 954 "" +#line 957 "" ip1 = min(ip1,idx); /* Maybe allows e.g. r0 rp ... */ -#line 955 "" +#line 958 "" } -#line 956 "" +#line 959 "" } -#line 957 "" +#line 960 "" /* L3: */ -#line 957 "" +#line 960 "" } /* Writing concatenation */ -#line 958 "" +#line 961 "" i__1[0] = 1, a__1[0] = sq; -#line 958 "" +#line 961 "" i__1[1] = 1, a__1[1] = sq; -#line 958 "" +#line 961 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)2); -#line 958 "" +#line 961 "" if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) { -#line 958 "" +#line 961 "" goto L2; -#line 958 "" +#line 961 "" } /* Switch to multibar rest search mode!!! Start forward in line(1) */ -#line 963 "" +#line 966 "" rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0; -#line 964 "" +#line 967 "" iline = 1; -#line 965 "" +#line 968 "" nmbr = 1; -#line 966 "" +#line 969 "" if (rpfirst) { -#line 967 "" +#line 970 "" lwbrsx = 2; -#line 968 "" +#line 971 "" } else { -#line 969 "" +#line 972 "" lwbrsx = lwbrs; -#line 970 "" +#line 973 "" } -#line 971 "" +#line 974 "" ipe = ip1 + lwbrsx - 1; /* ip at end of 1st wbrsym */ -#line 972 "" +#line 975 "" L4: -#line 972 "" +#line 975 "" if (ipe == len) { /* Need a new line */ -#line 976 "" +#line 979 "" ++iline; -#line 977 "" +#line 980 "" L6: -#line 977 "" +#line 980 "" io___145.ciunit = *iv + 10; -#line 977 "" +#line 980 "" i__3 = s_rsfe(&io___145); -#line 977 "" +#line 980 "" if (i__3 != 0) { -#line 977 "" +#line 980 "" goto L998; -#line 977 "" +#line 980 "" } -#line 977 "" +#line 980 "" i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128); -#line 977 "" +#line 980 "" if (i__3 != 0) { -#line 977 "" +#line 980 "" goto L998; -#line 977 "" +#line 980 "" } -#line 977 "" +#line 980 "" i__3 = e_rsfe(); -#line 977 "" +#line 980 "" if (i__3 != 0) { -#line 977 "" +#line 980 "" goto L998; -#line 977 "" +#line 980 "" } -#line 978 "" +#line 981 "" len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); -#line 979 "" +#line 982 "" if (*(unsigned char *)&line[(iline - 1) * 128] == '%') { -#line 980 "" +#line 983 "" s_wsfe(&io___146); -#line 980 "" +#line 983 "" do_fio(&c__1, "% Following comment has been moved forward", ( ftnlen)42); -#line 980 "" +#line 983 "" e_wsfe(); -#line 981 "" +#line 984 "" s_wsfe(&io___147); -#line 981 "" +#line 984 "" do_fio(&c__1, line + (iline - 1 << 7), len); -#line 981 "" +#line 984 "" e_wsfe(); -#line 982 "" +#line 985 "" goto L6; -#line 983 "" +#line 986 "" } -#line 984 "" +#line 987 "" ipe = 0; -#line 985 "" +#line 988 "" goto L4; -#line 986 "" +#line 989 "" L998: /* No more input left */ -#line 990 "" +#line 993 "" s_wsle(&io___148); -#line 990 "" +#line 993 "" do_lio(&c__9, &c__1, "All done!", (ftnlen)9); -#line 990 "" +#line 993 "" e_wsle(); -#line 991 "" +#line 994 "" alldone = TRUE_; -#line 992 "" +#line 995 "" ipe = 0; -#line 993 "" +#line 996 "" --iline; -#line 994 "" +#line 997 "" len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); -#line 995 "" +#line 998 "" goto L4; -#line 996 "" +#line 999 "" } else { -#line 997 "" +#line 1000 "" if (alldone) { -#line 998 "" +#line 1001 "" *(unsigned char *)sym = ' '; -#line 999 "" +#line 1002 "" } else { /* ipe 0) { -#line 1009 "" +#line 1012 "" ipe = ipenew; -#line 1010 "" +#line 1013 "" goto L4; -#line 1011 "" +#line 1014 "" } else { -#line 1012 "" +#line 1015 "" wbrest = FALSE_; -#line 1013 "" +#line 1016 "" if (alldone) { -#line 1013 "" +#line 1016 "" goto L12; -#line 1013 "" +#line 1016 "" } -#line 1014 "" +#line 1017 "" i__3 = nwbrs; -#line 1014 "" +#line 1017 "" for (iw = 1; iw <= i__3; ++iw) { -#line 1015 "" +#line 1018 "" wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym, lwbrs) == 0; -#line 1016 "" +#line 1019 "" /* L5: */ -#line 1016 "" +#line 1019 "" } -#line 1017 "" +#line 1020 "" wbrest = wbrest || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && lwbrs == 2 || s_cmp(sym, "rd", lsym, (ftnlen)2) == 0 && lwbrs == 3 || s_cmp(sym, "rp", lsym, (ftnlen)2) == 0 || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && rpfirst; -#line 1021 "" +#line 1024 "" L12: -#line 1021 "" +#line 1024 "" if (wbrest) { -#line 1022 "" +#line 1025 "" ipe = ipenew; -#line 1023 "" +#line 1026 "" ++nmbr; -#line 1024 "" +#line 1027 "" goto L4; -#line 1025 "" +#line 1028 "" } else { /* AHA! Failed prev. test, so last symbol was *not* mbr. */ /* It must be saved, and its starting position is ipenew-lsym+1 */ -#line 1030 "" +#line 1033 "" if (nmbr > 1) { /* Write stuff up to start of mbr */ -#line 1034 "" +#line 1037 "" if (ip1 > 1) { -#line 1034 "" +#line 1037 "" s_wsfe(&io___153); -#line 1034 "" +#line 1037 "" do_fio(&c__1, line, ip1 - 1); -#line 1034 "" +#line 1037 "" e_wsfe(); -#line 1034 "" +#line 1037 "" } /* Insert mbr symbol. Always end with a slash just in case next sym must be */ /* at start of block. May think this causes undefined octaves, but */ /* probably not since it's a single voice. */ -#line 1040 "" +#line 1043 "" r__1 = nmbr + .01f; -#line 1040 "" +#line 1043 "" ndig = (integer) r_lg10(&r__1) + 1; -#line 1041 "" +#line 1044 "" s_wsle(&io___155); -#line 1041 "" +#line 1044 "" do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", ( ftnlen)22); -#line 1041 "" +#line 1044 "" do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof( integer)); -#line 1041 "" +#line 1044 "" do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof( integer)); -#line 1041 "" +#line 1044 "" e_wsle(); -#line 1042 "" +#line 1045 "" ci__1.cierr = 0; -#line 1042 "" +#line 1045 "" ci__1.ciunit = 40; /* Writing concatenation */ -#line 1042 "" +#line 1045 "" i__2[0] = 5, a__2[0] = "(a2,i"; -#line 1042 "" +#line 1045 "" *(unsigned char *)&ch__1[0] = ndig + 48; -#line 1042 "" +#line 1045 "" i__2[1] = 1, a__2[1] = ch__1; -#line 1042 "" +#line 1045 "" i__2[2] = 4, a__2[2] = ",a2)"; -#line 1042 "" +#line 1045 "" ci__1.cifmt = (s_cat(ch__6, a__2, i__2, &c__3, ( ftnlen)10), ch__6); -#line 1042 "" +#line 1045 "" s_wsfe(&ci__1); -#line 1042 "" +#line 1045 "" do_fio(&c__1, "rm", (ftnlen)2); -#line 1042 "" +#line 1045 "" do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer)); -#line 1042 "" +#line 1045 "" do_fio(&c__1, " /", (ftnlen)2); -#line 1042 "" +#line 1045 "" e_wsfe(); -#line 1043 "" +#line 1046 "" if (alldone) { -#line 1043 "" +#line 1046 "" goto L999; -#line 1043 "" +#line 1046 "" } -#line 1044 "" +#line 1047 "" ipc = ipenew - lsym + 1; -#line 1045 "" +#line 1048 "" s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), ( ftnlen)128, len - (ipc - 1)); -#line 1046 "" +#line 1049 "" } else { /* Write old stuff up to end of original lonesome wbr, save the rest. */ @@ -2857,112 +2860,112 @@ L12: /* non-comment line; then revert to normal mode on that. In 3rd case must */ /* split line. */ -#line 1055 "" +#line 1058 "" if (alldone) { -#line 1056 "" +#line 1059 "" s_wsfe(&io___157); -#line 1056 "" +#line 1059 "" do_fio(&c__1, line, len); -#line 1056 "" +#line 1059 "" e_wsfe(); -#line 1057 "" +#line 1060 "" goto L999; -#line 1058 "" +#line 1061 "" } else if (iline > 1) { -#line 1059 "" +#line 1062 "" i__3 = iline - 1; -#line 1059 "" +#line 1062 "" for (il = 1; il <= i__3; ++il) { -#line 1060 "" +#line 1063 "" len = lenstr_(line + (il - 1 << 7), &c__128, ( ftnlen)128); -#line 1061 "" +#line 1064 "" s_wsfe(&io___159); -#line 1061 "" +#line 1064 "" do_fio(&c__1, line + (il - 1 << 7), len); -#line 1061 "" +#line 1064 "" e_wsfe(); -#line 1062 "" +#line 1065 "" /* L9: */ -#line 1062 "" +#line 1065 "" } -#line 1063 "" +#line 1066 "" s_copy(line, line + (iline - 1 << 7), (ftnlen)128, (ftnlen)128); -#line 1064 "" +#line 1067 "" } else { /* Since iline = 1 the wbr is not the last sym, so must split */ -#line 1068 "" +#line 1071 "" s_wsfe(&io___160); -#line 1068 "" +#line 1071 "" do_fio(&c__1, line, ip1 + lwbrsx - 1); -#line 1068 "" +#line 1071 "" e_wsfe(); -#line 1069 "" +#line 1072 "" i__3 = ip1 + lwbrsx; -#line 1069 "" +#line 1072 "" s_copy(line, line + i__3, (ftnlen)128, len - i__3) ; -#line 1070 "" +#line 1073 "" } -#line 1071 "" +#line 1074 "" } /* Exit multibar mode */ -#line 1075 "" +#line 1078 "" goto L7; -#line 1076 "" +#line 1079 "" } -#line 1077 "" +#line 1080 "" } -#line 1078 "" +#line 1081 "" } -#line 1079 "" +#line 1082 "" L2: -#line 1080 "" +#line 1083 "" if (len > 0) { -#line 1081 "" +#line 1084 "" s_wsfe(&io___161); -#line 1081 "" +#line 1084 "" do_fio(&c__1, line, len); -#line 1081 "" +#line 1084 "" e_wsfe(); -#line 1082 "" +#line 1085 "" } else { -#line 1083 "" +#line 1086 "" s_wsfe(&io___162); -#line 1083 "" +#line 1086 "" do_fio(&c__1, " ", (ftnlen)1); -#line 1083 "" +#line 1086 "" e_wsfe(); -#line 1084 "" +#line 1087 "" } -#line 1085 "" +#line 1088 "" /* L1: */ -#line 1085 "" +#line 1088 "" } -#line 1086 "" +#line 1089 "" L999: -#line 1087 "" +#line 1090 "" cl__1.cerr = 0; -#line 1087 "" +#line 1090 "" cl__1.cunit = *iv + 10; -#line 1087 "" +#line 1090 "" cl__1.csta = 0; -#line 1087 "" +#line 1090 "" f_clos(&cl__1); -#line 1088 "" +#line 1091 "" cl__1.cerr = 0; -#line 1088 "" +#line 1091 "" cl__1.cunit = 40; -#line 1088 "" +#line 1091 "" cl__1.csta = 0; -#line 1088 "" +#line 1091 "" f_clos(&cl__1); -#line 1089 "" +#line 1092 "" return 0; } /* mbrests_ */ @@ -2980,54 +2983,54 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) static cilist io___163 = { 0, 6, 0, 0, 0 }; -#line 1093 "" +#line 1096 "" if (*idur == 6) { -#line 1094 "" +#line 1097 "" ret_val = 1; -#line 1095 "" +#line 1098 "" } else if (*idur == 3) { -#line 1096 "" +#line 1099 "" ret_val = 2; -#line 1097 "" +#line 1100 "" } else if (*idur == 1 || *idur == 16) { -#line 1098 "" +#line 1101 "" ret_val = 4; -#line 1099 "" +#line 1102 "" } else if (*idur == 8) { -#line 1100 "" +#line 1103 "" ret_val = 8; -#line 1101 "" +#line 1104 "" } else if (*idur == 4) { -#line 1102 "" +#line 1105 "" ret_val = 16; -#line 1103 "" +#line 1106 "" } else if (*idur == 2) { -#line 1104 "" +#line 1107 "" ret_val = 32; -#line 1105 "" +#line 1108 "" } else if (*idur == 0) { -#line 1106 "" +#line 1109 "" ret_val = 64; -#line 1107 "" +#line 1110 "" } else { -#line 1108 "" +#line 1111 "" s_wsle(&io___163); -#line 1108 "" +#line 1111 "" do_lio(&c__9, &c__1, "You entered an invalid note-length value", ( ftnlen)40); -#line 1108 "" +#line 1111 "" e_wsle(); -#line 1109 "" +#line 1112 "" s_stop("", (ftnlen)0); -#line 1110 "" +#line 1113 "" } -#line 1111 "" +#line 1114 "" if (*(unsigned char *)dotq == 'd') { -#line 1111 "" +#line 1114 "" ret_val = ret_val * 3 / 2; -#line 1111 "" +#line 1114 "" } -#line 1112 "" +#line 1115 "" return ret_val; } /* ifnodur_ */ @@ -3039,79 +3042,82 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Fortran I/O blocks */ - static cilist io___164 = { 0, 6, 0, "(33H Any whole-bar rests of duratio" - "n ,i3, 26H/64 will not be recognized)", 0 }; + static cilist io___164 = { 0, 6, 0, "(a33,i3,a26)", 0 }; -#line 1116 "" +#line 1119 "" /* Parameter adjustments */ -#line 1116 "" +#line 1119 "" wbrsym -= 3; -#line 1116 "" +#line 1119 "" -#line 1116 "" +#line 1119 "" /* Function Body */ -#line 1116 "" +#line 1119 "" *nwbrs = 1; -#line 1117 "" +#line 1120 "" *lwbrs = 2; -#line 1118 "" +#line 1121 "" if (*lenbar == 16) { -#line 1119 "" +#line 1122 "" s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2); -#line 1120 "" +#line 1123 "" } else if (*lenbar == 32) { -#line 1121 "" +#line 1124 "" s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2); -#line 1122 "" +#line 1125 "" } else if (*lenbar == 64) { -#line 1123 "" +#line 1126 "" s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2); -#line 1124 "" +#line 1127 "" } else if (*lenbar == 8) { -#line 1125 "" +#line 1128 "" s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2); -#line 1126 "" +#line 1129 "" } else if (*lenbar == 128) { -#line 1127 "" +#line 1130 "" s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2); -#line 1128 "" +#line 1131 "" } else { -#line 1129 "" +#line 1132 "" *nwbrs = 2; -#line 1130 "" +#line 1133 "" *lwbrs = 3; -#line 1131 "" +#line 1134 "" if (*lenbar == 24) { -#line 1132 "" +#line 1135 "" s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3); -#line 1133 "" +#line 1136 "" s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3); -#line 1134 "" +#line 1137 "" } else if (*lenbar == 48) { -#line 1135 "" +#line 1138 "" s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3); -#line 1136 "" +#line 1139 "" s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3); -#line 1137 "" +#line 1140 "" } else if (*lenbar == 96) { -#line 1138 "" +#line 1141 "" s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3); -#line 1139 "" +#line 1142 "" s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3); -#line 1140 "" +#line 1143 "" } else { -#line 1141 "" +#line 1144 "" s_wsfe(&io___164); -#line 1141 "" +#line 1144 "" + do_fio(&c__1, " Any whole-bar rests of duration", (ftnlen)32); +#line 1144 "" do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer)); -#line 1141 "" +#line 1144 "" + do_fio(&c__1, "/64 will not be recognized", (ftnlen)26); +#line 1144 "" e_wsfe(); -#line 1143 "" +#line 1146 "" } -#line 1144 "" +#line 1147 "" } -#line 1145 "" +#line 1148 "" return 0; } /* fwbrsym_ */ @@ -3141,104 +3147,104 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) /* Know its the last symbol if on return ipenew = len!. So should never */ /* be called when ipstart=len. */ -#line 1154 "" +#line 1157 "" if (*ipeold >= *len) { -#line 1155 "" +#line 1158 "" s_wsle(&io___165); -#line 1155 "" +#line 1158 "" do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33); -#line 1155 "" +#line 1158 "" e_wsle(); -#line 1156 "" +#line 1159 "" s_wsle(&io___166); -#line 1156 "" +#line 1159 "" do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons@logicon.com", ( ftnlen)44); -#line 1156 "" +#line 1159 "" e_wsle(); -#line 1157 "" +#line 1160 "" s_stop("", (ftnlen)0); -#line 1158 "" +#line 1161 "" } -#line 1159 "" +#line 1162 "" i__1 = *len; -#line 1159 "" +#line 1162 "" for (ip = *ipeold + 1; ip <= i__1; ++ip) { -#line 1160 "" +#line 1163 "" if (*(unsigned char *)&line[ip - 1] != ' ') { /* symbol starts here (ip). We're committed to exit the loop. */ -#line 1164 "" +#line 1167 "" if (ip < *len) { -#line 1165 "" +#line 1168 "" i__2 = *len; -#line 1165 "" +#line 1168 "" for (iip = ip + 1; iip <= i__2; ++iip) { -#line 1166 "" +#line 1169 "" if (*(unsigned char *)&line[iip - 1] != ' ') { -#line 1166 "" +#line 1169 "" goto L2; -#line 1166 "" +#line 1169 "" } /* iip is the space after the symbol */ -#line 1170 "" +#line 1173 "" *ipenew = iip - 1; -#line 1171 "" +#line 1174 "" *lsym = *ipenew - ip + 1; -#line 1172 "" +#line 1175 "" s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1)); -#line 1173 "" +#line 1176 "" return 0; -#line 1174 "" +#line 1177 "" L2: -#line 1174 "" +#line 1177 "" ; -#line 1174 "" +#line 1177 "" } /* Have len>=2 and ends on len */ -#line 1178 "" +#line 1181 "" *ipenew = *len; -#line 1179 "" +#line 1182 "" *lsym = *ipenew - ip + 1; -#line 1180 "" +#line 1183 "" s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1)); -#line 1181 "" +#line 1184 "" return 0; -#line 1182 "" +#line 1185 "" } else { /* ip = len */ -#line 1186 "" +#line 1189 "" *ipenew = *len; -#line 1187 "" +#line 1190 "" *lsym = 1; -#line 1188 "" +#line 1191 "" s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1); -#line 1189 "" +#line 1192 "" return 0; -#line 1190 "" +#line 1193 "" } -#line 1191 "" +#line 1194 "" } -#line 1192 "" +#line 1195 "" /* L1: */ -#line 1192 "" +#line 1195 "" } -#line 1193 "" +#line 1196 "" s_wsle(&io___169); -#line 1193 "" +#line 1196 "" do_lio(&c__9, &c__1, "Error #3. Send files to Dr. Don at dsimons@logico"\ "n.com", (ftnlen)55); -#line 1193 "" +#line 1196 "" e_wsle(); -#line 1194 "" +#line 1197 "" return 0; } /* nextsym_ */ @@ -3278,158 +3284,158 @@ integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len) /* Use a temporary string to store the input and test, so can zap D"..." */ -#line 1209 "" +#line 1212 "" s_copy(tline, line, (ftnlen)128, (ftnlen)128); -#line 1210 "" +#line 1213 "" ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len); /* Return point below for rechecks after zapping D" " */ -#line 1214 "" +#line 1217 "" L2: -#line 1215 "" +#line 1218 "" ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1); -#line 1216 "" +#line 1219 "" if (ndxbs > 0) { /* Special check in case \ is inside D"..." */ -#line 1220 "" +#line 1223 "" ndxdq1 = i_indx(tline, "D\"", (ftnlen)128, (ftnlen)2); /* If the following test fails, flow out of if block; else loop up to 2. */ -#line 1224 "" +#line 1227 "" if (ndxdq1 > 0) { /* Find end of D"..." */ -#line 1228 "" +#line 1231 "" i__1 = ndxdq1 + 1; -#line 1228 "" +#line 1231 "" ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, ( ftnlen)1); -#line 1229 "" +#line 1232 "" if (ndxdq2 == ndxdq1 + 1) { -#line 1230 "" +#line 1233 "" s_wsle(&io___175); -#line 1230 "" +#line 1233 "" do_lio(&c__9, &c__1, "Something is really wierd here", ( ftnlen)30); -#line 1230 "" +#line 1233 "" e_wsle(); -#line 1231 "" +#line 1234 "" s_stop("", (ftnlen)0); -#line 1232 "" +#line 1235 "" } -#line 1233 "" +#line 1236 "" s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1); -#line 1234 "" +#line 1237 "" i__1 = ndxdq2; -#line 1234 "" +#line 1237 "" for (ic = ndxdq1; ic <= i__1; ++ic) { /* Writing concatenation */ -#line 1235 "" +#line 1238 "" i__2[0] = ic - 1, a__1[0] = tline; -#line 1235 "" +#line 1238 "" i__2[1] = 1, a__1[1] = " "; -#line 1235 "" +#line 1238 "" s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); -#line 1236 "" +#line 1239 "" /* L3: */ -#line 1236 "" +#line 1239 "" } -#line 1237 "" +#line 1240 "" i__1 = ndxdq2; /* Writing concatenation */ -#line 1237 "" +#line 1240 "" i__2[0] = ndxdq2, a__1[0] = tline; -#line 1237 "" +#line 1240 "" i__2[1] = 128 - i__1, a__1[1] = line + i__1; -#line 1237 "" +#line 1240 "" s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); -#line 1238 "" +#line 1241 "" goto L2; -#line 1239 "" +#line 1242 "" } -#line 1240 "" +#line 1243 "" } -#line 1241 "" +#line 1244 "" if (ndxbs == 0 || ndxs2 < ndxbs) { -#line 1242 "" +#line 1245 "" ret_val = ndxs2; /* print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */ -#line 1244 "" +#line 1247 "" } else { /* There are both bs and s2q, and bs is to the left of sq2. So check bs's to */ /* right of first: End is '\ ', start is ' \' */ -#line 1249 "" +#line 1252 "" len = lenstr_(tline, &c__128, (ftnlen)128); -#line 1250 "" +#line 1253 "" intex = TRUE_; /* print*,'intex+>',intex */ -#line 1252 "" +#line 1255 "" i__1 = len; -#line 1252 "" +#line 1255 "" for (ic = ndxbs + 1; ic <= i__1; ++ic) { -#line 1253 "" +#line 1256 "" if (ic == ndxs2) { -#line 1254 "" +#line 1257 "" if (intex) { -#line 1255 "" +#line 1258 "" ret_val = 0; -#line 1256 "" +#line 1259 "" i__3 = ic; -#line 1256 "" +#line 1259 "" ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) + ic; /* print*,'ndxs2 =>',ndxs2 */ -#line 1258 "" +#line 1261 "" } else { -#line 1259 "" +#line 1262 "" ret_val = ndxs2; -#line 1260 "" +#line 1263 "" return ret_val; -#line 1261 "" +#line 1264 "" } /* print*,'Internal exit, intex, ntindex:',intex,ntindex */ -#line 1263 "" +#line 1266 "" } else /* if(complicated condition) */ { -#line 1263 "" +#line 1266 "" i__3 = ic; -#line 1263 "" +#line 1266 "" if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, ( ftnlen)2) == 0) { -#line 1264 "" +#line 1267 "" intex = FALSE_; /* print*,'intex+>',intex */ -#line 1266 "" +#line 1269 "" } else /* if(complicated condition) */ { -#line 1266 "" +#line 1269 "" i__3 = ic; -#line 1266 "" +#line 1269 "" if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, ( ftnlen)2) == 0) { -#line 1268 "" +#line 1271 "" intex = TRUE_; /* print*,'intex+>',intex */ -#line 1270 "" +#line 1273 "" } -#line 1270 "" +#line 1273 "" } -#line 1270 "" +#line 1273 "" } -#line 1271 "" +#line 1274 "" /* L1: */ -#line 1271 "" +#line 1274 "" } /* print*,'Out end of loop 1' */ -#line 1273 "" +#line 1276 "" } /* print*,'Exiting ntindex at the end???' */ -#line 1275 "" +#line 1278 "" return ret_val; } /* ntindex_ */ @@ -3447,23 +3453,23 @@ L2: /* Gets the next character out of line*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount to position of the new character. */ -#line 1284 "" +#line 1287 "" if (*iccount == 128) { -#line 1285 "" +#line 1288 "" s_rsfe(&io___179); -#line 1285 "" +#line 1288 "" do_fio(&c__1, line, (ftnlen)128); -#line 1285 "" +#line 1288 "" e_rsfe(); -#line 1286 "" +#line 1289 "" *iccount = 0; -#line 1287 "" +#line 1290 "" } -#line 1288 "" +#line 1291 "" ++(*iccount); -#line 1289 "" +#line 1292 "" *(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1]; -#line 1290 "" +#line 1293 "" return 0; } /* getchar_ */ @@ -3515,167 +3521,167 @@ doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen /* 4 musicsize 20 */ /* 5 fracondent 0.05 */ -#line 1315 "" +#line 1318 "" L4: -#line 1315 "" +#line 1318 "" if (*iccount == 128) { -#line 1316 "" +#line 1319 "" s_rsfe(&io___180); -#line 1316 "" +#line 1319 "" do_fio(&c__1, line, (ftnlen)128); -#line 1316 "" +#line 1319 "" e_rsfe(); -#line 1317 "" +#line 1320 "" if (all_1.replacing) { -#line 1317 "" +#line 1320 "" all_1.replacing = FALSE_; -#line 1317 "" +#line 1320 "" } -#line 1318 "" +#line 1321 "" chkcom_(line, &goto999, (ftnlen)128); -#line 1319 "" +#line 1322 "" *iccount = 0; -#line 1320 "" +#line 1323 "" } -#line 1321 "" +#line 1324 "" ++(*iccount); /* Find next non-blank or end of line */ -#line 1325 "" +#line 1328 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { -#line 1326 "" +#line 1329 "" if (*(unsigned char *)&line[*iccount - 1] != ' ') { -#line 1326 "" +#line 1329 "" goto L3; -#line 1326 "" +#line 1329 "" } -#line 1327 "" +#line 1330 "" /* L2: */ -#line 1327 "" +#line 1330 "" } /* If here, need to get a new line */ -#line 1331 "" +#line 1334 "" *iccount = 128; -#line 1332 "" +#line 1335 "" goto L4; -#line 1333 "" +#line 1336 "" L3: /* iccount now points to start of number to read */ -#line 1337 "" +#line 1340 "" i1 = *iccount; -#line 1338 "" +#line 1341 "" L5: -#line 1338 "" +#line 1341 "" getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar first increments iccount, *then* reads a character. */ -#line 1342 "" +#line 1345 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 1342 "" +#line 1345 "" goto L5; -#line 1342 "" +#line 1345 "" } -#line 1343 "" +#line 1346 "" i2 = *iccount - 1; -#line 1344 "" +#line 1347 "" if (i2 < i1) { -#line 1345 "" +#line 1348 "" s_wsle(&io___185); /* Writing concatenation */ -#line 1345 "" +#line 1348 "" i__1[0] = 7, a__1[0] = "Found \""; -#line 1345 "" +#line 1348 "" i__1[1] = 1, a__1[1] = durq; -#line 1345 "" +#line 1348 "" i__1[2] = 19, a__1[2] = "\" instead of number"; -#line 1345 "" +#line 1348 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); -#line 1345 "" +#line 1348 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); -#line 1345 "" +#line 1348 "" e_wsle(); -#line 1346 "" +#line 1349 "" s_stop("1", (ftnlen)1); -#line 1347 "" +#line 1350 "" } -#line 1348 "" +#line 1351 "" icf = i2 - i1 + 49; -#line 1349 "" +#line 1352 "" ici__1.icierr = 0; -#line 1349 "" +#line 1352 "" ici__1.iciend = 0; -#line 1349 "" +#line 1352 "" ici__1.icirnum = 1; -#line 1349 "" +#line 1352 "" ici__1.icirlen = i2 - (i1 - 1); -#line 1349 "" +#line 1352 "" ici__1.iciunit = line + (i1 - 1); /* Writing concatenation */ -#line 1349 "" +#line 1352 "" i__1[0] = 2, a__1[0] = "(f"; -#line 1349 "" +#line 1352 "" *(unsigned char *)&ch__3[0] = icf; -#line 1349 "" +#line 1352 "" i__1[1] = 1, a__1[1] = ch__3; -#line 1349 "" +#line 1352 "" i__1[2] = 3, a__1[2] = ".0)"; -#line 1349 "" +#line 1352 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); -#line 1349 "" +#line 1352 "" s_rsfi(&ici__1); -#line 1349 "" +#line 1352 "" do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); -#line 1349 "" +#line 1352 "" e_rsfi(); -#line 1350 "" +#line 1353 "" if (! all_1.replacing) { -#line 1351 "" +#line 1354 "" if (*iread == 0) { -#line 1352 "" +#line 1355 "" i__2 = i2 - i1 + 1; -#line 1352 "" +#line 1355 "" allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1)); -#line 1353 "" +#line 1356 "" } else if (*iread == 1) { -#line 1354 "" +#line 1357 "" allparts_("-999", &c__4, (ftnlen)4); -#line 1355 "" +#line 1358 "" } else if (*iread == 2) { -#line 1356 "" +#line 1359 "" allparts_("1", &c__1, (ftnlen)1); -#line 1357 "" +#line 1360 "" } else if (*iread == 3) { -#line 1358 "" +#line 1361 "" allparts_("-998", &c__4, (ftnlen)4); -#line 1359 "" +#line 1362 "" } else if (*iread == 4) { -#line 1360 "" +#line 1363 "" allparts_("20", &c__2, (ftnlen)2); -#line 1361 "" +#line 1364 "" } else if (*iread == 5) { -#line 1362 "" +#line 1365 "" allparts_(".05", &c__3, (ftnlen)3); -#line 1363 "" +#line 1366 "" } else if (*iread != -1) { -#line 1364 "" +#line 1367 "" s_wsle(&io___187); -#line 1364 "" +#line 1367 "" do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26); -#line 1364 "" +#line 1367 "" e_wsle(); -#line 1365 "" +#line 1368 "" s_stop("", (ftnlen)0); -#line 1366 "" +#line 1369 "" } -#line 1367 "" +#line 1370 "" } -#line 1368 "" +#line 1371 "" return ret_val; } /* readin_ */ @@ -3710,217 +3716,217 @@ L5: /* Assume that line has just been read. No need to change iccount since we only */ /* process full lines. */ -#line 1380 "" +#line 1383 "" *goto999 = FALSE_; -#line 1381 "" +#line 1384 "" L1: -#line 1381 "" +#line 1384 "" if (*(unsigned char *)line != '%') { -#line 1381 "" +#line 1384 "" return 0; -#line 1381 "" +#line 1384 "" } /* If here, line has some sort of comment */ -#line 1385 "" +#line 1388 "" if (*(unsigned char *)&line[1] == '%') { -#line 1386 "" +#line 1389 "" if (! all_1.insetup) { /* Suck up a line, then flow out of "if" block to get another and loop */ -#line 1390 "" +#line 1393 "" s_rsfe(&io___188); -#line 1390 "" +#line 1393 "" do_fio(&c__1, line, (ftnlen)128); -#line 1390 "" +#line 1393 "" e_rsfe(); /* ++VV */ /* UNLESS (a) it has a score-only "M" and changes # of inst's. */ -#line 1396 "" +#line 1399 "" if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) { -#line 1397 "" +#line 1400 "" idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1); -#line 1398 "" +#line 1401 "" idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1); -#line 1399 "" +#line 1402 "" idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1); -#line 1400 "" +#line 1403 "" idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); -#line 1401 "" +#line 1404 "" if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb)) { -#line 1403 "" +#line 1406 "" i__1 = idxn; -#line 1403 "" +#line 1406 "" all_1.noinow = *(unsigned char *)&line[i__1] - 48; -#line 1404 "" +#line 1407 "" clefpend = TRUE_; /* Next noinow digits are original inst. #'s of new inst. set. Next noinow */ /* char's after that are clefs */ -#line 1409 "" +#line 1412 "" all_1.nvnow = 0; -#line 1410 "" +#line 1413 "" i__1 = all_1.noinow; -#line 1410 "" +#line 1413 "" for (j = 1; j <= i__1; ++j) { -#line 1411 "" +#line 1414 "" i__2 = idxn + 1 + j - 1; -#line 1411 "" +#line 1414 "" all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] - 48; -#line 1412 "" +#line 1415 "" iposc0 = idxn + 1 + all_1.noinow; -#line 1413 "" +#line 1416 "" i__2 = all_1.nvi[all_1.iorig[j - 1] - 1]; -#line 1413 "" +#line 1416 "" for (k = 1; k <= i__2; ++k) { -#line 1414 "" +#line 1417 "" ++all_1.nvnow; /* clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */ -#line 1416 "" +#line 1419 "" all_1.instnum[all_1.nvnow - 1] = j; -#line 1417 "" +#line 1420 "" all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1; -#line 1418 "" +#line 1421 "" /* L25: */ -#line 1418 "" +#line 1421 "" } -#line 1419 "" +#line 1422 "" /* L24: */ -#line 1419 "" +#line 1422 "" } -#line 1420 "" +#line 1423 "" } -#line 1421 "" +#line 1424 "" } /* or if it's "h" or "l", need to suck up one more line */ -#line 1425 "" +#line 1428 "" if (*(unsigned char *)line == 'h' && i_indx("+- ", line + 1, ( ftnlen)3, (ftnlen)1) > 0 || *(unsigned char *)line == 'T' || s_cmp(line, "l ", (ftnlen)2, (ftnlen)2) == 0) { -#line 1425 "" +#line 1428 "" s_rsfe(&io___197); -#line 1425 "" +#line 1428 "" do_fio(&c__1, line, (ftnlen)128); -#line 1425 "" +#line 1428 "" e_rsfe(); -#line 1425 "" +#line 1428 "" } /* 4/29/00 check for T string also */ -#line 1431 "" +#line 1434 "" } else { /* In setup mode. Set flag, flow out and do use following line */ -#line 1435 "" +#line 1438 "" all_1.replacing = TRUE_; -#line 1436 "" +#line 1439 "" } -#line 1437 "" +#line 1440 "" } else if (*(unsigned char *)&line[1] == '!') { /* Copy to all parts */ -#line 1441 "" +#line 1444 "" allparts_(line + 2, &c__125, (ftnlen)126); -#line 1442 "" +#line 1445 "" } else { /* Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise */ /* c Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise */ -#line 1447 "" +#line 1450 "" ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, ( ftnlen)1); /* Only treat as part-specific pmx line if number .le. noinst */ -#line 1451 "" +#line 1454 "" if (ivq < 1 || ivq > all_1.noinst) { /* Simple comment. */ -#line 1455 "" +#line 1458 "" allparts_(line, &c__128, (ftnlen)128); -#line 1456 "" +#line 1459 "" } else { /* Instrument comment, copy only to part */ -#line 1460 "" +#line 1463 "" lenline = lenstr_(line, &c__128, (ftnlen)128); -#line 1461 "" +#line 1464 "" if (lenline > 2) { -#line 1462 "" +#line 1465 "" io___200.ciunit = ivq + 10; -#line 1462 "" +#line 1465 "" s_wsfe(&io___200); -#line 1462 "" +#line 1465 "" do_fio(&c__1, line + 2, lenline - 2); -#line 1462 "" +#line 1465 "" e_wsfe(); -#line 1463 "" +#line 1466 "" } else { /* Transferring blank line */ -#line 1467 "" +#line 1470 "" io___201.ciunit = ivq + 10; -#line 1467 "" +#line 1470 "" s_wsfe(&io___201); -#line 1467 "" +#line 1470 "" do_fio(&c__1, " ", (ftnlen)1); -#line 1467 "" +#line 1470 "" e_wsfe(); -#line 1468 "" +#line 1471 "" } -#line 1469 "" +#line 1472 "" } -#line 1470 "" +#line 1473 "" } -#line 1471 "" +#line 1474 "" i__1 = s_rsfe(&io___202); -#line 1471 "" +#line 1474 "" if (i__1 != 0) { -#line 1471 "" +#line 1474 "" goto L2; -#line 1471 "" +#line 1474 "" } -#line 1471 "" +#line 1474 "" i__1 = do_fio(&c__1, line, (ftnlen)128); -#line 1471 "" +#line 1474 "" if (i__1 != 0) { -#line 1471 "" +#line 1474 "" goto L2; -#line 1471 "" +#line 1474 "" } -#line 1471 "" +#line 1474 "" i__1 = e_rsfe(); -#line 1471 "" +#line 1474 "" if (i__1 != 0) { -#line 1471 "" +#line 1474 "" goto L2; -#line 1471 "" +#line 1474 "" } -#line 1472 "" +#line 1475 "" zapbl_(line, &c__128, (ftnlen)128); -#line 1473 "" +#line 1476 "" goto L1; -#line 1474 "" +#line 1477 "" L2: -#line 1475 "" +#line 1478 "" *goto999 = TRUE_; -#line 1476 "" +#line 1479 "" return 0; } /* chkcom_ */ @@ -3962,128 +3968,128 @@ L2: /* iset(9) (npages) will be replaced with (nsyst-1)/12+1 */ /* iset(2), if negative, will be followed by extra numbers to be transf. */ -#line 1495 "" +#line 1498 "" iccount = 0; -#line 1496 "" +#line 1499 "" for (iset = 1; iset <= 12; ++iset) { -#line 1497 "" +#line 1500 "" partnum_(iv, &iccount, line, &xdata, (ftnlen)128); -#line 1498 "" +#line 1501 "" if (iset == 2) { -#line 1499 "" +#line 1502 "" if (xdata > 0.f) { -#line 1500 "" +#line 1503 "" s_wsfe(&io___206); -#line 1500 "" +#line 1503 "" i__1 = (integer) (xdata + .1f); -#line 1500 "" +#line 1503 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 1500 "" +#line 1503 "" e_wsfe(); -#line 1501 "" +#line 1504 "" } else { -#line 1502 "" +#line 1505 "" noi = -xdata + .1f; -#line 1503 "" +#line 1506 "" s_wsfe(&io___208); -#line 1503 "" +#line 1506 "" do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer)); -#line 1503 "" +#line 1506 "" e_wsfe(); -#line 1504 "" +#line 1507 "" i__1 = noi; -#line 1504 "" +#line 1507 "" for (ioi = 1; ioi <= i__1; ++ioi) { -#line 1505 "" +#line 1508 "" partnum_(iv, &iccount, line, &xdata, (ftnlen)128); -#line 1506 "" +#line 1509 "" s_wsfe(&io___210); -#line 1506 "" +#line 1509 "" i__2 = (integer) (xdata + .1f); -#line 1506 "" +#line 1509 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); -#line 1506 "" +#line 1509 "" e_wsfe(); -#line 1507 "" +#line 1510 "" /* L2: */ -#line 1507 "" +#line 1510 "" } -#line 1508 "" +#line 1511 "" } /* else if (iset.ne.8 .and. xdata.lt.0) then */ -#line 1510 "" +#line 1513 "" } else if (iset != 8 && iset != 5 && xdata < 0.f) { /* Must be either nv or npages */ -#line 1514 "" +#line 1517 "" if ((integer) (-xdata + .1f) == 999) { /* It's nv */ -#line 1518 "" +#line 1521 "" s_wsfe(&io___211); -#line 1518 "" +#line 1521 "" do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof( integer)); -#line 1518 "" +#line 1521 "" e_wsfe(); -#line 1519 "" +#line 1522 "" } else { /* npages must be computed */ -#line 1523 "" +#line 1526 "" s_wsfe(&io___212); -#line 1523 "" +#line 1526 "" i__1 = (all_1.nsyst - 1) / 12 + 1; -#line 1523 "" +#line 1526 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 1523 "" +#line 1526 "" e_wsfe(); -#line 1524 "" +#line 1527 "" } -#line 1525 "" +#line 1528 "" } else if (iset != 7 && iset != 12) { /* write integer */ -#line 1529 "" +#line 1532 "" s_wsfe(&io___213); -#line 1529 "" +#line 1532 "" i__1 = i_nint(&xdata); -#line 1529 "" +#line 1532 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); -#line 1529 "" +#line 1532 "" e_wsfe(); -#line 1530 "" +#line 1533 "" } else { /* write floating number */ -#line 1534 "" +#line 1537 "" s_wsfe(&io___214); -#line 1534 "" +#line 1537 "" do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real)); -#line 1534 "" +#line 1537 "" e_wsfe(); -#line 1535 "" +#line 1538 "" } -#line 1536 "" +#line 1539 "" if (iset == 3) { -#line 1537 "" +#line 1540 "" *mtrnum = i_nint(&xdata); -#line 1538 "" +#line 1541 "" } else if (iset == 4) { -#line 1539 "" +#line 1542 "" *mtrden = i_nint(&xdata); -#line 1540 "" +#line 1543 "" } -#line 1541 "" +#line 1544 "" /* L1: */ -#line 1541 "" +#line 1544 "" } -#line 1542 "" +#line 1545 "" return 0; } /* dosetup_ */ @@ -4121,131 +4127,131 @@ L2: /* Simplified number parsing. Only looks for comment lines and numbers. */ -#line 1550 "" +#line 1553 "" L2: -#line 1550 "" +#line 1553 "" if (*iccount == 128) { -#line 1551 "" +#line 1554 "" io___215.ciunit = *iv + 10; -#line 1551 "" +#line 1554 "" s_rsfe(&io___215); -#line 1551 "" +#line 1554 "" do_fio(&c__1, line, (ftnlen)128); -#line 1551 "" +#line 1554 "" e_rsfe(); -#line 1552 "" +#line 1555 "" if (*(unsigned char *)line == '%') { -#line 1553 "" +#line 1556 "" len = lenstr_(line, &c__128, (ftnlen)128); -#line 1554 "" +#line 1557 "" s_wsfe(&io___217); -#line 1554 "" +#line 1557 "" do_fio(&c__1, line, len); -#line 1554 "" +#line 1557 "" e_wsfe(); -#line 1555 "" +#line 1558 "" goto L2; -#line 1556 "" +#line 1559 "" } -#line 1557 "" +#line 1560 "" *iccount = 0; -#line 1558 "" +#line 1561 "" } -#line 1559 "" +#line 1562 "" ++(*iccount); /* Find next non-blank or end of line */ -#line 1563 "" +#line 1566 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { -#line 1564 "" +#line 1567 "" if (*(unsigned char *)&line[*iccount - 1] != ' ') { -#line 1564 "" +#line 1567 "" goto L3; -#line 1564 "" +#line 1567 "" } -#line 1565 "" +#line 1568 "" /* L4: */ -#line 1565 "" +#line 1568 "" } /* If here, iccount=128 and need to get a new line */ -#line 1569 "" +#line 1572 "" goto L2; -#line 1570 "" +#line 1573 "" L3: /* iccount now points to start of number to read */ -#line 1574 "" +#line 1577 "" i1 = *iccount; -#line 1575 "" +#line 1578 "" L5: -#line 1575 "" +#line 1578 "" getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar first increments iccount, *then* reads a character. */ -#line 1579 "" +#line 1582 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { -#line 1579 "" +#line 1582 "" goto L5; -#line 1579 "" +#line 1582 "" } -#line 1580 "" +#line 1583 "" i2 = *iccount - 1; -#line 1581 "" +#line 1584 "" if (i2 < i1) { -#line 1582 "" +#line 1585 "" s_wsle(&io___221); /* Writing concatenation */ -#line 1582 "" +#line 1585 "" i__1[0] = 7, a__1[0] = "Found \""; -#line 1582 "" +#line 1585 "" i__1[1] = 1, a__1[1] = durq; -#line 1582 "" +#line 1585 "" i__1[2] = 19, a__1[2] = "\" instead of number"; -#line 1582 "" +#line 1585 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); -#line 1582 "" +#line 1585 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); -#line 1582 "" +#line 1585 "" e_wsle(); -#line 1583 "" +#line 1586 "" s_stop("1", (ftnlen)1); -#line 1584 "" +#line 1587 "" } -#line 1585 "" +#line 1588 "" icf = i2 - i1 + 49; -#line 1586 "" +#line 1589 "" ici__1.icierr = 0; -#line 1586 "" +#line 1589 "" ici__1.iciend = 0; -#line 1586 "" +#line 1589 "" ici__1.icirnum = 1; -#line 1586 "" +#line 1589 "" ici__1.icirlen = i2 - (i1 - 1); -#line 1586 "" +#line 1589 "" ici__1.iciunit = line + (i1 - 1); /* Writing concatenation */ -#line 1586 "" +#line 1589 "" i__1[0] = 2, a__1[0] = "(f"; -#line 1586 "" +#line 1589 "" *(unsigned char *)&ch__3[0] = icf; -#line 1586 "" +#line 1589 "" i__1[1] = 1, a__1[1] = ch__3; -#line 1586 "" +#line 1589 "" i__1[2] = 3, a__1[2] = ".0)"; -#line 1586 "" +#line 1589 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); -#line 1586 "" +#line 1589 "" s_rsfi(&ici__1); -#line 1586 "" +#line 1589 "" do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real)); -#line 1586 "" +#line 1589 "" e_rsfi(); -#line 1587 "" +#line 1590 "" return 0; } /* partnum_ */ @@ -4261,40 +4267,40 @@ L5: /* Local variables */ static integer i__; -#line 1599 "" +#line 1602 "" i__1 = *len; -#line 1599 "" +#line 1602 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 1600 "" +#line 1603 "" if (*(unsigned char *)&string[i__ - 1] == ' ') { -#line 1600 "" +#line 1603 "" goto L1; -#line 1600 "" +#line 1603 "" } -#line 1601 "" +#line 1604 "" if (i__ == 1) { -#line 1601 "" +#line 1604 "" return 0; -#line 1601 "" +#line 1604 "" } -#line 1602 "" +#line 1605 "" goto L2; -#line 1603 "" +#line 1606 "" L1: -#line 1603 "" +#line 1606 "" ; -#line 1603 "" +#line 1606 "" } /* If line is all blank, leave it alone */ -#line 1607 "" +#line 1610 "" return 0; -#line 1608 "" +#line 1611 "" L2: -#line 1609 "" +#line 1612 "" s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1)); -#line 1610 "" +#line 1613 "" return 0; } /* zapbl_ */ @@ -4311,25 +4317,25 @@ L2: /* This counts number of double quotes in lineq up to position indx-1, then */ /* sets yesodd according to whether number is odd or even */ -#line 1619 "" +#line 1622 "" numdqs = 0; -#line 1620 "" +#line 1623 "" i__1 = *indx - 1; -#line 1620 "" +#line 1623 "" for (i__ = 1; i__ <= i__1; ++i__) { -#line 1621 "" +#line 1624 "" if (*(unsigned char *)&lineq[i__ - 1] == '"') { -#line 1621 "" +#line 1624 "" ++numdqs; -#line 1621 "" +#line 1624 "" } -#line 1622 "" +#line 1625 "" /* L1: */ -#line 1622 "" +#line 1625 "" } -#line 1623 "" +#line 1626 "" *yesodd = numdqs % 2 == 1; -#line 1624 "" +#line 1627 "" return 0; } /* oddquotesbefore_ */ diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.for b/Build/source/utils/pmx/pmx-src/scor2prt.for index a88f634d383..35839bd8803 100644 --- a/Build/source/utils/pmx/pmx-src/scor2prt.for +++ b/Build/source/utils/pmx/pmx-src/scor2prt.for @@ -1,1630 +1,1633 @@ -cccccccccccccccccccccccccc -cc -cc scor2prt 2/19/16 for PMX 2.74 -cccccccccccccccccccccccccc -c This program, developed by Don Simons (dsimons@roadrunner.com), is -c part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert -c with MusiXTeX and TeX, the purpose of PMX is to allow the user to create -c high-quality typeset musical scores by including a sequence of PMX commands -c in an ASCII input file. Scor2prt is an auxiliary program that creates PMX -c input files for individual parts from the PMX input file for the score. -c -c This program is free software: you can redistribute it and/or modify -c it under the terms of the GNU General Public License as published by -c the Free Software Foundation, either version 3 of the License, or -c (at your option) any later version. -c -c This program is distributed in the hope that it will be useful, -c but WITHOUT ANY WARRANTY; without even the implied warranty of -c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -c GNU General Public License for more details. -c -c You should have received a copy of the GNU General Public License -c along with this program. If not, see . -c -c 2/19/16 -c Exit gracefully when last input line is comment, with mods in -c subroutine chkcom, adding logical argument goto999 -c which is set to .true. in that case, causing input file to -c be closed after exiting. -c 4/9/12 -c Add logical declarations to subroutine dosetup -c 8/8/11 -c Copy & mod Ki into parts when after beginning. -c 7/18/11 -c Start to fix up for AS..., also Ki was done a little earlier. -c 7/5/10 -c Modify Manual to explain extended hex numbering for part-specific comments -c 5/16/10 -c Extend part-specific comments for up to 24 parts (subroutine chkcom) -c Allow files 11-34 for parts -c Change file 30 to 40 -c 6/1/08 es2p -c noimax = 24 -c -c To do -c Override fracindent, musicsize? -c Deal with midbar R? -c 2/29/04 -c Check for special character being in quoted string. -c 10/20/02 PMX 2.407 -c Interpret AN[n]"[used-defined-part-file-name]" -c 1/21/02 -c Deals with rm in multiple parts. -c s2p15 -c Get right non-tex index even if there's "\" inside D"..." -c s2p14 -c 10/29/00 fix transfer to parts of negative mtrdnp -c 4/29/00 screen for "%%" followed by "T" -c Restore change from "Version 2.1a, 21 Dec" -c s2p13 -c Allow whole-bar double-whole rests. -c Bypass MIDI commands "I..." achar(10)="I" -c s2p12 -c Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla -c only taken as such if ? represents a hex digit .le. noinst, otherwise it's -c a simple comment. This lessens incompatibility. -c In subroutine mbrest, properly open parts 10-12 if needed -c s2p11 -c Ignore leading blanks -c Fix undefined linelength in mbrest at very end of comments. -c s2p10 -c Fix non-transfer of P..c" " -c Allow "%%" and "%"n anywhere -c Version 1.43 -c Fix bug with P in TeX string. -c Ignore shifted whole-bar rests when consolidating whole-bar rests -c Copy type 4 TeX into all parts. -c Deal with XB and XP. -c Permit transfer of blank line into parts -c Change staves/inst in 'M' command. -c Arbitrary staves/inst. -c Recognize m1/2/3/4 syntax. -c Enable comment and one-voice syntax in instrument names -c -c Changes since 1.1 -c Deal with saved macros. -c Revise setup readin, to admit comments. -c Do not copy 'X' into parts -c -cccccccccccccccccccccccccccccccccccccccccccccccc - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - integer*4 ludpfn(noimax) - character*1 sq,achar(10) - character*2 termsym - character*27 jobname,infileq - character*128 instrum(noimax),udpfnq(noimax) - character*128 line,holdln,templine - logical termrpt,isachar,frstln,oneof2,botv,clefpend,fexist, - * insetup,replacing,gotname,yesodd,goto999 - character*1 dumq - data achar /'P','m','V','R','A','h','w','K','M','I'/ - clefpend = .false. - insetup = .true. - replacing = .false. - frstln = .true. - lenhold = 0 - sq = char(92) - print*,'This is scor2prt for PMX 2.74, 19 February 2016' - numargs = iargc() - if (numargs .eq. 0) then - print*,'You could have entered a jobname on the command line,' - print*,' but you may enter one now:' - read(*,'(a)')jobname - numargs = 1 - else -c call getarg(1,jobname,idum) ! May need to replace this w/ next line - call getarg(1,jobname) - end if - ljob = lenstr(jobname,27) - if (ljob .eq. 0) then - print*,'No was jobname entered. Restart and try again.' - stop - end if -c -c Strip ".pmx" if necessary -c - ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX')) - if (ndxpmx .gt. 0) then - jobname = jobname(1:ndxpmx-1) - ljob = ljob-4 - end if -c -c Check for existence of input file -c - infileq = jobname(1:ljob)//'.pmx' - inquire(file=infileq,EXIST=fexist) - if (.not.fexist) then - print*,'Cannot find file '//infileq - stop - end if - open(10,file=jobname(1:ljob)//'.pmx') -c -c Open all instrument files now for allparts stuff. Later disgard those >nv -c - do 19 iv = 1 , noimax - iorig(iv) = iv - open(10+iv,status='SCRATCH') - ludpfn(iv) = 0 -19 continue - read(10,'(a)')line - call chkcom(line,goto999) - if (line(1:3) .eq. '---') then - call allparts(line,128) -31 read(10,'(a)')line - if (line(1:3) .ne. '---') then - call allparts(line,128) - go to 31 - end if - call allparts(line,128) - read(10,'(a)')line - call chkcom(line,goto999) - end if - iccount = 0 - nv = readin(line,iccount,1)+.1 - noinst = readin(line,iccount,2)+.1 - if (noinst .gt. 0) then - nvi(1) = nv-noinst+1 - else - noinst = 1-noinst - do 21 iinst = 1 , noinst - nvi(iinst) = readin(line,iccount,-1)+.1 -21 continue - end if - noinow = noinst - insnow = 1 -c -c ivlast is last iv in current inst. instnum(iv) is iinst for current voice. -c - ivlast = nvi(1) - do 22 iv = 1 , nv - instnum(iv) = insnow - if (iv .eq. ivlast) then - if (iv .lt. nv) botv(iv+1) = .true. -c -c The previous stmt will set botv true only for bot voice of iinst>1. It is -c used when writing termrpts, but the one in voice one is handled differently, -c so botv(1) is left .false. -c - if (insnow .lt. noinst) then - insnow = insnow+1 - ivlast = ivlast+nvi(insnow) - end if - end if -22 continue - mtrnuml = readin(line,iccount,0)+.1 - mtrdenl = readin(line,iccount,0)+.1 - mtrnmp = readin(line,iccount,0)+.1 - mtrdnp = readin(line,iccount,0)+.1 - xmtrnum0 = readin(line,iccount,0) - isig = readin(line,iccount,0)+.1 - npages = readin(line,iccount,3)+.1 - nsyst = readin(line,iccount,0)+.1 - musicsize = readin(line,iccount,4)+.1 - fracindent = readin(line,iccount,5) - if (npages .eq. 0) then - print*, - *'You entered npages=0, which means nsyst is not the total number' - print*, - *'of systems. Scor2prt has to know the total number of systems.' - print*, - *'Please set npages and nsyst to their real values.' - stop - end if -c -c Must leave insetup=.true. else could bypass ALL instrument names. -c - read(10,'(a)')line - call chkcom(line,goto999) - backspace(10) -c -c Normally this puts pointer at start of line with 1st inst name -c Check if prior line was "%%" -c - backspace(10) - read(10,'(a)')line - if (line(1:2) .eq. '%%') backspace(10) - do 14 iv = 1 , noinst - gotname = .false. -16 read(10,'(a)') instrum(iv) - if (instrum(iv)(1:2) .eq. '%%') then - read(10,'(a)')line - go to 16 - else if (instrum(iv)(1:1) .eq. '%') then - ivq = ichar(instrum(iv)(2:2))-48 - if (ivq.ne.iv) then -c -c It's really a comment. Copy to parts, then get another trial name. -c - call allparts(instrum(iv),128) - go to 16 - else - line = instrum(iv)(3:) - instrum(iv) = line - gotname = .true. - end if - else - gotname = .true. - end if -cc -cc The following checks for macro that write original C-clef as part of -cc instrument name. See pmx.tex -cc -c if (index(instrum(iv),'namewpc') .eq. 0) then -c write(10+iv,'(a)')' ' -c else -c inm1 = index(instrum(iv),'{')+1 -c inm2 = index(instrum(iv),'}')-1 -c read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2 -c write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'// -c * char(iy1+49)//char(iy2+49) -c instrum(iv) = instrum(iv)(inm1:inm2) -c end if - if (.not.gotname) then - print*,'You must provide a replacement instrument name' - stop - end if - write(10+iv,'(a)')' ' -14 continue - replacing = .false. - nvnow = nv -c -c Clef string: Note insetup is still T, so "%%" will be treated specially -c - read(10,'(a)')line - call chkcom(line,goto999) - if (replacing) then -c -c If here, we have next line after "%%", containing score's clef string -c Assume all clefs are handled with instrument comments. -c - read(10,'(a)')line - call chkcom(line,goto999) - backspace(10) - else -c -c If here, line has the clef string in it. Handle the old way -c - kvstart = 1 - kvend = nvi(1) - do 2 inst = 1 , noinst - write(10+inst,'(a'//char(48+nvi(inst))//')') - * line(kvstart:kvend) - if (inst .lt. noinst) then - kvstart = kvend+1 - kvend = kvstart+nvi(inst+1)-1 - end if -2 continue - end if - replacing = .false. - insetup = .false. -c -c *****NOTE*****This comment applies to stuff done earlier! -c Before starting the big loop, copy initial instnum and staffnum stuff -c into working values. Latter may change if noinst changes. Also make -c list of current inst nums relative to original ones. In addition to those -c below, must redo instnum(iv) and botv(iv) when we change noinst. -c -c Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! -c -18 read(10,'(a)') line - if (line(1:1) .eq. '%') then - call allparts(line,128) - go to 18 - end if - call allparts(line,128) -c -c Write instrument names. Will be blank if later part of a score. -c - if (instrum(1)(1:1) .ne. ' ') then - do 3 iv = 1 , noinst - len = lenstr(instrum(iv),79) - write(10+iv,'(a2/a)')'Ti',instrum(iv)(1:len) -3 continue - end if -c -c The big loop. Except for '%%', put all comment lines in all parts. -c Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts -c If a line starts with %!, put the rest of it in each part. -c If a line starts with %[n], put the rest of it in part [n]. -c Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes. -c Assume they only come at top of block, except terminal repeat needs -c special handling. -c Check for "P"; ignore in parts. -c Check for consecutive full-bar rests; if found, replace with rm[nn] -c - iv = 1 - iinst = 1 - termrpt = .false. -4 continue - read(10,'(a)',end=999)line - lenline = lenstr(line,128) - if (lenline .eq. 0) go to 4 - call zapbl(line,128) - call chkcom(line,goto999) - if (goto999) go to 999 - lenline = lenstr(line,128) - if (lenline .eq. 0) go to 4 - if (line(1:1) .eq. 'T') then - call allparts(line,128) - read(10,'(a)')line - call allparts(line,128) - go to 4 - else if (line(1:2) .eq. sq//sq) then - call allparts(line,128) - go to 4 - else if (index('hl',line(1:1)).gt.0 .and. - * index(' +-',line(2:2)) .gt. 0) then - call allparts(line,128) - read(10,'(a)')line - call allparts(line,128) - go to 4 - else if (iv .eq. 1) then - do 5 ia = 1 , 10 -24 continue - idxa = ntindex(line,achar(ia)) - isachar = idxa .gt. 0 - if (idxa.gt.1) isachar = line(idxa-1:idxa-1).eq.' ' -c -c 1 2 3 4 5 6 7 8 9 10 -c data achar /'P','m','V','R','A','h','w','K','M','I'/ -c - if (ia .eq. 9) isachar = - * isachar .and. line(idxa+1:idxa+1).eq.'S' - if (isachar) then -c -c Check whether character is inside a quoted string by counting -c how many quotes precede it in the line -c - - call OddQuotesBefore(line,idxa,yesodd) - if (yesodd) isachar=.false. - end if - if (isachar) then -c -c Find next blank -c - do 6 ib = idxa+1 , 128 - if (line(ib:ib) .eq. ' ') go to 7 -6 continue - print*,'Problem with "V,R,m,P,A,h,MS, or w"' - print*, - * 'Send files to Dr. Don at dsimons at roadrunner dot com' - stop 1 -7 continue -c -c Next blank is at position ib. Later, if ia=1, must check for Pc" " ; -c i.e., look for '"' between P and blank -c - if (ia .eq. 4) then -c -c Check for terminal repeat. Note if there's a term rpt, there can't be any -c others. Also, must process repeats LAST, after m's and 'V's -c - do 8 ic = ib+1 , 128 -c -c If any subsequent character on this line is neither blank nor "/", get out -c - if (index(' /',line(ic:ic)) .eq. 0) go to 9 - if (line(ic:ic) .eq. '/') then - termrpt = .true. - termsym = line(ib-2:ib-1) -c -c Process the line as if there were no "R" -c - go to 10 - end if -8 continue -c -c +++ 060812 -c If here, all chars after "R" symbol are blanks, so process the line normally, -c but only IF next line is not the M-Tx line " /" -c - read(10,'(a)')templine - if (templine(1:2) .ne. ' /') then - backspace(10) ! and flow out - else -c -c We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, -c and proceed as above -c - line = line(1:ib)//'/' - lenline = lenline+2 - termrpt = .true. - termsym = line(ib-2:ib-1) - go to 10 - end if -c +++ 060812 -c - else if (ia .eq. 1) then - idxq = ntindex(line,'"') - if (idxq.gt.idxa .and. idxq.lt.ib) then -c -c Quote is between P and next blank. Find 2nd quote, starting at the blank. -c - idxq2 = ib-1+ntindex(line,'"') - if (idxq.eq.0 .or. line(idxq2+1:idxq2+1).ne.' ') then - print* - print*,'Error copying P with quotes, idxq2:',idxq2 - print*,line(1:60) - stop 1 - end if - ib = idxq2+1 - end if -c -c Do not transfer P into parts. -c - go to 12 - else if (ia .eq. 9) then -c -c Start Saving a macro. After leaving here, a symbol will be sent to all parts, -c If all on this line, set ib to end and exit normally. -c - ndxm = index(line(ib+1:128),'M') - if (ndxm.gt.0 .and. line(ib+ndxm-1:ib+ndxm-1).eq.' ') then -c -c Macro ends on this line -c - ib = ib+ndxm+1 - else -c -c Save leading part of current line -c - lenhold = idxa-1 - if (lenhold .gt. 0) holdln = line(1:lenhold) -c -c Transfer rest of line -c - call allparts(line(idxa:128),129-idxa) -c -c Read next line -c -20 read(10,'(a)')line -c -c Check for comment, transfer and loop if so -c -c if (line(1:1) .eq.'%') then -23 if (line(1:1) .eq.'%') then -c call allparts(line,128) -c go to 20 - call chkcom(line,goto999) - go to 23 - end if -c -c Look for terminal ' M' -c - if (line(1:1) .eq. 'M') then - ndxm = 1 - else - ndxm = index(line,' M') - if (ndxm .gt. 0) ndxm = ndxm+1 - end if - if (ndxm .gt. 0) then -c -c Set parameters, exit normally (but later check for leading part of 1st line -c - idxa = 1 - ib = ndxm+1 - else -c -c No "M", transfer entire line, loop -c - call allparts(line,128) - go to 20 - end if - end if - else if (ia .eq. 10) then -c -c Do not transfer MIDI command into parts -c - go to 12 - else if (ia .eq. 5) then -c -c First check for "AS", but S may come after other "A" options -c - idxS = index(line(idxa+1:ib),'S') - if (idxS .gt. 0) then -c -c Get rid of the string. First check if that's all there is in A. -c - if (ib-idxa .eq. nv+2) go to 12 - line = line(1:idxa+idxS-1)//line(idxa+idxS+nv+1:ib) - end if -c -c Check for user-defined part file name. Must start in column 1 and have -c AN[n]"userfilename". -c idxa is position of "A" -c ib is position of the next blank after "A" -c Don't allow any blanks in user -c - if (line(idxa+1:idxa+1) .ne. 'N') go to 9 ! bail out - if (idxa .ne. 1) then - print* - print*, - * 'You entered "AN..." somewhere beyond first column; stopping.' - stop 1 - end if -c -c pmxa already checked for valid one- or 2-digit number, so get it -c - if (line(4:4) .eq. '"') then -c -c Single digit instrument number -c - read(line(3:3),'(i1)')iudpfn - idxstartname = 5 - else - read(line(3:4),'(i2)')iudpfn - idxstartname = 6 - end if - ludpfn(iudpfn) = index(line(idxstartname:128),'"')-1 - if (ludpfn(iudpfn) .lt. 0) then - print* - print*,'User-defined part file name must be in quotes' - stop 1 - end if - idxendname = idxstartname+ludpfn(iudpfn)-1 - udpfnq(iudpfn) = line(idxstartname:idxendname) -c -c Get a new line! -c - go to 4 - else if (ia .eq. 8) then -c -c Key change/transposition. -c If not instrument specific, copy to all parts -c - if (line(idxa+1:idxa+1).ne.'i') go to 9 -c -c Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... -c - ibb = idxa+2 ! Starts on digit after 'i' -40 continue - read(line(ibb:ibb),'(i1)')iiinst ! 1st digit of iinst - itemp = (index('01234567890',line(ibb+1:ibb+1))) - if (itemp.gt.0) then - ibb = ibb+1 - iiinst = 10*iiinst+itemp-1 - end if - ibb = ibb+1 ! now at first +/-. Need end of 2nd number - itemp = index(line(ibb+1:ib),'i') ! Rel pos'n of next 'i' or 0 - if (itemp .gt. 0) then - iend = ibb+itemp-1 - else - iend = ib-1 - end if - write(10+iorig(iiinst),'(a)')'Ki1'//line(ibb:iend) - if (itemp .gt. 0) then - ibb = iend+2 - go to 40 - end if - go to 12 ! Remove K command from string, go to next ia - end if -9 continue - call allparts(line(idxa:ib-1),ib-idxa) -12 continue -c -c Remove the string from line -c - if (idxa .eq. 1) then - line = line(ib:128) - else - line = line(1:idxa-1)//line(ib:128) - end if - lenline = lenstr(line,128) -c -c Loop if only blanks are left -c - if (lenline .eq. 0) go to 4 -c -c Must check for multiple "I" commands, so go to just after start of ia loop -c - if (ia .eq. 10) go to 24 -c -c Tack on front part from 1st line of saved macro -c - if (lenhold .gt. 0) then - line = holdln(1:lenhold)//' '//line(1:lenline) - lenhold = 0 - end if - end if -5 continue - end if -c -c Now a special loop to deal with 'X'. If it was %[n]X..., will have been -c copied into part [n] already. If no "B" or "P", remove. If "P", just -c remove the "P" so pmxa/b will process. If "B". do nothing. -c -10 continue - nchk = 1 -13 ntinx = nchk-1+ntindex(line(nchk:),'X') - if (ntinx .gt. nchk-1) then -c -c There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. -c - if (ntinx.gt.1) then - if (line(ntinx-1:ntinx-1).ne.' ') then -c -c The X is not 1st char of PMX command. Advance starting point, loop. -c - nchk = ntinx+1 - go to 13 - end if - end if -c -c We now know the X at ntinx starts a PMX command. Find next blank -c - ib = ntinx+index(line(ntinx+1:),' ') -c -c There must be a blank to right of "X", so ib>ntinx -c -c locp = nchk-1+index(line(nchk:ib),'P') - locp = ntinx+index(line(ntinx+1:ib),'P') -c -c Did not need to use ntindex because we already know bounds of PMX command. -c -c if (locp .gt. nchk-1) then - if (locp .gt. ntinx) then -c -c Strip out the 'P' -c - templine = line(1:locp-1) - line = templine(1:locp-1)//line(locp+1:lenline) - lenline = lenline-1 - ib = ib-1 - end if - if (index(line(ntinx:ib),':').gt.0 .or. - * index(line(ntinx:ib),'S').gt.0 .or. - * index(line(ntinx:ib),'B').gt.0 .or. locp.gt.ntinx) then -c -c The X command is a shift, "Both", or "Part". Do not remove. -c - nchk = ib+1 - go to 13 - end if -c -c Remove the X command. -c - if (ntinx .eq. 1) then - if (ib .lt. lenline) then - line = line(ib+1:lenline) - else -c -c line contains ONLY the "X" command, so get a new line -c - go to 4 - end if - else - templine = line(1:ntinx-1) - if (ib .lt. lenline) then - line = templine(1:ntinx-1)//line(ib+1:lenline) - else - line = templine(1:ntinx-1) - end if - end if -c -c Recompute lenline -c - lenline = lenstr(line,128) -c -c Resume checking after location of removed command. -c - nchk = ntinx - go to 13 - end if -c -c End of loop for X-checks -c - oneof2 = ntindex(line,'//') .gt. 0 - if (termrpt .and. botv(iv) .and. frstln .and. - * line(lenline:lenline).eq.'/') then -c -c Must add a terminal repeat before the slash -c - if (oneof2) lenline = lenline-1 - if (lenline.gt.1) write(10+iorig(iinst),'(a)')line(1:lenline-1) - if (.not. oneof2) then - line = termsym//' /' - lenline = 4 - else - line = termsym//' //' - lenline = 5 - end if - end if - if (termrpt .and. frstln .and. line(lenline:lenline).eq.'/' .and. - * iv.eq.nvnow) termrpt = .false. - write(10+iorig(iinst),'(a)')line(1:lenline) - if (oneof2) then - frstln = .false. - else if (.not.frstln) then - frstln = .true. - end if -c if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then - if (ntindex(line,'/').gt.0 .and. ntindex(line,'//').eq.0) then - iv = 1+mod(iv,nvnow) - iinst = instnum(iv) - end if - go to 4 -999 continue - close(10) -c -c In the mbrest checks, must run through ALL noinst files (not just noinow) -c - do 11 iinst = 1 , noinst -ccc+++ -cc -cc Temporarily transfer entire scratch file to real file -cc -c rewind(10+iinst) -c open(40,file='s2pout'//char(48+iinst)//'.pmx') -c do 50 m = 1 , 10000 -c read(10+iinst,'(a)',end=51)line -c lenline = lenstr(line,128) -c if (lenline .ge. 1) then -c write(40,'(a)')line(1:lenline) -c else -c write(40,'(a)')' ' -c end if -c50 continue -c51 continue -c close(40) -ccc+++ - if (nvi(iinst) .eq. 1) then - call mbrests(iinst,jobname,ljob,ludpfn(iinst),udpfnq(iinst)) - else -c -c Send a signal with ljob to bypass most mbrest processing -c - call mbrests(iinst,jobname,-ljob,ludpfn(iinst),udpfnq(iinst)) - end if -11 continue - end - function lenstr(string,n) - character*(*) string - do 1 lenstr = n , 1 , -1 - if (string(lenstr:lenstr) .ne. ' ') return -1 continue - lenstr = 0 - return - end - subroutine allparts(string,n) - parameter (noimax=24) - character*(*) string - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv - len = lenstr(string,n) - if (len .eq. 0) then - len = 1 - string = ' ' - end if - do 1 iinst = 1 , noinow - write(10+iorig(iinst),'(a)')string(1:len) -1 continue - return - end - subroutine mbrests(iv,jobname,ljob,ludpfn,udpfnq) - character*128 line(50),line1,udpfnq - character*80 sym - character*12 jobname - character*3 wbrsym(2) - character*2 partq - character*1 sq - logical wbrest,alldone,rpfirst,newmtr,type4 - type4 = .false. - sq = char(92) - alldone = .false. - rewind(10+iv) - if (iv .lt. 10) then - partq(1:1) = char(48+iv) - lpart = 1 - else - lpart = 2 - if (iv .lt. 20) then - partq = '1'//char(38+iv) - else - partq = '2'//char(28+iv) - end if - end if -c 130327 -c open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') - if (ludpfn .eq. 0) then - open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') - else - open(40,file=udpfnq(1:ludpfn)//'.pmx') - end if - do 10 i = 1 , 10000 - read(10+iv,'(a)')line(1) - if (line(1)(1:1).eq.'%' .or. line(1)(1:3).eq.'---' - * .or. type4) then - len = lenstr(line(1),128) - if (len .gt. 0) then - write(40,'(a)')line(1)(1:len) - else - write(40,'(a)')' ' - end if - if (line(1)(1:3).eq.'---') type4 = .not.type4 - else - go to 11 - end if -10 continue - print*,'You should not be here in scor2prt. Call Dr. Don' - stop -11 continue -c -c Finished reading opening type4 TeX and comments. Next line to be read -c will contain the first of the input numbers -c - call dosetup(iv,line(1),mtrnum,mtrden) - do 1 i = 1 , 10000 -13 read(10+iv,'(a)',end=999)line(1) -7 len = lenstr(line(1),128) -c -c Pass-through (and copy into part file) if instrumnet has >1 voice. -c - if (ljob .lt. 0) go to 2 - if (index('TtTiTch+h-h l ',line(1)(1:2)) .gt. 0) then -c -c Traps titles, instruments, composers, headers, lower strings. Read 2 lines. -c - write(40,'(a)')line(1)(1:len) - read(10+iv,'(a)')line(1) - len = lenstr(line(1),128) - go to 2 - end if - if (i.eq.1 .or. (i.gt.5.and.line(1)(1:1).eq.'m')) then -c -c Either just starting, or a new meter is defined. -c NOTE! The above test may be bogus. -c - if (line(1)(1:1) .eq. '%') then - write(40,'(a)')line(1)(1:len) - go to 13 - end if - if (i .ne. 1) then -c -c New meter. Check for slashes (new meter change syntax) -c - idxs = index(line(1),'/') - idxb = index(line(1),' ') - newmtr = idxs.gt.0 .and. (idxb.eq.0 .or. idxs.lt.idxb) - if (.not.newmtr) then -c -c Old way, no slashes, uses 'o' for lonesome '1' -c - icden = 3 - if (line(1)(2:2) .eq. 'o') then - mtrnum = 1 - else - mtrnum = ichar(line(1)(2:2))-48 - if (mtrnum .eq. 1) then - icden = 4 - mtrnum = 10+ichar(line(1)(3:3))-48 - end if - end if - mtrden = ichar(line(1)(icden:icden))-48 - else -c -c New way with slashes: idxs is index of 1st slash! -c - read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum - idxb = index(line(1)(idxs+1:),'/') - read(line(1)(idxs+1:idxs+idxb-1), - * '(i'//char(48+idxb-1)//')')mtrden - end if - end if - lenbeat = ifnodur(mtrden,'x') - lenmult = 1 - if (mtrden .eq. 2) then - lenbeat = 16 - lenmult = 2 - end if - lenbar = lenmult*mtrnum*lenbeat - call fwbrsym(lenbar,nwbrs,wbrsym,lwbrs) - end if -c -c Finished setting up meter stuff and defining whole-bar rest symbols -c - ip1 = 0 - line1 = line(1) - do 3 iw = 0 , nwbrs - if (iw .gt. 0) then - idx = ntindex(line1,wbrsym(iw)(1:lwbrs)) - if (idx .gt. 0) then -c -c Check for blank or shifted rest, discount it if it's there -c - if (line1(idx+lwbrs:idx+lwbrs).ne.' ') idx = 0 - end if - else - idx = ntindex(line1,'rp') -c -c Check for raised rest -c - if (idx.gt.0) then - if (line1(idx+2:idx+2).ne.' ') idx = 0 - end if - end if - if (idx .gt. 0) then - if (ip1 .eq. 0) then - ip1 = idx - else - ip1 = min(ip1,idx) ! Maybe allows e.g. r0 rp ... - end if - end if -3 continue - if (i.lt.5 .or. line(1)(1:1).eq.'%' .or. line(1)(1:2).eq.sq//sq - * .or. ip1.eq.0) go to 2 -c -c Switch to multibar rest search mode!!! Start forward in line(1) -c - rpfirst = line1(ip1:ip1+1) .eq. 'rp' - iline = 1 - nmbr = 1 - if (rpfirst) then - lwbrsx = 2 - else - lwbrsx = lwbrs - end if - ipe = ip1+lwbrsx-1 ! ip at end of 1st wbrsym -4 if (ipe .eq. len) then -c -c Need a new line -c - iline = iline+1 -6 read(10+iv,'(a)',end=998)line(iline) - len = lenstr(line(iline),128) - if (line(iline)(1:1).eq.'%' ) then - write(40,'(a)')'% Following comment has been moved forward' - write(40,'(a)')line(iline)(1:len) - go to 6 - end if - ipe = 0 - go to 4 -998 continue -c -c No more input left -c - print*,'All done!' - alldone = .true. - ipe = 0 - iline = iline-1 - len = lenstr(line(iline),128) - go to 4 - else - if (alldone) then - sym(1:1) = ' ' - else -c -c ipe=len ' - print*,'Send files to Dr. Don at dsimons@logicon.com' - stop - end if - do 1 ip = ipeold+1 , len - if (line(ip:ip) .ne. ' ') then -c -c symbol starts here (ip). We're committed to exit the loop. -c - if (ip .lt. len) then - do 2 iip = ip+1 , len - if (line(iip:iip) .ne. ' ') go to 2 -c -c iip is the space after the symbol -c - ipenew = iip-1 - lsym = ipenew-ip+1 - sym = line(ip:ipenew) - return -2 continue -c -c Have len>=2 and ends on len -c - ipenew = len - lsym = ipenew-ip+1 - sym = line(ip:ipenew) - return - else -c -c ip = len -c - ipenew = len - lsym = 1 - sym = line(ip:ip) - return - end if - end if -1 continue - print*,'Error #3. Send files to Dr. Don at dsimons@logicon.com' - end - function ntindex(line,s2q) -c -c Returns index(line,s2q) if NOT in TeX string, 0 otherwise -c - character*(*) s2q - character*128 line,tline - logical intex -c -c print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below' -c print*,line(1:79) -c -c -c Use a temporary string to store the input and test, so can zap D"..." -c - tline = line - ndxs2 = index(tline,s2q) -c -c Return point below for rechecks after zapping D" " -c -2 continue - ndxbs = index(tline,char(92)) - if (ndxbs .gt. 0) then -c -c Special check in case \ is inside D"..." -c - ndxDq1 = index(tline,'D"') -c -c If the following test fails, flow out of if block; else loop up to 2. -c - if (ndxDq1 .gt. 0) then -c -c Find end of D"..." -c - ndxDq2 = ndxDq1+1+index(tline(ndxDq1+2:128),'"') - if (ndxDq2 .eq. ndxDq1+1) then - print*,'Something is really wierd here' - stop - end if - tline = tline(1:ndxDq1-1) - do 3 ic = ndxDq1 , ndxDq2 - tline = tline(1:ic-1)//' ' -3 continue - tline = tline(1:ndxDq2)//line(ndxDq2+1:128) - go to 2 - end if - end if - if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then - ntindex = ndxs2 -c print*,'No bs, or char is left of 1st bs, ntindex:',ntindex - else -c -c There are both bs and s2q, and bs is to the left of sq2. So check bs's to -c right of first: End is '\ ', start is ' \' -c - len = lenstr(tline,128) - intex = .true. -c print*,'intex+>',intex - do 1 ic = ndxbs+1 , len - if (ic .eq. ndxs2) then - if (intex) then - ntindex = 0 - ndxs2 = index(tline(ic+1:len),s2q)+ic -c print*,'ndxs2 =>',ndxs2 - else - ntindex = ndxs2 - return - end if -c print*,'Internal exit, intex, ntindex:',intex,ntindex - else if (intex .and. tline(ic+1:ic+2).eq.char(92)//' ') then - intex = .false. -c print*,'intex+>',intex - else if (.not.intex .and. tline(ic+1:ic+2).eq.' '//char(92)) - * then - intex = .true. -c print*,'intex+>',intex - end if -1 continue -c print*,'Out end of loop 1' - end if -c print*,'Exiting ntindex at the end???' - return - end - subroutine getchar(line,iccount,charq) -c -c Gets the next character out of line*128. If pointer iccount=128 on entry, -c then reads in a new line. Resets iccount to position of the new character. -c - character*1 charq - character*128 line - if (iccount .eq. 128) then - read(10,'(a)')line - iccount = 0 - end if - iccount = iccount+1 - charq = line(iccount:iccount) - return - end - function readin(line,iccount,iread) - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv,goto999 -c -c Reads a piece of setup data from line, gets a new line from -c file 10 (jobname.pmx) if needed, Transfers comment lines into all parts. -c -c iread controls copying of values into scratch files for parts, but only -c if not replacing. -c -c iread input value written -c -1 nvi nothing (only used when noinst<0 initially) -c 0 various value read -c 1 nv -1 , replace later with nvi(i) -c 2 noinst 1 -c 3 np -2 , replace later with (nsyst-1)/12+1 -c 4 musicsize 20 -c 5 fracondent 0.05 -c - character*128 line - character*1 durq -4 if (iccount .eq. 128) then - read(10,'(a)')line - if (replacing) replacing = .false. - call chkcom(line,goto999) - iccount = 0 - end if - iccount = iccount+1 -c -c Find next non-blank or end of line -c - do 2 iccount = iccount , 127 - if (line(iccount:iccount) .ne. ' ') go to 3 -2 continue -c -c If here, need to get a new line -c - iccount = 128 - go to 4 -3 continue -c -c iccount now points to start of number to read -c - i1 = iccount -5 call getchar(line,iccount,durq) -c -c Remember that getchar first increments iccount, *then* reads a character. -c - if (index('0123456789.-',durq) .gt. 0) go to 5 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - stop 1 - end if - icf = i2-i1+49 - read(line(i1:i2),'(f'//char(icf)//'.0)')readin - if (.not.replacing) then - if (iread .eq. 0) then - call allparts(line(i1:i2),i2-i1+1) - else if (iread .eq. 1) then - call allparts('-999',4) - else if (iread .eq. 2) then - call allparts('1',1) - else if (iread .eq. 3) then - call allparts('-998',4) - else if (iread .eq. 4) then - call allparts('20',2) - else if (iread .eq. 5) then - call allparts('.05',3) - else if (iread .ne. -1) then - print*,'Error with iread in readin' - stop - end if - end if - return - end - subroutine chkcom(line,goto999) - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,clefpend,botv,goto999 - character*128 line -c -c Assume that line has just been read. No need to change iccount since we only -c process full lines. -c - goto999 = .false. -1 if (line(1:1) .ne. '%') return -c -c If here, line has some sort of comment -c - if (line(2:2) .eq. '%') then - if (.not. insetup) then -c -c Suck up a line, then flow out of "if" block to get another and loop -c - read(10,'(a)')line - -c++VV -c -c UNLESS (a) it has a score-only "M" and changes # of inst's. -c - if (index(line,'M') .gt. 0) then - idxL = index(line,'L') - idxM = index(line,'M') - idxn = index(line,'n') - idxb = index(line,' ') - if (idxL.lt.idxM .and. idxM.lt.idxn .and. - * (idxb.eq.0 .or. idxn.lt.idxb)) then - noinow = ichar(line(idxn+1:idxn+1))-48 - clefpend = .true. -c -c Next noinow digits are original inst. #'s of new inst. set. Next noinow -c char's after that are clefs -c - nvnow = 0 - do 24 j = 1 , noinow - iorig(j) = ichar(line(idxn+1+j:idxn+1+j))-48 - iposc0 = idxn+1+noinow - do 25 k = 1 , nvi(iorig(j)) - nvnow = nvnow+1 -c clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) - instnum(nvnow) = j - botv(nvnow) = k.eq.1 .and. j.ne.1 -25 continue -24 continue - end if - end if -c -c or if it's "h" or "l", need to suck up one more line -c - if ((line(1:1).eq.'h'.and.index('+- ',line(2:2)).gt.0) .or. -c -c 4/29/00 check for T string also -c - * line(1:1).eq.'T' .or. - * line(1:2).eq.'l ') read(10,'(a)')line - else -c -c In setup mode. Set flag, flow out and do use following line -c - replacing = .true. - end if - else if (line(2:2) .eq. '!') then -c -c Copy to all parts -c - call allparts(line(3:128),125) - else -c -c Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise -cc Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise -c - ivq = index('123456789abcdefghijklmno',line(2:2)) -c -c Only treat as part-specific pmx line if number .le. noinst -c - if (ivq.lt.1 .or. ivq.gt.noinst) then -c -c Simple comment. -c - call allparts(line,128) - else -c -c Instrument comment, copy only to part -c - lenline = lenstr(line,128) - if (lenline .gt. 2) then - write(10+ivq,'(a)')line(3:lenline) - else -c -c Transferring blank line -c - write(10+ivq,'(a)')' ' - end if - end if - end if - read(10,'(a)',end=2)line - call zapbl(line,128) - go to 1 -2 continue - goto999 = .true. - return - end - subroutine dosetup(iv,line,mtrnum,mtrden) - parameter (noimax=24) -c -c Transfers setup data from scratch file to real one for one instrument -c Data may be mixed with comments, but on entry 1st item is a number. -c Write a comment when encountered, as it comes. -c Write numbers one per line. -c Three input data require special handling: -c If not already replaced, i.e., if negative, then -c iset(1) (nv) will be replaced with nvi(i) -c iset(9) (npages) will be replaced with (nsyst-1)/12+1 -c iset(2), if negative, will be followed by extra numbers to be transf. -c - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - character*128 line - logical insetup,replacing,botv - iccount = 0 - do 1 iset = 1 , 12 - call partnum(iv,iccount,line,xdata) - if (iset .eq. 2) then - if (xdata .gt. 0) then - write(40,'(i5)')int(xdata+.1) - else - noi = -xdata+.1 - write(40,'(i5)')noi - do 2 ioi = 1 , noi - call partnum(iv,iccount,line,xdata) - write(40,'(i5)')int(xdata+.1) -2 continue - end if -c else if (iset.ne.8 .and. xdata.lt.0) then - else if (iset.ne.8 .and. iset.ne.5 .and. xdata.lt.0) then -c -c Must be either nv or npages -c - if (int(-xdata+.1) .eq. 999) then -c -c It's nv -c - write(40,'(i5)')nvi(iv) - else -c -c npages must be computed -c - write(40,'(i5)')(nsyst-1)/12+1 - end if - else if (iset.ne.7 .and. iset.ne.12) then -c -c write integer -c - write(40,'(i5)')nint(xdata) - else -c -c write floating number -c - write(40,'(f5.2)')xdata - end if - if (iset .eq. 3) then - mtrnum = nint(xdata) - else if (iset .eq. 4) then - mtrden = nint(xdata) - end if -1 continue - return - end - subroutine partnum(iv,iccount,line,xdata) -c -c Simplified number parsing. Only looks for comment lines and numbers. -c - character*128 line - character*1 durq -2 if (iccount .eq. 128) then - read(10+iv,'(a)')line - if (line(1:1) .eq. '%') then - len = lenstr(line,128) - write(40,'(a)')line(1:len) - go to 2 - end if - iccount = 0 - end if - iccount = iccount+1 -c -c Find next non-blank or end of line -c - do 4 iccount = iccount , 127 - if (line(iccount:iccount) .ne. ' ') go to 3 -4 continue -c -c If here, iccount=128 and need to get a new line -c - go to 2 -3 continue -c -c iccount now points to start of number to read -c - i1 = iccount -5 call getchar(line,iccount,durq) -c -c Remember that getchar first increments iccount, *then* reads a character. -c - if (index('0123456789.-',durq) .gt. 0) go to 5 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - stop 1 - end if - icf = i2-i1+49 - read(line(i1:i2),'(f'//char(icf)//'.0)')xdata - return - end - block data - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv - data nvi /noimax*1/, noinst,noinow /2*noimax/ - data botv /noimax*.false./ - end - subroutine zapbl(string,len) - character*(*) string - do 1 i = 1 , len - if (string(i:i) .eq. ' ')go to 1 - if (i .eq. 1) return - go to 2 -1 continue -c -c If line is all blank, leave it alone -c - return -2 continue - string = string(i:len) - return - end - subroutine OddQuotesBefore(lineq,indx,yesodd) -c -c This counts number of double quotes in lineq up to position indx-1, then -c sets yesodd according to whether number is odd or even -c - logical yesodd - character*(*) lineq - numdqs = 0 - do 1 i = 1 , indx-1 - if (lineq(i:i) .eq. '"') numdqs = numdqs+1 -1 continue - yesodd = mod(numdqs,2) .eq. 1 - return - end - - - - - +cccccccccccccccccccccccccc +cc +cc scor2prt 1/29/21 for PMX 2.94 +cccccccccccccccccccccccccc +c This program, developed by Don Simons (dsimons@roadrunner.com), is +c part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert +c with MusiXTeX and TeX, the purpose of PMX is to allow the user to create +c high-quality typeset musical scores by including a sequence of PMX commands +c in an ASCII input file. Scor2prt is an auxiliary program that creates PMX +c input files for individual parts from the PMX input file for the score. +c +c This program is free software: you can redistribute it and/or modify +c it under the terms of the GNU General Public License as published by +c the Free Software Foundation, either version 3 of the License, or +c (at your option) any later version. +c +c This program is distributed in the hope that it will be useful, +c but WITHOUT ANY WARRANTY; without even the implied warranty of +c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +c GNU General Public License for more details. +c +c You should have received a copy of the GNU General Public License +c along with this program. If not, see . +c +c 1/29/21 +c Reformat output statement for warning about full bar rests to +c eliminate use of H format specifier +c 2/19/16 +c Exit gracefully when last input line is comment, with mods in +c subroutine chkcom, adding logical argument goto999 +c which is set to .true. in that case, causing input file to +c be closed after exiting. +c 4/9/12 +c Add logical declarations to subroutine dosetup +c 8/8/11 +c Copy & mod Ki into parts when after beginning. +c 7/18/11 +c Start to fix up for AS..., also Ki was done a little earlier. +c 7/5/10 +c Modify Manual to explain extended hex numbering for part-specific comments +c 5/16/10 +c Extend part-specific comments for up to 24 parts (subroutine chkcom) +c Allow files 11-34 for parts +c Change file 30 to 40 +c 6/1/08 es2p +c noimax = 24 +c +c To do +c Override fracindent, musicsize? +c Deal with midbar R? +c 2/29/04 +c Check for special character being in quoted string. +c 10/20/02 PMX 2.407 +c Interpret AN[n]"[used-defined-part-file-name]" +c 1/21/02 +c Deals with rm in multiple parts. +c s2p15 +c Get right non-tex index even if there's "\" inside D"..." +c s2p14 +c 10/29/00 fix transfer to parts of negative mtrdnp +c 4/29/00 screen for "%%" followed by "T" +c Restore change from "Version 2.1a, 21 Dec" +c s2p13 +c Allow whole-bar double-whole rests. +c Bypass MIDI commands "I..." achar(10)="I" +c s2p12 +c Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla +c only taken as such if ? represents a hex digit .le. noinst, otherwise it's +c a simple comment. This lessens incompatibility. +c In subroutine mbrest, properly open parts 10-12 if needed +c s2p11 +c Ignore leading blanks +c Fix undefined linelength in mbrest at very end of comments. +c s2p10 +c Fix non-transfer of P..c" " +c Allow "%%" and "%"n anywhere +c Version 1.43 +c Fix bug with P in TeX string. +c Ignore shifted whole-bar rests when consolidating whole-bar rests +c Copy type 4 TeX into all parts. +c Deal with XB and XP. +c Permit transfer of blank line into parts +c Change staves/inst in 'M' command. +c Arbitrary staves/inst. +c Recognize m1/2/3/4 syntax. +c Enable comment and one-voice syntax in instrument names +c +c Changes since 1.1 +c Deal with saved macros. +c Revise setup readin, to admit comments. +c Do not copy 'X' into parts +c +cccccccccccccccccccccccccccccccccccccccccccccccc + parameter (noimax=24) + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + integer*4 ludpfn(noimax) + character*1 sq,achar(10) + character*2 termsym + character*27 jobname,infileq + character*128 instrum(noimax),udpfnq(noimax) + character*128 line,holdln,templine + logical termrpt,isachar,frstln,oneof2,botv,clefpend,fexist, + * insetup,replacing,gotname,yesodd,goto999 + character*1 dumq + data achar /'P','m','V','R','A','h','w','K','M','I'/ + clefpend = .false. + insetup = .true. + replacing = .false. + frstln = .true. + lenhold = 0 + sq = char(92) + print*,'This is scor2prt for PMX 2.94, 29 January 2021' + numargs = iargc() + if (numargs .eq. 0) then + print*,'You could have entered a jobname on the command line,' + print*,' but you may enter one now:' + read(*,'(a)')jobname + numargs = 1 + else +c call getarg(1,jobname,idum) ! May need to replace this w/ next line + call getarg(1,jobname) + end if + ljob = lenstr(jobname,27) + if (ljob .eq. 0) then + print*,'No was jobname entered. Restart and try again.' + stop + end if +c +c Strip ".pmx" if necessary +c + ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX')) + if (ndxpmx .gt. 0) then + jobname = jobname(1:ndxpmx-1) + ljob = ljob-4 + end if +c +c Check for existence of input file +c + infileq = jobname(1:ljob)//'.pmx' + inquire(file=infileq,EXIST=fexist) + if (.not.fexist) then + print*,'Cannot find file '//infileq + stop + end if + open(10,file=jobname(1:ljob)//'.pmx') +c +c Open all instrument files now for allparts stuff. Later disgard those >nv +c + do 19 iv = 1 , noimax + iorig(iv) = iv + open(10+iv,status='SCRATCH') + ludpfn(iv) = 0 +19 continue + read(10,'(a)')line + call chkcom(line,goto999) + if (line(1:3) .eq. '---') then + call allparts(line,128) +31 read(10,'(a)')line + if (line(1:3) .ne. '---') then + call allparts(line,128) + go to 31 + end if + call allparts(line,128) + read(10,'(a)')line + call chkcom(line,goto999) + end if + iccount = 0 + nv = readin(line,iccount,1)+.1 + noinst = readin(line,iccount,2)+.1 + if (noinst .gt. 0) then + nvi(1) = nv-noinst+1 + else + noinst = 1-noinst + do 21 iinst = 1 , noinst + nvi(iinst) = readin(line,iccount,-1)+.1 +21 continue + end if + noinow = noinst + insnow = 1 +c +c ivlast is last iv in current inst. instnum(iv) is iinst for current voice. +c + ivlast = nvi(1) + do 22 iv = 1 , nv + instnum(iv) = insnow + if (iv .eq. ivlast) then + if (iv .lt. nv) botv(iv+1) = .true. +c +c The previous stmt will set botv true only for bot voice of iinst>1. It is +c used when writing termrpts, but the one in voice one is handled differently, +c so botv(1) is left .false. +c + if (insnow .lt. noinst) then + insnow = insnow+1 + ivlast = ivlast+nvi(insnow) + end if + end if +22 continue + mtrnuml = readin(line,iccount,0)+.1 + mtrdenl = readin(line,iccount,0)+.1 + mtrnmp = readin(line,iccount,0)+.1 + mtrdnp = readin(line,iccount,0)+.1 + xmtrnum0 = readin(line,iccount,0) + isig = readin(line,iccount,0)+.1 + npages = readin(line,iccount,3)+.1 + nsyst = readin(line,iccount,0)+.1 + musicsize = readin(line,iccount,4)+.1 + fracindent = readin(line,iccount,5) + if (npages .eq. 0) then + print*, + *'You entered npages=0, which means nsyst is not the total number' + print*, + *'of systems. Scor2prt has to know the total number of systems.' + print*, + *'Please set npages and nsyst to their real values.' + stop + end if +c +c Must leave insetup=.true. else could bypass ALL instrument names. +c + read(10,'(a)')line + call chkcom(line,goto999) + backspace(10) +c +c Normally this puts pointer at start of line with 1st inst name +c Check if prior line was "%%" +c + backspace(10) + read(10,'(a)')line + if (line(1:2) .eq. '%%') backspace(10) + do 14 iv = 1 , noinst + gotname = .false. +16 read(10,'(a)') instrum(iv) + if (instrum(iv)(1:2) .eq. '%%') then + read(10,'(a)')line + go to 16 + else if (instrum(iv)(1:1) .eq. '%') then + ivq = ichar(instrum(iv)(2:2))-48 + if (ivq.ne.iv) then +c +c It's really a comment. Copy to parts, then get another trial name. +c + call allparts(instrum(iv),128) + go to 16 + else + line = instrum(iv)(3:) + instrum(iv) = line + gotname = .true. + end if + else + gotname = .true. + end if +cc +cc The following checks for macro that write original C-clef as part of +cc instrument name. See pmx.tex +cc +c if (index(instrum(iv),'namewpc') .eq. 0) then +c write(10+iv,'(a)')' ' +c else +c inm1 = index(instrum(iv),'{')+1 +c inm2 = index(instrum(iv),'}')-1 +c read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2 +c write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'// +c * char(iy1+49)//char(iy2+49) +c instrum(iv) = instrum(iv)(inm1:inm2) +c end if + if (.not.gotname) then + print*,'You must provide a replacement instrument name' + stop + end if + write(10+iv,'(a)')' ' +14 continue + replacing = .false. + nvnow = nv +c +c Clef string: Note insetup is still T, so "%%" will be treated specially +c + read(10,'(a)')line + call chkcom(line,goto999) + if (replacing) then +c +c If here, we have next line after "%%", containing score's clef string +c Assume all clefs are handled with instrument comments. +c + read(10,'(a)')line + call chkcom(line,goto999) + backspace(10) + else +c +c If here, line has the clef string in it. Handle the old way +c + kvstart = 1 + kvend = nvi(1) + do 2 inst = 1 , noinst + write(10+inst,'(a'//char(48+nvi(inst))//')') + * line(kvstart:kvend) + if (inst .lt. noinst) then + kvstart = kvend+1 + kvend = kvstart+nvi(inst+1)-1 + end if +2 continue + end if + replacing = .false. + insetup = .false. +c +c *****NOTE*****This comment applies to stuff done earlier! +c Before starting the big loop, copy initial instnum and staffnum stuff +c into working values. Latter may change if noinst changes. Also make +c list of current inst nums relative to original ones. In addition to those +c below, must redo instnum(iv) and botv(iv) when we change noinst. +c +c Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! +c +18 read(10,'(a)') line + if (line(1:1) .eq. '%') then + call allparts(line,128) + go to 18 + end if + call allparts(line,128) +c +c Write instrument names. Will be blank if later part of a score. +c + if (instrum(1)(1:1) .ne. ' ') then + do 3 iv = 1 , noinst + len = lenstr(instrum(iv),79) + write(10+iv,'(a2/a)')'Ti',instrum(iv)(1:len) +3 continue + end if +c +c The big loop. Except for '%%', put all comment lines in all parts. +c Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts +c If a line starts with %!, put the rest of it in each part. +c If a line starts with %[n], put the rest of it in part [n]. +c Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes. +c Assume they only come at top of block, except terminal repeat needs +c special handling. +c Check for "P"; ignore in parts. +c Check for consecutive full-bar rests; if found, replace with rm[nn] +c + iv = 1 + iinst = 1 + termrpt = .false. +4 continue + read(10,'(a)',end=999)line + lenline = lenstr(line,128) + if (lenline .eq. 0) go to 4 + call zapbl(line,128) + call chkcom(line,goto999) + if (goto999) go to 999 + lenline = lenstr(line,128) + if (lenline .eq. 0) go to 4 + if (line(1:1) .eq. 'T') then + call allparts(line,128) + read(10,'(a)')line + call allparts(line,128) + go to 4 + else if (line(1:2) .eq. sq//sq) then + call allparts(line,128) + go to 4 + else if (index('hl',line(1:1)).gt.0 .and. + * index(' +-',line(2:2)) .gt. 0) then + call allparts(line,128) + read(10,'(a)')line + call allparts(line,128) + go to 4 + else if (iv .eq. 1) then + do 5 ia = 1 , 10 +24 continue + idxa = ntindex(line,achar(ia)) + isachar = idxa .gt. 0 + if (idxa.gt.1) isachar = line(idxa-1:idxa-1).eq.' ' +c +c 1 2 3 4 5 6 7 8 9 10 +c data achar /'P','m','V','R','A','h','w','K','M','I'/ +c + if (ia .eq. 9) isachar = + * isachar .and. line(idxa+1:idxa+1).eq.'S' + if (isachar) then +c +c Check whether character is inside a quoted string by counting +c how many quotes precede it in the line +c + + call OddQuotesBefore(line,idxa,yesodd) + if (yesodd) isachar=.false. + end if + if (isachar) then +c +c Find next blank +c + do 6 ib = idxa+1 , 128 + if (line(ib:ib) .eq. ' ') go to 7 +6 continue + print*,'Problem with "V,R,m,P,A,h,MS, or w"' + print*, + * 'Send files to Dr. Don at dsimons at roadrunner dot com' + stop 1 +7 continue +c +c Next blank is at position ib. Later, if ia=1, must check for Pc" " ; +c i.e., look for '"' between P and blank +c + if (ia .eq. 4) then +c +c Check for terminal repeat. Note if there's a term rpt, there can't be any +c others. Also, must process repeats LAST, after m's and 'V's +c + do 8 ic = ib+1 , 128 +c +c If any subsequent character on this line is neither blank nor "/", get out +c + if (index(' /',line(ic:ic)) .eq. 0) go to 9 + if (line(ic:ic) .eq. '/') then + termrpt = .true. + termsym = line(ib-2:ib-1) +c +c Process the line as if there were no "R" +c + go to 10 + end if +8 continue +c +c +++ 060812 +c If here, all chars after "R" symbol are blanks, so process the line normally, +c but only IF next line is not the M-Tx line " /" +c + read(10,'(a)')templine + if (templine(1:2) .ne. ' /') then + backspace(10) ! and flow out + else +c +c We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, +c and proceed as above +c + line = line(1:ib)//'/' + lenline = lenline+2 + termrpt = .true. + termsym = line(ib-2:ib-1) + go to 10 + end if +c +++ 060812 +c + else if (ia .eq. 1) then + idxq = ntindex(line,'"') + if (idxq.gt.idxa .and. idxq.lt.ib) then +c +c Quote is between P and next blank. Find 2nd quote, starting at the blank. +c + idxq2 = ib-1+ntindex(line,'"') + if (idxq.eq.0 .or. line(idxq2+1:idxq2+1).ne.' ') then + print* + print*,'Error copying P with quotes, idxq2:',idxq2 + print*,line(1:60) + stop 1 + end if + ib = idxq2+1 + end if +c +c Do not transfer P into parts. +c + go to 12 + else if (ia .eq. 9) then +c +c Start Saving a macro. After leaving here, a symbol will be sent to all parts, +c If all on this line, set ib to end and exit normally. +c + ndxm = index(line(ib+1:128),'M') + if (ndxm.gt.0 .and. line(ib+ndxm-1:ib+ndxm-1).eq.' ') then +c +c Macro ends on this line +c + ib = ib+ndxm+1 + else +c +c Save leading part of current line +c + lenhold = idxa-1 + if (lenhold .gt. 0) holdln = line(1:lenhold) +c +c Transfer rest of line +c + call allparts(line(idxa:128),129-idxa) +c +c Read next line +c +20 read(10,'(a)')line +c +c Check for comment, transfer and loop if so +c +c if (line(1:1) .eq.'%') then +23 if (line(1:1) .eq.'%') then +c call allparts(line,128) +c go to 20 + call chkcom(line,goto999) + go to 23 + end if +c +c Look for terminal ' M' +c + if (line(1:1) .eq. 'M') then + ndxm = 1 + else + ndxm = index(line,' M') + if (ndxm .gt. 0) ndxm = ndxm+1 + end if + if (ndxm .gt. 0) then +c +c Set parameters, exit normally (but later check for leading part of 1st line +c + idxa = 1 + ib = ndxm+1 + else +c +c No "M", transfer entire line, loop +c + call allparts(line,128) + go to 20 + end if + end if + else if (ia .eq. 10) then +c +c Do not transfer MIDI command into parts +c + go to 12 + else if (ia .eq. 5) then +c +c First check for "AS", but S may come after other "A" options +c + idxS = index(line(idxa+1:ib),'S') + if (idxS .gt. 0) then +c +c Get rid of the string. First check if that's all there is in A. +c + if (ib-idxa .eq. nv+2) go to 12 + line = line(1:idxa+idxS-1)//line(idxa+idxS+nv+1:ib) + end if +c +c Check for user-defined part file name. Must start in column 1 and have +c AN[n]"userfilename". +c idxa is position of "A" +c ib is position of the next blank after "A" +c Don't allow any blanks in user +c + if (line(idxa+1:idxa+1) .ne. 'N') go to 9 ! bail out + if (idxa .ne. 1) then + print* + print*, + * 'You entered "AN..." somewhere beyond first column; stopping.' + stop 1 + end if +c +c pmxa already checked for valid one- or 2-digit number, so get it +c + if (line(4:4) .eq. '"') then +c +c Single digit instrument number +c + read(line(3:3),'(i1)')iudpfn + idxstartname = 5 + else + read(line(3:4),'(i2)')iudpfn + idxstartname = 6 + end if + ludpfn(iudpfn) = index(line(idxstartname:128),'"')-1 + if (ludpfn(iudpfn) .lt. 0) then + print* + print*,'User-defined part file name must be in quotes' + stop 1 + end if + idxendname = idxstartname+ludpfn(iudpfn)-1 + udpfnq(iudpfn) = line(idxstartname:idxendname) +c +c Get a new line! +c + go to 4 + else if (ia .eq. 8) then +c +c Key change/transposition. +c If not instrument specific, copy to all parts +c + if (line(idxa+1:idxa+1).ne.'i') go to 9 +c +c Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... +c + ibb = idxa+2 ! Starts on digit after 'i' +40 continue + read(line(ibb:ibb),'(i1)')iiinst ! 1st digit of iinst + itemp = (index('01234567890',line(ibb+1:ibb+1))) + if (itemp.gt.0) then + ibb = ibb+1 + iiinst = 10*iiinst+itemp-1 + end if + ibb = ibb+1 ! now at first +/-. Need end of 2nd number + itemp = index(line(ibb+1:ib),'i') ! Rel pos'n of next 'i' or 0 + if (itemp .gt. 0) then + iend = ibb+itemp-1 + else + iend = ib-1 + end if + write(10+iorig(iiinst),'(a)')'Ki1'//line(ibb:iend) + if (itemp .gt. 0) then + ibb = iend+2 + go to 40 + end if + go to 12 ! Remove K command from string, go to next ia + end if +9 continue + call allparts(line(idxa:ib-1),ib-idxa) +12 continue +c +c Remove the string from line +c + if (idxa .eq. 1) then + line = line(ib:128) + else + line = line(1:idxa-1)//line(ib:128) + end if + lenline = lenstr(line,128) +c +c Loop if only blanks are left +c + if (lenline .eq. 0) go to 4 +c +c Must check for multiple "I" commands, so go to just after start of ia loop +c + if (ia .eq. 10) go to 24 +c +c Tack on front part from 1st line of saved macro +c + if (lenhold .gt. 0) then + line = holdln(1:lenhold)//' '//line(1:lenline) + lenhold = 0 + end if + end if +5 continue + end if +c +c Now a special loop to deal with 'X'. If it was %[n]X..., will have been +c copied into part [n] already. If no "B" or "P", remove. If "P", just +c remove the "P" so pmxa/b will process. If "B". do nothing. +c +10 continue + nchk = 1 +13 ntinx = nchk-1+ntindex(line(nchk:),'X') + if (ntinx .gt. nchk-1) then +c +c There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. +c + if (ntinx.gt.1) then + if (line(ntinx-1:ntinx-1).ne.' ') then +c +c The X is not 1st char of PMX command. Advance starting point, loop. +c + nchk = ntinx+1 + go to 13 + end if + end if +c +c We now know the X at ntinx starts a PMX command. Find next blank +c + ib = ntinx+index(line(ntinx+1:),' ') +c +c There must be a blank to right of "X", so ib>ntinx +c +c locp = nchk-1+index(line(nchk:ib),'P') + locp = ntinx+index(line(ntinx+1:ib),'P') +c +c Did not need to use ntindex because we already know bounds of PMX command. +c +c if (locp .gt. nchk-1) then + if (locp .gt. ntinx) then +c +c Strip out the 'P' +c + templine = line(1:locp-1) + line = templine(1:locp-1)//line(locp+1:lenline) + lenline = lenline-1 + ib = ib-1 + end if + if (index(line(ntinx:ib),':').gt.0 .or. + * index(line(ntinx:ib),'S').gt.0 .or. + * index(line(ntinx:ib),'B').gt.0 .or. locp.gt.ntinx) then +c +c The X command is a shift, "Both", or "Part". Do not remove. +c + nchk = ib+1 + go to 13 + end if +c +c Remove the X command. +c + if (ntinx .eq. 1) then + if (ib .lt. lenline) then + line = line(ib+1:lenline) + else +c +c line contains ONLY the "X" command, so get a new line +c + go to 4 + end if + else + templine = line(1:ntinx-1) + if (ib .lt. lenline) then + line = templine(1:ntinx-1)//line(ib+1:lenline) + else + line = templine(1:ntinx-1) + end if + end if +c +c Recompute lenline +c + lenline = lenstr(line,128) +c +c Resume checking after location of removed command. +c + nchk = ntinx + go to 13 + end if +c +c End of loop for X-checks +c + oneof2 = ntindex(line,'//') .gt. 0 + if (termrpt .and. botv(iv) .and. frstln .and. + * line(lenline:lenline).eq.'/') then +c +c Must add a terminal repeat before the slash +c + if (oneof2) lenline = lenline-1 + if (lenline.gt.1) write(10+iorig(iinst),'(a)')line(1:lenline-1) + if (.not. oneof2) then + line = termsym//' /' + lenline = 4 + else + line = termsym//' //' + lenline = 5 + end if + end if + if (termrpt .and. frstln .and. line(lenline:lenline).eq.'/' .and. + * iv.eq.nvnow) termrpt = .false. + write(10+iorig(iinst),'(a)')line(1:lenline) + if (oneof2) then + frstln = .false. + else if (.not.frstln) then + frstln = .true. + end if +c if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then + if (ntindex(line,'/').gt.0 .and. ntindex(line,'//').eq.0) then + iv = 1+mod(iv,nvnow) + iinst = instnum(iv) + end if + go to 4 +999 continue + close(10) +c +c In the mbrest checks, must run through ALL noinst files (not just noinow) +c + do 11 iinst = 1 , noinst +ccc+++ +cc +cc Temporarily transfer entire scratch file to real file +cc +c rewind(10+iinst) +c open(40,file='s2pout'//char(48+iinst)//'.pmx') +c do 50 m = 1 , 10000 +c read(10+iinst,'(a)',end=51)line +c lenline = lenstr(line,128) +c if (lenline .ge. 1) then +c write(40,'(a)')line(1:lenline) +c else +c write(40,'(a)')' ' +c end if +c50 continue +c51 continue +c close(40) +ccc+++ + if (nvi(iinst) .eq. 1) then + call mbrests(iinst,jobname,ljob,ludpfn(iinst),udpfnq(iinst)) + else +c +c Send a signal with ljob to bypass most mbrest processing +c + call mbrests(iinst,jobname,-ljob,ludpfn(iinst),udpfnq(iinst)) + end if +11 continue + end + function lenstr(string,n) + character*(*) string + do 1 lenstr = n , 1 , -1 + if (string(lenstr:lenstr) .ne. ' ') return +1 continue + lenstr = 0 + return + end + subroutine allparts(string,n) + parameter (noimax=24) + character*(*) string + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + logical insetup,replacing,botv + len = lenstr(string,n) + if (len .eq. 0) then + len = 1 + string = ' ' + end if + do 1 iinst = 1 , noinow + write(10+iorig(iinst),'(a)')string(1:len) +1 continue + return + end + subroutine mbrests(iv,jobname,ljob,ludpfn,udpfnq) + character*128 line(50),line1,udpfnq + character*80 sym + character*12 jobname + character*3 wbrsym(2) + character*2 partq + character*1 sq + logical wbrest,alldone,rpfirst,newmtr,type4 + type4 = .false. + sq = char(92) + alldone = .false. + rewind(10+iv) + if (iv .lt. 10) then + partq(1:1) = char(48+iv) + lpart = 1 + else + lpart = 2 + if (iv .lt. 20) then + partq = '1'//char(38+iv) + else + partq = '2'//char(28+iv) + end if + end if +c 130327 +c open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') + if (ludpfn .eq. 0) then + open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') + else + open(40,file=udpfnq(1:ludpfn)//'.pmx') + end if + do 10 i = 1 , 10000 + read(10+iv,'(a)')line(1) + if (line(1)(1:1).eq.'%' .or. line(1)(1:3).eq.'---' + * .or. type4) then + len = lenstr(line(1),128) + if (len .gt. 0) then + write(40,'(a)')line(1)(1:len) + else + write(40,'(a)')' ' + end if + if (line(1)(1:3).eq.'---') type4 = .not.type4 + else + go to 11 + end if +10 continue + print*,'You should not be here in scor2prt. Call Dr. Don' + stop +11 continue +c +c Finished reading opening type4 TeX and comments. Next line to be read +c will contain the first of the input numbers +c + call dosetup(iv,line(1),mtrnum,mtrden) + do 1 i = 1 , 10000 +13 read(10+iv,'(a)',end=999)line(1) +7 len = lenstr(line(1),128) +c +c Pass-through (and copy into part file) if instrumnet has >1 voice. +c + if (ljob .lt. 0) go to 2 + if (index('TtTiTch+h-h l ',line(1)(1:2)) .gt. 0) then +c +c Traps titles, instruments, composers, headers, lower strings. Read 2 lines. +c + write(40,'(a)')line(1)(1:len) + read(10+iv,'(a)')line(1) + len = lenstr(line(1),128) + go to 2 + end if + if (i.eq.1 .or. (i.gt.5.and.line(1)(1:1).eq.'m')) then +c +c Either just starting, or a new meter is defined. +c NOTE! The above test may be bogus. +c + if (line(1)(1:1) .eq. '%') then + write(40,'(a)')line(1)(1:len) + go to 13 + end if + if (i .ne. 1) then +c +c New meter. Check for slashes (new meter change syntax) +c + idxs = index(line(1),'/') + idxb = index(line(1),' ') + newmtr = idxs.gt.0 .and. (idxb.eq.0 .or. idxs.lt.idxb) + if (.not.newmtr) then +c +c Old way, no slashes, uses 'o' for lonesome '1' +c + icden = 3 + if (line(1)(2:2) .eq. 'o') then + mtrnum = 1 + else + mtrnum = ichar(line(1)(2:2))-48 + if (mtrnum .eq. 1) then + icden = 4 + mtrnum = 10+ichar(line(1)(3:3))-48 + end if + end if + mtrden = ichar(line(1)(icden:icden))-48 + else +c +c New way with slashes: idxs is index of 1st slash! +c + read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum + idxb = index(line(1)(idxs+1:),'/') + read(line(1)(idxs+1:idxs+idxb-1), + * '(i'//char(48+idxb-1)//')')mtrden + end if + end if + lenbeat = ifnodur(mtrden,'x') + lenmult = 1 + if (mtrden .eq. 2) then + lenbeat = 16 + lenmult = 2 + end if + lenbar = lenmult*mtrnum*lenbeat + call fwbrsym(lenbar,nwbrs,wbrsym,lwbrs) + end if +c +c Finished setting up meter stuff and defining whole-bar rest symbols +c + ip1 = 0 + line1 = line(1) + do 3 iw = 0 , nwbrs + if (iw .gt. 0) then + idx = ntindex(line1,wbrsym(iw)(1:lwbrs)) + if (idx .gt. 0) then +c +c Check for blank or shifted rest, discount it if it's there +c + if (line1(idx+lwbrs:idx+lwbrs).ne.' ') idx = 0 + end if + else + idx = ntindex(line1,'rp') +c +c Check for raised rest +c + if (idx.gt.0) then + if (line1(idx+2:idx+2).ne.' ') idx = 0 + end if + end if + if (idx .gt. 0) then + if (ip1 .eq. 0) then + ip1 = idx + else + ip1 = min(ip1,idx) ! Maybe allows e.g. r0 rp ... + end if + end if +3 continue + if (i.lt.5 .or. line(1)(1:1).eq.'%' .or. line(1)(1:2).eq.sq//sq + * .or. ip1.eq.0) go to 2 +c +c Switch to multibar rest search mode!!! Start forward in line(1) +c + rpfirst = line1(ip1:ip1+1) .eq. 'rp' + iline = 1 + nmbr = 1 + if (rpfirst) then + lwbrsx = 2 + else + lwbrsx = lwbrs + end if + ipe = ip1+lwbrsx-1 ! ip at end of 1st wbrsym +4 if (ipe .eq. len) then +c +c Need a new line +c + iline = iline+1 +6 read(10+iv,'(a)',end=998)line(iline) + len = lenstr(line(iline),128) + if (line(iline)(1:1).eq.'%' ) then + write(40,'(a)')'% Following comment has been moved forward' + write(40,'(a)')line(iline)(1:len) + go to 6 + end if + ipe = 0 + go to 4 +998 continue +c +c No more input left +c + print*,'All done!' + alldone = .true. + ipe = 0 + iline = iline-1 + len = lenstr(line(iline),128) + go to 4 + else + if (alldone) then + sym(1:1) = ' ' + else +c +c ipe=len ' + print*,'Send files to Dr. Don at dsimons@logicon.com' + stop + end if + do 1 ip = ipeold+1 , len + if (line(ip:ip) .ne. ' ') then +c +c symbol starts here (ip). We're committed to exit the loop. +c + if (ip .lt. len) then + do 2 iip = ip+1 , len + if (line(iip:iip) .ne. ' ') go to 2 +c +c iip is the space after the symbol +c + ipenew = iip-1 + lsym = ipenew-ip+1 + sym = line(ip:ipenew) + return +2 continue +c +c Have len>=2 and ends on len +c + ipenew = len + lsym = ipenew-ip+1 + sym = line(ip:ipenew) + return + else +c +c ip = len +c + ipenew = len + lsym = 1 + sym = line(ip:ip) + return + end if + end if +1 continue + print*,'Error #3. Send files to Dr. Don at dsimons@logicon.com' + end + function ntindex(line,s2q) +c +c Returns index(line,s2q) if NOT in TeX string, 0 otherwise +c + character*(*) s2q + character*128 line,tline + logical intex +c +c print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below' +c print*,line(1:79) +c +c +c Use a temporary string to store the input and test, so can zap D"..." +c + tline = line + ndxs2 = index(tline,s2q) +c +c Return point below for rechecks after zapping D" " +c +2 continue + ndxbs = index(tline,char(92)) + if (ndxbs .gt. 0) then +c +c Special check in case \ is inside D"..." +c + ndxDq1 = index(tline,'D"') +c +c If the following test fails, flow out of if block; else loop up to 2. +c + if (ndxDq1 .gt. 0) then +c +c Find end of D"..." +c + ndxDq2 = ndxDq1+1+index(tline(ndxDq1+2:128),'"') + if (ndxDq2 .eq. ndxDq1+1) then + print*,'Something is really wierd here' + stop + end if + tline = tline(1:ndxDq1-1) + do 3 ic = ndxDq1 , ndxDq2 + tline = tline(1:ic-1)//' ' +3 continue + tline = tline(1:ndxDq2)//line(ndxDq2+1:128) + go to 2 + end if + end if + if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then + ntindex = ndxs2 +c print*,'No bs, or char is left of 1st bs, ntindex:',ntindex + else +c +c There are both bs and s2q, and bs is to the left of sq2. So check bs's to +c right of first: End is '\ ', start is ' \' +c + len = lenstr(tline,128) + intex = .true. +c print*,'intex+>',intex + do 1 ic = ndxbs+1 , len + if (ic .eq. ndxs2) then + if (intex) then + ntindex = 0 + ndxs2 = index(tline(ic+1:len),s2q)+ic +c print*,'ndxs2 =>',ndxs2 + else + ntindex = ndxs2 + return + end if +c print*,'Internal exit, intex, ntindex:',intex,ntindex + else if (intex .and. tline(ic+1:ic+2).eq.char(92)//' ') then + intex = .false. +c print*,'intex+>',intex + else if (.not.intex .and. tline(ic+1:ic+2).eq.' '//char(92)) + * then + intex = .true. +c print*,'intex+>',intex + end if +1 continue +c print*,'Out end of loop 1' + end if +c print*,'Exiting ntindex at the end???' + return + end + subroutine getchar(line,iccount,charq) +c +c Gets the next character out of line*128. If pointer iccount=128 on entry, +c then reads in a new line. Resets iccount to position of the new character. +c + character*1 charq + character*128 line + if (iccount .eq. 128) then + read(10,'(a)')line + iccount = 0 + end if + iccount = iccount+1 + charq = line(iccount:iccount) + return + end + function readin(line,iccount,iread) + parameter (noimax=24) + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + logical insetup,replacing,botv,goto999 +c +c Reads a piece of setup data from line, gets a new line from +c file 10 (jobname.pmx) if needed, Transfers comment lines into all parts. +c +c iread controls copying of values into scratch files for parts, but only +c if not replacing. +c +c iread input value written +c -1 nvi nothing (only used when noinst<0 initially) +c 0 various value read +c 1 nv -1 , replace later with nvi(i) +c 2 noinst 1 +c 3 np -2 , replace later with (nsyst-1)/12+1 +c 4 musicsize 20 +c 5 fracondent 0.05 +c + character*128 line + character*1 durq +4 if (iccount .eq. 128) then + read(10,'(a)')line + if (replacing) replacing = .false. + call chkcom(line,goto999) + iccount = 0 + end if + iccount = iccount+1 +c +c Find next non-blank or end of line +c + do 2 iccount = iccount , 127 + if (line(iccount:iccount) .ne. ' ') go to 3 +2 continue +c +c If here, need to get a new line +c + iccount = 128 + go to 4 +3 continue +c +c iccount now points to start of number to read +c + i1 = iccount +5 call getchar(line,iccount,durq) +c +c Remember that getchar first increments iccount, *then* reads a character. +c + if (index('0123456789.-',durq) .gt. 0) go to 5 + i2 = iccount-1 + if (i2 .lt. i1) then + print*,'Found "'//durq//'" instead of number' + stop 1 + end if + icf = i2-i1+49 + read(line(i1:i2),'(f'//char(icf)//'.0)')readin + if (.not.replacing) then + if (iread .eq. 0) then + call allparts(line(i1:i2),i2-i1+1) + else if (iread .eq. 1) then + call allparts('-999',4) + else if (iread .eq. 2) then + call allparts('1',1) + else if (iread .eq. 3) then + call allparts('-998',4) + else if (iread .eq. 4) then + call allparts('20',2) + else if (iread .eq. 5) then + call allparts('.05',3) + else if (iread .ne. -1) then + print*,'Error with iread in readin' + stop + end if + end if + return + end + subroutine chkcom(line,goto999) + parameter (noimax=24) + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + logical insetup,replacing,clefpend,botv,goto999 + character*128 line +c +c Assume that line has just been read. No need to change iccount since we only +c process full lines. +c + goto999 = .false. +1 if (line(1:1) .ne. '%') return +c +c If here, line has some sort of comment +c + if (line(2:2) .eq. '%') then + if (.not. insetup) then +c +c Suck up a line, then flow out of "if" block to get another and loop +c + read(10,'(a)')line + +c++VV +c +c UNLESS (a) it has a score-only "M" and changes # of inst's. +c + if (index(line,'M') .gt. 0) then + idxL = index(line,'L') + idxM = index(line,'M') + idxn = index(line,'n') + idxb = index(line,' ') + if (idxL.lt.idxM .and. idxM.lt.idxn .and. + * (idxb.eq.0 .or. idxn.lt.idxb)) then + noinow = ichar(line(idxn+1:idxn+1))-48 + clefpend = .true. +c +c Next noinow digits are original inst. #'s of new inst. set. Next noinow +c char's after that are clefs +c + nvnow = 0 + do 24 j = 1 , noinow + iorig(j) = ichar(line(idxn+1+j:idxn+1+j))-48 + iposc0 = idxn+1+noinow + do 25 k = 1 , nvi(iorig(j)) + nvnow = nvnow+1 +c clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) + instnum(nvnow) = j + botv(nvnow) = k.eq.1 .and. j.ne.1 +25 continue +24 continue + end if + end if +c +c or if it's "h" or "l", need to suck up one more line +c + if ((line(1:1).eq.'h'.and.index('+- ',line(2:2)).gt.0) .or. +c +c 4/29/00 check for T string also +c + * line(1:1).eq.'T' .or. + * line(1:2).eq.'l ') read(10,'(a)')line + else +c +c In setup mode. Set flag, flow out and do use following line +c + replacing = .true. + end if + else if (line(2:2) .eq. '!') then +c +c Copy to all parts +c + call allparts(line(3:128),125) + else +c +c Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise +cc Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise +c + ivq = index('123456789abcdefghijklmno',line(2:2)) +c +c Only treat as part-specific pmx line if number .le. noinst +c + if (ivq.lt.1 .or. ivq.gt.noinst) then +c +c Simple comment. +c + call allparts(line,128) + else +c +c Instrument comment, copy only to part +c + lenline = lenstr(line,128) + if (lenline .gt. 2) then + write(10+ivq,'(a)')line(3:lenline) + else +c +c Transferring blank line +c + write(10+ivq,'(a)')' ' + end if + end if + end if + read(10,'(a)',end=2)line + call zapbl(line,128) + go to 1 +2 continue + goto999 = .true. + return + end + subroutine dosetup(iv,line,mtrnum,mtrden) + parameter (noimax=24) +c +c Transfers setup data from scratch file to real one for one instrument +c Data may be mixed with comments, but on entry 1st item is a number. +c Write a comment when encountered, as it comes. +c Write numbers one per line. +c Three input data require special handling: +c If not already replaced, i.e., if negative, then +c iset(1) (nv) will be replaced with nvi(i) +c iset(9) (npages) will be replaced with (nsyst-1)/12+1 +c iset(2), if negative, will be followed by extra numbers to be transf. +c + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + character*128 line + logical insetup,replacing,botv + iccount = 0 + do 1 iset = 1 , 12 + call partnum(iv,iccount,line,xdata) + if (iset .eq. 2) then + if (xdata .gt. 0) then + write(40,'(i5)')int(xdata+.1) + else + noi = -xdata+.1 + write(40,'(i5)')noi + do 2 ioi = 1 , noi + call partnum(iv,iccount,line,xdata) + write(40,'(i5)')int(xdata+.1) +2 continue + end if +c else if (iset.ne.8 .and. xdata.lt.0) then + else if (iset.ne.8 .and. iset.ne.5 .and. xdata.lt.0) then +c +c Must be either nv or npages +c + if (int(-xdata+.1) .eq. 999) then +c +c It's nv +c + write(40,'(i5)')nvi(iv) + else +c +c npages must be computed +c + write(40,'(i5)')(nsyst-1)/12+1 + end if + else if (iset.ne.7 .and. iset.ne.12) then +c +c write integer +c + write(40,'(i5)')nint(xdata) + else +c +c write floating number +c + write(40,'(f5.2)')xdata + end if + if (iset .eq. 3) then + mtrnum = nint(xdata) + else if (iset .eq. 4) then + mtrden = nint(xdata) + end if +1 continue + return + end + subroutine partnum(iv,iccount,line,xdata) +c +c Simplified number parsing. Only looks for comment lines and numbers. +c + character*128 line + character*1 durq +2 if (iccount .eq. 128) then + read(10+iv,'(a)')line + if (line(1:1) .eq. '%') then + len = lenstr(line,128) + write(40,'(a)')line(1:len) + go to 2 + end if + iccount = 0 + end if + iccount = iccount+1 +c +c Find next non-blank or end of line +c + do 4 iccount = iccount , 127 + if (line(iccount:iccount) .ne. ' ') go to 3 +4 continue +c +c If here, iccount=128 and need to get a new line +c + go to 2 +3 continue +c +c iccount now points to start of number to read +c + i1 = iccount +5 call getchar(line,iccount,durq) +c +c Remember that getchar first increments iccount, *then* reads a character. +c + if (index('0123456789.-',durq) .gt. 0) go to 5 + i2 = iccount-1 + if (i2 .lt. i1) then + print*,'Found "'//durq//'" instead of number' + stop 1 + end if + icf = i2-i1+49 + read(line(i1:i2),'(f'//char(icf)//'.0)')xdata + return + end + block data + parameter (noimax=24) + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + logical insetup,replacing,botv + data nvi /noimax*1/, noinst,noinow /2*noimax/ + data botv /noimax*.false./ + end + subroutine zapbl(string,len) + character*(*) string + do 1 i = 1 , len + if (string(i:i) .eq. ' ')go to 1 + if (i .eq. 1) return + go to 2 +1 continue +c +c If line is all blank, leave it alone +c + return +2 continue + string = string(i:len) + return + end + subroutine OddQuotesBefore(lineq,indx,yesodd) +c +c This counts number of double quotes in lineq up to position indx-1, then +c sets yesodd according to whether number is odd or even +c + logical yesodd + character*(*) lineq + numdqs = 0 + do 1 i = 1 , indx-1 + if (lineq(i:i) .eq. '"') numdqs = numdqs+1 +1 continue + yesodd = mod(numdqs,2) .eq. 1 + return + end + + + + + diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.mid b/Build/source/utils/pmx/pmx-src/tests/barsant.mid index fd58f2f8db0..6cc3fcee58d 100644 Binary files a/Build/source/utils/pmx/pmx-src/tests/barsant.mid and b/Build/source/utils/pmx/pmx-src/tests/barsant.mid differ diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.pml b/Build/source/utils/pmx/pmx-src/tests/barsant.pml index 1be48b99ea1..72d72eccc43 100644 --- a/Build/source/utils/pmx/pmx-src/tests/barsant.pml +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.pml @@ -1,4 +1,4 @@ -This is PMX, Version 2.94 , 17 Mar 20 +This is PMX, Version 2.98 , 12 Dec 21 Opening barsant.pmx Starting first PMX pass @@ -21,4 +21,3 @@ Writing ./barsant.tex Writing barsant.mid MIDI instrument 0 is 74 MIDI instrument 1 is 6 - Bytes used: 2126 807 15 diff --git a/Build/source/utils/pmx/pmx-src/version.ac b/Build/source/utils/pmx/pmx-src/version.ac index 73eb32443e9..c3b931fbd3a 100644 --- a/Build/source/utils/pmx/pmx-src/version.ac +++ b/Build/source/utils/pmx/pmx-src/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.9.4a]) +m4_define([pmx_version], [2.9.8a]) diff --git a/Build/source/utils/pmx/version.ac b/Build/source/utils/pmx/version.ac index 0984c08a463..981ff2aa84b 100644 --- a/Build/source/utils/pmx/version.ac +++ b/Build/source/utils/pmx/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.9.4a]) +m4_define([pmx_version], [2.9.8a]) -- cgit v1.2.3