diff options
Diffstat (limited to 'Build/source')
20 files changed, 29918 insertions, 3273 deletions
diff --git a/Build/source/utils/README b/Build/source/utils/README index bc07ecb5473..3686f95fbd8 100644 --- a/Build/source/utils/README +++ b/Build/source/utils/README @@ -20,7 +20,7 @@ lacheck - maintained here, by us m-tx 0.63 - checked 09jan18 http://ctan.org/pkg/m-tx/ -pmx 2.7.6 - checked 09dec16 +pmx 2.8.4 - checked 14feb18 http://ctan.org/pkg/pmx/ ps2eps 1.68 - checked 10may12 diff --git a/Build/source/utils/pmx/ChangeLog b/Build/source/utils/pmx/ChangeLog index d42497d2b50..07fa8ff330c 100644 --- a/Build/source/utils/pmx/ChangeLog +++ b/Build/source/utils/pmx/ChangeLog @@ -1,3 +1,7 @@ +2018-02-14 Akira Kakuto <kakuto@fuk.kindai.ac.jp> + + * Import pmx 2.8.4. + 2017-03-27 Karl Berry <karl@freefriends.org> * Makefile.am (AM_TESTS_ENVIRONMENT): use instead of TESTS_ENVIRONMENT. diff --git a/Build/source/utils/pmx/TLpatches/ChangeLog b/Build/source/utils/pmx/TLpatches/ChangeLog index c6f4cfebb39..8e52ce8d895 100644 --- a/Build/source/utils/pmx/TLpatches/ChangeLog +++ b/Build/source/utils/pmx/TLpatches/ChangeLog @@ -1,3 +1,7 @@ +2018-02-14 Akira Kakuto <kakuto@fuk.kindai.ac.jp> + + * import pmx-2.8.4. + 2016-12-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp> * import pmx-2.7.6. diff --git a/Build/source/utils/pmx/TLpatches/TL-Changes b/Build/source/utils/pmx/TLpatches/TL-Changes index 16641f4a0a5..c1728a1b9e2 100644 --- a/Build/source/utils/pmx/TLpatches/TL-Changes +++ b/Build/source/utils/pmx/TLpatches/TL-Changes @@ -1,4 +1,4 @@ -Changes applied to the pmx-2.7.6 tree as obtained from: +Changes applied to the pmx-2.8.4 tree as obtained from: http://www.ctan.org/tex-archive/support/pmx/ Remove: @@ -9,3 +9,4 @@ Remove: depcomp install-sh missing + test-driver diff --git a/Build/source/utils/pmx/configure b/Build/source/utils/pmx/configure index f81c63197a1..d3f548e4435 100755 --- a/Build/source/utils/pmx/configure +++ b/Build/source/utils/pmx/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.7.6. +# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.8.4. # # Report bugs to <tex-k@tug.org>. # @@ -580,8 +580,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='pmx (TeX Live)' PACKAGE_TARNAME='pmx--tex-live-' -PACKAGE_VERSION='2.7.6' -PACKAGE_STRING='pmx (TeX Live) 2.7.6' +PACKAGE_VERSION='2.8.4' +PACKAGE_STRING='pmx (TeX Live) 2.8.4' PACKAGE_BUGREPORT='tex-k@tug.org' PACKAGE_URL='' @@ -1278,7 +1278,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures pmx (TeX Live) 2.7.6 to adapt to many kinds of systems. +\`configure' configures pmx (TeX Live) 2.8.4 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1344,7 +1344,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.6:";; + short | recursive ) echo "Configuration of pmx (TeX Live) 2.8.4:";; esac cat <<\_ACEOF @@ -1441,7 +1441,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -pmx (TeX Live) configure 2.7.6 +pmx (TeX Live) configure 2.8.4 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1835,7 +1835,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by pmx (TeX Live) $as_me 2.7.6, which was +It was created by pmx (TeX Live) $as_me 2.8.4, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3758,7 +3758,7 @@ fi # Define the identity of the package. PACKAGE='pmx--tex-live-' - VERSION='2.7.6' + VERSION='2.8.4' cat >>confdefs.h <<_ACEOF @@ -5963,7 +5963,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by pmx (TeX Live) $as_me 2.7.6, which was +This file was extended by pmx (TeX Live) $as_me 2.8.4, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6020,7 +6020,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -pmx (TeX Live) config.status 2.7.6 +pmx (TeX Live) config.status 2.8.4 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/Build/source/utils/pmx/pmx-src/ChangeLog b/Build/source/utils/pmx/pmx-src/ChangeLog index 86223087368..54297fae190 100644 --- a/Build/source/utils/pmx/pmx-src/ChangeLog +++ b/Build/source/utils/pmx/pmx-src/ChangeLog @@ -1,231 +1,686 @@ -Changes from PMX 2.5 to 2.621, 28 January 2013 - -2.501 (Note: new scor2prt) - -Bugfix: initialize index in PMX subroutine putorn to eliminate subscript -error detected in some compilers Bugfix in scor2prt: Ignore special -treatment of special symbols if they appear between double quotes. -Tweak: move end of first part of linebreak ties slightly to the right. - -2.502 (Note: new pmx.tex) - -The height of a figured bass vertical stack can now be adjusted upward by -an integral number of \internote by appending "+" and the number. Recall -that it can already be moved downward 4\internote by prepending "_" -(underscore). The two options can be combined to provide full control -over the vertical position. Ties can now be represented with braces -"{" before a note and "}" after. Both are equivalent to "t" after the -note. (Thanks to Dirk Laurie). In pmx.tex all the commands of the form -\font\...=\fontid sy1000 have been changed to \font\...=cmsy10 (Thanks -to Olivier Vogel). - -2.503 - -Enable arpeggio left shift with ?[x] Allow musicsize of 24 and 29. -Bugfix: Fix bug introduced in 2.415 which caused error in printing -replacement number in xtup. - -2.504 - -Gap between normal grace and main note: X[x] as option to the G command, -where x is the gap size in notehead widths. Bugfix: og (segno) now -works OK when nv .ne. noinst. - -2.505 - -A new global option AK activates special rules for vertical positioning of -rests in twovoice staves. By way of background, without the new option, -rests in twovoice staves have default positions based on a simple rule -that is not contextsensitive: those in the lower voice (the one before -"//") are 4\internote below their singlevoice default positions, -and those in the upper line are 2\internote above the singlevoice -default. The new option invokes a set of contextsensitive rules to -set the default position. The baseline rule is to align the rest in -a horizontal line with the next following note in the same bar. If -there is no following note in the bar, then it is aligned with the next -prior note. If there are simulataneous rests in both voices, the old -rule is applied. When the AK option is in force, it only affects places -where there are two voices in a staff. It may be toggled on and off at -the beginning of any input block, using just AK. When the option is in -effect, any userdefined tweaks on the height of a rest will supersede -the option for that particular rest, i.e., the tweak will be applied -relative to the singlevoice default position. - -2.506 - -Fixes a bug in AK. Simultaneous, equalduration rests will be positioned -according to the default rules. - -2.507 - -Enhancement to global option AK for vertical positioning of rests in -twovoice staves (see version 2.505): The option L ("look left") in a rest -will cause the vertical position of that rest to be based on the preceding -note, rather than the following one as is the default when AK has been -issued Partial bugfix: In unbeamed xtuplets, the length of the bracket -and position of the number are now adjusted to account for any inserted -hardspaces. Bugfix: unbeamed xtups with two flags are now allowed. - -2.508 - -Allow grace notes in xtuplets. - -2.509 - -Correct small bug in arpeggio leftshifting (it got confused when there -was more than one voice on a staff). - -2.510 - -Bugfix: Correct omission of character variable declarations in new -subroutine getgrace introduced in 2.508. - -2.511 (Note: new scor2prt named s2p2511.exe) - -Bugfix: Correct error in horizontal spacing introduced in 2.507. -Experiment: Remove prohibition against tempo changes in MIDI macros. -Bugfix in scor2prt: Make it work right when "R" command occurs at end -of input block and "/" is on next line (as produced by MTx). - -2.512 - -Enable multiplicity downup "][" within xtuplet - -2.513 - -Bugfix: If there is more than one rest at start of a beamed xtuplet marked -as a forced beam, beam height and slope tweaks are now properly handled. -Bugfix: If an xtuplet with multiplicity 2 or 3 starts with a rest, the -rest is now printed correctly. Bugfix: Unbeamed xtuplets (with option -'a' on first note) with multiplicity 2 or 3 are now printed correctly. - -2.514 - -Bugfix: Correct horizontal spacing when aftergrace is immediately -followed by normal grace. Bugfix: Correct transpose register when it -has been changed in a single aftergrace. - -2.515 - -Bugfix: Correct error in automatic forced beams. Before the fix, if the -beam did not start an integral number of beam durations from the start -of the bar, incorrect results would occur. Bugfix: Properly center -fermata over centered wholebar rest. - -2.516 (Note: new pmx.tex) - -Allow figures in voice #2. - -2.517 - -Allow figures in two voices, voice 1 and any other one. - -2.518 - -Bug fixes in 2voice figures. - -2.519 - -Fix bug that prevented \sk from being output, misaligning some voices. - -2.520 - -New feature: special characters 2+, 4+, 5+, 6+, 9+ for figured bass. In -the PMX string for any figure, follow the number by 's'. This uses the -font cmrj from the new package figbas. You must install this font in -your TeX setup for this to work. - -2.521 - -Bugfix: Font definition syntax corrected so no extra space is introduced. - -2.602 (Note: new pmx.tex; requires eTeX) - -Allow 24 voices, beams, slurs. Require etex. Include comment about -doubling size of internal buffer to 131072, requiring gfortran for -Windows to compile. Correct slur indexing in linebreakslurs. Account for -comment lines in line count for error messages - -2.603 (Note: new scor2prt) - -In getpmxmod.for, decrease nline by 2 to fix locating errors following -reading in an include file. Add some error messages in g1etset.for -setup data - -2.610 - -Instrument-wise transposition: Ki[instrument #][+/-][trans -amt.][+/-][new key]. For more than one instrument, may immediately -repeat everything after "K". Must either be at start of score (right -after setup), or if later, must be preceded by normal (full score) key -change command K+0[+/-][new key]. Must be used with relative accidentals -("Ar"). Part(s) to be transposed must be entered in concert key, and -will appear transposed in the score. MIDI behavior not yet tested. -Has not yet been integrated into scor2prt, so for now if you want to -make parts, only use Ki... as score-only (on line after "%%") and/or -instrument only (on same line after %[Instrument #]). - -2.613 - -Set error trap if "D" is entered before any notes. - -Enhance "AS" to allow spacing adjustments tailored for either smallsize -or tinysize. As before, "AS" must be followed by nv characters, but now -they may be "0" for normal, "-" or "s" for small, or "t" for tiny. Still -must set sizes of instruments with inline TeX. - -Bugfix: Fixed broken "K-..." in 2.610. - -2.614 - -Bugfix: revise raised dotted rests by separately raising rest and dot. - -2.615 *(Note: new scor2prt)* - -Command "AS", described above under 2.163, now also causes staff sizes -to change (in score only, not parts), so inline TeX is no longer needed -to change sizes of selected staves. - -Scor2prt transfers partwise transposition commands Ki... (see 2.610 -above) into parts. - -2.616 - -"Feature" added: Hairpin dynamics now may span input blocks. - -2.617 - -Repaired several obscure bugs related to platform and compiler -dependencies; see pmxab.f for details. - -2.618 - -For letter and a4 paper respectively, commands "Acl" and "Ac4" set -horizontal and vertical sizes and offsets that center the page with no -further adjustments required in dvips. - -2.619 - -Several changes at movement breaks to improve compatibility with M-Tx -and musixlyr. - -2.621 - -Bugfix: Made keyboard rest positioning ("AK" command) work properly -when there are rests are within xtuplets. Also fine-tune default -positioning of number and bracket in unbeamed xtuplets containing -rests. Position of both can still be overridden with options on -first note command for xtuplet. - +2.84 + Bug fix: dots in chordal seconds + Bug fix: Initialize ihornb for non-beamed, down xtup + Bug fix: When using "AT" with 2-note x3c rD. +2.83 + Fix problems when changing to or from octave treble clef. + Fix beaming (or not) and number location for xtups with + multiple rests. Still some problems with number height but + can be band-aided with number height tweak option. + Tweak error messages for options on "R" command. + Allow forced beam height and slope tweaks with 2-note tremolos + Allow chordal note with 2-note tremolos, adding dots as needed. + Fix call to ncmid in beamstrt when setting start height for beam of + 2-note trem, by changing arg from ivx to iv +2.82 + bugfix: beams with rests, not confused with xtups. + x option after slur index to allow slurs to go from one voice to another. + x option also for ties +2.81 + Allow string of rests to end xtup + in chordal half-note 2-note tremolo, make chord notes open. +2.80 + Add 2-note tremolos +2.78 + Expand bufq to 131072 bytes + Expand maxblks tp 9600 + Allow up to 75 pages + Index postscript hairpins from 1 up instead of by voice #. + Add option 'o' to forced beam for open notehead (\hb); set ipl(3) + Add option T[n], n=1,2,3 for single stem tremolo +2.77 + Enable AV+/-x+/-y to add vskip bigh before or after \eject +2.76 +2.75 + Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and + 2 or 3 flags on shortened note. +2.74 + Bugfix: allow "0" as argument of @ command on lyrics string. + Check for and allow "\ in centered page headings with P command. + Check for and allow "\ in text dynamics with D command. + For lyrics string starting in xtuplet, insert check for inputting musixlyr. + For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam + starts with a blank rest, put '\sk' into the TeX. + To enable high-to-both beamed etup staff-crossing chord, for blank + rest at start of forced beam, shift \sk's from before to after \ib..; + so \ib is at start and note in upper voice has a beam to connect to. + Expand range of vertical xtup number shift, now stored in mult(16-22) + Check for and allow \" within lyrics strings, for umlauts. +2.73 (160121) + Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as + inline TeX. Replace all '~' inside "..." and not preceded with '\', by + '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ + Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", + add (as type 2 string) '\\input musixlyr \' + After inputting pathname, change any '\' to '/', for Linux compatibility. +2.72 (160110) + Really finalize \mbrest...go back to 3 args to deal with clef changes. + Fine tune centered whole bar rests to deal with clef changes + Fix bug in wsclef when >1 staff per instrument, since \setclef + needs to know instrument and specify clefs on all staves for that + instrument. Ones that were not changed by user will not be printed, + and will be kept the same as before. + Fix bug with arpegii from one voice to another in same staff. +2.71 (151226) + Finalize mbrest mods +2.705 + Fix error message +2.704 (140614) + Octave treble clef + Make horizontal ornament shift (ornhshft) floating +2.703 (140323) + Option v[-]n at end of any figure will alter figdrop for rest of system +2.702 + Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" +2.701 + oC = coda (\code{10}) + Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) + oG = new seqno + To do: fix grace note spacing problem (partially done) 2.622 - -New option in "K" command: "Kn..." inserts \ignorenats before signature -change, supressing naturals in new signature. - -Many small fixes in transposition and key changes with "K", "Ki", -and "IT" to make MIDI come out OK. Basic function of "K" and -"Ki" unchanged. "IT[+/- n1][+/- n2]..." now transposes MIDI by -\internotes, not half steps as before. E.g. to transpose MIDI of -2nd instrument out of 3 up by one octave, use "IT+0+7+0". May also -use to untranspose a transposing instrument that has been entered -transposed, to make MIDI come out right. + Redefine midtc(..) and miditran(..); clean up all transpositions/key changes + Kn[+/-...] \ignorenats at signature changes + Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs + before checking and setting pitch levels levson() and levsoff() + Define midisig separately from isig. Put in common commidisig. + Use for explicit midi signature and for accid corrections to midi piches + in addmidi. +2.621 + Make keyboard rest option work in xtuplets. Created subroutine + chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd. +2.620 + Allow user-defined rest height tweaks at start of beam. +2.619 + At movement break, change \nbinstruments in \newmovement macro; add + 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for + to remove call to newnoi and change call to \newmovement +2.618 + Add option Ac[l,4] to set vert and horiz size and offsets to properly + center page for letter or a4 paper. +2.617 + In g1etnote, change if-check for note to use index(...) instead + of ichar(charq) since it was messing up gfortran optimizer + After pmxa, search for and remove penultimate line <blank><blank>/ + because it was screwing up linux-compiled versions + Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...) +2.616 (111110) + Allow hairpins to span multiple notes groups (gulps). +2.615+ (110810) + Fix midi when some instruments are transposed, by subtracting + iTransAmt(instno(iv)) from pitch values sent to via addmidi in + make2bar.for (for main notes) and docrd (for chord notes) +2.615 (110725) + Fig bug with size-setting (in topfile) when instrument has >1 staves +2.615 (110724) + Make AS[0|-|s|t]... really set sizes +2.614 + Mod notex.for to fix Terry's bug with raised dotted rests (caused + by double-hboxing). +2.613 + Bugfix: In pmxa, change "do while" limit to keep from overwriting instno. +2.612 + Enhance AS to allow s or t for smallsize or tinysize +2.611 + Error trap for "D" before any notes in a block. +2.610 + Instrument-wise key changes and transposition (incomplete) +2.603 + 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors + following reading in an include file. + 101121 Added some error messages in g1etset.for setup data +2.602 + Correct slur indexing in linebreakslurs. + Account for comment lines in line count for error messages +2.601 + Bug fix: allow 24 slurs with graces +2.60 Changes made make it really big + increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o + major reprogramming, and 16 may also be a problem (icmm) + nm=24 (voices) done + 24 slurs done + 24 simultaneous beams (Replace index 24 by 0, so get 0-23) + bufq*131072 (gfortran only) + getarg syntax (gfortran only) +2.523+ + Fix voice numbering for normal dynamics and text dynamics +2.523 + Version of bigpmx first posted to Hiroaki's web site. +2.522 + 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it. + With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices. + 5/13/10 Fix log2 function + 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length. +2.521+ + 091025 Enable dotting 2nd part of linebreak slur or tie. + To adjust barno height due to linebreak slur, use \bnrs instead of + explicitly redefining \raisebarno (pmxb) +2.521 + Bugfix +2.520 + 090519 Enable ligfonts (special figured bass characters) +2.519 + Fix another bug which kept \sk from being output so misaligned some notes. +2.518 + Fix bugs: referencing fig data, char declaration for member of + common/comfig/ +2.517 + Allow figures in voice 1 + any one other. +2.516 + Allow figures in voice #2 +2.515+ to do: Change manual and activate rule against clef change in voice #2. +2.515 + 071222 Changes in getnote to allow auto forced beams to start anywhere. + 071206 In make2bar, shift fermataup7 to left over centered pause. + 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line + staff (it was screwing up vertical justification). + n34 for tweaks to midi durations of quarter note septuplets. + To do: In ref250.tex, the tables where 's,t,)' is explained, the line + [+,- i] ... Vertical adjustment of the start of second segment + should it be replaced by + [s +,- i] ... Vertical adjustment of the start of second segment +2.514 + Changes in make2bar to get horizontal spacing right when normal grace + follows after grace + Changes in dograce to get octaves right for any material entered inside + \gaft, which shields transpose register changes from the outside world. +2.513 + In make1bar, near end, for forced beams starting with a rest, copy hgt and + slope tweaks to ALL notes after first, not just the second one, so if + there's more than one rest at start the tweaks are still observed. + In beamid and beamend, add stand-alone triply-flagged notes for xtups. +2.512 + Near end of pmxb, fix error trap to allow redundant 'RD' + Enable multiplicity down-up '][' within xtup. +2.511 + Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by + adjusteskz as in bar 7 of barsant. +2.510a + Test: remove restriction on tempo changes in MIDI macros + Send to CM for beta testing. +2.509+ + To do: Correct manual on AS. "-" is for smaller staves. +2.510 + Forgot to declare litq, voltxtq as character in subroutine getgrace +2.509 + Corrected small bug in arpeggio shifting (ivx <= iv in call putarp) +2.508 + Allow graces in xtups. New subroutine getgrace. +2.507 + To do: Raise/lower figures. + To do: Add 24, 29 to list of musicsizes in manual + New sub adjusteskz to account for ask's when computing lengths of + brackets for unbeamed xtups, slopes and horizontal posn's of number + Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags + Add look-left option for keyboard rests, "L" in rest command, set iornq(30) +2.506 + Fix bug with AK, when simultaneous rests have same duration, use defaults. +2.505 + Keyboard rests AK +2.504 + Space after normal grace: option X[n] + Fixed og when nv .ne. noinst, by using sepsymq instead of '&' + (To do) length of xtup bracket when there is added non-collision space. + Trap musicsize if .ne. 16,20,24,29. +2.503 + Enable arpeggio left shift with ?-x + To do: In manual, arpeggio over 2 staves. + Allow musicsize of 24 and 29. Had to define meter font size explicitly, + also change font size for text dynamics, but not much else so far. + Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn + was called, causing error in printing replacement number. +2.502 + Incorporate Dirk Laurie's patch to use { , } , for ties. + Figure height adjustment: append +[n] + Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?) +2.501 + Readjust horizontal offset back to .8 in LineBreakTies + Fix zero-subscript (iudorn) in putorn +2.50 + Increase number of text-dynamics (dimension of txtdynq) per block + from 12 to 41. + Slur option n to override altered default curvature. + Allow default ps slur curvature tweaks with Ap+/-c +2.416 + Increase length of textdynq from 24 to 128 + (Todo) Add comment in manual about blank lines at end. + Configuration file: Define subroutine getpmxmod, check path in environment + variable pmxmoddir, check existence, read lines into bufq after setup. + Increase dimension on idynn in dodyn from 4 to 10 for max number + of marks in a bar + Increase allowable # of lines from 2000 to 4000. + (To do) Replace definition of \liftpausc per Olivier. + (To do) Fix extraneous error message if RD is placed at very end. +2.415 + Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt + instead of redefining \xnum. Change font used to \smallfont (as for + normal xtups, + Allow slur to start on rest. +2.414 + Correct bug in crdacc when adding accidental to boundary causes number of + segments to decrease + Special rule for 3-accidental chords: If no 2nds, place them in order + top, bottom, middle. +2.413 + Correct bugs in chordal accidentals, related to left-shifted noteheads + (a) Special problems with downstem when main note needs shifting + (b) Assign 0 rank to boundary segs due to left-shifted noteheads +2.412 + Change default horiz shift of start of seg 2 of linebreak slurs: + -.7 for slurs, -1.2 for ties, + Use height of start of seg 1 slur itself for end of 1 and start of 2. +2.411 + "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2. + "s" option in start of slur/tie as precursor to vert/horiz tweaks for end + of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2. + With "Apl", curvature adjustments on starting slur command apply to seg 1, + those on ending command to seg 2. +2.410 + "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine + \xnum, \unbkt, \ovbkt. + "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is + flag, mult(5-9) is tweak value+16 +2.409 + Bugfix in docrd for MIDI: Use original pitch in case main/chord were + switched due to 2nds. + Remove "o" from error message for "A" command. + New syntax: optional instrument number separator ":" in movement + break command to precede a 2-digit instrument. + Conditional output formats for \setname at movement break to allow + instrument numbers >9. + Bugfix in coding to raise barno due to slur over line break (pmxb) + Move date/version data statement in pmxab to a better place. +2.408 + Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar). + Bug fix in \liftPAusep in notex.for and in pmx.tex + Character variables for version and date + For up-stem single graces slurred to down-stem, shift slur start left by + 0.8 so slur doesn't get too short. + Initialize and slide mult, same as other full-program variables in /all/. +2.407 + Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n, +2.406 + Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing + equalization). + Put dimensions of double sharps and flats in crdacc (for chords). + Bugfix: Use sepsymq in LineBreakTies(..) instead of '&' + Use only first 4 bits of mult for multiplicity+8, so rest can be used + for other stuff. + Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict. +2.405: Not published but saved for safety. + Option Aph to write \special{header=psslurs.pro} top of each page, so + dviselec will work OK. +2.404 + Allow slur to end on rest, but not start on a rest. Efaults height + of ending is default height of start (before any automatic or user- + defined djustments). User may adjust height as normal from default. +2.403 + Bugfix: turn off repeated beaming patterns.at end of non-last voice. +2.402 + Automatic repeated forced beams. Start with "[:" End with next explicit + forced beam or end of input block. + Increase # of forced beams per line of music per input block from 20 to 40 +2.401 + Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies. + Makes 1st part normal shape, and starts 2nd part a little further left. + Enable arpeggios in xtuplets. Had to make time itar(narp) a real. +2.40 + Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap. + Fix non-ps-slur input to \midslur (third signed integer). Do not reverse + sign for down-slurs. +2.359 + Add error exit subroutine stop1 to make exit status g77-compatible.. + Absolute octave on xtup chord note was 2 octave too high, fixed in getnote + Fermata on vertically shifted rest: special trap in putorn() to set height. + Correct multiple grace note spacing for small staves (in dograce, + define wheadpt1 depending on staff size) +2.358 + Allow curvature corrections at start of postscript slur, in dopsslur() + Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust + Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h] + Make t[ID] act like s[ID]t, most mods in spsslur(). + Add spsslur() to read in data for ps slurs, call from getnote. + In beamstrt, save args for SetupB in common comipb to save them for + 2nd call when xtup starts with rest + Add spacing for ornament ")" as if it were accidental, in make2bar(). + Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur() + Horiz. shift start of ps grace slur, 2 places in dograce(). + Horiz shift end of grace slur in endslur() + Make st slurs into postscript ties. Separate subroutine dopsslur(), + Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.) + Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn. +2.357a + Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote +2.357 + Increase dimension for # of lit TeX strings from 52 to 83. + Allow blank rest in middle of xtuplet. Only mods in g*etnote(). +2.356 + Increased some dimensions from 30 to 40 to allow up to 40 pages. + In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt(). + Fix parsing of "f,h,H,HH" in sslur. + Fix bug with cdot, note-level for slur termination (in getnote) +2.355 + Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)], + n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues + Make midi recognize ps ties in doslur. + Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote + to get octave right. +2.354 + With postscript slurs, make t-slurs real ties by inserting replacement + macros \tieforisu, etc, defined in pmx.tex + Check for open cresc or decresc at end of input block, using list[de]cresc + Hairpin syntax conditional on postscript slurs. Backup to fill in start + level, using new backfill(...). Separate height tweaks for + start and finish. +2.353 + K-0+n to transpose by half step (rather than just change key) + Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of + \mbrest's + Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end + of input block before movement break, and at start of block after + movement break, using \newmovement rather than \setzalaligne, since + former already redefines \stoppiece. In second case, set rptfg2='z'. + Make clefq(nm) common between pmxb and getnote; change references in + getnote at 'M' to array elements, setting all new clefs as you go. +2.352 + Remove \parskip redefinition from pmx.tex; write it into TeX file when + "Ae" is invoked. + Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine + \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH', + translate them thru mapping to (1,4,5,6) as \midslur params, then let + \psforts translate them back to ps slur macors. +2.351 + Number slurs from 0 up instead of 11 down, anticipating postscript slurs. + Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size. + Increase length of basenameq to 44 characters everywhere. + Increase dimension of mcpitch (midi-chord-pitch) to 20. + Set default systems per page to 1 if nv>7 + In pmxb, move place where isystpg is reset to 0, so that \eject gets + written when there is just one system per page. +2.35 + Cautionary accidentals with 'c' anywhere in note symbol. + NEW pmx.tex with \resetsize to set size to normal or small depending on + current \internote. Used with new coding in dograce() to get right + new size in case user has \setsize'ed some lines to \smallvalue. For + \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font. + Affects pmx.tex. + Continuation figure with fractional length. May now mix with other figures. + If another figure follow Cont-fig, separate with colon. +2.342 + Bugfix in getnote to recognize relative octave shift in grace at start of + input block. + In make2bar, initialize islhgt=0 earlier than before (possible solution + to Suse g77 compile problem that I could not reproduce).. + Bugfix in beamstrt & beamn1 for r2x6 c4D d d d +2.341 + Syntax check: Forced page break page number must be > than previous. + Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb. +2.34 + New pmx.tex with redefined liftpausc + Bug fix with dotted, non-beamed xtups. +2.332 + Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads. + Allow arbitrary pos. input to W in g1etnote and getnote. +2.331 + Bug-fix in dodyn(..): typo on length of arg of txtdyn +2.33 + Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata() +2.321 + Rescale accidental shifts. Still use 7 bits but now map (0,127) + onto (-1.,5.35) + Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups +2.32 (Noticed after posting) + Prohibit "/" as figure. +2.32 (Posted) + Tidied up accidentals in chords, do spacing. + Still to do: + check for "(" on chord notes in spacing algo + small accids + double accids + autoshift slurs +2.310 + Extra call to precrd ahead of spacing chk, and single-note crd/acc + shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time. +2.309 + Alternate algo for accid shifts in chords. +2.308 + Auto horiz. notehead shifting added to precrd. +2.307 + Auto shifting of multiple accidentals in chords. + "Ao" in main chord note to keep accidentals in order. Set nacc(28). + If there are any manual main or chord note shifts, then + If any manual shift is preceded by "A" then + 1. Auto-shifting proceeds + 2. "A"-shifts add to autoshifts + 3. non-"A" shifts are ignored! + Else (>0 man shifts, none has "A") + No auto-ordering, No autoshifts, + End if + End if +2.306 + Initialize legacy note level to middle C in case user forgets to set + octave. + Shift xtup note? + Shift in elemskips rather than noteheads? +2.305 + Stop pmxb from multiple endvolta's at start of new page. +2.304 + "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on + for multiple notes in the voice, "S:" last shortened note. +2.303 + vshrink stuff all OK? Description is in pmxb. +2.302 + Toggle vshrink with "Av". vshrink normally kicks in when \interstaff + hits 20. This still needs work. + Add " /" to last line if last char is not % or /. +2.301 + Check in beamn1 for single note before multiplicity down-up. + allow '.PMX' as well as '.pmx' +2.299 + Correct typo in pmxb involving PMXbarnotrue. + Replacement printed number for xtup: Unsigned integer after 'n' after 'x' + Minor upgrade parsing xtuplet options 'x...' + Correct dimension of nxtinbm in make2bar. +2.298 + Account for doubled xtup notes in subroutine getx (user-defined spaces), + by adding ndoub as an argument.. +2.297 + Created and solved compiler problem. Put drawbm(NM) in its own common. + Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar + when \centerbar is used. + Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX + use right 2nd and 3rd args for \mbrest when key, meter, or clef changes. +2.296 + Correct printed numbers for forced beams with multiple xtups. For each beam + make list in setupb by voice of eloff (h-offset) and mtupv (printed #) + Increase lengths of jobname and infileq by 20 characters + Enable whole notes and breves as 1st or last note of xtup in beamn1 and + beamend, and wholes in beamid. +2.295 + Midi balance Ib[n1]:[n2]:...[nn] + Single-slope beam groups [...]-[...] + Trap "i" unless after accidental (main notes, xtups, chord notes) +2.294 + Unequal xtups with "D" to double a note in an xtup. + As above, "F" will (a) increase multiplicity by 1 for marked note and next + one and (b) add a dot to the first one. + Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on + when "." is encountered, then correcting beam start time.(end of getnote) + MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]... +2.293 + Check for single notes spanning bar lines. + Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup + must be set in make2bar since beamstrt is not called, fixing problem with + dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix + problem when >2 staves. + Add nodur to args of dodyn, so can check if stemless and avoid height tweak + Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak +2.292a + Undo syntax check for Type 2 or 3 TeX string starting in column 1. + Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?! +2.292 + Allow comments in xtuplets + Enable multiple octave jumps in grace notes. + Allow dynamics in xtuplets. + Fix bug in getdyn searching for end of text string (correct length of lineq + to 128) + Fix bug in dodyn, must ignore horiz. interaction tweak for + user-text (idno = 0) + Syntax check for Type 2 or 3 TeX string starting in column 1 + (NOTE: later undone!) + Syntax check for page number > npages at forced line break. +2.291 + Fix error in AS command (accid spacing for small systems), making only + one spec per staff, nv total. + Stop using MIDI channel 10 +2.29 + Fix error in console output format for # of bytes used in MIDI file. + Fix bug in dograce so no space is added between grace and main note when + there is a MIDI-only accidental. + Fix bug so oes?+4 works. It was too ugly to explain. + ...Different ways of storing accidental specs on input and output. + No longer zap \writezbarno in special situations. + Fix bug in dyntxt level on rest + Line spacing equalization. Add macros \starteq, \endeq, \spread, etc. + Activate with Ae. (Maybe later could input alternate values for + \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1 + in the page, and \endeq on 1st note of next-to-last line in page. +2.28 + Flip direction of forced beam "[f..." + Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30) + Fix bug in sliding ip's for txtdyn's + In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99) +2.27 + Comment out lines in dodyn checking number of dynamic marks found. Voice + order may not be monotonic if two lines on a staff. + Literal dynamic: D"[text]" +2.26 + Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn, + increasing dimension of idynn to 4 to allow 4 symbols on same note. + Increase voltxtq length from 10 to 20. + AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough + accounting for ast's is done by defining effective headwidth + whead1 in makebar2 to be 0.8*whead. +2.25 + Fix logic bug with sepsym's when # of instruments changes. + Slight increases in default offsets for hairpin starts after "p" +2.24 + Hairpins D< or D> as toggle. + Many automatic position tweaks for letter-group dynamics and hairpins. +2.23 + Continued rhythmic shortcuts: space followed by "." or "," +2.22 + In call to doslur, change tno(...) to tnote(...). This was only + used when checking to slurs per stem directions, and should have been + the note duration all along. + MIDI-only accidental, bit 17 in nacc, or 27 in icrdat. + Use "i" anywhere in note symbol. +2.21 + Increase from 20 to 30 dimensions for movement breaks and midi sections. + Fix out-of-order declarations per mutex comments + Add "Bad error" and "Kluging" messages to log file. +2.197 + add /comips/ to save tie-check midi variables + For spacing of clef changes at start of input block, changed integer time + lastnodur to prevtn, so it works with xtups. Possible incompatibility! +2.196 + Fix Ickbug with time check in ncmid() + Interchange \fermataup7 and \pausec to get proper alignment + Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX. + Add defn's of \hsp, \hspp to pmx.tex + Fix pre-slurs on xtup chord notes. + Fixed raised PAuse, define \liftPAuse + Replace \zbreve\sk with \breve. + Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what + about "o" and 1 as shorthand for 16???? Search for "Kluge" + Added "vo" (voice) as MIDI instrument 55 + Allow 3-digit page numbers (search for "toppageno") + Fix bug caused by prior fix (cancelling accid after bar line was ignored). + Fix double accids in chords +2.194 + Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if + block. + Add meter to MIDI file with every pause + Purify FORTRAN? +2.193 + Increased # of in-line TeX strings from 36 to 52. + Fix entry of # of bytes in header of tempo/meter/key track to allow >255. +2.191 + Event track: Tempos, meters, keys all together. Data in comevent +2.15 + Pretty good midi capability. Still no attention to slurs on chord notes. +2.11 + 11 Dec 99 c rm1 + 11 Dec 99 "oes?", "oe?" + 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes + 11 Dec 99 Error message for shifted, repeated ornaments. +2.10 (Version 2.1) + Fix bug with lowdot and xtuplets +2.09 + Fix bug with multiple ornament heights over beams, when one is . or _ + Error message from pmxa if rest on last note of xtup. + Enable 12 slurs. + Reinstate multiple rests at start of xtup. +2.07 + Combine consecutive type-1 TeX strings. + \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's. + Fixed breve chord notes in docrd + Check irest(28) as well as vxtup when setting nodur for chord notes, since + vxtup isn't set until 1st *main* note in xtup + Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing. +2.06+ + Make deterministic the beam slope calculation when there are an even # of + slopes in list and middle two are equal magnitude but opposite sign. + pmxa Trap for "o:" before 1st note in block + Partial bug fix for 64th notes in xtuplets. + Make ixrest a vector, since with new time scheme may not finish xtup in + same notes block. + Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb) +2.06 + Account for changes in nv when computing \interstaff. Add a counter + nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever + setting isysflb(iflb). Note nv can only change at a forced line break. + Note also, iflb starts at 0! +2.05 + Automatic start of new notes group with part 2 of staff-jump beam + In make1bar, set irest bit 29 of lowest-voice note at same time, + use as flag when making notes groups. + For now, remove dummy blank line at end...it zaps terminal repeats. +2.02 + Fixed slur-counting bug for multiple, slurred, aftergraces. +2.01 + Increase to ask(1400) + Increase max forced page breaks to 18 + Define pausc for centered pause +2.0a + Insert dummy blank line at very end to handle input files w/o terminal CR-LF +pmx03r + Option m[n] in S symbol to change musicsize (for parts) + Double dotted rests now work. + Write file name to log file + Check existence of input file + Allow 24-char jobname, may end with ".pmx" + Comment out time stuff + Replace 3-argument getarg with 2-argument + iargc + Fix bug with negative noinst due to nint<=int replacement + move lovation of iv in isdat1 to allow iv>7. + Set nm=12 +pmx03q + replace int(x+.001) with nint(x) + Write TeX file name to screen and to pml. + Replace char(...) with chax(...) to sovle msdev bug. + Bug fix: macro terminations when M is on a line by itself. + Bug fix: don't accumulate space for XS in pmxa. + Streamline Macros: use pointers to bufq instead of scratch files +pmx03p + Store input file in single character array bufq. + lbuf(i)*2 is length of line i + ipbuf is position just before next line to be read. +pmx03 + Optimize read/writes +pmx02 + Fix line count (for errors) when there are saved macros +pmx01 + In optimize mode, open/close macros (Watch out for residual zz files!) + Command line input + Option Ao to optimize, otherwise normal processing +c diff --git a/Build/source/utils/pmx/pmx-src/Makefile.am b/Build/source/utils/pmx/pmx-src/Makefile.am index 0d86435f73d..a1c900ef64e 100644 --- a/Build/source/utils/pmx/pmx-src/Makefile.am +++ b/Build/source/utils/pmx/pmx-src/Makefile.am @@ -233,11 +233,11 @@ PATCHES = libf2c/patch-01-binary libf2c/patch-03-DOS-line-endings \ libf2c/patch-07-MuslLibc \ libf2c/patch-08-WIN64 \ libf2c/patch-09-tmpfile \ - PATCH-pmx276.for + PATCH-pmx284.for ## pmx.test EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \ tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx -EXTRA_DIST += scor2prt.for pmx276.for.orig pmx276.for +EXTRA_DIST += scor2prt.for pmx284.for.orig pmx284.for EXTRA_DIST += $(PATCHES) EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c DISTCLEANFILES = barsant* pmxaerr.dat diff --git a/Build/source/utils/pmx/pmx-src/Makefile.f2c b/Build/source/utils/pmx/pmx-src/Makefile.f2c index ae58b8792fe..d1e75570c99 100644 --- a/Build/source/utils/pmx/pmx-src/Makefile.f2c +++ b/Build/source/utils/pmx/pmx-src/Makefile.f2c @@ -1,7 +1,7 @@ all: pmxab.c scor2prt.c -pmxab.c: pmx274.for - f2c -g -\!bs < pmx274.for > pmxab.c +pmxab.c: pmx284.for + f2c -g -\!bs < pmx284.for > pmxab.c scor2prt.c: scor2prt.for f2c -g -\!bs < scor2prt.for > scor2prt.c diff --git a/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for b/Build/source/utils/pmx/pmx-src/PATCH-pmx284.for index 89750d303f9..c1262cfa78a 100644 --- a/Build/source/utils/pmx/pmx-src/PATCH-pmx276.for +++ b/Build/source/utils/pmx/pmx-src/PATCH-pmx284.for @@ -1,7 +1,7 @@ -*** pmx276.for.orig 2016-12-07 08:56:24.231733002 -0500 ---- pmx276.for 2016-12-07 14:55:34.769485275 -0500 +*** pmx284.for.orig 2018-02-12 13:36:14.825209815 -0500 +--- pmx284.for 2018-02-12 13:36:14.848209816 -0500 *************** -*** 11104,11110 **** +*** 11875,11881 **** end if go to 1 end @@ -9,7 +9,7 @@ * lenbar, c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, * mtrdenl,first) ---- 11104,11110 ---- +--- 11875,11881 ---- end if go to 1 end @@ -18,7 +18,7 @@ c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, * mtrdenl,first) *************** -*** 11210,11216 **** +*** 11981,11987 **** c Instrument numbers or letters. Expect noinst of them. c c do 2 ivx = 1 , nv @@ -26,7 +26,7 @@ call getchar(lineq,iccount,durq) if (ichar(durq) .gt. 96) then c ---- 11210,11216 ---- +--- 11981,11987 ---- c Instrument numbers or letters. Expect noinst of them. c c do 2 ivx = 1 , nv @@ -35,7 +35,7 @@ if (ichar(durq) .gt. 96) then c *************** -*** 11255,11261 **** +*** 12026,12032 **** c Follow same pattern as for insttrument numbers above. c c do 7 ivx = 1 , nv @@ -43,7 +43,7 @@ call getchar(lineq,iccount,durq) if (index('123456789',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, ---- 11255,11261 ---- +--- 12026,12032 ---- c Follow same pattern as for insttrument numbers above. c c do 7 ivx = 1 , nv @@ -52,7 +52,7 @@ if (index('123456789',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, *************** -*** 11278,11284 **** +*** 12049,12055 **** c Follow same pattern as for instrument numbers above. c c do 8 ivx = 1 , nv @@ -60,7 +60,7 @@ call getchar(lineq,iccount,durq) if (index('123456789',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, ---- 11278,11284 ---- +--- 12049,12055 ---- c Follow same pattern as for instrument numbers above. c c do 8 ivx = 1 , nv @@ -69,7 +69,7 @@ if (index('123456789',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, *************** -*** 11301,11307 **** +*** 12072,12078 **** c Follow similar pattern as above, but separator is +|-. c c do 9 ivx = 1 , nv @@ -77,7 +77,7 @@ call getchar(lineq,iccount,durq) ipm = index('-+',durq) if (ipm .eq. 0) then ---- 11301,11307 ---- +--- 12072,12078 ---- c Follow similar pattern as above, but separator is +|-. c c do 9 ivx = 1 , nv @@ -86,34 +86,37 @@ ipm = index('-+',durq) if (ipm .eq. 0) then *************** -*** 11634,11639 **** ---- 11634,11640 ---- - common /commidisig/ midisig - common /comlyr/ inputmlyr - logical inputmlyr -+ data inputmlyr /.false./ - cdot = .false. - 1 call getchar(lineq,iccount,charq) - if (lastchar) return -*************** -*** 19899,19905 **** +*** 20724,20736 **** common /comclefrests/ centrests logical newclef, centrests common /comlyr/ inputmlyr ! logical inputmlyr /.false./ + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comhair/ idhairuse,idhair(nm) + bottopgap = .false. + idhairuse = 0 if (.not.optimize) then print* - print*,'Starting second PMX pass' ---- 19900,19906 ---- +--- 20724,20737 ---- common /comclefrests/ centrests logical newclef, centrests common /comlyr/ inputmlyr ! logical inputmlyr + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comhair/ idhairuse,idhair(nm) + bottopgap = .false. ++ inputmlyr = .false. + idhairuse = 0 if (.not.optimize) then print* - print*,'Starting second PMX pass' *************** -*** 24541,24547 **** +*** 25399,25405 **** c (unless preceded with '\'), check length c character*128 lineq,lineqt @@ -121,12 +124,12 @@ iend = lenstr(lineq,128) c c i2nd = iccount+index(lineq(iccount+1:128),'"') ---- 24542,24549 ---- +--- 25400,25407 ---- c (unless preceded with '\'), check length c character*128 lineq,lineqt ! character*1 sq -! data sq /'\'/ +! sq = '\' iend = lenstr(lineq,128) c c i2nd = iccount+index(lineq(iccount+1:128),'"') diff --git a/Build/source/utils/pmx/pmx-src/README b/Build/source/utils/pmx/pmx-src/README index c5725475eaf..492559b1b0d 100644 --- a/Build/source/utils/pmx/pmx-src/README +++ b/Build/source/utils/pmx/pmx-src/README @@ -1,4 +1,4 @@ -This is PMX, version 2.7.4 (2016-02-20). PMX provides a preprocessor for MusiXTeX. +This is PMX, version 2.8.4 (2018-02-12). PMX provides a preprocessor for MusiXTeX. pmxab builds a TeX input file based on a .pmx input file in a much simpler language, making most of the layout decisions by itself. It has diff --git a/Build/source/utils/pmx/pmx-src/configure.ac b/Build/source/utils/pmx/pmx-src/configure.ac index d56db2ca306..07ab7e522a6 100644 --- a/Build/source/utils/pmx/pmx-src/configure.ac +++ b/Build/source/utils/pmx/pmx-src/configure.ac @@ -11,7 +11,7 @@ AC_INIT([pmx], pmx_version, [rdt@cs.queensu.ca]) AC_PREREQ([2.63]) AC_CONFIG_SRCDIR([pmxab.c]) -AM_INIT_AUTOMAKE(pmx, pmx_version) +AM_INIT_AUTOMAKE dnl Check compiler and flags AC_PROG_CC diff --git a/Build/source/utils/pmx/pmx-src/pmx.test b/Build/source/utils/pmx/pmx-src/pmx.test index 9979082d335..4055a6e47ed 100755 --- a/Build/source/utils/pmx/pmx-src/pmx.test +++ b/Build/source/utils/pmx/pmx-src/pmx.test @@ -1,6 +1,6 @@ -#! /bin/sh -vx -# Copyright 2017 Karl Berry <tex-live@tug.org> -# Copyright 2012 Peter Breitenlohner <tex-live@tug.org> +#! /bin/sh + +# Copyright (C) 2012 Peter Breitenlohner <tex-live@tug.org> # You may freely use, modify and/or distribute this file. rm -f barsant* pmxaerr.dat diff --git a/Build/source/utils/pmx/pmx-src/pmx276.for b/Build/source/utils/pmx/pmx-src/pmx284.for index d863df79a01..172f3da759b 100644 --- a/Build/source/utils/pmx/pmx-src/pmx276.for +++ b/Build/source/utils/pmx/pmx-src/pmx284.for @@ -63,6 +63,39 @@ c Undotted chord notes with dotted main note. c Forced line break without line number c Fix dot moving when 2nds in chord get flipped c To do: increase length on notexq in dodyn +c 2.84 +c Bug fix: dots in chordal seconds +c Bug fix: Initialize ihornb for non-beamed, down xtup +c Bug fix: When using "AT" with 2-note x3c rD. +c 2.83 +c Fix problems when changing to or from octave treble clef. +c Fix beaming (or not) and number location for xtups with +c multiple rests. Still some problems with number height but +c can be band-aided with number height tweak option. +c Tweak error messages for options on "R" command. +c Allow forced beam height and slope tweaks with 2-note tremolos +c Allow chordal note with 2-note tremolos, adding dots as needed. +c Fix call to ncmid in beamstrt when setting start height for beam of +c 2-note trem, by changing arg from ivx to iv +c 2.82 +c bugfix: beams with rests, not confused with xtups. +c x option after slur index to allow slurs to go from one voice to another. +c x option also for ties +c 2.81 +c Allow string of rests to end xtup +c in chordal half-note 2-note tremolo, make chord notes open. +c 2.80 +c Add 2-note tremolos +c 2.78 +c Expand bufq to 131072 bytes +c Expand maxblks tp 9600 +c Allow up to 75 pages +c Index postscript hairpins from 1 up instead of by voice #. +c Add option 'o' to forced beam for open notehead (\hb); set ipl(3) +c Add option T[n], n=1,2,3 for single stem tremolo +c 2.77 +c Enable AV+/-x+/-y to add vskip bigh before or after \eject +c 2.76 c 2.75 c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and c 2 or 3 flags on shortened note. @@ -717,9 +750,9 @@ c Command line input c Option Ao to optimize, otherwise normal processing c ccccccc - parameter (nks=125,nm=24,mv=24576,maxblks=4000) + parameter (nks=125,nm=24,mv=24576,maxblks=9600) character*128 lnholdq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /comevent/ miditime,lasttime logical slmon,dbltie @@ -769,8 +802,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording). c ccccccccccccccccccccccccc c - data date /'24 Nov 16'/ - data version /'2.76'/ + data date /'10 Feb 18'/ + data version /'2.84'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -908,7 +941,7 @@ c else linewcom(1) = 1+ncomments end if - if (ipbuf+lbuf(ilbuf).gt.65536) then + if (ipbuf+lbuf(ilbuf).gt.131072) then print*,'Too many characters in file, stopping' call stop1() end if @@ -1006,11 +1039,6 @@ c c Check to see if (1) last line is "<blank><blank>/" and (2) next to last c line is "/" c -c print*,'iplast:',iplast -c print*,'Last line:' -c print*,bufq(iplast+1-lbuf(nlbuf):iplast) -c print*,'Last char of next to last line:' -c print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)) if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then print*,'Removing last line of "<blank><blank>/"' @@ -1109,9 +1137,6 @@ c write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize) call pmxb(.true.,poe0,ncalls,optimize) -c itend = mytime() -c print*,'Elapsed time in ms:',itend-itstart -c write(15,*)'Elapsed time in ms:',itend-itstart close(15) end subroutine accsym(nacc,acsymq,lacc) @@ -1573,9 +1598,6 @@ c if (endrest) then return end if -c -c print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time -c 8 continue naccbl(icm) = nusebl if (nusebl .gt. 0) then @@ -1883,6 +1905,7 @@ c character*79 notexq ip = ipo(jn) multip = iand(mult(ivx,ip),15)-8 + lnote = 0 if (ixrest(ivx) .eq. 4) then c c This is the LAST note in the xtup (i.e., all rests before). Make single. @@ -1901,10 +1924,79 @@ c else if (btest(nacc(ivx,ip),31)) then nole = nole + 1 end if +c +c Terminate indented beams for 2-note tremolo if needed +c + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) + addoff = addoff+.0822*islope(ivx) + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 + end if if (.not.drawbm(ivx)) then c c Xtuplet with no beam, just put in the right kind of note c + if (btest(irest(ivx,ip),0)) then +c +c Rest at end of unbeamed xtup +c + lnote = 3 + if (btest(islur(ivx,ip),29)) then + notexq = sq//'sk' +c +c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for +c a blank rest ending xtup, but hopefully returning from here will handle it. +c + return + else if (multip .eq. 0) then + notexq = sq//'qp' + else if (multip .eq. -1) then + notexq = sq//'hp' + else if (multip .eq. 1) then + notexq = sq//'ds' + else if (multip .eq. 2) then + notexq = sq//'qs' + else + notexq = sq//'hs' + end if +c +c 180106 Deal with possible level tweak +c + nole = mod(nolev(ivx,ip)+50,100)-50 + if (nole .ne. 0) then + if (abs(nole) .lt. 10) then + noteq = chax(48+abs(nole)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole) + lnoten = 2 + end if + if (nole .gt. 0) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + end if if (btest(islur(ivx,ip),30)) then c c Forced stem direction @@ -1918,29 +2010,180 @@ c else call notefq(noteq,lnoten,nole,ncmid(iv,ip)) if (lnoten .eq. 1) call addblank(noteq,lnoten) - lnote = lnoten+3 +c +c To reduce confusion due to this early update of lnote, do it +c below, separately in each case/ +c lnote = lnoten+3 if (.not.btest(nacc(ivx,ip-1),27)) then c c Prior note is not regular-dotted c - + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then +c +c Unbeamed tremolo with indented beams. Put termination in right here +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c +c Is there an islope here, for unbeamed? +c + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq// + * 'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 +c write(11,'(a)')notexq(1:lnote) + end if if (multip .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq +c if (btest(irest(ivx,ip-1),2)) then + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).gt.24) then +c +c 2nd note of unbeamed half-note trem; make open +c But it's not clear if unbeamed half-note tremolo is Kosher, +c so don't worry about stem lengths here now. +c + if (lnote .eq. 0) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + else + notexq = notexq(1:46)// + * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + lnote = 46 + end if + else + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then +c +c Need a dot. +c + lnote = 46 + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if +c +c Insert stemlength stuff here for unbeamed dotted tremolo. +c May later combine with below to avoid repeat. But need to +c return to normal stem length after note is set. +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote) + lnote = lnote+10 + end if + if (lnote .eq. 0) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + * //noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'q' + * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then + notexq = notexq(1:lnote)//sq//'slz' + lnote=lnote+4 + end if + end if + else if (btest(irest(ivx,ip-1),2)) then +c +c 2nd note of unbeamed quarter or 8th trem; make quarter note +c Get stemlength change +c + lnote = 46 + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = notexq(1:46)//sq//'slx{'//tempq//'}' + lnote = lnote+10 +c if (lnote .eq. 0) then +c notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq +c else +c notexq = notexq(1:46)// +c * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq +c end if +c +c +c Check for dotted unbeamed tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if + notexq = notexq(1:lnote)// + * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) +c * //sq//'stemcut' + * //sq//'slz' +c lnote=lnote+3+lnoten+8 + lnote=lnote+3+lnoten+4 else if (multip .eq. -1) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. 1) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. 2) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnote+1 + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+4 else if (multip .eq. 3) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnote+2 + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+5 else if (multip .eq. -2) then - notexq = sq//'wh'//noteq + notexq = sq//'wh'//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. -3) then - notexq = sq//'breve'//noteq - lnote = lnote+3 + notexq = sq//'breve'//noteq(1:lnoten) + lnote = lnoten+6 else print* print*,'(Error in beamend, send source to Dr. Don)' @@ -1957,17 +2200,27 @@ c else if (multip .eq. -2) then notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq end if + lnote = lnoten+3 end if end if - return + return end if - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - lnote = 0 +c +c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just +c skipping the call in that case. +c + if (.not.btest(irest(ivx,ip),0)) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if +c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) +c lnote = 0 c c New way, with flipend, which was computed in beamstrt. c - if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) - * ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then + ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + flipend(ivx) = .false. + end if if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then c c This is not a one-noter from beam-jump. Check if multiplicity has increased @@ -2012,14 +2265,67 @@ c if (.not.btest(irest(ivx,ip),23)) then c c This is either a normal beamend or end of a sequence of jump-beam segments, +c (170409) or rest at end of xtup c so some sort of termination is required c ulqq = ulq(ivx,ibmcnt(ivx)) if (.not.isbjmp .or. ivx.ne.ivbj2) then + if (btest(irest(ivx,ip),0)) then +c +c Xtup ends with rest +c + if (multip .eq. 1) then + notexq = sq//'ds' + lnote = 3 + else if (multip .eq. 2) then + notexq = sq//'qs' + lnote = 3 + else if (multip .eq. 3) then + notexq = sq//'hs' + lnote = 3 + end if +c +c 170801 Borrowed from main rest entry way down below to get level adjustment: +c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? +c "... Now raise if necc." +c + if (btest(islur(ivx,ip),29)) then +c +c Blank rest +c + notexq = sq//'sk' + lnote = 3 + else if (nole .ne. 0) then +c +c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with +c nolev=-4 but expected 100+/-. Try to fix. +c + if (abs(nole).lt.30) nole = 100+nole +c + if (abs(nole-100) .lt. 10) then + noteq = chax(48+abs(nole-100)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole-100) + lnoten = 2 + end if +c ??? if (nole .gt. 0) then + if (nole .gt. 100) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + else c c Normal termination c - call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) + call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) + end if else c c Terminate a sequence of jump-beam segments. @@ -2038,12 +2344,50 @@ c if (isbjmp.and.ivx.eq.ivbj2 return end if c -c And now the note +c And now the note, checking for open-head beamed tremolo c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' + if (btest(irest(ivx,ip-1),2)) then +c +c Check for dotted tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes? + end if + if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if + else + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + end if + else +c +c No tremolo +c + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if end if lnote = lnote+3 isdotm = .false. @@ -2063,10 +2407,8 @@ c 5/25/08 Allow >12 c 5/9/10 Up to 24; replace 24 with 0 c if (.not.(isbjmp.and.ivx.eq.ivbj2)) then -c call istring(mod(ivx,12),tempq,len) call istring(mod(ivx,24),tempq,len) else -c call istring(mod(ivbj1,12),tempq,len) call istring(mod(ivbj1,24),tempq,len) end if if (isbjmp .and. ivx.eq.ivbj2 @@ -2263,7 +2605,6 @@ c call putxtn(mprint,iflop,multip,iud,wheadpt,poenom, * nolev1(ivx),islope(ivx),slfac, * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum, -c * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.) * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip), * mult(ivx,ip),.false.) end if @@ -2287,10 +2628,43 @@ c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) end if c +c Check for string of rests up to and including last note in xtup. +c +c Replace next 2 lines to keep from doing this block +c when in second part of staff-jumping chordal xtup. This fix could +c break some unaccounted non-chordal staff-jum xtup situations. +c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. +c * .not.btest(irest(ivx,ip),0)) then + if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. + * .not.btest(irest(ivx,ip),0) .and. + * .not.(isbjmp.and.ivx.eq.ivbj2)) then +c +c This note is not a rest but next is a rest. Do rests continue to +c end of xtup, where nodur>0 +c + do 3 ipnow = ip+1 , ip+24 + if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup + if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest +c +c If I don't go to 5, know next note IS a rest! +c +3 continue +4 continue + call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) + notexq = notexq(1:lnote)//sq//'qb' + lnote = lnote+3 + call istring(ivx,tempq,len) + notexq = notexq(1:lnote)//tempq(1:len) + lnote = lnote+len + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + return +5 continue +c c Check if multiplicity changes in a way requiring action, c unless (160211) it's blank rest on start of 2nd seg of joined beam c - if(.not.btest(irest(ivx,ip-1),24) + else if(.not.btest(irest(ivx,ip-1),24) * .or..not.btest(islur(ivx,ip-1),29)) then ipleft = ip-1 if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1 @@ -2432,11 +2806,10 @@ c call istring(mod(ivbj1,12),tempq,len) * nssb(nm),issb(nm),lev1ssb(nm,20) common /comdraw/ drawbm(nm) common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*8 noteq + character*8 noteq,tempq character*79 notexq ip1 = ipo(jn) multip = iand(15,mult(ivx,ip1))-8 -c if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then lnote = 0 c @@ -2471,8 +2844,93 @@ c call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) if (lnoten .eq. 1) call addblank(noteq,lnoten) lnote = 3 - if (multip .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + if (multip .le. 0) then +c if (btest(irest(ivx,ip1),2) .and. +c * nodur(ivx,ip1+1).ge.32) then + if ((btest(irest(ivx,ip1),2) .and. + * nodur(ivx,ip1+1).ge.32) + * .or. multip .eq. -1) then +c +c 1st note of unbeamed half-note trem; make open +c + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -2) then + notexq = sq//'wh' + else + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + end if +c +c Check for dot +c + if (btest(irest(ivx,ip1),2) .and. +c * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then +c +c Need a dot. already called addblank for noteq +c + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes? + if (lnoten .eq. 1) call addblank(noteq,lnoten) + end if +c +c Insert the stemlength calcs here for dotted, unbeamed. +c Later may combine with below to avoid repeat. +c + if (btest(irest(ivx,ip1),2)) then + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * notexq(1:lnote) + lnote = lnote+10 + end if + else if (btest(irest(ivx,ip1),2)) then +c +c 1st note of unbeamed quarter or 8th trem, make a quarter note +c +c Stem length calcs here. The .2 factor is empirical, but +c slfac accounts for musicsize. +c + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * sq//'q'//ulq(ivx,ibmcnt(ivx)) + lnote = 13 +c +c Check for dotted 2-note trem; prepend dot to notexq if needed +c + if (nodur(ivx,ip1+1).eq.12 .or. + * nodur(ivx,ip1+1).eq.24) then + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if else if (multip .eq. -1) then notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) else if (multip .eq. 1) then @@ -2527,12 +2985,46 @@ c end if end if c -c Put in the note +c Check for beamed, dotted 2-note tremolo c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' + if (btest(irest(ivx,ip1),2) .and. + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if +c +c Put in the note, but check first for open-head beamed tremolo. +c + if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if else - notexq = sq//'qb' + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if end if lnote = lnote+3 c @@ -2651,12 +3143,86 @@ c ipb1 = ibm1(ivx,ibc) multb = iand(15,mult(ivx,ipb1))-8 ip = ipo(jn) + lnote = 0 + nvtrem = 0 ! Vertical adjustment beams for tremolo c c Compute slopes and note offsets from start of beam. Inside SetupB, for each -c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. +c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also +c gets islope(ivx), transferred in common. c if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx)) +c +c Will always come past here after entering beamstrt for 2-note tremolo, and +c slope will have been computed, even for unbeamed. So start the indented +c beams here. The indented tremolo bars will be added to the notexq output +c string, under the tacet assumption that there is no horizontal shift +c enacted by the action just before and after the call to beamstrt. +c + if (btest(irest(ivx,ipb1),2) .and. + * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ipb1),2,5) + tempq = sq//'roffset{.7}{'//sq//'ib' + ltemp = 16 + if (nindent .eq. 2) then + tempq = tempq(1:16)//'b' + ltemp = 17 + else if (nindent .eq. 3) then + tempq = tempq(1:16)//'bb' + ltemp = 18 + end if +c +c Use beam # 0 for indented beams +c + tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0' + ltemp = ltemp+2 +c +c Get adjustment to nolev1 for main beam based on nindent +c + if (ulq(ivx,ibc) .eq. 'u') then + nvtrem = nindent-1 + else + nvtrem = 1-nindent + end if +c +c Get numerical position of initiation for main beam. Will adjust height at +c closing to account for nindent +c +c numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4 + numinit = nolev1(ivx)-ncmid(iv,ipb1)+4 +c +c Get forced beam height tweak, apply here for indented beams +c + iadj = igetbits(ipl(ivx,ipb1),6,11)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1)') numinit + lnoten = 1 + else + write(noteq,'(a1,i2,a1)')'{',numinit,'}' + lnoten = 4 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten +c +c Now do the slope. +c 170408 Baseline is in islope(ivx). Apply slope tweak if present. +c + numinit = islope(ivx) + iadj = igetbits(ipl(ivx,ipb1),6,17)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1,a1)') numinit,'}' + lnoten = 2 + else + write(noteq,'(a1,i2,a2)')'{',numinit,'}}' + lnoten = 5 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten + notexq = tempq + lnote = ltemp + end if if (btest(nacc(ivx,ip),21)) then c c This is start of later segment of single-slope beam group so use slope and @@ -2665,7 +3231,9 @@ c issb(ivx) = issb(ivx)+1 nolev1(ivx) = lev1ssb(ivx,issb(ivx)) end if - lnote = 0 +c +c Move this up to before indented beams for tremolo +c lnote = 0 drawbm(ivx) = .true. if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then vxtup(ivx) = .true. @@ -2715,8 +3283,13 @@ c if (iud*iup .lt. 0) iflop = iup end if c -c Determine if a beam is to be drawn +c Determine if a beam is to be drawn. +c Had problem w/ half-note 2-note xtups always F, so add a test c + if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then + drawbm(ivx) = .true. + go to 6 + end if do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc) if (iand(15,mult(ivx,ipp))-8 .le. 0) then drawbm(ivx) = .false. @@ -2730,15 +3303,29 @@ c Are we using tuplet.tex? c usexnumt = cstuplet .and. .not.drawbm(ivx) c +c Check for single note xtup 171217 +c + if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then + drawbm(ivx) = .false. + end if +c c Place xtup number if needed c if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then mprint = igetbits(nacc(ivx,ip),5,22) if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) +c Stab in the dark! Note: tried setting unbeam flag islur18 but no go. + if (nnb .eq. 1) then + xnlmid = nolev1(ivx) + islope(ivx) = 0 +c +c Move up, outside number check block, so all 1-note xtups ar unbeamed +c drawbm(ivx) = .false. +c + end if call putxtn(mprint,iflop,multb,iud,wheadpt, * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1), * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)), -c * iup,irest(ivx,ipb1),usexnumt) * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt) end if if (.not.drawbm(ivx)) then @@ -2829,25 +3416,11 @@ c beamstrt and beamn1 some non-spacing chars. are inserted. c c 130126 Deal with vertical shifts of rest starting xtuplet c -c if (multb .eq. 0) then -c notexq = notexq(1:lnote)//sq//'qp' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.1) then -c notexq = notexq(1:lnote)//sq//'ds' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.2) then -c notexq = notexq(1:lnote)//sq//'qs' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.3) then -c notexq = notexq(1:lnote)//sq//'hs' -c lnote = lnote+3 -c else -c notexq = notexq(1:lnote)//sq//'hpause' -c lnote = lnote+7 -c end if - lrest = 3 - if (multb .eq. 0) then + if (btest(islur(ivx,ip),29)) then + restq = sq//'sk' +c if (multb .eq. 0) then + else if (multb .eq. 0) then restq = sq//'qp' else if (.not.drawbm(ivx).and.multb.eq.1) then restq = sq//'ds' @@ -2859,10 +3432,20 @@ c end if restq = sq//'hpause' lrest = 7 end if + if (btest(nacc(ivx,ipb1),18) .and. + * btest(nacc(ivx,ipb1),19)) then +c +c VERY special case of rest at start of F-tuplet, needs dot +c + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if + nole = mod(nolev(ivx,ip)+20,100)-20 - if (nole .eq. 0) then +c if (nole .eq. 0) then + if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then c -c Rest is not raised +c Rest blank or is not raised c notexq = notexq(1:lnote)//restq lnote = lnote+lrest @@ -3016,14 +3599,23 @@ c flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc)) end if end if - call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote) + multbb = multb+iadj +c +c Tremolo starting? +c + if (btest(irest(ivx,ipb1),2)) multbb = + * igetbits(irest(ivx,ipb1),2,3) + call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote) c c Put in name of start level and slope, after correcting nolev1 if xtup c started with a rest. c if (ixrest(ivx).eq.2) nolev1(ivx) = * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac) - call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1)) +c +c Add adjustment nvtrem to main beam to account for tremolo indented beams +c + call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1)) if (islope(ivx) .lt. 0) then notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' lnote = lnote+4+lnoten @@ -3258,7 +3850,7 @@ c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, data iTransAmt /nm*0/ end subroutine catspace(space,squez,nnsk) - parameter (nkb=3999,maxblks=4000) + parameter (nkb=3999,maxblks=9600) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) @@ -4391,8 +4983,9 @@ c end subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt, * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen, - * dotxtup,nacc) + * dotxtup,nacc,irest) parameter (nm=24,mv=24576) + integer*4 irest(nm,24) common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), * xinsnow,lowdot common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), @@ -4427,10 +5020,10 @@ c * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans common /commidisig/ midisig -c 130316 common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) c c This subr. once produced notexq for entire chord. 10/18/97 altered to write c chord notes as we go. 10/22/97 find range of icrd first. @@ -4453,10 +5046,86 @@ c c c Check for special situations with 2nds (see precrd). c - if (btest(nacc,30)) then - if (nolev .eq. nolevm-1) nolev = nolevm - else if (btest(nacc,31)) then - if (nolev .eq. nolevm+1) nolev = nolevm + if (btest(nacc,30) .and. nolev.eq.nolevm-1) then +c +c Upstem, 2nd with upper as main, interchange pitches, +c rt-shift upper (now chord note). Lower (orig chord, now main) +c if dotted, probably had shifted dot, dot parameters must be moved +c from chord to main +c + nolev = nolevm + if (btest(icrdat(icrd),26)) then +c +c Orig. chord note dot shift, must transfer to main. +c + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + if (btest(irest(ivx,ip),19)) then +c +c Main note (upper) had a dot shift, must move it to chord +c + call setbits(icrdat(icrd),1,26,1) + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c May need to worry about other chord params (accid shefts etc) later +c + else + icrdat(icrd) = ibclr(icrdat(icrd),26) + end if +c +c We are adding a main note dot shift, so push any later ones back +c + + if (.not.btest(irest(ivx,ip),19)) then + maxdotmv(ivx) = maxdotmv(ivx)+1 + do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1 + updot(ivx,indm) = updot(ivx,indm-1) + rtdot(ivx,indm) = rtdot(ivx,indm-1) +1 continue + end if + irest(ivx,ip) = ibset(irest(ivx,ip),19) + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + end if + else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then +c +c Downstem, 2nd with lower as main, interchange pitches, +c left-shift lower (now chord note). Lower (orig main, now chord) +c probably had shifted dot, dot parameters must be moved from +c main to chord +c + nolev = nolevm + if (btest(irest(ivx,ip),19)) then + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + icrdat(icrd) = ibset(icrdat(icrd),26) +c bits in icrdot +c 0-6 10*abs(vertical dot shift in \internote) + 64 +c 7-13 10*abs(horizontal dot shift in \internote) + 64 +c Assuming >0 for now! + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c Must also set dot shift for (now) main note (orig. chord note). +c + if (btest(icrdatsav,26)) then + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + else +c +c No dot move on original chord (now main) note, +c + updot(ivx,ndotmv(ivx)+1) = 0. + rtdot(ivx,ndotmv(ivx)+1) = 0. + end if + end if end if c c Lower dot for lower-voice notes?. Conditions are: @@ -4467,43 +5136,38 @@ c 4. Not a rest (cannot be a rest in a chord!) c. 5. Flag (lowdot) is set to true c if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then - if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then - if (btest(icrdat(icrd),26)) then + if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then + if (btest(icrdat(icrd),26)) then c c Note already in movdot list. Drop by 2. c - call setbits(icrdot(icrd),7,0, + call setbits(icrdot(icrd),7,0, * igetbits(icrdot(icrd),7,0)-20) else c c Not in list so just move it right now c - call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) - end if + call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) end if - end if - if (btest(icrdat(icrd),26)) then + end if + end if + if (btest(icrdat(icrd),26)) then c -c Move the dot. +c Move the dot. Basic call for chord notes, not main note. c - updotc = 0.1*(iand(127,icrdot(icrd))-64) - rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) - call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) - end if - isleft = btest(icrdat(icrd),23) - isright = btest(icrdat(icrd),24) + updotc = 0.1*(iand(127,icrdot(icrd))-64) + rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) + call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) + end if + isleft = btest(icrdat(icrd),23) + isright = btest(icrdat(icrd),24) c c Check for ornament in chord. c - if (icrdorn(icrd) .gt. 0) then - call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, - * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, - * ip,0,beamon,.true.) -c -c subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx, -c * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt, -c * notcrd,beamon,iscrd) -c + if (icrdorn(icrd) .gt. 0) then + call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, + * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, + * ip,0,beamon,.true.) call addstr(outq,lout,soutq,lsout) end if c @@ -4603,15 +5267,8 @@ c c c Use original saved pitch level, unaltered by 2nds logic. c -c 130316 -c call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)), -c * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) -c 130316 -c * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., * igetbits(icrdat(icrd),3,20),midisig,1., - - * .false.,.false.) end if 5 continue @@ -4643,6 +5300,7 @@ c character*79 notexq character*80 soutq integer*4 ihornb(nm,24),nornb(nm),idynn(10) + common /comhair/ ihairuse,idhair(nm) data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/ numdyn = 0 c @@ -4650,7 +5308,6 @@ c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values c in idynn(1...4) c do 1 idyn = 1 , ndyn -c ivxtent = iand(idyndat(idyn),15) ivxtent = iand(idyndat(idyn),15) * +16*igetbits(idynda2(idyn),1,10) if (ivxtent .eq. ivx) then @@ -4664,8 +5321,6 @@ c I don't think there are any more possible for this ivx,ip, so exit loop c go to 2 end if -c else if (ivxtent .gt. ivx) then -c go to 2 end if 1 continue 2 continue @@ -4709,7 +5364,14 @@ c end if else hoffsd = -.5 - lbot = ihornb(ivx,nornb(ivx))+1 +c +c 171230 Desperation +c lbot = ihornb(ivx,nornb(ivx))+1 + if (nornb(ivx).eq.0) then + lbot = 1 + else + lbot = ihornb(ivx,nornb(ivx))+1 + end if if (lbot .eq. 1) then c c Kluge for non-beamed, down xtup, for which ihorb was never set. @@ -4761,7 +5423,7 @@ c lnote = 7 if (idno .eq. 13) then c -c Start a hairpin +c Start a font-based hairpin c notexq = chax(92)//'hpstrt' else if (idno .eq. 14) then @@ -4775,6 +5437,19 @@ c End decrescendo c notexq = chax(92)//'hpdend' end if +c +c Put in voice number as ID for font-based hairpin +c + if (ivx .le. 9) then + notexq = notexq(1:lnote)//char(48+ivx) + lnote = lnote+1 + else if (ivx .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' + lnote = lnote+4 + end if else c c Postscript hairpins @@ -4788,19 +5463,37 @@ c else notexq = chax(92)//'Tcresc' end if - end if - if (idno .ge. 13) then + if (idno .le. 14) then +c +c Get and record ID no for start of ps hairpin +c Find first unused ID +c + do 8 idh = 1 , 24 + if (.not.btest(ihairuse,idh)) go to 9 +8 continue + call printl('Bad place in putdyn, call Dr. Don') + call stop1() +9 continue + ihairuse = ibset(ihairuse,idh) + idhair(ivx) = idh + else c -c Put in voice number +c Unrecord ID no for end of ps hairpin +c + call setbits(ihairuse,1,idhair(ivx),0) + end if c - if (ivx .le. 9) then - notexq = notexq(1:lnote)//char(48+ivx) +c Write ID # for start or end of ps hairpin +c + idh = idhair(ivx) + if (idh .le. 9) then + notexq = notexq(1:lnote)//char(48+idh) lnote = lnote+1 - else if (ivx .le. 19) then - notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' + else if (idh .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}' lnote = lnote+4 else - notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' + notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}' lnote = lnote+4 end if end if @@ -5095,14 +5788,14 @@ c c c Construct string to search backwards for placeholder c - if (ivx .le. 9) then - tempq = 'cresc'//char(48+ivx)//'{ }' + if (idh .le. 9) then + tempq = 'cresc'//char(48+idh)//'{ }' ltemp = 11 - else if (ivx .le. 19) then - tempq = 'cresc'//'{1'//char(38+ivx)//'}{ }' + else if (idh .le. 19) then + tempq = 'cresc'//'{1'//char(38+idh)//'}{ }' ltemp = 14 else - tempq = 'cresc'//'{2'//char(28+ivx)//'}{ }' + tempq = 'cresc'//'{2'//char(28+idh)//'}{ }' ltemp = 14 end if write(11,'(a)')soutq(1:lsout)//'%' @@ -5269,13 +5962,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' lnote = 4 end if -c if (11-ndxslur .lt. 10) then -c call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten, -c * soutq,lsout) -c else -c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), -c * 4+lnoten,soutq,lsout) -c end if call addstr(notexq(1:lnote)//noteq(1:lnoten), * lnote+lnoten,soutq,lsout) if (.not.fontslur) then @@ -5363,12 +6049,10 @@ c c c Terminate slur on single after-grace c -c ndxslur = igetbits(ipl,4,23) ndxslur = igetbits(ipl,5,23) call notefq(noteq,lnoten,nolevg(ngs),ncm) call addstr(sq//'tslur',6,soutq,lsout) c -cc Print 11-ndxslur c Print 24-ndxslur c c if (11-ndxslur .lt. 10) then @@ -5391,8 +6075,6 @@ c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), c c+++ Try to fix loss of octave with single gaft c -c if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}', -c * 13+lnoten,soutq,lsout) if (isgaft) then itrans = 0 do 1 i = 1 , lnotenGA @@ -5505,7 +6187,7 @@ c end if end if c -c Print 11-ndxslur +c Print 23-ndxslur c if (23-ndxslur .lt. 10) then call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten, @@ -5689,11 +6371,13 @@ c 11 start/stop switch c 12 kv-1 c 19-25 ichar(code$) c 26 force direction? + c 27 forced dir'n = up if on, set in sslur; also c final direction, set in doslur when beam is started, used on term. c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. c 2 stem slur flag +c 1 flag for "x" slur (voice-independent) c c Bits in isdat2 c 0 Chord switch. Not set on main note. @@ -5756,7 +6440,9 @@ c isdata = isdat1(isdat) if (iv .eq. igetbits(isdata,5,13) .and. * ip .eq. igetbits(isdata,8,3) .and. - * kv .eq. igetbits(isdata,1,12)+1) then +c * kv .eq. igetbits(isdata,1,12)+1) then + * (kv .eq. igetbits(isdata,1,12)+1 .or. + * btest(isdata,1))) then c c Since iv and kv match, ivx will be correct c @@ -5869,13 +6555,10 @@ c c Get index of next slur not in use, starting from 12 down c ndxslur = log2(16777215-listslur) -c write(*,'()') -c write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur c c Record slur index c listslur = ibset(listslur,ndxslur) -c write(*,'(10x,B24)')listslur c c Save for use on termination c @@ -5892,7 +6575,7 @@ c else ihoff = ihoff+2 end if - end if + end if if (iscrd) then c c Additional horiz shifts for h-shifted noteheads? @@ -5963,19 +6646,15 @@ c notexq = chax(92)//'dotted'//noteq end if c c Add slur index to string -cc Print 11-ndxslur c Print 23-ndxslur c -c if (11-ndxslur .lt. 10) then if (23-ndxslur .lt. 10) then c c 5/25/08 Allow 24 slurs c -c notexq = notexq(1:lnote)//chax(59-ndxslur) notexq = notexq(1:lnote)//chax(71-ndxslur) lnote = lnote+1 else if (23-ndxslur .lt. 20) then -c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' lnote = lnote+4 else @@ -5985,7 +6664,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' c c Add note name to string c -c call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) islhgt = nolevs+iupdn+ivoff call notefq(noteq,lnoten,islhgt,ncm) notexq = notexq(1:lnote)//noteq(1:lnoten) @@ -6045,7 +6723,9 @@ c Slur is ending. Back thru list to find starting slur c do 3 j = isdat-1 , 1 , -1 if (iv.eq.igetbits(isdat1(j),5,13) .and. - * kv.eq.igetbits(isdat1(j),1,12)+1) then +c * kv.eq.igetbits(isdat1(j),1,12)+1) then + * (kv.eq.igetbits(isdat1(j),1,12)+1 + * .or. btest(isdat1(j),1))) then if (idcode .eq. igetbits(isdat1(j),7,19)) then ndxslur = igetbits(isdat1(j),4,28) c @@ -6063,7 +6743,6 @@ c c c Bugfix 070901 for slur ending on rest in 2-voice staff c -c if (nolevs.eq.0 .or. nolevs.gt.60) then if (nolevs.le.2 .or. nolevs.gt.60) then c c Ending is on a rest, reset nolevs to default starting height @@ -7432,7 +8111,7 @@ c return end subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0) - parameter (nkb=3999,maxblks=4000) + parameter (nkb=3999,maxblks=9600) c c Compute an exponent eonk for use in the "flattened" formula for elemskips c vs time. We must solve the eqution f = 0. Initial quess is eonk0. @@ -7531,7 +8210,7 @@ c fnote = nodur(ivx,iip)/float(iip-ip1m1) print*,' ' call printl * ('Probable misplaced barline or incorrect meter, stopping') -c call printl('Program error in fnote, send source to Dr. Don') + print*,'ivx,ip:',ivx,ip call stop1() end subroutine g1etchar(lineq,iccount,charq) @@ -7567,7 +8246,7 @@ c return end subroutine g1etnote(loop,ifig,optimize,fulltrans) - parameter (nm=24,nkb=3999,mv=24576,maxblks=4000) + parameter (nm=24,nkb=3999,mv=24576,maxblks=9600) character*1 chax common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, @@ -7604,7 +8283,7 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), * debugmidi logical debugmidi - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq logical novshrinktop,upslur,fontslur,ztrans, @@ -7621,6 +8300,8 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) logical fulltrans common /comsize/ isize(nm) common /commidisig/ midisig + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset data literq * /'Literal TeX string cannot start with 4 backslashes!', * 'TeX string must have <129 char, end with backslash!', @@ -7850,13 +8531,13 @@ c else call g1etchar(lineq,iccount,durq) call readnum(lineq,iccount,durq,dum) + if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1 iccount = iccount-1 go to 2 end if c else if (index('ulare',durq) .gt. 0) then else if (index('ularec',durq) .gt. 0) then go to 2 -c else if (durq .eq. 'S') then else if (index('LS',durq) .gt. 0) then c c Stemlength change @@ -7933,20 +8614,51 @@ c c Will set all durations to 0 except last one. c call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then + if (index('123456789T',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'First char after "x" in xtuplet must be "1"-"9"!') + * 'First char after "x" in xtuplet must be "1"-"9" or "T"!') call stop1() end if - call readnum(lineq,iccount,durq,fnum) - if (fnum .gt. 99) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + if (durq .eq. 'T') then +c +c Check all x-tremolo inputs here; set fnum=2 +c + fnum = 2 + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'First char after "T" in xtuplet must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This char must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) +c +c Probably blank unles other options entered +c + end if + end if + else +c +c durq is digit, normal xtup +c + call readnum(lineq,iccount,durq,fnum) +c +c Leaves durq at next char after number +c + if (fnum .gt. 99) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Xtuplet cannot have more than 99 notes!') - call stop1() - else if (index(' DFnd',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only legal characters here are " ","D","F","n"!') - call stop1() + call stop1() + else if (index(' DFnd',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only legal characters here are " ","D","F","n"!') + call stop1() + end if end if c c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. @@ -8262,6 +8974,8 @@ c * 'Slur ID not allowed on non-postscript tie!') call stop1() end if + if (lineq(iccount+1:iccount+1).eq.'x') + * iccount = iccount+1 go to 15 end if call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, @@ -8486,18 +9200,10 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'In xtup, this character is not allowed!') call stop1() -c else if (durq.eq.'r' .and. itup.eq.ntup) then -c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'Sorry, PMX cannot end an xtuplet with a rest!') -c call stop1() - else if (durq.eq.'r' .and. itup.eq.ntup .and. - * index(lineq(iccount+1:iccount+2),'b').eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Sorry, PMX cannot end an xtuplet with a non-blank rest!') - call stop1() end if 7 call g1etchar(lineq,iccount,durq) - if (index('2345678ulcb',durq) .gt. 0) then +c if (index('2345678ulcb',durq) .gt. 0) then + if (index('12345678ulcb',durq) .gt. 0) then go to 7 else if (index('sfn',durq) .gt. 0) then c @@ -8640,7 +9346,14 @@ c iccount = iccount-1 end if go to 2 - else if (durq .ne. ' ') then + else if (durq .eq. 'T') then +c +c Single stem tremolo. Only option (optional) is 1,2,3, or 4. +c + call getchar(lineq,iccount,durq) + if (index('1234',durq) .eq. 0) iccount = iccount-1 + go to 2 + else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character!') print*,'ASCII code:',ichar(durq) @@ -9079,6 +9792,8 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Slur ID not allowed on non-postscript tie!') call stop1() + else if (lineq(iccount+1:iccount+1).eq.'x') then + iccount = iccount+1 end if end if c @@ -9536,13 +10251,28 @@ c gotclef = .true. * 'Repeats can only go in voice 1!') call stop1() end if -10 call g1etchar(lineq,iccount,durq) - if (index('lrdDbz',durq) .gt. 0) go to 10 - if (durq .ne. ' ') then +c10 call g1etchar(lineq,iccount,durq) +c if (index('lrdDbz',durq) .gt. 0) go to 10 +c if (durq .ne. ' ') then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'Illegal character after "R" (repeat/double bar)!') +c call stop1() +c end if + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,dumq) + if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "R" (repeat/double bar)!') + * 'Illegal character after "R*" (repeat/double bar)!') call stop1() end if + if (dumq .ne. ' ') then + call g1etchar(lineq,iccount,durq) + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have blank after "R**" (repeat/double bar)!') + call stop1() + end if + end if else if (charq .eq. 'V') then c c Ending @@ -9640,7 +10370,16 @@ c iccount = 128 else if (charq .eq. 'A') then 27 call g1etchar(lineq,iccount,durq) - if (index('rbsdeK',durq) .gt. 0) then +c if (index('rbsdeK',durq) .gt. 0) then + if (index('rbsdK',durq) .gt. 0) then + go to 27 + else if (durq .eq. 'e') then +c +c Check for is4bignv. Must do here to catch first \internote, written in topfile +c before ever calling getnote. Initialize as .false. in pmxa. Make it true only +c if nv>7, AI not set, Ai not set. +c + is4bignv = nv.gt.7 .and. .not.AIset go to 27 else if (durq .eq. 'v') then if (ibarcnt .eq. 0) novshrinktop = .true. @@ -9656,6 +10395,8 @@ c iccount = iccount-1 go to 27 else if (durq .eq. 'i') then + is4bignv = .false. + AIset = .true. call g1etchar(lineq,iccount,durq) c c Local interstaff correction. Set to -1. if not specifiec, or after use, @@ -9669,6 +10410,8 @@ c c c Global interstaff correction. Use in place of fintstf if fintstf<0 c + is4bignv = .false. + AIset = .true. call g1etchar(lineq,iccount,durq) call readnum(lineq,iccount,durq,gintstf) iccount = iccount-1 @@ -9771,10 +10514,38 @@ c voffpt = -24 end if go to 27 + else if (durq .eq. 'V') then + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift before \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift after \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 27 else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, c * 'After "A" must follow one of the letters abcdeiINprRsST!') - * 'After "A" must follow one of the letters abcdeiILNprRsST!') + * 'After "A" must follow one of abcdeiILNprRsSTvV!') print*,'For AS, since ver. 2.7, must only have noinst args.' write(15,'(a)') * 'For AS, since ver. 2.7, must only have noinst args.' @@ -9936,7 +10707,7 @@ c if (mod(itsofar(ivx),lenbar).ne.0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Block duration not divisible by lenbar!') - print*,'lenbar is ',lenbar + print*,'lenbar, timesofar are ',lenbar,itsofar(ivx) call stop1() else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then print* @@ -10326,8 +11097,8 @@ c end subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, * xmtrnum0,newkey,npages,nsyst,musize,bottreb) - parameter(nm=24,maxblks=4000) - character*65536 bufq + parameter(nm=24,maxblks=9600) + character*131072 bufq character*1 chax integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq @@ -10564,9 +11335,9 @@ c mytime = 1000*(ts+60*(im+60*ih)) c return c end subroutine getbuf(lineq) - parameter (maxblks=4000) + parameter (maxblks=9600) character*(*) lineq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) @@ -11552,7 +12323,7 @@ c common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, * OptLineBreakTies,HeaderSpecial common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, @@ -11574,7 +12345,7 @@ c * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /combc/ bcspec common /comas3/ ask(2500),iask,topmods c @@ -11634,8 +12405,11 @@ c common /commidisig/ midisig common /comlyr/ inputmlyr logical inputmlyr - data inputmlyr /.false./ + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + logical inxtup cdot = .false. + inxtup = .false. 1 call getchar(lineq,iccount,charq) if (lastchar) return if (charq .eq. ' ') go to 1 @@ -11825,11 +12599,15 @@ c c c Accidental c - if (nacc(ivx,nnl(ivx)) .eq. 0) then +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c 171209 May have set bit 18 earlier if D or F preceded accidental + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then c c No accidental has been set yet c - nacc(ivx,nnl(ivx)) = index('fsn',durq) +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) else c c Repeated accid, so must be double @@ -11878,8 +12656,8 @@ c c Kluge in case there is a shortcut ".". It will have been sucked up by c readnum. (Same doesn't hold for ",") c - iccount = iccount-2 - go to 2 + iccount = iccount-1 +c go to 2 end if nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) c @@ -11898,17 +12676,86 @@ c ndoub = 0 end if c +c Initialize counter for # of non-rests, so can later unbeam if = 1. +c + inxtup = .true. + note1xtup = nnl(ivx) + nnb = 0 + if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1 +c c Will set all durations to 0 except last one. Set flag on this note. c irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28) c -c Next input will be digit +c Next input will be digit unless its a "T" c iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - ntup = nint(fnum) + if (lineq(iccount:iccount) .eq. 'T') then +c +c Set up tremolo +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2) + ntup = 2 +c +c Set default beaming, based on Wikipedia article +c May be a problem here is nnodur is inherited +c + if (nnodur .eq. 4) then + nsolid = 0 + nindent = 3 + else if (nnodur .eq. 2) then + nsolid = 3 + nindent = 0 + else if (nnodur .eq. 8) then + nsolid = 1 + nindent = 2 + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nsolid = index('0123456789',durq)-1 + if (nsolid.eq.0 .and. nnodur.eq.2) then + print*,'' + print*,'Unbeamed half-note 2-note tremolo forbidden.' + call stop1() + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nindent = index('0123456789',durq)-1 + end if + end if + call setbits(irest(ivx,nnl(ivx)),2,3,nsolid) + call setbits(irest(ivx,nnl(ivx)),2,5,nindent) + if (nsolid .eq. 0) then + islur(ivx,nnl(ivx)) = + * ibset(islur(ivx,nnl(ivx)),18) + end if + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) + call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid) +c +c Set some force-beam parameters for the tremolo +c +c Need to check if there's already a forced beam explicitly set here. +c If there was, shouldn't do any harm resetting parameters. +c + if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx)) + * nfb(ivx) = nfb(ivx)+1 + fbon = .true. + ulfbq(ivx,nfb(ivx)) = 'x' + t1fb(ivx,nfb(ivx)) = itsofar(ivx) + t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq) + nadj = 0 +c +c Set open beamed notehead flag for half-note tremolo +c Just gave 2 quarters with or without flag set. Need to fix +c + else + call readnum(lineq,iccount,durq,fnum) + ntup = nint(fnum) + end if if (index('DF',durq) .gt. 0) then c +c c Double xtup note to make an un= xtup. Here xtup number already set but may also c have this command before. c @@ -12292,12 +13139,8 @@ c c 140218 Need to get time differently inside xtup, since itsofar doesn't get c updated until after xtup is done c -c tcc(iv,ncc(iv)) = itsofar(iv) nodurt = ifnodur(nnodur,dotq) tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) -c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' -c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) -c isl = ibset(islur(iv,nnl(iv)+1),11) isl = ibset(islur(iv,nnl(iv)),11) call getchar(lineq,iccount,durq) c @@ -12307,7 +13150,7 @@ c ncmidcc(iv,ncc(iv)) = ncmidf(durq) if (durq .eq. '8') then ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) end if c c Set marker on note with lowest voice # starting at same time. @@ -12379,6 +13222,12 @@ c else nolev(ivx,nnl(ivx)) = 2 end if +c end if + else +c +c Counter for non-rests +c + nnb = nnb+1 end if notcrd = .true. 8 call getchar(lineq,iccount,durq) @@ -12396,11 +13245,16 @@ c end if end if else if (index('fsn',durq) .gt. 0) then - if (nacc(ivx,nnl(ivx)) .eq. 0) then +c +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c May have set other bits earlier + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then c c No accid set yet c - nacc(ivx,nnl(ivx)) = index('fsn',durq) +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) else c c Symbol must be repeated, so it's a double @@ -12541,7 +13395,6 @@ c ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) go to 2 -c else if (durq .eq. 'S') then else if (index('LS',durq) .gt. 0) then c c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 @@ -12629,6 +13482,16 @@ c iccount = iccount-1 end if go to 2 + else if (durq .eq. 'T') then + call getchar(lineq,iccount,durq) + multtrem = index('1234',durq) + if (multtrem .eq. 0) then + iccount = iccount-1 + multtrem = 1 + end if + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4) + call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1) + go to 2 else if (durq .ne. ' ') then print*,'Illegal character in note: ',durq,', ivx,nn:', * ivx,nnl(ivx) @@ -12652,6 +13515,17 @@ c Set level for preslur on normal note, non-chord c call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) 43 continue +c +c Only matters if last note, non-rest of xtuplet +c + nnb = nnb+1 + end if +c +c Set flag for unbeamed xtup if it just has 1 note +c + if (inxtup .and. nnb.eq.1) then +c ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19) + islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18) end if if (idotform .gt. 0) then if (idotform .eq. 1) then @@ -13441,9 +14315,18 @@ c ncmidcc(iv,ncc(iv)) = ncmidf(durq) if (durq .eq. '8') then ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) + lastlev = lastlev+7 else - if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0 +c +c This won't work if you really had an octave transposition with some +c other clef. Need a check on whether prior clef was an octave clef. +c + if (iTransAmt(instno(iv)).eq.7) then + iTransAmt(instno(iv))=iTransAmt(instno(iv))-7 + lastlev = lastlev-7 + print*,'Reset itransamt to ',iTransAmt(instno(iv)) + end if end if c c Set marker on note with lowest voice # starting at same time. @@ -13826,6 +14709,20 @@ c c Just eat the input; it was used in pmxa c go to 27 + else if (durq .eq. 'V') then + bottopgap = .true. + topamt = 0. + call getchar(lineq,iccount,durq) + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,botamt) + botamt = botamt*pmfac + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,topamt) + topamt = topamt*pmfac + iccount = iccount-1 + go to 27 end if if (index('NR',durq) .gt. 0) then c @@ -14308,14 +15205,14 @@ c to last character of most recent line sucked from buffer. c ipbufmod = points to last character of most recent inserted line c from pmx.mod c - parameter (maxblks=4000,nm=24) + parameter (maxblks=9600,nm=24) common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 logical lastchar,fbon,issegno,isheadr,isvolt character*(*)includeq character*80 pmxmoddirq character*128 lnholdq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq logical fexist,global @@ -15280,12 +16177,10 @@ c c c Forced multiplicity c -c mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22) call setbits(mult(ivx,iip),4,0, * igetbits(islur(ivx,nip1),3,22)+8) else if (.not.isxtup) then if (nodur(ivx,iip) .gt. 0) then -c mult(ivx,iip) = 4-log2(nodur(ivx,iip)) call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8) else c @@ -15305,7 +16200,6 @@ c multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)- * alog(nodur(ivx,iip)/2.))/0.69315)-10 do 74 iiip = iip1 , iip -c mult(ivx,iiip) = multx call setbits(mult(ivx,iiip),4,0,multx+8) c c Note the following still works after making mult only the 1st 4 bits. @@ -15367,13 +16261,13 @@ c c This is called when (a) macro recording is just starting and c (b) at the start of a new line, if recording is on c - parameter (maxblks=4000) + parameter (maxblks=9600) character*128 lineq,lnholdq common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), * ic1mac(20),ilmac,iplmac logical mrecord,mplay,endmac - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq lbuf(1) = lbuf(1) @@ -15443,7 +16337,7 @@ c logical upg,slurg,slashg,autofbon character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm), * numbms(nm),mapfb(16) real*4 xit(nm),t1xtup(20),tstart(80),squez(80) @@ -15843,21 +16737,6 @@ c end if 30 continue c -c Debug writes -c -c print* -c write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot) -c print*,'PMXB has now got blocks' -c write(*,'(16i5)')(istart(ib),ib=1,nb) -c write(*,'(16i5)')(istop(ib),ib=1,nb) -c write(*,'(16f5.1)')(space(ib),ib=1,nb) -c write(*,'(16f5.1)')(squez(ib),ib=1,nb) -c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) -cc write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048, -c * in=1,ntot) -c write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot) -c -c c Analyze for beams. c do 20 iv = 1 , nv @@ -16004,10 +16883,10 @@ c logical upg,slurg,slashg,issig,rpndot,autofbon character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) integer istart(80),istop(80),iaskb(nm),numbms(nm), * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2) - character*1 ulfbq,udqq,clefq(nm),slurudq + character*1 ulfbq,udqq,clefq(nm),slurudq,udq character*8 noteq character*79 cwrq(nm),notexq,inameq character*20 voltxtq @@ -16157,10 +17036,10 @@ c c if (clefq(ivxo(in)) .eq. '8') then if (btest(ipl(ivxo(in),ipo(in)),2)) then if (iv .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' end if end if @@ -16545,8 +17424,12 @@ c if (isaccs .or. iscacc) then ptsneed = ptsneed+taccfac*wheadpt1 end if - if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, +c if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, +c * esk,fixednew,scaldold,0.,.false.) + if (poenom*esk .lt. ptsneed) then + call addask(to(in),ptsneed, * esk,fixednew,scaldold,0.,.false.) + end if 99 continue if (btest(iornq(ivx,ip),26)) then c @@ -16758,7 +17641,6 @@ c c Check for new clef here. c if (isclef .and. btest(islur(ivx,ip),11)) then -c print*,'At clef insertion, ptclef:',ptclef(iv) if (ptclef(iv) .gt. 0.) then notexq = sq//'off{-' if (ptclef(iv) .lt. 9.95) then @@ -16771,7 +17653,6 @@ c print*,'At clef insertion, ptclef:',ptclef(iv) notexq = notexq(1:lnote)//'pt}' lnote = lnote+3 call addstr(notexq,lnote,soutq,lsout) -c print*,'Just added: ',notexq(1:lnote) end if call clefsym(islur(iv,ip),notexq,lnote,nclef) c @@ -17050,7 +17931,28 @@ c Clumsy test, but vxtup is not set until main note is processed. c if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then nodu = nodur(ivx,ip) -c else if (mult(ivx,ip) .lt. 0) then +cc else if (iand(mult(ivx,ip),15)-8 .lt. 0) then +c else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or. +c * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or. +c * (ip.gt.1.and.btest(irest(ivx,ip-1),2) +c * .and.nodur(ivx,ip).eq.32)) then +c nodu = 32 +c else +c nodu = 16 +c end if + else if (btest(irest(ivx,ip),2) .or. + * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then +c +c In a 2-note tremolo +c + if (btest(irest(ivx,ip),2)) then +c +c First note of tremolo, duration is on next note +c + nodu = nodur(ivx,ip+1) + else + nodu = nodur(ivx,ip) + end if else if (iand(mult(ivx,ip),15)-8 .lt. 0) then nodu = 32 else @@ -17059,7 +17961,8 @@ c else if (mult(ivx,ip) .lt. 0) then call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout, * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv, * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen, - * btest(nacc(ivx,ip),27),nacc(ivx,ip)) + * btest(nacc(ivx,ip),27),nacc(ivx,ip), + * irest) end if c c Now that chords are done, add stuff to midi file @@ -17179,7 +18082,9 @@ c end if end if c -c Check for dotted notes with moved dots +c Check for dotted main notes with moved dots. Chord notes done elsewhere. +c Added check rules out special chordal 2nds, but later must check +c substituted chord note for dot shift that now applies to main note. c if (btest(irest(ivx,ip),19)) then ndotmv(ivx) = ndotmv(ivx)+1 @@ -17290,106 +18195,58 @@ c Conditions are 0. This is a non-blank rest c 1. kbdrests = .true. c 2. There are two voices on the staff c 3. No user-def height adjustments have been applied (nolev<50) -cc 4. Not last note in bar -cc 5. Followed by note (add better test later) c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. -c * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) -c * .and. .not.(btest(irest(ivx,ip+1),0))) then * nolev(ivx,ip).le.50) then + call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, + * mult,ipl) + end if + if (btest(ipl(ivx,ip),4)) then c -c 130127 Replaced following code with a subroutine +c Deal with single stem tremolo +c Get up-downness, borrowed from notex c -cc Get reference level: next following note if no intervening blank rests, -cc otherwise next prior note. -cc -cc levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line -c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then -cc -cc Not the last note and not "look-left" for level -cc -c do 8 kkp = ip+1 , nn(ivx) -c if (btest(islur(ivx,kkp),29)) go to 4 -c if (.not.btest(irest(ivx,kkp),0)) then -c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line -c go to 9 -c end if -c8 continue -c end if -c4 continue -cc -cc If here, there were no following notes or came to a blank rest, or -cc "look-left" option set. So look before -cc -c if (ip .eq. 1) go to 2 ! Get out if this is the first note. -c do 3 kkp = ip-1, 1, -1 -c if (.not.btest(irest(ivx,kkp),0)) then -c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line -c go to 9 -c end if -c3 continue -c go to 2 ! Pretty odd, should never be here, but get out if so. -c9 continue -cc -cc Find note in other voice at same time -cc -c iupdown = sign(1,ivx-nv-1) -c ivother = ivmx(iv,(3-iupdown)/2) -c tother = 0. -c do 5 kkp = 1 , nib(ivother,ibar) -c if (abs(tother-tnow) .lt. tol) go to 6 -c tother = tother+nodur(ivother,kkp) -c5 continue -cc -cc If here, then no note starts in other voice at same time, so set default -cc -c levother = -iupdown*50 -c go to 7 -c6 continue -cc -cc If here, have just identified a simultaneous note or rest in other voice -cc -c if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it -c levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 -c else -c if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then -cc -cc Rest in other voice has same duration, get out (so defualt spacing is used) -cc -c go to 2 -c end if -c levother = -iupdown*50 -c end if -c7 continue -c indxr = log2(nodur(ivx,ip))+1 -c if (iupdown .lt. 0) then -c levtop = levtopr(indxr) -c iraise1 = levother-levtop-3 ! Based on other note -c iraise2 = levnext-levtop ! Based on following note -c if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 -c iraise = min(iraise1,iraise2) -c if (mod(iraise+50,2).eq.1 .and. -c * iraise+levtop.gt.-1) iraise = iraise-1 -c else -c levbot = levbotr(indxr) -c iraise1 = levother-levbot+3 -c iraise2 = levnext-levbot -c if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 -c iraise = max(iraise1,iraise2) -c if (mod(iraise+50,2).eq.1 .and. -c * iraise+levbot.le.9) iraise = iraise-1 -c end if -c nolev(ivx,ip) = 100+iraise + if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv).eq.'u') then + udq = 'u' + else + udq = 'l' + end if + multtrem = igetbits(ipl(ivx,ip),2,5)+1 + if (nodur(ivx,ip) .lt. 64) then + notexq = sq//'tr' + else + notexq = sq//'Tr' + end if + lnote = 3 + if (multtrem .eq. 2) then + notexq = notexq(1:3)//'r' + lnote = 4 + else if (multtrem .eq.3) then + notexq = notexq(1:3)//'rr' + lnote = 5 + end if c -c The new subroutine call, to replace above code +c Get a numerical pitch argument c - call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, - * mult,ipl) + lineno = nolev(ivx,ip)-ncmid(iv,ip)+4 + if (lineno .lt.0 .or. lineno .gt.9) then + write(noteq,'(a1,i2,a1)')'{',lineno,'}' + lnoten = 4 + else + noteq = char(lineno+48) + lnoten = 1 + end if + notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten) + lnote = lnote+2+lnoten + call addstr(notexq,lnote,soutq,lsout) end if c -c Write a separate note or rest +c Get code for a separate note or rest +c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), +c pitch will be shifted +/-1 inside notex. c call notex(notexq,lnote) end if @@ -17401,8 +18258,9 @@ c else if (btest(ipl(ivx,ip),9)) then call addstr(sq//'roff{',6,soutq,lsout) end if - if (ixrest(ivx).eq.0 .and. lnote.gt. 0) - * call addstr(notexq,lnote,soutq,lsout) + if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then + call addstr(notexq,lnote,soutq,lsout) + end if if (btest(ipl(ivx,ip),8) .or. * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) c @@ -17815,7 +18673,7 @@ c i.e., with squez=1. Use after parsing into line to decide if c spacing needs to be "flattened" among notes groups. c common /comtol/ tol - parameter (nm=24,nkb=3999,maxblks=4000) + parameter (nm=24,nkb=3999,maxblks=9600) common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, * nbars,itsofar(nm),nib(nm,15),nn(nm), @@ -18117,13 +18975,13 @@ c c This is called when (a) macro recording is just starting and c (b) at the start of a new line, if recording is on c - parameter (maxblks=4000) + parameter (maxblks=9600) character*128 lineq,lnholdq common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac logical mrecord,mplay,endmac common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), * ic1mac(20),ilmac,iplmac - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq if (.not.mrecord) then @@ -18165,7 +19023,7 @@ c character*1 ulq,sepsymq,sq logical beamon,firstgulp,figbass,figchk,isfig common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /commvl/ nvmx(nm),ivmx(nm,2),ivx common /comtol/ tol if (ncc(iv) .eq. 1) then @@ -18187,23 +19045,6 @@ c c Return middle line of a clef c character*1 clefq -c if (clefq.eq.'t' .or. clefq.eq.'0') then -c ncmidf = 35 -c else if (clefq.eq.'s' .or. clefq.eq.'1') then -c ncmidf = 33 -c else if (clefq.eq.'m' .or. clefq.eq.'2') then -c ncmidf = 31 -c else if (clefq.eq.'a' .or. clefq.eq.'3') then -c ncmidf = 29 -c else if (clefq.eq.'n' .or. clefq.eq.'4') then -c ncmidf = 27 -c else if (clefq.eq.'r' .or. clefq.eq.'5') then -c ncmidf = 25 -c else if (clefq.eq.'f' .or. clefq.eq.'7') then -c ncmidf = 37 -c else -c ncmidf = 23 -c end if if (clefq .eq. '8') then c c treblelowoct; will treat as treble for this purpose @@ -18232,7 +19073,7 @@ c * tautofb,autofbon,t1autofb character*1 ulfbq,clefq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) logical change,autofbon nvmx(jv) = 1 @@ -18480,20 +19321,14 @@ c restq =sq//'qqs' lrest = 4 end if -c if (2**log2(nodu) .ne. nodu) then -cc -cc One or two dots on rest -cc -c restq = restq(1:3)//'p' -c lrest = 4 -c if (2*nodu .gt. 3*2**log2(nodu)) then -cc -cc Double dotted rest -cc -c restq = restq(1:4)//'p' -c lrest = 5 -c end if -c end if +c +c Special case for rest at start of F-tuplet inside a forced beam +c + if (btest(nacc(ivx,ip),18) .and. + * btest(nacc(ivx,ip),19)) then + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if notexq = restq lnote = lrest c @@ -18513,19 +19348,8 @@ c notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' end if lnote = 16+lnoten -c if (2**log2(nodu) .ne. nodu) then -cc -cc Have dot in raised rest. must put in hbox! -cc -c notexq = notexq(1:lnote)//sq//'hbox{' -c lnote = lnote+6 -c end if notexq = notexq(1:lnote)//restq(1:lrest) lnote = lnote+lrest -c if (2**log2(nodu) .ne. nodu) then -c notexq = notexq(1:lnote)//'}' -c lnote = lnote+1 -c end if end if if (2**log2(nodu) .ne. nodu) then c @@ -18561,9 +19385,6 @@ c * (nole.lt.0.or.nole.gt.8)) then * sq//'hbox{'//restq(1:lrest)//'}' lrest = lrest+23 end if - - - notexq = restq(1:lrest)//notexq(1:lnote) lnote = lnote+lrest end if @@ -18803,9 +19624,9 @@ cc Correct fsyst to account for transposition and key changes. cc Check for nbars > nsyst cc ccccccccccccccccccccccccccccccccccc - parameter (nm=24,nkb=3999,nks=125,maxblks=4000) + parameter (nm=24,nkb=3999,nks=125,maxblks=9600) logical loop,usefig,isfirst,optimize - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq integer nn(nm),nodur(nm,200),ivxo(600),ipo(600), @@ -18854,8 +19675,12 @@ c logical mrecord,mplay,endmac,gotclef,cstuplet * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans logical fulltrans + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset data wtimesig,wclef,wkeysig * / 0.72 , 0.8 , 0.28 / + is4bignv = .false. + AIset = .false. whead20 = 0.3 if (.not.optimize) then print* @@ -19399,7 +20224,6 @@ c * 'In system #',isyst,' cannot meet min. space rqmt' c c Find eonk by Newton method c -c eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1, * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax, * (wminpt-elmin0)/(elmin1-elmin0)) @@ -19556,7 +20380,7 @@ cc Admit "RD" before "/" (search for "rptfq2:" ) cc In doslur, for multi-line staves, single notes, check forced stem dir'n cc before setting stemup (used to set horiz offset). ccccccccccccccccccccccccccccccc - parameter (nm=24,nks=125,mv=24576,maxblks=4000) + parameter (nm=24,nks=125,mv=24576,maxblks=9600) c c FYI /all/ differs in appearance in function ncmid c @@ -19604,20 +20428,19 @@ c 31 If on, suppress printing number with xtuplet starting here ccccccccccccc cc ipl cc ccccccccccccc -cc 0-7 Location in list [0,200] -cc 0-7 Unused c 0 blank barline (must be iv=1) (would have used islur but no room) c 1 look left for K rests, moved here from iornq(30) c 2 treblelowoct -cc 2-7 Unused -c 3-7 unused +c 3 Open notehead in forced beam xtup +c 4 Set if single stem tremolo +c 5-6 termulo multiplicity - 1 +c 7 unused c 8 left offset main note one headwidth c 9 right offset main note one headwidth c 10 chord present? c 11-16 Forced beam height adjustment (-30 to +30) c 17-22 Forced beam slope adjustment (-30 to +30) c 23-26 Slur index for Way-after grace. Inserted when slur is started. -cc 27 Unused? c 27 5th bit for slur index for Way-after grace (100712) c 28 key change: only in voice 1 c 29 Grace after main note. (Type A) @@ -19655,8 +20478,9 @@ cc irest cc ccccccccccccc c 0 rest=1, no rest = 0 c 1 There will be a vertical shift for number of this xtup -c Moved hgt shft to mult 16-22, so could span -64,64. -cc 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n' +c 2 Set if 2-note tremolo starts here +c 3-4 nsolid, # of solid beams in 2-note tremolo +c 5-6 nindent, # of indented beams in 2-note tremolo c 7 There is a horizontal shift for xtup number c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 c 14 Flip up/down-ness of xtup number @@ -19782,7 +20606,7 @@ c c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. c cccccccccccccccccccccccccccccccc - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq character*10 figq @@ -19794,7 +20618,7 @@ cccccccccccccccccccccccccccccccc logical loop,lastchar,slint,svolta,evolta,onvolt, * cwrest(nm),islast,inlast,optimize integer istop(80),numbms(nm),istart(80) - real*4 xnsttop(40),xintstaff(40),hesk(23),hpts(23),poevec(nks), + real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks), * tstart(80),squez(80) character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq character*79 notexq,inameq @@ -19821,7 +20645,7 @@ cccccccccccccccccccccccccccccccc * rptprev,equalize,rptfq1,rptfq2 common /combeam/ ibmtyp common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, * OptLineBreakTies,HeaderSpecial common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, @@ -19851,7 +20675,7 @@ cccccccccccccccccccccccccccccccc * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb, * btest,sluron,setis,nobar1 common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /compoi/ ispoi common /combc/ bcspec common /comeon/ eonk,ewmxk @@ -19901,6 +20725,14 @@ cccccccccccccccccccccccccccccccc logical newclef, centrests common /comlyr/ inputmlyr logical inputmlyr + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comhair/ idhairuse,idhair(nm) + bottopgap = .false. + inputmlyr = .false. + idhairuse = 0 if (.not.optimize) then print* print*,'Starting second PMX pass' @@ -20191,6 +21023,7 @@ c nvolt = 0 do 28 iv = 1 , nm nudoff(iv) = 0 + maxdotmv(iv) = ndotmv(iv) ndotmv(iv) = 0 28 continue c @@ -20387,10 +21220,10 @@ c c if (clefq(iv) .eq. '8') then if (btest(ipl(iv,ioff+1),2)) then if (iv .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' end if else @@ -20843,6 +21676,21 @@ c second pass, vshrink at top of page one is dealt with in topfile, which is ca c *before* any reading in any "Av" at the top of the first input block. c if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if xnstbot = xnsttop(ipage)*etabot/etatop if (xnstbot .lt. 9.95) then fmtq = '(a,f3.1,a)' @@ -20851,6 +21699,22 @@ c end if if (islast) write(11,fmtq)sq//'vskip',xnstbot, * sq//'Interligne'//sq//'eject%' + if (islast .and. bottopgap) then + if (abs(topamt) .gt. 1.e-6) then + if (topamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (topamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (topamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',topamt, + * sq//'Internote%' + end if + bottopgap = .false. + end if else if (islast) write(11,'(a)') sq//'vfill'//sq//'eject%' end if @@ -20878,6 +21742,7 @@ c c c Vertical spacing parameters, then restart c + if (is4bignv) xinsnow = .95*xinsnow if (islast) write(11,fmtq)sq//'interstaff{',xinsnow, * '}'//sq//'contpiece' c @@ -21162,8 +22027,6 @@ c ipl(ivx,ip) = ipl(ivx,ip+ioff) iornq(ivx,ip) = iornq(ivx,ip+ioff) mult(ivx,ip) = mult(ivx,ip+ioff) -c if (ivx.le.2 .and. figbass) -c * isfig(ivx,ip) = isfig(ivx,ip+ioff) if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then if (ivx.eq.1) then isfig(1,ip) = isfig(1,ip+ioff) @@ -21204,7 +22067,6 @@ c * iptrill(it)+nib(ivtrill(it),ibar-2) 22 continue do 27 icrd = 1 , ncrd -c ivx = iand(15,ishft(icrdat(icrd),-8)) ivx = iand(15,ishft(icrdat(icrd),-8)) * +16*igetbits(icrdat(icrd),1,28) ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1) @@ -21213,7 +22075,6 @@ c ivx = iand(15,ishft(icrdat(icrd),-8)) icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd)) 27 continue do 29 iudorn = 1 , nudorn -c ivx = iand(15,ishft(kudorn(iudorn),-8)) ivx = ivxudorn(iudorn) ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1) if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) @@ -21222,7 +22083,6 @@ c ivx = iand(15,ishft(kudorn(iudorn),-8)) 29 continue do 42 idyn = 1 , ndyn idynd = idyndat(idyn) -c ivx = iand(15,idynd) ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10) ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) c @@ -21237,9 +22097,7 @@ c 42 continue do 43 itxtdyn = 1 , ntxtdyn idynd = ivxiptxt(itxtdyn) -c ivx = iand(15,idynd) ivx = iand(31,idynd) -c ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1) if (ibar .gt. 2) then ipnew = ipnew+nib(ivx,ibar-2) @@ -21261,7 +22119,6 @@ c call setbits(idynd,8,4,ipnew) isdat1(isdat) = isdata 41 continue do 44 ibc = 1 , nbc -c ivx = iand(15,ibcdata(ibc)) ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1) if (ibar .gt. 2) then @@ -21397,7 +22254,6 @@ c else if (rptfq2 .eq. 'z') then if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece' else -c else if (rptfq2 .ne. 'D') then print* print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 @@ -21407,6 +22263,21 @@ c else if (rptfq2 .ne. 'D') then if (islast) write(11,'(a)')sq//'Endpiece' end if if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if xnstbot = xnsttop(ipage)*etabot/etatop if (xnstbot .lt. 9.95) then fmtq = '(a,f3.1,a)' @@ -21763,9 +22634,6 @@ c c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) invert = -levbot+4+nolev-ncm -c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' -c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), -c *levbot,nolev,ncm end if c c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote @@ -22631,11 +23499,10 @@ c c c Only print number when wanted. First check vert, horiz offset c -c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64 if (btest(irest,7)) eloff = eloff+ * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom - if (.not.usexnumt) then + if (.not.usexnumt) then notexq = chax(92)//'xnum{' lnote = 10 istrtn = 7 @@ -22668,8 +23535,8 @@ c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 return end subroutine read10(string,lastchar) - parameter (maxblks=4000) - character*65536 bufq + parameter (maxblks=9600) + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq character*(*) string @@ -22869,11 +23736,6 @@ c c Sets iwidbits of isdata, shifted by ishift, to ivalue c ibase = 2**iwidbit-1 - if (ivalue.gt.ibase) then - print* - print*,'WARNING in setbits: ivalue > ibase' - write(15,'(/,a)')'WARNING in setbits: ivalue > ibase' - end if isdata = iand(not(ishft(ibase,ishift)),isdata) isdata = ior(isdata,ishft(ivalue,ishift)) return @@ -22976,9 +23838,6 @@ c call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, * 'Macro number not in range 1-20!') call stop1() -c else if (btest(macuse,macnum)) then -c print* -c print*,'WARNING: Redefining macro # ',macnum end if macuse = ibset(macuse,macnum) if (charq .eq. 'R') then @@ -23038,6 +23897,12 @@ c else ibmrep = 2*mtrnuml/mtrdenl end if + else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then +c +c Added 170726 +c + ibmtyp = 1 + ibmrep = mtrnuml/4 else c c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 @@ -23168,11 +24033,12 @@ c Reset nxtinbm for use as counter as #'s are posted by putxtn(..) c nxtinbm(ivx) = 0 smed = 0. - if (.not.btest(islur(ivx,ipb(1)),2)) then +c if (.not.btest(islur(ivx,ipb(1)),2)) then + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then c c No forced 0 slope c - if (nnb .eq. 1) go to 6 +c if (nnb .eq. 1) go to 6 nsc = 0 do 5 inb = 1 , nnb-1 do 5 jnb = inb+1 , nnb @@ -23245,12 +24111,10 @@ c if (ulq(ivx,ibc) .eq. 'u') iul = 1 ssq = 0. syb = 0. -c yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) yb1 = nolev1(ivx) * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)) do 4 inb = 1 , nnb ybeam = yb1+islope(ivx)*xelsk(inb)/slfac -c * -iul*bmhgt*(mult(ivx,ipb(inb))-1) * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1) syb = syb+ybeam ynote = nolev(ivx,ipb(inb)) @@ -23275,7 +24139,9 @@ c * -iul*bmhgt*(mult(ivx,ipb(inb))-1) ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2 if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and. * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax) - * .and. .not.btest(islur(ivx,ipb(1)),2)) then +c * .and. .not.btest(islur(ivx,ipb(1)),2)) then + * .and. .not.btest(islur(ivx,ipb(1)),2) + * .and. nnb.ne.1) then c c The first check is to save trouble of putting xtup's in setbm2. c The penultimate check is that first and last stems aren't both excessive. @@ -23286,7 +24152,6 @@ c c c Check if beam starts or ends too high or low. c -c xboff = bmhgt*(mult(ivx,ipb(1))-1) xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1) l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0. xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb) @@ -23304,7 +24169,8 @@ c c c Since one or the other end has changed, need to change slope c - if (.not.btest(islur(ivx,ipb(1)),2)) +c if (.not.btest(islur(ivx,ipb(1)),2)) + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1) * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb)) end if if (nssb(ivx) .gt. 0) then @@ -23407,6 +24273,13 @@ c Make t[ID] look like s[ID]t c isdat2(nsdat) = ibset(isdat2(nsdat),3) end if + if (lineq(iccount+1:iccount+1).eq.'x') then +c +c Flag for 2-voice, indexed slurs +c + iccount = iccount+1 + call setbits(isdat1(nsdat),1,1,1) + end if end if call setbits(isdat1(nsdat),7,19,idcode) c @@ -23415,7 +24288,9 @@ c do 2 isdat = nsdat-1 , 1 , -1 if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. * iv .eq. igetbits(isdat1(isdat),5,13) .and. - * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then +c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then + * (kv-1 .eq. igetbits(isdat1(isdat),1,12) + * .or. btest(isdat1(isdat),1))) then c c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. c @@ -23829,6 +24704,8 @@ c * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans common /comsize/ isize(nm) + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset sq = chax(92) vshrink = xinstf1.gt.20. .and. .not.novshrinktop if (vshrink) then @@ -23948,7 +24825,7 @@ c clefqiv = clefq(iv) if (clefqiv.eq.'8') then clefqiv='t' - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) end if if (nstaves .eq. 1) then fmtq = chax(48+numclef(clefq(iv))) @@ -24011,8 +24888,10 @@ c else fmtq = '(a,f4.1,a)' end if + facis = 1. + if (is4bignv) facis = .95 write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt' - * //sq//'interstaff{',xinstf1,'}'//sq//'relax' + * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax' else write(11,'(a)')sq//'stafftopmarg0pt'// * sq//'staffbotmarg5'//sq//'Interligne'//sq// @@ -24104,7 +24983,7 @@ c upcaseq = chq print*,'Warning, upcaseq was called with improper argument: ' * //chq - stop + stop end if return end @@ -24266,25 +25145,6 @@ c kv = 1 end if c -c Moved to pmxab to allow midivel, bal, tran as functions of instrument -c rather than staff (iv) -cc -cc Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) -cc -c nstaves = 0 -c ivt = 0 -c do 12 iinst = 1 , nm -c nstaves = nstaves+nsperi(iinst) -c do 13 ivtt = 1 , nsperi(iinst) -c ivt = ivt+1 -c iinsiv(ivt) = iinst -c13 continue -c if (nstaves .eq. nv) go to 14 -c12 continue -c print*,'Screwup!' -c call stop1() -c14 continue -c do 5 icm = 0 , numchan-1 c c Get the number of bytes in the data stream @@ -24294,10 +25154,8 @@ c ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec) 11 continue c -cc Add 3 (for instrum) plus 4 (for closing) to byte count, c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, c -c ndata = ndata+7 ndata = ndata+11 c c Add 4+lnam(iinsiv(iv)) if lnam>0 , @@ -24543,7 +25401,7 @@ c (unless preceded with '\'), check length c character*128 lineq,lineqt character*1 sq - data sq /'\'/ + sq = '\' iend = lenstr(lineq,128) c c i2nd = iccount+index(lineq(iccount+1:128),'"') diff --git a/Build/source/utils/pmx/pmx-src/pmx276.for.orig b/Build/source/utils/pmx/pmx-src/pmx284.for.orig index 0ef9353f24d..2e331296c98 100644 --- a/Build/source/utils/pmx/pmx-src/pmx276.for.orig +++ b/Build/source/utils/pmx/pmx-src/pmx284.for.orig @@ -63,6 +63,39 @@ c Undotted chord notes with dotted main note. c Forced line break without line number c Fix dot moving when 2nds in chord get flipped c To do: increase length on notexq in dodyn +c 2.84 +c Bug fix: dots in chordal seconds +c Bug fix: Initialize ihornb for non-beamed, down xtup +c Bug fix: When using "AT" with 2-note x3c rD. +c 2.83 +c Fix problems when changing to or from octave treble clef. +c Fix beaming (or not) and number location for xtups with +c multiple rests. Still some problems with number height but +c can be band-aided with number height tweak option. +c Tweak error messages for options on "R" command. +c Allow forced beam height and slope tweaks with 2-note tremolos +c Allow chordal note with 2-note tremolos, adding dots as needed. +c Fix call to ncmid in beamstrt when setting start height for beam of +c 2-note trem, by changing arg from ivx to iv +c 2.82 +c bugfix: beams with rests, not confused with xtups. +c x option after slur index to allow slurs to go from one voice to another. +c x option also for ties +c 2.81 +c Allow string of rests to end xtup +c in chordal half-note 2-note tremolo, make chord notes open. +c 2.80 +c Add 2-note tremolos +c 2.78 +c Expand bufq to 131072 bytes +c Expand maxblks tp 9600 +c Allow up to 75 pages +c Index postscript hairpins from 1 up instead of by voice #. +c Add option 'o' to forced beam for open notehead (\hb); set ipl(3) +c Add option T[n], n=1,2,3 for single stem tremolo +c 2.77 +c Enable AV+/-x+/-y to add vskip bigh before or after \eject +c 2.76 c 2.75 c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and c 2 or 3 flags on shortened note. @@ -717,9 +750,9 @@ c Command line input c Option Ao to optimize, otherwise normal processing c ccccccc - parameter (nks=125,nm=24,mv=24576,maxblks=4000) + parameter (nks=125,nm=24,mv=24576,maxblks=9600) character*128 lnholdq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /comevent/ miditime,lasttime logical slmon,dbltie @@ -769,8 +802,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording). c ccccccccccccccccccccccccc c - data date /'24 Nov 16'/ - data version /'2.76'/ + data date /'10 Feb 18'/ + data version /'2.84'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -908,7 +941,7 @@ c else linewcom(1) = 1+ncomments end if - if (ipbuf+lbuf(ilbuf).gt.65536) then + if (ipbuf+lbuf(ilbuf).gt.131072) then print*,'Too many characters in file, stopping' call stop1() end if @@ -1006,11 +1039,6 @@ c c Check to see if (1) last line is "<blank><blank>/" and (2) next to last c line is "/" c -c print*,'iplast:',iplast -c print*,'Last line:' -c print*,bufq(iplast+1-lbuf(nlbuf):iplast) -c print*,'Last char of next to last line:' -c print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)) if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then print*,'Removing last line of "<blank><blank>/"' @@ -1109,9 +1137,6 @@ c write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst) call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize) call pmxb(.true.,poe0,ncalls,optimize) -c itend = mytime() -c print*,'Elapsed time in ms:',itend-itstart -c write(15,*)'Elapsed time in ms:',itend-itstart close(15) end subroutine accsym(nacc,acsymq,lacc) @@ -1573,9 +1598,6 @@ c if (endrest) then return end if -c -c print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time -c 8 continue naccbl(icm) = nusebl if (nusebl .gt. 0) then @@ -1883,6 +1905,7 @@ c character*79 notexq ip = ipo(jn) multip = iand(mult(ivx,ip),15)-8 + lnote = 0 if (ixrest(ivx) .eq. 4) then c c This is the LAST note in the xtup (i.e., all rests before). Make single. @@ -1901,10 +1924,79 @@ c else if (btest(nacc(ivx,ip),31)) then nole = nole + 1 end if +c +c Terminate indented beams for 2-note tremolo if needed +c + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) + addoff = addoff+.0822*islope(ivx) + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 + end if if (.not.drawbm(ivx)) then c c Xtuplet with no beam, just put in the right kind of note c + if (btest(irest(ivx,ip),0)) then +c +c Rest at end of unbeamed xtup +c + lnote = 3 + if (btest(islur(ivx,ip),29)) then + notexq = sq//'sk' +c +c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for +c a blank rest ending xtup, but hopefully returning from here will handle it. +c + return + else if (multip .eq. 0) then + notexq = sq//'qp' + else if (multip .eq. -1) then + notexq = sq//'hp' + else if (multip .eq. 1) then + notexq = sq//'ds' + else if (multip .eq. 2) then + notexq = sq//'qs' + else + notexq = sq//'hs' + end if +c +c 180106 Deal with possible level tweak +c + nole = mod(nolev(ivx,ip)+50,100)-50 + if (nole .ne. 0) then + if (abs(nole) .lt. 10) then + noteq = chax(48+abs(nole)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole) + lnoten = 2 + end if + if (nole .gt. 0) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + end if if (btest(islur(ivx,ip),30)) then c c Forced stem direction @@ -1918,29 +2010,180 @@ c else call notefq(noteq,lnoten,nole,ncmid(iv,ip)) if (lnoten .eq. 1) call addblank(noteq,lnoten) - lnote = lnoten+3 +c +c To reduce confusion due to this early update of lnote, do it +c below, separately in each case/ +c lnote = lnoten+3 if (.not.btest(nacc(ivx,ip-1),27)) then c c Prior note is not regular-dotted c - + if (btest(irest(ivx,ip-1),2) .and. + * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then +c +c Unbeamed tremolo with indented beams. Put termination in right here +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + addoff = -1-.5*nindent + else + addoff = 1+.5*nindent + endif +c +c Is there an islope here, for unbeamed? +c + if (addoff .lt. -.05) then + write(tempq,'(f4.1)')addoff + else + write(tempq,'(f4.2)')addoff + end if + notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq// + * 'hbox{' + * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))// + * '0}}' + lnote = 46 +c write(11,'(a)')notexq(1:lnote) + end if if (multip .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq +c if (btest(irest(ivx,ip-1),2)) then + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).gt.24) then +c +c 2nd note of unbeamed half-note trem; make open +c But it's not clear if unbeamed half-note tremolo is Kosher, +c so don't worry about stem lengths here now. +c + if (lnote .eq. 0) then + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + else + notexq = notexq(1:46)// + * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + lnote = 46 + end if + else + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then +c +c Need a dot. +c + lnote = 46 + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if +c +c Insert stemlength stuff here for unbeamed dotted tremolo. +c May later combine with below to avoid repeat. But need to +c return to normal stem length after note is set. +c + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote) + lnote = lnote+10 + end if + if (lnote .eq. 0) then + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + * //noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'q' + * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + if (btest(irest(ivx,ip-1),2) .and. + * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then + notexq = notexq(1:lnote)//sq//'slz' + lnote=lnote+4 + end if + end if + else if (btest(irest(ivx,ip-1),2)) then +c +c 2nd note of unbeamed quarter or 8th trem; make quarter note +c Get stemlength change +c + lnote = 46 + nindent = igetbits(irest(ivx,ip-1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7) + * *islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = notexq(1:46)//sq//'slx{'//tempq//'}' + lnote = lnote+10 +c if (lnote .eq. 0) then +c notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq +c else +c notexq = notexq(1:46)// +c * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq +c end if +c +c +c Check for dotted unbeamed tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if + notexq = notexq(1:lnote)// + * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) +c * //sq//'stemcut' + * //sq//'slz' +c lnote=lnote+3+lnoten+8 + lnote=lnote+3+lnoten+4 else if (multip .eq. -1) then - notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. 1) then - notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq + notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. 2) then - notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnote+1 + notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+4 else if (multip .eq. 3) then - notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq - lnote = lnote+2 + notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) + lnote = lnoten+5 else if (multip .eq. -2) then - notexq = sq//'wh'//noteq + notexq = sq//'wh'//noteq(1:lnoten) + lnote = lnoten+3 else if (multip .eq. -3) then - notexq = sq//'breve'//noteq - lnote = lnote+3 + notexq = sq//'breve'//noteq(1:lnoten) + lnote = lnoten+6 else print* print*,'(Error in beamend, send source to Dr. Don)' @@ -1957,17 +2200,27 @@ c else if (multip .eq. -2) then notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq end if + lnote = lnoten+3 end if end if - return + return end if - call notefq(noteq,lnoten,nole,ncmid(iv,ip)) - lnote = 0 +c +c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just +c skipping the call in that case. +c + if (.not.btest(irest(ivx,ip),0)) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + end if +c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) +c lnote = 0 c c New way, with flipend, which was computed in beamstrt. c - if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) - * ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then + ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx)))) + flipend(ivx) = .false. + end if if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then c c This is not a one-noter from beam-jump. Check if multiplicity has increased @@ -2012,14 +2265,67 @@ c if (.not.btest(irest(ivx,ip),23)) then c c This is either a normal beamend or end of a sequence of jump-beam segments, +c (170409) or rest at end of xtup c so some sort of termination is required c ulqq = ulq(ivx,ibmcnt(ivx)) if (.not.isbjmp .or. ivx.ne.ivbj2) then + if (btest(irest(ivx,ip),0)) then +c +c Xtup ends with rest +c + if (multip .eq. 1) then + notexq = sq//'ds' + lnote = 3 + else if (multip .eq. 2) then + notexq = sq//'qs' + lnote = 3 + else if (multip .eq. 3) then + notexq = sq//'hs' + lnote = 3 + end if +c +c 170801 Borrowed from main rest entry way down below to get level adjustment: +c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? +c "... Now raise if necc." +c + if (btest(islur(ivx,ip),29)) then +c +c Blank rest +c + notexq = sq//'sk' + lnote = 3 + else if (nole .ne. 0) then +c +c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with +c nolev=-4 but expected 100+/-. Try to fix. +c + if (abs(nole).lt.30) nole = 100+nole +c + if (abs(nole-100) .lt. 10) then + noteq = chax(48+abs(nole-100)) + lnoten = 1 + else + write(noteq(1:2),'(i2)')abs(nole-100) + lnoten = 2 + end if +c ??? if (nole .gt. 0) then + if (nole .gt. 100) then + notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + else + notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' + * //notexq(1:lnote) + end if + lnote = 16+lnoten+lnote + end if + return + else c c Normal termination c - call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) + call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote) + end if else c c Terminate a sequence of jump-beam segments. @@ -2038,12 +2344,50 @@ c if (isbjmp.and.ivx.eq.ivbj2 return end if c -c And now the note +c And now the note, checking for open-head beamed tremolo c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' - else - notexq = sq//'qb' + if (btest(irest(ivx,ip-1),2)) then +c +c Check for dotted tremolo +c + if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then +c +c Need a dot +c + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes? + end if + if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if + else + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if + end if + else +c +c No tremolo +c + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if end if lnote = lnote+3 isdotm = .false. @@ -2063,10 +2407,8 @@ c 5/25/08 Allow >12 c 5/9/10 Up to 24; replace 24 with 0 c if (.not.(isbjmp.and.ivx.eq.ivbj2)) then -c call istring(mod(ivx,12),tempq,len) call istring(mod(ivx,24),tempq,len) else -c call istring(mod(ivbj1,12),tempq,len) call istring(mod(ivbj1,24),tempq,len) end if if (isbjmp .and. ivx.eq.ivbj2 @@ -2263,7 +2605,6 @@ c call putxtn(mprint,iflop,multip,iud,wheadpt,poenom, * nolev1(ivx),islope(ivx),slfac, * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum, -c * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.) * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip), * mult(ivx,ip),.false.) end if @@ -2287,10 +2628,43 @@ c call notefq(noteq,lnoten,nole,ncmid(iv,ip)) end if c +c Check for string of rests up to and including last note in xtup. +c +c Replace next 2 lines to keep from doing this block +c when in second part of staff-jumping chordal xtup. This fix could +c break some unaccounted non-chordal staff-jum xtup situations. +c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. +c * .not.btest(irest(ivx,ip),0)) then + if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. + * .not.btest(irest(ivx,ip),0) .and. + * .not.(isbjmp.and.ivx.eq.ivbj2)) then +c +c This note is not a rest but next is a rest. Do rests continue to +c end of xtup, where nodur>0 +c + do 3 ipnow = ip+1 , ip+24 + if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup + if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest +c +c If I don't go to 5, know next note IS a rest! +c +3 continue +4 continue + call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) + notexq = notexq(1:lnote)//sq//'qb' + lnote = lnote+3 + call istring(ivx,tempq,len) + notexq = notexq(1:lnote)//tempq(1:len) + lnote = lnote+len + notexq = notexq(1:lnote)//noteq(1:lnoten) + lnote = lnote+lnoten + return +5 continue +c c Check if multiplicity changes in a way requiring action, c unless (160211) it's blank rest on start of 2nd seg of joined beam c - if(.not.btest(irest(ivx,ip-1),24) + else if(.not.btest(irest(ivx,ip-1),24) * .or..not.btest(islur(ivx,ip-1),29)) then ipleft = ip-1 if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1 @@ -2432,11 +2806,10 @@ c call istring(mod(ivbj1,12),tempq,len) * nssb(nm),issb(nm),lev1ssb(nm,20) common /comdraw/ drawbm(nm) common /commvl/ nvmx(nm),ivmx(nm,2),ivx - character*8 noteq + character*8 noteq,tempq character*79 notexq ip1 = ipo(jn) multip = iand(15,mult(ivx,ip1))-8 -c if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then lnote = 0 c @@ -2471,8 +2844,93 @@ c call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) if (lnoten .eq. 1) call addblank(noteq,lnoten) lnote = 3 - if (multip .eq. 0) then - notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + if (multip .le. 0) then +c if (btest(irest(ivx,ip1),2) .and. +c * nodur(ivx,ip1+1).ge.32) then + if ((btest(irest(ivx,ip1),2) .and. + * nodur(ivx,ip1+1).ge.32) + * .or. multip .eq. -1) then +c +c 1st note of unbeamed half-note trem; make open +c + notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) + else if (multip .eq. -2) then + notexq = sq//'wh' + else + notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) + end if +c +c Check for dot +c + if (btest(irest(ivx,ip1),2) .and. +c * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then +c +c Need a dot. already called addblank for noteq +c + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) ! Octave changes? + if (lnoten .eq. 1) call addblank(noteq,lnoten) + end if +c +c Insert the stemlength calcs here for dotted, unbeamed. +c Later may combine with below to avoid repeat. +c + if (btest(irest(ivx,ip1),2)) then + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * notexq(1:lnote) + lnote = lnote+10 + end if + else if (btest(irest(ivx,ip1),2)) then +c +c 1st note of unbeamed quarter or 8th trem, make a quarter note +c +c Stem length calcs here. The .2 factor is empirical, but +c slfac accounts for musicsize. +c + nindent = igetbits(irest(ivx,ip1),2,5) + if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then + slen = (4.5+nindent+nolev1(ivx)-nole + * -.4*islope(ivx)/slfac)*.6667 + else + slen = (4.5+nindent-nolev1(ivx)+nole + * +.4*islope(ivx)/slfac)*.6667 + end if + write(tempq,'(f4.1)')slen + notexq = sq//'slx{'//tempq(1:4)//'}'// + * sq//'q'//ulq(ivx,ibmcnt(ivx)) + lnote = 13 +c +c Check for dotted 2-note trem; prepend dot to notexq if needed +c + if (nodur(ivx,ip1+1).eq.12 .or. + * nodur(ivx,ip1+1).eq.24) then + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote) + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip1)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if else if (multip .eq. -1) then notexq = sq//'h'//ulq(ivx,ibmcnt(ivx)) else if (multip .eq. 1) then @@ -2527,12 +2985,46 @@ c end if end if c -c Put in the note +c Check for beamed, dotted 2-note tremolo c - if (lnote .gt. 0) then - notexq = notexq(1:lnote)//sq//'qb' + if (btest(irest(ivx,ip1),2) .and. + * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + if (lnote .eq. 0) then + notexq = sq//'pt'//noteq(1:lnoten) + else + notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten) + end if + lnote = lnote+3+lnoten + call notefq(noteq,lnoten,nole,ncmid(iv,ip)) + if (lnoten .eq. 1) then + noteq = ' '//noteq(1:1) + lnoten = 2 + end if + end if +c +c Put in the note, but check first for open-head beamed tremolo. +c + if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'hb' + else + notexq = sq//'hb' + end if else - notexq = sq//'qb' + if (lnote .gt. 0) then + notexq = notexq(1:lnote)//sq//'qb' + else + notexq = sq//'qb' + end if end if lnote = lnote+3 c @@ -2651,12 +3143,86 @@ c ipb1 = ibm1(ivx,ibc) multb = iand(15,mult(ivx,ipb1))-8 ip = ipo(jn) + lnote = 0 + nvtrem = 0 ! Vertical adjustment beams for tremolo c c Compute slopes and note offsets from start of beam. Inside SetupB, for each -c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. +c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also +c gets islope(ivx), transferred in common. c if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21)) * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx)) +c +c Will always come past here after entering beamstrt for 2-note tremolo, and +c slope will have been computed, even for unbeamed. So start the indented +c beams here. The indented tremolo bars will be added to the notexq output +c string, under the tacet assumption that there is no horizontal shift +c enacted by the action just before and after the call to beamstrt. +c + if (btest(irest(ivx,ipb1),2) .and. + * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then + nindent = igetbits(irest(ivx,ipb1),2,5) + tempq = sq//'roffset{.7}{'//sq//'ib' + ltemp = 16 + if (nindent .eq. 2) then + tempq = tempq(1:16)//'b' + ltemp = 17 + else if (nindent .eq. 3) then + tempq = tempq(1:16)//'bb' + ltemp = 18 + end if +c +c Use beam # 0 for indented beams +c + tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0' + ltemp = ltemp+2 +c +c Get adjustment to nolev1 for main beam based on nindent +c + if (ulq(ivx,ibc) .eq. 'u') then + nvtrem = nindent-1 + else + nvtrem = 1-nindent + end if +c +c Get numerical position of initiation for main beam. Will adjust height at +c closing to account for nindent +c +c numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4 + numinit = nolev1(ivx)-ncmid(iv,ipb1)+4 +c +c Get forced beam height tweak, apply here for indented beams +c + iadj = igetbits(ipl(ivx,ipb1),6,11)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1)') numinit + lnoten = 1 + else + write(noteq,'(a1,i2,a1)')'{',numinit,'}' + lnoten = 4 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten +c +c Now do the slope. +c 170408 Baseline is in islope(ivx). Apply slope tweak if present. +c + numinit = islope(ivx) + iadj = igetbits(ipl(ivx,ipb1),6,17)-30 + if (iadj .ne. -30) numinit = numinit+iadj + if (numinit.ge.0 .and. numinit.le.9) then + write(noteq,'(i1,a1)') numinit,'}' + lnoten = 2 + else + write(noteq,'(a1,i2,a2)')'{',numinit,'}}' + lnoten = 5 + end if + tempq = tempq(1:ltemp)//noteq(1:lnoten) + ltemp = ltemp+lnoten + notexq = tempq + lnote = ltemp + end if if (btest(nacc(ivx,ip),21)) then c c This is start of later segment of single-slope beam group so use slope and @@ -2665,7 +3231,9 @@ c issb(ivx) = issb(ivx)+1 nolev1(ivx) = lev1ssb(ivx,issb(ivx)) end if - lnote = 0 +c +c Move this up to before indented beams for tremolo +c lnote = 0 drawbm(ivx) = .true. if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then vxtup(ivx) = .true. @@ -2715,8 +3283,13 @@ c if (iud*iup .lt. 0) iflop = iup end if c -c Determine if a beam is to be drawn +c Determine if a beam is to be drawn. +c Had problem w/ half-note 2-note xtups always F, so add a test c + if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then + drawbm(ivx) = .true. + go to 6 + end if do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc) if (iand(15,mult(ivx,ipp))-8 .le. 0) then drawbm(ivx) = .false. @@ -2730,15 +3303,29 @@ c Are we using tuplet.tex? c usexnumt = cstuplet .and. .not.drawbm(ivx) c +c Check for single note xtup 171217 +c + if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then + drawbm(ivx) = .false. + end if +c c Place xtup number if needed c if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then mprint = igetbits(nacc(ivx,ip),5,22) if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx)) +c Stab in the dark! Note: tried setting unbeam flag islur18 but no go. + if (nnb .eq. 1) then + xnlmid = nolev1(ivx) + islope(ivx) = 0 +c +c Move up, outside number check block, so all 1-note xtups ar unbeamed +c drawbm(ivx) = .false. +c + end if call putxtn(mprint,iflop,multb,iud,wheadpt, * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1), * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)), -c * iup,irest(ivx,ipb1),usexnumt) * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt) end if if (.not.drawbm(ivx)) then @@ -2829,25 +3416,11 @@ c beamstrt and beamn1 some non-spacing chars. are inserted. c c 130126 Deal with vertical shifts of rest starting xtuplet c -c if (multb .eq. 0) then -c notexq = notexq(1:lnote)//sq//'qp' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.1) then -c notexq = notexq(1:lnote)//sq//'ds' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.2) then -c notexq = notexq(1:lnote)//sq//'qs' -c lnote = lnote+3 -c else if (.not.drawbm(ivx).and.multb.eq.3) then -c notexq = notexq(1:lnote)//sq//'hs' -c lnote = lnote+3 -c else -c notexq = notexq(1:lnote)//sq//'hpause' -c lnote = lnote+7 -c end if - lrest = 3 - if (multb .eq. 0) then + if (btest(islur(ivx,ip),29)) then + restq = sq//'sk' +c if (multb .eq. 0) then + else if (multb .eq. 0) then restq = sq//'qp' else if (.not.drawbm(ivx).and.multb.eq.1) then restq = sq//'ds' @@ -2859,10 +3432,20 @@ c end if restq = sq//'hpause' lrest = 7 end if + if (btest(nacc(ivx,ipb1),18) .and. + * btest(nacc(ivx,ipb1),19)) then +c +c VERY special case of rest at start of F-tuplet, needs dot +c + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if + nole = mod(nolev(ivx,ip)+20,100)-20 - if (nole .eq. 0) then +c if (nole .eq. 0) then + if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then c -c Rest is not raised +c Rest blank or is not raised c notexq = notexq(1:lnote)//restq lnote = lnote+lrest @@ -3016,14 +3599,23 @@ c flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc)) end if end if - call ntrbbb(multb+iadj,'i',ulq(ivx,ibc),ivx,notexq,lnote) + multbb = multb+iadj +c +c Tremolo starting? +c + if (btest(irest(ivx,ipb1),2)) multbb = + * igetbits(irest(ivx,ipb1),2,3) + call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote) c c Put in name of start level and slope, after correcting nolev1 if xtup c started with a rest. c if (ixrest(ivx).eq.2) nolev1(ivx) = * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac) - call notefq(noteq,lnoten,nolev1(ivx),ncmid(iv,ipb1)) +c +c Add adjustment nvtrem to main beam to account for tremolo indented beams +c + call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1)) if (islope(ivx) .lt. 0) then notexq = notexq(1:lnote)//noteq(1:lnoten)//'{' lnote = lnote+4+lnoten @@ -3258,7 +3850,7 @@ c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, data iTransAmt /nm*0/ end subroutine catspace(space,squez,nnsk) - parameter (nkb=3999,maxblks=4000) + parameter (nkb=3999,maxblks=9600) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) @@ -4391,8 +4983,9 @@ c end subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt, * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen, - * dotxtup,nacc) + * dotxtup,nacc,irest) parameter (nm=24,mv=24576) + integer*4 irest(nm,24) common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), * xinsnow,lowdot common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), @@ -4427,10 +5020,10 @@ c * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans common /commidisig/ midisig -c 130316 common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c + common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) c c This subr. once produced notexq for entire chord. 10/18/97 altered to write c chord notes as we go. 10/22/97 find range of icrd first. @@ -4453,10 +5046,86 @@ c c c Check for special situations with 2nds (see precrd). c - if (btest(nacc,30)) then - if (nolev .eq. nolevm-1) nolev = nolevm - else if (btest(nacc,31)) then - if (nolev .eq. nolevm+1) nolev = nolevm + if (btest(nacc,30) .and. nolev.eq.nolevm-1) then +c +c Upstem, 2nd with upper as main, interchange pitches, +c rt-shift upper (now chord note). Lower (orig chord, now main) +c if dotted, probably had shifted dot, dot parameters must be moved +c from chord to main +c + nolev = nolevm + if (btest(icrdat(icrd),26)) then +c +c Orig. chord note dot shift, must transfer to main. +c + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + if (btest(irest(ivx,ip),19)) then +c +c Main note (upper) had a dot shift, must move it to chord +c + call setbits(icrdat(icrd),1,26,1) + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c May need to worry about other chord params (accid shefts etc) later +c + else + icrdat(icrd) = ibclr(icrdat(icrd),26) + end if +c +c We are adding a main note dot shift, so push any later ones back +c + + if (.not.btest(irest(ivx,ip),19)) then + maxdotmv(ivx) = maxdotmv(ivx)+1 + do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1 + updot(ivx,indm) = updot(ivx,indm-1) + rtdot(ivx,indm) = rtdot(ivx,indm-1) +1 continue + end if + irest(ivx,ip) = ibset(irest(ivx,ip),19) + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + end if + else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then +c +c Downstem, 2nd with lower as main, interchange pitches, +c left-shift lower (now chord note). Lower (orig main, now chord) +c probably had shifted dot, dot parameters must be moved from +c main to chord +c + nolev = nolevm + if (btest(irest(ivx,ip),19)) then + icrdotsav = icrdot(icrd) + icrdatsav = icrdat(icrd) + icrdat(icrd) = ibset(icrdat(icrd),26) +c bits in icrdot +c 0-6 10*abs(vertical dot shift in \internote) + 64 +c 7-13 10*abs(horizontal dot shift in \internote) + 64 +c Assuming >0 for now! + call setbits(icrdot(icrd),7,0, + * nint(updot(ivx,ndotmv(ivx)+1)*10)+64) + call setbits(icrdot(icrd),7,7, + * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64) +c +c Must also set dot shift for (now) main note (orig. chord note). +c + if (btest(icrdatsav,26)) then + updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64) + rtdot(ivx,ndotmv(ivx)+1) = + * 0.1*(iand(127,ishft(icrdotsav,-7))-64) + else +c +c No dot move on original chord (now main) note, +c + updot(ivx,ndotmv(ivx)+1) = 0. + rtdot(ivx,ndotmv(ivx)+1) = 0. + end if + end if end if c c Lower dot for lower-voice notes?. Conditions are: @@ -4467,43 +5136,38 @@ c 4. Not a rest (cannot be a rest in a chord!) c. 5. Flag (lowdot) is set to true c if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then - if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then - if (btest(icrdat(icrd),26)) then + if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then + if (btest(icrdat(icrd),26)) then c c Note already in movdot list. Drop by 2. c - call setbits(icrdot(icrd),7,0, + call setbits(icrdot(icrd),7,0, * igetbits(icrdot(icrd),7,0)-20) else c c Not in list so just move it right now c - call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) - end if + call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) end if - end if - if (btest(icrdat(icrd),26)) then + end if + end if + if (btest(icrdat(icrd),26)) then c -c Move the dot. +c Move the dot. Basic call for chord notes, not main note. c - updotc = 0.1*(iand(127,icrdot(icrd))-64) - rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) - call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) - end if - isleft = btest(icrdat(icrd),23) - isright = btest(icrdat(icrd),24) + updotc = 0.1*(iand(127,icrdot(icrd))-64) + rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) + call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) + end if + isleft = btest(icrdat(icrd),23) + isright = btest(icrdat(icrd),24) c c Check for ornament in chord. c - if (icrdorn(icrd) .gt. 0) then - call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, - * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, - * ip,0,beamon,.true.) -c -c subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx, -c * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt, -c * notcrd,beamon,iscrd) -c + if (icrdorn(icrd) .gt. 0) then + call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, + * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, + * ip,0,beamon,.true.) call addstr(outq,lout,soutq,lsout) end if c @@ -4603,15 +5267,8 @@ c c c Use original saved pitch level, unaltered by 2nds logic. c -c 130316 -c call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)), -c * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) -c 130316 -c * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., * igetbits(icrdat(icrd),3,20),midisig,1., - - * .false.,.false.) end if 5 continue @@ -4643,6 +5300,7 @@ c character*79 notexq character*80 soutq integer*4 ihornb(nm,24),nornb(nm),idynn(10) + common /comhair/ ihairuse,idhair(nm) data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/ numdyn = 0 c @@ -4650,7 +5308,6 @@ c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values c in idynn(1...4) c do 1 idyn = 1 , ndyn -c ivxtent = iand(idyndat(idyn),15) ivxtent = iand(idyndat(idyn),15) * +16*igetbits(idynda2(idyn),1,10) if (ivxtent .eq. ivx) then @@ -4664,8 +5321,6 @@ c I don't think there are any more possible for this ivx,ip, so exit loop c go to 2 end if -c else if (ivxtent .gt. ivx) then -c go to 2 end if 1 continue 2 continue @@ -4709,7 +5364,14 @@ c end if else hoffsd = -.5 - lbot = ihornb(ivx,nornb(ivx))+1 +c +c 171230 Desperation +c lbot = ihornb(ivx,nornb(ivx))+1 + if (nornb(ivx).eq.0) then + lbot = 1 + else + lbot = ihornb(ivx,nornb(ivx))+1 + end if if (lbot .eq. 1) then c c Kluge for non-beamed, down xtup, for which ihorb was never set. @@ -4761,7 +5423,7 @@ c lnote = 7 if (idno .eq. 13) then c -c Start a hairpin +c Start a font-based hairpin c notexq = chax(92)//'hpstrt' else if (idno .eq. 14) then @@ -4775,6 +5437,19 @@ c End decrescendo c notexq = chax(92)//'hpdend' end if +c +c Put in voice number as ID for font-based hairpin +c + if (ivx .le. 9) then + notexq = notexq(1:lnote)//char(48+ivx) + lnote = lnote+1 + else if (ivx .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' + lnote = lnote+4 + else + notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' + lnote = lnote+4 + end if else c c Postscript hairpins @@ -4788,19 +5463,37 @@ c else notexq = chax(92)//'Tcresc' end if - end if - if (idno .ge. 13) then + if (idno .le. 14) then +c +c Get and record ID no for start of ps hairpin +c Find first unused ID +c + do 8 idh = 1 , 24 + if (.not.btest(ihairuse,idh)) go to 9 +8 continue + call printl('Bad place in putdyn, call Dr. Don') + call stop1() +9 continue + ihairuse = ibset(ihairuse,idh) + idhair(ivx) = idh + else c -c Put in voice number +c Unrecord ID no for end of ps hairpin +c + call setbits(ihairuse,1,idhair(ivx),0) + end if c - if (ivx .le. 9) then - notexq = notexq(1:lnote)//char(48+ivx) +c Write ID # for start or end of ps hairpin +c + idh = idhair(ivx) + if (idh .le. 9) then + notexq = notexq(1:lnote)//char(48+idh) lnote = lnote+1 - else if (ivx .le. 19) then - notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}' + else if (idh .le. 19) then + notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}' lnote = lnote+4 else - notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}' + notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}' lnote = lnote+4 end if end if @@ -5095,14 +5788,14 @@ c c c Construct string to search backwards for placeholder c - if (ivx .le. 9) then - tempq = 'cresc'//char(48+ivx)//'{ }' + if (idh .le. 9) then + tempq = 'cresc'//char(48+idh)//'{ }' ltemp = 11 - else if (ivx .le. 19) then - tempq = 'cresc'//'{1'//char(38+ivx)//'}{ }' + else if (idh .le. 19) then + tempq = 'cresc'//'{1'//char(38+idh)//'}{ }' ltemp = 14 else - tempq = 'cresc'//'{2'//char(28+ivx)//'}{ }' + tempq = 'cresc'//'{2'//char(28+idh)//'}{ }' ltemp = 14 end if write(11,'(a)')soutq(1:lsout)//'%' @@ -5269,13 +5962,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}' lnote = 4 end if -c if (11-ndxslur .lt. 10) then -c call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten, -c * soutq,lsout) -c else -c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), -c * 4+lnoten,soutq,lsout) -c end if call addstr(notexq(1:lnote)//noteq(1:lnoten), * lnote+lnoten,soutq,lsout) if (.not.fontslur) then @@ -5363,12 +6049,10 @@ c c c Terminate slur on single after-grace c -c ndxslur = igetbits(ipl,4,23) ndxslur = igetbits(ipl,5,23) call notefq(noteq,lnoten,nolevg(ngs),ncm) call addstr(sq//'tslur',6,soutq,lsout) c -cc Print 11-ndxslur c Print 24-ndxslur c c if (11-ndxslur .lt. 10) then @@ -5391,8 +6075,6 @@ c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), c c+++ Try to fix loss of octave with single gaft c -c if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}', -c * 13+lnoten,soutq,lsout) if (isgaft) then itrans = 0 do 1 i = 1 , lnotenGA @@ -5505,7 +6187,7 @@ c end if end if c -c Print 11-ndxslur +c Print 23-ndxslur c if (23-ndxslur .lt. 10) then call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten, @@ -5689,11 +6371,13 @@ c 11 start/stop switch c 12 kv-1 c 19-25 ichar(code$) c 26 force direction? + c 27 forced dir'n = up if on, set in sslur; also c final direction, set in doslur when beam is started, used on term. c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. c 2 stem slur flag +c 1 flag for "x" slur (voice-independent) c c Bits in isdat2 c 0 Chord switch. Not set on main note. @@ -5756,7 +6440,9 @@ c isdata = isdat1(isdat) if (iv .eq. igetbits(isdata,5,13) .and. * ip .eq. igetbits(isdata,8,3) .and. - * kv .eq. igetbits(isdata,1,12)+1) then +c * kv .eq. igetbits(isdata,1,12)+1) then + * (kv .eq. igetbits(isdata,1,12)+1 .or. + * btest(isdata,1))) then c c Since iv and kv match, ivx will be correct c @@ -5869,13 +6555,10 @@ c c Get index of next slur not in use, starting from 12 down c ndxslur = log2(16777215-listslur) -c write(*,'()') -c write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur c c Record slur index c listslur = ibset(listslur,ndxslur) -c write(*,'(10x,B24)')listslur c c Save for use on termination c @@ -5892,7 +6575,7 @@ c else ihoff = ihoff+2 end if - end if + end if if (iscrd) then c c Additional horiz shifts for h-shifted noteheads? @@ -5963,19 +6646,15 @@ c notexq = chax(92)//'dotted'//noteq end if c c Add slur index to string -cc Print 11-ndxslur c Print 23-ndxslur c -c if (11-ndxslur .lt. 10) then if (23-ndxslur .lt. 10) then c c 5/25/08 Allow 24 slurs c -c notexq = notexq(1:lnote)//chax(59-ndxslur) notexq = notexq(1:lnote)//chax(71-ndxslur) lnote = lnote+1 else if (23-ndxslur .lt. 20) then -c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}' lnote = lnote+4 else @@ -5985,7 +6664,6 @@ c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' c c Add note name to string c -c call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) islhgt = nolevs+iupdn+ivoff call notefq(noteq,lnoten,islhgt,ncm) notexq = notexq(1:lnote)//noteq(1:lnoten) @@ -6045,7 +6723,9 @@ c Slur is ending. Back thru list to find starting slur c do 3 j = isdat-1 , 1 , -1 if (iv.eq.igetbits(isdat1(j),5,13) .and. - * kv.eq.igetbits(isdat1(j),1,12)+1) then +c * kv.eq.igetbits(isdat1(j),1,12)+1) then + * (kv.eq.igetbits(isdat1(j),1,12)+1 + * .or. btest(isdat1(j),1))) then if (idcode .eq. igetbits(isdat1(j),7,19)) then ndxslur = igetbits(isdat1(j),4,28) c @@ -6063,7 +6743,6 @@ c c c Bugfix 070901 for slur ending on rest in 2-voice staff c -c if (nolevs.eq.0 .or. nolevs.gt.60) then if (nolevs.le.2 .or. nolevs.gt.60) then c c Ending is on a rest, reset nolevs to default starting height @@ -7432,7 +8111,7 @@ c return end subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0) - parameter (nkb=3999,maxblks=4000) + parameter (nkb=3999,maxblks=9600) c c Compute an exponent eonk for use in the "flattened" formula for elemskips c vs time. We must solve the eqution f = 0. Initial quess is eonk0. @@ -7531,7 +8210,7 @@ c fnote = nodur(ivx,iip)/float(iip-ip1m1) print*,' ' call printl * ('Probable misplaced barline or incorrect meter, stopping') -c call printl('Program error in fnote, send source to Dr. Don') + print*,'ivx,ip:',ivx,ip call stop1() end subroutine g1etchar(lineq,iccount,charq) @@ -7567,7 +8246,7 @@ c return end subroutine g1etnote(loop,ifig,optimize,fulltrans) - parameter (nm=24,nkb=3999,mv=24576,maxblks=4000) + parameter (nm=24,nkb=3999,mv=24576,maxblks=9600) character*1 chax common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, @@ -7604,7 +8283,7 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv), * debugmidi logical debugmidi - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq logical novshrinktop,upslur,fontslur,ztrans, @@ -7621,6 +8300,8 @@ c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) logical fulltrans common /comsize/ isize(nm) common /commidisig/ midisig + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset data literq * /'Literal TeX string cannot start with 4 backslashes!', * 'TeX string must have <129 char, end with backslash!', @@ -7850,13 +8531,13 @@ c else call g1etchar(lineq,iccount,durq) call readnum(lineq,iccount,durq,dum) + if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1 iccount = iccount-1 go to 2 end if c else if (index('ulare',durq) .gt. 0) then else if (index('ularec',durq) .gt. 0) then go to 2 -c else if (durq .eq. 'S') then else if (index('LS',durq) .gt. 0) then c c Stemlength change @@ -7933,20 +8614,51 @@ c c Will set all durations to 0 except last one. c call g1etchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then + if (index('123456789T',durq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'First char after "x" in xtuplet must be "1"-"9"!') + * 'First char after "x" in xtuplet must be "1"-"9" or "T"!') call stop1() end if - call readnum(lineq,iccount,durq,fnum) - if (fnum .gt. 99) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + if (durq .eq. 'T') then +c +c Check all x-tremolo inputs here; set fnum=2 +c + fnum = 2 + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'First char after "T" in xtuplet must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) + if (index('0123 ',durq).eq.0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'This char must be "0"-"3" or blank!') + call stop1() + else if (durq .ne. ' ') then + call getchar(lineq,iccount,durq) +c +c Probably blank unles other options entered +c + end if + end if + else +c +c durq is digit, normal xtup +c + call readnum(lineq,iccount,durq,fnum) +c +c Leaves durq at next char after number +c + if (fnum .gt. 99) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Xtuplet cannot have more than 99 notes!') - call stop1() - else if (index(' DFnd',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Only legal characters here are " ","D","F","n"!') - call stop1() + call stop1() + else if (index(' DFnd',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only legal characters here are " ","D","F","n"!') + call stop1() + end if end if c c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. @@ -8262,6 +8974,8 @@ c * 'Slur ID not allowed on non-postscript tie!') call stop1() end if + if (lineq(iccount+1:iccount+1).eq.'x') + * iccount = iccount+1 go to 15 end if call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, @@ -8486,18 +9200,10 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'In xtup, this character is not allowed!') call stop1() -c else if (durq.eq.'r' .and. itup.eq.ntup) then -c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -c * 'Sorry, PMX cannot end an xtuplet with a rest!') -c call stop1() - else if (durq.eq.'r' .and. itup.eq.ntup .and. - * index(lineq(iccount+1:iccount+2),'b').eq.0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Sorry, PMX cannot end an xtuplet with a non-blank rest!') - call stop1() end if 7 call g1etchar(lineq,iccount,durq) - if (index('2345678ulcb',durq) .gt. 0) then +c if (index('2345678ulcb',durq) .gt. 0) then + if (index('12345678ulcb',durq) .gt. 0) then go to 7 else if (index('sfn',durq) .gt. 0) then c @@ -8640,7 +9346,14 @@ c iccount = iccount-1 end if go to 2 - else if (durq .ne. ' ') then + else if (durq .eq. 'T') then +c +c Single stem tremolo. Only option (optional) is 1,2,3, or 4. +c + call getchar(lineq,iccount,durq) + if (index('1234',durq) .eq. 0) iccount = iccount-1 + go to 2 + else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character!') print*,'ASCII code:',ichar(durq) @@ -9079,6 +9792,8 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Slur ID not allowed on non-postscript tie!') call stop1() + else if (lineq(iccount+1:iccount+1).eq.'x') then + iccount = iccount+1 end if end if c @@ -9536,13 +10251,28 @@ c gotclef = .true. * 'Repeats can only go in voice 1!') call stop1() end if -10 call g1etchar(lineq,iccount,durq) - if (index('lrdDbz',durq) .gt. 0) go to 10 - if (durq .ne. ' ') then +c10 call g1etchar(lineq,iccount,durq) +c if (index('lrdDbz',durq) .gt. 0) go to 10 +c if (durq .ne. ' ') then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'Illegal character after "R" (repeat/double bar)!') +c call stop1() +c end if + call g1etchar(lineq,iccount,durq) + call g1etchar(lineq,iccount,dumq) + if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'Illegal character after "R" (repeat/double bar)!') + * 'Illegal character after "R*" (repeat/double bar)!') call stop1() end if + if (dumq .ne. ' ') then + call g1etchar(lineq,iccount,durq) + if (durq .ne. ' ') then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have blank after "R**" (repeat/double bar)!') + call stop1() + end if + end if else if (charq .eq. 'V') then c c Ending @@ -9640,7 +10370,16 @@ c iccount = 128 else if (charq .eq. 'A') then 27 call g1etchar(lineq,iccount,durq) - if (index('rbsdeK',durq) .gt. 0) then +c if (index('rbsdeK',durq) .gt. 0) then + if (index('rbsdK',durq) .gt. 0) then + go to 27 + else if (durq .eq. 'e') then +c +c Check for is4bignv. Must do here to catch first \internote, written in topfile +c before ever calling getnote. Initialize as .false. in pmxa. Make it true only +c if nv>7, AI not set, Ai not set. +c + is4bignv = nv.gt.7 .and. .not.AIset go to 27 else if (durq .eq. 'v') then if (ibarcnt .eq. 0) novshrinktop = .true. @@ -9656,6 +10395,8 @@ c iccount = iccount-1 go to 27 else if (durq .eq. 'i') then + is4bignv = .false. + AIset = .true. call g1etchar(lineq,iccount,durq) c c Local interstaff correction. Set to -1. if not specifiec, or after use, @@ -9669,6 +10410,8 @@ c c c Global interstaff correction. Use in place of fintstf if fintstf<0 c + is4bignv = .false. + AIset = .true. call g1etchar(lineq,iccount,durq) call readnum(lineq,iccount,durq,gintstf) iccount = iccount-1 @@ -9771,10 +10514,38 @@ c voffpt = -24 end if go to 27 + else if (durq .eq. 'V') then + call g1etchar(lineq,iccount,durq) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift before \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + if (index('+-',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Only "+" or "-" is allowed here!') + call stop1() + end if + call g1etchar(lineq,iccount,durq) + if (index('0123456789.',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'A number for vert shift after \eject must start here!') + call stop1() + end if + call readnum(lineq,iccount,durq,fnum) + iccount = iccount-1 + go to 27 else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, c * 'After "A" must follow one of the letters abcdeiINprRsST!') - * 'After "A" must follow one of the letters abcdeiILNprRsST!') + * 'After "A" must follow one of abcdeiILNprRsSTvV!') print*,'For AS, since ver. 2.7, must only have noinst args.' write(15,'(a)') * 'For AS, since ver. 2.7, must only have noinst args.' @@ -9936,7 +10707,7 @@ c if (mod(itsofar(ivx),lenbar).ne.0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Block duration not divisible by lenbar!') - print*,'lenbar is ',lenbar + print*,'lenbar, timesofar are ',lenbar,itsofar(ivx) call stop1() else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then print* @@ -10326,8 +11097,8 @@ c end subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp, * xmtrnum0,newkey,npages,nsyst,musize,bottreb) - parameter(nm=24,maxblks=4000) - character*65536 bufq + parameter(nm=24,maxblks=9600) + character*131072 bufq character*1 chax integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq @@ -10564,9 +11335,9 @@ c mytime = 1000*(ts+60*(im+60*ih)) c return c end subroutine getbuf(lineq) - parameter (maxblks=4000) + parameter (maxblks=9600) character*(*) lineq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) @@ -11552,7 +12323,7 @@ c common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, * OptLineBreakTies,HeaderSpecial common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS, * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf, @@ -11574,7 +12345,7 @@ c * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2 character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /combc/ bcspec common /comas3/ ask(2500),iask,topmods c @@ -11634,7 +12405,11 @@ c common /commidisig/ midisig common /comlyr/ inputmlyr logical inputmlyr + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + logical inxtup cdot = .false. + inxtup = .false. 1 call getchar(lineq,iccount,charq) if (lastchar) return if (charq .eq. ' ') go to 1 @@ -11824,11 +12599,15 @@ c c c Accidental c - if (nacc(ivx,nnl(ivx)) .eq. 0) then +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c 171209 May have set bit 18 earlier if D or F preceded accidental + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then c c No accidental has been set yet c - nacc(ivx,nnl(ivx)) = index('fsn',durq) +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) else c c Repeated accid, so must be double @@ -11877,8 +12656,8 @@ c c Kluge in case there is a shortcut ".". It will have been sucked up by c readnum. (Same doesn't hold for ",") c - iccount = iccount-2 - go to 2 + iccount = iccount-1 +c go to 2 end if nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum) c @@ -11897,17 +12676,86 @@ c ndoub = 0 end if c +c Initialize counter for # of non-rests, so can later unbeam if = 1. +c + inxtup = .true. + note1xtup = nnl(ivx) + nnb = 0 + if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1 +c c Will set all durations to 0 except last one. Set flag on this note. c irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28) c -c Next input will be digit +c Next input will be digit unless its a "T" c iccount = iccount+1 - call readnum(lineq,iccount,durq,fnum) - ntup = nint(fnum) + if (lineq(iccount:iccount) .eq. 'T') then +c +c Set up tremolo +c + irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2) + ntup = 2 +c +c Set default beaming, based on Wikipedia article +c May be a problem here is nnodur is inherited +c + if (nnodur .eq. 4) then + nsolid = 0 + nindent = 3 + else if (nnodur .eq. 2) then + nsolid = 3 + nindent = 0 + else if (nnodur .eq. 8) then + nsolid = 1 + nindent = 2 + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nsolid = index('0123456789',durq)-1 + if (nsolid.eq.0 .and. nnodur.eq.2) then + print*,'' + print*,'Unbeamed half-note 2-note tremolo forbidden.' + call stop1() + end if + call getchar(lineq,iccount,durq) + if (index('0123456789',durq) .gt. 0) then + nindent = index('0123456789',durq)-1 + end if + end if + call setbits(irest(ivx,nnl(ivx)),2,3,nsolid) + call setbits(irest(ivx,nnl(ivx)),2,5,nindent) + if (nsolid .eq. 0) then + islur(ivx,nnl(ivx)) = + * ibset(islur(ivx,nnl(ivx)),18) + end if + islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31) + islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21) + call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid) +c +c Set some force-beam parameters for the tremolo +c +c Need to check if there's already a forced beam explicitly set here. +c If there was, shouldn't do any harm resetting parameters. +c + if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx)) + * nfb(ivx) = nfb(ivx)+1 + fbon = .true. + ulfbq(ivx,nfb(ivx)) = 'x' + t1fb(ivx,nfb(ivx)) = itsofar(ivx) + t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq) + nadj = 0 +c +c Set open beamed notehead flag for half-note tremolo +c Just gave 2 quarters with or without flag set. Need to fix +c + else + call readnum(lineq,iccount,durq,fnum) + ntup = nint(fnum) + end if if (index('DF',durq) .gt. 0) then c +c c Double xtup note to make an un= xtup. Here xtup number already set but may also c have this command before. c @@ -12291,12 +13139,8 @@ c c 140218 Need to get time differently inside xtup, since itsofar doesn't get c updated until after xtup is done c -c tcc(iv,ncc(iv)) = itsofar(iv) nodurt = ifnodur(nnodur,dotq) tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) -c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' -c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) -c isl = ibset(islur(iv,nnl(iv)+1),11) isl = ibset(islur(iv,nnl(iv)),11) call getchar(lineq,iccount,durq) c @@ -12306,7 +13150,7 @@ c ncmidcc(iv,ncc(iv)) = ncmidf(durq) if (durq .eq. '8') then ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) end if c c Set marker on note with lowest voice # starting at same time. @@ -12378,6 +13222,12 @@ c else nolev(ivx,nnl(ivx)) = 2 end if +c end if + else +c +c Counter for non-rests +c + nnb = nnb+1 end if notcrd = .true. 8 call getchar(lineq,iccount,durq) @@ -12395,11 +13245,16 @@ c end if end if else if (index('fsn',durq) .gt. 0) then - if (nacc(ivx,nnl(ivx)) .eq. 0) then +c +c if (nacc(ivx,nnl(ivx)) .eq. 0) then +c May have set other bits earlier + if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then c c No accid set yet c - nacc(ivx,nnl(ivx)) = index('fsn',durq) +c nacc(ivx,nnl(ivx)) = index('fsn',durq) + nacc(ivx,nnl(ivx)) = + * ior(nacc(ivx,nnl(ivx)),index('fsn',durq)) else c c Symbol must be repeated, so it's a double @@ -12540,7 +13395,6 @@ c ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8) irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27) go to 2 -c else if (durq .eq. 'S') then else if (index('LS',durq) .gt. 0) then c c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 @@ -12628,6 +13482,16 @@ c iccount = iccount-1 end if go to 2 + else if (durq .eq. 'T') then + call getchar(lineq,iccount,durq) + multtrem = index('1234',durq) + if (multtrem .eq. 0) then + iccount = iccount-1 + multtrem = 1 + end if + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4) + call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1) + go to 2 else if (durq .ne. ' ') then print*,'Illegal character in note: ',durq,', ivx,nn:', * ivx,nnl(ivx) @@ -12651,6 +13515,17 @@ c Set level for preslur on normal note, non-chord c call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev) 43 continue +c +c Only matters if last note, non-rest of xtuplet +c + nnb = nnb+1 + end if +c +c Set flag for unbeamed xtup if it just has 1 note +c + if (inxtup .and. nnb.eq.1) then +c ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19) + islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18) end if if (idotform .gt. 0) then if (idotform .eq. 1) then @@ -13440,9 +14315,18 @@ c ncmidcc(iv,ncc(iv)) = ncmidf(durq) if (durq .eq. '8') then ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) + lastlev = lastlev+7 else - if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0 +c +c This won't work if you really had an octave transposition with some +c other clef. Need a check on whether prior clef was an octave clef. +c + if (iTransAmt(instno(iv)).eq.7) then + iTransAmt(instno(iv))=iTransAmt(instno(iv))-7 + lastlev = lastlev-7 + print*,'Reset itransamt to ',iTransAmt(instno(iv)) + end if end if c c Set marker on note with lowest voice # starting at same time. @@ -13825,6 +14709,20 @@ c c Just eat the input; it was used in pmxa c go to 27 + else if (durq .eq. 'V') then + bottopgap = .true. + topamt = 0. + call getchar(lineq,iccount,durq) + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,botamt) + botamt = botamt*pmfac + pmfac = index('- +',durq)-2 + call g1etchar(lineq,iccount,durq) + call readnum(lineq,iccount,durq,topamt) + topamt = topamt*pmfac + iccount = iccount-1 + go to 27 end if if (index('NR',durq) .gt. 0) then c @@ -14307,14 +15205,14 @@ c to last character of most recent line sucked from buffer. c ipbufmod = points to last character of most recent inserted line c from pmx.mod c - parameter (maxblks=4000,nm=24) + parameter (maxblks=9600,nm=24) common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 logical lastchar,fbon,issegno,isheadr,isvolt character*(*)includeq character*80 pmxmoddirq character*128 lnholdq - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq logical fexist,global @@ -15279,12 +16177,10 @@ c c c Forced multiplicity c -c mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22) call setbits(mult(ivx,iip),4,0, * igetbits(islur(ivx,nip1),3,22)+8) else if (.not.isxtup) then if (nodur(ivx,iip) .gt. 0) then -c mult(ivx,iip) = 4-log2(nodur(ivx,iip)) call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8) else c @@ -15304,7 +16200,6 @@ c multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)- * alog(nodur(ivx,iip)/2.))/0.69315)-10 do 74 iiip = iip1 , iip -c mult(ivx,iiip) = multx call setbits(mult(ivx,iiip),4,0,multx+8) c c Note the following still works after making mult only the 1st 4 bits. @@ -15366,13 +16261,13 @@ c c This is called when (a) macro recording is just starting and c (b) at the start of a new line, if recording is on c - parameter (maxblks=4000) + parameter (maxblks=9600) character*128 lineq,lnholdq common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), * ic1mac(20),ilmac,iplmac logical mrecord,mplay,endmac - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq lbuf(1) = lbuf(1) @@ -15442,7 +16337,7 @@ c logical upg,slurg,slashg,autofbon character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm), * numbms(nm),mapfb(16) real*4 xit(nm),t1xtup(20),tstart(80),squez(80) @@ -15842,21 +16737,6 @@ c end if 30 continue c -c Debug writes -c -c print* -c write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot) -c print*,'PMXB has now got blocks' -c write(*,'(16i5)')(istart(ib),ib=1,nb) -c write(*,'(16i5)')(istop(ib),ib=1,nb) -c write(*,'(16f5.1)')(space(ib),ib=1,nb) -c write(*,'(16f5.1)')(squez(ib),ib=1,nb) -c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) -cc write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048, -c * in=1,ntot) -c write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot) -c -c c Analyze for beams. c do 20 iv = 1 , nv @@ -16003,10 +16883,10 @@ c logical upg,slurg,slashg,issig,rpndot,autofbon character*128 litq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) integer istart(80),istop(80),iaskb(nm),numbms(nm), * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2) - character*1 ulfbq,udqq,clefq(nm),slurudq + character*1 ulfbq,udqq,clefq(nm),slurudq,udq character*8 noteq character*79 cwrq(nm),notexq,inameq character*20 voltxtq @@ -16156,10 +17036,10 @@ c c if (clefq(ivxo(in)) .eq. '8') then if (btest(ipl(ivxo(in),ipo(in)),2)) then if (iv .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' end if end if @@ -16544,8 +17424,12 @@ c if (isaccs .or. iscacc) then ptsneed = ptsneed+taccfac*wheadpt1 end if - if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, +c if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, +c * esk,fixednew,scaldold,0.,.false.) + if (poenom*esk .lt. ptsneed) then + call addask(to(in),ptsneed, * esk,fixednew,scaldold,0.,.false.) + end if 99 continue if (btest(iornq(ivx,ip),26)) then c @@ -16757,7 +17641,6 @@ c c Check for new clef here. c if (isclef .and. btest(islur(ivx,ip),11)) then -c print*,'At clef insertion, ptclef:',ptclef(iv) if (ptclef(iv) .gt. 0.) then notexq = sq//'off{-' if (ptclef(iv) .lt. 9.95) then @@ -16770,7 +17653,6 @@ c print*,'At clef insertion, ptclef:',ptclef(iv) notexq = notexq(1:lnote)//'pt}' lnote = lnote+3 call addstr(notexq,lnote,soutq,lsout) -c print*,'Just added: ',notexq(1:lnote) end if call clefsym(islur(iv,ip),notexq,lnote,nclef) c @@ -17049,7 +17931,28 @@ c Clumsy test, but vxtup is not set until main note is processed. c if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then nodu = nodur(ivx,ip) -c else if (mult(ivx,ip) .lt. 0) then +cc else if (iand(mult(ivx,ip),15)-8 .lt. 0) then +c else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or. +c * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or. +c * (ip.gt.1.and.btest(irest(ivx,ip-1),2) +c * .and.nodur(ivx,ip).eq.32)) then +c nodu = 32 +c else +c nodu = 16 +c end if + else if (btest(irest(ivx,ip),2) .or. + * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then +c +c In a 2-note tremolo +c + if (btest(irest(ivx,ip),2)) then +c +c First note of tremolo, duration is on next note +c + nodu = nodur(ivx,ip+1) + else + nodu = nodur(ivx,ip) + end if else if (iand(mult(ivx,ip),15)-8 .lt. 0) then nodu = 32 else @@ -17058,7 +17961,8 @@ c else if (mult(ivx,ip) .lt. 0) then call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout, * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv, * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen, - * btest(nacc(ivx,ip),27),nacc(ivx,ip)) + * btest(nacc(ivx,ip),27),nacc(ivx,ip), + * irest) end if c c Now that chords are done, add stuff to midi file @@ -17178,7 +18082,9 @@ c end if end if c -c Check for dotted notes with moved dots +c Check for dotted main notes with moved dots. Chord notes done elsewhere. +c Added check rules out special chordal 2nds, but later must check +c substituted chord note for dot shift that now applies to main note. c if (btest(irest(ivx,ip),19)) then ndotmv(ivx) = ndotmv(ivx)+1 @@ -17289,106 +18195,58 @@ c Conditions are 0. This is a non-blank rest c 1. kbdrests = .true. c 2. There are two voices on the staff c 3. No user-def height adjustments have been applied (nolev<50) -cc 4. Not last note in bar -cc 5. Followed by note (add better test later) c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. -c * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) -c * .and. .not.(btest(irest(ivx,ip+1),0))) then * nolev(ivx,ip).le.50) then + call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, + * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, + * mult,ipl) + end if + if (btest(ipl(ivx,ip),4)) then c -c 130127 Replaced following code with a subroutine +c Deal with single stem tremolo +c Get up-downness, borrowed from notex c -cc Get reference level: next following note if no intervening blank rests, -cc otherwise next prior note. -cc -cc levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line -c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then -cc -cc Not the last note and not "look-left" for level -cc -c do 8 kkp = ip+1 , nn(ivx) -c if (btest(islur(ivx,kkp),29)) go to 4 -c if (.not.btest(irest(ivx,kkp),0)) then -c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line -c go to 9 -c end if -c8 continue -c end if -c4 continue -cc -cc If here, there were no following notes or came to a blank rest, or -cc "look-left" option set. So look before -cc -c if (ip .eq. 1) go to 2 ! Get out if this is the first note. -c do 3 kkp = ip-1, 1, -1 -c if (.not.btest(irest(ivx,kkp),0)) then -c levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line -c go to 9 -c end if -c3 continue -c go to 2 ! Pretty odd, should never be here, but get out if so. -c9 continue -cc -cc Find note in other voice at same time -cc -c iupdown = sign(1,ivx-nv-1) -c ivother = ivmx(iv,(3-iupdown)/2) -c tother = 0. -c do 5 kkp = 1 , nib(ivother,ibar) -c if (abs(tother-tnow) .lt. tol) go to 6 -c tother = tother+nodur(ivother,kkp) -c5 continue -cc -cc If here, then no note starts in other voice at same time, so set default -cc -c levother = -iupdown*50 -c go to 7 -c6 continue -cc -cc If here, have just identified a simultaneous note or rest in other voice -cc -c if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it -c levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 -c else -c if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then -cc -cc Rest in other voice has same duration, get out (so defualt spacing is used) -cc -c go to 2 -c end if -c levother = -iupdown*50 -c end if -c7 continue -c indxr = log2(nodur(ivx,ip))+1 -c if (iupdown .lt. 0) then -c levtop = levtopr(indxr) -c iraise1 = levother-levtop-3 ! Based on other note -c iraise2 = levnext-levtop ! Based on following note -c if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 -c iraise = min(iraise1,iraise2) -c if (mod(iraise+50,2).eq.1 .and. -c * iraise+levtop.gt.-1) iraise = iraise-1 -c else -c levbot = levbotr(indxr) -c iraise1 = levother-levbot+3 -c iraise2 = levnext-levbot -c if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 -c iraise = max(iraise1,iraise2) -c if (mod(iraise+50,2).eq.1 .and. -c * iraise+levbot.le.9) iraise = iraise-1 -c end if -c nolev(ivx,ip) = 100+iraise + if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip), + * nvmx(iv),ivx,nv).eq.'u') then + udq = 'u' + else + udq = 'l' + end if + multtrem = igetbits(ipl(ivx,ip),2,5)+1 + if (nodur(ivx,ip) .lt. 64) then + notexq = sq//'tr' + else + notexq = sq//'Tr' + end if + lnote = 3 + if (multtrem .eq. 2) then + notexq = notexq(1:3)//'r' + lnote = 4 + else if (multtrem .eq.3) then + notexq = notexq(1:3)//'rr' + lnote = 5 + end if c -c The new subroutine call, to replace above code +c Get a numerical pitch argument c - call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, - * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, - * mult,ipl) + lineno = nolev(ivx,ip)-ncmid(iv,ip)+4 + if (lineno .lt.0 .or. lineno .gt.9) then + write(noteq,'(a1,i2,a1)')'{',lineno,'}' + lnoten = 4 + else + noteq = char(lineno+48) + lnoten = 1 + end if + notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten) + lnote = lnote+2+lnoten + call addstr(notexq,lnote,soutq,lsout) end if c -c Write a separate note or rest +c Get code for a separate note or rest +c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), +c pitch will be shifted +/-1 inside notex. c call notex(notexq,lnote) end if @@ -17400,8 +18258,9 @@ c else if (btest(ipl(ivx,ip),9)) then call addstr(sq//'roff{',6,soutq,lsout) end if - if (ixrest(ivx).eq.0 .and. lnote.gt. 0) - * call addstr(notexq,lnote,soutq,lsout) + if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then + call addstr(notexq,lnote,soutq,lsout) + end if if (btest(ipl(ivx,ip),8) .or. * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout) c @@ -17814,7 +18673,7 @@ c i.e., with squez=1. Use after parsing into line to decide if c spacing needs to be "flattened" among notes groups. c common /comtol/ tol - parameter (nm=24,nkb=3999,maxblks=4000) + parameter (nm=24,nkb=3999,maxblks=9600) common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm), * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount, * nbars,itsofar(nm),nib(nm,15),nn(nm), @@ -18116,13 +18975,13 @@ c c This is called when (a) macro recording is just starting and c (b) at the start of a new line, if recording is on c - parameter (maxblks=4000) + parameter (maxblks=9600) character*128 lineq,lnholdq common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac logical mrecord,mplay,endmac common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20), * ic1mac(20),ilmac,iplmac - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq if (.not.mrecord) then @@ -18164,7 +19023,7 @@ c character*1 ulq,sepsymq,sq logical beamon,firstgulp,figbass,figchk,isfig common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /commvl/ nvmx(nm),ivmx(nm,2),ivx common /comtol/ tol if (ncc(iv) .eq. 1) then @@ -18186,23 +19045,6 @@ c c Return middle line of a clef c character*1 clefq -c if (clefq.eq.'t' .or. clefq.eq.'0') then -c ncmidf = 35 -c else if (clefq.eq.'s' .or. clefq.eq.'1') then -c ncmidf = 33 -c else if (clefq.eq.'m' .or. clefq.eq.'2') then -c ncmidf = 31 -c else if (clefq.eq.'a' .or. clefq.eq.'3') then -c ncmidf = 29 -c else if (clefq.eq.'n' .or. clefq.eq.'4') then -c ncmidf = 27 -c else if (clefq.eq.'r' .or. clefq.eq.'5') then -c ncmidf = 25 -c else if (clefq.eq.'f' .or. clefq.eq.'7') then -c ncmidf = 37 -c else -c ncmidf = 23 -c end if if (clefq .eq. '8') then c c treblelowoct; will treat as treble for this purpose @@ -18231,7 +19073,7 @@ c * tautofb,autofbon,t1autofb character*1 ulfbq,clefq common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm) logical change,autofbon nvmx(jv) = 1 @@ -18479,20 +19321,14 @@ c restq =sq//'qqs' lrest = 4 end if -c if (2**log2(nodu) .ne. nodu) then -cc -cc One or two dots on rest -cc -c restq = restq(1:3)//'p' -c lrest = 4 -c if (2*nodu .gt. 3*2**log2(nodu)) then -cc -cc Double dotted rest -cc -c restq = restq(1:4)//'p' -c lrest = 5 -c end if -c end if +c +c Special case for rest at start of F-tuplet inside a forced beam +c + if (btest(nacc(ivx,ip),18) .and. + * btest(nacc(ivx,ip),19)) then + restq = sq//'pt4'//restq(1:lrest) + lrest = lrest+4 + end if notexq = restq lnote = lrest c @@ -18512,19 +19348,8 @@ c notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote' end if lnote = 16+lnoten -c if (2**log2(nodu) .ne. nodu) then -cc -cc Have dot in raised rest. must put in hbox! -cc -c notexq = notexq(1:lnote)//sq//'hbox{' -c lnote = lnote+6 -c end if notexq = notexq(1:lnote)//restq(1:lrest) lnote = lnote+lrest -c if (2**log2(nodu) .ne. nodu) then -c notexq = notexq(1:lnote)//'}' -c lnote = lnote+1 -c end if end if if (2**log2(nodu) .ne. nodu) then c @@ -18560,9 +19385,6 @@ c * (nole.lt.0.or.nole.gt.8)) then * sq//'hbox{'//restq(1:lrest)//'}' lrest = lrest+23 end if - - - notexq = restq(1:lrest)//notexq(1:lnote) lnote = lnote+lrest end if @@ -18802,9 +19624,9 @@ cc Correct fsyst to account for transposition and key changes. cc Check for nbars > nsyst cc ccccccccccccccccccccccccccccccccccc - parameter (nm=24,nkb=3999,nks=125,maxblks=4000) + parameter (nm=24,nkb=3999,nks=125,maxblks=9600) logical loop,usefig,isfirst,optimize - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq integer nn(nm),nodur(nm,200),ivxo(600),ipo(600), @@ -18853,8 +19675,12 @@ c logical mrecord,mplay,endmac,gotclef,cstuplet * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans logical fulltrans + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset data wtimesig,wclef,wkeysig * / 0.72 , 0.8 , 0.28 / + is4bignv = .false. + AIset = .false. whead20 = 0.3 if (.not.optimize) then print* @@ -19398,7 +20224,6 @@ c * 'In system #',isyst,' cannot meet min. space rqmt' c c Find eonk by Newton method c -c eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1, * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax, * (wminpt-elmin0)/(elmin1-elmin0)) @@ -19555,7 +20380,7 @@ cc Admit "RD" before "/" (search for "rptfq2:" ) cc In doslur, for multi-line staves, single notes, check forced stem dir'n cc before setting stemup (used to set horiz offset). ccccccccccccccccccccccccccccccc - parameter (nm=24,nks=125,mv=24576,maxblks=4000) + parameter (nm=24,nks=125,mv=24576,maxblks=9600) c c FYI /all/ differs in appearance in function ncmid c @@ -19603,20 +20428,19 @@ c 31 If on, suppress printing number with xtuplet starting here ccccccccccccc cc ipl cc ccccccccccccc -cc 0-7 Location in list [0,200] -cc 0-7 Unused c 0 blank barline (must be iv=1) (would have used islur but no room) c 1 look left for K rests, moved here from iornq(30) c 2 treblelowoct -cc 2-7 Unused -c 3-7 unused +c 3 Open notehead in forced beam xtup +c 4 Set if single stem tremolo +c 5-6 termulo multiplicity - 1 +c 7 unused c 8 left offset main note one headwidth c 9 right offset main note one headwidth c 10 chord present? c 11-16 Forced beam height adjustment (-30 to +30) c 17-22 Forced beam slope adjustment (-30 to +30) c 23-26 Slur index for Way-after grace. Inserted when slur is started. -cc 27 Unused? c 27 5th bit for slur index for Way-after grace (100712) c 28 key change: only in voice 1 c 29 Grace after main note. (Type A) @@ -19654,8 +20478,9 @@ cc irest cc ccccccccccccc c 0 rest=1, no rest = 0 c 1 There will be a vertical shift for number of this xtup -c Moved hgt shft to mult 16-22, so could span -64,64. -cc 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n' +c 2 Set if 2-note tremolo starts here +c 3-4 nsolid, # of solid beams in 2-note tremolo +c 5-6 nindent, # of indented beams in 2-note tremolo c 7 There is a horizontal shift for xtup number c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 c 14 Flip up/down-ness of xtup number @@ -19781,7 +20606,7 @@ c c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. c cccccccccccccccccccccccccccccccc - character*65536 bufq + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq character*10 figq @@ -19793,7 +20618,7 @@ cccccccccccccccccccccccccccccccc logical loop,lastchar,slint,svolta,evolta,onvolt, * cwrest(nm),islast,inlast,optimize integer istop(80),numbms(nm),istart(80) - real*4 xnsttop(40),xintstaff(40),hesk(23),hpts(23),poevec(nks), + real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks), * tstart(80),squez(80) character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq character*79 notexq,inameq @@ -19820,7 +20645,7 @@ cccccccccccccccccccccccccccccccc * rptprev,equalize,rptfq1,rptfq2 common /combeam/ ibmtyp common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, - * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, + * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage, * OptLineBreakTies,HeaderSpecial common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0, * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig, @@ -19850,7 +20675,7 @@ cccccccccccccccccccccccccccccccc * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb, * btest,sluron,setis,nobar1 common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), - * ndotmv(nm),updot(nm,20),rtdot(nm,20) + * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20) common /compoi/ ispoi common /combc/ bcspec common /comeon/ eonk,ewmxk @@ -19900,6 +20725,13 @@ cccccccccccccccccccccccccccccccc logical newclef, centrests common /comlyr/ inputmlyr logical inputmlyr /.false./ + common /combottop/ botamt,topamt,bottopgap + logical bottopgap + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset + common /comhair/ idhairuse,idhair(nm) + bottopgap = .false. + idhairuse = 0 if (.not.optimize) then print* print*,'Starting second PMX pass' @@ -20190,6 +21022,7 @@ c nvolt = 0 do 28 iv = 1 , nm nudoff(iv) = 0 + maxdotmv(iv) = ndotmv(iv) ndotmv(iv) = 0 28 continue c @@ -20386,10 +21219,10 @@ c c if (clefq(iv) .eq. '8') then if (btest(ipl(iv,ioff+1),2)) then if (iv .le. 9) then - write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' else - write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iv, * sq//'treblelowoct%' end if else @@ -20842,6 +21675,21 @@ c second pass, vshrink at top of page one is dealt with in topfile, which is ca c *before* any reading in any "Av" at the top of the first input block. c if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if xnstbot = xnsttop(ipage)*etabot/etatop if (xnstbot .lt. 9.95) then fmtq = '(a,f3.1,a)' @@ -20850,6 +21698,22 @@ c end if if (islast) write(11,fmtq)sq//'vskip',xnstbot, * sq//'Interligne'//sq//'eject%' + if (islast .and. bottopgap) then + if (abs(topamt) .gt. 1.e-6) then + if (topamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (topamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (topamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',topamt, + * sq//'Internote%' + end if + bottopgap = .false. + end if else if (islast) write(11,'(a)') sq//'vfill'//sq//'eject%' end if @@ -20877,6 +21741,7 @@ c c c Vertical spacing parameters, then restart c + if (is4bignv) xinsnow = .95*xinsnow if (islast) write(11,fmtq)sq//'interstaff{',xinsnow, * '}'//sq//'contpiece' c @@ -21161,8 +22026,6 @@ c ipl(ivx,ip) = ipl(ivx,ip+ioff) iornq(ivx,ip) = iornq(ivx,ip+ioff) mult(ivx,ip) = mult(ivx,ip+ioff) -c if (ivx.le.2 .and. figbass) -c * isfig(ivx,ip) = isfig(ivx,ip+ioff) if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then if (ivx.eq.1) then isfig(1,ip) = isfig(1,ip+ioff) @@ -21203,7 +22066,6 @@ c * iptrill(it)+nib(ivtrill(it),ibar-2) 22 continue do 27 icrd = 1 , ncrd -c ivx = iand(15,ishft(icrdat(icrd),-8)) ivx = iand(15,ishft(icrdat(icrd),-8)) * +16*igetbits(icrdat(icrd),1,28) ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1) @@ -21212,7 +22074,6 @@ c ivx = iand(15,ishft(icrdat(icrd),-8)) icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd)) 27 continue do 29 iudorn = 1 , nudorn -c ivx = iand(15,ishft(kudorn(iudorn),-8)) ivx = ivxudorn(iudorn) ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1) if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2) @@ -21221,7 +22082,6 @@ c ivx = iand(15,ishft(kudorn(iudorn),-8)) 29 continue do 42 idyn = 1 , ndyn idynd = idyndat(idyn) -c ivx = iand(15,idynd) ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10) ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) c @@ -21236,9 +22096,7 @@ c 42 continue do 43 itxtdyn = 1 , ntxtdyn idynd = ivxiptxt(itxtdyn) -c ivx = iand(15,idynd) ivx = iand(31,idynd) -c ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1) if (ibar .gt. 2) then ipnew = ipnew+nib(ivx,ibar-2) @@ -21260,7 +22118,6 @@ c call setbits(idynd,8,4,ipnew) isdat1(isdat) = isdata 41 continue do 44 ibc = 1 , nbc -c ivx = iand(15,ibcdata(ibc)) ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1) if (ibar .gt. 2) then @@ -21396,7 +22253,6 @@ c else if (rptfq2 .eq. 'z') then if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece' else -c else if (rptfq2 .ne. 'D') then print* print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2 @@ -21406,6 +22262,21 @@ c else if (rptfq2 .ne. 'D') then if (islast) write(11,'(a)')sq//'Endpiece' end if if (.not.vshrink) then + if (islast .and. bottopgap) then + if (abs(botamt) .gt. 1.e-6) then + if (botamt .gt. 9.95) then + fmtq = '(a,f4.1,a)' + else if (botamt .gt. 0.) then + fmtq = '(a,f3.1,a)' + else if (botamt .gt. -9.95) then + fmtq = '(a,f4.1,a)' + else + fmtq = '(a,f5.1,a)' + end if + write(11,fmtq)sq//'null'//sq//'vskip',botamt, + * sq//'Internote%' + end if + end if xnstbot = xnsttop(ipage)*etabot/etatop if (xnstbot .lt. 9.95) then fmtq = '(a,f3.1,a)' @@ -21762,9 +22633,6 @@ c c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) invert = -levbot+4+nolev-ncm -c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' -c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), -c *levbot,nolev,ncm end if c c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote @@ -22630,11 +23498,10 @@ c c c Only print number when wanted. First check vert, horiz offset c -c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64 if (btest(irest,7)) eloff = eloff+ * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom - if (.not.usexnumt) then + if (.not.usexnumt) then notexq = chax(92)//'xnum{' lnote = 10 istrtn = 7 @@ -22667,8 +23534,8 @@ c if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 return end subroutine read10(string,lastchar) - parameter (maxblks=4000) - character*65536 bufq + parameter (maxblks=9600) + character*131072 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq character*(*) string @@ -22868,11 +23735,6 @@ c c Sets iwidbits of isdata, shifted by ishift, to ivalue c ibase = 2**iwidbit-1 - if (ivalue.gt.ibase) then - print* - print*,'WARNING in setbits: ivalue > ibase' - write(15,'(/,a)')'WARNING in setbits: ivalue > ibase' - end if isdata = iand(not(ishft(ibase,ishift)),isdata) isdata = ior(isdata,ishft(ivalue,ishift)) return @@ -22975,9 +23837,6 @@ c call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1, * 'Macro number not in range 1-20!') call stop1() -c else if (btest(macuse,macnum)) then -c print* -c print*,'WARNING: Redefining macro # ',macnum end if macuse = ibset(macuse,macnum) if (charq .eq. 'R') then @@ -23037,6 +23896,12 @@ c else ibmrep = 2*mtrnuml/mtrdenl end if + else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then +c +c Added 170726 +c + ibmtyp = 1 + ibmrep = mtrnuml/4 else c c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 @@ -23167,11 +24032,12 @@ c Reset nxtinbm for use as counter as #'s are posted by putxtn(..) c nxtinbm(ivx) = 0 smed = 0. - if (.not.btest(islur(ivx,ipb(1)),2)) then +c if (.not.btest(islur(ivx,ipb(1)),2)) then + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then c c No forced 0 slope c - if (nnb .eq. 1) go to 6 +c if (nnb .eq. 1) go to 6 nsc = 0 do 5 inb = 1 , nnb-1 do 5 jnb = inb+1 , nnb @@ -23244,12 +24110,10 @@ c if (ulq(ivx,ibc) .eq. 'u') iul = 1 ssq = 0. syb = 0. -c yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) yb1 = nolev1(ivx) * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)) do 4 inb = 1 , nnb ybeam = yb1+islope(ivx)*xelsk(inb)/slfac -c * -iul*bmhgt*(mult(ivx,ipb(inb))-1) * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1) syb = syb+ybeam ynote = nolev(ivx,ipb(inb)) @@ -23274,7 +24138,9 @@ c * -iul*bmhgt*(mult(ivx,ipb(inb))-1) ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2 if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and. * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax) - * .and. .not.btest(islur(ivx,ipb(1)),2)) then +c * .and. .not.btest(islur(ivx,ipb(1)),2)) then + * .and. .not.btest(islur(ivx,ipb(1)),2) + * .and. nnb.ne.1) then c c The first check is to save trouble of putting xtup's in setbm2. c The penultimate check is that first and last stems aren't both excessive. @@ -23285,7 +24151,6 @@ c c c Check if beam starts or ends too high or low. c -c xboff = bmhgt*(mult(ivx,ipb(1))-1) xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1) l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0. xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb) @@ -23303,7 +24168,8 @@ c c c Since one or the other end has changed, need to change slope c - if (.not.btest(islur(ivx,ipb(1)),2)) +c if (.not.btest(islur(ivx,ipb(1)),2)) + if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1) * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb)) end if if (nssb(ivx) .gt. 0) then @@ -23406,6 +24272,13 @@ c Make t[ID] look like s[ID]t c isdat2(nsdat) = ibset(isdat2(nsdat),3) end if + if (lineq(iccount+1:iccount+1).eq.'x') then +c +c Flag for 2-voice, indexed slurs +c + iccount = iccount+1 + call setbits(isdat1(nsdat),1,1,1) + end if end if call setbits(isdat1(nsdat),7,19,idcode) c @@ -23414,7 +24287,9 @@ c do 2 isdat = nsdat-1 , 1 , -1 if (idcode .eq. igetbits(isdat1(isdat),7,19) .and. * iv .eq. igetbits(isdat1(isdat),5,13) .and. - * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then +c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then + * (kv-1 .eq. igetbits(isdat1(isdat),1,12) + * .or. btest(isdat1(isdat),1))) then c c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. c @@ -23828,6 +24703,8 @@ c * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans logical EarlyTransOn,LaterInstTrans common /comsize/ isize(nm) + common /comis4bignv/ is4bignv,AIset + logical is4bignv,AIset sq = chax(92) vshrink = xinstf1.gt.20. .and. .not.novshrinktop if (vshrink) then @@ -23947,7 +24824,7 @@ c clefqiv = clefq(iv) if (clefqiv.eq.'8') then clefqiv='t' - iTransAmt(instno(iv)) = 7 + iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv)) end if if (nstaves .eq. 1) then fmtq = chax(48+numclef(clefq(iv))) @@ -24010,8 +24887,10 @@ c else fmtq = '(a,f4.1,a)' end if + facis = 1. + if (is4bignv) facis = .95 write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt' - * //sq//'interstaff{',xinstf1,'}'//sq//'relax' + * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax' else write(11,'(a)')sq//'stafftopmarg0pt'// * sq//'staffbotmarg5'//sq//'Interligne'//sq// @@ -24103,7 +24982,7 @@ c upcaseq = chq print*,'Warning, upcaseq was called with improper argument: ' * //chq - stop + stop end if return end @@ -24265,25 +25144,6 @@ c kv = 1 end if c -c Moved to pmxab to allow midivel, bal, tran as functions of instrument -c rather than staff (iv) -cc -cc Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) -cc -c nstaves = 0 -c ivt = 0 -c do 12 iinst = 1 , nm -c nstaves = nstaves+nsperi(iinst) -c do 13 ivtt = 1 , nsperi(iinst) -c ivt = ivt+1 -c iinsiv(ivt) = iinst -c13 continue -c if (nstaves .eq. nv) go to 14 -c12 continue -c print*,'Screwup!' -c call stop1() -c14 continue -c do 5 icm = 0 , numchan-1 c c Get the number of bytes in the data stream @@ -24293,10 +25153,8 @@ c ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec) 11 continue c -cc Add 3 (for instrum) plus 4 (for closing) to byte count, c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, c -c ndata = ndata+7 ndata = ndata+11 c c Add 4+lnam(iinsiv(iv)) if lnam>0 , diff --git a/Build/source/utils/pmx/pmx-src/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c index d4776386d23..38aac5a1d0f 100644 --- a/Build/source/utils/pmx/pmx-src/pmxab.c +++ b/Build/source/utils/pmx/pmx-src/pmxab.c @@ -1,3 +1,4 @@ +#line 1 "" /* -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; @@ -12,6 +13,7 @@ #include "f2c.h" +#line 1 "" /* Common Block Declarations */ struct { @@ -66,8 +68,8 @@ union { struct { integer ipbuf, ilbuf, nlbuf; - shortint lbuf[4000]; - char bufq[65536]; + shortint lbuf[9600]; + char bufq[131072]; } inbuff_; #define inbuff_1 inbuff_ @@ -503,10 +505,10 @@ struct comsize_1_ { struct { integer nnodur; real wminnh[3999]; - integer nnpd[4000]; - real durb[4000]; + integer nnpd[9600]; + real durb[9600]; integer iddot, nptr[3999], ibarcnt, mbrest, ibarmbr, ibaroff; - real udsp[3999], wheadpt, sqzb[4000]; + real udsp[3999], wheadpt, sqzb[9600]; } c1omnotes_; #define c1omnotes_1 c1omnotes_ @@ -528,6 +530,15 @@ struct { #define commidisig_1 commidisig_ struct { + integer ncc[24]; + real tcc[240] /* was [24][10] */; + integer ncmidcc[240] /* was [24][10] */, maxdotmv[24], ndotmv[24]; + real updot[480] /* was [24][20] */, rtdot[480] /* was [24][20] */; +} comcc_; + +#define comcc_1 comcc_ + +struct { integer listslur; logical upslur[48] /* was [24][2] */; integer ndxslur; @@ -537,6 +548,18 @@ struct { #define comslur_1 comslur_ +union { + struct { + integer ihairuse, idhair[24]; + } _1; + struct { + integer idhairuse, idhair[24]; + } _2; +} comhair_; + +#define comhair_1 (comhair_._1) +#define comhair_2 (comhair_._2) + struct { integer ivg[37], ipg[37], nolevg[74], itoff[148] /* was [2][74] */; real aftshft; @@ -623,6 +646,12 @@ struct { #define comligfont_1 comligfont_ struct { + logical is4bignv, aiset; +} comis4bignv_; + +#define comis4bignv_1 comis4bignv_ + +struct { logical lastchar, rptnd1, sluron[48] /* was [24][2] */, fbon, ornrpt, stickys; integer movbrk, movnmp, movdnp, movgap; @@ -646,7 +675,7 @@ struct { logical was2[24]; integer ninow; logical nobar1; - integer nsystp[40], ipage; + integer nsystp[75], ipage; logical optlinebreakties, headerspecial; } comnotes_; @@ -674,15 +703,6 @@ struct { #define comfb_1 comfb_ struct { - integer ncc[24]; - real tcc[240] /* was [24][10] */; - integer ncmidcc[240] /* was [24][10] */, ndotmv[24]; - real updot[480] /* was [24][20] */, rtdot[480] /* was [24][20] */; -} comcc_; - -#define comcc_1 comcc_ - -struct { logical bcspec; } combc_; @@ -722,11 +742,18 @@ struct { #define combibarcnt_1 combibarcnt_ -struct comlyr_1_ { +struct { logical inputmlyr; -}; +} comlyr_; + +#define comlyr_1 comlyr_ -#define comlyr_1 (*(struct comlyr_1_ *) &comlyr_) +struct { + real botamt, topamt; + logical bottopgap; +} combottop_; + +#define combottop_1 combottop_ struct { integer ivxudorn[63]; @@ -849,10 +876,6 @@ struct { 0, 0, 0, 0 }; struct { - logical e_1; - } comlyr_ = { FALSE_ }; - -struct { real e_1; } comtol_ = { .001f }; @@ -875,16 +898,18 @@ static integer c__17 = 17; static integer c__14 = 14; static integer c__129 = 129; static integer c__5 = 5; +static integer c__13 = 13; +static integer c__6 = 6; +static integer c__7 = 7; static integer c__22 = 22; static integer c__0 = 0; -static integer c__6 = 6; static integer c__27 = 27; -static integer c__7 = 7; static integer c__10 = 10; static integer c__20 = 20; -static real c_b773 = -2.f; -static real c_b774 = 0.f; -static real c_b819 = 1.f; +static integer c__26 = 26; +static real c_b1008 = -2.f; +static real c_b1009 = 0.f; +static real c_b1054 = 1.f; static integer c__8 = 8; static integer c__16 = 16; static integer c__23 = 23; @@ -893,10 +918,9 @@ static integer c__96 = 96; static integer c__21 = 21; static integer c__19 = 19; static integer c__24 = 24; -static integer c__13 = 13; static integer c__28 = 28; static integer c__18 = 18; -static real c_b1655 = 2.f; +static real c_b1902 = 2.f; static integer c__30 = 30; static integer c__60 = 60; static integer c__80 = 80; @@ -911,8 +935,8 @@ static integer c__47 = 47; { /* Initialized data */ - static char date[9] = "24 Nov 16"; - static char version[5] = "2.76 "; + static char date[9] = "10 Feb 18"; + static char version[5] = "2.84 "; static integer maxit = 200; static integer ncalls = 0; static logical isfirst = TRUE_; @@ -1064,6 +1088,39 @@ static integer c__47 = 47; /* Forced line break without line number */ /* Fix dot moving when 2nds in chord get flipped */ /* To do: increase length on notexq in dodyn */ +/* 2.84 */ +/* Bug fix: dots in chordal seconds */ +/* Bug fix: Initialize ihornb for non-beamed, down xtup */ +/* Bug fix: When using "AT" with 2-note x3c rD. */ +/* 2.83 */ +/* Fix problems when changing to or from octave treble clef. */ +/* Fix beaming (or not) and number location for xtups with */ +/* multiple rests. Still some problems with number height but */ +/* can be band-aided with number height tweak option. */ +/* Tweak error messages for options on "R" command. */ +/* Allow forced beam height and slope tweaks with 2-note tremolos */ +/* Allow chordal note with 2-note tremolos, adding dots as needed. */ +/* Fix call to ncmid in beamstrt when setting start height for beam of */ +/* 2-note trem, by changing arg from ivx to iv */ +/* 2.82 */ +/* bugfix: beams with rests, not confused with xtups. */ +/* x option after slur index to allow slurs to go from one voice to another. */ +/* x option also for ties */ +/* 2.81 */ +/* Allow string of rests to end xtup */ +/* in chordal half-note 2-note tremolo, make chord notes open. */ +/* 2.80 */ +/* Add 2-note tremolos */ +/* 2.78 */ +/* Expand bufq to 131072 bytes */ +/* Expand maxblks tp 9600 */ +/* Allow up to 75 pages */ +/* Index postscript hairpins from 1 up instead of by voice #. */ +/* Add option 'o' to forced beam for open notehead (\hb); set ipl(3) */ +/* Add option T[n], n=1,2,3 for single stem tremolo */ +/* 2.77 */ +/* Enable AV+/-x+/-y to add vskip bigh before or after \eject */ +/* 2.76 */ /* 2.75 */ /* Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and */ /* 2 or 3 flags on shortened note. */ @@ -1730,654 +1787,1149 @@ static integer c__47 = 47; /* cccccccccccccccccccccccc */ /* itstart = mytime() */ +#line 812 "" s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5); /* Initialize midi parameters */ +#line 816 "" commmac_1.gottempo = FALSE_; +#line 817 "" commidi_1.ismidi = FALSE_; +#line 818 "" commidi_1.debugmidi = FALSE_; +#line 819 "" commidi_1.relacc = FALSE_; +#line 820 "" commmac_1.mmacrec = FALSE_; +#line 821 "" commmac_1.nmidsec = 1; +#line 822 "" commidi_1.mgap = 10; +#line 823 "" comevent_1.miditime = 0; +#line 824 "" comevent_1.lasttime = 0; +#line 825 "" commidi_1.nmidcrd = 0; +#line 826 "" comslm_1.nusebl = 0; +#line 827 "" commidi_1.notmain = FALSE_; +#line 828 "" for (ivx = 1; ivx <= 24; ++ivx) { +#line 829 "" commidi_1.twoline[ivx - 1] = FALSE_; +#line 830 "" commidi_1.midinst[ivx - 1] = 6; +#line 831 "" commvel_1.midivel[ivx - 1] = 127; +#line 832 "" commvel_1.midibal[ivx - 1] = 64; +#line 833 "" commvel_1.miditran[ivx - 1] = 0; +#line 834 "" /* L3: */ +#line 834 "" } +#line 835 "" for (icm = 0; icm <= 24; ++icm) { +#line 836 "" commidi_1.imidi[icm] = 0; +#line 837 "" commidi_1.restpend[icm] = FALSE_; +#line 838 "" commidi_1.trest[icm] = 0.f; +#line 839 "" comslm_1.levson[icm] = 0; +#line 840 "" comslm_1.levsoff[icm] = 0; +#line 841 "" comslm_1.slmon[icm] = FALSE_; +#line 842 "" comslm_1.naccbl[icm] = 0; +#line 843 "" comdiag_1.n69[icm] = 0; +#line 844 "" comdiag_1.n34[icm] = 0; +#line 845 "" commmac_1.msecstrt[icm] = 1; +#line 846 "" /* L12: */ +#line 846 "" } /* End of midi parameter initialization */ +#line 850 "" commus_1.musize = 0; +#line 851 "" optimize = FALSE_; +#line 852 "" numargs = iargc_(); +#line 853 "" if (numargs == 0) { +#line 854 "" s_wsle(&io___10); - do_lio(&c__9, &c__1, "You could have entered a jobname on the comman" +#line 854 "" + do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\ "d line,", (ftnlen)53); +#line 854 "" e_wsle(); +#line 855 "" s_wsle(&io___11); +#line 855 "" do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); +#line 855 "" e_wsle(); +#line 856 "" s_rsfe(&io___12); +#line 856 "" do_fio(&c__1, jobname, (ftnlen)44); +#line 856 "" e_rsfe(); +#line 857 "" numargs = 1; +#line 858 "" } else { /* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ +#line 860 "" getarg_(&c__1, jobname, (ftnlen)44); +#line 861 "" } +#line 862 "" L10: +#line 862 "" ljob = lenstr_(jobname, &c__44, (ftnlen)44); +#line 863 "" if (ljob > 44) { +#line 864 "" s_wsle(&io___15); +#line 864 "" do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31); +#line 864 "" e_wsle(); +#line 865 "" stop1_(); +#line 866 "" } else if (ljob == 0) { +#line 867 "" s_wsle(&io___16); +#line 867 "" do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34) ; +#line 867 "" e_wsle(); +#line 868 "" stop1_(); +#line 869 "" } else if (numargs == 2) { +#line 870 "" if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) { +#line 871 "" optimize = TRUE_; /* call getarg(2,jobname,idum) ! May need to replace this w/ next line */ +#line 873 "" getarg_(&c__2, jobname, (ftnlen)44); +#line 874 "" numargs = 1; +#line 875 "" goto L10; +#line 876 "" } else { +#line 877 "" s_wsle(&io___17); +#line 877 "" do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30) ; +#line 877 "" e_wsle(); +#line 878 "" stop1_(); +#line 879 "" } +#line 880 "" } /* Strip ".pmx" if necessary */ /* Computing MAX */ +#line 884 "" i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx( jobname, ".PMX", (ftnlen)44, (ftnlen)4); +#line 884 "" ndxpmx = max(i__1,i__2); +#line 885 "" if (ndxpmx > 0) { +#line 886 "" s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1); +#line 887 "" ljob += -4; +#line 888 "" } /* Check for existence of input file */ /* Writing concatenation */ +#line 892 "" i__3[0] = ljob, a__1[0] = jobname; +#line 892 "" i__3[1] = 4, a__1[1] = ".pmx"; +#line 892 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 893 "" ioin__1.inerr = 0; +#line 893 "" ioin__1.infilen = 47; +#line 893 "" ioin__1.infile = infileq; +#line 893 "" ioin__1.inex = &fexist; +#line 893 "" ioin__1.inopen = 0; +#line 893 "" ioin__1.innum = 0; +#line 893 "" ioin__1.innamed = 0; +#line 893 "" ioin__1.inname = 0; +#line 893 "" ioin__1.inacc = 0; +#line 893 "" ioin__1.inseq = 0; +#line 893 "" ioin__1.indir = 0; +#line 893 "" ioin__1.infmt = 0; +#line 893 "" ioin__1.inform = 0; +#line 893 "" ioin__1.inunf = 0; +#line 893 "" ioin__1.inrecl = 0; +#line 893 "" ioin__1.innrec = 0; +#line 893 "" ioin__1.inblank = 0; +#line 893 "" f_inqu(&ioin__1); +#line 894 "" if (! fexist) { +#line 895 "" ioin__1.inerr = 0; +#line 895 "" ioin__1.infilen = ljob + 4; /* Writing concatenation */ +#line 895 "" i__3[0] = ljob, a__1[0] = jobname; +#line 895 "" i__3[1] = 4, a__1[1] = ".PMX"; +#line 895 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 895 "" ioin__1.infile = ch__1; +#line 895 "" ioin__1.inex = &fexist; +#line 895 "" ioin__1.inopen = 0; +#line 895 "" ioin__1.innum = 0; +#line 895 "" ioin__1.innamed = 0; +#line 895 "" ioin__1.inname = 0; +#line 895 "" ioin__1.inacc = 0; +#line 895 "" ioin__1.inseq = 0; +#line 895 "" ioin__1.indir = 0; +#line 895 "" ioin__1.infmt = 0; +#line 895 "" ioin__1.inform = 0; +#line 895 "" ioin__1.inunf = 0; +#line 895 "" ioin__1.inrecl = 0; +#line 895 "" ioin__1.innrec = 0; +#line 895 "" ioin__1.inblank = 0; +#line 895 "" f_inqu(&ioin__1); +#line 896 "" if (! fexist) { +#line 897 "" s_wsle(&io___21); /* Writing concatenation */ +#line 897 "" i__3[0] = 17, a__1[0] = "Cannot find file "; +#line 897 "" i__3[1] = 47, a__1[1] = infileq; +#line 897 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64); +#line 897 "" do_lio(&c__9, &c__1, ch__2, (ftnlen)64); +#line 897 "" e_wsle(); +#line 898 "" stop1_(); +#line 899 "" } else { /* Writing concatenation */ +#line 900 "" i__3[0] = ljob, a__1[0] = jobname; +#line 900 "" i__3[1] = 4, a__1[1] = ".PMX"; +#line 900 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 901 "" } +#line 902 "" } /* Open a log file */ +#line 906 "" o__1.oerr = 0; +#line 906 "" o__1.ounit = 15; +#line 906 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 906 "" i__3[0] = ljob, a__1[0] = jobname; +#line 906 "" i__3[1] = 4, a__1[1] = ".pml"; +#line 906 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 906 "" o__1.ofnm = ch__1; +#line 906 "" o__1.orl = 0; +#line 906 "" o__1.osta = 0; +#line 906 "" o__1.oacc = 0; +#line 906 "" o__1.ofm = 0; +#line 906 "" o__1.oblnk = 0; +#line 906 "" f_open(&o__1); /* Writing concatenation */ +#line 907 "" i__4[0] = 21, a__2[0] = "This is PMX, Version "; +#line 907 "" i__4[1] = 5, a__2[1] = version; +#line 907 "" i__4[2] = 2, a__2[2] = ", "; +#line 907 "" i__4[3] = 9, a__2[3] = date; +#line 907 "" s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37); +#line 907 "" printl_(ch__3, (ftnlen)37); +#line 908 "" ljob4 = ljob; /* Writing concatenation */ +#line 909 "" i__3[0] = 8, a__1[0] = "Opening "; +#line 909 "" i__3[1] = 47, a__1[1] = infileq; +#line 909 "" s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55); +#line 909 "" printl_(ch__4, (ftnlen)55); +#line 910 "" o__1.oerr = 0; +#line 910 "" o__1.ounit = 18; +#line 910 "" o__1.ofnmlen = 47; +#line 910 "" o__1.ofnm = infileq; +#line 910 "" o__1.orl = 0; +#line 910 "" o__1.osta = 0; +#line 910 "" o__1.oacc = 0; +#line 910 "" o__1.ofm = 0; +#line 910 "" o__1.oblnk = 0; +#line 910 "" f_open(&o__1); /* Copy input file into common buffer */ +#line 914 "" inbuff_1.ipbuf = 0; +#line 915 "" truelinecount_1.linewcom[0] = 1; - for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 4000; ++inbuff_1.ilbuf) { +#line 916 "" + for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 9600; ++inbuff_1.ilbuf) { +#line 917 "" ncomments = 0; +#line 918 "" L14: +#line 918 "" i__1 = s_rsfe(&io___24); +#line 918 "" if (i__1 != 0) { +#line 918 "" goto L9; +#line 918 "" } +#line 918 "" i__1 = do_fio(&c__1, lnholdq, (ftnlen)128); +#line 918 "" if (i__1 != 0) { +#line 918 "" goto L9; +#line 918 "" } +#line 918 "" i__1 = e_rsfe(); +#line 918 "" if (i__1 != 0) { +#line 918 "" goto L9; +#line 918 "" } +#line 919 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, & c__128, (ftnlen)128); +#line 920 "" if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) { /* Blank line. Make it a single blank with length 1 */ +#line 924 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1; +#line 925 "" s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); +#line 926 "" } /* Now line has at least one non blank character. Check for comment */ /* As of Version 260, do not copy comments into bufq */ /* But need to count %'s for error messaging */ /* if (lnholdq(1:1).eq.'%') go to 14 */ +#line 932 "" if (*(unsigned char *)lnholdq == '%') { +#line 933 "" ++ncomments; +#line 934 "" goto L14; +#line 935 "" } /* When here, have counted all preceding comments and have a real line */ +#line 939 "" if (inbuff_1.ilbuf > 1) { +#line 940 "" truelinecount_1.linewcom[inbuff_1.ilbuf - 1] = truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 + ncomments; +#line 941 "" } else { +#line 942 "" truelinecount_1.linewcom[0] = ncomments + 1; +#line 943 "" } - if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 65536) { +#line 944 "" + if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 131072) { +#line 945 "" s_wsle(&io___26); +#line 945 "" do_lio(&c__9, &c__1, "Too many characters in file, stopping", ( ftnlen)37); +#line 945 "" e_wsle(); +#line 946 "" stop1_(); +#line 947 "" } +#line 948 "" i__1 = inbuff_1.ipbuf; +#line 948 "" s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[ inbuff_1.ilbuf - 1] - i__1, (ftnlen)128); +#line 949 "" inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; +#line 950 "" /* L8: */ +#line 950 "" } +#line 951 "" printl_("Too many lines in input file", (ftnlen)28); +#line 952 "" stop1_(); +#line 953 "" L9: /* Insert dummy line to handle input files w/o CR-LF at end. */ +#line 957 "" inbuff_1.nlbuf = inbuff_1.ilbuf - 1; /* nlbuf = ilbuf */ /* bufq(ipbuf+1:ipbuf+3) = ' / ' */ /* lbuf(nlbuf) = 3 */ +#line 961 "" cl__1.cerr = 0; +#line 961 "" cl__1.cunit = 18; +#line 961 "" cl__1.csta = 0; +#line 961 "" f_clos(&cl__1); +#line 962 "" i__1 = maxit; +#line 962 "" for (numit = 1; numit <= i__1; ++numit) { +#line 963 "" if (optimize) { +#line 963 "" printl_("Starting an iteration", (ftnlen)21); +#line 963 "" } /* When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */ /* Otherwise, nbars0 is the input */ /* When islast=.false., pmxb only returns poe's, otherwise does whole job */ +#line 969 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen) 44); +#line 970 "" if (! optimize) { +#line 971 "" if (commidi_1.ismidi) { /* This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */ /* set up here as functions of instrument rather than iv (staff). */ /* Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */ +#line 977 "" nstaves = 0; +#line 978 "" ivt = 0; +#line 979 "" for (iinst = 1; iinst <= 24; ++iinst) { +#line 980 "" nstaves += c1omget_1.nsperi[iinst - 1]; +#line 981 "" i__2 = c1omget_1.nsperi[iinst - 1]; +#line 981 "" for (ivtt = 1; ivtt <= i__2; ++ivtt) { +#line 982 "" ++ivt; +#line 983 "" commvel_1.iinsiv[ivt - 1] = (shortint) iinst; +#line 984 "" /* L17: */ +#line 984 "" } +#line 985 "" if (nstaves == a1ll_1.nv) { +#line 985 "" goto L18; +#line 985 "" } +#line 986 "" /* L16: */ +#line 986 "" } +#line 987 "" s_wsle(&io___34); +#line 987 "" do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8); +#line 987 "" e_wsle(); +#line 988 "" stop1_(); +#line 989 "" L18: /* Set up channel numbers for midi. */ +#line 993 "" commidi_1.numchan = 0; +#line 994 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 995 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { +#line 996 "" commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan; +#line 997 "" ++commidi_1.numchan; +#line 998 "" } +#line 999 "" commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan; +#line 1000 "" ++commidi_1.numchan; +#line 1001 "" /* L11: */ +#line 1001 "" } /* numchan will now be the number of channels, but max channel # is numchan-1 */ /* Set up velocities, balances, and midi-transpositions */ +#line 1007 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 1008 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { /* 130302 Make these functions of instrument rather than staff (iv) */ /* midvelc(midchan(iv,2)) = midivel(iv) */ /* midbc(midchan(iv,2)) = midibal(iv) */ /* midtc(midchan(iv,2)) = miditran(iv) */ +#line 1013 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1014 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1015 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1016 "" } /* midvelc(midchan(iv,1)) = midivel(iv) */ /* midbc(midchan(iv,1)) = midibal(iv) */ /* midtc(midchan(iv,1)) = miditran(iv) */ +#line 1020 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1021 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1022 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 1023 "" /* L13: */ +#line 1023 "" } +#line 1024 "" } /* TEMPORARY!!! */ +#line 1028 "" s_wsle(&io___35); +#line 1028 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 1028 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof( integer)); +#line 1028 "" e_wsle(); +#line 1029 "" ip1 = 1; +#line 1030 "" i__2 = inbuff_1.nlbuf; +#line 1030 "" for (ilb = 1; ilb <= i__2; ++ilb) { /* write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */ /* * bufq(ip1:ip1+lbuf(ilb)-1), */ /* * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */ /* * k=min(3,lbuf(ilb)),1,-1) */ +#line 1035 "" ip1 += inbuff_1.lbuf[ilb - 1]; +#line 1036 "" /* L10000: */ +#line 1036 "" } +#line 1037 "" iplast = ip1 - 1; /* Check to see if (1) last line is "<blank><blank>/" and (2) next to last */ /* line is "/" */ -/* print*,'iplast:',iplast */ -/* print*,'Last line:' */ -/* print*,bufq(iplast+1-lbuf(nlbuf):iplast) */ -/* print*,'Last char of next to last line:' */ -/* print*,bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)) */ +#line 1042 "" i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; +#line 1042 "" if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3) == 0) { +#line 1043 "" i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; +#line 1043 "" if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[ inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) { +#line 1044 "" s_wsle(&io___39); - do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl" +#line 1044 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ "ank>/\"", (ftnlen)39); +#line 1044 "" e_wsle(); +#line 1045 "" s_wsle(&io___40); - do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl" +#line 1045 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ "ank>/\"", (ftnlen)39); +#line 1045 "" e_wsle(); +#line 1046 "" --inbuff_1.nlbuf; +#line 1047 "" } +#line 1048 "" } +#line 1050 "" pmxb_(&c_true, poe0, &ncalls, &optimize); +#line 1051 "" if (commidi_1.ismidi) { /* Write midi file */ +#line 1055 "" o__1.oerr = 0; +#line 1055 "" o__1.ounit = 51; +#line 1055 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 1055 "" i__3[0] = ljob, a__1[0] = jobname; +#line 1055 "" i__3[1] = 4, a__1[1] = ".mid"; +#line 1055 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1055 "" o__1.ofnm = ch__1; +#line 1055 "" o__1.orl = 0; +#line 1055 "" o__1.osta = 0; +#line 1055 "" o__1.oacc = 0; +#line 1055 "" o__1.ofm = 0; +#line 1055 "" o__1.oblnk = 0; +#line 1055 "" f_open(&o__1); +#line 1056 "" if (commidi_1.debugmidi) { +#line 1056 "" o__1.oerr = 0; +#line 1056 "" o__1.ounit = 52; +#line 1056 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 1056 "" i__3[0] = ljob, a__1[0] = jobname; +#line 1056 "" i__3[1] = 4, a__1[1] = ".dbm"; +#line 1056 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1056 "" o__1.ofnm = ch__1; +#line 1056 "" o__1.orl = 0; +#line 1056 "" o__1.osta = 0; +#line 1056 "" o__1.oacc = 0; +#line 1056 "" o__1.ofm = 0; +#line 1056 "" o__1.oblnk = 0; +#line 1056 "" f_open(&o__1); +#line 1056 "" } +#line 1057 "" printl_(" ", (ftnlen)1); /* Writing concatenation */ +#line 1058 "" i__5[0] = 8, a__3[0] = "Writing "; +#line 1058 "" i__5[1] = ljob, a__3[1] = jobname; +#line 1058 "" i__5[2] = 4, a__3[2] = ".mid"; +#line 1058 "" s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56); +#line 1058 "" printl_(ch__5, ljob + 12); +#line 1059 "" writemidi_(jobname, &ljob, (ftnlen)44); +#line 1060 "" } +#line 1061 "" cl__1.cerr = 0; +#line 1061 "" cl__1.cunit = 15; +#line 1061 "" cl__1.csta = 0; +#line 1061 "" f_clos(&cl__1); +#line 1062 "" s_stop("", (ftnlen)0); +#line 1063 "" } +#line 1064 "" s_wsle(&io___42); +#line 1064 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 1064 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer)) ; +#line 1064 "" e_wsle(); +#line 1065 "" ip1 = 1; +#line 1066 "" pmxb_(&c_false, poe0, &ncalls, &optimize); +#line 1067 "" poestats_(&nsyst, poe0, &poebar0, &devnorm0); /* Save initial deviation and line breaks for later comparison */ +#line 1071 "" if (numit == 1) { +#line 1072 "" devpmx = devnorm0; +#line 1073 "" i__2 = nsyst; +#line 1073 "" for (isys = 1; isys <= i__2; ++isys) { +#line 1074 "" nbari[isys - 1] = nbars0[isys - 1]; +#line 1075 "" /* L20: */ +#line 1075 "" } +#line 1076 "" } +#line 1077 "" sortpoe_(&nsyst, poe0, ipoe); +#line 1078 "" for (iupord = nsyst; iupord >= 1; --iupord) { +#line 1079 "" isysu = ipoe[iupord - 1]; +#line 1080 "" s_wsle(&io___51); +#line 1080 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1080 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1080 "" e_wsle(); +#line 1081 "" s_wsle(&io___52); +#line 1081 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1081 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1081 "" e_wsle(); /* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */ +#line 1085 "" if (poe0[isysu - 1] < poebar0) { +#line 1085 "" goto L1; +#line 1085 "" } +#line 1086 "" i__2 = nsyst; +#line 1086 "" for (idnord = 1; idnord <= i__2; ++idnord) { +#line 1087 "" isysd = ipoe[idnord - 1]; +#line 1088 "" if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd - 1] > poebar0) { +#line 1088 "" goto L5; +#line 1088 "" } +#line 1090 "" i__6 = nsyst; +#line 1090 "" for (isyst = 1; isyst <= i__6; ++isyst) { +#line 1091 "" nbars[isyst - 1] = nbars0[isyst - 1]; +#line 1092 "" if (isyst == isysu) { +#line 1093 "" ++nbars[isyst - 1]; +#line 1094 "" } else if (isyst == isysd) { +#line 1095 "" --nbars[isyst - 1]; +#line 1096 "" } +#line 1097 "" /* L2: */ +#line 1097 "" } +#line 1098 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, ( ftnlen)44); +#line 1099 "" pmxb_(&c_false, poe, &ncalls, &optimize); +#line 1100 "" poestats_(&nsyst, poe, &poebar, &devnorm); +#line 1101 "" if (devnorm < devnorm0) { +#line 1102 "" devnorm0 = devnorm; +#line 1103 "" poebar0 = poebar; +#line 1104 "" i__6 = nsyst; +#line 1104 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1105 "" nbars0[isys - 1] = nbars[isys - 1]; +#line 1106 "" poe0[isys - 1] = poe[isys - 1]; +#line 1107 "" /* L4: */ +#line 1107 "" } +#line 1108 "" s_wsle(&io___60); +#line 1108 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); +#line 1108 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); +#line 1108 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); +#line 1108 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); +#line 1108 "" e_wsle(); +#line 1110 "" s_wsle(&io___61); +#line 1110 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); +#line 1110 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); +#line 1110 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); +#line 1110 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); +#line 1110 "" e_wsle(); +#line 1112 "" s_wsfe(&io___62); +#line 1112 "" i__6 = nsyst; +#line 1112 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1112 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); +#line 1112 "" } +#line 1112 "" e_wsfe(); +#line 1113 "" s_wsfe(&io___63); +#line 1113 "" i__6 = nsyst; +#line 1113 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1113 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); +#line 1113 "" } +#line 1113 "" e_wsfe(); +#line 1114 "" sortpoe_(&nsyst, poe0, ipoe); +#line 1115 "" goto L6; +#line 1116 "" } +#line 1117 "" L5: +#line 1117 "" ; +#line 1117 "" } +#line 1118 "" L1: +#line 1118 "" ; +#line 1118 "" } /* If we get here, must have gone thru all switches and found nothing better, */ /* so done! */ +#line 1123 "" goto L7; +#line 1124 "" L6: +#line 1124 "" ; +#line 1124 "" } +#line 1125 "" L7: +#line 1126 "" s_wsle(&io___64); +#line 1126 "" do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1126 "" do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1126 "" do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1126 "" do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1126 "" e_wsle(); +#line 1127 "" s_wsle(&io___65); +#line 1127 "" do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1127 "" do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1127 "" do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1127 "" do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1127 "" e_wsle(); +#line 1128 "" s_wsle(&io___66); +#line 1128 "" do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1128 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1128 "" do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1128 "" do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1128 "" e_wsle(); +#line 1129 "" s_wsle(&io___67); +#line 1129 "" do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1129 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1129 "" do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1129 "" do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1129 "" e_wsle(); +#line 1130 "" s_wsle(&io___68); +#line 1130 "" do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1130 "" r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1130 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1130 "" e_wsle(); +#line 1131 "" s_wsle(&io___69); +#line 1131 "" do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1131 "" r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1131 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1131 "" e_wsle(); +#line 1132 "" printl_("Initial bars/system:", (ftnlen)20); +#line 1133 "" s_wsfe(&io___70); +#line 1133 "" i__1 = nsyst; +#line 1133 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1133 "" do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1133 "" } +#line 1133 "" e_wsfe(); +#line 1134 "" s_wsfe(&io___71); +#line 1134 "" i__1 = nsyst; +#line 1134 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1134 "" do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1134 "" } +#line 1134 "" e_wsfe(); +#line 1135 "" printl_("Final bars/system:", (ftnlen)18); +#line 1136 "" s_wsfe(&io___72); +#line 1136 "" i__1 = nsyst; +#line 1136 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1136 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1136 "" } +#line 1136 "" e_wsfe(); +#line 1137 "" s_wsfe(&io___73); +#line 1137 "" i__1 = nsyst; +#line 1137 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1137 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1137 "" } +#line 1137 "" e_wsfe(); +#line 1138 "" pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44); +#line 1139 "" pmxb_(&c_true, poe0, &ncalls, &optimize); -/* itend = mytime() */ -/* print*,'Elapsed time in ms:',itend-itstart */ -/* write(15,*)'Elapsed time in ms:',itend-itstart */ +#line 1140 "" cl__1.cerr = 0; +#line 1140 "" cl__1.cunit = 15; +#line 1140 "" cl__1.csta = 0; +#line 1140 "" f_clos(&cl__1); +#line 1141 "" return 0; } /* MAIN__ */ @@ -2396,28 +2948,51 @@ L7: static cilist io___75 = { 0, 6, 0, 0, 0 }; +#line 1144 "" iacc = *nacc & 7; +#line 1145 "" if (iacc == 1) { +#line 1146 "" s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2); +#line 1147 "" *lacc = 2; +#line 1148 "" } else if (iacc == 2) { +#line 1149 "" s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2); +#line 1150 "" *lacc = 2; +#line 1151 "" } else if (iacc == 3) { +#line 1152 "" s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2); +#line 1153 "" *lacc = 2; +#line 1154 "" } else if (iacc == 5) { +#line 1155 "" s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3); +#line 1156 "" *lacc = 3; +#line 1157 "" } else if (iacc == 6) { +#line 1158 "" s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3); +#line 1159 "" *lacc = 3; +#line 1160 "" } else { +#line 1161 "" s_wsle(&io___75); +#line 1161 "" do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16); +#line 1161 "" do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer)); +#line 1161 "" e_wsle(); +#line 1162 "" } +#line 1163 "" return 0; } /* accsym_ */ @@ -2442,82 +3017,123 @@ L7: static cilist io___77 = { 0, 6, 0, 0, 0 }; +#line 1172 "" if (*isudsp) { /* Find which udsp we're dealing with */ +#line 1176 "" i__1 = comudsp_1.nudsp; +#line 1176 "" for (iudsp = 1; iudsp <= i__1; ++iudsp) { +#line 1177 "" if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs( r__1)) < comtol_1.tol) { +#line 1177 "" goto L2; +#line 1177 "" } +#line 1178 "" /* L1: */ +#line 1178 "" } +#line 1179 "" s_wsle(&io___77); +#line 1179 "" do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen) 36); +#line 1179 "" e_wsle(); +#line 1180 "" stop1_(); +#line 1181 "" L2: /* Fixednew and scaldold must not be changed, since udsp's are already included */ /* in fsyst from pmxa, and udsp don't involve scaled space.. */ +#line 1186 "" if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1, comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) { /* Must add user-defined space to what's there already. */ +#line 1190 "" comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1]; +#line 1191 "" } else { /* This place has no other space. */ +#line 1195 "" ++comas1_1.naskb; +#line 1196 "" comas1_1.task[comas1_1.naskb - 1] = *taskn; +#line 1197 "" comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1]; +#line 1198 "" comas1_1.elask[comas1_1.naskb - 1] = 0.f; +#line 1199 "" } +#line 1200 "" } else { /* 130330 start */ +#line 1202 "" oldwask = 0.f; +#line 1203 "" oldelask = 0.f; /* 130330 end */ /* This is a normal space, no effect if smaller than existing space */ +#line 1208 "" if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1, comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) { /* We already put in some space at this time */ /* Check if new one needs more space than old one at same time */ +#line 1213 "" if (*waskn > comas1_1.wask[comas1_1.naskb - 1]) { /* 130330 We were double counting the larger space when it came 2nd */ /* Need to fix but don't see how yet. Assume times came in order and */ /* that last naskb defined spaces that need updating */ +#line 1219 "" oldwask = comas1_1.wask[comas1_1.naskb - 1]; +#line 1220 "" oldelask = comas1_1.elask[comas1_1.naskb - 1]; /* End of 130330 insertions */ +#line 1222 "" --comas1_1.naskb; +#line 1223 "" } else { +#line 1224 "" return 0; +#line 1225 "" } +#line 1226 "" } +#line 1227 "" ++comas1_1.naskb; +#line 1228 "" comas1_1.task[comas1_1.naskb - 1] = *taskn; +#line 1229 "" comas1_1.wask[comas1_1.naskb - 1] = *waskn; +#line 1230 "" comas1_1.elask[comas1_1.naskb - 1] = *elaskn; /* 130330 start */ /* fixednew = fixednew+waskn */ /* scaldold = scaldold+elaskn */ +#line 1234 "" *fixednew = *fixednew + *waskn - oldwask; +#line 1235 "" *scaldold = *scaldold + *elaskn - oldelask; /* 130330 end */ +#line 1237 "" } +#line 1238 "" return 0; } /* addask_ */ @@ -2533,12 +3149,18 @@ L2: /* Local variables */ static char tchar[1]; +#line 1243 "" *(unsigned char *)tchar = *(unsigned char *)noteq; /* Writing concatenation */ +#line 1244 "" i__1[0] = 1, a__1[0] = " "; +#line 1244 "" i__1[1] = 1, a__1[1] = tchar; +#line 1244 "" s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8); +#line 1245 "" *lnoten = 2; +#line 1246 "" return 0; } /* addblank_ */ @@ -2547,30 +3169,54 @@ L2: { static integer ifb; +#line 1254 "" /* Parameter adjustments */ +#line 1254 "" ulfbq -= 25; +#line 1254 "" t2fb -= 25; +#line 1254 "" t1fb -= 25; +#line 1254 "" --nfb; +#line 1254 "" +#line 1254 "" /* Function Body */ +#line 1254 "" *ifbadd = 1; +#line 1255 "" ++nfb[*iv]; +#line 1256 "" for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) { +#line 1257 "" if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) { +#line 1258 "" t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24]; +#line 1259 "" t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24]; +#line 1260 "" *(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char * )&ulfbq[*iv + ifb * 24]; +#line 1261 "" } else { +#line 1262 "" *ifbadd = ifb + 1; +#line 1263 "" goto L2; +#line 1264 "" } +#line 1265 "" /* L1: */ +#line 1265 "" } +#line 1266 "" L2: +#line 1267 "" t1fb[*iv + *ifbadd * 24] = *tnew; +#line 1268 "" *(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x'; +#line 1269 "" return 0; } /* addfb_ */ @@ -2627,117 +3273,179 @@ L2: /* Cancel out barline accidentals if there's a rest. */ +#line 1309 "" if (*rest) { +#line 1309 "" comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0; +#line 1309 "" } /* Special path to insert dummy rest at end of a section */ +#line 1313 "" if (*endrest) { +#line 1313 "" goto L20; +#line 1313 "" } +#line 1315 "" i__1 = commidi_1.nmidcrd; +#line 1315 "" for (ion = 0; ion <= i__1; ++ion) { /* check if this is only to get pitch of a chord note */ +#line 1319 "" if (commidi_1.notmain) { +#line 1319 "" goto L6; +#line 1319 "" } /* check for rest */ +#line 1323 "" if (*rest) { /* Will not put in a note, but must update timing */ +#line 1327 "" if (! commidi_1.restpend[*icm]) { /* First rest in sequence, save the time */ +#line 1331 "" commidi_1.restpend[*icm] = TRUE_; +#line 1332 "" commidi_1.trest[*icm] = *time; +#line 1333 "" } else { +#line 1334 "" commidi_1.trest[*icm] += *time; +#line 1335 "" } /* Note: code checkers don't like the above due to calling addmidi(trest(icm)) */ /* but this only happens if rest at end of section (endrest=.true.) (called */ /* from getmidi(), in which case these above lines are bypassed. */ +#line 1341 "" chkimidi_(icm); +#line 1342 "" return 0; +#line 1343 "" } /* time tics */ +#line 1347 "" if (commidi_1.imidi[*icm] > 0 && ion == 0) { +#line 1348 "" idur = commidi_1.mgap; +#line 1349 "" } else { +#line 1350 "" idur = 0; +#line 1351 "" } +#line 1352 "" if (commidi_1.restpend[*icm]) { +#line 1353 "" commidi_1.restpend[*icm] = FALSE_; +#line 1354 "" r__1 = commidi_1.trest[*icm] * 15; +#line 1354 "" idur += i_nint(&r__1); +#line 1355 "" } /* time to start of note */ +#line 1359 "" idurvar = isetvarlen_(&idur, &nby2on); +#line 1360 "" if (nby2on > 4) { +#line 1361 "" s_wsle(&io___87); +#line 1361 "" do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", ( ftnlen)37); +#line 1361 "" e_wsle(); +#line 1362 "" stop1_(); +#line 1363 "" } +#line 1364 "" ++commidi_1.imidi[*icm]; +#line 1365 "" i__2 = nby2on; +#line 1365 "" for (i__ = 1; i__ <= i__2; ++i__) { /* imidi points to cell before highest (leftmost) byte. Start with lowest byte */ /* at far right, fill in backwards */ +#line 1370 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) * 25 - 25] = (shortint) (idurvar % 256); +#line 1371 "" if (nby2on > 1) { +#line 1371 "" idurvar /= 256; +#line 1371 "" } +#line 1372 "" /* L2: */ +#line 1372 "" } +#line 1373 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1; /* Note-on signal */ +#line 1377 "" ++commidi_1.imidi[*icm]; /* mmidi(icm,imidi(icm)) = 9*16+icm */ +#line 1379 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( icmm[*icm] + 144); /* Entry point for chord note pitch determination */ +#line 1383 "" L6: /* Get midi pitch. On chord iteration, only do this first time (main note), */ /* since pitch was already computed for nonmain chord notes. */ +#line 1388 "" if (ion == 0) { +#line 1389 "" ipsav = *nolev * 12.f / 7 + 11; +#line 1390 "" ipsav0 = ipsav; +#line 1391 "" if (*midisig != 0) { /* Adjust for signature */ +#line 1395 "" *(unsigned char *)notenumq = (char) (*nolev % 7 + 48); +#line 1396 "" if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, ( ftnlen)1)) { +#line 1397 "" ++ipsav; +#line 1398 "" } else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen) 7, (ftnlen)1)) { +#line 1399 "" --ipsav; +#line 1400 "" } +#line 1401 "" } /* Deal with accidentals. */ @@ -2746,276 +3454,442 @@ L6: /* effect X fl sh na X dfl dsh X */ /* iashft X -1 1 0 X -2 2 X */ +#line 1409 "" jacc = 0; +#line 1410 "" eximacc = FALSE_; +#line 1411 "" if (*iacc > 0) { /* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */ +#line 1415 "" jacc = iashft_(iacc); +#line 1416 "" eximacc = TRUE_; +#line 1417 "" if (! commidi_1.relacc) { +#line 1417 "" jacc = jacc + ipsav0 - ipsav; +#line 1417 "" } /* (Above) Shift applies to diatonic pitch but will be added to adjusted one */ +#line 1421 "" } else if (commidi_1.naccim[*icm] > 0) { /* Possible implicit accidental from earlier in the bar */ /* Check for prior accid in this bar at this note level */ +#line 1426 "" i__2 = commidi_1.naccim[*icm]; +#line 1426 "" for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1427 "" if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { +#line 1428 "" jacc = commidi_1.jaccim[*icm + kacc * 25 - 25]; +#line 1429 "" eximacc = TRUE_; +#line 1430 "" if (! commidi_1.relacc) { +#line 1430 "" jacc = jacc + ipsav0 - ipsav; +#line 1430 "" } +#line 1431 "" goto L4; +#line 1432 "" } +#line 1433 "" /* L3: */ +#line 1433 "" } +#line 1434 "" L4: +#line 1435 "" ; +#line 1435 "" } /* Must split off the following if block from those above because chord */ /* notes can cause naccim>0, forcing us to miss other chord note's */ /* accross-bar-line accidental */ +#line 1441 "" if (comslm_1.naccbl[*icm] > 0 && ! eximacc) { /* Possible carryover accid from prior bar (or prior same-pitch note). */ +#line 1445 "" i__2 = comslm_1.naccbl[*icm]; +#line 1445 "" for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1446 "" if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) { +#line 1447 "" jacc = comslm_1.jaccbl[*icm + kacc * 25 - 25]; /* Since we are *using* the bar-line accid, must flag it to be saved for next. */ +#line 1451 "" ++comslm_1.nusebl; +#line 1452 "" comips_1.jusebl[comslm_1.nusebl - 1] = (shortint) jacc; +#line 1453 "" comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (* nolev); +#line 1454 "" if (! commidi_1.relacc) { +#line 1454 "" jacc = jacc + ipsav0 - ipsav; +#line 1454 "" } +#line 1455 "" goto L22; +#line 1456 "" } +#line 1457 "" /* L21: */ +#line 1457 "" } +#line 1458 "" L22: +#line 1459 "" ; +#line 1459 "" } +#line 1460 "" ipsav += jacc; +#line 1461 "" } +#line 1462 "" if (commidi_1.notmain) { +#line 1463 "" commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav; /* Save pitch for tie checks */ +#line 1467 "" if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) { +#line 1467 "" comips_1.ipslon[*icm] = (shortint) ipsav; +#line 1467 "" } +#line 1469 "" } else { +#line 1470 "" ++commidi_1.imidi[*icm]; +#line 1471 "" if (ion == 0) { +#line 1472 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) ipsav; +#line 1473 "" if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) { +#line 1473 "" comips_1.ipslon[*icm] = (shortint) ipsav; +#line 1473 "" } +#line 1475 "" } else { +#line 1476 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) commidi_1.mcpitch[ion - 1]; +#line 1477 "" } +#line 1478 "" } +#line 1479 "" if (ion == 0) { /* Only record accids for non-chords, main chord note during chord iteration */ /* and chordnotes on first call but not during iteration */ +#line 1484 "" if (*iacc > 0) { /* Set marker for accidental for possible continuations later this bar */ /* but first check and clear earlier ones on same note. */ +#line 1489 "" i__2 = commidi_1.naccim[*icm]; +#line 1489 "" for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1490 "" if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { +#line 1491 "" i__3 = commidi_1.naccim[*icm] - 1; +#line 1491 "" for (macc = kacc; macc <= i__3; ++macc) { +#line 1492 "" commidi_1.laccim[*icm + macc * 25 - 25] = commidi_1.laccim[*icm + (macc + 1) * 25 - 25]; +#line 1493 "" commidi_1.jaccim[*icm + macc * 25 - 25] = commidi_1.jaccim[*icm + (macc + 1) * 25 - 25]; +#line 1494 "" /* L24: */ +#line 1494 "" } +#line 1495 "" goto L25; +#line 1496 "" } +#line 1497 "" /* L23: */ +#line 1497 "" } +#line 1498 "" goto L26; +#line 1499 "" L25: +#line 1500 "" --commidi_1.naccim[*icm]; +#line 1501 "" L26: /* Flag new accidental */ +#line 1505 "" ++commidi_1.naccim[*icm]; +#line 1506 "" commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = * nolev; +#line 1507 "" commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = iashft_(iacc); +#line 1508 "" } /* Bail if this is a chord note on the first call (from docrd) */ +#line 1512 "" if (commidi_1.notmain) { +#line 1513 "" chkimidi_(icm); +#line 1514 "" return 0; +#line 1515 "" } +#line 1516 "" } /* Vel */ +#line 1520 "" ++commidi_1.imidi[*icm]; /* mmidi(icm,imidi(icm)) = 127 */ +#line 1522 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) commvel_1.midvelc[*icm]; +#line 1523 "" chkimidi_(icm); +#line 1524 "" /* L7: */ +#line 1524 "" } /* For tie checks */ +#line 1528 "" if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) { +#line 1528 "" comslm_1.imidso[*icm] = commidi_1.imidi[*icm]; +#line 1528 "" } /* Entry point for special rests at section ends (endrest=T) */ +#line 1532 "" L20: /* Now insert all the ends */ +#line 1536 "" i__1 = commidi_1.nmidcrd; +#line 1536 "" for (ioff = 0; ioff <= i__1; ++ioff) { +#line 1537 "" if (ioff == 0) { /* time to end */ +#line 1541 "" r__1 = *time * 15; +#line 1541 "" idur1 = i_nint(&r__1); +#line 1542 "" r__1 = commidi_1.trest[*icm] * 15; +#line 1542 "" if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) { +#line 1543 "" idur = idur1 - commidi_1.mgap; +#line 1544 "" } else { +#line 1545 "" idur = idur1; +#line 1546 "" } /* Deal with roundoff problems with 7-tuplets on half or quarters */ +#line 1550 "" if (idur1 == 69) { +#line 1551 "" ++comdiag_1.n69[*icm]; /* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */ +#line 1553 "" if ((comdiag_1.n69[*icm] + 6) % 7 > 3) { +#line 1553 "" idur = idur1 - commidi_1.mgap - 1; +#line 1553 "" } +#line 1554 "" } else if (idur1 == 34) { +#line 1555 "" ++comdiag_1.n34[*icm]; +#line 1556 "" if ((comdiag_1.n34[*icm] + 6) % 7 > 4) { +#line 1556 "" idur = idur1 - commidi_1.mgap + 1; +#line 1556 "" } +#line 1557 "" } +#line 1558 "" idurvar = isetvarlen_(&idur, &nby2off); +#line 1559 "" if (nby2off > 4) { +#line 1560 "" s_wsle(&io___99); +#line 1560 "" do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (ftnlen)37); +#line 1560 "" e_wsle(); +#line 1561 "" stop1_(); +#line 1562 "" } +#line 1563 "" ++commidi_1.imidi[*icm]; +#line 1564 "" chkimidi_(icm); +#line 1565 "" i__2 = nby2off; +#line 1565 "" for (i__ = 1; i__ <= i__2; ++i__) { +#line 1566 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__) * 25 - 25] = (shortint) (idurvar % 256); +#line 1567 "" if (nby2off > 1) { +#line 1567 "" idurvar /= 256; +#line 1567 "" } +#line 1568 "" /* L1: */ +#line 1568 "" } +#line 1569 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1; +#line 1570 "" } else { /* Inserting end of chord note, delta time is 0 */ +#line 1574 "" ++commidi_1.imidi[*icm]; +#line 1575 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; +#line 1576 "" } /* Note off */ +#line 1580 "" ++commidi_1.imidi[*icm]; /* mmidi(icm,imidi(icm)) = 8*16+icm */ +#line 1582 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( icmm[*icm] + 128); /* Pitch */ +#line 1586 "" ++commidi_1.imidi[*icm]; +#line 1587 "" if (ioff == 0) { +#line 1588 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) ipsav; +#line 1589 "" } else { +#line 1590 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( shortint) commidi_1.mcpitch[ioff - 1]; +#line 1591 "" } /* Vel */ +#line 1595 "" ++commidi_1.imidi[*icm]; +#line 1596 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; +#line 1597 "" chkimidi_(icm); +#line 1598 "" if (*endrest) { +#line 1599 "" return 0; +#line 1600 "" } - -/* print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time */ - +#line 1601 "" /* L8: */ +#line 1601 "" } +#line 1602 "" comslm_1.naccbl[*icm] = comslm_1.nusebl; +#line 1603 "" if (comslm_1.nusebl > 0) { /* Fix tables of "bar-line" accids that are saved due to consecutive notes. */ +#line 1607 "" i__1 = comslm_1.nusebl; +#line 1607 "" for (kacc = 1; kacc <= i__1; ++kacc) { +#line 1608 "" comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1] ; +#line 1609 "" comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1] ; +#line 1610 "" /* L30: */ +#line 1610 "" } +#line 1611 "" comslm_1.nusebl = 0; +#line 1612 "" } /* Begin tie checks */ +#line 1616 "" if (comslm_1.slmon[*icm]) { /* Prior note had a slur start */ +#line 1620 "" if (comslm_1.levson[*icm] == comslm_1.levsoff[*icm] && *iacc == 0) { /* We have a tie! (Assumed there would be no accidental on tie-ending note) */ @@ -3024,110 +3898,198 @@ L20: /* comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) */ /* Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */ /* time. */ +#line 1628 "" nsav4tie = 0; +#line 1629 "" imidt = comslm_1.imidso[*icm]; +#line 1630 "" L10: +#line 1630 "" ++nsav4tie; +#line 1631 "" itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, & imidt, &nbytes); +#line 1632 "" imidt += nbytes; +#line 1633 "" for (j = 1; j <= 3; ++j) { +#line 1634 "" itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + ( imidt + j) * 25 - 25]; +#line 1635 "" /* L11: */ +#line 1635 "" } +#line 1636 "" imidt += 3; +#line 1637 "" if (nsav4tie == 1) { +#line 1638 "" itiesav[4] = itiesav[0]; +#line 1639 "" } else { +#line 1640 "" itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] + itiesav[(nsav4tie - 1) * 5 - 1]; +#line 1642 "" } +#line 1643 "" if (imidt != commidi_1.imidi[*icm]) { +#line 1643 "" goto L10; +#line 1643 "" } /* Find which two pitches agree with saved slur pitch. */ +#line 1647 "" it1found = FALSE_; +#line 1648 "" i__1 = nsav4tie; +#line 1648 "" for (it2 = 1; it2 <= i__1; ++it2) { +#line 1649 "" if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) { +#line 1650 "" if (it1found) { +#line 1650 "" goto L13; +#line 1650 "" } +#line 1651 "" it1 = it2; +#line 1652 "" it1found = TRUE_; +#line 1653 "" } +#line 1654 "" /* L12: */ +#line 1654 "" } +#line 1655 "" printl_("Program error, tied notes, send source to Dr. Don", ( ftnlen)49); +#line 1657 "" it1 = nsav4tie + 1; +#line 1658 "" it2 = nsav4tie + 1; +#line 1659 "" L13: /* List the positions we want to keep */ +#line 1663 "" jsav = 0; +#line 1664 "" i__1 = nsav4tie; +#line 1664 "" for (isav = 1; isav <= i__1; ++isav) { +#line 1665 "" if (isav == it1 || isav == it2) { +#line 1665 "" goto L14; +#line 1665 "" } +#line 1666 "" ++jsav; +#line 1667 "" itk[jsav - 1] = (shortint) isav; +#line 1668 "" L14: +#line 1668 "" ; +#line 1668 "" } +#line 1669 "" nsav4tie += -2; /* Now dump events it1 & it2, recompute times, restack mmidi. */ +#line 1673 "" commidi_1.imidi[*icm] = comslm_1.imidso[*icm]; +#line 1674 "" i__1 = nsav4tie; +#line 1674 "" for (isav = 1; isav <= i__1; ++isav) { +#line 1675 "" if (isav == 1) { +#line 1676 "" idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], & nbytes); +#line 1677 "" } else { +#line 1678 "" i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav - 2] * 5 - 1]; +#line 1678 "" idurvar = isetvarlen_(&i__2, &nbytes); +#line 1680 "" } +#line 1681 "" ++commidi_1.imidi[*icm]; +#line 1682 "" i__2 = nbytes; +#line 1682 "" for (i__ = 1; i__ <= i__2; ++i__) { +#line 1683 "" commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes - i__) * 25 - 25] = (shortint) (idurvar % 256); +#line 1684 "" if (nbytes > 1) { +#line 1684 "" idurvar /= 256; +#line 1684 "" } +#line 1685 "" /* L16: */ +#line 1685 "" } +#line 1686 "" commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1; +#line 1687 "" for (i__ = 2; i__ <= 4; ++i__) { +#line 1688 "" ++commidi_1.imidi[*icm]; +#line 1689 "" commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) itiesav[i__ + itk[isav - 1] * 5 - 6]; +#line 1690 "" /* L17: */ +#line 1690 "" } +#line 1691 "" /* L15: */ +#line 1691 "" } +#line 1692 "" } +#line 1693 "" comslm_1.slmon[*icm] = FALSE_; +#line 1694 "" comslm_1.levsoff[*icm] = 0; +#line 1695 "" if (! comslm_1.dbltie) { +#line 1695 "" comslm_1.levson[*icm] = 0; +#line 1695 "" } +#line 1696 "" } +#line 1697 "" if (comslm_1.levson[*icm] > 0) { +#line 1697 "" comslm_1.slmon[*icm] = TRUE_; +#line 1697 "" } +#line 1698 "" if (commidi_1.nmidcrd > 0) { +#line 1698 "" commidi_1.nmidcrd = 0; +#line 1698 "" } +#line 1699 "" chkimidi_(icm); +#line 1700 "" return 0; } /* addmidi_ */ @@ -3149,27 +4111,47 @@ L14: static cilist io___111 = { 0, 11, 0, "(a)", 0 }; +#line 1707 "" if (*lsout + *lnote > 72) { +#line 1708 "" if (comlast_1.islast) { +#line 1708 "" s_wsfe(&io___111); /* Writing concatenation */ +#line 1708 "" i__1[0] = *lsout, a__1[0] = soutq; +#line 1708 "" i__1[1] = 1, a__1[1] = "%"; +#line 1708 "" s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81); +#line 1708 "" do_fio(&c__1, ch__1, *lsout + 1); +#line 1708 "" e_wsfe(); +#line 1708 "" } +#line 1709 "" *lsout = 0; +#line 1710 "" } +#line 1711 "" if (*lsout > 0) { /* Writing concatenation */ +#line 1712 "" i__1[0] = *lsout, a__1[0] = soutq; +#line 1712 "" i__1[1] = *lnote, a__1[1] = notexq; +#line 1712 "" s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80); +#line 1713 "" } else { +#line 1714 "" s_copy(soutq, notexq, (ftnlen)80, (*lnote)); +#line 1715 "" } +#line 1716 "" *lsout += *lnote; +#line 1717 "" return 0; } /* addstr_ */ @@ -3187,36 +4169,63 @@ L14: /* For block ib, this adds accidental spaces to eskz, for use in getting */ /* length of xtup bracket and slopes of brackets and beams. */ +#line 1743 "" /* Parameter adjustments */ +#line 1743 "" --istart; +#line 1743 "" +#line 1743 "" /* Function Body */ +#line 1743 "" inmin = istart[*ib] + 1; +#line 1744 "" i__1 = comas1_1.naskb; +#line 1744 "" for (iaskb = 1; iaskb <= i__1; ++iaskb) { +#line 1745 "" if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] - comtol_1.tol) { +#line 1745 "" goto L10; +#line 1745 "" } +#line 1746 "" eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb - 1]; +#line 1747 "" i__2 = comntot_1.ntot; +#line 1747 "" for (in = inmin; in <= i__2; ++in) { +#line 1748 "" if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) { +#line 1749 "" comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] += eskadd; +#line 1750 "" if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs( r__1)) < comtol_1.tol) { +#line 1750 "" --inmin; +#line 1750 "" } +#line 1751 "" } else { +#line 1752 "" ++inmin; +#line 1753 "" } +#line 1754 "" /* L11: */ +#line 1754 "" } +#line 1755 "" L10: +#line 1755 "" ; +#line 1755 "" } +#line 1756 "" return 0; } /* adjusteskz_ */ @@ -3262,185 +4271,333 @@ L10: static cilist io___129 = { 0, 12, 0, "(a)", 0 }; +#line 1768 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 1768 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 1769 "" o__1.oerr = 0; +#line 1769 "" o__1.ounit = 12; +#line 1769 "" o__1.ofnmlen = *lpath + *lbase + 4; /* Writing concatenation */ +#line 1769 "" i__1[0] = *lpath, a__1[0] = pathnameq; +#line 1769 "" i__1[1] = *lbase, a__1[1] = basenameq; +#line 1769 "" i__1[2] = 4, a__1[2] = ".tex"; +#line 1769 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88); +#line 1769 "" o__1.ofnm = ch__2; +#line 1769 "" o__1.orl = 0; +#line 1769 "" o__1.osta = 0; +#line 1769 "" o__1.oacc = 0; +#line 1769 "" o__1.ofm = 0; +#line 1769 "" o__1.oblnk = 0; +#line 1769 "" f_open(&o__1); /* Transfer first 5 lines of main internal TeX file */ +#line 1773 "" for (il = 1; il <= 5; ++il) { +#line 1774 "" moveln_(&c__11, &c__12, &done); +#line 1775 "" /* L11: */ +#line 1775 "" } +#line 1776 "" if (*istype0) { /* Transfer literal TeX stuff from special scratch file */ +#line 1780 "" al__1.aerr = 0; +#line 1780 "" al__1.aunit = 17; +#line 1780 "" f_rew(&al__1); +#line 1781 "" L10: +#line 1781 "" moveln_(&c__17, &c__12, &done); +#line 1782 "" if (! done) { +#line 1782 "" goto L10; +#line 1782 "" } +#line 1783 "" cl__1.cerr = 0; +#line 1783 "" cl__1.cunit = 17; +#line 1783 "" cl__1.csta = 0; +#line 1783 "" f_clos(&cl__1); +#line 1784 "" } /* Transfer next 2 lines from main scratch file */ +#line 1788 "" for (il = 1; il <= 2; ++il) { +#line 1789 "" moveln_(&c__11, &c__12, &done); +#line 1790 "" /* L3: */ +#line 1790 "" } +#line 1791 "" if (compoi_1.ispoi) { +#line 1791 "" s_wsfe(&io___119); /* Writing concatenation */ +#line 1791 "" i__2[0] = 1, a__2[0] = sq; +#line 1791 "" i__2[1] = 14, a__2[1] = "input musixpoi"; +#line 1791 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 1791 "" do_fio(&c__1, ch__3, (ftnlen)15); +#line 1791 "" e_wsfe(); +#line 1791 "" } +#line 1792 "" if (combbm_1.isbbm) { +#line 1792 "" s_wsfe(&io___120); /* Writing concatenation */ +#line 1792 "" i__2[0] = 1, a__2[0] = sq; +#line 1792 "" i__2[1] = 14, a__2[1] = "input musixbbm"; +#line 1792 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 1792 "" do_fio(&c__1, ch__3, (ftnlen)15); +#line 1792 "" e_wsfe(); +#line 1792 "" } +#line 1793 "" if (*figbass) { /* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */ +#line 1797 "" L4: +#line 1797 "" moveln_(&c__14, &c__12, &done); +#line 1798 "" if (! done) { +#line 1798 "" goto L4; +#line 1798 "" } +#line 1799 "" cl__1.cerr = 0; +#line 1799 "" cl__1.cunit = 14; +#line 1799 "" cl__1.csta = 0; +#line 1799 "" f_clos(&cl__1); +#line 1800 "" } +#line 1801 "" comas3_1.iask = 0; +#line 1802 "" ihs = 0; +#line 1803 "" L1: +#line 1803 "" i__3 = s_rsfe(&io___122); +#line 1803 "" if (i__3 != 0) { +#line 1803 "" goto L999; +#line 1803 "" } +#line 1803 "" i__3 = do_fio(&c__1, outq, (ftnlen)129); +#line 1803 "" if (i__3 != 0) { +#line 1803 "" goto L999; +#line 1803 "" } +#line 1803 "" i__3 = e_rsfe(); +#line 1803 "" if (i__3 != 0) { +#line 1803 "" goto L999; +#line 1803 "" } /* Hardspaces. */ /* Writing concatenation */ +#line 1807 "" i__2[0] = 1, a__2[0] = sq; +#line 1807 "" i__2[1] = 4, a__2[1] = "xard"; +#line 1807 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5); +#line 1807 "" if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) { +#line 1808 "" ++ihs; +#line 1809 "" *(unsigned char *)&outq[1] = 'h'; +#line 1810 "" s_wsfi(&io___124); +#line 1810 "" do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real)) ; +#line 1810 "" e_wsfi(); +#line 1811 "" lenout = 19; +#line 1812 "" goto L9; +#line 1813 "" } /* This part hard-wires ask's into new .tex file as ast's */ +#line 1817 "" L2: /* Writing concatenation */ +#line 1817 "" i__2[0] = 1, a__2[0] = sq; +#line 1817 "" i__2[1] = 3, a__2[1] = "ask"; +#line 1817 "" s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4); +#line 1817 "" indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4); +#line 1818 "" if (indxask != 0) { +#line 1819 "" ++comas3_1.iask; +#line 1820 "" putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129) ; +#line 1821 "" goto L2; +#line 1822 "" } +#line 1823 "" lenout = llen_(outq, &c__129, (ftnlen)129); +#line 1824 "" L9: +#line 1825 "" s_wsfe(&io___127); +#line 1825 "" do_fio(&c__1, outq, lenout); +#line 1825 "" e_wsfe(); /* If this is the line with "readmod", check for topmods. */ +#line 1829 "" if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7) == 0) { +#line 1830 "" comas3_1.topmods = FALSE_; +#line 1831 "" al__1.aerr = 0; +#line 1831 "" al__1.aunit = 16; +#line 1831 "" f_rew(&al__1); +#line 1832 "" for (il = 1; il <= 1000; ++il) { +#line 1833 "" i__3 = s_rsfe(&io___128); +#line 1833 "" if (i__3 != 0) { +#line 1833 "" goto L8; +#line 1833 "" } +#line 1833 "" i__3 = do_fio(&c__1, outq, (ftnlen)129); +#line 1833 "" if (i__3 != 0) { +#line 1833 "" goto L8; +#line 1833 "" } +#line 1833 "" i__3 = e_rsfe(); +#line 1833 "" if (i__3 != 0) { +#line 1833 "" goto L8; +#line 1833 "" } +#line 1834 "" lenout = llen_(outq, &c__129, (ftnlen)129); /* We inserted the '%' in subroutine littex, to guarantee including blank. */ +#line 1838 "" s_wsfe(&io___129); +#line 1838 "" do_fio(&c__1, outq, lenout); +#line 1838 "" e_wsfe(); +#line 1839 "" /* L7: */ +#line 1839 "" } +#line 1840 "" L8: +#line 1841 "" cl__1.cerr = 0; +#line 1841 "" cl__1.cunit = 16; +#line 1841 "" cl__1.csta = 0; +#line 1841 "" f_clos(&cl__1); +#line 1842 "" } +#line 1843 "" goto L1; +#line 1844 "" L999: +#line 1844 "" cl__1.cerr = 0; +#line 1844 "" cl__1.cunit = 11; +#line 1844 "" cl__1.csta = 0; +#line 1844 "" f_clos(&cl__1); +#line 1845 "" cl__1.cerr = 0; +#line 1845 "" cl__1.cunit = 12; +#line 1845 "" cl__1.csta = 0; +#line 1845 "" f_clos(&cl__1); +#line 1846 "" return 0; } /* askfig_ */ @@ -3472,285 +4629,1143 @@ L999: /* In iunit, looks backward for oldq, overwrites newq */ /* Safest if both are same length! */ +#line 1855 "" linesback = 0; +#line 1856 "" L1: +#line 1857 "" al__1.aerr = 0; +#line 1857 "" al__1.aunit = *iunit; +#line 1857 "" f_back(&al__1); +#line 1858 "" io___131.ciunit = *iunit; +#line 1858 "" s_rsfe(&io___131); +#line 1858 "" do_fio(&c__1, nowq, (ftnlen)128); +#line 1858 "" e_rsfe(); +#line 1859 "" ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold)); /* Save the line just read */ +#line 1863 "" ++linesback; +#line 1864 "" s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128); +#line 1865 "" if (ndx == 0) { +#line 1866 "" al__1.aerr = 0; +#line 1866 "" al__1.aunit = *iunit; +#line 1866 "" f_back(&al__1); +#line 1867 "" goto L1; +#line 1868 "" } /* If here, it's replacement time. */ +#line 1872 "" i__1 = ndx + *lenold - 1; /* Writing concatenation */ +#line 1872 "" i__2[0] = ndx - 1, a__1[0] = nowq; +#line 1872 "" i__2[1] = *lennew, a__1[1] = newq; +#line 1872 "" i__2[2] = 128 - i__1, a__1[2] = nowq + i__1; +#line 1872 "" s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128); +#line 1874 "" al__1.aerr = 0; +#line 1874 "" al__1.aunit = *iunit; +#line 1874 "" f_back(&al__1); +#line 1875 "" for (line = linesback; line >= 1; --line) { +#line 1876 "" io___136.ciunit = *iunit; +#line 1876 "" s_wsfe(&io___136); +#line 1876 "" do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128); +#line 1876 "" e_wsfe(); +#line 1877 "" /* L2: */ +#line 1877 "" } +#line 1878 "" return 0; } /* backfill_ */ /* Subroutine */ int beamend_(char *notexq, integer *lnote, ftnlen notexq_len) { /* System generated locals */ - address a__1[4], a__2[3], a__3[2]; - integer i__1, i__2[4], i__3[3], i__4[2]; + address a__1[13], a__2[2], a__3[6], a__4[4], a__5[5], a__6[3], a__7[7]; + integer i__1, i__2[13], i__3[2], i__4[6], i__5[4], i__6[5], i__7[3], i__8[ + 7], i__9; + real r__1; char ch__1[1]; /* Builtin functions */ - integer pow_ii(integer *, integer *); - /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer pow_ii(integer *, integer *), s_wsfi(icilist *), do_fio(integer *, + char *, ftnlen), e_wsfi(void); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char *, ftnlen); /* Local variables */ extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + extern integer igetbits_(integer *, integer *, integer *); static integer ip, mp, len, imp; extern integer log2_(integer *); extern /* Character */ VOID chax_(char *, ftnlen, integer *); static integer nole; + static real slen; static char ulqq[1]; extern /* Subroutine */ int stop1_(void); extern integer ncmid_(integer *, integer *); static integer ndsav; static char tempq[4], noteq[8]; - extern /* Subroutine */ int notex_(char *, integer *, ftnlen), ntrbbb_( - integer *, char *, char *, integer *, char *, integer *, ftnlen, - ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *, - ftnlen); + extern /* Subroutine */ int notex_(char *, integer *, ftnlen); + static real addoff; + extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, + char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *, + integer *, integer *, integer *, ftnlen); static logical isdotm; - static integer lnoten, multip; + static integer lnoten, multip, nindent; extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) ; /* Fortran I/O blocks */ - static cilist io___143 = { 0, 6, 0, 0, 0 }; - static cilist io___144 = { 0, 6, 0, 0, 0 }; - - + static icilist io___143 = { 0, tempq, 0, "(f4.1)", 4, 1 }; + static icilist io___144 = { 0, tempq, 0, "(f4.2)", 4, 1 }; + static icilist io___147 = { 0, noteq, 0, "(i2)", 2, 1 }; + static icilist io___149 = { 0, tempq, 0, "(f4.1)", 4, 1 }; + static icilist io___150 = { 0, tempq, 0, "(f4.2)", 4, 1 }; + static icilist io___152 = { 0, tempq, 0, "(f4.1)", 4, 1 }; + static icilist io___153 = { 0, tempq, 0, "(f4.1)", 4, 1 }; + static cilist io___154 = { 0, 6, 0, 0, 0 }; + static cilist io___155 = { 0, 6, 0, 0, 0 }; + static icilist io___159 = { 0, noteq, 0, "(i2)", 2, 1 }; + + +#line 1906 "" ip = all_1.ipo[all_1.jn - 1]; +#line 1907 "" multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; +#line 1908 "" + *lnote = 0; +#line 1909 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) { /* This is the LAST note in the xtup (i.e., all rests before). Make single. */ +#line 1913 "" i__1 = 4 - multip; +#line 1913 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 1914 "" notex_(notexq, lnote, (ftnlen)79); +#line 1915 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 1916 "" return 0; +#line 1917 "" } +#line 1918 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ +#line 1922 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 1923 "" --nole; +#line 1924 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 1925 "" ++nole; +#line 1926 "" } + +/* Terminate indented beams for 2-note tremolo if needed */ + +#line 1930 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) && + igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2, + &c__5) > 0) { +#line 1932 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], & + c__2, &c__5); +#line 1933 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 1934 "" + addoff = -1 - nindent * .5f; +#line 1935 "" + } else { +#line 1936 "" + addoff = nindent * .5f + 1; +#line 1937 "" + } +/* addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) */ +#line 1939 "" + addoff += comxtup_1.islope[commvl_1.ivx - 1] * .0822f; +#line 1940 "" + if (addoff < -.05f) { +#line 1941 "" + s_wsfi(&io___143); +#line 1941 "" + do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); +#line 1941 "" + e_wsfi(); +#line 1942 "" + } else { +#line 1943 "" + s_wsfi(&io___144); +#line 1943 "" + do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); +#line 1943 "" + e_wsfi(); +#line 1944 "" + } +/* Writing concatenation */ +#line 1945 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1945 "" + i__2[1] = 5, a__1[1] = "raise"; +#line 1945 "" + i__2[2] = 4, a__1[2] = tempq; +#line 1945 "" + i__2[3] = 1, a__1[3] = all_1.sq; +#line 1945 "" + i__2[4] = 9, a__1[4] = "internote"; +#line 1945 "" + i__2[5] = 1, a__1[5] = all_1.sq; +#line 1945 "" + i__2[6] = 5, a__1[6] = "hbox{"; +#line 1945 "" + i__2[7] = 1, a__1[7] = all_1.sq; +#line 1945 "" + i__2[8] = 12, a__1[8] = "loffset{.7}{"; +#line 1945 "" + i__2[9] = 1, a__1[9] = all_1.sq; +#line 1945 "" + i__2[10] = 2, a__1[10] = "tb"; +#line 1945 "" + i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25); +#line 1945 "" + i__2[12] = 3, a__1[12] = "0}}"; +#line 1945 "" + s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79); +#line 1948 "" + *lnote = 46; +#line 1949 "" + } +#line 1950 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ +#line 1954 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { + +/* Rest at end of unbeamed xtup */ + +#line 1958 "" + *lnote = 3; +#line 1959 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { +/* Writing concatenation */ +#line 1960 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1960 "" + i__3[1] = 2, a__2[1] = "sk"; +#line 1960 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); + +/* 180106 There was a problem with nolev(ivx,ip) not being set to 0 for */ +/* a blank rest ending xtup, but hopefully returning from here will handle it. */ + +#line 1965 "" + return 0; +#line 1966 "" + } else if (multip == 0) { +/* Writing concatenation */ +#line 1967 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1967 "" + i__3[1] = 2, a__2[1] = "qp"; +#line 1967 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 1968 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 1969 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1969 "" + i__3[1] = 2, a__2[1] = "hp"; +#line 1969 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 1970 "" + } else if (multip == 1) { +/* Writing concatenation */ +#line 1971 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1971 "" + i__3[1] = 2, a__2[1] = "ds"; +#line 1971 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 1972 "" + } else if (multip == 2) { +/* Writing concatenation */ +#line 1973 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1973 "" + i__3[1] = 2, a__2[1] = "qs"; +#line 1973 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 1974 "" + } else { +/* Writing concatenation */ +#line 1975 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1975 "" + i__3[1] = 2, a__2[1] = "hs"; +#line 1975 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 1976 "" + } + +/* 180106 Deal with possible level tweak */ + +#line 1980 "" + nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 50) % 100 - 50; +#line 1981 "" + if (nole != 0) { +#line 1982 "" + if (abs(nole) < 10) { +#line 1983 "" + i__1 = abs(nole) + 48; +#line 1983 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 1983 "" + s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 1984 "" + lnoten = 1; +#line 1985 "" + } else { +#line 1986 "" + s_wsfi(&io___147); +#line 1986 "" + i__1 = abs(nole); +#line 1986 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 1986 "" + e_wsfi(); +#line 1987 "" + lnoten = 2; +#line 1988 "" + } +#line 1989 "" + if (nole > 0) { +/* Writing concatenation */ +#line 1990 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 1990 "" + i__4[1] = 5, a__3[1] = "raise"; +#line 1990 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 1990 "" + i__4[3] = 1, a__3[3] = all_1.sq; +#line 1990 "" + i__4[4] = 9, a__3[4] = "internote"; +#line 1990 "" + i__4[5] = *lnote, a__3[5] = notexq; +#line 1990 "" + s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); +#line 1992 "" + } else { +/* Writing concatenation */ +#line 1993 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 1993 "" + i__4[1] = 5, a__3[1] = "lower"; +#line 1993 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 1993 "" + i__4[3] = 1, a__3[3] = all_1.sq; +#line 1993 "" + i__4[4] = 9, a__3[4] = "internote"; +#line 1993 "" + i__4[5] = *lnote, a__3[5] = notexq; +#line 1993 "" + s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); +#line 1995 "" + } +#line 1996 "" + *lnote = lnoten + 16 + *lnote; +#line 1997 "" + } +#line 1998 "" + return 0; +#line 1999 "" + } +#line 2000 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { /* Forced stem direction */ +#line 2004 "" ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 2005 "" i__1 = 4 - multip; +#line 2005 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2006 "" if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { +#line 2006 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; +#line 2006 "" } +#line 2008 "" notex_(notexq, lnote, (ftnlen)79); +#line 2009 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; +#line 2010 "" } else { +#line 2011 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2011 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2012 "" if (lnoten == 1) { +#line 2012 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 2012 "" } - *lnote = lnoten + 3; + +/* To reduce confusion due to this early update of lnote, do it */ +/* below, separately in each case/ */ +/* lnote = lnoten+3 */ +#line 2017 "" if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* Prior note is not regular-dotted */ - if (multip == 0) { +#line 2021 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) + && igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * + 24 - 25], &c__2, &c__5) > 0) { + +/* Unbeamed tremolo with indented beams. Put termination in right here */ + +#line 2026 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * + 24 - 25], &c__2, &c__5); +#line 2027 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') + { +#line 2028 "" + addoff = -1 - nindent * .5f; +#line 2029 "" + } else { +#line 2030 "" + addoff = nindent * .5f + 1; +#line 2031 "" + } + +/* Is there an islope here, for unbeamed? */ + +#line 2035 "" + if (addoff < -.05f) { +#line 2036 "" + s_wsfi(&io___149); +#line 2036 "" + do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); +#line 2036 "" + e_wsfi(); +#line 2037 "" + } else { +#line 2038 "" + s_wsfi(&io___150); +#line 2038 "" + do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real)); +#line 2038 "" + e_wsfi(); +#line 2039 "" + } /* Writing concatenation */ +#line 2040 "" i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "q"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2040 "" + i__2[1] = 5, a__1[1] = "raise"; +#line 2040 "" + i__2[2] = 4, a__1[2] = tempq; +#line 2040 "" + i__2[3] = 1, a__1[3] = all_1.sq; +#line 2040 "" + i__2[4] = 9, a__1[4] = "internote"; +#line 2040 "" + i__2[5] = 1, a__1[5] = all_1.sq; +#line 2040 "" + i__2[6] = 5, a__1[6] = "hbox{"; +#line 2040 "" + i__2[7] = 1, a__1[7] = all_1.sq; +#line 2040 "" + i__2[8] = 12, a__1[8] = "loffset{.7}{"; +#line 2040 "" + i__2[9] = 1, a__1[9] = all_1.sq; +#line 2040 "" + i__2[10] = 2, a__1[10] = "tb"; +#line 2040 "" + i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2040 "" + i__2[12] = 3, a__1[12] = "0}}"; +#line 2040 "" + s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79); +#line 2044 "" + *lnote = 46; +/* write(11,'(a)')notexq(1:lnote) */ +#line 2046 "" + } +#line 2047 "" + if (multip == 0) { +/* if (btest(irest(ivx,ip-1),2)) then */ +#line 2049 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - + 25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] + > 24) { + +/* 2nd note of unbeamed half-note trem; make open */ +/* But it's not clear if unbeamed half-note tremolo is Kosher, */ +/* so don't worry about stem lengths here now. */ + +#line 2056 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2057 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2057 "" + i__5[1] = 1, a__4[1] = "h"; +#line 2057 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - + 25); +#line 2057 "" + i__5[3] = 8, a__4[3] = noteq; +#line 2057 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2058 "" + } else { +/* Writing concatenation */ +#line 2059 "" + i__6[0] = 46, a__5[0] = notexq; +#line 2059 "" + i__6[1] = 1, a__5[1] = all_1.sq; +#line 2059 "" + i__6[2] = 1, a__5[2] = "h"; +#line 2059 "" + i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - + 25); +#line 2059 "" + i__6[4] = 8, a__5[4] = noteq; +#line 2059 "" + s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); +#line 2061 "" + *lnote = 46; +#line 2062 "" + } +#line 2063 "" + } else { +#line 2064 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 + - 25],2) && all_1.nodur[commvl_1.ivx + ip * + 24 - 25] == 24 || all_1.nodur[commvl_1.ivx + + ip * 24 - 25] == 12) { + +/* Need a dot. */ + +#line 2069 "" + *lnote = 46; +#line 2070 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2071 "" + i__3[0] = 1, a__2[0] = " "; +#line 2071 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2071 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2072 "" + lnoten = 2; +#line 2073 "" + } +/* Writing concatenation */ +#line 2074 "" + i__5[0] = *lnote, a__4[0] = notexq; +#line 2074 "" + i__5[1] = 1, a__4[1] = all_1.sq; +#line 2074 "" + i__5[2] = 2, a__4[2] = "pt"; +#line 2074 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2074 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2075 "" + *lnote = *lnote + 3 + lnoten; +#line 2076 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2076 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2077 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2078 "" + i__3[0] = 1, a__2[0] = " "; +#line 2078 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2078 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2079 "" + lnoten = 2; +#line 2080 "" + } + +/* Insert stemlength stuff here for unbeamed dotted tremolo. */ +/* May later combine with below to avoid repeat. But need to */ +/* return to normal stem length after note is set. */ + +#line 2086 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + ( + ip - 1) * 24 - 25], &c__2, &c__5); +#line 2087 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] + == 'u') { +#line 2088 "" + slen = (nindent + 4.5f + comxtup_1.nolev1[ + commvl_1.ivx - 1] - nole + ( + all_1.eskz[commvl_1.ivx + ip * 24 - + 25] - all_1.eskz[commvl_1.ivx + (ip - + 1) * 24 - 25] - .7f) * 1.3f * + comxtup_1.islope[commvl_1.ivx - 1] / + all_1.slfac) * .6667f; +#line 2091 "" + } else { +#line 2092 "" + slen = (nindent + 4.5f - comxtup_1.nolev1[ + commvl_1.ivx - 1] + nole - ( + all_1.eskz[commvl_1.ivx + ip * 24 - + 25] - all_1.eskz[commvl_1.ivx + (ip - + 1) * 24 - 25] - .7f) * 1.3f * + comxtup_1.islope[commvl_1.ivx - 1] / + all_1.slfac) * .6667f; +#line 2095 "" + } +#line 2096 "" + s_wsfi(&io___152); +#line 2096 "" + do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)) + ; +#line 2096 "" + e_wsfi(); +/* Writing concatenation */ +#line 2097 "" + i__6[0] = 1, a__5[0] = all_1.sq; +#line 2097 "" + i__6[1] = 4, a__5[1] = "slx{"; +#line 2097 "" + i__6[2] = 4, a__5[2] = tempq; +#line 2097 "" + i__6[3] = 1, a__5[3] = "}"; +#line 2097 "" + i__6[4] = *lnote, a__5[4] = notexq; +#line 2097 "" + s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); +#line 2098 "" + *lnote += 10; +#line 2099 "" + } +#line 2100 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2101 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2101 "" + i__5[1] = 1, a__4[1] = "q"; +#line 2101 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - + 25); +#line 2101 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2101 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2103 "" + } else { +/* Writing concatenation */ +#line 2104 "" + i__6[0] = *lnote, a__5[0] = notexq; +#line 2104 "" + i__6[1] = 1, a__5[1] = all_1.sq; +#line 2104 "" + i__6[2] = 1, a__5[2] = "q"; +#line 2104 "" + i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - + 25); +#line 2104 "" + i__6[4] = lnoten, a__5[4] = noteq; +#line 2104 "" + s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); +#line 2106 "" + } +#line 2107 "" + *lnote = *lnote + 3 + lnoten; +#line 2108 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 + - 25],2) && all_1.nodur[commvl_1.ivx + ip * + 24 - 25] == 24 || all_1.nodur[commvl_1.ivx + + ip * 24 - 25] == 12) { +/* Writing concatenation */ +#line 2110 "" + i__7[0] = *lnote, a__6[0] = notexq; +#line 2110 "" + i__7[1] = 1, a__6[1] = all_1.sq; +#line 2110 "" + i__7[2] = 3, a__6[2] = "slz"; +#line 2110 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2111 "" + *lnote += 4; +#line 2112 "" + } +#line 2113 "" + } +#line 2114 "" + } else if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 + - 25],2)) { + +/* 2nd note of unbeamed quarter or 8th trem; make quarter note */ +/* Get stemlength change */ + +#line 2119 "" + *lnote = 46; +#line 2120 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * + 24 - 25], &c__2, &c__5); +#line 2121 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') + { +#line 2122 "" + slen = (nindent + 4.5f + comxtup_1.nolev1[ + commvl_1.ivx - 1] - nole + (all_1.eskz[ + commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ + commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) * + 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / + all_1.slfac) * .6667f; +#line 2125 "" + } else { +#line 2126 "" + slen = (nindent + 4.5f - comxtup_1.nolev1[ + commvl_1.ivx - 1] + nole - (all_1.eskz[ + commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ + commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) * + 1.3f * comxtup_1.islope[commvl_1.ivx - 1] / + all_1.slfac) * .6667f; +#line 2129 "" + } +#line 2130 "" + s_wsfi(&io___153); +#line 2130 "" + do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); +#line 2130 "" + e_wsfi(); +/* Writing concatenation */ +#line 2131 "" + i__6[0] = 46, a__5[0] = notexq; +#line 2131 "" + i__6[1] = 1, a__5[1] = all_1.sq; +#line 2131 "" + i__6[2] = 4, a__5[2] = "slx{"; +#line 2131 "" + i__6[3] = 4, a__5[3] = tempq; +#line 2131 "" + i__6[4] = 1, a__5[4] = "}"; +#line 2131 "" + s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79); +#line 2132 "" + *lnote += 10; +/* if (lnote .eq. 0) then */ +/* notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */ +/* else */ +/* notexq = notexq(1:46)// */ +/* * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */ +/* end if */ + + +/* Check for dotted unbeamed tremolo */ + +#line 2143 "" + if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] / + 12.f - all_1.nodur[commvl_1.ivx + ip * 24 - 25] / + 12, dabs(r__1)) < .001f) { + +/* Need a dot */ + +#line 2147 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2148 "" + i__3[0] = 1, a__2[0] = " "; +#line 2148 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2148 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2149 "" + lnoten = 2; +#line 2150 "" + } +#line 2151 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2152 "" + i__7[0] = 1, a__6[0] = all_1.sq; +#line 2152 "" + i__7[1] = 2, a__6[1] = "pt"; +#line 2152 "" + i__7[2] = lnoten, a__6[2] = noteq; +#line 2152 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2153 "" + } else { +/* Writing concatenation */ +#line 2154 "" + i__5[0] = *lnote, a__4[0] = notexq; +#line 2154 "" + i__5[1] = 1, a__4[1] = all_1.sq; +#line 2154 "" + i__5[2] = 2, a__4[2] = "pt"; +#line 2154 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2154 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2155 "" + } +#line 2156 "" + *lnote = *lnote + 3 + lnoten; +#line 2157 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2157 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2158 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2159 "" + i__3[0] = 1, a__2[0] = " "; +#line 2159 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2159 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2160 "" + lnoten = 2; +#line 2161 "" + } +#line 2162 "" + } +/* Writing concatenation */ +#line 2163 "" + i__8[0] = *lnote, a__7[0] = notexq; +#line 2163 "" + i__8[1] = 1, a__7[1] = all_1.sq; +#line 2163 "" + i__8[2] = 1, a__7[2] = "q"; +#line 2163 "" + i__8[3] = 1, a__7[3] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2163 "" + i__8[4] = lnoten, a__7[4] = noteq; +#line 2163 "" + i__8[5] = 1, a__7[5] = all_1.sq; +#line 2163 "" + i__8[6] = 3, a__7[6] = "slz"; +#line 2163 "" + s_cat(notexq, a__7, i__8, &c__7, (ftnlen)79); +/* * //sq//'stemcut' */ +/* lnote=lnote+3+lnoten+8 */ +#line 2168 "" + *lnote = *lnote + 3 + lnoten + 4; +#line 2169 "" } else if (multip == -1) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "h"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2170 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2170 "" + i__5[1] = 1, a__4[1] = "h"; +#line 2170 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2170 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2170 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2171 "" + *lnote = lnoten + 3; +#line 2172 "" } else if (multip == 1) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "c"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2173 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2173 "" + i__5[1] = 1, a__4[1] = "c"; +#line 2173 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2173 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2173 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2174 "" + *lnote = lnoten + 3; +#line 2175 "" } else if (multip == 2) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 2, a__1[1] = "cc"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2176 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2176 "" + i__5[1] = 2, a__4[1] = "cc"; +#line 2176 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); - ++(*lnote); +#line 2176 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2176 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2177 "" + *lnote = lnoten + 4; +#line 2178 "" } else if (multip == 3) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 3, a__1[1] = "ccc"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2179 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2179 "" + i__5[1] = 3, a__4[1] = "ccc"; +#line 2179 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); - *lnote += 2; +#line 2179 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2179 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2180 "" + *lnote = lnoten + 5; +#line 2181 "" } else if (multip == -2) { /* Writing concatenation */ - i__3[0] = 1, a__2[0] = all_1.sq; - i__3[1] = 2, a__2[1] = "wh"; - i__3[2] = 8, a__2[2] = noteq; - s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 2182 "" + i__7[0] = 1, a__6[0] = all_1.sq; +#line 2182 "" + i__7[1] = 2, a__6[1] = "wh"; +#line 2182 "" + i__7[2] = lnoten, a__6[2] = noteq; +#line 2182 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2183 "" + *lnote = lnoten + 3; +#line 2184 "" } else if (multip == -3) { /* Writing concatenation */ - i__3[0] = 1, a__2[0] = all_1.sq; - i__3[1] = 5, a__2[1] = "breve"; - i__3[2] = 8, a__2[2] = noteq; - s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); - *lnote += 3; +#line 2185 "" + i__7[0] = 1, a__6[0] = all_1.sq; +#line 2185 "" + i__7[1] = 5, a__6[1] = "breve"; +#line 2185 "" + i__7[2] = lnoten, a__6[2] = noteq; +#line 2185 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2186 "" + *lnote = lnoten + 6; +#line 2187 "" } else { - s_wsle(&io___143); +#line 2188 "" + s_wsle(&io___154); +#line 2188 "" e_wsle(); - s_wsle(&io___144); - do_lio(&c__9, &c__1, "(Error in beamend, send source to " +#line 2189 "" + s_wsle(&io___155); +#line 2189 "" + do_lio(&c__9, &c__1, "(Error in beamend, send source to "\ "Dr. Don)", (ftnlen)42); +#line 2189 "" e_wsle(); +#line 2190 "" stop1_(); +#line 2191 "" } +#line 2192 "" } else { /* Prior note is regular-dotted so this one is halved */ +#line 2196 "" if (multip == 0) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "c"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2197 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2197 "" + i__5[1] = 1, a__4[1] = "c"; +#line 2197 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2197 "" + i__5[3] = 8, a__4[3] = noteq; +#line 2197 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2198 "" } else if (multip == -1) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "q"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2199 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2199 "" + i__5[1] = 1, a__4[1] = "q"; +#line 2199 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2199 "" + i__5[3] = 8, a__4[3] = noteq; +#line 2199 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2200 "" } else if (multip == -2) { /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "h"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2201 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2201 "" + i__5[1] = 1, a__4[1] = "h"; +#line 2201 "" + i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - i__2[3] = 8, a__1[3] = noteq; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2201 "" + i__5[3] = 8, a__4[3] = noteq; +#line 2201 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2202 "" } +#line 2203 "" + *lnote = lnoten + 3; +#line 2204 "" } +#line 2205 "" } +#line 2206 "" return 0; +#line 2207 "" } - i__1 = ncmid_(&all_1.iv, &ip); - notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); - *lnote = 0; + +/* End of block for unbeamed. Problem if beamed but ends w/ rest. Try just */ +/* skipping the call in that case. */ + +#line 2212 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 2213 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2213 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2214 "" + } +/* call notefq(noteq,lnoten,nole,ncmid(iv,ip)) */ +/* lnote = 0 */ /* New way, with flipend, which was computed in beamstrt. */ +#line 2220 "" if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],30)) { +#line 2221 "" i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25]; +#line 2221 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 2221 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)&ch__1[0]; +#line 2222 "" + strtmid_1.flipend[commvl_1.ivx - 1] = FALSE_; +#line 2223 "" } +#line 2224 "" if (ip > all_1.ibm1[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]) { /* This is not a one-noter from beam-jump. Check if multiplicity has increased */ +#line 2228 "" if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) { /* Prior note is a rest, check one before that */ +#line 2232 "" mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8; +#line 2233 "" } else { +#line 2234 "" mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8; +#line 2235 "" } +#line 2236 "" if (multip > mp) { /* Assume 1-3, 2-3, or 1-2 */ +#line 2240 "" i__1 = mp + 1; +#line 2240 "" for (imp = multip; imp >= i__1; --imp) { +#line 2241 "" ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); +#line 2242 "" /* L2: */ +#line 2242 "" } +#line 2243 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* 2nd member of dotted xtup */ +#line 2247 "" i__1 = multip + 1; +#line 2247 "" ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); +#line 2249 "" } +#line 2250 "" } /* Beam termination and direction analysis */ +#line 2254 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && ! combjmp_1.isbjmp) { @@ -3759,130 +5774,477 @@ L1: /* voice of the 2nd part of jumped beam. (May need special treatment for */ /* multi-segment jump-beams */ +#line 2261 "" combjmp_1.isbjmp = TRUE_; +#line 2262 "" combjmp_1.ivbj1 = commvl_1.ivx; +#line 2263 "" combjmp_1.ivbj2 = 0; +#line 2264 "" } +#line 2265 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) { /* This is either a normal beamend or end of a sequence of jump-beam segments, */ +/* (170409) or rest at end of xtup */ /* so some sort of termination is required */ +#line 2271 "" *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2272 "" if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) { +#line 2273 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { + +/* Xtup ends with rest */ + +#line 2277 "" + if (multip == 1) { +/* Writing concatenation */ +#line 2278 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2278 "" + i__3[1] = 2, a__2[1] = "ds"; +#line 2278 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2279 "" + *lnote = 3; +#line 2280 "" + } else if (multip == 2) { +/* Writing concatenation */ +#line 2281 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2281 "" + i__3[1] = 2, a__2[1] = "qs"; +#line 2281 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2282 "" + *lnote = 3; +#line 2283 "" + } else if (multip == 3) { +/* Writing concatenation */ +#line 2284 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2284 "" + i__3[1] = 2, a__2[1] = "hs"; +#line 2284 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2285 "" + *lnote = 3; +#line 2286 "" + } + +/* 170801 Borrowed from main rest entry way down below to get level adjustment: */ +/* BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? */ +/* "... Now raise if necc." */ + +#line 2292 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { + +/* Blank rest */ + +/* Writing concatenation */ +#line 2296 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2296 "" + i__3[1] = 2, a__2[1] = "sk"; +#line 2296 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2297 "" + *lnote = 3; +#line 2298 "" + } else if (nole != 0) { + +/* Bandaid. Odd case with rests in xtups + 2 voices where came thru here with */ +/* nolev=-4 but expected 100+/-. Try to fix. */ + +#line 2303 "" + if (abs(nole) < 30) { +#line 2303 "" + nole += 100; +#line 2303 "" + } + +#line 2305 "" + if ((i__1 = nole - 100, abs(i__1)) < 10) { +#line 2306 "" + i__9 = (i__1 = nole - 100, abs(i__1)) + 48; +#line 2306 "" + chax_(ch__1, (ftnlen)1, &i__9); +#line 2306 "" + s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 2307 "" + lnoten = 1; +#line 2308 "" + } else { +#line 2309 "" + s_wsfi(&io___159); +#line 2309 "" + i__9 = (i__1 = nole - 100, abs(i__1)); +#line 2309 "" + do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer)); +#line 2309 "" + e_wsfi(); +#line 2310 "" + lnoten = 2; +#line 2311 "" + } +/* ??? if (nole .gt. 0) then */ +#line 2313 "" + if (nole > 100) { +/* Writing concatenation */ +#line 2314 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 2314 "" + i__4[1] = 5, a__3[1] = "raise"; +#line 2314 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 2314 "" + i__4[3] = 1, a__3[3] = all_1.sq; +#line 2314 "" + i__4[4] = 9, a__3[4] = "internote"; +#line 2314 "" + i__4[5] = *lnote, a__3[5] = notexq; +#line 2314 "" + s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); +#line 2316 "" + } else { +/* Writing concatenation */ +#line 2317 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 2317 "" + i__4[1] = 5, a__3[1] = "lower"; +#line 2317 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 2317 "" + i__4[3] = 1, a__3[3] = all_1.sq; +#line 2317 "" + i__4[4] = 9, a__3[4] = "internote"; +#line 2317 "" + i__4[5] = *lnote, a__3[5] = notexq; +#line 2317 "" + s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79); +#line 2319 "" + } +#line 2320 "" + *lnote = lnoten + 16 + *lnote; +#line 2321 "" + } +#line 2322 "" + return 0; +#line 2323 "" + } else { /* Normal termination */ - i__1 = commvl_1.ivx % 24; - ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( - ftnlen)1, (ftnlen)79); +#line 2327 "" + i__1 = commvl_1.ivx % 24; +#line 2327 "" + ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2328 "" + } +#line 2329 "" } else { /* Terminate a sequence of jump-beam segments. */ +#line 2333 "" i__1 = 225 - *(unsigned char *)ulqq; +#line 2333 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 2333 "" *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; +#line 2334 "" i__1 = combjmp_1.ivbj1 % 24; +#line 2334 "" ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); +#line 2335 "" } +#line 2336 "" } /* Check for end of 2nd seg of staff-jump xtup chord blank rest */ /* if (isbjmp.and.ivx.eq.ivbj2 */ +#line 2341 "" if (combjmp_1.isbjmp && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 29)) { /* Writing concatenation */ - i__3[0] = *lnote, a__2[0] = notexq; - i__3[1] = 1, a__2[1] = all_1.sq; - i__3[2] = 2, a__2[2] = "sk"; - s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 2343 "" + i__7[0] = *lnote, a__6[0] = notexq; +#line 2343 "" + i__7[1] = 1, a__6[1] = all_1.sq; +#line 2343 "" + i__7[2] = 2, a__6[2] = "sk"; +#line 2343 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2344 "" return 0; +#line 2345 "" } -/* And now the note */ +/* And now the note, checking for open-head beamed tremolo */ - if (*lnote > 0) { +#line 2349 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) { + +/* Check for dotted tremolo */ + +#line 2353 "" + if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12.f - + all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12, dabs(r__1)) < + .001f) { + +/* Need a dot */ + +#line 2357 "" + if (lnoten == 1) { /* Writing concatenation */ - i__3[0] = *lnote, a__2[0] = notexq; - i__3[1] = 1, a__2[1] = all_1.sq; - i__3[2] = 2, a__2[2] = "qb"; - s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 2358 "" + i__3[0] = 1, a__2[0] = " "; +#line 2358 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2358 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2359 "" + lnoten = 2; +#line 2360 "" + } +#line 2361 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2362 "" + i__7[0] = 1, a__6[0] = all_1.sq; +#line 2362 "" + i__7[1] = 2, a__6[1] = "pt"; +#line 2362 "" + i__7[2] = lnoten, a__6[2] = noteq; +#line 2362 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2363 "" + } else { +/* Writing concatenation */ +#line 2364 "" + i__5[0] = *lnote, a__4[0] = notexq; +#line 2364 "" + i__5[1] = 1, a__4[1] = all_1.sq; +#line 2364 "" + i__5[2] = 2, a__4[2] = "pt"; +#line 2364 "" + i__5[3] = lnoten, a__4[3] = noteq; +#line 2364 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2365 "" + } +#line 2366 "" + *lnote = *lnote + 3 + lnoten; +#line 2367 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2367 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +/* Octave changes? */ +#line 2368 "" + } +#line 2369 "" + if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 32 || all_1.nodur[ + commvl_1.ivx + ip * 24 - 25] == 48) { +#line 2370 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2371 "" + i__7[0] = *lnote, a__6[0] = notexq; +#line 2371 "" + i__7[1] = 1, a__6[1] = all_1.sq; +#line 2371 "" + i__7[2] = 2, a__6[2] = "hb"; +#line 2371 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2372 "" + } else { +/* Writing concatenation */ +#line 2373 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2373 "" + i__3[1] = 2, a__2[1] = "hb"; +#line 2373 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2374 "" + } +#line 2375 "" + } else { +#line 2376 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2377 "" + i__7[0] = *lnote, a__6[0] = notexq; +#line 2377 "" + i__7[1] = 1, a__6[1] = all_1.sq; +#line 2377 "" + i__7[2] = 2, a__6[2] = "qb"; +#line 2377 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2378 "" + } else { +/* Writing concatenation */ +#line 2379 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2379 "" + i__3[1] = 2, a__2[1] = "qb"; +#line 2379 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2380 "" + } +#line 2381 "" + } +#line 2382 "" } else { + +/* No tremolo */ + +#line 2386 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2387 "" + i__7[0] = *lnote, a__6[0] = notexq; +#line 2387 "" + i__7[1] = 1, a__6[1] = all_1.sq; +#line 2387 "" + i__7[2] = 2, a__6[2] = "qb"; +#line 2387 "" + s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79); +#line 2388 "" + } else { /* Writing concatenation */ - i__4[0] = 1, a__3[0] = all_1.sq; - i__4[1] = 2, a__3[1] = "qb"; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2389 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2389 "" + i__3[1] = 2, a__2[1] = "qb"; +#line 2389 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2390 "" + } +#line 2391 "" } +#line 2392 "" *lnote += 3; +#line 2393 "" isdotm = FALSE_; +#line 2394 "" if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { +#line 2395 "" i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); +#line 2395 "" if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25]) { +#line 2396 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { /* Writing concatenation */ - i__4[0] = *lnote, a__3[0] = notexq; - i__4[1] = 1, a__3[1] = "p"; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2397 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2397 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2397 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2398 "" } else { /* Writing concatenation */ - i__4[0] = *lnote, a__3[0] = notexq; - i__4[1] = 1, a__3[1] = "m"; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2399 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2399 "" + i__3[1] = 1, a__2[1] = "m"; +#line 2399 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2400 "" isdotm = TRUE_; +#line 2401 "" } +#line 2402 "" ++(*lnote); +#line 2403 "" } +#line 2404 "" } /* 5/25/08 Allow >12 */ /* 5/9/10 Up to 24; replace 24 with 0 */ +#line 2409 "" if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { -/* call istring(mod(ivx,12),tempq,len) */ +#line 2410 "" i__1 = commvl_1.ivx % 24; +#line 2410 "" istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2411 "" } else { -/* call istring(mod(ivbj1,12),tempq,len) */ +#line 2412 "" i__1 = combjmp_1.ivbj1 % 24; +#line 2412 "" istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2413 "" } +#line 2414 "" if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) { +#line 2414 "" combjmp_1.isbjmp = FALSE_; +#line 2414 "" } /* Writing concatenation */ - i__4[0] = *lnote, a__3[0] = notexq; - i__4[1] = len, a__3[1] = tempq; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2416 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2416 "" + i__3[1] = len, a__2[1] = tempq; +#line 2416 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2417 "" *lnote += len; /* Writing concatenation */ - i__4[0] = *lnote, a__3[0] = notexq; - i__4[1] = lnoten, a__3[1] = noteq; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2418 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2418 "" + i__3[1] = lnoten, a__2[1] = noteq; +#line 2418 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2419 "" *lnote += lnoten; +#line 2420 "" if (isdotm) { +#line 2421 "" if (lnoten == 1) { /* Writing concatenation */ - i__2[0] = *lnote, a__1[0] = notexq; - i__2[1] = 1, a__1[1] = "{"; - i__2[2] = 1, a__1[2] = noteq; - i__2[3] = 1, a__1[3] = "}"; - s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2422 "" + i__5[0] = *lnote, a__4[0] = notexq; +#line 2422 "" + i__5[1] = 1, a__4[1] = "{"; +#line 2422 "" + i__5[2] = 1, a__4[2] = noteq; +#line 2422 "" + i__5[3] = 1, a__4[3] = "}"; +#line 2422 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79); +#line 2423 "" *lnote += 3; +#line 2424 "" } else { +#line 2425 "" i__1 = lnoten - 2; /* Writing concatenation */ - i__4[0] = *lnote, a__3[0] = notexq; - i__4[1] = lnoten - 1 - i__1, a__3[1] = noteq + i__1; - s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2425 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2425 "" + i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; +#line 2425 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2426 "" ++(*lnote); +#line 2427 "" } +#line 2428 "" } +#line 2429 "" return 0; } /* beamend_ */ @@ -3912,7 +6274,7 @@ L1: extern /* Subroutine */ int notex_(char *, integer *, ftnlen); extern integer levrn_(integer *, integer *, integer *, integer *, integer *); - static integer nlnum, multl, multr; + static integer nlnum, ipnow, multl, multr; extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, char *, integer *, ftnlen, ftnlen, ftnlen); static integer ipleft; @@ -3929,18 +6291,28 @@ L1: extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) ; +#line 2459 "" *lnote = 0; +#line 2460 "" ip = all_1.ipo[all_1.jn - 1]; +#line 2461 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ +#line 2465 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 2466 "" --nole; +#line 2467 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 2468 "" ++nole; +#line 2469 "" } +#line 2470 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 2471 "" multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; /* if (btest(islur(ivx,ip-1),3)) multip = multip+1 */ @@ -3950,229 +6322,371 @@ L1: /* embedded xtup with number, due to ordering/octave feature. */ /* call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */ +#line 2480 "" } +#line 2481 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) { +#line 2481 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 2481 "" } +#line 2482 "" if (comxtup_1.vxtup[commvl_1.ivx - 1]) { /* In an xtup */ +#line 2486 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { /* Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK */ +#line 2490 "" i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8); +#line 2490 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2491 "" notex_(notexq, lnote, (ftnlen)79); /* Re-zero so next note does not get confused */ +#line 2495 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0; +#line 2496 "" return 0; +#line 2497 "" } +#line 2498 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ +#line 2502 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { /* Forced stem direction */ +#line 2506 "" ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 2507 "" i__1 = 4 - multip; +#line 2507 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, & i__1); +#line 2508 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { +#line 2510 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[ commvl_1.ivx + ip * 24 - 25] * 3 / 2; +#line 2511 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { +#line 2512 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; +#line 2513 "" } +#line 2514 "" notex_(notexq, lnote, (ftnlen)79); +#line 2515 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; +#line 2516 "" } else { /* Use ulq for stem direction */ +#line 2520 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2520 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2521 "" if (lnoten == 1) { +#line 2521 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 2521 "" } +#line 2522 "" *lnote = 3; +#line 2523 "" if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25], 27)) { /* Prior note of xtup is not regular-dotted */ +#line 2527 "" if (multip == 0) { /* Writing concatenation */ +#line 2528 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2528 "" i__2[1] = 1, a__1[1] = "q"; +#line 2528 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2528 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2529 "" } else if (multip == -1) { /* Writing concatenation */ +#line 2530 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2530 "" i__2[1] = 1, a__1[1] = "h"; +#line 2530 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2530 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2531 "" } else if (multip == 1) { /* Writing concatenation */ +#line 2532 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2532 "" i__2[1] = 1, a__1[1] = "c"; +#line 2532 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2532 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2533 "" } else if (multip == 2) { /* Writing concatenation */ +#line 2534 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2534 "" i__2[1] = 2, a__1[1] = "cc"; +#line 2534 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2534 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2535 "" *lnote = 4; +#line 2536 "" } else if (multip == 3) { /* Writing concatenation */ +#line 2537 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2537 "" i__2[1] = 3, a__1[1] = "ccc"; +#line 2537 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2537 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2538 "" *lnote = 5; +#line 2539 "" } else if (multip == -2) { /* Writing concatenation */ +#line 2540 "" i__3[0] = 1, a__2[0] = all_1.sq; +#line 2540 "" i__3[1] = 2, a__2[1] = "wh"; +#line 2540 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2541 "" } +#line 2542 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { /* This xtup note is regular dotted non-beamed xtup */ /* Writing concatenation */ +#line 2546 "" i__3[0] = 3, a__2[0] = notexq; +#line 2546 "" i__3[1] = 1, a__2[1] = "p"; +#line 2546 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2547 "" *lnote = 4; +#line 2548 "" } +#line 2549 "" } else { /* Prior note of xtup is regular-dotted so this one is halved */ +#line 2553 "" if (multip == 2) { /* Writing concatenation */ +#line 2554 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2554 "" i__2[1] = 3, a__1[1] = "ccc"; +#line 2554 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2554 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2555 "" *lnote = 5; +#line 2556 "" } else if (multip == 1) { /* Writing concatenation */ +#line 2557 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2557 "" i__2[1] = 2, a__1[1] = "cc"; +#line 2557 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2557 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2558 "" *lnote = 4; +#line 2559 "" } else if (multip == 0) { /* Writing concatenation */ +#line 2560 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2560 "" i__2[1] = 1, a__1[1] = "c"; +#line 2560 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2560 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2561 "" } else if (multip == -1) { /* Writing concatenation */ +#line 2562 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2562 "" i__2[1] = 1, a__1[1] = "q"; +#line 2562 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2562 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2563 "" } else if (multip == -2) { /* Writing concatenation */ +#line 2564 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2564 "" i__2[1] = 1, a__1[1] = "h"; +#line 2564 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2564 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2565 "" } +#line 2566 "" } /* Writing concatenation */ +#line 2567 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2567 "" i__3[1] = 8, a__2[1] = noteq; +#line 2567 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2568 "" *lnote += lnoten; +#line 2569 "" } +#line 2570 "" return 0; +#line 2571 "" } else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* In the beamed xtup but not the last note */ +#line 2575 "" if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) { /* Embedded Xtup, mult>0, starts here. Put in number if needed */ +#line 2579 "" ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; +#line 2580 "" iud = 1; +#line 2581 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 2581 "" iud = -1; +#line 2581 "" } /* Get ip#, notelevel of middle note (or gap) in xtup */ +#line 2585 "" ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] / 2; +#line 2586 "" i__1 = ncmid_(&all_1.iv, &ipmid); +#line 2586 "" i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; +#line 2586 "" xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], &all_1.irest[commvl_1.ivx + ipmid * 24 - 25], & iud, &i__1, &i__4); +#line 2588 "" if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { +#line 2588 "" i__4 = ipmid - 1; +#line 2588 "" i__1 = ncmid_(&all_1.iv, &i__4); +#line 2588 "" i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - 8; +#line 2588 "" xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + ( ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24 - 25], &iud, &i__1, &i__5)) / 2; +#line 2588 "" } +#line 2591 "" iflop = 0; +#line 2592 "" if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) < 3.f) { +#line 2592 "" iflop = -iud; +#line 2592 "" } +#line 2593 "" iup = iud + (iflop << 1); +#line 2594 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) { +#line 2595 "" iup = -iup; +#line 2596 "" iflop = 0; +#line 2597 "" if (iud * iup < 0) { +#line 2597 "" iflop = iup; +#line 2597 "" } +#line 2598 "" } /* Place number if needed */ +#line 2602 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) { +#line 2603 "" mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__5, &c__22); +#line 2604 "" if (mprint == 0) { +#line 2604 "" mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25] ; +#line 2604 "" } +#line 2605 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2605 "" putxtn_(&mprint, &iflop, &multip, &iud, &comask_1.wheadpt, &comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], &comxtup_1.islope[commvl_1.ivx - 1], & @@ -4183,507 +6697,1273 @@ L1: commvl_1.ivx + ip * 24 - 25], &all_1.mult[ commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen) 79); -/* * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),.false.) */ +#line 2610 "" } +#line 2611 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2611 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2612 "" } else { /* Intermediate note of xtup */ +#line 2616 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2616 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2617 "" } +#line 2618 "" } else { /* Last note of xtup (but not last note of beam!) */ +#line 2622 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2622 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2623 "" } +#line 2624 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 2625 "" notex_(notexq, lnote, (ftnlen)79); +#line 2626 "" return 0; +#line 2627 "" } else { +#line 2628 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 2628 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); - } +#line 2629 "" + } + +/* Check for string of rests up to and including last note in xtup. */ + +/* Replace next 2 lines to keep from doing this block */ +/* when in second part of staff-jumping chordal xtup. This fix could */ +/* break some unaccounted non-chordal staff-jum xtup situations. */ +/* if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. */ +/* * .not.btest(irest(ivx,ip),0)) then */ +#line 2638 "" + if (comxtup_1.vxtup[commvl_1.ivx - 1] && bit_test(all_1.irest[ + commvl_1.ivx + (ip + 1) * 24 - 25],0) && ! bit_test(all_1.irest[ + commvl_1.ivx + ip * 24 - 25],0) && ! (combjmp_1.isbjmp && + commvl_1.ivx == combjmp_1.ivbj2)) { + +/* This note is not a rest but next is a rest. Do rests continue to */ +/* end of xtup, where nodur>0 */ + +#line 2645 "" + i__1 = ip + 24; +#line 2645 "" + for (ipnow = ip + 1; ipnow <= i__1; ++ipnow) { +#line 2646 "" + if (all_1.nodur[commvl_1.ivx + ipnow * 24 - 25] > 0) { +#line 2646 "" + goto L4; +#line 2646 "" + } +/* This is last of xtup */ +#line 2647 "" + if (! bit_test(all_1.irest[commvl_1.ivx + (ipnow + 1) * 24 - 25], + 0)) { +#line 2647 "" + goto L5; +#line 2647 "" + } + +/* If I don't go to 5, know next note IS a rest! */ + +/* Next is not */ +#line 2651 "" +/* L3: */ +#line 2651 "" + } +#line 2652 "" +L4: +#line 2653 "" + ntrbbb_(&c__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, ( + ftnlen)1, (ftnlen)1, (ftnlen)79); +/* Writing concatenation */ +#line 2654 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 2654 "" + i__2[1] = 1, a__1[1] = all_1.sq; +#line 2654 "" + i__2[2] = 2, a__1[2] = "qb"; +#line 2654 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2655 "" + *lnote += 3; +#line 2656 "" + istring_(&commvl_1.ivx, tempq, &len, (ftnlen)4); +/* Writing concatenation */ +#line 2657 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2657 "" + i__3[1] = len, a__2[1] = tempq; +#line 2657 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2658 "" + *lnote += len; +/* Writing concatenation */ +#line 2659 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2659 "" + i__3[1] = lnoten, a__2[1] = noteq; +#line 2659 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2660 "" + *lnote += lnoten; +#line 2661 "" + return 0; +#line 2662 "" +L5: /* Check if multiplicity changes in a way requiring action, */ /* unless (160211) it's blank rest on start of 2nd seg of joined beam */ - if (! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],24) || ! - bit_test(all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25],29)) { +#line 2667 "" + ; +#line 2667 "" + } else if (! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],24) + || ! bit_test(all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25],29)) + { +#line 2669 "" ipleft = ip - 1; +#line 2670 "" if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) { +#line 2670 "" --ipleft; +#line 2670 "" } +#line 2671 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) { +#line 2672 "" multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8; +#line 2673 "" } else { +#line 2674 "" multl = 1; +#line 2675 "" } +#line 2676 "" mub = multip - multl; +#line 2677 "" ipright = ip + 1; +#line 2678 "" if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) { +#line 2678 "" ++ipright; +#line 2678 "" } +#line 2679 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) { +#line 2680 "" multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8; +#line 2681 "" } else { +#line 2682 "" multr = 1; +#line 2683 "" } +#line 2684 "" mua = multr - multip; +#line 2685 "" if (mub > 0 || mua < 0) { /* Multiplicity has increased from left or will decrease to right. Need action. */ +#line 2689 "" if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) { +#line 2690 "" ivb = combjmp_1.ivbj1; +#line 2691 "" i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2691 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 2691 "" *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; +#line 2692 "" } else { +#line 2693 "" ivb = commvl_1.ivx; +#line 2694 "" *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2695 "" } +#line 2696 "" if (mua >= 0) { +#line 2697 "" ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); /* else if (multl .ge. multr) then */ /* Test for next note being blank rest, assuming staff-crossing */ /* xtup chord */ +#line 2702 "" } else if (multl >= multr && ! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 - 25],29)) { +#line 2704 "" i__1 = multr + 1; +#line 2704 "" for (im = multip; im >= i__1; --im) { +#line 2705 "" ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); +#line 2706 "" /* L1: */ +#line 2706 "" } /* else */ /* Test for next note being blank rest, assuming staff-crossing */ /* xtup chord */ +#line 2711 "" } else if (! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 - 25],29)) { +#line 2712 "" i__1 = multip; +#line 2712 "" for (im = multr + 1; im <= i__1; ++im) { +#line 2713 "" ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); +#line 2714 "" /* L2: */ +#line 2714 "" } +#line 2715 "" ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( ftnlen)1, (ftnlen)79); +#line 2716 "" } +#line 2717 "" } else if (ip > 1) { /* Check for 2nd member of dotted xtup */ +#line 2721 "" if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { +#line 2721 "" i__1 = multip + 1; +#line 2721 "" ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); +#line 2721 "" } +#line 2723 "" } +#line 2724 "" } /* Now put in the note */ +#line 2728 "" if (*lnote > 0) { /* Writing concatenation */ +#line 2729 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 2729 "" i__2[1] = 1, a__1[1] = all_1.sq; +#line 2729 "" i__2[2] = 2, a__1[2] = "qb"; +#line 2729 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2730 "" } else { /* Writing concatenation */ +#line 2731 "" i__3[0] = 1, a__2[0] = all_1.sq; +#line 2731 "" i__3[1] = 2, a__2[1] = "qb"; +#line 2731 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2732 "" } +#line 2733 "" *lnote += 3; +#line 2734 "" isdotm = FALSE_; +#line 2735 "" if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { /* rule out ')' */ +#line 2739 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { +#line 2740 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { /* Writing concatenation */ +#line 2741 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2741 "" i__3[1] = 1, a__2[1] = "p"; +#line 2741 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2742 "" } else { /* Double dot */ /* Writing concatenation */ +#line 2746 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2746 "" i__3[1] = 2, a__2[1] = "pp"; +#line 2746 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2747 "" ++(*lnote); +#line 2748 "" } +#line 2749 "" } else { /* Writing concatenation */ +#line 2750 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2750 "" i__3[1] = 1, a__2[1] = "m"; +#line 2750 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2751 "" isdotm = TRUE_; +#line 2752 "" } +#line 2753 "" ++(*lnote); +#line 2754 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) { /* Special dotted notation for 2:1 xtup, or normal dot in xtup */ /* Writing concatenation */ +#line 2759 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2759 "" i__3[1] = 1, a__2[1] = "p"; +#line 2759 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2760 "" ++(*lnote); +#line 2761 "" } /* 5/25/08 Allow >12 */ +#line 2765 "" if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { /* call istring(mod(ivx,12),tempq,len) */ +#line 2767 "" i__1 = commvl_1.ivx % 24; +#line 2767 "" istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2768 "" } else { /* call istring(mod(ivbj1,12),tempq,len) */ +#line 2770 "" i__1 = combjmp_1.ivbj1 % 24; +#line 2770 "" istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2771 "" } /* Writing concatenation */ +#line 2772 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2772 "" i__3[1] = len, a__2[1] = tempq; +#line 2772 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2773 "" *lnote += len; /* Writing concatenation */ +#line 2774 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2774 "" i__3[1] = lnoten, a__2[1] = noteq; +#line 2774 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2775 "" *lnote += lnoten; +#line 2776 "" if (isdotm) { +#line 2777 "" if (lnoten == 2) { /* Writing concatenation */ +#line 2778 "" i__6[0] = *lnote, a__3[0] = notexq; +#line 2778 "" i__6[1] = 1, a__3[1] = "{"; +#line 2778 "" i__6[2] = 1, a__3[2] = noteq + 1; +#line 2778 "" i__6[3] = 1, a__3[3] = "}"; +#line 2778 "" s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79); +#line 2779 "" *lnote += 3; +#line 2780 "" } else { +#line 2781 "" i__1 = lnoten - 2; /* Writing concatenation */ +#line 2781 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2781 "" i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; +#line 2781 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2782 "" ++(*lnote); +#line 2783 "" } +#line 2784 "" } +#line 2785 "" return 0; } /* beamid_ */ /* Subroutine */ int beamn1_(char *notexq, integer *lnote, ftnlen notexq_len) { /* System generated locals */ - address a__1[3], a__2[2], a__3[4]; - integer i__1, i__2[3], i__3[2], i__4[4]; + address a__1[3], a__2[2], a__3[4], a__4[5], a__5[7]; + integer i__1, i__2[3], i__3[2], i__4[4], i__5[5], i__6[7]; + real r__1; /* Builtin functions */ integer pow_ii(integer *, integer *); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char - *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, + char *, ftnlen); /* Local variables */ extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); - static integer nd, im, ip1, len; + extern integer igetbits_(integer *, integer *, integer *); + static integer nd, im, ip, ip1, len; extern integer log2_(integer *); static integer nole; + static real slen; extern /* Subroutine */ int stop1_(void); extern integer ncmid_(integer *, integer *); static integer ndsav; - static char noteq[8]; + static char noteq[8], tempq[8]; extern /* Subroutine */ int notex_(char *, integer *, ftnlen); static integer multr; extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, char *, integer *, ftnlen, ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *, ftnlen); static logical isdotm; - static integer lnoten, multip; + static integer lnoten, multip, nindent; extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) ; /* Fortran I/O blocks */ - static cilist io___182 = { 0, 6, 0, 0, 0 }; - static cilist io___183 = { 0, 6, 0, 0, 0 }; + static icilist io___198 = { 0, tempq, 0, "(f4.1)", 8, 1 }; + static icilist io___199 = { 0, tempq, 0, "(f4.1)", 8, 1 }; + static cilist io___200 = { 0, 6, 0, 0, 0 }; + static cilist io___201 = { 0, 6, 0, 0, 0 }; +#line 2811 "" ip1 = all_1.ipo[all_1.jn - 1]; +#line 2812 "" multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8; -/* if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then */ +#line 2813 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[ commvl_1.ivx + ip1 * 24 - 25],0)) { +#line 2814 "" *lnote = 0; /* The rest was already written in beamstrt, so just get out of here */ +#line 2818 "" return 0; +#line 2819 "" } +#line 2820 "" nole = all_1.nolev[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ +#line 2824 "" if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25], 30)) { +#line 2825 "" --nole; +#line 2826 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25],31)) { +#line 2827 "" ++nole; +#line 2828 "" } +#line 2829 "" if (comxtup_1.vxtup[commvl_1.ivx - 1] && ! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam, just put in the right kind of note */ +#line 2833 "" if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) { /* Forced stem direction */ +#line 2837 "" ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25]; +#line 2838 "" i__1 = 4 - multip; +#line 2838 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2839 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { +#line 2839 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[ commvl_1.ivx + ip1 * 24 - 25] * 3 / 2; +#line 2839 "" } +#line 2841 "" notex_(notexq, lnote, (ftnlen)79); +#line 2842 "" all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav; +#line 2843 "" } else { +#line 2844 "" i__1 = ncmid_(&all_1.iv, &ip1); +#line 2844 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2845 "" if (lnoten == 1) { +#line 2845 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 2845 "" } +#line 2846 "" *lnote = 3; - if (multip == 0) { +#line 2847 "" + if (multip <= 0) { +/* if (btest(irest(ivx,ip1),2) .and. */ +/* * nodur(ivx,ip1+1).ge.32) then */ +#line 2850 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && + all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32 + || multip == -1) { + +/* 1st note of unbeamed half-note trem; make open */ + /* Writing concatenation */ - i__2[0] = 1, a__1[0] = all_1.sq; - i__2[1] = 1, a__1[1] = "q"; - i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + +#line 2856 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2856 "" + i__2[1] = 1, a__1[1] = "h"; +#line 2856 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2856 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2857 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 2858 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2858 "" + i__3[1] = 2, a__2[1] = "wh"; +#line 2858 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2859 "" + } else { +/* Writing concatenation */ +#line 2860 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2860 "" + i__2[1] = 1, a__1[1] = "q"; +#line 2860 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2860 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2861 "" + } + +/* Check for dot */ + +#line 2865 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && ( + r__1 = all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] + / 12.f - all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - + 25] / 12, dabs(r__1)) < .001f) { +/* * abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then */ + +/* Need a dot. already called addblank for noteq */ + +#line 2871 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2872 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2872 "" + i__2[1] = 2, a__1[1] = "pt"; +#line 2872 "" + i__2[2] = lnoten, a__1[2] = noteq; +#line 2872 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2873 "" + } else { +/* Writing concatenation */ +#line 2874 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 2874 "" + i__4[1] = 2, a__3[1] = "pt"; +#line 2874 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 2874 "" + i__4[3] = *lnote, a__3[3] = notexq; +#line 2874 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 2875 "" + } +#line 2876 "" + *lnote = *lnote + 3 + lnoten; +#line 2877 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2877 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +/* Octave chang */ +#line 2878 "" + if (lnoten == 1) { +#line 2878 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 2878 "" + } +#line 2879 "" + } + +/* Insert the stemlength calcs here for dotted, unbeamed. */ +/* Later may combine with below to avoid repeat. */ + +#line 2884 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) { +#line 2885 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 + - 25], &c__2, &c__5); +#line 2886 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') + { +#line 2887 "" + slen = (nindent + 4.5f + comxtup_1.nolev1[ + commvl_1.ivx - 1] - nole - comxtup_1.islope[ + commvl_1.ivx - 1] * .4f / all_1.slfac) * + .6667f; +#line 2889 "" + } else { +#line 2890 "" + slen = (nindent + 4.5f - comxtup_1.nolev1[ + commvl_1.ivx - 1] + nole + comxtup_1.islope[ + commvl_1.ivx - 1] * .4f / all_1.slfac) * + .6667f; +#line 2892 "" + } +#line 2893 "" + s_wsfi(&io___198); +#line 2893 "" + do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); +#line 2893 "" + e_wsfi(); +/* Writing concatenation */ +#line 2894 "" + i__5[0] = 1, a__4[0] = all_1.sq; +#line 2894 "" + i__5[1] = 4, a__4[1] = "slx{"; +#line 2894 "" + i__5[2] = 4, a__4[2] = tempq; +#line 2894 "" + i__5[3] = 1, a__4[3] = "}"; +#line 2894 "" + i__5[4] = *lnote, a__4[4] = notexq; +#line 2894 "" + s_cat(notexq, a__4, i__5, &c__5, (ftnlen)79); +#line 2896 "" + *lnote += 10; +#line 2897 "" + } +#line 2898 "" + } else if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) + { + +/* 1st note of unbeamed quarter or 8th trem, make a quarter note */ + +/* Stem length calcs here. The .2 factor is empirical, but */ +/* slfac accounts for musicsize. */ + +#line 2905 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 - 25] + , &c__2, &c__5); +#line 2906 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 2907 "" + slen = (nindent + 4.5f + comxtup_1.nolev1[commvl_1.ivx - + 1] - nole - comxtup_1.islope[commvl_1.ivx - 1] * + .4f / all_1.slfac) * .6667f; +#line 2909 "" + } else { +#line 2910 "" + slen = (nindent + 4.5f - comxtup_1.nolev1[commvl_1.ivx - + 1] + nole + comxtup_1.islope[commvl_1.ivx - 1] * + .4f / all_1.slfac) * .6667f; +#line 2912 "" + } +#line 2913 "" + s_wsfi(&io___199); +#line 2913 "" + do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real)); +#line 2913 "" + e_wsfi(); +/* Writing concatenation */ +#line 2914 "" + i__6[0] = 1, a__5[0] = all_1.sq; +#line 2914 "" + i__6[1] = 4, a__5[1] = "slx{"; +#line 2914 "" + i__6[2] = 4, a__5[2] = tempq; +#line 2914 "" + i__6[3] = 1, a__5[3] = "}"; +#line 2914 "" + i__6[4] = 1, a__5[4] = all_1.sq; +#line 2914 "" + i__6[5] = 1, a__5[5] = "q"; +#line 2914 "" + i__6[6] = 1, a__5[6] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); - s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2914 "" + s_cat(notexq, a__5, i__6, &c__7, (ftnlen)79); +#line 2916 "" + *lnote = 13; + +/* Check for dotted 2-note trem; prepend dot to notexq if needed */ + +#line 2920 "" + if (all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 || + all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24) + { +#line 2922 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2923 "" + i__3[0] = 1, a__2[0] = " "; +#line 2923 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2923 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2924 "" + lnoten = 2; +#line 2925 "" + } +/* Writing concatenation */ +#line 2926 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 2926 "" + i__4[1] = 2, a__3[1] = "pt"; +#line 2926 "" + i__4[2] = lnoten, a__3[2] = noteq; +#line 2926 "" + i__4[3] = *lnote, a__3[3] = notexq; +#line 2926 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 2927 "" + *lnote = *lnote + 3 + lnoten; +#line 2928 "" + i__1 = ncmid_(&all_1.iv, &ip1); +#line 2928 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2929 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2930 "" + i__3[0] = 1, a__2[0] = " "; +#line 2930 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2930 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2931 "" + lnoten = 2; +#line 2932 "" + } +#line 2933 "" + } +#line 2934 "" } else if (multip == -1) { /* Writing concatenation */ +#line 2935 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2935 "" i__2[1] = 1, a__1[1] = "h"; +#line 2935 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2935 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2936 "" } else if (multip == 1) { /* Writing concatenation */ +#line 2937 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2937 "" i__2[1] = 1, a__1[1] = "c"; +#line 2937 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2937 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2938 "" } else if (multip == 2) { /* Writing concatenation */ +#line 2939 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2939 "" i__2[1] = 2, a__1[1] = "cc"; +#line 2939 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2939 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2940 "" *lnote = 4; +#line 2941 "" } else if (multip == 3) { /* Writing concatenation */ +#line 2942 "" i__2[0] = 1, a__1[0] = all_1.sq; +#line 2942 "" i__2[1] = 3, a__1[1] = "ccc"; +#line 2942 "" i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2942 "" s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2943 "" *lnote = 5; +#line 2944 "" } else if (multip == -2) { /* Writing concatenation */ +#line 2945 "" i__3[0] = 1, a__2[0] = all_1.sq; +#line 2945 "" i__3[1] = 2, a__2[1] = "wh"; +#line 2945 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2946 "" } else if (multip == -3) { /* Writing concatenation */ +#line 2947 "" i__3[0] = 1, a__2[0] = all_1.sq; +#line 2947 "" i__3[1] = 5, a__2[1] = "breve"; +#line 2947 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2948 "" *lnote = 6; +#line 2949 "" } else { - s_wsle(&io___182); +#line 2950 "" + s_wsle(&io___200); +#line 2950 "" e_wsle(); - s_wsle(&io___183); - do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D" +#line 2951 "" + s_wsle(&io___201); +#line 2951 "" + do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"\ "on)", (ftnlen)41); +#line 2951 "" e_wsle(); +#line 2952 "" stop1_(); +#line 2953 "" } +#line 2954 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { /* notexq = notexq(1:3)//'p' */ /* lnote = 4 */ /* Writing concatenation */ +#line 2957 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2957 "" i__3[1] = 1, a__2[1] = "p"; +#line 2957 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2958 "" ++(*lnote); +#line 2959 "" } /* Writing concatenation */ +#line 2960 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 2960 "" i__3[1] = 8, a__2[1] = noteq; +#line 2960 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2961 "" *lnote += lnoten; +#line 2962 "" } +#line 2963 "" return 0; +#line 2964 "" } /* Check if mult. decreases from 1st note to 2nd */ +#line 2968 "" if (all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] > ip1 || bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) { /* More than one note or single-note before a multiplicity-down-up "][" */ +#line 2973 "" if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) { +#line 2974 "" multr = 1; +#line 2975 "" } else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25], 0)) { +#line 2976 "" multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8; +#line 2977 "" } else { +#line 2978 "" multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8; +#line 2979 "" } +#line 2980 "" *lnote = 0; +#line 2981 "" if (multr < multip) { +#line 2982 "" i__1 = multr + 1; +#line 2982 "" for (im = multip; im >= i__1; --im) { +#line 2983 "" ntrbbb_(&im, "r", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); +#line 2984 "" /* L1: */ +#line 2984 "" } +#line 2985 "" } +#line 2986 "" } -/* Put in the note */ +/* Check for beamed, dotted 2-note tremolo */ - if (*lnote > 0) { +#line 2990 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (r__1 = + all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12.f - + all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12, dabs(r__1)) + < .001f) { +#line 2992 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2992 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2993 "" + if (lnoten == 1) { /* Writing concatenation */ - i__2[0] = *lnote, a__1[0] = notexq; - i__2[1] = 1, a__1[1] = all_1.sq; - i__2[2] = 2, a__1[2] = "qb"; - s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2994 "" + i__3[0] = 1, a__2[0] = " "; +#line 2994 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2994 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2995 "" + lnoten = 2; +#line 2996 "" + } +#line 2997 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2998 "" + i__3[0] = 1, a__2[0] = " "; +#line 2998 "" + i__3[1] = 1, a__2[1] = noteq; +#line 2998 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 2999 "" + lnoten = 2; +#line 3000 "" + } +#line 3001 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 3002 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 3002 "" + i__2[1] = 2, a__1[1] = "pt"; +#line 3002 "" + i__2[2] = lnoten, a__1[2] = noteq; +#line 3002 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 3003 "" + } else { +/* Writing concatenation */ +#line 3004 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 3004 "" + i__4[1] = 1, a__3[1] = all_1.sq; +#line 3004 "" + i__4[2] = 2, a__3[2] = "pt"; +#line 3004 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 3004 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 3005 "" + } +#line 3006 "" + *lnote = *lnote + 3 + lnoten; +#line 3007 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 3007 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 3008 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 3009 "" + i__3[0] = 1, a__2[0] = " "; +#line 3009 "" + i__3[1] = 1, a__2[1] = noteq; +#line 3009 "" + s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8); +#line 3010 "" + lnoten = 2; +#line 3011 "" + } +#line 3012 "" + } + +/* Put in the note, but check first for open-head beamed tremolo. */ + +#line 3016 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && all_1.nodur[ + commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32) { +#line 3017 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 3018 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 3018 "" + i__2[1] = 1, a__1[1] = all_1.sq; +#line 3018 "" + i__2[2] = 2, a__1[2] = "hb"; +#line 3018 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 3019 "" + } else { +/* Writing concatenation */ +#line 3020 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 3020 "" + i__3[1] = 2, a__2[1] = "hb"; +#line 3020 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3021 "" + } +#line 3022 "" } else { +#line 3023 "" + if (*lnote > 0) { /* Writing concatenation */ - i__3[0] = 1, a__2[0] = all_1.sq; - i__3[1] = 2, a__2[1] = "qb"; - s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3024 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 3024 "" + i__2[1] = 1, a__1[1] = all_1.sq; +#line 3024 "" + i__2[2] = 2, a__1[2] = "qb"; +#line 3024 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 3025 "" + } else { +/* Writing concatenation */ +#line 3026 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 3026 "" + i__3[1] = 2, a__2[1] = "qb"; +#line 3026 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3027 "" + } +#line 3028 "" } +#line 3029 "" *lnote += 3; /* Check for dot */ +#line 3033 "" isdotm = FALSE_; +#line 3034 "" if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { +#line 3035 "" nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25]; +#line 3036 "" if (nd != 0) { +#line 3037 "" i__1 = log2_(&nd); +#line 3037 "" if (pow_ii(&c__2, &i__1) != nd) { +#line 3038 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) { +#line 3039 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25], 3)) { /* Writing concatenation */ +#line 3040 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3040 "" i__3[1] = 1, a__2[1] = "p"; +#line 3040 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3041 "" } else { /* Double dot */ /* Writing concatenation */ +#line 3045 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3045 "" i__3[1] = 2, a__2[1] = "pp"; +#line 3045 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3046 "" ++(*lnote); +#line 3047 "" } +#line 3048 "" } else { /* Writing concatenation */ +#line 3049 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3049 "" i__3[1] = 1, a__2[1] = "m"; +#line 3049 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3050 "" isdotm = TRUE_; +#line 3051 "" } +#line 3052 "" ++(*lnote); +#line 3053 "" } +#line 3054 "" } +#line 3055 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) || bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) { /* In an xtup with special 2:1 notation with a dot on 1st note, or normal dot */ /* Writing concatenation */ +#line 3060 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3060 "" i__3[1] = 1, a__2[1] = "p"; +#line 3060 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3061 "" ++(*lnote); +#line 3062 "" } /* Do the number; 0 if 12 */ /* 5/25/08 allow >12 */ +#line 3068 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) { /* call istring(mod(ivx,12),noteq,len) */ +#line 3070 "" i__1 = commvl_1.ivx % 24; +#line 3070 "" istring_(&i__1, noteq, &len, (ftnlen)8); +#line 3071 "" } else { /* call istring(mod(ivbj1,12),noteq,len) */ +#line 3073 "" i__1 = combjmp_1.ivbj1 % 24; +#line 3073 "" istring_(&i__1, noteq, &len, (ftnlen)8); +#line 3074 "" } /* Writing concatenation */ +#line 3075 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3075 "" i__3[1] = len, a__2[1] = noteq; +#line 3075 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3076 "" *lnote += len; +#line 3077 "" i__1 = ncmid_(&all_1.iv, &ip1); +#line 3077 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); /* Writing concatenation */ +#line 3078 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3078 "" i__3[1] = lnoten, a__2[1] = noteq; +#line 3078 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3079 "" *lnote += lnoten; +#line 3080 "" if (isdotm) { +#line 3081 "" if (lnoten == 1) { /* Writing concatenation */ +#line 3082 "" i__4[0] = *lnote, a__3[0] = notexq; +#line 3082 "" i__4[1] = 1, a__3[1] = "{"; +#line 3082 "" i__4[2] = 1, a__3[2] = noteq; +#line 3082 "" i__4[3] = 1, a__3[3] = "}"; +#line 3082 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 3083 "" *lnote += 3; +#line 3084 "" } else { +#line 3085 "" i__1 = lnoten - 2; /* Writing concatenation */ +#line 3085 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 3085 "" i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; +#line 3085 "" s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 3086 "" ++(*lnote); +#line 3087 "" } +#line 3088 "" } +#line 3089 "" return 0; } /* beamn1_ */ @@ -4692,19 +7972,19 @@ L1: notexq_len) { /* System generated locals */ - address a__1[3], a__2[2], a__3[5]; - integer i__1, i__2, i__3, i__4[3], i__5[2], i__6[5]; + address a__1[4], a__2[2], a__3[3], a__4[5]; + integer i__1[4], i__2[2], i__3[3], i__4, i__5, i__6, i__7[5]; real r__1; char ch__1[1]; icilist ici__1; /* Builtin functions */ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); - integer i_nint(real *), s_wsfi(icilist *), do_fio(integer *, char *, - ftnlen), e_wsfi(void); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); - integer pow_ii(integer *, integer *), i_sign(integer *, integer *), - lbit_shift(integer, integer); + integer i_nint(real *), pow_ii(integer *, integer *), i_sign(integer *, + integer *), lbit_shift(integer, integer); /* Local variables */ static logical addbrack; @@ -4738,64 +8018,290 @@ L1: static real zmult; extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, char *, integer *, ftnlen, ftnlen, ftnlen); + static integer multbb, lnoten; static real xnlmid; extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer - *, ftnlen); - static integer lnoten; - extern /* Subroutine */ int setupb_(real *, integer *, real *, real *, - integer *, real *, integer *); + *, ftnlen), setupb_(real *, integer *, real *, real *, integer *, + real *, integer *); static integer mprint; static real xslope; + static integer nvtrem; extern /* Subroutine */ int putxtn_(integer *, integer *, integer *, integer *, real *, real *, integer *, integer *, real *, real *, integer *, integer *, char *, integer *, integer *, real *, integer *, integer *, integer *, logical *, ftnlen); - static integer maxdrop; + static integer nindent, maxdrop, numinit; /* Fortran I/O blocks */ - static icilist io___213 = { 0, tempq, 0, "(i2)", 2, 1 }; + static icilist io___219 = { 0, noteq, 0, "(i1)", 8, 1 }; + static icilist io___221 = { 0, noteq, 0, "(a1,i2,a1)", 8, 1 }; + static icilist io___222 = { 0, noteq, 0, "(i1,a1)", 8, 1 }; + static icilist io___223 = { 0, noteq, 0, "(a1,i2,a2)", 8, 1 }; + static icilist io___239 = { 0, tempq, 0, "(i2)", 2, 1 }; /* The following is just to save the outputs from SetupB for the case of */ /* xtups starting with a rest, where beamstrt is called twice. */ +#line 3141 "" /* Parameter adjustments */ +#line 3141 "" --squez; +#line 3141 "" --space; +#line 3141 "" ihornb -= 25; +#line 3141 "" --nornb; +#line 3141 "" +#line 3141 "" /* Function Body */ +#line 3141 "" writebrests = TRUE_; +#line 3142 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 3143 "" ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; +#line 3144 "" multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8; +#line 3145 "" ip = all_1.ipo[all_1.jn - 1]; +#line 3146 "" + *lnote = 0; +#line 3147 "" + nvtrem = 0; /* Compute slopes and note offsets from start of beam. Inside SetupB, for each */ -/* xtup in the beam, set eloff,mtupv (in comxtup) for printed number. */ +/* xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also */ +/* gets islope(ivx), transferred in common. */ +/* Vertical adjustment beams for tremolo */ +#line 3153 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],21)) { +#line 3153 "" setupb_(comxtup_1.xelsk, &comipb_1.nnb, &comipb_1.sumx, & comipb_1.sumy, comipb_1.ipb, &comipb_1.smed, & strtmid_1.ixrest[commvl_1.ivx - 1]); - } +#line 3153 "" + } + +/* Will always come past here after entering beamstrt for 2-note tremolo, and */ +/* slope will have been computed, even for unbeamed. So start the indented */ +/* beams here. The indented tremolo bars will be added to the notexq output */ +/* string, under the tacet assumption that there is no horizontal shift */ +/* enacted by the action just before and after the call to beamstrt. */ + +#line 3162 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2) && igetbits_(& + all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &c__5) > 0) { +#line 3164 "" + nindent = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], & + c__2, &c__5); +/* Writing concatenation */ +#line 3165 "" + i__1[0] = 1, a__1[0] = all_1.sq; +#line 3165 "" + i__1[1] = 12, a__1[1] = "roffset{.7}{"; +#line 3165 "" + i__1[2] = 1, a__1[2] = all_1.sq; +#line 3165 "" + i__1[3] = 2, a__1[3] = "ib"; +#line 3165 "" + s_cat(tempq, a__1, i__1, &c__4, (ftnlen)79); +#line 3166 "" + ltemp = 16; +#line 3167 "" + if (nindent == 2) { +/* Writing concatenation */ +#line 3168 "" + i__2[0] = 16, a__2[0] = tempq; +#line 3168 "" + i__2[1] = 1, a__2[1] = "b"; +#line 3168 "" + s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); +#line 3169 "" + ltemp = 17; +#line 3170 "" + } else if (nindent == 3) { +/* Writing concatenation */ +#line 3171 "" + i__2[0] = 16, a__2[0] = tempq; +#line 3171 "" + i__2[1] = 2, a__2[1] = "bb"; +#line 3171 "" + s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); +#line 3172 "" + ltemp = 18; +#line 3173 "" + } + +/* Use beam # 0 for indented beams */ + +/* Writing concatenation */ +#line 3177 "" + i__3[0] = ltemp, a__3[0] = tempq; +#line 3177 "" + i__3[1] = 1, a__3[1] = all_1.ulq + (commvl_1.ivx + ibc * 24 - 25); +#line 3177 "" + i__3[2] = 1, a__3[2] = "0"; +#line 3177 "" + s_cat(tempq, a__3, i__3, &c__3, (ftnlen)79); +#line 3178 "" + ltemp += 2; + +/* Get adjustment to nolev1 for main beam based on nindent */ + +#line 3182 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') + { +#line 3183 "" + nvtrem = nindent - 1; +#line 3184 "" + } else { +#line 3185 "" + nvtrem = 1 - nindent; +#line 3186 "" + } + +/* Get numerical position of initiation for main beam. Will adjust height at */ +/* closing to account for nindent */ + +/* numinit = nolev1(ivx)-ncmid(ivx,ipb1)+4 */ +#line 3192 "" + numinit = comxtup_1.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, & + ipb1) + 4; + +/* Get forced beam height tweak, apply here for indented beams */ + +#line 3196 "" + iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & + c__11) - 30; +#line 3197 "" + if (iadj != -30) { +#line 3197 "" + numinit += iadj; +#line 3197 "" + } +#line 3198 "" + if (numinit >= 0 && numinit <= 9) { +#line 3199 "" + s_wsfi(&io___219); +#line 3199 "" + do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); +#line 3199 "" + e_wsfi(); +#line 3200 "" + lnoten = 1; +#line 3201 "" + } else { +#line 3202 "" + s_wsfi(&io___221); +#line 3202 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 3202 "" + do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); +#line 3202 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 3202 "" + e_wsfi(); +#line 3203 "" + lnoten = 4; +#line 3204 "" + } +/* Writing concatenation */ +#line 3205 "" + i__2[0] = ltemp, a__2[0] = tempq; +#line 3205 "" + i__2[1] = lnoten, a__2[1] = noteq; +#line 3205 "" + s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); +#line 3206 "" + ltemp += lnoten; + +/* Now do the slope. */ +/* 170408 Baseline is in islope(ivx). Apply slope tweak if present. */ + +#line 3211 "" + numinit = comxtup_1.islope[commvl_1.ivx - 1]; +#line 3212 "" + iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & + c__17) - 30; +#line 3213 "" + if (iadj != -30) { +#line 3213 "" + numinit += iadj; +#line 3213 "" + } +#line 3214 "" + if (numinit >= 0 && numinit <= 9) { +#line 3215 "" + s_wsfi(&io___222); +#line 3215 "" + do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); +#line 3215 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 3215 "" + e_wsfi(); +#line 3216 "" + lnoten = 2; +#line 3217 "" + } else { +#line 3218 "" + s_wsfi(&io___223); +#line 3218 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 3218 "" + do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer)); +#line 3218 "" + do_fio(&c__1, "}}", (ftnlen)2); +#line 3218 "" + e_wsfi(); +#line 3219 "" + lnoten = 5; +#line 3220 "" + } +/* Writing concatenation */ +#line 3221 "" + i__2[0] = ltemp, a__2[0] = tempq; +#line 3221 "" + i__2[1] = lnoten, a__2[1] = noteq; +#line 3221 "" + s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79); +#line 3222 "" + ltemp += lnoten; +#line 3223 "" + s_copy(notexq, tempq, (ftnlen)79, (ftnlen)79); +#line 3224 "" + *lnote = ltemp; +#line 3225 "" + } +#line 3226 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) { /* This is start of later segment of single-slope beam group so use slope and */ /* height from prior beam. Slope is already OK. */ +#line 3231 "" ++comxtup_1.issb[commvl_1.ivx - 1]; +#line 3232 "" comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx + comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25]; +#line 3233 "" } - *lnote = 0; + +/* Move this up to before indented beams for tremolo */ +/* lnote = 0 */ +#line 3237 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 3238 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) && strtmid_1.ixrest[commvl_1.ivx - 1] != 2) { +#line 3239 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 3240 "" ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; /* irest(28)=>Xtup starts on this note. Set up for xtuplet. */ @@ -4810,275 +8316,500 @@ L1: /* iflop 0 1 -1 0 ...direction of flop */ /* iup -1 1 -1 1 ...direction of number and bracket */ +#line 3254 "" iud = 1; +#line 3255 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 3255 "" iud = -1; +#line 3255 "" } /* Get ip#, note level of middle note (or gap) in xtup */ +#line 3259 "" ipmid = ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] / 2; /* 130129 If middle note is a rest, go to next note. Note last note cannot */ /* be a rest */ +#line 3264 "" L14: +#line 3265 "" if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) { +#line 3266 "" ++ipmid; +#line 3267 "" goto L14; +#line 3268 "" } - i__1 = ncmid_(&all_1.iv, &ipmid); - i__2 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; +#line 3269 "" + i__4 = ncmid_(&all_1.iv, &ipmid); +#line 3269 "" + i__5 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; +#line 3269 "" xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], & - all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__1, & - i__2); + all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__4, & + i__5); +#line 3271 "" if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { - i__2 = ipmid - 1; - i__1 = ncmid_(&all_1.iv, &i__2); - i__3 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - +#line 3271 "" + i__5 = ipmid - 1; +#line 3271 "" + i__4 = ncmid_(&all_1.iv, &i__5); +#line 3271 "" + i__6 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - 8; +#line 3271 "" xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24 - - 25], &iud, &i__1, &i__3)) / 2; + - 25], &iud, &i__4, &i__6)) / 2; +#line 3271 "" } +#line 3274 "" iflop = 0; +#line 3275 "" if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) { +#line 3275 "" iflop = -iud; +#line 3275 "" } +#line 3276 "" iup = iud + (iflop << 1); +#line 3277 "" if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],14)) { /* Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) */ +#line 3281 "" iup = -iup; +#line 3282 "" iflop = 0; +#line 3283 "" if (iud * iup < 0) { +#line 3283 "" iflop = iup; +#line 3283 "" } +#line 3284 "" } -/* Determine if a beam is to be drawn */ +/* Determine if a beam is to be drawn. */ +/* Had problem w/ half-note 2-note xtups always F, so add a test */ - i__1 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; - for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__1; +#line 3289 "" + if (igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, & + c__3) != 0) { +#line 3290 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 3291 "" + goto L6; +#line 3292 "" + } +#line 3293 "" + i__4 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; +#line 3293 "" + for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__4; ++ipp) { +#line 3294 "" if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) { +#line 3295 "" comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_; +#line 3296 "" goto L6; +#line 3297 "" } +#line 3298 "" /* L5: */ +#line 3298 "" } +#line 3299 "" comdraw_1.drawbm[commvl_1.ivx - 1] = ! bit_test(all_1.islur[ commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25],18); +#line 3300 "" L6: /* Are we using tuplet.tex? */ +#line 3304 "" usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1]; +/* Check for single note xtup 171217 */ + +#line 3308 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) && + comipb_1.nnb == 1) { +#line 3309 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_; +#line 3310 "" + } + /* Place xtup number if needed */ +#line 3314 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) || multb <= 0) { +#line 3315 "" mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__5, &c__22); +#line 3316 "" if (mprint == 0) { +#line 3316 "" mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25]; +#line 3316 "" + } +/* Stab in the dark! Note: tried setting unbeam flag islur18 but no go. */ +#line 3318 "" + if (comipb_1.nnb == 1) { +#line 3319 "" + xnlmid = (real) comxtup_1.nolev1[commvl_1.ivx - 1]; +#line 3320 "" + comxtup_1.islope[commvl_1.ivx - 1] = 0; + +/* Move up, outside number check block, so all 1-note xtups ar unbeamed */ +/* drawbm(ivx) = .false. */ + +#line 3325 "" } - i__1 = ncmid_(&all_1.iv, &ipb1); +#line 3326 "" + i__4 = ncmid_(&all_1.iv, &ipb1); +#line 3326 "" putxtn_(&mprint, &iflop, &multb, &iud, &comask_1.wheadpt, & comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], & comxtup_1.islope[commvl_1.ivx - 1], &all_1.slfac, &xnlmid, &all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], lnote, - notexq, &i__1, &nlnum, &comxtup_1.eloff[commvl_1.ivx + + notexq, &i__4, &nlnum, &comxtup_1.eloff[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25], &iup, & all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &all_1.mult[ commvl_1.ivx + ipb1 * 24 - 25], &usexnumt, (ftnlen)79); -/* * iup,irest(ivx,ipb1),usexnumt) */ +#line 3330 "" } +#line 3331 "" if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { /* Xtuplet with no beam */ +#line 3335 "" if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31)) { /* Number printing has not been suppressed, so put in the bracket. */ /* scale = stretch factor for bracket if there are asx's */ /* xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) */ +#line 3341 "" r__1 = space[*ib] / squez[*ib]; +#line 3341 "" xnsk = (comeskz2_1.eskz2[commvl_1.ivx + (ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ commvl_1.ivx - 1] * 24 - 25] - 1) * 24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipb1 * 24 - 25]) / squez[*ib] / feon_(&r__1); +#line 3343 "" if (iup == 1) { +#line 3344 "" if (*lnote > 0) { /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = 1, a__1[1] = all_1.sq; - i__4[2] = 5, a__1[2] = "ovbkt"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3345 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3345 "" + i__3[1] = 1, a__3[1] = all_1.sq; +#line 3345 "" + i__3[2] = 5, a__3[2] = "ovbkt"; +#line 3345 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3346 "" } else { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 5, a__2[1] = "ovbkt"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3347 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3347 "" + i__2[1] = 5, a__2[1] = "ovbkt"; +#line 3347 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3348 "" } +#line 3349 "" } else { +#line 3350 "" if (*lnote > 0) { /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = 1, a__1[1] = all_1.sq; - i__4[2] = 5, a__1[2] = "unbkt"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3351 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3351 "" + i__3[1] = 1, a__3[1] = all_1.sq; +#line 3351 "" + i__3[2] = 5, a__3[2] = "unbkt"; +#line 3351 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3352 "" } else { /* Introduced 12/5/98, req'd due to possible presence of in-line TeX */ /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 5, a__2[1] = "unbkt"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3356 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3356 "" + i__2[1] = 5, a__2[1] = "unbkt"; +#line 3356 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3357 "" } +#line 3358 "" } +#line 3359 "" *lnote += 6; +#line 3360 "" if (all_1.iline == 1) { +#line 3361 "" comipb_1.smed /= 1.f - comtop_1.fracindent; +#line 3362 "" } +#line 3363 "" xslope = comipb_1.smed * 1.8f * all_1.slfac; +#line 3364 "" comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope); +#line 3365 "" r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1]; +#line 3365 "" comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1); +#line 3366 "" if (comxtup_1.islope[commvl_1.ivx - 1] == 0) { +#line 3366 "" --comxtup_1.nolev1[commvl_1.ivx - 1]; +#line 3366 "" } +#line 3367 "" if (iup == 1) { +#line 3367 "" comxtup_1.nolev1[commvl_1.ivx - 1] += 4; +#line 3367 "" } +#line 3368 "" levbracket = comxtup_1.nolev1[commvl_1.ivx - 1]; +#line 3369 "" if (iup == 1 && comnvst_1.cstuplet) { +#line 3369 "" --levbracket; +#line 3369 "" } - i__1 = ncmid_(&all_1.iv, &ipb1); - notefq_(noteq, &lnoten, &levbracket, &i__1, (ftnlen)8); +#line 3370 "" + i__4 = ncmid_(&all_1.iv, &ipb1); +#line 3370 "" + notefq_(noteq, &lnoten, &levbracket, &i__4, (ftnlen)8); +#line 3371 "" if (lnoten == 1) { +#line 3371 "" addblank_(noteq, &lnoten, (ftnlen)8); - } -/* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = lnoten, a__1[1] = noteq; - i__4[2] = 1, a__1[2] = "{"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3371 "" + } +/* Writing concatenation */ +#line 3372 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3372 "" + i__3[1] = lnoten, a__3[1] = noteq; +#line 3372 "" + i__3[2] = 1, a__3[2] = "{"; +#line 3372 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3373 "" *lnote = *lnote + lnoten + 1; +#line 3374 "" if (xnsk < .995f) { - i__1 = *lnote; +#line 3375 "" + i__4 = *lnote; +#line 3375 "" ici__1.icierr = 0; +#line 3375 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 4 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3375 "" + ici__1.icirlen = *lnote + 4 - i__4; +#line 3375 "" + ici__1.iciunit = notexq + i__4; +#line 3375 "" ici__1.icifmt = "(i1,f3.2)"; +#line 3375 "" s_wsfi(&ici__1); +#line 3375 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 3375 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 3375 "" e_wsfi(); +#line 3376 "" *lnote += 4; +#line 3377 "" } else if (xnsk < 9.995f) { - i__1 = *lnote; +#line 3378 "" + i__4 = *lnote; +#line 3378 "" ici__1.icierr = 0; +#line 3378 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 4 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3378 "" + ici__1.icirlen = *lnote + 4 - i__4; +#line 3378 "" + ici__1.iciunit = notexq + i__4; +#line 3378 "" ici__1.icifmt = "(f4.2)"; +#line 3378 "" s_wsfi(&ici__1); +#line 3378 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 3378 "" e_wsfi(); +#line 3379 "" *lnote += 4; +#line 3380 "" } else { - i__1 = *lnote; +#line 3381 "" + i__4 = *lnote; +#line 3381 "" ici__1.icierr = 0; +#line 3381 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 5 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3381 "" + ici__1.icirlen = *lnote + 5 - i__4; +#line 3381 "" + ici__1.iciunit = notexq + i__4; +#line 3381 "" ici__1.icifmt = "(f5.2)"; +#line 3381 "" s_wsfi(&ici__1); +#line 3381 "" do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 3381 "" e_wsfi(); +#line 3382 "" *lnote += 5; +#line 3383 "" } /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = 1, a__2[1] = "}"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3384 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3384 "" + i__2[1] = 1, a__2[1] = "}"; +#line 3384 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3385 "" ++(*lnote); +#line 3386 "" if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) { /* Tweak slope of bracket */ +#line 3390 "" comxtup_1.islope[commvl_1.ivx - 1] = comxtup_1.islope[ commvl_1.ivx - 1] + igetbits_(&all_1.mult[ commvl_1.ivx + ipb1 * 24 - 25], &c__5, &c__5) - 16; +#line 3391 "" } +#line 3392 "" if (comxtup_1.islope[commvl_1.ivx - 1] < 0 || comxtup_1.islope[commvl_1.ivx - 1] >= 10) { /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = 1, a__2[1] = "{"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3393 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3393 "" + i__2[1] = 1, a__2[1] = "{"; +#line 3393 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3394 "" ++(*lnote); +#line 3395 "" if (comxtup_1.islope[commvl_1.ivx - 1] < -9) { - i__1 = *lnote; +#line 3396 "" + i__4 = *lnote; +#line 3396 "" ici__1.icierr = 0; +#line 3396 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 3 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3396 "" + ici__1.icirlen = *lnote + 3 - i__4; +#line 3396 "" + ici__1.iciunit = notexq + i__4; +#line 3396 "" ici__1.icifmt = "(i3)"; +#line 3396 "" s_wsfi(&ici__1); +#line 3396 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); +#line 3396 "" e_wsfi(); +#line 3397 "" *lnote += 3; +#line 3398 "" } else { - i__1 = *lnote; +#line 3399 "" + i__4 = *lnote; +#line 3399 "" ici__1.icierr = 0; +#line 3399 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 2 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3399 "" + ici__1.icirlen = *lnote + 2 - i__4; +#line 3399 "" + ici__1.iciunit = notexq + i__4; +#line 3399 "" ici__1.icifmt = "(i2)"; +#line 3399 "" s_wsfi(&ici__1); +#line 3399 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); +#line 3399 "" e_wsfi(); +#line 3400 "" *lnote += 2; +#line 3401 "" } /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = 1, a__2[1] = "}"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3402 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3402 "" + i__2[1] = 1, a__2[1] = "}"; +#line 3402 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3403 "" ++(*lnote); +#line 3404 "" } else { - i__1 = *lnote; +#line 3405 "" + i__4 = *lnote; +#line 3405 "" ici__1.icierr = 0; +#line 3405 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote + 1 - i__1; - ici__1.iciunit = notexq + i__1; +#line 3405 "" + ici__1.icirlen = *lnote + 1 - i__4; +#line 3405 "" + ici__1.iciunit = notexq + i__4; +#line 3405 "" ici__1.icifmt = "(i1)"; +#line 3405 "" s_wsfi(&ici__1); +#line 3405 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)sizeof(integer)); +#line 3405 "" e_wsfi(); +#line 3406 "" ++(*lnote); +#line 3407 "" } /* Done with bracket */ +#line 3411 "" } +#line 3412 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { /* Put in the rest. Possible problem: Rest is a spacing char, but between */ @@ -5086,372 +8817,633 @@ L6: /* 130126 Deal with vertical shifts of rest starting xtuplet */ -/* if (multb .eq. 0) then */ -/* notexq = notexq(1:lnote)//sq//'qp' */ -/* lnote = lnote+3 */ -/* else if (.not.drawbm(ivx).and.multb.eq.1) then */ -/* notexq = notexq(1:lnote)//sq//'ds' */ -/* lnote = lnote+3 */ -/* else if (.not.drawbm(ivx).and.multb.eq.2) then */ -/* notexq = notexq(1:lnote)//sq//'qs' */ -/* lnote = lnote+3 */ -/* else if (.not.drawbm(ivx).and.multb.eq.3) then */ -/* notexq = notexq(1:lnote)//sq//'hs' */ -/* lnote = lnote+3 */ -/* else */ -/* notexq = notexq(1:lnote)//sq//'hpause' */ -/* lnote = lnote+7 */ -/* end if */ +#line 3419 "" lrest = 3; - if (multb == 0) { -/* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 2, a__2[1] = "qp"; - s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 3420 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { +/* Writing concatenation */ +#line 3421 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3421 "" + i__2[1] = 2, a__2[1] = "sk"; +#line 3421 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +/* if (multb .eq. 0) then */ +#line 3423 "" + } else if (multb == 0) { +/* Writing concatenation */ +#line 3424 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3424 "" + i__2[1] = 2, a__2[1] = "qp"; +#line 3424 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +#line 3425 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1) { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 2, a__2[1] = "ds"; - s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 3426 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3426 "" + i__2[1] = 2, a__2[1] = "ds"; +#line 3426 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +#line 3427 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2) { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 2, a__2[1] = "qs"; - s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 3428 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3428 "" + i__2[1] = 2, a__2[1] = "qs"; +#line 3428 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +#line 3429 "" } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3) { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 2, a__2[1] = "hs"; - s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 3430 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3430 "" + i__2[1] = 2, a__2[1] = "hs"; +#line 3430 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +#line 3431 "" } else { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 6, a__2[1] = "hpause"; - s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 3432 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3432 "" + i__2[1] = 6, a__2[1] = "hpause"; +#line 3432 "" + s_cat(restq, a__2, i__2, &c__2, (ftnlen)40); +#line 3433 "" lrest = 7; +#line 3434 "" + } +#line 3435 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],18) && + bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],19) + ) { + +/* VERY special case of rest at start of F-tuplet, needs dot */ + +/* Writing concatenation */ +#line 3440 "" + i__3[0] = 1, a__3[0] = all_1.sq; +#line 3440 "" + i__3[1] = 3, a__3[1] = "pt4"; +#line 3440 "" + i__3[2] = lrest, a__3[2] = restq; +#line 3440 "" + s_cat(restq, a__3, i__3, &c__3, (ftnlen)40); +#line 3441 "" + lrest += 4; +#line 3442 "" } +#line 3444 "" nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100 - 20; - if (nole == 0) { +/* if (nole .eq. 0) then */ +#line 3446 "" + if (nole == 0 || bit_test(all_1.islur[commvl_1.ivx + ip * 24 + - 25],29)) { -/* Rest is not raised */ +/* Rest blank or is not raised */ /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = 40, a__2[1] = restq; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3450 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3450 "" + i__2[1] = 40, a__2[1] = restq; +#line 3450 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3451 "" *lnote += lrest; +#line 3452 "" } else { +#line 3453 "" if (abs(nole) < 10) { - i__1 = abs(nole) + 48; - chax_(ch__1, (ftnlen)1, &i__1); +#line 3454 "" + i__4 = abs(nole) + 48; +#line 3454 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 3454 "" s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1); +#line 3455 "" ltemp = 1; +#line 3456 "" } else { - s_wsfi(&io___213); - i__1 = abs(nole); - do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 3457 "" + s_wsfi(&io___239); +#line 3457 "" + i__4 = abs(nole); +#line 3457 "" + do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer)); +#line 3457 "" e_wsfi(); +#line 3458 "" ltemp = 2; +#line 3459 "" } +#line 3460 "" if (nole > 0) { /* Writing concatenation */ - i__6[0] = 1, a__3[0] = all_1.sq; - i__6[1] = 5, a__3[1] = "raise"; - i__6[2] = ltemp, a__3[2] = tempq; - i__6[3] = 1, a__3[3] = all_1.sq; - i__6[4] = 9, a__3[4] = "internote"; - s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79); +#line 3461 "" + i__7[0] = 1, a__4[0] = all_1.sq; +#line 3461 "" + i__7[1] = 5, a__4[1] = "raise"; +#line 3461 "" + i__7[2] = ltemp, a__4[2] = tempq; +#line 3461 "" + i__7[3] = 1, a__4[3] = all_1.sq; +#line 3461 "" + i__7[4] = 9, a__4[4] = "internote"; +#line 3461 "" + s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79); +#line 3462 "" } else { /* Writing concatenation */ - i__6[0] = 1, a__3[0] = all_1.sq; - i__6[1] = 5, a__3[1] = "lower"; - i__6[2] = ltemp, a__3[2] = tempq; - i__6[3] = 1, a__3[3] = all_1.sq; - i__6[4] = 9, a__3[4] = "internote"; - s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79); - } +#line 3463 "" + i__7[0] = 1, a__4[0] = all_1.sq; +#line 3463 "" + i__7[1] = 5, a__4[1] = "lower"; +#line 3463 "" + i__7[2] = ltemp, a__4[2] = tempq; +#line 3463 "" + i__7[3] = 1, a__4[3] = all_1.sq; +#line 3463 "" + i__7[4] = 9, a__4[4] = "internote"; +#line 3463 "" + s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79); +#line 3464 "" + } +#line 3465 "" ltemp += 16; /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = ltemp, a__1[1] = tempq; - i__4[2] = lrest, a__1[2] = restq; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3466 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3466 "" + i__3[1] = ltemp, a__3[1] = tempq; +#line 3466 "" + i__3[2] = lrest, a__3[2] = restq; +#line 3466 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3467 "" *lnote = *lnote + ltemp + lrest; +#line 3468 "" } /* No need to come back through this subroutine (as would if rest starts bar */ /* & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. */ +#line 3473 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 3474 "" } +#line 3475 "" return 0; +#line 3476 "" } /* End if block for non-beamed xtup start...note we returned */ +#line 3480 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { /* Insert rest at start of beamed xtup. See above note for possible problem. */ /* But first check if blank rest and if in forced beam (assuming xtuplet), */ /* and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*' */ +#line 3486 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],30)) { +#line 3487 "" ++xjbeambrests_1.nbrests; +#line 3488 "" writebrests = FALSE_; +#line 3489 "" } else { - i__1 = 4 - multb; +#line 3490 "" + i__4 = 4 - multb; +#line 3490 "" all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, & - i__1); + i__4); +#line 3491 "" notex_(tempq, <emp, (ftnlen)79); +#line 3492 "" if (*lnote > 0) { /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = ltemp, a__2[1] = tempq; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3493 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3493 "" + i__2[1] = ltemp, a__2[1] = tempq; +#line 3493 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3494 "" } else { +#line 3495 "" s_copy(notexq, tempq, (ftnlen)79, ltemp); +#line 3496 "" } +#line 3497 "" *lnote += ltemp; +#line 3498 "" } /* Re-zero just in case! */ +#line 3502 "" all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0; +#line 3503 "" ++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; /* See if next note is a non-rest */ +#line 3507 "" if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0) ) { +#line 3508 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 2; +#line 3509 "" } else { /* Suppress reprinting xtup number next time through beamstrt */ +#line 3513 "" all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25],31); /* Set new xtup start flag */ +#line 3517 "" all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set( all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28); +#line 3518 "" } +#line 3519 "" return 0; +#line 3520 "" } +#line 3521 "" } /* Just ended if block for xtups */ +#line 3525 "" if (comxtup_1.vxtup[commvl_1.ivx - 1] && ipb1 == all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]) { /* Move actual note writing to beamend */ +#line 3529 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 4; +#line 3530 "" return 0; +#line 3531 "" } +#line 3532 "" if (comxtup_1.issb[commvl_1.ivx - 1] == 0) { /* 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed */ +#line 3536 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__11) - 30; +#line 3537 "" if (iadj != -30) { +#line 3538 "" comxtup_1.nolev1[commvl_1.ivx - 1] += iadj; - i__1 = comxtup_1.nssb[commvl_1.ivx - 1]; - for (isssb = 1; isssb <= i__1; ++isssb) { +#line 3539 "" + i__4 = comxtup_1.nssb[commvl_1.ivx - 1]; +#line 3539 "" + for (isssb = 1; isssb <= i__4; ++isssb) { +#line 3540 "" comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj; +#line 3541 "" /* L2: */ +#line 3541 "" } +#line 3542 "" } +#line 3543 "" iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & c__17) - 30; +#line 3544 "" if (iadj != -30) { +#line 3545 "" comxtup_1.islope[commvl_1.ivx - 1] += iadj; - if ((i__1 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__1)) > 9) { +#line 3546 "" + if ((i__4 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__4)) > 9) { +#line 3546 "" comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, & comxtup_1.islope[commvl_1.ivx - 1]); +#line 3546 "" } +#line 3547 "" if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) { /* Cycle thru non-rest notes in SSBG, looking for bmstrts. */ +#line 3551 "" isssb = 0; - i__1 = comipb_1.nnb; - for (inb = 2; inb <= i__1; ++inb) { +#line 3552 "" + i__4 = comipb_1.nnb; +#line 3552 "" + for (inb = 2; inb <= i__4; ++inb) { +#line 3553 "" if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 25],21)) { /* Beam segment start. New start level */ +#line 3556 "" ++isssb; +#line 3557 "" comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac; +#line 3559 "" } +#line 3560 "" /* L4: */ +#line 3560 "" } +#line 3561 "" } +#line 3562 "" } +#line 3563 "" } +#line 3564 "" iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, & c__27); +#line 3565 "" addbrack = FALSE_; +#line 3566 "" if (bit_test(all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25],30)) { /* Check for altered starting polarity. Only in forced beams. Nominal start */ /* level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). */ +#line 3571 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && comxtup_1.nolev1[commvl_1.ivx - 1] + 6 < all_1.nolev[ commvl_1.ivx + ipb1 * 24 - 25]) { +#line 3573 "" if (*lnote == 0) { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 5, a__2[1] = "loff{"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3574 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3574 "" + i__2[1] = 5, a__2[1] = "loff{"; +#line 3574 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3575 "" } else { /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = 1, a__1[1] = all_1.sq; - i__4[2] = 5, a__1[2] = "loff{"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); - } +#line 3576 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3576 "" + i__3[1] = 1, a__3[1] = all_1.sq; +#line 3576 "" + i__3[2] = 5, a__3[2] = "loff{"; +#line 3576 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3577 "" + } +#line 3578 "" *lnote += 6; +#line 3579 "" addbrack = TRUE_; +#line 3580 "" } else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' && comxtup_1.nolev1[commvl_1.ivx - 1] - 6 > all_1.nolev[commvl_1.ivx + ipb1 * 24 - 25]) { +#line 3582 "" if (*lnote == 0) { /* Writing concatenation */ - i__5[0] = 1, a__2[0] = all_1.sq; - i__5[1] = 5, a__2[1] = "roff{"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3583 "" + i__2[0] = 1, a__2[0] = all_1.sq; +#line 3583 "" + i__2[1] = 5, a__2[1] = "roff{"; +#line 3583 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3584 "" } else { /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = 1, a__1[1] = all_1.sq; - i__4[2] = 5, a__1[2] = "roff{"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); - } +#line 3585 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3585 "" + i__3[1] = 1, a__3[1] = all_1.sq; +#line 3585 "" + i__3[2] = 5, a__3[2] = "roff{"; +#line 3585 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3586 "" + } +#line 3587 "" *lnote += 6; +#line 3588 "" addbrack = TRUE_; +#line 3589 "" } /* Check end level for possible flipping in forced beam. Have to do it */ /* here since with multiple voices, xelsk will not be preserved. */ +#line 3594 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 3595 "" bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] + 6 + comxtup_1.islope[ commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] / all_1.slfac; +#line 3596 "" strtmid_1.flipend[commvl_1.ivx - 1] = bmlev < (real) all_1.nolev[ commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; +#line 3597 "" } else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'l') { +#line 3598 "" bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] - 6 + comxtup_1.islope[ commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] / all_1.slfac; +#line 3599 "" strtmid_1.flipend[commvl_1.ivx - 1] = bmlev > (real) all_1.nolev[ commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; +#line 3600 "" } +#line 3601 "" } - i__1 = multb + iadj; - ntrbbb_(&i__1, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & +#line 3602 "" + multbb = multb + iadj; + +/* Tremolo starting? */ + +#line 3606 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2)) { +#line 3606 "" + multbb = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, + &c__3); +#line 3606 "" + } +#line 3608 "" + ntrbbb_(&multbb, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79); /* Put in name of start level and slope, after correcting nolev1 if xtup */ /* started with a rest. */ +#line 3613 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { +#line 3613 "" r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] * comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac; +#line 3613 "" comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 3613 "" } - i__1 = ncmid_(&all_1.iv, &ipb1); - notefq_(noteq, &lnoten, &comxtup_1.nolev1[commvl_1.ivx - 1], &i__1, ( - ftnlen)8); + +/* Add adjustment nvtrem to main beam to account for tremolo indented beams */ + +#line 3618 "" + i__4 = comxtup_1.nolev1[commvl_1.ivx - 1] + nvtrem; +#line 3618 "" + i__5 = ncmid_(&all_1.iv, &ipb1); +#line 3618 "" + notefq_(noteq, &lnoten, &i__4, &i__5, (ftnlen)8); +#line 3619 "" if (comxtup_1.islope[commvl_1.ivx - 1] < 0) { /* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; - i__4[1] = lnoten, a__1[1] = noteq; - i__4[2] = 1, a__1[2] = "{"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3620 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3620 "" + i__3[1] = lnoten, a__3[1] = noteq; +#line 3620 "" + i__3[2] = 1, a__3[2] = "{"; +#line 3620 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3621 "" *lnote = *lnote + 4 + lnoten; - i__1 = *lnote - 3; +#line 3622 "" + i__4 = *lnote - 3; +#line 3622 "" ici__1.icierr = 0; +#line 3622 "" ici__1.icirnum = 1; - ici__1.icirlen = *lnote - i__1; - ici__1.iciunit = notexq + i__1; +#line 3622 "" + ici__1.icirlen = *lnote - i__4; +#line 3622 "" + ici__1.iciunit = notexq + i__4; +#line 3622 "" ici__1.icifmt = "(i2,a1)"; +#line 3622 "" s_wsfi(&ici__1); +#line 3622 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) sizeof(integer)); +#line 3622 "" do_fio(&c__1, "}", (ftnlen)1); +#line 3622 "" e_wsfi(); +#line 3623 "" } else { /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = lnoten, a__2[1] = noteq; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3624 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3624 "" + i__2[1] = lnoten, a__2[1] = noteq; +#line 3624 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3625 "" *lnote = *lnote + 1 + lnoten; +#line 3626 "" ici__1.icierr = 0; +#line 3626 "" ici__1.icirnum = 1; +#line 3626 "" ici__1.icirlen = 1; +#line 3626 "" ici__1.iciunit = notexq + (*lnote - 1); +#line 3626 "" ici__1.icifmt = "(i1)"; +#line 3626 "" s_wsfi(&ici__1); +#line 3626 "" do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) sizeof(integer)); +#line 3626 "" e_wsfi(); +#line 3627 "" } /* Check for beam-thk fine-tuning */ +#line 3631 "" if (iadj > 0) { - i__1 = multb + 1; - for (imp = multb + iadj; imp >= i__1; --imp) { +#line 3632 "" + i__4 = multb + 1; +#line 3632 "" + for (imp = multb + iadj; imp >= i__4; --imp) { +#line 3633 "" ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, ( ftnlen)79); +#line 3634 "" /* L1: */ +#line 3634 "" } +#line 3635 "" } /* If we shifted, must close with right bracket */ +#line 3639 "" if (addbrack) { /* Writing concatenation */ - i__5[0] = *lnote, a__2[0] = notexq; - i__5[1] = 1, a__2[1] = "}"; - s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 3640 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 3640 "" + i__2[1] = 1, a__2[1] = "}"; +#line 3640 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 3641 "" ++(*lnote); +#line 3642 "" } /* Add in \sk's for very special case of staff-crossing xtup chords */ /* Assumes we are in lower (first) voice of up-to-both beamed xtup */ /* that starts with blank rests (notes in upper voice here). */ +#line 3648 "" if (xjbeambrests_1.nbrests > 0 && writebrests) { - i__1 = xjbeambrests_1.nbrests; - for (isk = 1; isk <= i__1; ++isk) { -/* Writing concatenation */ - i__4[0] = *lnote, a__1[0] = notexq; +#line 3649 "" + i__4 = xjbeambrests_1.nbrests; +#line 3649 "" + for (isk = 1; isk <= i__4; ++isk) { +/* Writing concatenation */ +#line 3650 "" + i__3[0] = *lnote, a__3[0] = notexq; +#line 3650 "" chax_(ch__1, (ftnlen)1, &c__92); - i__4[1] = 1, a__1[1] = ch__1; - i__4[2] = 2, a__1[2] = "sk"; - s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 3650 "" + i__3[1] = 1, a__3[1] = ch__1; +#line 3650 "" + i__3[2] = 2, a__3[2] = "sk"; +#line 3650 "" + s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79); +#line 3651 "" *lnote += 3; +#line 3652 "" /* L7: */ +#line 3652 "" } +#line 3653 "" xjbeambrests_1.nbrests = 0; +#line 3654 "" } /* Get 'floor' zmin for figures */ @@ -5459,61 +9451,100 @@ L6: /* won't be adjusted. If anyone ever needs that, need to duplicate this */ /* functionality up above, before exiting. */ +#line 3661 "" if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2)) { +#line 3662 "" if (commvl_1.ivx == 1) { +#line 3663 "" ivf = 1; +#line 3664 "" } else { +#line 3665 "" ivf = comfig_1.ivxfig2; +#line 3666 "" } +#line 3667 "" zmult = (multb - 1) * 1.2f; +#line 3668 "" ymin = 100.f; - i__1 = comipb_1.nnb; - for (inb = 1; inb <= i__1; ++inb) { +#line 3669 "" + i__4 = comipb_1.nnb; +#line 3669 "" + for (inb = 1; inb <= i__4; ++inb) { +#line 3670 "" if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) { +#line 3671 "" if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] == 'u') { +#line 3672 "" ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1] * 24 - 25]; +#line 3673 "" } else { +#line 3674 "" ybot = comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac * comxtup_1.xelsk[inb - 1] + comxtup_1.nolev1[ commvl_1.ivx - 1] - all_1.stemlen - zmult; +#line 3676 "" } +#line 3677 "" ymin = dmin(ymin,ybot); +#line 3678 "" } +#line 3679 "" /* L3: */ +#line 3679 "" } +#line 3680 "" maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f; /* Computing MAX */ - i__1 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3]; - all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__1,maxdrop); +#line 3681 "" + i__4 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3]; +#line 3681 "" + all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__4,maxdrop); +#line 3682 "" } /* Compute ornament levels if needed */ +#line 3686 "" nomornlev = ncmid_(&all_1.iv, &ipb1) + 5; +#line 3687 "" iorn = 0; - i__1 = comipb_1.nnb; - for (inb = 1; inb <= i__1; ++inb) { +#line 3688 "" + i__4 = comipb_1.nnb; +#line 3688 "" + for (inb = 1; inb <= i__4; ++inb) { +#line 3689 "" ip = comipb_1.ipb[inb - 1]; +#line 3690 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) { +#line 3690 "" goto L8; +#line 3690 "" } +#line 3691 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26) && *( unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l') { /* letter-dynamic or hairpin ending under down-beamed */ +#line 3695 "" ++iorn; +#line 3696 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - (multb - 1) * 1.2f; /* Computing MIN */ +#line 3698 "" r__1 = ybeam - 3.f; - i__2 = i_nint(&r__1), i__3 = nomornlev - 10; - ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3); +#line 3698 "" + i__5 = i_nint(&r__1), i__6 = nomornlev - 10; +#line 3698 "" + ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6); +#line 3699 "" } else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */ @@ -5522,35 +9553,52 @@ L6: /* Non-chord. There IS an ornament. Need ihornb only if upbeam, and if */ /* ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) */ +#line 3707 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1] & 4163566) > 0) { +#line 3709 "" ++iorn; +#line 3710 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[ commvl_1.ivx + ip * 24 - 1],22); +#line 3711 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[ inb - 1] / all_1.slfac - 1 + (multb - 1) * 1.2f; /* Computing MAX */ +#line 3713 "" r__1 = ybeam + 3.f; - i__2 = i_nint(&r__1); - ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev); +#line 3713 "" + i__5 = i_nint(&r__1); +#line 3713 "" + ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev); +#line 3714 "" } +#line 3715 "" } else { /* In a chord. Orn may be on main note or non-main or both. Set ihornb if */ /* upbeam and highest note has orn, or down beam and lowest. Find 1st chord note */ - i__2 = comtrill_1.ncrd; - for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__2; +#line 3720 "" + i__5 = comtrill_1.ncrd; +#line 3720 "" + for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__5; ++comtrill_1.icrd1) { +#line 3721 "" if ((255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]) == ip && ( 15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], (ftnlen)-8)) == commvl_1.ivx) { +#line 3721 "" goto L11; +#line 3721 "" } +#line 3723 "" /* L10: */ +#line 3723 "" } +#line 3724 "" L11: /* Find outermost note, min or max depending on beam direction ulq. xto is true */ @@ -5558,79 +9606,126 @@ L11: /* on extreme chord note in beam, will move. */ /* So ornaments are all except 0,4,13 (,g,) */ +#line 3731 "" levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; +#line 3732 "" xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1] & 4186094) > 0; +#line 3733 "" icrdx = 0; - i__2 = comtrill_1.ncrd; - for (icrd = comtrill_1.icrd1; icrd <= i__2; ++icrd) { +#line 3734 "" + i__5 = comtrill_1.ncrd; +#line 3734 "" + for (icrd = comtrill_1.icrd1; icrd <= i__5; ++icrd) { +#line 3735 "" if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8)) != commvl_1.ivx) { +#line 3735 "" goto L13; +#line 3735 "" } +#line 3737 "" levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen) -12); +#line 3738 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u' && levc > levx || *(unsigned char *)& all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' && levc < levx) { +#line 3740 "" levx = levc; +#line 3741 "" icrdx = icrd; +#line 3742 "" xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0; +#line 3743 "" } +#line 3744 "" /* L12: */ +#line 3744 "" } +#line 3745 "" L13: /* If there's orn on extreme note, do stuff */ +#line 3749 "" if (xto) { +#line 3750 "" ++iorn; +#line 3751 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 3752 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac - 1 + ( multb - 1) * 1.2f; /* Computing MAX */ +#line 3754 "" r__1 = ybeam + 3.f; - i__2 = i_nint(&r__1); - ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev); +#line 3754 "" + i__5 = i_nint(&r__1); +#line 3754 "" + ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev); +#line 3755 "" } else { +#line 3756 "" ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - ( multb - 1) * 1.2f; /* Computing MIN */ +#line 3758 "" r__1 = ybeam - 3.f; - i__2 = i_nint(&r__1), i__3 = nomornlev - 10; - ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3); +#line 3758 "" + i__5 = i_nint(&r__1), i__6 = nomornlev - 10; +#line 3758 "" + ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6); +#line 3759 "" } +#line 3760 "" if (icrdx == 0) { /* Affected ornament is on main note */ +#line 3764 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( all_1.iornq[commvl_1.ivx + ip * 24 - 1],22); +#line 3765 "" } else { +#line 3766 "" comtrill_1.icrdorn[icrdx - 1] = bit_set( comtrill_1.icrdorn[icrdx - 1],22); +#line 3767 "" } +#line 3768 "" } +#line 3769 "" } +#line 3770 "" L8: +#line 3770 "" ; +#line 3770 "" } /* Henceforth nornb will be a counter. */ +#line 3774 "" if (iorn > 0) { +#line 3774 "" nornb[commvl_1.ivx] = 1; +#line 3774 "" } +#line 3775 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { +#line 3775 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 3775 "" } +#line 3776 "" return 0; } /* beamstrt_ */ @@ -5654,30 +9749,45 @@ L8: /* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ /* logical gotclef */ +#line 3860 "" i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1; +#line 3860 "" for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1; ++iptr) { +#line 3861 "" if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) < comtol_1.tol) { +#line 3862 "" if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) < comtol_1.tol) { /* Increment pre-existing entry */ +#line 3866 "" c1omnotes_1.nnpd[iptr - 1] += *nnsk; +#line 3867 "" return 0; +#line 3868 "" } +#line 3869 "" } +#line 3870 "" /* L16: */ +#line 3870 "" } /* Didn't find current duration & squez, so add a new entry. */ /* No particular reason to keep in order, so add at the end. */ +#line 3875 "" c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk; +#line 3876 "" c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space; +#line 3877 "" c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez; +#line 3878 "" ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; +#line 3879 "" return 0; } /* catspace_ */ @@ -5687,7 +9797,9 @@ L8: /* The only reason for this seemingly do-nothing function is to get around an */ /* apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! */ +#line 3886 "" *(unsigned char *)ret_val = (char) (*n); +#line 3887 "" return ; } /* chax_ */ @@ -5722,141 +9834,238 @@ L8: ftnlen, ftnlen); static char dynsymq[4]; +#line 3894 "" txtdyn = FALSE_; /* On entry, iccount is on "D" */ +#line 3898 "" i__1 = *iccount; +#line 3898 "" if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { /* Dynamic text */ +#line 3903 "" istart = *iccount + 2; /* 1 past 1st quote */ +#line 3904 "" L3: +#line 3905 "" iend = i_indx(lineq + (istart - 1), "\"", 128 - (istart - 1), (ftnlen) 1); +#line 3906 "" i__1 = istart + iend - 3; +#line 3906 "" if (s_cmp(lineq + i__1, "\\", istart + iend - 2 - i__1, (ftnlen)1) == 0) { +#line 3907 "" istart = *iccount + iend + 2; +#line 3908 "" goto L3; +#line 3909 "" } +#line 3910 "" if (iend == 0) { +#line 3911 "" i__1 = *iccount + 1; - errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit" +#line 3911 "" + errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"\ "h double quote!", (ftnlen)128, (ftnlen)50); +#line 3913 "" stop1_(); +#line 3914 "" } /* Set iccount to character after 2nd ", and set ipm */ /* iccount = iccount+iend+2 */ +#line 3919 "" *iccount = istart + iend; +#line 3920 "" ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1); +#line 3921 "" if (ipm == 0) { - errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h" +#line 3922 "" + errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"\ "ere!", (ftnlen)128, (ftnlen)33); +#line 3924 "" stop1_(); +#line 3925 "" } +#line 3926 "" } else { /* Expect ordinary dynamic */ +#line 3930 "" for (iend = *iccount + 2; iend <= 128; ++iend) { +#line 3931 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); +#line 3932 "" if (ipm > 0) { +#line 3932 "" goto L2; +#line 3932 "" } +#line 3933 "" /* L1: */ +#line 3933 "" } +#line 3934 "" L2: +#line 3935 "" if (iend - *iccount > 5 || iend - *iccount < 2) { +#line 3936 "" i__1 = iend - 1; +#line 3936 "" errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", ( ftnlen)128, (ftnlen)30); +#line 3938 "" stop1_(); +#line 3939 "" } +#line 3940 "" i__1 = *iccount; +#line 3940 "" ici__1.icierr = 0; +#line 3940 "" ici__1.iciend = 0; +#line 3940 "" ici__1.icirnum = 1; +#line 3940 "" ici__1.icirlen = iend - 1 - i__1; +#line 3940 "" ici__1.iciunit = lineq + i__1; /* Writing concatenation */ +#line 3940 "" i__2[0] = 2, a__1[0] = "(a"; +#line 3940 "" i__3 = iend + 47 - *iccount; +#line 3940 "" chax_(ch__2, (ftnlen)1, &i__3); +#line 3940 "" i__2[1] = 1, a__1[1] = ch__2; +#line 3940 "" i__2[2] = 1, a__1[2] = ")"; +#line 3940 "" ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 3940 "" s_rsfi(&ici__1); +#line 3940 "" do_fio(&c__1, dynsymq, (ftnlen)4); +#line 3940 "" e_rsfi(); - idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< " +#line 3942 "" + idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "\ "> ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4; +#line 3945 "" if (idno == 0) { +#line 3946 "" i__1 = *iccount + 1; +#line 3946 "" errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128, (ftnlen)21); +#line 3947 "" stop1_(); +#line 3948 "" } +#line 3949 "" *iccount = iend; +#line 3950 "" } +#line 3951 "" if (ipm != 2) { /* There is a vertical shift, have "+" or "-" */ +#line 3955 "" ++(*iccount); +#line 3956 "" if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen) 1) == 0) { - errmsg_(lineq, iccount, ibar, "Expected integer here for vertica" +#line 3957 "" + errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"\ "l offset!", (ftnlen)128, (ftnlen)42); +#line 3959 "" stop1_(); +#line 3960 "" } +#line 3961 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3962 "" idno = i_nint(&fnum); +#line 3963 "" if (idno > 63) { +#line 3964 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu" +#line 3964 "" + errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"\ "st be (-63,63)!", (ftnlen)128, (ftnlen)50); +#line 3966 "" stop1_(); +#line 3967 "" } +#line 3968 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); +#line 3969 "" if (ipm == 0) { - errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h" +#line 3970 "" + errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"\ "ere!", (ftnlen)128, (ftnlen)33); +#line 3972 "" stop1_(); +#line 3973 "" } +#line 3974 "" if (ipm != 2) { /* There is a horizontal shift */ +#line 3978 "" ++(*iccount); +#line 3979 "" if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, ( ftnlen)1) == 0) { - errmsg_(lineq, iccount, ibar, "Expected number here for hori" +#line 3980 "" + errmsg_(lineq, iccount, ibar, "Expected number here for hori"\ "zontal offset!", (ftnlen)128, (ftnlen)43); +#line 3982 "" stop1_(); +#line 3983 "" } +#line 3984 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3985 "" r__1 = fnum * 10; +#line 3985 "" idno = i_nint(&r__1); +#line 3986 "" if (idno > 255) { +#line 3987 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m" +#line 3987 "" + errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"\ "ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56); +#line 3989 "" stop1_(); +#line 3990 "" } else if (*(unsigned char *)durq != ' ') { +#line 3991 "" errmsg_(lineq, iccount, ibar, "There should be a blank here!", (ftnlen)128, (ftnlen)29); +#line 3993 "" stop1_(); +#line 3994 "" } +#line 3995 "" } /* iccount should be on the blank at the end of the entire symbol */ +#line 3999 "" } +#line 4000 "" return 0; } /* checkdyn_ */ @@ -5875,10 +10084,15 @@ L2: /* subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */ /* * icashft) */ +#line 4007 "" /* Parameter adjustments */ +#line 4007 "" --icrdat; +#line 4007 "" +#line 4007 "" /* Function Body */ +#line 4007 "" found1 = FALSE_; /* icashft will be max left shift of accid's in chord notes. */ @@ -5886,14 +10100,19 @@ L2: /* Will include left shift of chord note itself. */ /* Rezero after use. */ +#line 4014 "" i__1 = *ncrd; +#line 4014 "" for (icrd = 1; icrd <= i__1; ++icrd) { /* This if block cycles thru all chord notes on ivx,ip; then returns. */ +#line 4018 "" if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], ( ftnlen)-8)) == *ivx) { +#line 4020 "" found1 = TRUE_; +#line 4021 "" *iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test( icrdat[icrd],27); @@ -5917,12 +10136,19 @@ L2: /* if (irshft .lt. 64) icashft = max(icashft,64-irshft) */ /* end if */ /* end if */ +#line 4044 "" *isarp = *isarp || bit_test(icrdat[icrd],25); +#line 4045 "" } else if (found1) { +#line 4046 "" return 0; +#line 4047 "" } +#line 4048 "" /* L18: */ +#line 4048 "" } +#line 4049 "" return 0; } /* chkarp_ */ @@ -5934,26 +10160,41 @@ L2: e_wsfe(void); /* Fortran I/O blocks */ - static cilist io___245 = { 0, 6, 0, 0, 0 }; - static cilist io___246 = { 0, 6, 0, 0, 0 }; - static cilist io___247 = { 0, 6, 0, "(a6,2x,4i8)", 0 }; + static cilist io___271 = { 0, 6, 0, 0, 0 }; + static cilist io___272 = { 0, 6, 0, 0, 0 }; + static cilist io___273 = { 0, 6, 0, "(a6,2x,4i8)", 0 }; +#line 4062 "" if (commidi_1.imidi[*icm] >= 24576) { - s_wsle(&io___245); +#line 4063 "" + s_wsle(&io___271); +#line 4063 "" e_wsle(); - s_wsle(&io___246); - do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or" +#line 4064 "" + s_wsle(&io___272); +#line 4064 "" + do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"\ " worse", (ftnlen)52); +#line 4064 "" e_wsle(); - s_wsfe(&io___247); +#line 4065 "" + s_wsfe(&io___273); +#line 4065 "" do_fio(&c__1, "imidi:", (ftnlen)6); +#line 4065 "" do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer)); +#line 4065 "" do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer)); +#line 4065 "" do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer)); +#line 4065 "" do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer)); +#line 4065 "" e_wsfe(); +#line 4067 "" } +#line 4068 "" return 0; } /* chkimidi_ */ @@ -5991,129 +10232,223 @@ L2: /* otherwise next prior note. Relative to bottom line. */ /* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */ +#line 4090 "" /* Parameter adjustments */ +#line 4090 "" ipl -= 25; +#line 4090 "" mult -= 25; +#line 4090 "" --levbotr; +#line 4090 "" --levtopr; +#line 4090 "" nodur -= 25; +#line 4090 "" nib -= 25; +#line 4090 "" ivmx -= 25; +#line 4090 "" nolev -= 25; +#line 4090 "" irest -= 25; +#line 4090 "" islur -= 25; +#line 4090 "" --nn; +#line 4090 "" +#line 4090 "" /* Function Body */ +#line 4090 "" if (*ip != nn[*ivx] && ! bit_test(ipl[*ivx + *ip * 24],1)) { /* Not the last note and not "look-left" for level */ +#line 4094 "" i__1 = nn[*ivx]; +#line 4094 "" for (kkp = *ip + 1; kkp <= i__1; ++kkp) { +#line 4095 "" if (bit_test(islur[*ivx + kkp * 24],29)) { +#line 4095 "" goto L4; +#line 4095 "" } +#line 4096 "" if (! bit_test(irest[*ivx + kkp * 24],0)) { +#line 4097 "" levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; /* Relative to botto */ +#line 4098 "" goto L9; +#line 4099 "" } +#line 4100 "" /* L8: */ +#line 4100 "" } +#line 4101 "" } +#line 4102 "" L4: /* If here, there were no following notes or came to a blank rest, or */ /* "look-left" option set. So look before */ /* if (ip .eq. 1) go to 2 ! Get out if this is the first note. */ +#line 4108 "" if (*ip == 1) { +#line 4108 "" return 0; +#line 4108 "" } /* Get out if this is the first note. */ +#line 4109 "" for (kkp = *ip - 1; kkp >= 1; --kkp) { +#line 4110 "" if (! bit_test(irest[*ivx + kkp * 24],0)) { +#line 4111 "" levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; /* Relative to bottom */ +#line 4112 "" goto L9; +#line 4113 "" } +#line 4114 "" /* L3: */ +#line 4114 "" } /* go to 2 ! Pretty odd, should never be here, but get out if so. */ +#line 4116 "" return 0; /* Pretty odd, should never be here, but get out if so. */ +#line 4117 "" L9: /* Find note in other voice at same time */ +#line 4121 "" i__1 = *ivx - *nv - 1; +#line 4121 "" iupdown = i_sign(&c__1, &i__1); +#line 4122 "" ivother = ivmx[*iv + (3 - iupdown) / 2 * 24]; +#line 4123 "" tother = 0.f; +#line 4124 "" i__1 = nib[ivother + *ibar * 24]; +#line 4124 "" for (kkp = 1; kkp <= i__1; ++kkp) { +#line 4125 "" if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) { +#line 4125 "" goto L6; +#line 4125 "" } +#line 4126 "" tother += nodur[ivother + kkp * 24]; +#line 4127 "" /* L5: */ +#line 4127 "" } /* If here, then no note starts in other voice at same time, so set default */ +#line 4131 "" levother = -iupdown * 50; +#line 4132 "" goto L7; +#line 4133 "" L6: /* If here, have just identified a simultaneous note or rest in other voice */ +#line 4137 "" if (! bit_test(irest[ivother + kkp * 24],0)) { /* Not a rest, use it */ +#line 4138 "" levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4; +#line 4139 "" } else { +#line 4140 "" if (nodur[ivother + kkp * 24] == nodur[*ivx + *ip * 24]) { /* Rest in other voice has same duration, get out (so defualt spacing is used) */ /* go to 2 */ +#line 4145 "" return 0; +#line 4146 "" } +#line 4147 "" levother = -iupdown * 50; +#line 4148 "" } +#line 4149 "" L7: +#line 4150 "" if (*mode == 1) { +#line 4151 "" indxr = log2_(&nodur[*ivx + *ip * 24]) + 1; +#line 4152 "" } else { /* nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */ +#line 4154 "" indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1; +#line 4155 "" } +#line 4156 "" if (iupdown < 0) { +#line 4157 "" levtop = levtopr[indxr]; +#line 4158 "" iraise1 = levother - levtop - 3; /* Based on other note */ +#line 4159 "" iraise2 = levnext - levtop; /* Based on following note */ +#line 4160 "" if (indxr == 5 && levnext < 1) { +#line 4160 "" iraise2 += 2; +#line 4160 "" } +#line 4161 "" iraise = min(iraise1,iraise2); +#line 4162 "" if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) { +#line 4162 "" --iraise; +#line 4162 "" } +#line 4164 "" } else { +#line 4165 "" levbot = levbotr[indxr]; +#line 4166 "" iraise1 = levother - levbot + 3; +#line 4167 "" iraise2 = levnext - levbot; +#line 4168 "" if (indxr == 5 && levnext > 8) { +#line 4168 "" --iraise2; +#line 4168 "" } +#line 4169 "" iraise = max(iraise1,iraise2); +#line 4170 "" if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) { +#line 4170 "" --iraise; +#line 4170 "" } +#line 4172 "" } +#line 4173 "" nolev[*ivx + *ip * 24] = iraise + 100; +#line 4174 "" return 0; } /* chkkbdrests_ */ @@ -6130,44 +10465,80 @@ L7: extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, ftnlen); +#line 4179 "" *literr = 0; +#line 4180 "" itype = 1; +#line 4181 "" L17: +#line 4181 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 4182 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 4182 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { +#line 4183 "" ++itype; +#line 4184 "" if (itype > 3) { +#line 4185 "" *literr = 1; +#line 4186 "" return 0; +#line 4187 "" } +#line 4188 "" goto L17; +#line 4189 "" } +#line 4190 "" lenlit = itype; +#line 4191 "" L18: +#line 4191 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 4192 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 4192 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { +#line 4193 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 4194 "" if (*(unsigned char *)charq != ' ') { /* Starting a new tex command withing the string */ +#line 4198 "" lenlit += 2; +#line 4199 "" if (lenlit > 128) { +#line 4200 "" *literr = 2; +#line 4201 "" return 0; +#line 4202 "" } +#line 4203 "" goto L18; +#line 4204 "" } +#line 4205 "" } else { +#line 4206 "" ++lenlit; +#line 4207 "" if (lenlit > 128) { +#line 4208 "" *literr = 2; +#line 4209 "" return 0; +#line 4210 "" } +#line 4211 "" goto L18; +#line 4212 "" } +#line 4213 "" return 0; } /* chklit_ */ @@ -6199,8 +10570,11 @@ L18: /* numbers. If moved=.true., iccount on exit is on end of last number. */ /* If moved=.false., iccount still on +/- */ +#line 4226 "" i__1 = *iccount - 2; +#line 4226 "" i__2 = *iccount; +#line 4226 "" if (i_indx("sfnA", lineq + i__1, (ftnlen)4, *iccount - 1 - i__1) > 0 && i_indx("0123456789.", lineq + i__2, (ftnlen)11, *iccount + 1 - i__2) > 0) { @@ -6208,66 +10582,100 @@ L18: /* Prior char was accid & next is #; this may be start of accidental shift. */ /* Must test for "." above in case we get "<" or ">" */ +#line 4232 "" ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1) - 2; +#line 4233 "" i__1 = *iccount + 1; +#line 4233 "" i__2 = *iccount; +#line 4233 "" if (s_cmp(lineq + i__2, ".", *iccount + 1 - i__2, (ftnlen)1) == 0 && i_indx("0123456789", lineq + i__1, (ftnlen)10, *iccount + 2 - i__1) == 0) { /* Rare case of [accid][+/-].[letter]. Bail out */ +#line 4238 "" *moved = FALSE_; +#line 4239 "" return 0; +#line 4240 "" } +#line 4241 "" ishorz = ipm > 1; /* Save iccount in case it's not accid shift and we have to reset. */ +#line 4245 "" icsav = *iccount; +#line 4246 "" ++(*iccount); +#line 4247 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 4248 "" if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* This has to be accidental shift. Set vert. shift. */ +#line 4252 "" if (! ishorz) { /* +/- syntax, both shifts set, vertical first */ +#line 4256 "" i__1 = (integer) (ipm * fnum + 32.5f); +#line 4256 "" setbits_(nacc, &c__6, &c__4, &i__1); +#line 4257 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 4258 "" ++(*iccount); +#line 4259 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 4260 "" } else { /* </> syntax, only horiz set */ +#line 4264 "" ipm += -3; +#line 4265 "" } /* Set horiz. shift */ +#line 4269 "" r__1 = (ipm * fnum + 5.35f) * 20; +#line 4269 "" i__1 = i_nint(&r__1); +#line 4269 "" setbits_(nacc, &c__7, &c__10, &i__1); +#line 4270 "" --(*iccount); +#line 4271 "" *moved = TRUE_; +#line 4272 "" } else { /* False alarm. Reset everything and flow onward */ +#line 4276 "" *moved = FALSE_; +#line 4277 "" *iccount = icsav; +#line 4278 "" } +#line 4279 "" } else { /* Either prior char was not 'sfn' or next was not digit, so take no action */ +#line 4283 "" *moved = FALSE_; +#line 4284 "" } +#line 4285 "" return 0; } /* chkpm4ac_ */ @@ -6290,40 +10698,62 @@ L18: /* Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */ +#line 4293 "" *nclef = lbit_shift(*isl, (ftnlen)-12) & 7; +#line 4294 "" if (*nclef == 0) { /* treble */ +#line 4298 "" nlev = 2; +#line 4299 "" } else if (*nclef > 6) { /* French violin */ +#line 4303 "" nlev = 0; +#line 4304 "" } else if (*nclef < 5) { /* C-clef */ +#line 4308 "" nlev = (*nclef << 1) - 2; +#line 4309 "" } else { /* F-clef */ +#line 4313 "" nlev = (*nclef << 1) - 6; +#line 4314 "" } /* Writing concatenation */ +#line 4315 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 4315 "" i__1[0] = 1, a__1[0] = ch__1; +#line 4315 "" i__1[1] = 7, a__1[1] = "pmxclef"; +#line 4315 "" i__2 = min(*nclef,7) + 48; +#line 4315 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 4315 "" i__1[2] = 1, a__1[2] = ch__2; +#line 4315 "" i__3 = nlev + 48; +#line 4315 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 4315 "" i__1[3] = 1, a__1[3] = ch__3; +#line 4315 "" s_cat(notexq, a__1, i__1, &c__4, notexq_len); +#line 4317 "" *lnote = 10; +#line 4318 "" return 0; } /* clefsym_ */ @@ -6378,8 +10808,8 @@ L18: integer *); /* Fortran I/O blocks */ - static cilist io___294 = { 0, 6, 0, 0, 0 }; - static cilist io___295 = { 0, 6, 0, 0, 0 }; + static cilist io___320 = { 0, 6, 0, 0, 0 }; + static cilist io___321 = { 0, 6, 0, 0, 0 }; @@ -6398,11 +10828,17 @@ L18: /* icrdot(icrd)(27-29) = level rank of chord-note among accid-notes */ /* twooftwo will be true 2nd time thru; signal to store shifts w/ notes */ +#line 4345 "" /* Parameter adjustments */ +#line 4345 "" --ksegrb0; +#line 4345 "" segrb0 -= 3; +#line 4345 "" --micrd; +#line 4345 "" +#line 4345 "" /* Function Body */ /* Fancy sharp boundary. fl,sh,na,dfl,dsh */ @@ -6419,97 +10855,152 @@ L18: /* Set up barrier segrb(iseg,ipoint) to define coords of corner points */ /* on stem+notes */ +#line 4376 "" i__1 = *nsegrb0; +#line 4376 "" for (iseg = 1; iseg <= i__1; ++iseg) { +#line 4377 "" segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1]; +#line 4378 "" segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2]; +#line 4379 "" ksegrb[iseg - 1] = ksegrb0[iseg]; +#line 4380 "" /* L11: */ +#line 4380 "" } +#line 4381 "" nsegrb = *nsegrb0; +#line 4382 "" *rmsshift = 0.f; +#line 4383 "" shiftmin = 1e3f; +#line 4384 "" i__1 = *naccid; +#line 4384 "" for (iwa = 1; iwa <= i__1; ++iwa) { /* Initialize shift for this note */ +#line 4388 "" shift = 0.f; +#line 4389 "" mainnote = micrd[iwa] == 0; +#line 4390 "" isetshft[iwa - 1] = -1; /* Get note level and accidental type */ +#line 4394 "" if (mainnote) { +#line 4395 "" nolev = *nolevm; +#line 4396 "" iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1]; +#line 4397 "" } else { +#line 4398 "" nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, & c__12); +#line 4399 "" iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], & c__3, &c__20) - 1]; +#line 4400 "" } /* Cycle thru segments on right edge of this accidental */ +#line 4404 "" i__2 = nsegar[iacctype - 1] - 1; +#line 4404 "" for (isega = 1; isega <= i__2; ++isega) { +#line 4405 "" ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16]; +#line 4406 "" ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 - 16]; /* Cycle thru segments of right-hand barrier */ +#line 4410 "" i__3 = nsegrb - 1; +#line 4410 "" for (isegrb = 1; isegrb <= i__3; ++isegrb) { /* Must find all barrier segments that start below ytopseg & end above ybotseg */ +#line 4414 "" if (segrb[(isegrb << 1) - 1] < ytopaseg) { /* Barrier seg starts below top of accid */ /* Check if barrier seg ends above bottom of accid */ +#line 4419 "" if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) { +#line 4420 "" if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype + ((isega << 1) + 1) * 5 - 16]) { +#line 4422 "" shift = segrb[(isegrb << 1) - 2] - segar[iacctype + ((isega << 1) + 1) * 5 - 16]; /* Record the cause of the shift */ +#line 4426 "" isetshft[iwa - 1] = ksegrb[isegrb - 1]; +#line 4427 "" } +#line 4428 "" } /* Does barrier segment end above top of accid seg? */ +#line 4432 "" if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) { +#line 4432 "" goto L4; +#line 4432 "" } +#line 4433 "" } +#line 4434 "" /* L3: */ +#line 4434 "" } +#line 4435 "" L4: +#line 4436 "" /* L2: */ +#line 4436 "" ; +#line 4436 "" } +#line 4437 "" if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) { /* if (nolev .eq. levmaxacc) then */ +#line 4440 "" if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) { +#line 4441 "" *rmsshift = 1e3f; +#line 4442 "" return 0; +#line 4443 "" } /* Does the following properly account for left-shifted noteheads? */ /* Top-down rank of this note we just shifted */ +#line 4449 "" if (mainnote) { +#line 4450 "" irank = *icrdot0; +#line 4451 "" } else { +#line 4452 "" irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, & c__27); +#line 4453 "" } /* Compare level-rank of this note vs. that of note that caused the shift. */ @@ -6522,158 +11013,264 @@ L4: /* icrd: Chord-note accidental */ /* isetshft(i),i=1,naccid: what set shift for this accid, same codes */ +#line 4465 "" if (isetshft[iwa - 1] < 0) { +#line 4466 "" iranksetter = 0; +#line 4467 "" } else if (isetshft[iwa - 1] == 0) { +#line 4468 "" iranksetter = *icrdot0; +#line 4469 "" } else { +#line 4470 "" iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1] - 1], &c__3, &c__27); +#line 4471 "" } +#line 4472 "" if (iranksetter != 0 && irank != iranksetter + 1) { +#line 4473 "" *rmsshift = 1e3f; +#line 4474 "" return 0; +#line 4475 "" } +#line 4476 "" } /* Computing 2nd power */ +#line 4477 "" r__1 = shift; +#line 4477 "" *rmsshift += r__1 * r__1; +#line 4478 "" if (*lasttime && dabs(shift) > 1e-4f) { +#line 4479 "" if (mainnote) { +#line 4480 "" if (! bit_test(*nacc,29)) { +#line 4480 "" goto L10; +#line 4480 "" } +#line 4481 "" } else { +#line 4482 "" if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) { +#line 4482 "" goto L10; +#line 4482 "" } +#line 4483 "" } /* If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there */ /* was a manual shift but auto-shift was zero, will not come thru here, but shift value */ /* will be left intact. */ +#line 4489 "" if (mainnote) { +#line 4490 "" shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f; +#line 4491 "" } else { +#line 4492 "" shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, &c__20) - 107) * .05f; +#line 4493 "" } +#line 4494 "" L10: +#line 4495 "" if (*twooftwo) { /* Record the shift for this accidental */ +#line 4499 "" if (shift < -5.35f) { +#line 4500 "" printl_(" ", (ftnlen)1); - printl_("WARNING: auto-generated accidental shift too bi" +#line 4501 "" + printl_("WARNING: auto-generated accidental shift too bi"\ "g for PMX, ignoring", (ftnlen)66); +#line 4503 "" } else { +#line 4504 "" r__1 = (shift + 5.35f) * 20; +#line 4504 "" ishift = i_nint(&r__1); +#line 4505 "" if (mainnote) { +#line 4506 "" setbits_(nacc, &c__7, &c__10, &ishift); +#line 4507 "" } else { +#line 4508 "" setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, & c__20, &ishift); +#line 4509 "" } +#line 4510 "" } +#line 4511 "" } else { /* This is the earlier call to precrd, so need minimum shift */ +#line 4515 "" shiftmin = dmin(shiftmin,shift); +#line 4516 "" } +#line 4517 "" } /* Bail out if this is the last accidental to check */ +#line 4521 "" if (iwa == *naccid) { +#line 4521 "" goto L1; +#line 4521 "" } /* Add this accidental to the right barrier! Count down from highest barrier segment, */ /* find 1st one starting below top of accid, and first one starting below bot. */ +#line 4526 "" for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) { +#line 4527 "" if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + (( nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) { +#line 4529 "" for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) { +#line 4530 "" if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype + 4]) { +#line 4530 "" goto L6; +#line 4530 "" } +#line 4532 "" /* L9: */ +#line 4532 "" } - s_wsle(&io___294); +#line 4533 "" + s_wsle(&io___320); +#line 4533 "" do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6); +#line 4533 "" e_wsle(); +#line 4534 "" stop1_(); +#line 4535 "" } +#line 4536 "" /* L5: */ +#line 4536 "" } - s_wsle(&io___295); +#line 4537 "" + s_wsle(&io___321); +#line 4537 "" do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16); +#line 4537 "" e_wsle(); +#line 4538 "" stop1_(); +#line 4539 "" L6: +#line 4540 "" netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot; /* Shift high segments up */ +#line 4544 "" if (netgain >= 0) { +#line 4545 "" i__2 = ibelowtop + 1; +#line 4545 "" for (isegrb = nsegrb; isegrb >= i__2; --isegrb) { +#line 4546 "" segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; +#line 4547 "" segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; +#line 4548 "" ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; +#line 4549 "" /* L7: */ +#line 4549 "" } /* Set up 1st segment above accid */ +#line 4553 "" segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - 2]; +#line 4554 "" segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; +#line 4556 "" ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; +#line 4557 "" } else { /* netgain<0, must remove segments. Use same coding but reverse order, */ /* work from bottom up */ +#line 4562 "" segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - 2]; +#line 4563 "" segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; +#line 4565 "" ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; +#line 4566 "" i__2 = nsegrb; +#line 4566 "" for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) { +#line 4567 "" segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; +#line 4568 "" segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; +#line 4569 "" ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; +#line 4570 "" /* L12: */ +#line 4570 "" } +#line 4571 "" } /* Insert new segments */ +#line 4575 "" i__2 = nsegal[iacctype - 1] - 1; +#line 4575 "" for (isega = 1; isega <= i__2; ++isega) { +#line 4576 "" segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + (( isega << 1) + 1) * 5 - 16]; +#line 4577 "" segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + (( isega << 1) + 2) * 5 - 16]; +#line 4578 "" if (mainnote) { +#line 4579 "" ksegrb[ibelowbot + isega - 1] = 0; +#line 4580 "" } else { +#line 4581 "" ksegrb[ibelowbot + isega - 1] = micrd[iwa]; +#line 4582 "" } +#line 4583 "" /* L8: */ +#line 4583 "" } /* Update number of barrier segments */ +#line 4587 "" nsegrb += netgain; /* c */ /* c Temporary printout for boundary segments as built up */ @@ -6684,16 +11281,23 @@ L6: /* write(15,'(a/(2i5))')' micrd isetshft', */ /* * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */ /* c */ +#line 4597 "" L1: +#line 4597 "" ; +#line 4597 "" } /* next accidental */ +#line 4598 "" if (*lasttime && ! (*twooftwo)) { /* This is the final call on the pre-ask pass, so compute left-shift rqmt. */ +#line 4602 "" r__1 = shiftmin * -20; +#line 4602 "" *icashft = i_nint(&r__1); +#line 4603 "" } /* c */ /* c Temporary printout for boundary segments */ @@ -6706,6 +11310,7 @@ L1: /* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */ /* end if */ /* c */ +#line 4615 "" return 0; } /* crdacc_ */ @@ -6742,7 +11347,7 @@ L1: integer *); /* Fortran I/O blocks */ - static cilist io___324 = { 0, 6, 0, 0, 0 }; + static cilist io___350 = { 0, 6, 0, 0, 0 }; @@ -6775,16 +11380,27 @@ L1: /* Initialize right-barrier */ +#line 4655 "" /* Parameter adjustments */ +#line 4655 "" --kicrd; +#line 4655 "" +#line 4655 "" /* Function Body */ +#line 4655 "" segrb0[0] = 0.f; +#line 4656 "" segrb0[1] = -1e3f; +#line 4657 "" segrb0[2] = 0.f; +#line 4658 "" segrb0[3] = 1e3f; +#line 4659 "" nsegrb0 = 2; +#line 4660 "" ksegrb0[0] = -1; +#line 4661 "" ksegrb0[1] = -1; /* Search for left-shifted notes, Make up the initial right-barrier, which */ @@ -6792,77 +11408,124 @@ L1: /* irest()(27) is set if any notes are left-shifted */ /* Must use ALL chord notes, not just ones w/ accid's. */ +#line 4668 "" if (bit_test(*irest,27)) { +#line 4669 "" i__1 = comtrill_1.icrd2; +#line 4669 "" for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) { +#line 4670 "" if (icrd == comtrill_1.icrd1 - 1) { /* Main note */ /* lshift = btest(ipl,8) */ +#line 4675 "" lshift = bit_test(*ipl,8) || bit_test(*nacc,31); +#line 4676 "" if (lshift) { +#line 4676 "" nolev = *nolevm; +#line 4676 "" } +#line 4677 "" } else { /* Chord note */ +#line 4681 "" lshift = bit_test(comtrill_1.icrdat[icrd - 1],23); /* if (lshift) nolev = igetbits(icrdat(icrd),7,12) */ +#line 4683 "" if (lshift) { +#line 4684 "" nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, & c__12); +#line 4685 "" if (bit_test(*nacc,31) && nolev == *nolevm + 1) { /* This note is not really shifted, It is the upper of a 2nd with the main */ /* note on an upstem, and Main note must be shifted. */ /* nacc(31) signals the real truth. */ +#line 4691 "" lshift = FALSE_; +#line 4692 "" } +#line 4693 "" } +#line 4694 "" } +#line 4695 "" if (lshift) { +#line 4696 "" i__2 = nsegrb0 - 1; +#line 4696 "" for (isegrb = 1; isegrb <= i__2; ++isegrb) { +#line 4697 "" if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) { /* Add this notehead to the right boundary here. Move all higher segs up 2. */ +#line 4701 "" i__3 = isegrb + 1; +#line 4701 "" for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) { +#line 4702 "" segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1) - 2]; +#line 4703 "" segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1) - 1]; +#line 4704 "" ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1]; +#line 4705 "" /* L17: */ +#line 4705 "" } +#line 4706 "" goto L18; +#line 4707 "" } +#line 4708 "" /* L16: */ +#line 4708 "" } +#line 4709 "" L18: /* Insert notehead into list. Set kseg=-2 to signal notehead shift. */ +#line 4713 "" iiseg = isegrb + 1; +#line 4714 "" segrb0[(iiseg << 1) - 2] = -1.2f; +#line 4715 "" segrb0[(iiseg << 1) - 1] = nolev - 1.f; +#line 4716 "" ksegrb0[iiseg - 1] = -2; +#line 4717 "" segrb0[(iiseg + 1 << 1) - 2] = 0.f; +#line 4718 "" segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f; +#line 4719 "" ksegrb0[iiseg] = -1; +#line 4720 "" nsegrb0 += 2; +#line 4721 "" } +#line 4722 "" /* L15: */ +#line 4722 "" } +#line 4723 "" } /* Done setting right barrier for left-shifted noteheads */ +#line 4727 "" tagged = FALSE_; +#line 4728 "" manual = FALSE_; /* Preprocess to check for manual shifts. */ @@ -6876,179 +11539,302 @@ L18: /* End if */ /* End if */ +#line 4741 "" maxmanshft = 0; +#line 4742 "" i__1 = *naccid; +#line 4742 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4743 "" if (kicrd[i__] == 0) { /* Main note */ +#line 4747 "" manshft = igetbits_(nacc, &c__7, &c__10); +#line 4748 "" if (manshft != 0) { +#line 4749 "" manual = TRUE_; +#line 4750 "" if (bit_test(*nacc,29)) { +#line 4751 "" tagged = TRUE_; +#line 4752 "" } else { /* maxmanshft = max(maxmanshft,64-manshft) */ /* Computing MAX */ +#line 4754 "" i__2 = maxmanshft, i__3 = 107 - manshft; +#line 4754 "" maxmanshft = max(i__2,i__3); +#line 4755 "" } +#line 4756 "" } +#line 4757 "" } else { /* Chord note */ +#line 4761 "" manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & c__20); +#line 4762 "" if (manshft != 0) { +#line 4763 "" manual = TRUE_; +#line 4764 "" if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { +#line 4765 "" tagged = TRUE_; +#line 4766 "" } else { /* maxmanshft = max(maxmanshft,64-manshft) */ /* Computing MAX */ +#line 4768 "" i__2 = maxmanshft, i__3 = 107 - manshft; +#line 4768 "" maxmanshft = max(i__2,i__3); +#line 4769 "" } +#line 4770 "" } +#line 4771 "" } +#line 4772 "" /* L13: */ +#line 4772 "" } +#line 4773 "" if (manual) { +#line 4774 "" if (tagged) { /* zero out all untagged shifts */ +#line 4778 "" i__1 = *naccid; +#line 4778 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4779 "" if (kicrd[i__] == 0) { +#line 4780 "" if (! bit_test(*nacc,29)) { +#line 4780 "" setbits_(nacc, &c__7, &c__10, &c__0); +#line 4780 "" } +#line 4781 "" } else { +#line 4782 "" if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { +#line 4782 "" setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & c__20, &c__0); +#line 4782 "" } +#line 4784 "" } +#line 4785 "" /* L14: */ +#line 4785 "" } +#line 4786 "" } else { /* There are manual shifts but none tagged. Only proceed if "Ao" was entered */ +#line 4790 "" if (! bit_test(*nacc,28)) { +#line 4791 "" *icashft = maxmanshft; +#line 4792 "" return 0; +#line 4793 "" } +#line 4794 "" } +#line 4795 "" } +#line 4796 "" if (bit_test(*nacc,28)) { /* Take the accidentals in order as originally input, then exit. */ +#line 4800 "" crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4802 "" return 0; /* end if */ +#line 4804 "" } else if (*naccid == 3) { /* Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd */ /* then place in order top, bottom, middle. */ +#line 4809 "" for (i__ = 1; i__ <= 3; ++i__) { +#line 4810 "" if (kicrd[i__] == 0) { +#line 4811 "" irank = *icrdot0; +#line 4812 "" nolev = *nolevm; +#line 4813 "" } else { +#line 4814 "" irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, & c__27); +#line 4815 "" nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, & c__12); +#line 4816 "" } +#line 4817 "" if (irank == 1) { +#line 4818 "" micrd[0] = kicrd[i__]; +#line 4819 "" } else { +#line 4820 "" micrd[5 - irank - 1] = kicrd[i__]; +#line 4821 "" } +#line 4822 "" if (irank == 2) { +#line 4823 "" levmidacc = nolev; +#line 4824 "" } +#line 4825 "" /* L20: */ +#line 4825 "" } +#line 4826 "" if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) { +#line 4828 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4830 "" return 0; +#line 4831 "" } +#line 4832 "" } +#line 4833 "" rmsmin = 1e5f; /* Initialize permutation array */ +#line 4837 "" i__1 = *naccid; +#line 4837 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4838 "" iperm[i__ - 1] = i__; +#line 4839 "" /* L7: */ +#line 4839 "" } /* Start looping over permutations */ +#line 4843 "" for (ip = 1; ip <= 5041; ++ip) { +#line 4844 "" if (ip != 1) { /* Work the magic algorithm to get the next permutation */ +#line 4848 "" for (k = *naccid - 1; k >= 1; --k) { +#line 4849 "" if (iperm[k - 1] <= iperm[k]) { +#line 4849 "" goto L2; +#line 4849 "" } +#line 4850 "" /* L1: */ +#line 4850 "" } /* If here, we just got the last permutation, so exit the loop over permutations */ +#line 4854 "" goto L10; +#line 4855 "" L2: +#line 4856 "" for (j = *naccid; j >= 1; --j) { +#line 4857 "" if (iperm[k - 1] <= iperm[j - 1]) { +#line 4857 "" goto L4; +#line 4857 "" } +#line 4858 "" /* L3: */ +#line 4858 "" } +#line 4859 "" L4: +#line 4860 "" it = iperm[j - 1]; +#line 4861 "" iperm[j - 1] = iperm[k - 1]; +#line 4862 "" iperm[k - 1] = it; +#line 4863 "" is = k + 1; +#line 4864 "" for (ir = *naccid; ir >= 1; --ir) { +#line 4865 "" if (ir <= is) { +#line 4865 "" goto L6; +#line 4865 "" } +#line 4866 "" it = iperm[ir - 1]; +#line 4867 "" iperm[ir - 1] = iperm[is - 1]; +#line 4868 "" iperm[is - 1] = it; +#line 4869 "" ++is; +#line 4870 "" /* L5: */ +#line 4870 "" } +#line 4871 "" L6: +#line 4872 "" ; +#line 4872 "" } /* New we have a permutation. Take icrd values out of kicrd and put them into */ /* micrd in the order of the permutation */ +#line 4877 "" i__1 = *naccid; +#line 4877 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4878 "" micrd[i__ - 1] = kicrd[iperm[i__ - 1]]; +#line 4879 "" /* L9: */ +#line 4879 "" } /* c */ /* c Temporary printout */ /* c */ /* write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */ /* c */ +#line 4885 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc, icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); /* c */ @@ -7056,39 +11842,61 @@ L6: /* c */ /* write(15,*)'perm done, rmsshift:',rmsshift */ /* c */ +#line 4892 "" if (rmsshift < rmsmin) { /* Save this permutation, reset minrms */ +#line 4896 "" i__1 = *naccid; +#line 4896 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4897 "" ipermsav[i__ - 1] = iperm[i__ - 1]; +#line 4898 "" rmsmin = rmsshift; +#line 4899 "" /* L11: */ +#line 4899 "" } +#line 4900 "" } +#line 4901 "" /* L8: */ +#line 4901 "" } - s_wsle(&io___324); +#line 4902 "" + s_wsle(&io___350); +#line 4902 "" do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24); +#line 4902 "" e_wsle(); +#line 4903 "" stop1_(); +#line 4904 "" L10: /* Done looping, get info for the final choice */ +#line 4908 "" i__1 = *naccid; +#line 4908 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 4909 "" micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]]; +#line 4910 "" /* L12: */ +#line 4910 "" } /* c */ /* c Temporary printout */ /* c */ /* write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */ /* c */ +#line 4916 "" crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4918 "" return 0; } /* crdaccs_ */ @@ -7122,108 +11930,191 @@ L10: static char acsymq[3]; static integer lnoten; +#line 4926 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 4926 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 4927 "" if (*ihshft == -107) { +#line 4927 "" *ihshft = 0; +#line 4927 "" } /* c */ /* c If main note shifted left, so shift accid. Terminate below, when acc. is done. */ /* c */ +#line 4931 "" if (*ihshft != 0) { /* Accid must be shifted horizontally */ +#line 4935 "" if (*ihshft < 0) { /* Writing concatenation */ +#line 4936 "" i__1[0] = 1, a__1[0] = sq; +#line 4936 "" i__1[1] = 8, a__1[1] = "loffset{"; +#line 4936 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4937 "" *ihshft = -(*ihshft); +#line 4938 "" } else { /* Writing concatenation */ +#line 4939 "" i__1[0] = 1, a__1[0] = sq; +#line 4939 "" i__1[1] = 8, a__1[1] = "roffset{"; +#line 4939 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4940 "" } +#line 4941 "" hshft = *ihshft * .05f; +#line 4942 "" if (hshft < 1.f) { +#line 4943 "" ici__1.icierr = 0; +#line 4943 "" ici__1.icirnum = 1; +#line 4943 "" ici__1.icirlen = 3; +#line 4943 "" ici__1.iciunit = notexq + 9; +#line 4943 "" ici__1.icifmt = "(f3.2)"; +#line 4943 "" s_wsfi(&ici__1); +#line 4943 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 4943 "" e_wsfi(); +#line 4944 "" *lnote = 12; +#line 4945 "" } else { +#line 4946 "" ici__1.icierr = 0; +#line 4946 "" ici__1.icirnum = 1; +#line 4946 "" ici__1.icirlen = 4; +#line 4946 "" ici__1.iciunit = notexq + 9; +#line 4946 "" ici__1.icifmt = "(f4.2)"; +#line 4946 "" s_wsfi(&ici__1); +#line 4946 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 4946 "" e_wsfi(); +#line 4947 "" *lnote = 13; +#line 4948 "" } /* Writing concatenation */ +#line 4949 "" i__2[0] = *lnote, a__2[0] = notexq; +#line 4949 "" i__2[1] = 2, a__2[1] = "}{"; +#line 4949 "" i__2[2] = 1, a__2[2] = sq; +#line 4949 "" s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); +#line 4950 "" *lnote += 3; +#line 4951 "" } else { +#line 4952 "" s_copy(notexq, sq, (ftnlen)79, (ftnlen)1); +#line 4953 "" *lnote = 1; +#line 4954 "" } +#line 4955 "" if (bit_test(*nacc,3)) { /* Writing concatenation */ +#line 4956 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 4956 "" i__1[1] = 3, a__1[1] = "big"; +#line 4956 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4957 "" *lnote += 3; +#line 4958 "" } +#line 4959 "" if (*caut) { /* Cautionary accidental. Need to define bigcna,... in pmx.tex */ /* Writing concatenation */ +#line 4963 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 4963 "" i__1[1] = 1, a__1[1] = "c"; +#line 4963 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4964 "" ++(*lnote); +#line 4965 "" } +#line 4966 "" accsym_(nacc, acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ +#line 4967 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 4967 "" i__1[1] = lacc, a__1[1] = acsymq; +#line 4967 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4968 "" *lnote += lacc; +#line 4969 "" noleva = *nolev; +#line 4970 "" if (*ivshft != 0) { +#line 4970 "" noleva = noleva + *ivshft - 32; +#line 4970 "" } +#line 4971 "" notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8); +#line 4972 "" if (lnoten == 1) { +#line 4972 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 4972 "" } /* Writing concatenation */ +#line 4973 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 4973 "" i__1[1] = lnoten, a__1[1] = noteq; +#line 4973 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4974 "" *lnote += lnoten; +#line 4975 "" if (*ihshft != 0) { /* Terminate horizontal shift */ /* Writing concatenation */ +#line 4979 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 4979 "" i__1[1] = 1, a__1[1] = "}"; +#line 4979 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4980 "" ++(*lnote); +#line 4981 "" } +#line 4982 "" return 0; } /* doacc_ */ @@ -7231,17 +12122,19 @@ L10: *ncm, integer *iv, real *tnow, char *soutq, integer *lsout, char *ulq, integer *ibmcnt, integer *islur, integer *nvmx, integer *nv, logical *beamon, integer *nolevm, integer *ihornb, integer *nornb, real * - stemlen, logical *dotxtup, integer *nacc, ftnlen soutq_len, ftnlen - ulq_len) + stemlen, logical *dotxtup, integer *nacc, integer *irest, ftnlen + soutq_len, ftnlen ulq_len) { /* System generated locals */ address a__1[2]; integer i__1, i__2, i__3[2], i__4, i__5, i__6; + real r__1; logical L__1; char ch__1[1]; /* Builtin functions */ - integer pow_ii(integer *, integer *), lbit_shift(integer, integer); + integer i_nint(real *), lbit_shift(integer, integer), pow_ii(integer *, + integer *); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), s_copy(char *, char *, ftnlen, ftnlen); integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char @@ -7250,11 +12143,11 @@ L10: /* Local variables */ extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); extern integer igetbits_(integer *, integer *, integer *); - static integer kv; + static integer icrdatsav, icrdotsav, kv; extern integer log2_(integer *); static integer icrd; extern /* Character */ VOID chax_(char *, ftnlen, integer *); - static integer lout, lsym; + static integer indm, lout, lsym; static char outq[79]; extern /* Subroutine */ int stop1_(void), doacc_(integer *, integer *, char *, integer *, integer *, integer *, integer *, logical *, @@ -7269,9 +12162,11 @@ L10: extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer *, ftnlen); static real updotc, rtdotc; - static integer nolevo, lnoten; + static integer nolevo; extern /* Subroutine */ int dotmov_(real *, real *, char *, integer *, - integer *, ftnlen), putarp_(real *, integer *, integer *, integer + integer *, ftnlen); + static integer lnoten; + extern /* Subroutine */ int putarp_(real *, integer *, integer *, integer *, integer *, char *, integer *, ftnlen); static char notexq[79], nosymq[7]; extern /* Subroutine */ int putorn_(integer *, integer *, integer *, @@ -7285,11 +12180,9 @@ L10: integer *); /* Fortran I/O blocks */ - static cilist io___349 = { 0, 6, 0, 0, 0 }; - static cilist io___350 = { 0, 6, 0, 0, 0 }; - + static cilist io___378 = { 0, 6, 0, 0, 0 }; + static cilist io___379 = { 0, 6, 0, 0, 0 }; -/* 130316 */ /* This subr. once produced notexq for entire chord. 10/18/97 altered to write */ @@ -7300,34 +12193,195 @@ L10: /* Set counter (for this note) for chord notes present. Set notmain=T. */ /* Will test for notmain=.true. in addmidi to tell whether to save pitch. */ +#line 5036 "" /* Parameter adjustments */ +#line 5036 "" + irest -= 25; +#line 5036 "" --nornb; +#line 5036 "" ihornb -= 25; +#line 5036 "" ulq -= 25; +#line 5036 "" +#line 5036 "" /* Function Body */ +#line 5036 "" commidi_1.nmidcrd = 0; +#line 5037 "" commidi_1.notmain = TRUE_; +#line 5038 "" commidi_1.crdacc = FALSE_; +#line 5039 "" i__1 = comtrill_1.icrd2; +#line 5039 "" for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) { +#line 5040 "" lnote = 0; +#line 5041 "" nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12); /* 3/8/03 save original pitch to use in midi, in case 2nds alter things. */ +#line 5045 "" nolevo = nolev; /* Check for special situations with 2nds (see precrd). */ - if (bit_test(*nacc,30)) { - if (nolev == *nolevm - 1) { - nolev = *nolevm; - } - } else if (bit_test(*nacc,31)) { - if (nolev == *nolevm + 1) { - nolev = *nolevm; +#line 5049 "" + if (bit_test(*nacc,30) && nolev == *nolevm - 1) { + +/* Upstem, 2nd with upper as main, interchange pitches, */ +/* rt-shift upper (now chord note). Lower (orig chord, now main) */ +/* if dotted, probably had shifted dot, dot parameters must be moved */ +/* from chord to main */ + +#line 5056 "" + nolev = *nolevm; +#line 5057 "" + if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { + +/* Orig. chord note dot shift, must transfer to main. */ + +#line 5061 "" + icrdotsav = comtrill_1.icrdot[icrd - 1]; +#line 5062 "" + icrdatsav = comtrill_1.icrdat[icrd - 1]; +#line 5063 "" + if (bit_test(irest[*ivx + *ip * 24],19)) { + +/* Main note (upper) had a dot shift, must move it to chord */ + +#line 5067 "" + setbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__26, & + c__1); +#line 5068 "" + r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) + * 24 - 25] * 10; +#line 5068 "" + i__2 = i_nint(&r__1) + 64; +#line 5068 "" + setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, & + i__2); +#line 5070 "" + r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) + * 24 - 25] * 10; +#line 5070 "" + i__2 = i_nint(&r__1) + 64; +#line 5070 "" + setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, & + i__2); + +/* May need to worry about other chord params (accid shefts etc) later */ + +#line 5075 "" + } else { +#line 5076 "" + comtrill_1.icrdat[icrd - 1] = bit_clear(comtrill_1.icrdat[ + icrd - 1],26); +#line 5077 "" + } + +/* We are adding a main note dot shift, so push any later ones back */ + +#line 5082 "" + if (! bit_test(irest[*ivx + *ip * 24],19)) { +#line 5083 "" + ++comcc_1.maxdotmv[*ivx - 1]; +#line 5084 "" + i__2 = comcc_1.ndotmv[*ivx - 1] + 2; +#line 5084 "" + for (indm = comcc_1.maxdotmv[*ivx - 1]; indm >= i__2; + --indm) { +#line 5085 "" + comcc_1.updot[*ivx + indm * 24 - 25] = comcc_1.updot[* + ivx + (indm - 1) * 24 - 25]; +#line 5086 "" + comcc_1.rtdot[*ivx + indm * 24 - 25] = comcc_1.rtdot[* + ivx + (indm - 1) * 24 - 25]; +#line 5087 "" +/* L1: */ +#line 5087 "" + } +#line 5088 "" + } +#line 5089 "" + irest[*ivx + *ip * 24] = bit_set(irest[*ivx + *ip * 24],19); +#line 5090 "" + comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] + = ((127 & icrdotsav) - 64) * .1f; +#line 5091 "" + comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25] + = ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) - 64) * + .1f; +#line 5093 "" + } +#line 5094 "" + } else if (bit_test(*nacc,31) && nolev == *nolevm + 1) { + +/* Downstem, 2nd with lower as main, interchange pitches, */ +/* left-shift lower (now chord note). Lower (orig main, now chord) */ +/* probably had shifted dot, dot parameters must be moved from */ +/* main to chord */ + +#line 5101 "" + nolev = *nolevm; +#line 5102 "" + if (bit_test(irest[*ivx + *ip * 24],19)) { +#line 5103 "" + icrdotsav = comtrill_1.icrdot[icrd - 1]; +#line 5104 "" + icrdatsav = comtrill_1.icrdat[icrd - 1]; +#line 5105 "" + comtrill_1.icrdat[icrd - 1] = bit_set(comtrill_1.icrdat[icrd + - 1],26); +/* bits in icrdot */ +/* 0-6 10*abs(vertical dot shift in \internote) + 64 */ +/* 7-13 10*abs(horizontal dot shift in \internote) + 64 */ +/* Assuming >0 for now! */ +#line 5110 "" + r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * + 24 - 25] * 10; +#line 5110 "" + i__2 = i_nint(&r__1) + 64; +#line 5110 "" + setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &i__2); +#line 5112 "" + r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * + 24 - 25] * 10; +#line 5112 "" + i__2 = i_nint(&r__1) + 64; +#line 5112 "" + setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, &i__2); + +/* Must also set dot shift for (now) main note (orig. chord note). */ + +#line 5117 "" + if (bit_test(icrdatsav,26)) { +#line 5118 "" + comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 + - 25] = ((127 & icrdotsav) - 64) * .1f; +#line 5119 "" + comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 + - 25] = ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) + - 64) * .1f; +#line 5121 "" + } else { + +/* No dot move on original chord (now main) note, */ + +#line 5125 "" + comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 + - 25] = 0.f; +#line 5126 "" + comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 + - 25] = 0.f; +#line 5127 "" + } +#line 5128 "" } +#line 5129 "" } /* Lower dot for lower-voice notes?. Conditions are: */ @@ -7337,180 +12391,282 @@ L10: /* 4. Not a rest (cannot be a rest in a chord!) */ /* . 5. Flag (lowdot) is set to true */ +#line 5138 "" if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) { +#line 5139 "" i__2 = log2_(nodu); +#line 5139 "" if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) { +#line 5140 "" if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { /* Note already in movdot list. Drop by 2. */ +#line 5144 "" i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, & c__0) - 20; +#line 5144 "" setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, & i__2); +#line 5146 "" } else { /* Not in list so just move it right now */ +#line 5150 "" i__2 = igetbits_(islur, &c__1, &c__3); - dotmov_(&c_b773, &c_b774, soutq, lsout, &i__2, (ftnlen)80) - ; +#line 5150 "" + dotmov_(&c_b1008, &c_b1009, soutq, lsout, &i__2, (ftnlen) + 80); +#line 5151 "" } +#line 5152 "" } +#line 5153 "" } +#line 5154 "" if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { -/* Move the dot. */ +/* Move the dot. Basic call for chord notes, not main note. */ +#line 5158 "" updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f; +#line 5159 "" rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen) -7)) - 64) * .1f; +#line 5160 "" i__2 = igetbits_(islur, &c__1, &c__3); +#line 5160 "" dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80); +#line 5161 "" } +#line 5162 "" isleft = bit_test(comtrill_1.icrdat[icrd - 1],23); +#line 5163 "" isright = bit_test(comtrill_1.icrdat[icrd - 1],24); /* Check for ornament in chord. */ +#line 5167 "" if (comtrill_1.icrdorn[icrd - 1] > 0) { +#line 5168 "" putorn_(&comtrill_1.icrdorn[icrd - 1], &nolev, nolevm, nodu, & nornb[1], ulq + 25, ibmcnt, ivx, ncm, islur, nvmx, nv, & ihornb[25], stemlen, outq, &lout, ip, &c__0, beamon, & c_true, (ftnlen)1, (ftnlen)79); - -/* subroutin putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx, */ -/* * ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,ip,islhgt, */ -/* * notcrd,beamon,iscrd) */ - +#line 5171 "" addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 5172 "" } /* Chord-note symbol. First check for breve */ +#line 5176 "" if (*nodu == 128) { /* Writing concatenation */ +#line 5177 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5177 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5177 "" i__3[1] = 6, a__1[1] = "zbreve"; +#line 5177 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5178 "" lsym = 7; +#line 5179 "" } else { /* Not a breve chord. Get first letters in chord-note symbol */ +#line 5183 "" if (isleft) { /* Writing concatenation */ +#line 5184 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5184 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5184 "" i__3[1] = 1, a__1[1] = "l"; +#line 5184 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5185 "" } else if (isright) { /* Writing concatenation */ +#line 5186 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5186 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5186 "" i__3[1] = 1, a__1[1] = "r"; +#line 5186 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5187 "" } else { /* Writing concatenation */ +#line 5188 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5188 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5188 "" i__3[1] = 1, a__1[1] = "z"; +#line 5188 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5189 "" } +#line 5190 "" if (*nodu >= 64) { /* Writing concatenation */ +#line 5191 "" i__3[0] = 2, a__1[0] = nosymq; +#line 5191 "" i__3[1] = 1, a__1[1] = "w"; +#line 5191 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5192 "" } else if (*nodu >= 32) { /* Writing concatenation */ +#line 5193 "" i__3[0] = 2, a__1[0] = nosymq; +#line 5193 "" i__3[1] = 1, a__1[1] = "h"; +#line 5193 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5194 "" } else { /* Writing concatenation */ +#line 5195 "" i__3[0] = 2, a__1[0] = nosymq; +#line 5195 "" i__3[1] = 1, a__1[1] = "q"; +#line 5195 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5196 "" } +#line 5197 "" i__2 = log2_(nodu); +#line 5197 "" if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) { +#line 5198 "" lsym = 3; +#line 5199 "" } else if (! bit_test(*islur,3) || *dotxtup) { /* Single dot */ /* Writing concatenation */ +#line 5203 "" i__3[0] = 3, a__1[0] = nosymq; +#line 5203 "" i__3[1] = 1, a__1[1] = "p"; +#line 5203 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5204 "" lsym = 4; +#line 5205 "" } else { /* Double dot */ /* Writing concatenation */ +#line 5209 "" i__3[0] = 3, a__1[0] = nosymq; +#line 5209 "" i__3[1] = 2, a__1[1] = "pp"; +#line 5209 "" s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 5210 "" lsym = 5; +#line 5211 "" } +#line 5212 "" } +#line 5213 "" if (bit_test(comtrill_1.icrdat[icrd - 1],19) && ! bit_test( comtrill_1.icrdat[icrd - 1],27)) { /* Accidental and not MIDI-only. Build up bits 0-3 of nacc */ +#line 5217 "" nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); /* Kluge for bigness. Only means 'As' has not been issued */ +#line 5221 "" if (spfacs_1.bacfac != 1e6f) { +#line 5221 "" nactmp += 8; +#line 5221 "" } +#line 5222 "" i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) - 107; +#line 5222 "" i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14); +#line 5222 "" i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12); +#line 5222 "" i__6 = ncmid_(iv, ip); +#line 5222 "" L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31); +#line 5222 "" doacc_(&i__2, &i__4, notexq, &lnote, &nactmp, &i__5, &i__6, &L__1, (ftnlen)79); /* * notexq,lnote,nactmp,nolev,ncmid(iv,ip)) */ /* Get original nolev, not altered to deal with 2nds */ /* * ncmid(iv,ip)) */ /* Writing concatenation */ +#line 5229 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5229 "" i__3[1] = 7, a__1[1] = nosymq; +#line 5229 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5230 "" commidi_1.crdacc = TRUE_; +#line 5231 "" } else { +#line 5232 "" s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7); +#line 5233 "" } +#line 5234 "" lnote += lsym; /* Get note name (again if accid, due to possible octave jump) */ +#line 5238 "" notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8); +#line 5239 "" if (lnoten == 1) { +#line 5239 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 5239 "" } /* Put in note name */ /* Writing concatenation */ +#line 5243 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5243 "" i__3[1] = 8, a__1[1] = noteq; +#line 5243 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5244 "" lnote += lnoten; +#line 5245 "" if (bit_test(comtrill_1.icrdat[icrd - 1],25)) { /* Arpeggio signal */ +#line 5249 "" putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80); +#line 5250 "" } +#line 5251 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 5252 "" if (commidi_1.ismidi) { /* Here is where we collect MIDI pitch info for the chord note. By checking */ @@ -7518,37 +12674,53 @@ L10: /* pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() */ /* for MAIN note, will put in note codes for all chord notes + main note. */ +#line 5259 "" kv = 1; +#line 5260 "" if (*ivx > *iv) { +#line 5260 "" kv = 2; +#line 5260 "" } +#line 5261 "" ++commidi_1.nmidcrd; +#line 5262 "" if (commidi_1.nmidcrd > 20) { - s_wsle(&io___349); +#line 5263 "" + s_wsle(&io___378); +#line 5263 "" e_wsle(); - s_wsle(&io___350); - do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr" +#line 5264 "" + s_wsle(&io___379); +#line 5264 "" + do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"\ "ocessor", (ftnlen)45); +#line 5264 "" e_wsle(); +#line 5265 "" stop1_(); +#line 5266 "" } /* Use original saved pitch level, unaltered by 2nds logic. */ -/* 130316 */ -/* call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), */ +#line 5270 "" i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1] - 1]; +#line 5270 "" i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); +#line 5270 "" addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, & - commidisig_1.midisig, &c_b819, &c_false, &c_false); -/* * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) */ -/* 130316 */ -/* * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., */ + commidisig_1.midisig, &c_b1054, &c_false, &c_false); +#line 5273 "" } +#line 5274 "" /* L5: */ +#line 5274 "" } +#line 5275 "" commidi_1.notmain = FALSE_; +#line 5276 "" return 0; } /* docrd_ */ @@ -7580,7 +12752,7 @@ L10: , integer *, ftnlen, ftnlen); static integer jtxtdyn1; extern integer igetbits_(integer *, integer *, integer *); - static integer lpretweak, id; + static integer lpretweak, id, idh; static real hoff; extern /* Character */ VOID chax_(char *, ftnlen, integer *); static integer idno, lbot, idyn, jdyn; @@ -7603,131 +12775,216 @@ L10: static integer numdyn; static logical upstem; static char notexq[79]; - static integer lnumpq, icntdyn, ivxtent; + static integer lnumpq, icntdyn; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + static integer ivxtent; static char dynstrq[4]; static integer jtxtdyn, ltxtdyn; /* Fortran I/O blocks */ - static icilist io___371 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___373 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___374 = { 0, numpq+1, 0, "(i3)", 3, 1 }; - static icilist io___381 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___382 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___383 = { 0, numpq+1, 0, "(i3)", 3, 1 }; - static cilist io___386 = { 0, 11, 0, "(a)", 0 }; + static icilist io___401 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___403 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___404 = { 0, numpq+1, 0, "(i3)", 3, 1 }; + static icilist io___411 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___412 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___413 = { 0, numpq+1, 0, "(i3)", 3, 1 }; + static cilist io___416 = { 0, 11, 0, "(a)", 0 }; /* Inputs are array *elements* except ihornb,nornb,ulq */ +#line 5304 "" /* Parameter adjustments */ +#line 5304 "" ulq -= 25; +#line 5304 "" --nornb; +#line 5304 "" ihornb -= 25; +#line 5304 "" +#line 5304 "" /* Function Body */ +#line 5305 "" numdyn = 0; /* Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values */ /* in idynn(1...4) */ +#line 5310 "" i__1 = comdyn_1.ndyn; +#line 5310 "" for (idyn = 1; idyn <= i__1; ++idyn) { -/* ivxtent = iand(idyndat(idyn),15) */ +#line 5311 "" ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(& comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4); +#line 5313 "" if (ivxtent == *ivx) { +#line 5314 "" iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4); +#line 5315 "" if (iptent == *ip) { +#line 5316 "" ++numdyn; +#line 5317 "" idynn[numdyn - 1] = idyn; +#line 5318 "" } else if (iptent > *ip) { /* I don't think there are any more possible for this ivx,ip, so exit loop */ +#line 5322 "" goto L2; +#line 5323 "" } -/* else if (ivxtent .gt. ivx) then */ -/* go to 2 */ +#line 5324 "" } +#line 5325 "" /* L1: */ +#line 5325 "" } +#line 5326 "" L2: /* At this point there is a list of idyn's in idynn(1...numdyn) */ /* Compute level, and stem-dir'n-based horizontal tweaks */ +#line 5331 "" hoffsd = 0.f; /* Set upstem to false as default */ +#line 5335 "" upstem = FALSE_; +#line 5336 "" if (bit_test(*irest,0)) { /* It's a rest. Assume it doesn't go below the staff */ +#line 5340 "" lbot = *ncm - 4; +#line 5341 "" } else if (! (*beamon)) { +#line 5342 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv); +#line 5342 "" if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) { +#line 5343 "" upstem = TRUE_; +#line 5344 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ +#line 5345 "" i__1 = *nolev - 1, i__2 = *ncm - 4; +#line 5345 "" lbot = min(i__1,i__2); +#line 5346 "" } else { /* Computing MIN */ +#line 5347 "" i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; +#line 5347 "" lbot = min(i__1,i__2); +#line 5348 "" } +#line 5349 "" } else { +#line 5350 "" hoffsd = -.5f; +#line 5351 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ +#line 5352 "" i__1 = *nolev - 7, i__2 = *ncm - 4; +#line 5352 "" lbot = min(i__1,i__2); +#line 5353 "" } else { /* Computing MIN */ +#line 5354 "" i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4; +#line 5354 "" lbot = min(i__1,i__2); +#line 5355 "" } +#line 5356 "" } +#line 5357 "" } else { +#line 5358 "" if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { +#line 5359 "" upstem = TRUE_; +#line 5360 "" if (! bit_test(*ipl,10)) { /* Computing MIN */ +#line 5361 "" i__1 = *nolev - 1, i__2 = *ncm - 4; +#line 5361 "" lbot = min(i__1,i__2); +#line 5362 "" } else { /* Computing MIN */ +#line 5363 "" i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; +#line 5363 "" lbot = min(i__1,i__2); +#line 5364 "" } +#line 5365 "" } else { +#line 5366 "" hoffsd = -.5f; - lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1; + +/* 171230 Desperation */ +/* lbot = ihornb(ivx,nornb(ivx))+1 */ +#line 5370 "" + if (nornb[*ivx] == 0) { +#line 5371 "" + lbot = 1; +#line 5372 "" + } else { +#line 5373 "" + lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1; +#line 5374 "" + } +#line 5375 "" if (lbot == 1) { /* Kluge for non-beamed, down xtup, for which ihorb was never set. */ /* Assumes stem is shortened. */ +#line 5380 "" lbot = *nolev - 5; +#line 5381 "" } +#line 5382 "" ++nornb[*ivx]; +#line 5383 "" } +#line 5384 "" } +#line 5385 "" lbot += -5; +#line 5386 "" jtxtdyn1 = 1; /* Now ready to loop over current dyn's */ +#line 5390 "" i__1 = numdyn; +#line 5390 "" for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) { +#line 5391 "" idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1]; +#line 5392 "" idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1]; +#line 5393 "" idno = igetbits_(&idynd, &c__4, &c__12); /* ivx = iand(15,idynd) */ +#line 5395 "" *ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4); /* Build the command into notex in stages. Insert name & rq'd args in order: */ @@ -7743,174 +13000,366 @@ L2: /* d-mark */ /* X */ +#line 5410 "" if (idno == 0) { /* Text-dynamic */ /* Writing concatenation */ +#line 5414 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5414 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5414 "" i__3[1] = 6, a__1[1] = "txtdyn"; +#line 5414 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5415 "" lnote = 7; +#line 5416 "" } else if (idno <= 12) { /* Letter-group */ /* Writing concatenation */ +#line 5420 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5420 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5420 "" i__3[1] = 6, a__1[1] = "pmxdyn"; +#line 5420 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5421 "" lnote = 7; +#line 5422 "" } else if (comslur_1.fontslur) { +#line 5423 "" lnote = 7; +#line 5424 "" if (idno == 13) { -/* Start a hairpin */ +/* Start a font-based hairpin */ /* Writing concatenation */ +#line 5428 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5428 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5428 "" i__3[1] = 6, a__1[1] = "hpstrt"; +#line 5428 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5429 "" } else if (idno == 14) { /* End crescendo */ /* Writing concatenation */ +#line 5433 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5433 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5433 "" i__3[1] = 6, a__1[1] = "hpcend"; +#line 5433 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5434 "" } else { /* End decrescendo */ /* Writing concatenation */ +#line 5438 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5438 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5438 "" i__3[1] = 6, a__1[1] = "hpdend"; +#line 5438 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5439 "" } + +/* Put in voice number as ID for font-based hairpin */ + +#line 5443 "" + if (*ivx <= 9) { +/* Writing concatenation */ +#line 5444 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 5444 "" + *(unsigned char *)&ch__1[0] = *ivx + 48; +#line 5444 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 5444 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5445 "" + ++lnote; +#line 5446 "" + } else if (*ivx <= 19) { +/* Writing concatenation */ +#line 5447 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 5447 "" + i__4[1] = 2, a__2[1] = "{1"; +#line 5447 "" + *(unsigned char *)&ch__1[0] = *ivx + 38; +#line 5447 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 5447 "" + i__4[3] = 1, a__2[3] = "}"; +#line 5447 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5448 "" + lnote += 4; +#line 5449 "" + } else { +/* Writing concatenation */ +#line 5450 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 5450 "" + i__4[1] = 2, a__2[1] = "{2"; +#line 5450 "" + *(unsigned char *)&ch__1[0] = *ivx + 28; +#line 5450 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 5450 "" + i__4[3] = 1, a__2[3] = "}"; +#line 5450 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5451 "" + lnote += 4; +#line 5452 "" + } +#line 5453 "" } else { /* Postscript hairpins */ +#line 5457 "" lnote = 7; +#line 5458 "" if (idno == 13) { /* Writing concatenation */ +#line 5459 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5459 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5459 "" i__3[1] = 6, a__1[1] = "Icresc"; +#line 5459 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5460 "" } else if (idno == 14) { /* Writing concatenation */ +#line 5461 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5461 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5461 "" i__3[1] = 8, a__1[1] = "Idecresc"; +#line 5461 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5462 "" lnote = 9; +#line 5463 "" } else { /* Writing concatenation */ +#line 5464 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5464 "" i__3[0] = 1, a__1[0] = ch__1; +#line 5464 "" i__3[1] = 6, a__1[1] = "Tcresc"; +#line 5464 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5465 "" } - } - if (idno >= 13) { +#line 5466 "" + if (idno <= 14) { -/* Put in voice number */ +/* Get and record ID no for start of ps hairpin */ +/* Find first unused ID */ - if (*ivx <= 9) { +#line 5471 "" + for (idh = 1; idh <= 24; ++idh) { +#line 5472 "" + if (! bit_test(comhair_1.ihairuse,idh)) { +#line 5472 "" + goto L9; +#line 5472 "" + } +#line 5473 "" +/* L8: */ +#line 5473 "" + } +#line 5474 "" + printl_("Bad place in putdyn, call Dr. Don", (ftnlen)33); +#line 5475 "" + stop1_(); +#line 5476 "" +L9: +#line 5477 "" + comhair_1.ihairuse = bit_set(comhair_1.ihairuse,idh); +#line 5478 "" + comhair_1.idhair[*ivx - 1] = idh; +#line 5479 "" + } else { + +/* Unrecord ID no for end of ps hairpin */ + +#line 5483 "" + setbits_(&comhair_1.ihairuse, &c__1, &comhair_1.idhair[*ivx - + 1], &c__0); +#line 5484 "" + } + +/* Write ID # for start or end of ps hairpin */ + +#line 5488 "" + idh = comhair_1.idhair[*ivx - 1]; +#line 5489 "" + if (idh <= 9) { /* Writing concatenation */ +#line 5490 "" i__3[0] = lnote, a__1[0] = notexq; - *(unsigned char *)&ch__1[0] = *ivx + 48; +#line 5490 "" + *(unsigned char *)&ch__1[0] = idh + 48; +#line 5490 "" i__3[1] = 1, a__1[1] = ch__1; +#line 5490 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5491 "" ++lnote; - } else if (*ivx <= 19) { +#line 5492 "" + } else if (idh <= 19) { /* Writing concatenation */ +#line 5493 "" i__4[0] = lnote, a__2[0] = notexq; +#line 5493 "" i__4[1] = 2, a__2[1] = "{1"; - *(unsigned char *)&ch__1[0] = *ivx + 38; +#line 5493 "" + *(unsigned char *)&ch__1[0] = idh + 38; +#line 5493 "" i__4[2] = 1, a__2[2] = ch__1; +#line 5493 "" i__4[3] = 1, a__2[3] = "}"; +#line 5493 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5494 "" lnote += 4; +#line 5495 "" } else { /* Writing concatenation */ +#line 5496 "" i__4[0] = lnote, a__2[0] = notexq; +#line 5496 "" i__4[1] = 2, a__2[1] = "{2"; - *(unsigned char *)&ch__1[0] = *ivx + 28; +#line 5496 "" + *(unsigned char *)&ch__1[0] = idh + 28; +#line 5496 "" i__4[2] = 1, a__2[2] = ch__1; +#line 5496 "" i__4[3] = 1, a__2[3] = "}"; +#line 5496 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5497 "" lnote += 4; +#line 5498 "" } +#line 5499 "" } /* Begin setting level */ +#line 5503 "" lbot1 = lbot; +#line 5504 "" if (idno > 0 && idno <= 5) { /* All letters are short so raise a bit. */ +#line 5508 "" ++lbot1; +#line 5509 "" } else if (idno >= 13) { +#line 5510 "" lbot1 += 2; +#line 5511 "" } /* Convert so reference is bottom line */ +#line 5515 "" lbot1 = lbot1 - *ncm + 4; +#line 5516 "" if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno == 13 || idno == 14)) { /* Hairpin start. Save level and user-tweak before applying user tweak. */ +#line 5521 "" comdyn_1.levdsav[*ivx - 1] = lbot1; +#line 5522 "" comdyn_1.levhssav[*ivx - 1] = 0; +#line 5523 "" if (bit_test(idynd,16)) { +#line 5523 "" comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17) - 64; +#line 5523 "" } +#line 5524 "" } else if (comslur_1.fontslur && idno >= 14 || idno == 15) { /* Hairpin end; Compare level with saved start level before user-tweaks */ /* Computing MIN */ +#line 5528 "" i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1]; +#line 5528 "" lbot1 = min(i__2,i__5); /* Save pre-tweak level */ +#line 5532 "" lpretweak = lbot1; +#line 5533 "" } /* Check for user-defined vertical tweak */ +#line 5537 "" if (bit_test(idynd,16)) { +#line 5537 "" lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17); +#line 5537 "" } /* Now horizontal stuff */ +#line 5541 "" hoff = hoffsd; /* Some special horizontal tweaks */ +#line 5545 "" if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) { +#line 5545 "" hoff += .4f; +#line 5545 "" } /* User-defined tweaks */ +#line 5550 "" if (bit_test(idynd2,0)) { +#line 5550 "" hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f; +#line 5550 "" } +#line 5552 "" if (numdyn > 1) { /* Horizontal-interaction-based tweaks. */ @@ -7922,19 +13371,23 @@ L2: /* 2 hrpnend hrpnstrt - hoh2h1(1...2) */ /* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */ +#line 5563 "" if (idno > 0 && idno <= 12) { /* Word-group, may need vertical tweak to line up. */ +#line 5567 "" lbot1 += comdyn_1.ivowg[idno - 1]; /* Protecting against hp start-stop on same note */ +#line 5571 "" } else if ((comslur_1.fontslur && idno >= 14 || idno == 15) && icntdyn < numdyn) { /* Hairpin ending, check next type */ +#line 5576 "" if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ icntdyn] - 1], &c__4, &c__12) == 13 || ! comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[ @@ -7944,22 +13397,28 @@ L2: /* Hairpin end then hairpin start, no words, (remember dealing with end now) */ +#line 5586 "" hoff += comdyn_1.hoh2h1[0]; +#line 5587 "" } else { /* Hairpin end then word-group, need idno for w-g to set hp offset */ +#line 5591 "" hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[ icntdyn] - 1], &c__4, &c__12) - 1]; +#line 5593 "" } /* Protecting against hp start-stop on same note */ +#line 5597 "" } else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno < 14 || ! comslur_1.fontslur && idno < 15)) { /* Hairpin start, check prior type */ +#line 5603 "" if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ icntdyn - 2] - 1], &c__4, &c__12) >= 14 || ! comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[ @@ -7967,21 +13426,30 @@ L2: /* Hairpin end then hairpin start, (remember dealing with start now) */ +#line 5612 "" hoff += comdyn_1.hoh2h1[1]; +#line 5613 "" } else { /* Hairpin start after word-group, need idno for w-g to set hp offset */ +#line 5617 "" hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[ icntdyn - 2] - 1], &c__4, &c__12) - 1]; +#line 5619 "" } +#line 5620 "" } +#line 5621 "" } /* End of if-block for 2- or 3-way interactions. */ +#line 5625 "" if (! comslur_1.fontslur && idno >= 13) { +#line 5625 "" hoff = (hoff + .5f) * 6.f / 2.5f; +#line 5625 "" } /* Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */ @@ -7989,128 +13457,217 @@ L2: /* Position corrections all done now. Put in the level. */ +#line 5633 "" if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno == 13 || idno == 14)) { /* Hairpin start. */ +#line 5638 "" if (! comslur_1.fontslur) { /* Postscript hairpin start...inset placeholder for start level. */ /* Writing concatenation */ +#line 5642 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5642 "" i__3[1] = 5, a__1[1] = "{ }"; +#line 5642 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5643 "" lnote += 5; +#line 5644 "" } +#line 5645 "" } else { /* Insert actual level in all cases except hairpin start */ /* Create string with level in it */ +#line 5650 "" if (lbot1 > 9) { +#line 5651 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___371); +#line 5652 "" + s_wsfi(&io___401); +#line 5652 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5652 "" e_wsfi(); /* Writing concatenation */ +#line 5653 "" i__3[0] = 3, a__1[0] = numpq; +#line 5653 "" i__3[1] = 1, a__1[1] = "}"; +#line 5653 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5654 "" lnumpq = 4; +#line 5655 "" } else if (lbot1 > -1) { +#line 5656 "" *(unsigned char *)&ch__1[0] = lbot1 + 48; +#line 5656 "" s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); +#line 5657 "" lnumpq = 1; +#line 5658 "" } else if (lbot1 > -10) { +#line 5659 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___373); +#line 5660 "" + s_wsfi(&io___403); +#line 5660 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5660 "" e_wsfi(); /* Writing concatenation */ +#line 5661 "" i__3[0] = 3, a__1[0] = numpq; +#line 5661 "" i__3[1] = 1, a__1[1] = "}"; +#line 5661 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5662 "" lnumpq = 4; +#line 5663 "" } else { +#line 5664 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___374); +#line 5665 "" + s_wsfi(&io___404); +#line 5665 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5665 "" e_wsfi(); /* Writing concatenation */ +#line 5666 "" i__3[0] = 4, a__1[0] = numpq; +#line 5666 "" i__3[1] = 1, a__1[1] = "}"; +#line 5666 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5667 "" lnumpq = 5; +#line 5668 "" } /* Level has now been computed and stored in numpq */ /* Append the level */ /* Writing concatenation */ +#line 5673 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5673 "" i__3[1] = lnumpq, a__1[1] = numpq; +#line 5673 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5674 "" lnote += lnumpq; +#line 5675 "" } +#line 5676 "" if (dabs(hoff) < .001f) { /* No horiz offset */ /* Writing concatenation */ +#line 5680 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5680 "" i__3[1] = 1, a__1[1] = "0"; +#line 5680 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5681 "" ++lnote; +#line 5682 "" } else { /* Horizontal tweak */ +#line 5686 "" lform = lfmt1_(&hoff); /* Writing concatenation */ +#line 5687 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5687 "" i__3[1] = 1, a__1[1] = "{"; +#line 5687 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5688 "" ++lnote; +#line 5689 "" i__2 = lnote; +#line 5689 "" ici__1.icierr = 0; +#line 5689 "" ici__1.icirnum = 1; +#line 5689 "" ici__1.icirlen = lnote + lform - i__2; +#line 5689 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 5689 "" i__6[0] = 2, a__3[0] = "(f"; +#line 5689 "" i__5 = lform + 48; +#line 5689 "" chax_(ch__1, (ftnlen)1, &i__5); +#line 5689 "" i__6[1] = 1, a__3[1] = ch__1; +#line 5689 "" i__6[2] = 3, a__3[2] = ".1)"; +#line 5689 "" ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6), ch__2); +#line 5689 "" s_wsfi(&ici__1); +#line 5689 "" do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real)); +#line 5689 "" e_wsfi(); +#line 5691 "" lnote += lform; /* Writing concatenation */ +#line 5692 "" i__3[0] = lnote, a__1[0] = notexq; +#line 5692 "" i__3[1] = 1, a__1[1] = "}"; +#line 5692 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 5693 "" ++lnote; +#line 5694 "" } +#line 5695 "" if (idno == 0) { /* text-dynamic. Find the string and append it */ +#line 5699 "" i__2 = comdyn_1.ntxtdyn; +#line 5699 "" for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) { /* ivxip = ivx+16*ip */ +#line 5701 "" ivxip = *ivx + (*ip << 5); +#line 5702 "" if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) { +#line 5702 "" goto L5; +#line 5702 "" } +#line 5703 "" /* L4: */ +#line 5703 "" } +#line 5704 "" printl_("Abnormal stop in putdyn", (ftnlen)23); +#line 5705 "" stop1_(); +#line 5706 "" L5: +#line 5707 "" ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128, (ftnlen)128); @@ -8136,149 +13693,264 @@ L5: /* Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) */ +#line 5731 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); +#line 5732 "" if (commus_1.musize == 20) { +#line 5733 "" s_copy(notexq, "{\\medtype\\it ", (ftnlen)79, (ftnlen)13); +#line 5734 "" lnote = 13; +#line 5735 "" } else if (commus_1.musize == 16) { +#line 5736 "" s_copy(notexq, "{\\normtype\\it ", (ftnlen)79, (ftnlen)14); +#line 5737 "" lnote = 14; +#line 5738 "" } else if (commus_1.musize == 24) { +#line 5739 "" s_copy(notexq, "{\\bigtype\\it ", (ftnlen)79, (ftnlen)13); +#line 5740 "" lnote = 13; +#line 5741 "" } else if (commus_1.musize == 29) { +#line 5742 "" s_copy(notexq, "{\\Bigtype\\it ", (ftnlen)79, (ftnlen)13); +#line 5743 "" lnote = 13; +#line 5744 "" } /* Writing concatenation */ +#line 5746 "" i__6[0] = lnote, a__3[0] = notexq; +#line 5746 "" i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7) ; +#line 5746 "" i__6[2] = 1, a__3[2] = "}"; +#line 5746 "" s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); +#line 5747 "" lnote = lnote + ltxtdyn + 1; /* Reset jtxtdyn1 just in case >1 txtdyn on same note. */ +#line 5751 "" jtxtdyn1 = jtxtdyn + 1; +#line 5752 "" } else if (idno <= 12) { /* Letter-group dynamic. Append the letter-group command */ +#line 5756 "" id = idno << 2; +#line 5757 "" i__2 = id - 4; +#line 5757 "" s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2); +#line 5758 "" id = lenstr_(dynstrq, &c__4, (ftnlen)4); /* Writing concatenation */ +#line 5759 "" i__6[0] = lnote, a__3[0] = notexq; +#line 5759 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5759 "" i__6[1] = 1, a__3[1] = ch__1; +#line 5759 "" i__6[2] = id, a__3[2] = dynstrq; +#line 5759 "" s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); +#line 5760 "" lnote = lnote + 1 + id; +#line 5761 "" } +#line 5762 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); +#line 5763 "" if (! comslur_1.fontslur && idno == 15) { /* PS slurs on, hairpin is ending. Go back and set height at beginning. */ /* Add user-defined tweak to default level */ +#line 5768 "" lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1]; +#line 5769 "" if (lbot1 > 9) { +#line 5770 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___381); +#line 5771 "" + s_wsfi(&io___411); +#line 5771 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5771 "" e_wsfi(); /* Writing concatenation */ +#line 5772 "" i__3[0] = 3, a__1[0] = numpq; +#line 5772 "" i__3[1] = 1, a__1[1] = "}"; +#line 5772 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5773 "" lnumpq = 4; +#line 5774 "" } else if (lbot1 > -1) { +#line 5775 "" *(unsigned char *)&ch__1[0] = lbot1 + 48; +#line 5775 "" s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); +#line 5776 "" lnumpq = 1; +#line 5777 "" } else if (lbot1 > -10) { +#line 5778 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___382); +#line 5779 "" + s_wsfi(&io___412); +#line 5779 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5779 "" e_wsfi(); /* Writing concatenation */ +#line 5780 "" i__3[0] = 3, a__1[0] = numpq; +#line 5780 "" i__3[1] = 1, a__1[1] = "}"; +#line 5780 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5781 "" lnumpq = 4; +#line 5782 "" } else { +#line 5783 "" s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); - s_wsfi(&io___383); +#line 5784 "" + s_wsfi(&io___413); +#line 5784 "" do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5784 "" e_wsfi(); /* Writing concatenation */ +#line 5785 "" i__3[0] = 4, a__1[0] = numpq; +#line 5785 "" i__3[1] = 1, a__1[1] = "}"; +#line 5785 "" s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5786 "" lnumpq = 5; +#line 5787 "" } /* Construct string to search backwards for placeholder */ - if (*ivx <= 9) { +#line 5791 "" + if (idh <= 9) { /* Writing concatenation */ +#line 5792 "" i__6[0] = 5, a__3[0] = "cresc"; - *(unsigned char *)&ch__1[0] = *ivx + 48; +#line 5792 "" + *(unsigned char *)&ch__1[0] = idh + 48; +#line 5792 "" i__6[1] = 1, a__3[1] = ch__1; +#line 5792 "" i__6[2] = 5, a__3[2] = "{ }"; +#line 5792 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5793 "" ltemp = 11; - } else if (*ivx <= 19) { +#line 5794 "" + } else if (idh <= 19) { /* Writing concatenation */ +#line 5795 "" i__6[0] = 7, a__3[0] = "cresc{1"; - *(unsigned char *)&ch__1[0] = *ivx + 38; +#line 5795 "" + *(unsigned char *)&ch__1[0] = idh + 38; +#line 5795 "" i__6[1] = 1, a__3[1] = ch__1; +#line 5795 "" i__6[2] = 6, a__3[2] = "}{ }"; +#line 5795 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5796 "" ltemp = 14; +#line 5797 "" } else { /* Writing concatenation */ +#line 5798 "" i__6[0] = 7, a__3[0] = "cresc{2"; - *(unsigned char *)&ch__1[0] = *ivx + 28; +#line 5798 "" + *(unsigned char *)&ch__1[0] = idh + 28; +#line 5798 "" i__6[1] = 1, a__3[1] = ch__1; +#line 5798 "" i__6[2] = 6, a__3[2] = "}{ }"; +#line 5798 "" s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5799 "" ltemp = 14; +#line 5800 "" } - s_wsfe(&io___386); +#line 5801 "" + s_wsfe(&io___416); /* Writing concatenation */ +#line 5801 "" i__3[0] = *lsout, a__1[0] = soutq; +#line 5801 "" i__3[1] = 1, a__1[1] = "%"; +#line 5801 "" s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81); +#line 5801 "" do_fio(&c__1, ch__3, *lsout + 1); +#line 5801 "" e_wsfe(); +#line 5802 "" *lsout = 0; /* Writing concatenation */ +#line 5803 "" i__3[0] = ltemp - 5, a__1[0] = tempq; +#line 5803 "" i__3[1] = lnumpq, a__1[1] = numpq; +#line 5803 "" s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53); +#line 5803 "" i__2 = ltemp - 5 + lnumpq; +#line 5803 "" backfill_(&c__11, tempq, <emp, ch__4, &i__2, (ftnlen)48, ltemp - 5 + lnumpq); +#line 5805 "" } +#line 5806 "" /* L3: */ +#line 5806 "" } /* Shrink arrays, decrease ndyn 111109 */ +#line 5810 "" for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) { +#line 5811 "" i__1 = comdyn_1.ndyn - 1; +#line 5811 "" for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) { +#line 5812 "" comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn]; +#line 5813 "" comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn]; +#line 5814 "" /* L7: */ +#line 5814 "" } +#line 5815 "" --comdyn_1.ndyn; +#line 5816 "" /* L6: */ +#line 5816 "" } +#line 5817 "" return 0; } /* dodyn_ */ @@ -8345,15 +14017,15 @@ L5: static real wheadpt1; /* Fortran I/O blocks */ - static cilist io___392 = { 0, 6, 0, 0, 0 }; - static cilist io___396 = { 0, 6, 0, 0, 0 }; - static cilist io___397 = { 0, 6, 0, 0, 0 }; - static cilist io___398 = { 0, 15, 0, "(/,a)", 0 }; - static icilist io___401 = { 0, notexq, 0, "(i2)", 2, 1 }; - static cilist io___402 = { 0, 6, 0, 0, 0 }; - static icilist io___426 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 }; - static icilist io___428 = { 0, notexq+13, 0, "(f4.1)", 4, 1 }; - static icilist io___430 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; + static cilist io___422 = { 0, 6, 0, 0, 0 }; + static cilist io___426 = { 0, 6, 0, 0, 0 }; + static cilist io___427 = { 0, 6, 0, 0, 0 }; + static cilist io___428 = { 0, 15, 0, "(/,a)", 0 }; + static icilist io___431 = { 0, notexq, 0, "(i2)", 2, 1 }; + static cilist io___432 = { 0, 6, 0, 0, 0 }; + static icilist io___456 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 }; + static icilist io___458 = { 0, notexq+13, 0, "(f4.1)", 4, 1 }; + static icilist io___460 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; @@ -8361,836 +14033,1426 @@ L5: /* It is only used to find ig. */ /* ig is returned to makeabar in case there's a slur that needs to be ended */ +#line 5856 "" /* Parameter adjustments */ +#line 5856 "" ulq -= 25; +#line 5856 "" --ptgr; +#line 5856 "" +#line 5856 "" /* Function Body */ +#line 5856 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 5856 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 5857 "" isgaft = bit_test(*ipl,29); +#line 5858 "" iswaft = bit_test(*ipl,31); +#line 5859 "" normsp = ! isgaft; /* Find ig. */ +#line 5863 "" i__1 = comgrace_1.ngrace; +#line 5863 "" for (*ig = 1; *ig <= i__1; ++(*ig)) { +#line 5864 "" if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx) { +#line 5864 "" goto L121; +#line 5864 "" } +#line 5865 "" /* L120: */ +#line 5865 "" } - s_wsle(&io___392); +#line 5866 "" + s_wsle(&io___422); +#line 5866 "" do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38) ; +#line 5866 "" e_wsle(); +#line 5867 "" s_stop("", (ftnlen)0); +#line 5868 "" L121: +#line 5869 "" ngs = comgrace_1.ngstrt[*ig - 1]; +#line 5870 "" mg = comgrace_1.multg[*ig - 1]; /* wheadpt1 = wheadpt*fullsize(ivx) */ +#line 5872 "" wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1]; /* For way-after-graces at end of bar, must set the octave. */ +#line 5876 "" if (*farend) { +#line 5877 "" comoct_1.noctup = 0; +#line 5878 "" if (*ncm == 23) { +#line 5878 "" comoct_1.noctup = -2; +#line 5878 "" } +#line 5879 "" } +#line 5880 "" if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) { +#line 5881 "" if (comslur_1.listslur == 16777215) { - s_wsle(&io___396); +#line 5882 "" + s_wsle(&io___426); +#line 5882 "" e_wsle(); - s_wsle(&io___397); - do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too " +#line 5883 "" + s_wsle(&io___427); +#line 5883 "" + do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "\ "many!", (ftnlen)47); +#line 5883 "" e_wsle(); - s_wsfe(&io___398); +#line 5884 "" + s_wsfe(&io___428); +#line 5884 "" do_fio(&c__1, "You defined the twentyfifth slur, one too many!", ( ftnlen)47); +#line 5884 "" e_wsfe(); +#line 5886 "" stop1_(); +#line 5887 "" } /* Slur on fore-grace. Get index of next slur not in use, from 23 down. */ +#line 5891 "" i__1 = 16777215 - comslur_1.listslur; +#line 5891 "" comslur_1.ndxslur = log2_(&i__1); +#line 5893 "" } +#line 5894 "" if (comgrace_1.nng[*ig - 1] == 1) { /* Single grace. */ +#line 5898 "" if (normsp) { /* Anything but GA */ /* Writing concatenation */ +#line 5902 "" i__2[0] = 1, a__1[0] = sq; +#line 5902 "" i__2[1] = 5, a__1[1] = "shlft"; +#line 5902 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 5902 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80); +#line 5903 "" niptgr = i_nint(&ptgr[*ig]); /* Empirical tweak for postscript. */ /* if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */ /* ++ */ +#line 5909 "" if (niptgr < 10) { /* Writing concatenation */ +#line 5910 "" i__1 = niptgr + 48; +#line 5910 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 5910 "" i__2[0] = 1, a__1[0] = ch__1; +#line 5910 "" i__2[1] = 1, a__1[1] = "{"; +#line 5910 "" s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2); +#line 5910 "" addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); +#line 5911 "" } else if (niptgr < 100) { - s_wsfi(&io___401); +#line 5912 "" + s_wsfi(&io___431); +#line 5912 "" do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer)); +#line 5912 "" e_wsfi(); /* Writing concatenation */ +#line 5913 "" i__3[0] = 1, a__2[0] = "{"; +#line 5913 "" i__3[1] = 2, a__2[1] = notexq; +#line 5913 "" i__3[2] = 2, a__2[2] = "}{"; +#line 5913 "" s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5); +#line 5913 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); +#line 5914 "" } else { - s_wsle(&io___402); - do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace " +#line 5915 "" + s_wsle(&io___432); +#line 5915 "" + do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "\ "note group > 99 pt", (ftnlen)56); +#line 5915 "" e_wsle(); +#line 5917 "" s_stop("", (ftnlen)0); +#line 5918 "" } +#line 5919 "" } else { /* Writing concatenation */ +#line 5920 "" i__2[0] = 1, a__1[0] = sq; +#line 5920 "" i__2[1] = 10, a__1[1] = "gaft{1.5}{"; +#line 5920 "" s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); +#line 5920 "" addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); /* GA. Compute aftshft, for later use. */ +#line 5924 "" comgrace_1.aftshft = spfacs_1.grafac; +#line 5925 "" if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { +#line 5925 "" comgrace_1.aftshft += spfacs_1.agc1fac; +#line 5925 "" } +#line 5926 "" comgrace_1.aftshft *= comask_1.wheadpt; +#line 5927 "" } +#line 5928 "" if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { /* Start slur on pre-grace. No accounting needed since will be ended very soon. */ +#line 5932 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); +#line 5933 "" if (comslur_1.fontslur) { +#line 5934 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 5935 "" i__2[0] = 1, a__1[0] = sq; +#line 5935 "" i__2[1] = 6, a__1[1] = "islurd"; +#line 5935 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5935 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; +#line 5936 "" } else { /* Writing concatenation */ +#line 5937 "" i__2[0] = 1, a__1[0] = sq; +#line 5937 "" i__2[1] = 6, a__1[1] = "isluru"; +#line 5937 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5937 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; +#line 5938 "" } +#line 5939 "" } else { /* Start Postscript slur. */ +#line 5943 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 5944 "" i__2[0] = 1, a__1[0] = sq; +#line 5944 "" i__2[1] = 3, a__1[1] = "isd"; +#line 5944 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5944 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; +#line 5945 "" } else { /* Writing concatenation */ +#line 5946 "" i__2[0] = 1, a__1[0] = sq; +#line 5946 "" i__2[1] = 3, a__1[1] = "isu"; +#line 5946 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5946 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; +#line 5947 "" } +#line 5948 "" } /* Print slur number, 23-ndxslur */ +#line 5952 "" lnote = 0; +#line 5953 "" if (23 - comslur_1.ndxslur < 10) { /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ +#line 5955 "" i__1 = 71 - comslur_1.ndxslur; +#line 5955 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 5955 "" s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); +#line 5956 "" lnote = 1; +#line 5957 "" } else if (23 - comslur_1.ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ +#line 5959 "" i__3[0] = 2, a__2[0] = "{1"; +#line 5959 "" i__1 = 61 - comslur_1.ndxslur; +#line 5959 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 5959 "" i__3[1] = 1, a__2[1] = ch__1; +#line 5959 "" i__3[2] = 1, a__2[2] = "}"; +#line 5959 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 5960 "" lnote = 4; +#line 5961 "" } else { /* Writing concatenation */ +#line 5962 "" i__4[0] = lnote, a__3[0] = notexq; +#line 5962 "" i__4[1] = 2, a__3[1] = "{2"; +#line 5962 "" i__1 = 51 - comslur_1.ndxslur; +#line 5962 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 5962 "" i__4[2] = 1, a__3[2] = ch__1; +#line 5962 "" i__4[3] = 1, a__3[3] = "}"; +#line 5962 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 5963 "" lnote = 4; +#line 5964 "" } -/* if (11-ndxslur .lt. 10) then */ -/* call addstr(chax(59-ndxslur)//noteq(1:lnoten),1+lnoten, */ -/* * soutq,lsout) */ -/* else */ -/* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */ -/* * 4+lnoten,soutq,lsout) */ -/* end if */ /* Writing concatenation */ +#line 5965 "" i__2[0] = lnote, a__1[0] = notexq; +#line 5965 "" i__2[1] = lnoten, a__1[1] = noteq; +#line 5965 "" s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); +#line 5965 "" i__1 = lnote + lnoten; +#line 5965 "" addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80); +#line 5967 "" if (! comslur_1.fontslur) { /* Horizontal tweaks for postscript slur on single grace */ +#line 5971 "" stemup = TRUE_; +#line 5972 "" if (comgrace_1.upg[*ig - 1]) { /* Check for up-grace + down stem. Get stem direction */ +#line 5976 "" if (! (*beamon)) { /* Separate note. Get stem direction. */ +#line 5980 "" udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx, ivx, nv); +#line 5980 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 5982 "" } else { /* In a beam */ +#line 5986 "" stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u'; +#line 5987 "" } /* Stop the shift if whole note */ +#line 5991 "" stemup = stemup || *tnote > 63.f; +#line 5992 "" } +#line 5993 "" if (stemup) { +#line 5994 "" addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) 80); +#line 5995 "" } else { +#line 5996 "" addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) 80); +#line 5997 "" } +#line 5998 "" } +#line 5999 "" } +#line 6000 "" if (comgrace_1.naccg[ngs - 1] > 0) { +#line 6001 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Save for checking octave shifts in GA */ +#line 6005 "" if (isgaft) { +#line 6006 "" lnotenga = lnoten; +#line 6007 "" s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); +#line 6008 "" } +#line 6010 "" if (lnoten == 1) { +#line 6010 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 6010 "" } +#line 6011 "" accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ +#line 6012 "" i__4[0] = 1, a__3[0] = sq; +#line 6012 "" i__4[1] = 3, a__3[1] = "big"; +#line 6012 "" i__4[2] = lacc, a__3[2] = acsymq; +#line 6012 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6012 "" s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); +#line 6012 "" i__1 = lacc + 4 + lnoten; +#line 6012 "" addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80) ; +#line 6014 "" } +#line 6015 "" if (comgrace_1.slashg[*ig - 1]) { /* Writing concatenation */ +#line 6016 "" i__2[0] = 1, a__1[0] = sq; +#line 6016 "" i__2[1] = 3, a__1[1] = "grc"; +#line 6016 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6017 "" lnote = 4; +#line 6018 "" } else if (mg == 0) { /* Writing concatenation */ +#line 6019 "" i__2[0] = 1, a__1[0] = sq; +#line 6019 "" i__2[1] = 2, a__1[1] = "zq"; +#line 6019 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6020 "" lnote = 3; +#line 6021 "" } else { /* Writing concatenation */ +#line 6022 "" i__2[0] = 1, a__1[0] = sq; +#line 6022 "" i__2[1] = 2, a__1[1] = "zc"; +#line 6022 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6023 "" i__1 = mg; +#line 6023 "" for (i__ = 2; i__ <= i__1; ++i__) { /* Writing concatenation */ +#line 6024 "" i__2[0] = i__ + 1, a__1[0] = notexq; +#line 6024 "" i__2[1] = 1, a__1[1] = "c"; +#line 6024 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6025 "" /* L61: */ +#line 6025 "" } +#line 6026 "" lnote = mg + 2; +#line 6027 "" } +#line 6028 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 6029 "" i__2[0] = lnote, a__1[0] = notexq; +#line 6029 "" i__2[1] = 1, a__1[1] = "u"; +#line 6029 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6030 "" } else { /* Writing concatenation */ +#line 6031 "" i__2[0] = lnote, a__1[0] = notexq; +#line 6031 "" i__2[1] = 1, a__1[1] = "l"; +#line 6031 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6032 "" } +#line 6033 "" i__1 = lnote + 1; +#line 6033 "" addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 6034 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); +#line 6036 "" if (isgaft && comgrace_1.naccg[ngs - 1] == 0) { +#line 6037 "" lnotenga = lnoten; +#line 6038 "" s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); +#line 6039 "" } +#line 6041 "" if (lnoten == 1) { +#line 6041 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 6041 "" } +#line 6042 "" addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80); +#line 6043 "" if (comgrace_1.slashg[*ig - 1]) { /* Writing concatenation */ +#line 6043 "" i__4[0] = 1, a__3[0] = sq; +#line 6043 "" i__4[1] = 5, a__3[1] = "off{-"; +#line 6043 "" i__4[2] = 1, a__3[2] = sq; +#line 6043 "" i__4[3] = 9, a__3[3] = "noteskip}"; +#line 6043 "" s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16); +#line 6043 "" addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80); +#line 6043 "" } /* Above code needed since slashg causes spacing */ +#line 6048 "" if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) { /* Terminate slur on single after-grace */ -/* ndxslur = igetbits(ipl,4,23) */ +#line 6052 "" comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); +#line 6053 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Writing concatenation */ +#line 6054 "" i__2[0] = 1, a__1[0] = sq; +#line 6054 "" i__2[1] = 5, a__1[1] = "tslur"; +#line 6054 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 6054 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80); -/* c Print 11-ndxslur */ /* Print 24-ndxslur */ /* if (11-ndxslur .lt. 10) then */ +#line 6059 "" if (23 - comslur_1.ndxslur < 10) { /* call addstr(chax(59-ndxslur)//noteq(1:lnoten), */ /* Writing concatenation */ +#line 6061 "" i__1 = 71 - comslur_1.ndxslur; +#line 6061 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6061 "" i__2[0] = 1, a__1[0] = ch__1; +#line 6061 "" i__2[1] = lnoten, a__1[1] = noteq; +#line 6061 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 6061 "" i__5 = lnoten + 1; +#line 6061 "" addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); +#line 6063 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 6064 "" i__4[0] = 2, a__3[0] = "{2"; +#line 6064 "" i__1 = 61 - comslur_1.ndxslur; +#line 6064 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6064 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6064 "" i__4[2] = 1, a__3[2] = "}"; +#line 6064 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6064 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6064 "" i__5 = lnoten + 4; +#line 6064 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 6066 "" } else { /* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */ /* Writing concatenation */ +#line 6068 "" i__4[0] = 2, a__3[0] = "{1"; +#line 6068 "" i__1 = 51 - comslur_1.ndxslur; +#line 6068 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6068 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6068 "" i__4[2] = 1, a__3[2] = "}"; +#line 6068 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6068 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6068 "" i__5 = lnoten + 4; +#line 6068 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 6070 "" } +#line 6071 "" comgrace_1.slurg[*ig - 1] = FALSE_; +#line 6072 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); +#line 6073 "" } +#line 6074 "" addstr_("}", &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80); /* +++ Try to fix loss of octave with single gaft */ -/* if (isgaft) call addstr(sq//'zcharnote'//noteq(1:lnoten)//'{~}', */ -/* * 13+lnoten,soutq,lsout) */ +#line 6078 "" if (isgaft) { +#line 6079 "" itrans = 0; +#line 6080 "" i__1 = lnotenga; +#line 6080 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 6081 "" chax_(ch__1, (ftnlen)1, &c__39); +#line 6081 "" if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned char *)& ch__1[0]) { +#line 6082 "" itrans += 7; +#line 6083 "" } else /* if(complicated condition) */ { +#line 6083 "" chax_(ch__1, (ftnlen)1, &c__96); +#line 6083 "" if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned char *)&ch__1[0]) { +#line 6084 "" itrans += -7; +#line 6085 "" } +#line 6085 "" } +#line 6086 "" /* L1: */ +#line 6086 "" } +#line 6087 "" if (itrans == -14) { /* Writing concatenation */ +#line 6088 "" i__4[0] = 1, a__3[0] = sq; +#line 6088 "" i__4[1] = 7, a__3[1] = "advance"; +#line 6088 "" i__4[2] = 1, a__3[2] = sq; +#line 6088 "" i__4[3] = 12, a__3[3] = "transpose-14"; +#line 6088 "" s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21); +#line 6088 "" addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); +#line 6090 "" } else if (itrans == -7) { /* Writing concatenation */ +#line 6091 "" i__4[0] = 1, a__3[0] = sq; +#line 6091 "" i__4[1] = 7, a__3[1] = "advance"; +#line 6091 "" i__4[2] = 1, a__3[2] = sq; +#line 6091 "" i__4[3] = 11, a__3[3] = "transpose-7"; +#line 6091 "" s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); +#line 6091 "" addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); +#line 6093 "" } else if (itrans == 7) { /* Writing concatenation */ +#line 6094 "" i__4[0] = 1, a__3[0] = sq; +#line 6094 "" i__4[1] = 7, a__3[1] = "advance"; +#line 6094 "" i__4[2] = 1, a__3[2] = sq; +#line 6094 "" i__4[3] = 10, a__3[3] = "transpose7"; +#line 6094 "" s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19); +#line 6094 "" addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80); +#line 6096 "" } else if (itrans == 14) { /* Writing concatenation */ +#line 6097 "" i__4[0] = 1, a__3[0] = sq; +#line 6097 "" i__4[1] = 7, a__3[1] = "advance"; +#line 6097 "" i__4[2] = 1, a__3[2] = sq; +#line 6097 "" i__4[3] = 11, a__3[3] = "transpose14"; +#line 6097 "" s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); +#line 6097 "" addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); +#line 6099 "" } +#line 6100 "" } +#line 6101 "" } else { /* Multiple grace. Put in literally. Compute beam stuff */ +#line 6105 "" sumx = 0.f; +#line 6106 "" sumy = 0.f; +#line 6107 "" sumxy = 0.f; +#line 6108 "" sumxx = 0.f; +#line 6109 "" sumyy = 0.f; +#line 6110 "" x = 0.f; +#line 6111 "" i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; +#line 6111 "" for (ing = ngs; ing <= i__1; ++ing) { +#line 6112 "" if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) { +#line 6112 "" x += spfacs_1.acgfac; +#line 6112 "" } +#line 6113 "" y = (real) comgrace_1.nolevg[ing - 1]; +#line 6114 "" sumx += x; +#line 6115 "" sumy += y; +#line 6116 "" sumxy += x * y; +#line 6117 "" sumxx += x * x; +#line 6118 "" sumyy += y * y; +#line 6119 "" x += spfacs_1.emgfac; +#line 6120 "" /* L118: */ +#line 6120 "" } +#line 6121 "" delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx; +#line 6122 "" em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta; +#line 6123 "" r__1 = em * .5f * spfacs_1.gslfac; +#line 6123 "" islope = i_nint(&r__1); +#line 6124 "" if (abs(islope) > 9) { +#line 6124 "" islope = i_sign(&c__9, &islope); +#line 6124 "" } +#line 6125 "" beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig - 1]; +#line 6126 "" nolev1 = i_nint(&beta); /* Back up */ /* Writing concatenation */ +#line 6130 "" i__4[0] = 1, a__3[0] = sq; +#line 6130 "" i__4[1] = 7, a__3[1] = "settiny"; +#line 6130 "" i__4[2] = 1, a__3[2] = sq; +#line 6130 "" i__4[3] = 4, a__3[3] = "off{"; +#line 6130 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 6131 "" if (normsp) { - s_wsfi(&io___426); +#line 6132 "" + s_wsfi(&io___456); +#line 6132 "" do_fio(&c__1, "-", (ftnlen)1); +#line 6132 "" do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real)); +#line 6132 "" e_wsfi(); /* Writing concatenation */ +#line 6133 "" i__2[0] = 18, a__1[0] = notexq; +#line 6133 "" i__2[1] = 3, a__1[1] = "pt}"; +#line 6133 "" s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21); +#line 6133 "" addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); +#line 6134 "" finalshift = ptgr[*ig]; +#line 6135 "" } else { +#line 6136 "" comgrace_1.aftshft = comask_1.wheadpt * 1.33f; +#line 6137 "" if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { +#line 6137 "" comgrace_1.aftshft += comask_1.wheadpt * .5f; +#line 6137 "" } - s_wsfi(&io___428); +#line 6138 "" + s_wsfi(&io___458); +#line 6138 "" do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real)); +#line 6138 "" e_wsfi(); /* Writing concatenation */ +#line 6139 "" i__4[0] = 17, a__3[0] = notexq; +#line 6139 "" i__4[1] = 3, a__3[1] = "pt}"; +#line 6139 "" i__4[2] = 1, a__3[2] = sq; +#line 6139 "" i__4[3] = 3, a__3[3] = "bsk"; +#line 6139 "" s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24); +#line 6139 "" addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80); +#line 6140 "" } /* Start the beam */ /* Writing concatenation */ +#line 6144 "" i__2[0] = 1, a__1[0] = sq; +#line 6144 "" i__2[1] = 2, a__1[1] = "ib"; +#line 6144 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6145 "" i__1 = mg; +#line 6145 "" for (ing = 2; ing <= i__1; ++ing) { /* Writing concatenation */ +#line 6146 "" i__2[0] = ing + 1, a__1[0] = notexq; +#line 6146 "" i__2[1] = 1, a__1[1] = "b"; +#line 6146 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6147 "" /* L119: */ +#line 6147 "" } +#line 6148 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 6149 "" i__2[0] = mg + 2, a__1[0] = notexq; +#line 6149 "" i__2[1] = 1, a__1[1] = "u"; +#line 6149 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6150 "" } else { /* Writing concatenation */ +#line 6151 "" i__2[0] = mg + 2, a__1[0] = notexq; +#line 6151 "" i__2[1] = 1, a__1[1] = "l"; +#line 6151 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6152 "" } /* Writing concatenation */ +#line 6153 "" i__2[0] = mg + 3, a__1[0] = notexq; +#line 6153 "" i__2[1] = 1, a__1[1] = "0"; +#line 6153 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); /* Get starting note for beam */ +#line 6157 "" notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8); /* Writing concatenation */ +#line 6158 "" i__2[0] = mg + 4, a__1[0] = notexq; +#line 6158 "" i__2[1] = lnoten, a__1[1] = noteq; +#line 6158 "" s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); +#line 6158 "" i__1 = mg + 4 + lnoten; +#line 6158 "" addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80); /* Put in the slope */ +#line 6163 "" if (islope >= 0) { +#line 6164 "" i__1 = islope + 48; +#line 6164 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6164 "" addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80); +#line 6165 "" } else { /* Writing concatenation */ +#line 6166 "" i__3[0] = 2, a__2[0] = "{-"; +#line 6166 "" i__1 = 48 - islope; +#line 6166 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6166 "" i__3[1] = 1, a__2[1] = ch__1; +#line 6166 "" i__3[2] = 1, a__2[2] = "}"; +#line 6166 "" s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4); +#line 6166 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80); +#line 6167 "" } /* Start a slur on multiple fore-grace */ +#line 6171 "" if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { +#line 6172 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); +#line 6173 "" if (comslur_1.fontslur) { +#line 6174 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 6175 "" i__2[0] = 1, a__1[0] = sq; +#line 6175 "" i__2[1] = 6, a__1[1] = "islurd"; +#line 6175 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 6175 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; +#line 6176 "" } else { /* Writing concatenation */ +#line 6177 "" i__2[0] = 1, a__1[0] = sq; +#line 6177 "" i__2[1] = 6, a__1[1] = "isluru"; +#line 6177 "" s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 6177 "" addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) ; +#line 6178 "" } +#line 6179 "" } else { /* Need a tweak for postscript slur */ +#line 6183 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 6184 "" i__2[0] = 1, a__1[0] = sq; +#line 6184 "" i__2[1] = 3, a__1[1] = "isd"; +#line 6184 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 6184 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; +#line 6185 "" } else { /* Writing concatenation */ +#line 6186 "" i__2[0] = 1, a__1[0] = sq; +#line 6186 "" i__2[1] = 3, a__1[1] = "isu"; +#line 6186 "" s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 6186 "" addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) ; +#line 6187 "" } +#line 6188 "" } -/* Print 11-ndxslur */ +/* Print 23-ndxslur */ +#line 6192 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ +#line 6193 "" i__1 = 71 - comslur_1.ndxslur; +#line 6193 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6193 "" i__2[0] = 1, a__1[0] = ch__1; +#line 6193 "" i__2[1] = lnoten, a__1[1] = noteq; +#line 6193 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 6193 "" i__5 = lnoten + 1; +#line 6193 "" addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); +#line 6195 "" } else if (23 - comslur_1.ndxslur < 2) { /* Writing concatenation */ +#line 6196 "" i__4[0] = 2, a__3[0] = "{1"; +#line 6196 "" i__1 = 61 - comslur_1.ndxslur; +#line 6196 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6196 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6196 "" i__4[2] = 1, a__3[2] = "}"; +#line 6196 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6196 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6196 "" i__5 = lnoten + 4; +#line 6196 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 6198 "" } else { /* Writing concatenation */ +#line 6199 "" i__4[0] = 2, a__3[0] = "{1"; +#line 6199 "" i__1 = 51 - comslur_1.ndxslur; +#line 6199 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 6199 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6199 "" i__4[2] = 1, a__3[2] = "}"; +#line 6199 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6199 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6199 "" i__5 = lnoten + 4; +#line 6199 "" addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 6201 "" } /* Put in tweak for postscript slur */ +#line 6205 "" if (! comslur_1.fontslur) { +#line 6205 "" addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); +#line 6205 "" } +#line 6206 "" } /* Put in first note. Call notefq again in case octave changed */ +#line 6210 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); +#line 6211 "" if (comgrace_1.naccg[ngs - 1] == 0) { /* Writing concatenation */ +#line 6212 "" i__3[0] = 1, a__2[0] = sq; +#line 6212 "" i__3[1] = 4, a__2[1] = "zqb0"; +#line 6212 "" i__3[2] = lnoten, a__2[2] = noteq; +#line 6212 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 6213 "" lnote = lnoten + 5; +#line 6214 "" } else { +#line 6215 "" if (lnoten == 1) { +#line 6215 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 6215 "" } +#line 6216 "" accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ +#line 6217 "" i__4[0] = 1, a__3[0] = sq; +#line 6217 "" i__4[1] = 3, a__3[1] = "big"; +#line 6217 "" i__4[2] = lacc, a__3[2] = acsymq; +#line 6217 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6217 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 6218 "" lnote = lacc + 4 + lnoten; +#line 6219 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) 8); /* Writing concatenation */ +#line 6220 "" i__4[0] = lnote, a__3[0] = notexq; +#line 6220 "" i__4[1] = 1, a__3[1] = sq; +#line 6220 "" i__4[2] = 4, a__3[2] = "zqb0"; +#line 6220 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6220 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 6221 "" lnote = lnote + 5 + lnoten; +#line 6222 "" } +#line 6223 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 6224 "" i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; +#line 6224 "" for (ing = ngs + 1; ing <= i__1; ++ing) { /* Skip */ +#line 6228 "" ptoff = wheadpt1 * spfacs_1.emgfac; +#line 6229 "" if (comgrace_1.naccg[ing - 1] > 0) { +#line 6229 "" ptoff += wheadpt1 * spfacs_1.acgfac; +#line 6229 "" } +#line 6230 "" if (isgaft && ! iswaft) { +#line 6230 "" comgrace_1.aftshft += ptoff; +#line 6230 "" } /* Writing concatenation */ +#line 6231 "" i__2[0] = 1, a__1[0] = sq; +#line 6231 "" i__2[1] = 4, a__1[1] = "off{"; +#line 6231 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); - s_wsfi(&io___430); +#line 6232 "" + s_wsfi(&io___460); +#line 6232 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 6232 "" e_wsfi(); +#line 6233 "" if (normsp) { +#line 6233 "" finalshift -= ptoff; +#line 6233 "" } /* Writing concatenation */ +#line 6234 "" i__2[0] = 8, a__1[0] = notexq; +#line 6234 "" i__2[1] = 3, a__1[1] = "pt}"; +#line 6234 "" s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); +#line 6234 "" addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); +#line 6235 "" if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) { /* Terminate beam if needed */ +#line 6239 "" if (comgrace_1.upg[*ig - 1]) { /* Writing concatenation */ +#line 6240 "" i__2[0] = 1, a__1[0] = sq; +#line 6240 "" i__2[1] = 4, a__1[1] = "tbu0"; +#line 6240 "" s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); +#line 6240 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) ; +#line 6241 "" } else { /* Writing concatenation */ +#line 6242 "" i__2[0] = 1, a__1[0] = sq; +#line 6242 "" i__2[1] = 4, a__1[1] = "tbl0"; +#line 6242 "" s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); +#line 6242 "" addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) ; +#line 6243 "" } /* Terminate after slur if needed */ +#line 6247 "" if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) { /* if (iswaft) ndxslur = igetbits(ipl,4,23) */ +#line 6249 "" if (iswaft) { +#line 6249 "" comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); +#line 6249 "" } +#line 6250 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen)8); /* Writing concatenation */ +#line 6251 "" i__2[0] = 1, a__1[0] = sq; +#line 6251 "" i__2[1] = 5, a__1[1] = "tslur"; +#line 6251 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 6251 "" addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80) ; /* Print 11-ndxslur */ /* c Print 23-ndxslur */ +#line 6256 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ +#line 6257 "" i__5 = 71 - comslur_1.ndxslur; +#line 6257 "" chax_(ch__1, (ftnlen)1, &i__5); +#line 6257 "" i__2[0] = 1, a__1[0] = ch__1; +#line 6257 "" i__2[1] = lnoten, a__1[1] = noteq; +#line 6257 "" s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 6257 "" i__6 = lnoten + 1; +#line 6257 "" addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, ( ftnlen)80); +#line 6259 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 6260 "" i__4[0] = 2, a__3[0] = "{2"; +#line 6260 "" i__5 = 61 - comslur_1.ndxslur; +#line 6260 "" chax_(ch__1, (ftnlen)1, &i__5); +#line 6260 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6260 "" i__4[2] = 1, a__3[2] = "}"; +#line 6260 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6260 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6260 "" i__6 = lnoten + 4; +#line 6260 "" addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( ftnlen)80); +#line 6262 "" } else { /* Writing concatenation */ +#line 6263 "" i__4[0] = 2, a__3[0] = "{1"; +#line 6263 "" i__5 = 51 - comslur_1.ndxslur; +#line 6263 "" chax_(ch__1, (ftnlen)1, &i__5); +#line 6263 "" i__4[1] = 1, a__3[1] = ch__1; +#line 6263 "" i__4[2] = 1, a__3[2] = "}"; +#line 6263 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6263 "" s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 6263 "" i__6 = lnoten + 4; +#line 6263 "" addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( ftnlen)80); +#line 6265 "" } /* Stop slur terminator after exit from this subroutine */ +#line 6269 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); +#line 6270 "" comgrace_1.slurg[*ig - 1] = FALSE_; +#line 6271 "" } +#line 6272 "" } /* Accidental if needed */ +#line 6276 "" if (comgrace_1.naccg[ing - 1] > 0) { +#line 6277 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, ( ftnlen)8); +#line 6278 "" if (lnoten == 1) { +#line 6278 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 6278 "" } +#line 6279 "" accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3); /* Writing concatenation */ +#line 6280 "" i__4[0] = 1, a__3[0] = sq; +#line 6280 "" i__4[1] = 3, a__3[1] = "big"; +#line 6280 "" i__4[2] = lacc, a__3[2] = acsymq; +#line 6280 "" i__4[3] = lnoten, a__3[3] = noteq; +#line 6280 "" s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); +#line 6280 "" i__5 = lacc + 4 + lnoten; +#line 6280 "" addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, ( ftnlen)80); +#line 6282 "" } /* Put in the (beamed) grace note */ +#line 6286 "" notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen) 8); /* Writing concatenation */ +#line 6287 "" i__3[0] = 1, a__2[0] = sq; +#line 6287 "" i__3[1] = 4, a__2[1] = "zqb0"; +#line 6287 "" i__3[2] = lnoten, a__2[2] = noteq; +#line 6287 "" s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13); +#line 6287 "" i__5 = lnoten + 5; +#line 6287 "" addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80); +#line 6289 "" /* L127: */ +#line 6289 "" } /* Terminate the grace */ @@ -9200,78 +15462,147 @@ L121: /* notexq = '}'//sq//'off{' */ /* lnote = 6 */ /* Writing concatenation */ +#line 6297 "" i__2[0] = 1, a__1[0] = sq; +#line 6297 "" i__2[1] = 4, a__1[1] = "off{"; +#line 6297 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6298 "" lnote = 5; +#line 6299 "" ptoff = comask_1.wheadpt * spfacs_1.emgfac; +#line 6300 "" if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) { +#line 6300 "" ptoff += comask_1.wheadpt * spfacs_1.accfac; +#line 6300 "" } +#line 6302 "" if (isgaft && ! iswaft) { /* Writing concatenation */ +#line 6303 "" i__2[0] = 5, a__1[0] = notexq; +#line 6303 "" i__2[1] = 1, a__1[1] = "-"; +#line 6303 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6304 "" lnote = 6; +#line 6305 "" ptoff = comgrace_1.aftshft; +#line 6306 "" } +#line 6307 "" if (normsp) { +#line 6307 "" ptoff = finalshift; +#line 6307 "" } +#line 6308 "" if (ptoff < 9.95f) { +#line 6309 "" i__1 = lnote; +#line 6309 "" ici__1.icierr = 0; +#line 6309 "" ici__1.icirnum = 1; +#line 6309 "" ici__1.icirlen = lnote + 3 - i__1; +#line 6309 "" ici__1.iciunit = notexq + i__1; +#line 6309 "" ici__1.icifmt = "(f3.1)"; +#line 6309 "" s_wsfi(&ici__1); +#line 6309 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 6309 "" e_wsfi(); +#line 6310 "" lnote += 3; +#line 6311 "" } else if (ptoff < 99.95f) { +#line 6312 "" i__1 = lnote; +#line 6312 "" ici__1.icierr = 0; +#line 6312 "" ici__1.icirnum = 1; +#line 6312 "" ici__1.icirlen = lnote + 4 - i__1; +#line 6312 "" ici__1.iciunit = notexq + i__1; +#line 6312 "" ici__1.icifmt = "(f4.1)"; +#line 6312 "" s_wsfi(&ici__1); +#line 6312 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 6312 "" e_wsfi(); +#line 6313 "" lnote += 4; +#line 6314 "" } else { +#line 6315 "" i__1 = lnote; +#line 6315 "" ici__1.icierr = 0; +#line 6315 "" ici__1.icirnum = 1; +#line 6315 "" ici__1.icirlen = lnote + 5 - i__1; +#line 6315 "" ici__1.iciunit = notexq + i__1; +#line 6315 "" ici__1.icifmt = "(f5.1)"; +#line 6315 "" s_wsfi(&ici__1); +#line 6315 "" do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 6315 "" e_wsfi(); +#line 6316 "" lnote += 5; +#line 6317 "" } /* Writing concatenation */ +#line 6318 "" i__2[0] = lnote, a__1[0] = notexq; +#line 6318 "" i__2[1] = 3, a__1[1] = "pt}"; +#line 6318 "" s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82); +#line 6318 "" i__1 = lnote + 3; +#line 6318 "" addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80); +#line 6319 "" if (isgaft && ! iswaft) { /* Writing concatenation */ +#line 6319 "" i__2[0] = 1, a__1[0] = sq; +#line 6319 "" i__2[1] = 2, a__1[1] = "sk"; +#line 6319 "" s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3); +#line 6319 "" addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80); +#line 6319 "" } /* Writing concatenation */ +#line 6320 "" i__2[0] = 1, a__1[0] = sq; +#line 6320 "" i__2[1] = 9, a__1[1] = "resetsize"; +#line 6320 "" s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10); +#line 6320 "" addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80); +#line 6321 "" } +#line 6322 "" return 0; } /* dograce_ */ @@ -9329,10 +15660,10 @@ L121: static char slurudq[1]; /* Fortran I/O blocks */ - static cilist io___444 = { 0, 6, 0, 0, 0 }; - static cilist io___445 = { 0, 6, 0, 0, 0 }; - static cilist io___446 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___454 = { 0, 6, 0, 0, 0 }; + static cilist io___474 = { 0, 6, 0, 0, 0 }; + static cilist io___475 = { 0, 6, 0, 0, 0 }; + static cilist io___476 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___484 = { 0, 6, 0, 0, 0 }; @@ -9354,6 +15685,7 @@ L121: /* 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. */ /* 18 int(ndxslur/16), ditto. So this allows ndxslur>15. */ /* 2 stem slur flag */ +/* 1 flag for "x" slur (voice-independent) */ /* Bits in isdat2 */ /* 0 Chord switch. Not set on main note. */ @@ -9392,300 +15724,492 @@ L121: /* If highest note has upslur, save slur height in islhgt in case */ /* ornament must be moved. */ +#line 6419 "" /* Parameter adjustments */ +#line 6419 "" --isdat4; +#line 6419 "" --isdat3; +#line 6419 "" --isdat2; +#line 6419 "" --isdat1; +#line 6419 "" +#line 6419 "" /* Function Body */ +#line 6419 "" *islhgt = 0; +#line 6420 "" if (*beamon) { +#line 6421 "" stemup = *(unsigned char *)ulq == 'u'; +#line 6422 "" } else if (commvl_1.nvmx[*iv - 1] == 2) { +#line 6423 "" if (! bit_test(*islur,30)) { /* Single note, 2 lines of music, stem direction not forced */ +#line 6427 "" stemup = commvl_1.ivx > *nv; +#line 6428 "" } else { +#line 6429 "" stemup = bit_test(*islur,17); +#line 6430 "" } +#line 6431 "" } else { +#line 6432 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & commvl_1.ivx, nv); +#line 6432 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 6433 "" } +#line 6434 "" iscrd = bit_test(*ipl,10); +#line 6435 "" if (commidi_1.ismidi) { +#line 6436 "" settie = FALSE_; +#line 6437 "" comslm_1.dbltie = FALSE_; +#line 6438 "" } +#line 6439 "" i__1 = *nsdat; +#line 6439 "" for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6440 "" isdata = isdat1[isdat]; +#line 6441 "" if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(& - isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, & - c__12) + 1) { + isdata, &c__8, &c__3) && (*kv == igetbits_(&isdata, &c__1, & + c__12) + 1 || bit_test(isdata,1))) { +/* * kv .eq. igetbits(isdata,1,12)+1) then */ /* Since iv and kv match, ivx will be correct */ +#line 6449 "" idcode = igetbits_(&isdata, &c__7, &c__19); +#line 6450 "" ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; +#line 6451 "" ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; +#line 6452 "" iupdn = 0; +#line 6453 "" *(unsigned char *)slurudq = 'd'; +#line 6454 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 6455 "" pstie = bit_test(isdat2[isdat],3) || idcode == 1; +#line 6456 "" if (bit_test(isdata,11)) { /* Turnon */ /* Get slur direction */ +#line 6461 "" if (bit_test(isdata,26)) { /* Force slur direction */ +#line 6465 "" if (bit_test(isdata,27)) { +#line 6465 "" *(unsigned char *)slurudq = 'u'; +#line 6465 "" } +#line 6466 "" } else if (commvl_1.nvmx[*iv - 1] == 1) { /* Only one voice per line */ +#line 6470 "" if (! (*beamon)) { /* Separate note. */ +#line 6474 "" udfq_(ch__1, (ftnlen)1, nolev, ncm); +#line 6474 "" *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ 0]; +#line 6475 "" } else { /* In a beam */ +#line 6479 "" if (*(unsigned char *)ulq != 'u') { +#line 6479 "" *(unsigned char *)slurudq = 'u'; +#line 6479 "" } +#line 6480 "" } +#line 6481 "" if (iscrd) { +#line 6482 "" if (nolevs > *ncm) { +#line 6483 "" *(unsigned char *)slurudq = 'u'; +#line 6484 "" } else { +#line 6485 "" *(unsigned char *)slurudq = 'd'; +#line 6486 "" } +#line 6487 "" } +#line 6488 "" } else { /* Two voices per line. Get default */ +#line 6492 "" if (commvl_1.ivx > *nv) { +#line 6492 "" *(unsigned char *)slurudq = 'u'; +#line 6492 "" } /* Upper voice of the two, so up slur */ +#line 6496 "" } +#line 6497 "" if (bit_test(isdata,2)) { /* ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. */ +#line 6501 "" if (stemup) { +#line 6502 "" *(unsigned char *)slurudq = 'u'; +#line 6503 "" ivoff += 4; +#line 6504 "" } else { +#line 6505 "" *(unsigned char *)slurudq = 'd'; +#line 6506 "" ivoff += -4; +#line 6507 "" } +#line 6508 "" } /* Set level for slur starting on rest */ +#line 6512 "" if (nolevs == 0 || nolevs > 60) { +#line 6513 "" if (*(unsigned char *)slurudq == 'u') { +#line 6514 "" nolevs = *ncm + 2; +#line 6515 "" } else { +#line 6516 "" nolevs = *ncm - 2; +#line 6517 "" } +#line 6518 "" } /* Save up/down-ness for use at termination */ +#line 6522 "" if (*(unsigned char *)slurudq == 'u') { +#line 6522 "" isdata = bit_set(isdata,27); +#line 6522 "" } /* End of section for setting slur direction, still in "Turnon" if-block. */ +#line 6526 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ +#line 6530 "" ivoffinc = 0; +#line 6531 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { /* Must move the slur for _ or . */ +#line 6536 "" if (stemup) { +#line 6537 "" ivoffinc = -1; +#line 6538 "" } else { +#line 6539 "" ivoffinc = 1; +#line 6540 "" } +#line 6541 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { +#line 6541 "" ivoffinc <<= 1; +#line 6541 "" } +#line 6544 "" ivoff += ivoffinc; +#line 6545 "" } +#line 6546 "" } +#line 6547 "" if (comslur_1.listslur == 16777215) { - s_wsle(&io___444); +#line 6548 "" + s_wsle(&io___474); +#line 6548 "" e_wsle(); - s_wsle(&io___445); - do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur," +#line 6549 "" + s_wsle(&io___475); +#line 6549 "" + do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"\ " one too many!", (ftnlen)48); +#line 6549 "" e_wsle(); - s_wsfe(&io___446); - do_fio(&c__1, "You defined the twentyfifth slur, one too" +#line 6550 "" + s_wsfe(&io___476); +#line 6550 "" + do_fio(&c__1, "You defined the twentyfifth slur, one too"\ " many!", (ftnlen)47); +#line 6550 "" e_wsfe(); +#line 6552 "" stop1_(); +#line 6553 "" } /* Get index of next slur not in use, starting from 12 down */ +#line 6557 "" i__2 = 16777215 - comslur_1.listslur; +#line 6557 "" comslur_1.ndxslur = log2_(&i__2); -/* write(*,'()') */ -/* write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur */ /* Record slur index */ +#line 6561 "" comslur_1.listslur = bit_set(comslur_1.listslur, comslur_1.ndxslur); -/* write(*,'(10x,B24)')listslur */ /* Save for use on termination */ /* call setbits(isdata,4,28,ndxslur) */ /* 080531 Allow >16 slurs */ +#line 6567 "" i__2 = comslur_1.ndxslur % 16; +#line 6567 "" setbits_(&isdata, &c__4, &c__28, &i__2); +#line 6568 "" i__2 = comslur_1.ndxslur / 16; +#line 6568 "" setbits_(&isdata, &c__1, &c__18, &i__2); /* Shift for stem? */ +#line 6572 "" if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) { +#line 6573 "" if (! pstie) { +#line 6574 "" ihoff += 8; +#line 6575 "" } else { +#line 6576 "" ihoff += 2; +#line 6577 "" } +#line 6578 "" } +#line 6579 "" if (iscrd) { /* Additional horiz shifts for h-shifted noteheads? */ +#line 6583 "" if (bit_test(isdat2[isdat],1)) { /* Slur start on left-shifted chord notehead. ASSUME downstem. */ +#line 6587 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { +#line 6588 "" ihoff += -2; +#line 6589 "" } else { +#line 6590 "" ihoff += -10; +#line 6591 "" } +#line 6592 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ +#line 6596 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { +#line 6597 "" ihoff += 2; +#line 6598 "" } else { +#line 6599 "" ihoff += 10; +#line 6600 "" } +#line 6601 "" } +#line 6602 "" } +#line 6603 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6603 "" s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); +#line 6604 "" lnote = 1; /* Check for local adjustment default changes */ +#line 6608 "" if (bit_test(isdat2[isdat],26)) { /* Writing concatenation */ +#line 6609 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6609 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6609 "" i__3[1] = 10, a__1[1] = "sluradjust"; +#line 6609 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 6609 "" i__3[2] = 1, a__1[2] = ch__2; +#line 6609 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6610 "" lnote = 12; +#line 6611 "" } else if (bit_test(isdat2[isdat],27)) { /* Writing concatenation */ +#line 6612 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6612 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6612 "" i__3[1] = 12, a__1[1] = "nosluradjust"; +#line 6612 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 6612 "" i__3[2] = 1, a__1[2] = ch__2; +#line 6612 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6613 "" lnote = 14; +#line 6614 "" } else if (bit_test(isdat2[isdat],28)) { /* Writing concatenation */ +#line 6615 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6615 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6615 "" i__3[1] = 9, a__1[1] = "tieadjust"; +#line 6615 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 6615 "" i__3[2] = 1, a__1[2] = ch__2; +#line 6615 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6616 "" lnote = 11; +#line 6617 "" } else if (bit_test(isdat2[isdat],29)) { /* Writing concatenation */ +#line 6618 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6618 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6618 "" i__3[1] = 11, a__1[1] = "notieadjust"; +#line 6618 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 6618 "" i__3[2] = 1, a__1[2] = ch__2; +#line 6618 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6619 "" lnote = 13; +#line 6620 "" } +#line 6621 "" if (ihoff == 0) { /* Write stuff for non-shifted start */ /* Writing concatenation */ +#line 6625 "" i__3[0] = lnote, a__1[0] = notexq; +#line 6625 "" i__3[1] = 5, a__1[1] = "islur"; +#line 6625 "" i__3[2] = 1, a__1[2] = slurudq; +#line 6625 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6626 "" lnote += 6; +#line 6627 "" } else { /* Writing concatenation */ +#line 6628 "" i__3[0] = lnote, a__1[0] = notexq; +#line 6628 "" i__3[1] = 2, a__1[1] = "is"; +#line 6628 "" i__3[2] = 1, a__1[2] = slurudq; +#line 6628 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6629 "" lnote += 3; +#line 6630 "" } /* Prepend postscript tie switch */ +#line 6634 "" if (pstie) { /* Writing concatenation */ +#line 6635 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6635 "" i__4[0] = 1, a__2[0] = ch__1; +#line 6635 "" i__4[1] = 8, a__2[1] = "tieforis"; +#line 6635 "" i__4[2] = 1, a__2[2] = slurudq; +#line 6635 "" i__4[3] = lnote, a__2[3] = notexq; +#line 6635 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6636 "" lnote += 10; +#line 6637 "" } +#line 6638 "" if (bit_test(isdat2[isdat],4)) { /* Dotted slur */ @@ -9693,183 +16217,289 @@ L121: /* noteq = notexq */ /* notexq = chax(92)//'dotted'//noteq */ /* Writing concatenation */ +#line 6644 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6644 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6644 "" i__3[1] = 6, a__1[1] = "dotted"; +#line 6644 "" i__3[2] = lnote, a__1[2] = notexq; +#line 6644 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6645 "" lnote += 7; +#line 6646 "" } /* Add slur index to string */ -/* c Print 11-ndxslur */ /* Print 23-ndxslur */ -/* if (11-ndxslur .lt. 10) then */ +#line 6651 "" if (23 - comslur_1.ndxslur < 10) { /* 5/25/08 Allow 24 slurs */ -/* notexq = notexq(1:lnote)//chax(59-ndxslur) */ /* Writing concatenation */ +#line 6655 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6655 "" i__2 = 71 - comslur_1.ndxslur; +#line 6655 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6655 "" i__5[1] = 1, a__3[1] = ch__1; +#line 6655 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6656 "" ++lnote; +#line 6657 "" } else if (23 - comslur_1.ndxslur < 20) { -/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ +#line 6658 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6658 "" i__4[1] = 2, a__2[1] = "{1"; +#line 6658 "" i__2 = 61 - comslur_1.ndxslur; +#line 6658 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6658 "" i__4[2] = 1, a__2[2] = ch__1; +#line 6658 "" i__4[3] = 1, a__2[3] = "}"; +#line 6658 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6659 "" lnote += 4; +#line 6660 "" } else { /* Writing concatenation */ +#line 6661 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6661 "" i__4[1] = 2, a__2[1] = "{2"; +#line 6661 "" i__2 = 51 - comslur_1.ndxslur; +#line 6661 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6661 "" i__4[2] = 1, a__2[2] = ch__1; +#line 6661 "" i__4[3] = 1, a__2[3] = "}"; +#line 6661 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6662 "" lnote += 4; +#line 6663 "" } /* Add note name to string */ -/* call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) */ +#line 6667 "" *islhgt = nolevs + iupdn + ivoff; +#line 6668 "" notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8); /* Writing concatenation */ +#line 6669 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6669 "" i__5[1] = lnoten, a__3[1] = noteq; +#line 6669 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6670 "" lnote += lnoten; /* Store height and staff mid level for use with LineBreakTies */ +#line 6674 "" setbits_(&isdat3[isdat], &c__8, &c__14, islhgt); +#line 6675 "" setbits_(&isdat3[isdat], &c__8, &c__22, ncm); /* Save height (for ornament and barnobox interference) if topmost slur is up */ +#line 6679 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6681 "" *islhgt = nolevs + iupdn + ivoff; /* Save height & idcode if top voice and slur start */ +#line 6685 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { +#line 6686 "" comsln_1.is1n1 = *islhgt; +#line 6687 "" comsln_1.is2n1 = idcode; +#line 6688 "" } +#line 6689 "" } +#line 6690 "" if ((real) ihoff != 0.f) { +#line 6691 "" shift = ihoff * .1f; /* Writing concatenation */ +#line 6692 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6692 "" i__5[1] = 1, a__3[1] = "{"; +#line 6692 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6693 "" ++lnote; +#line 6694 "" lform = lfmt1_(&shift); +#line 6695 "" i__2 = lnote; +#line 6695 "" ici__1.icierr = 0; +#line 6695 "" ici__1.icirnum = 1; +#line 6695 "" ici__1.icirlen = lnote + lform - i__2; +#line 6695 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 6695 "" i__3[0] = 2, a__1[0] = "(f"; +#line 6695 "" i__6 = lform + 48; +#line 6695 "" chax_(ch__1, (ftnlen)1, &i__6); +#line 6695 "" i__3[1] = 1, a__1[1] = ch__1; +#line 6695 "" i__3[2] = 3, a__1[2] = ".1)"; +#line 6695 "" ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) 6), ch__3); +#line 6695 "" s_wsfi(&ici__1); +#line 6695 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6695 "" e_wsfi(); +#line 6697 "" lnote += lform; /* Writing concatenation */ +#line 6698 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6698 "" i__5[1] = 1, a__3[1] = "}"; +#line 6698 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6699 "" ++lnote; +#line 6700 "" } +#line 6701 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Zero out ip1 to avoid problems if slur goes to next input blk. */ +#line 6705 "" setbits_(&isdata, &c__8, &c__3, &c__0); /* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */ +#line 6709 "" if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { /* levson(midchan(iv,kv)) = nolevs */ /* 130316 */ /* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */ +#line 6713 "" comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1]; +#line 6714 "" if (settie) { +#line 6714 "" comslm_1.dbltie = TRUE_; +#line 6714 "" } /* Only way settie=T is if we just set a tie ending. So there's also a slur */ /* start here, so set a flag telling addmidi not to zero out levson */ +#line 6719 "" } +#line 6720 "" } else { /* Slur is ending. Back thru list to find starting slur */ +#line 6724 "" for (j = isdat - 1; j >= 1; --j) { - if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv == - igetbits_(&isdat1[j], &c__1, &c__12) + 1) { +#line 6725 "" + if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && (*kv == + igetbits_(&isdat1[j], &c__1, &c__12) + 1 || + bit_test(isdat1[j],1))) { +/* * kv.eq.igetbits(isdat1(j),1,12)+1) then */ +#line 6729 "" if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { +#line 6730 "" comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & c__28) + (igetbits_(&isdat1[j], &c__1, & c__18) << 4); /* 080531 Allow >16 slurs */ +#line 6735 "" if (bit_test(isdat1[j],27)) { +#line 6735 "" *(unsigned char *)slurudq = 'u'; +#line 6735 "" } +#line 6736 "" goto L4; +#line 6737 "" } +#line 6738 "" } +#line 6739 "" /* L3: */ +#line 6739 "" } - s_wsle(&io___454); +#line 6740 "" + s_wsle(&io___484); +#line 6740 "" do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); +#line 6740 "" e_wsle(); +#line 6741 "" stop1_(); +#line 6742 "" L4: /* Bugfix 070901 for slur ending on rest in 2-voice staff */ -/* if (nolevs.eq.0 .or. nolevs.gt.60) then */ +#line 6746 "" if (nolevs <= 2 || nolevs > 60) { /* Ending is on a rest, reset nolevs to default starting height */ +#line 6750 "" nolevs = igetbits_(&isdat2[j], &c__7, &c__19); +#line 6751 "" } +#line 6752 "" if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) { /* Deal with \curve or \midslur. isdat is ending, j is start. */ +#line 6756 "" if (bit_test(isdat3[isdat],0)) { +#line 6757 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; +#line 6758 "" } else { +#line 6759 "" imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32; +#line 6760 "" } /* Postscript slurs, and \midslur adjustment is needed. Invoke macro */ @@ -9882,227 +16512,384 @@ L4: /* 6+ HH */ /* Writing concatenation */ +#line 6771 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6771 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6771 "" i__3[1] = 7, a__1[1] = "psforts"; /* Computing MIN */ +#line 6771 "" i__6 = abs(imid); +#line 6771 "" i__2 = min(i__6,6) + 48; +#line 6771 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 6771 "" i__3[2] = 1, a__1[2] = ch__2; +#line 6771 "" s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9); +#line 6771 "" addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80) ; +#line 6773 "" } +#line 6774 "" if (bit_test(isdata,2)) { /* ADjust for stem slur. */ +#line 6778 "" if (stemup) { +#line 6779 "" *(unsigned char *)slurudq = 'u'; +#line 6780 "" ivoff += 4; +#line 6781 "" } else { +#line 6782 "" *(unsigned char *)slurudq = 'd'; +#line 6783 "" ivoff += -4; +#line 6784 "" } +#line 6785 "" } /* Shift slur ending for stem on any note? */ +#line 6789 "" if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < 63.f) { +#line 6790 "" if (! pstie) { +#line 6791 "" ihoff += -8; +#line 6792 "" } else { +#line 6793 "" ihoff += -3; +#line 6794 "" } +#line 6795 "" } +#line 6796 "" if (iscrd) { /* Shift termination for shifted notehead? */ +#line 6800 "" if (bit_test(isdat2[isdat],1)) { /* Left-shifted chord notehead. ASSUME downstem. */ +#line 6804 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { +#line 6805 "" ihoff += -2; +#line 6806 "" } else { +#line 6807 "" ihoff += -10; +#line 6808 "" } +#line 6809 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ +#line 6813 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { +#line 6814 "" ihoff += 2; +#line 6815 "" } else { +#line 6816 "" ihoff += 10; +#line 6817 "" } +#line 6818 "" } +#line 6819 "" } +#line 6820 "" if (ihoff == 0) { /* Writing concatenation */ +#line 6821 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6821 "" i__5[0] = 1, a__3[0] = ch__1; +#line 6821 "" i__5[1] = 5, a__3[1] = "tslur"; +#line 6821 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6822 "" lnote = 6; +#line 6823 "" } else { /* Shift needed */ /* Writing concatenation */ +#line 6827 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6827 "" i__5[0] = 1, a__3[0] = ch__1; +#line 6827 "" i__5[1] = 2, a__3[1] = "ts"; +#line 6827 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6828 "" lnote = 3; +#line 6829 "" } /* Switch to postscript tie */ +#line 6833 "" if (pstie) { /* Writing concatenation */ +#line 6834 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6834 "" i__3[0] = 1, a__1[0] = ch__1; +#line 6834 "" i__3[1] = 8, a__1[1] = "tieforts"; +#line 6834 "" i__3[2] = lnote, a__1[2] = notexq; +#line 6834 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6835 "" lnote += 9; +#line 6836 "" } /* Print 13-ndxslur */ /* 5/25/08 Allow 14 slurs */ +#line 6841 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ +#line 6842 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6842 "" i__2 = 71 - comslur_1.ndxslur; +#line 6842 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6842 "" i__5[1] = 1, a__3[1] = ch__1; +#line 6842 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6843 "" ++lnote; +#line 6844 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 6845 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6845 "" i__4[1] = 2, a__2[1] = "{1"; +#line 6845 "" i__2 = 61 - comslur_1.ndxslur; +#line 6845 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6845 "" i__4[2] = 1, a__2[2] = ch__1; +#line 6845 "" i__4[3] = 1, a__2[3] = "}"; +#line 6845 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6846 "" lnote += 4; +#line 6847 "" } else { /* Writing concatenation */ +#line 6848 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6848 "" i__4[1] = 2, a__2[1] = "{2"; +#line 6848 "" i__2 = 51 - comslur_1.ndxslur; +#line 6848 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6848 "" i__4[2] = 1, a__2[2] = ch__1; +#line 6848 "" i__4[3] = 1, a__2[3] = "}"; +#line 6848 "" s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6849 "" lnote += 4; +#line 6850 "" } +#line 6851 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ +#line 6855 "" ivoffinc = 0; +#line 6856 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { +#line 6858 "" if (stemup) { +#line 6859 "" ivoffinc = -1; +#line 6860 "" } else { +#line 6861 "" ivoffinc = 1; +#line 6862 "" } +#line 6863 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { +#line 6863 "" ivoffinc <<= 1; +#line 6863 "" } +#line 6866 "" } +#line 6867 "" ivoff += ivoffinc; +#line 6868 "" } +#line 6869 "" i__2 = nolevs + iupdn + ivoff; +#line 6869 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +#line 6870 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6872 "" *islhgt = nolevs + iupdn + ivoff; /* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ +#line 6876 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && comsln_1.is1n1 > 0) { +#line 6877 "" if (idcode == comsln_1.is2n1) { +#line 6877 "" comsln_1.is1n1 = 0; +#line 6877 "" } +#line 6878 "" } +#line 6879 "" } /* Writing concatenation */ +#line 6880 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6880 "" i__5[1] = lnoten, a__3[1] = noteq; +#line 6880 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6881 "" lnote += lnoten; +#line 6882 "" if (ihoff != 0) { +#line 6883 "" shift = ihoff * .1f; /* Writing concatenation */ +#line 6884 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6884 "" i__5[1] = 1, a__3[1] = "{"; +#line 6884 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6885 "" ++lnote; +#line 6886 "" lform = lfmt1_(&shift); +#line 6887 "" i__2 = lnote; +#line 6887 "" ici__1.icierr = 0; +#line 6887 "" ici__1.icirnum = 1; +#line 6887 "" ici__1.icirlen = lnote + lform - i__2; +#line 6887 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 6887 "" i__3[0] = 2, a__1[0] = "(f"; +#line 6887 "" i__6 = lform + 48; +#line 6887 "" chax_(ch__1, (ftnlen)1, &i__6); +#line 6887 "" i__3[1] = 1, a__1[1] = ch__1; +#line 6887 "" i__3[2] = 3, a__1[2] = ".1)"; +#line 6887 "" ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) 6), ch__3); +#line 6887 "" s_wsfi(&ici__1); +#line 6887 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6887 "" e_wsfi(); +#line 6889 "" lnote += lform; /* Writing concatenation */ +#line 6890 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6890 "" i__5[1] = 1, a__3[1] = "}"; +#line 6890 "" s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6891 "" ++lnote; +#line 6892 "" } +#line 6893 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Clear the bit from list of slurs in use */ +#line 6897 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); /* Zero out the entire strings for start and stop */ +#line 6901 "" isdata = 0; +#line 6902 "" isdat2[isdat] = 0; +#line 6903 "" isdat3[isdat] = 0; +#line 6904 "" isdat4[isdat] = 0; +#line 6905 "" isdat1[j] = 0; +#line 6906 "" isdat2[j] = 0; +#line 6907 "" isdat3[j] = 0; +#line 6908 "" isdat4[j] = 0; /* Set midi info for slur ending */ +#line 6912 "" if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { +#line 6913 "" icm = commidi_1.midchan[*iv + *kv * 24 - 25]; +#line 6914 "" if (comslm_1.slmon[icm]) { /* if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */ /* 130316 */ /* if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */ +#line 6918 "" if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1] == comslm_1.levson[icm] && (7 & *nacc) == 0) { @@ -10112,44 +16899,77 @@ L4: /* levsoff(icm) = nolevs */ /* 130316 */ /* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */ +#line 6926 "" comslm_1.levsoff[icm] = nolevs + commvel_1.miditran[cominsttrans_1.instno[* iv - 1] - 1]; +#line 6927 "" settie = TRUE_; +#line 6928 "" } else { +#line 6929 "" comslm_1.levsoff[icm] = 0; +#line 6930 "" comslm_1.levson[icm] = 0; +#line 6931 "" comslm_1.slmon[icm] = FALSE_; +#line 6932 "" } +#line 6933 "" } +#line 6934 "" } +#line 6935 "" } +#line 6936 "" isdat1[isdat] = isdata; +#line 6937 "" } +#line 6938 "" /* L1: */ +#line 6938 "" } /* Clear and collapse the slur data list */ +#line 6942 "" numdrop = 0; +#line 6943 "" i__1 = *nsdat; +#line 6943 "" for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6944 "" if (isdat1[isdat] == 0) { +#line 6945 "" ++numdrop; +#line 6946 "" } else if (numdrop > 0) { +#line 6947 "" isdat1[isdat - numdrop] = isdat1[isdat]; +#line 6948 "" isdat2[isdat - numdrop] = isdat2[isdat]; +#line 6949 "" isdat3[isdat - numdrop] = isdat3[isdat]; +#line 6950 "" isdat4[isdat - numdrop] = isdat4[isdat]; +#line 6951 "" isdat1[isdat] = 0; +#line 6952 "" isdat2[isdat] = 0; +#line 6953 "" isdat3[isdat] = 0; +#line 6954 "" isdat4[isdat] = 0; +#line 6955 "" } +#line 6956 "" /* L2: */ +#line 6956 "" } +#line 6957 "" *nsdat -= numdrop; /* call report(nsdat,isdat1,isdat2) */ +#line 6959 "" return 0; } /* dopsslur_ */ @@ -10211,11 +17031,11 @@ L4: static char slurudq[1]; /* Fortran I/O blocks */ - static cilist io___475 = { 0, 6, 0, 0, 0 }; - static cilist io___477 = { 0, 6, 0, 0, 0 }; - static cilist io___478 = { 0, 6, 0, 0, 0 }; - static cilist io___479 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___487 = { 0, 6, 0, 0, 0 }; + static cilist io___505 = { 0, 6, 0, 0, 0 }; + static cilist io___507 = { 0, 6, 0, 0, 0 }; + static cilist io___508 = { 0, 6, 0, 0, 0 }; + static cilist io___509 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___517 = { 0, 6, 0, 0, 0 }; @@ -10259,75 +17079,129 @@ L4: /* If highest note has upslur, save slur height in islhgt in case */ /* ornament must be moved. */ +#line 7037 "" /* Parameter adjustments */ +#line 7037 "" --isdat3; +#line 7037 "" --isdat2; +#line 7037 "" --isdat1; +#line 7037 "" +#line 7037 "" /* Function Body */ +#line 7037 "" *islhgt = 0; +#line 7038 "" if (*beamon) { +#line 7039 "" stemup = *(unsigned char *)ulq == 'u'; +#line 7040 "" } else if (commvl_1.nvmx[*iv - 1] == 2) { +#line 7041 "" if (! bit_test(*islur,30)) { /* Single note, 2 lines of music, stem direction not forced */ +#line 7045 "" stemup = commvl_1.ivx > *nv; +#line 7046 "" } else { +#line 7047 "" stemup = bit_test(*islur,17); +#line 7048 "" } +#line 7049 "" } else { +#line 7050 "" udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & commvl_1.ivx, nv); +#line 7050 "" stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 7051 "" } +#line 7052 "" iscrd = bit_test(*ipl,10); +#line 7053 "" if (bit_test(*islur,1)) { /* 't'-slur (idcode=1) somewhere on this note. Find it, check height against */ /* 's'-slur (idcode=32) */ +#line 7058 "" sfound = FALSE_; +#line 7059 "" tfound = FALSE_; +#line 7060 "" tmove = FALSE_; +#line 7061 "" i__1 = *nsdat; +#line 7061 "" for (isdat = 1; isdat <= i__1; ++isdat) { +#line 7062 "" if (*iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *ip == igetbits_(&isdat1[isdat], &c__8, &c__3) && *kv == igetbits_(&isdat1[isdat], &c__1, &c__12) + 1) { +#line 7065 "" if (! tfound) { +#line 7066 "" tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1; +#line 7067 "" if (tfound) { +#line 7068 "" nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 7069 "" isdatt = isdat; +#line 7070 "" if (sfound) { +#line 7070 "" goto L6; +#line 7070 "" } +#line 7071 "" } +#line 7072 "" } +#line 7073 "" if (! sfound) { +#line 7074 "" sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32; +#line 7075 "" if (sfound) { +#line 7076 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 7077 "" isdats = isdat; +#line 7078 "" if (tfound) { +#line 7078 "" goto L6; +#line 7078 "" } +#line 7079 "" } +#line 7080 "" } +#line 7081 "" } +#line 7082 "" /* L5: */ +#line 7082 "" } /* Will come thru here if there is a t with no s, so comment out the following */ /* print*,'Did not find s+t-slurs in doslur' */ +#line 7087 "" L6: +#line 7088 "" if (sfound && tfound) { +#line 7088 "" tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) && bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats], 11) && ! bit_test(isdat1[isdatt],11)); +#line 7088 "" } /* Check if 2 starts or two stops */ @@ -10335,145 +17209,229 @@ L6: /* This is a flag for later changing slur level, after we know slur dir'n. */ +#line 7099 "" } +#line 7100 "" if (commidi_1.ismidi) { +#line 7101 "" settie = FALSE_; +#line 7102 "" comslm_1.dbltie = FALSE_; +#line 7103 "" } +#line 7104 "" i__1 = *nsdat; +#line 7104 "" for (isdat = 1; isdat <= i__1; ++isdat) { +#line 7105 "" isdata = isdat1[isdat]; +#line 7106 "" if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(& isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, & c__12) + 1) { /* Since iv and kv match, ivx will be correct */ +#line 7112 "" idcode = igetbits_(&isdata, &c__7, &c__19); +#line 7113 "" ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; +#line 7114 "" ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; +#line 7115 "" iupdn = 0; +#line 7116 "" *(unsigned char *)slurudq = 'd'; +#line 7117 "" nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 7118 "" if (bit_test(isdata,11)) { /* Turnon, */ +#line 7122 "" if (nolevs == 0 || nolevs > 60) { /* Note was a rest, cannot start slur on rest. */ - s_wsle(&io___475); +#line 7126 "" + s_wsle(&io___505); +#line 7126 "" e_wsle(); +#line 7127 "" printl_("Cannot start slur on a rest", (ftnlen)27); +#line 7128 "" stop1_(); +#line 7129 "" } /* Get slur direction */ +#line 7133 "" if (bit_test(isdata,26)) { /* Force slur direction */ +#line 7137 "" if (bit_test(isdata,27)) { +#line 7137 "" *(unsigned char *)slurudq = 'u'; +#line 7137 "" } +#line 7138 "" } else if (commvl_1.nvmx[*iv - 1] == 1) { /* Only one voice per line */ +#line 7142 "" if (! (*beamon)) { /* Separate note. */ +#line 7146 "" udfq_(ch__1, (ftnlen)1, nolev, ncm); +#line 7146 "" *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ 0]; +#line 7147 "" } else { /* In a beam */ +#line 7151 "" if (*(unsigned char *)ulq != 'u') { +#line 7151 "" *(unsigned char *)slurudq = 'u'; +#line 7151 "" } +#line 7152 "" } +#line 7153 "" if (iscrd) { +#line 7154 "" if (nolevs > *ncm) { +#line 7155 "" *(unsigned char *)slurudq = 'u'; +#line 7156 "" } else { +#line 7157 "" *(unsigned char *)slurudq = 'd'; +#line 7158 "" } +#line 7159 "" } +#line 7160 "" } else { /* Two voices per line. Get default */ +#line 7164 "" if (commvl_1.ivx > *nv) { +#line 7164 "" *(unsigned char *)slurudq = 'u'; +#line 7164 "" } /* Upper voice of the two, so up slur */ +#line 7168 "" } /* Save up/down-ness for use at termination */ +#line 7172 "" if (*(unsigned char *)slurudq == 'u') { +#line 7172 "" isdata = bit_set(isdata,27); +#line 7172 "" } /* End of section for setting slur direction, still in "Turnon" if-block. */ +#line 7176 "" if (idcode == 1 && tmove) { +#line 7177 "" iupdn = 1; +#line 7178 "" if (*(unsigned char *)slurudq == 'd') { +#line 7178 "" iupdn = -1; +#line 7178 "" } +#line 7179 "" } +#line 7180 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ +#line 7184 "" ivoffinc = 0; +#line 7185 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { /* Must move the slur for _ or . */ +#line 7190 "" if (stemup) { +#line 7191 "" ivoffinc = -1; +#line 7192 "" } else { +#line 7193 "" ivoffinc = 1; +#line 7194 "" } +#line 7195 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { +#line 7195 "" ivoffinc <<= 1; +#line 7195 "" } +#line 7198 "" ivoff += ivoffinc; +#line 7199 "" } +#line 7200 "" } +#line 7201 "" if (comslur_1.listslur == 16777215) { - s_wsle(&io___477); +#line 7202 "" + s_wsle(&io___507); +#line 7202 "" e_wsle(); - s_wsle(&io___478); - do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur" +#line 7203 "" + s_wsle(&io___508); +#line 7203 "" + do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"\ ", one too many!", (ftnlen)49); +#line 7203 "" e_wsle(); - s_wsfe(&io___479); - do_fio(&c__1, "You2 defined the twenty-fifth slur, one t" +#line 7204 "" + s_wsfe(&io___509); +#line 7204 "" + do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"\ "oo many!", (ftnlen)49); +#line 7204 "" e_wsfe(); +#line 7206 "" stop1_(); +#line 7207 "" } /* Get index of next slur not in use, starting from ? down */ +#line 7211 "" i__2 = 16777215 - comslur_1.listslur; +#line 7211 "" comslur_1.ndxslur = log2_(&i__2); /* Record slur index */ +#line 7215 "" comslur_1.listslur = bit_set(comslur_1.listslur, comslur_1.ndxslur); @@ -10481,92 +17439,149 @@ L6: /* call setbits(isdata,4,28,ndxslur) */ /* 080531 Allow >16 slurs */ +#line 7221 "" i__2 = comslur_1.ndxslur % 16; +#line 7221 "" setbits_(&isdata, &c__4, &c__28, &i__2); +#line 7222 "" i__2 = comslur_1.ndxslur / 16; +#line 7222 "" setbits_(&isdata, &c__1, &c__18, &i__2); /* Shift for stem? */ +#line 7226 "" if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) { +#line 7226 "" ihoff += 8; +#line 7226 "" } +#line 7228 "" if (bit_test(isdat2[isdat],3)) { /* Tie spacing, (slur start) */ +#line 7232 "" if (*(unsigned char *)slurudq == 'd') { +#line 7233 "" ++ivoff; +#line 7234 "" ihoff += 8; +#line 7235 "" } else if (*(unsigned char *)slurudq == 'u') { +#line 7236 "" --ivoff; +#line 7237 "" if (! (stemup && *tno < 63.f)) { +#line 7237 "" ihoff += 8; +#line 7237 "" } /* (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */ +#line 7241 "" } +#line 7242 "" } +#line 7243 "" if (iscrd) { /* Additional horiz shifts for h-shifted noteheads? */ +#line 7247 "" if (bit_test(isdat2[isdat],1)) { /* Slur start on left-shifted chord notehead. ASSUME downstem. */ +#line 7251 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { +#line 7252 "" ihoff += -2; +#line 7253 "" } else { +#line 7254 "" ihoff += -10; +#line 7255 "" } +#line 7256 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ +#line 7260 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { +#line 7261 "" ihoff += 2; +#line 7262 "" } else { +#line 7263 "" ihoff += 10; +#line 7264 "" } +#line 7265 "" } +#line 7266 "" } +#line 7267 "" if (ihoff == 0) { /* Write stuff for non-shifted start */ /* Writing concatenation */ +#line 7271 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7271 "" i__3[0] = 1, a__1[0] = ch__1; +#line 7271 "" i__3[1] = 5, a__1[1] = "islur"; +#line 7271 "" i__3[2] = 1, a__1[2] = slurudq; +#line 7271 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 7272 "" lnote = 7; +#line 7273 "" } else { /* Writing concatenation */ +#line 7274 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7274 "" i__3[0] = 1, a__1[0] = ch__1; +#line 7274 "" i__3[1] = 2, a__1[1] = "is"; +#line 7274 "" i__3[2] = 1, a__1[2] = slurudq; +#line 7274 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 7275 "" lnote = 4; +#line 7276 "" } +#line 7277 "" if (bit_test(isdat2[isdat],4)) { /* Dotted slur */ +#line 7281 "" s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79); /* Writing concatenation */ +#line 7282 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7282 "" i__3[0] = 1, a__1[0] = ch__1; +#line 7282 "" i__3[1] = 6, a__1[1] = "dotted"; +#line 7282 "" i__3[2] = 8, a__1[2] = noteq; +#line 7282 "" s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 7283 "" lnote += 7; +#line 7284 "" } /* Add slur index to string */ @@ -10574,156 +17589,253 @@ L6: /* Print 23-ndxslur */ /* if (11-ndxslur .lt. 10) then */ +#line 7291 "" if (23 - comslur_1.ndxslur < 10) { /* 5/25/08 Allow 24 slurs */ /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ /* Writing concatenation */ +#line 7296 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7296 "" i__2 = 71 - comslur_1.ndxslur; +#line 7296 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7296 "" i__4[1] = 1, a__2[1] = ch__1; +#line 7296 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7297 "" ++lnote; +#line 7298 "" } else if (23 - comslur_1.ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ +#line 7300 "" i__5[0] = lnote, a__3[0] = notexq; +#line 7300 "" i__5[1] = 2, a__3[1] = "{1"; +#line 7300 "" i__2 = 61 - comslur_1.ndxslur; +#line 7300 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7300 "" i__5[2] = 1, a__3[2] = ch__1; +#line 7300 "" i__5[3] = 1, a__3[3] = "}"; +#line 7300 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 7301 "" lnote += 4; +#line 7302 "" } else { /* Writing concatenation */ +#line 7303 "" i__5[0] = lnote, a__3[0] = notexq; +#line 7303 "" i__5[1] = 2, a__3[1] = "{2"; +#line 7303 "" i__2 = 51 - comslur_1.ndxslur; +#line 7303 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7303 "" i__5[2] = 1, a__3[2] = ch__1; +#line 7303 "" i__5[3] = 1, a__3[3] = "}"; +#line 7303 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 7304 "" lnote += 4; +#line 7305 "" } /* Add note name to string */ +#line 7309 "" i__2 = nolevs + iupdn + ivoff; +#line 7309 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); /* Writing concatenation */ +#line 7310 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7310 "" i__4[1] = lnoten, a__2[1] = noteq; +#line 7310 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7311 "" lnote += lnoten; /* Save height (for ornament and barnobox interference) if topmost slur is up */ +#line 7315 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 7317 "" *islhgt = nolevs + iupdn + ivoff; /* Save height & idcode if top voice and slur start */ +#line 7321 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { +#line 7322 "" comsln_1.is1n1 = *islhgt; +#line 7323 "" comsln_1.is2n1 = idcode; +#line 7324 "" } +#line 7325 "" } +#line 7326 "" if ((real) ihoff != 0.f) { +#line 7327 "" shift = ihoff * .1f; /* Writing concatenation */ +#line 7328 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7328 "" i__4[1] = 1, a__2[1] = "{"; +#line 7328 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7329 "" ++lnote; +#line 7330 "" lform = lfmt1_(&shift); +#line 7331 "" i__2 = lnote; +#line 7331 "" ici__1.icierr = 0; +#line 7331 "" ici__1.icirnum = 1; +#line 7331 "" ici__1.icirlen = lnote + lform - i__2; +#line 7331 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 7331 "" i__3[0] = 2, a__1[0] = "(f"; +#line 7331 "" i__6 = lform + 48; +#line 7331 "" chax_(ch__1, (ftnlen)1, &i__6); +#line 7331 "" i__3[1] = 1, a__1[1] = ch__1; +#line 7331 "" i__3[2] = 3, a__1[2] = ".1)"; +#line 7331 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) 6), ch__2); +#line 7331 "" s_wsfi(&ici__1); +#line 7331 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 7331 "" e_wsfi(); +#line 7333 "" lnote += lform; /* Writing concatenation */ +#line 7334 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7334 "" i__4[1] = 1, a__2[1] = "}"; +#line 7334 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7335 "" ++lnote; +#line 7336 "" } +#line 7337 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Zero out ip1 to avoid problems if slur goes to next input blk. */ +#line 7341 "" setbits_(&isdata, &c__8, &c__3, &c__0); /* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */ +#line 7345 "" if (commidi_1.ismidi && idcode == 32) { /* levson(midchan(iv,kv)) = nolevs */ /* 130316 */ /* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */ +#line 7349 "" comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1]; +#line 7350 "" if (settie) { +#line 7350 "" comslm_1.dbltie = TRUE_; +#line 7350 "" } /* Only way settie=T is if we just set a tie ending. So there's also a slur */ /* start here, so set a flag telling addmidi not to zero out levson */ +#line 7355 "" } +#line 7356 "" } else { /* Slur is ending. Back thru list to find starting slur */ +#line 7360 "" for (j = isdat - 1; j >= 1; --j) { +#line 7361 "" if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv == igetbits_(&isdat1[j], &c__1, &c__12) + 1) { +#line 7363 "" if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { +#line 7364 "" comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & c__28) + (igetbits_(&isdat1[j], &c__1, & c__18) << 4); /* 080531 Allow >16 slurs */ +#line 7369 "" if (bit_test(isdat1[j],27)) { +#line 7369 "" *(unsigned char *)slurudq = 'u'; +#line 7369 "" } +#line 7370 "" goto L4; +#line 7371 "" } +#line 7372 "" } +#line 7373 "" /* L3: */ +#line 7373 "" } - s_wsle(&io___487); +#line 7374 "" + s_wsle(&io___517); +#line 7374 "" do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); +#line 7374 "" e_wsle(); +#line 7375 "" stop1_(); +#line 7376 "" L4: +#line 7377 "" if (nolevs == 0 || nolevs > 60) { /* Ending is on a rest, reset nolevs to default starting height */ +#line 7381 "" nolevs = igetbits_(&isdat2[j], &c__7, &c__19); +#line 7382 "" } +#line 7383 "" if (bit_test(isdat3[isdat],0)) { /* Deal with \curve or \midslur */ +#line 7387 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; /* Remember, only dealing with non-ps slurs */ @@ -10733,309 +17845,528 @@ L4: /* if (slurudq .eq. 'd') imid = -imid */ /* 3/8/03 added the following */ +#line 7396 "" if (*(unsigned char *)slurudq == 'd') { +#line 7396 "" imid = -abs(imid); +#line 7396 "" } +#line 7398 "" if (bit_test(isdat3[isdat],1)) { /* Writing concatenation */ +#line 7399 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7399 "" i__4[0] = 1, a__2[0] = ch__1; +#line 7399 "" i__4[1] = 5, a__2[1] = "curve"; +#line 7399 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7400 "" lnote = 6; +#line 7401 "" } else { /* Writing concatenation */ +#line 7402 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7402 "" i__4[0] = 1, a__2[0] = ch__1; +#line 7402 "" i__4[1] = 7, a__2[1] = "midslur"; +#line 7402 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7403 "" lnote = 8; +#line 7404 "" } +#line 7405 "" if (imid < 0 || imid > 9) { /* Need brackets */ /* Writing concatenation */ +#line 7409 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7409 "" i__4[1] = 1, a__2[1] = "{"; +#line 7409 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7410 "" ++lnote; +#line 7411 "" if (imid < -9) { +#line 7412 "" i__2 = lnote; +#line 7412 "" ici__1.icierr = 0; +#line 7412 "" ici__1.icirnum = 1; +#line 7412 "" ici__1.icirlen = lnote + 3 - i__2; +#line 7412 "" ici__1.iciunit = notexq + i__2; +#line 7412 "" ici__1.icifmt = "(i3)"; +#line 7412 "" s_wsfi(&ici__1); +#line 7412 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 7412 "" e_wsfi(); +#line 7413 "" lnote += 3; +#line 7414 "" } else if (imid < 0 || imid > 9) { +#line 7415 "" i__2 = lnote; +#line 7415 "" ici__1.icierr = 0; +#line 7415 "" ici__1.icirnum = 1; +#line 7415 "" ici__1.icirlen = lnote + 2 - i__2; +#line 7415 "" ici__1.iciunit = notexq + i__2; +#line 7415 "" ici__1.icifmt = "(i2)"; +#line 7415 "" s_wsfi(&ici__1); +#line 7415 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 7415 "" e_wsfi(); +#line 7416 "" lnote += 2; +#line 7417 "" } else { +#line 7418 "" i__2 = lnote; +#line 7418 "" ici__1.icierr = 0; +#line 7418 "" ici__1.icirnum = 1; +#line 7418 "" ici__1.icirlen = lnote + 1 - i__2; +#line 7418 "" ici__1.iciunit = notexq + i__2; +#line 7418 "" ici__1.icifmt = "(i1)"; +#line 7418 "" s_wsfi(&ici__1); +#line 7418 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 7418 "" e_wsfi(); +#line 7419 "" ++lnote; +#line 7420 "" } /* Writing concatenation */ +#line 7421 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7421 "" i__4[1] = 1, a__2[1] = "}"; +#line 7421 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7422 "" ++lnote; +#line 7423 "" } else { /* 1=<imid=<9, no brackets */ /* Writing concatenation */ +#line 7427 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7427 "" *(unsigned char *)&ch__1[0] = imid + 48; +#line 7427 "" i__4[1] = 1, a__2[1] = ch__1; +#line 7427 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7428 "" ++lnote; +#line 7429 "" } +#line 7430 "" if (bit_test(isdat3[isdat],1)) { /* \curve; 3 args */ /* Writing concatenation */ +#line 7434 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7434 "" *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] , &c__3, &c__8) + 48; +#line 7434 "" i__4[1] = 1, a__2[1] = ch__1; +#line 7434 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); /* Writing concatenation */ +#line 7436 "" i__4[0] = lnote + 1, a__2[0] = notexq; +#line 7436 "" *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] , &c__3, &c__11) + 48; +#line 7436 "" i__4[1] = 1, a__2[1] = ch__1; +#line 7436 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7438 "" lnote += 2; +#line 7439 "" } +#line 7440 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen) 80); +#line 7441 "" } /* Shift slur ending for stem on any note? */ +#line 7445 "" if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < 63.f) { +#line 7445 "" ihoff += -8; +#line 7445 "" } +#line 7447 "" if (bit_test(isdat2[isdat],3)) { /* Shift ending for tie spacing */ +#line 7451 "" if (*(unsigned char *)slurudq == 'u') { +#line 7452 "" ihoff += -8; +#line 7453 "" --ivoff; +#line 7454 "" } else if (*(unsigned char *)slurudq == 'd') { +#line 7455 "" ++ivoff; +#line 7456 "" if (stemup || *tno > 63.f) { +#line 7456 "" ihoff += -8; +#line 7456 "" } +#line 7457 "" } +#line 7458 "" } +#line 7459 "" if (iscrd) { /* Shift termination for shifted notehead? */ +#line 7463 "" if (bit_test(isdat2[isdat],1)) { /* Left-shifted chord notehead. ASSUME downstem. */ +#line 7467 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { +#line 7468 "" ihoff += -2; +#line 7469 "" } else { +#line 7470 "" ihoff += -10; +#line 7471 "" } +#line 7472 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ +#line 7476 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { +#line 7477 "" ihoff += 2; +#line 7478 "" } else { +#line 7479 "" ihoff += 10; +#line 7480 "" } +#line 7481 "" } +#line 7482 "" } +#line 7483 "" if (ihoff == 0) { /* Writing concatenation */ +#line 7484 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7484 "" i__4[0] = 1, a__2[0] = ch__1; +#line 7484 "" i__4[1] = 5, a__2[1] = "tslur"; +#line 7484 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7485 "" lnote = 6; +#line 7486 "" } else { /* Shift needed */ /* Writing concatenation */ +#line 7490 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7490 "" i__4[0] = 1, a__2[0] = ch__1; +#line 7490 "" i__4[1] = 2, a__2[1] = "ts"; +#line 7490 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7491 "" lnote = 3; +#line 7492 "" } /* Print 23-ndxslur */ /* 5/25/08 Allow 14 slurs (???????????) */ +#line 7497 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ +#line 7498 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7498 "" i__2 = 71 - comslur_1.ndxslur; +#line 7498 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7498 "" i__4[1] = 1, a__2[1] = ch__1; +#line 7498 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7499 "" ++lnote; +#line 7500 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 7501 "" i__5[0] = lnote, a__3[0] = notexq; +#line 7501 "" i__5[1] = 2, a__3[1] = "{1"; +#line 7501 "" i__2 = 61 - comslur_1.ndxslur; +#line 7501 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7501 "" i__5[2] = 1, a__3[2] = ch__1; +#line 7501 "" i__5[3] = 1, a__3[3] = "}"; +#line 7501 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 7502 "" lnote += 4; +#line 7503 "" } else { /* Writing concatenation */ +#line 7504 "" i__5[0] = lnote, a__3[0] = notexq; +#line 7504 "" i__5[1] = 2, a__3[1] = "{2"; +#line 7504 "" i__2 = 51 - comslur_1.ndxslur; +#line 7504 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7504 "" i__5[2] = 1, a__3[2] = ch__1; +#line 7504 "" i__5[3] = 1, a__3[3] = "}"; +#line 7504 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 7505 "" lnote += 4; +#line 7506 "" } +#line 7507 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ +#line 7511 "" ivoffinc = 0; +#line 7512 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { +#line 7514 "" if (stemup) { +#line 7515 "" ivoffinc = -1; +#line 7516 "" } else { +#line 7517 "" ivoffinc = 1; +#line 7518 "" } +#line 7519 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { +#line 7519 "" ivoffinc <<= 1; +#line 7519 "" } +#line 7522 "" } +#line 7523 "" ivoff += ivoffinc; +#line 7524 "" } +#line 7525 "" if (idcode == 1 && tmove) { /* t-slur height adjustment */ +#line 7529 "" iupdn = 1; +#line 7530 "" if (*(unsigned char *)slurudq == 'd') { +#line 7530 "" iupdn = -1; +#line 7530 "" } +#line 7531 "" } +#line 7532 "" i__2 = nolevs + iupdn + ivoff; +#line 7532 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +#line 7533 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 7535 "" *islhgt = nolevs + iupdn + ivoff; /* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ +#line 7539 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && comsln_1.is1n1 > 0) { +#line 7540 "" if (idcode == comsln_1.is2n1) { +#line 7540 "" comsln_1.is1n1 = 0; +#line 7540 "" } +#line 7541 "" } +#line 7542 "" } /* Writing concatenation */ +#line 7543 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7543 "" i__4[1] = lnoten, a__2[1] = noteq; +#line 7543 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7544 "" lnote += lnoten; +#line 7545 "" if (ihoff != 0) { +#line 7546 "" shift = ihoff * .1f; /* Writing concatenation */ +#line 7547 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7547 "" i__4[1] = 1, a__2[1] = "{"; +#line 7547 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7548 "" ++lnote; +#line 7549 "" lform = lfmt1_(&shift); +#line 7550 "" i__2 = lnote; +#line 7550 "" ici__1.icierr = 0; +#line 7550 "" ici__1.icirnum = 1; +#line 7550 "" ici__1.icirlen = lnote + lform - i__2; +#line 7550 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 7550 "" i__3[0] = 2, a__1[0] = "(f"; +#line 7550 "" i__6 = lform + 48; +#line 7550 "" chax_(ch__1, (ftnlen)1, &i__6); +#line 7550 "" i__3[1] = 1, a__1[1] = ch__1; +#line 7550 "" i__3[2] = 3, a__1[2] = ".1)"; +#line 7550 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) 6), ch__2); +#line 7550 "" s_wsfi(&ici__1); +#line 7550 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 7550 "" e_wsfi(); +#line 7552 "" lnote += lform; /* Writing concatenation */ +#line 7553 "" i__4[0] = lnote, a__2[0] = notexq; +#line 7553 "" i__4[1] = 1, a__2[1] = "}"; +#line 7553 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 7554 "" ++lnote; +#line 7555 "" } +#line 7556 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Clear the bit from list of slurs in use */ +#line 7560 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); /* Zero out the entire strings for start and stop */ +#line 7564 "" isdata = 0; +#line 7565 "" isdat2[isdat] = 0; +#line 7566 "" isdat1[j] = 0; +#line 7567 "" isdat2[j] = 0; +#line 7568 "" isdat3[isdat] = 0; /* Set midi info for slur ending */ +#line 7572 "" if (commidi_1.ismidi && idcode == 32) { +#line 7573 "" icm = commidi_1.midchan[*iv + *kv * 24 - 25]; +#line 7574 "" if (comslm_1.slmon[icm]) { /* if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */ /* 130316 */ /* if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */ +#line 7578 "" if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1] == comslm_1.levson[icm] && (7 & *nacc) == 0) { @@ -11045,42 +18376,73 @@ L4: /* levsoff(icm) = nolevs */ /* 130316 */ /* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */ +#line 7586 "" comslm_1.levsoff[icm] = nolevs + commvel_1.miditran[cominsttrans_1.instno[* iv - 1] - 1]; +#line 7587 "" settie = TRUE_; +#line 7588 "" } else { +#line 7589 "" comslm_1.levsoff[icm] = 0; +#line 7590 "" comslm_1.levson[icm] = 0; +#line 7591 "" comslm_1.slmon[icm] = FALSE_; +#line 7592 "" } +#line 7593 "" } +#line 7594 "" } +#line 7595 "" } +#line 7596 "" isdat1[isdat] = isdata; +#line 7597 "" } +#line 7598 "" /* L1: */ +#line 7598 "" } /* Clear and collapse the slur data list */ +#line 7602 "" numdrop = 0; +#line 7603 "" i__1 = *nsdat; +#line 7603 "" for (isdat = 1; isdat <= i__1; ++isdat) { +#line 7604 "" if (isdat1[isdat] == 0) { +#line 7605 "" ++numdrop; +#line 7606 "" } else if (numdrop > 0) { +#line 7607 "" isdat1[isdat - numdrop] = isdat1[isdat]; +#line 7608 "" isdat2[isdat - numdrop] = isdat2[isdat]; +#line 7609 "" isdat3[isdat - numdrop] = isdat3[isdat]; +#line 7610 "" isdat1[isdat] = 0; +#line 7611 "" isdat2[isdat] = 0; +#line 7612 "" isdat3[isdat] = 0; +#line 7613 "" } +#line 7614 "" /* L2: */ +#line 7614 "" } +#line 7615 "" *nsdat -= numdrop; /* call report(nsdat,isdat1,isdat2) */ +#line 7617 "" return 0; } /* doslur_ */ @@ -11111,57 +18473,102 @@ L4: /* iddot = 0 for single dot, 1 for double */ +#line 7625 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7625 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 7626 "" lfmtup = lfmt1_(updot); +#line 7627 "" lfmtrt = lfmt1_(rtdot); +#line 7628 "" ici__1.icierr = 0; +#line 7628 "" ici__1.icirnum = 1; +#line 7628 "" ici__1.icirlen = 80; +#line 7628 "" ici__1.iciunit = notexq; /* Writing concatenation */ +#line 7628 "" i__1[0] = 6, a__1[0] = "(a37,f"; +#line 7628 "" i__2 = lfmtup + 48; +#line 7628 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7628 "" i__1[1] = 1, a__1[1] = ch__1; +#line 7628 "" i__1[2] = 7, a__1[2] = ".1,a2,f"; +#line 7628 "" i__3 = lfmtrt + 48; +#line 7628 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7628 "" i__1[3] = 1, a__1[3] = ch__3; +#line 7628 "" i__1[4] = 7, a__1[4] = ".1,a15)"; +#line 7628 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2); +#line 7628 "" s_wsfi(&ici__1); /* Writing concatenation */ +#line 7628 "" i__4[0] = 1, a__2[0] = sq; +#line 7628 "" i__4[1] = 12, a__2[1] = "makeatletter"; +#line 7628 "" i__4[2] = 1, a__2[2] = sq; +#line 7628 "" i__4[3] = 3, a__2[3] = "def"; +#line 7628 "" i__4[4] = 1, a__2[4] = sq; +#line 7628 "" i__4[5] = 12, a__2[5] = "C@Point#1#2{"; +#line 7628 "" i__4[6] = 1, a__2[6] = sq; +#line 7628 "" i__4[7] = 6, a__2[7] = "PMXpt{"; +#line 7628 "" s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37); +#line 7628 "" do_fio(&c__1, ch__4, (ftnlen)37); +#line 7628 "" do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real)); +#line 7628 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 7628 "" do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real)); /* Writing concatenation */ +#line 7628 "" i__5[0] = 1, a__3[0] = "}"; +#line 7628 "" i__6 = *iddot + 48; +#line 7628 "" chax_(ch__6, (ftnlen)1, &i__6); +#line 7628 "" i__5[1] = 1, a__3[1] = ch__6; +#line 7628 "" i__5[2] = 1, a__3[2] = "}"; +#line 7628 "" i__5[3] = 1, a__3[3] = sq; +#line 7628 "" i__5[4] = 11, a__3[4] = "makeatother"; +#line 7628 "" s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15); +#line 7628 "" do_fio(&c__1, ch__5, (ftnlen)15); +#line 7628 "" e_wsfi(); /* Example of string just created: */ /* \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */ +#line 7637 "" lnote = lfmtup + 54 + lfmtrt; +#line 7638 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); +#line 7639 "" return 0; } /* dotmov_ */ @@ -11190,92 +18597,165 @@ L4: static logical tronly; /* Fortran I/O blocks */ - static cilist io___497 = { 0, 6, 0, 0, 0 }; + static cilist io___527 = { 0, 6, 0, 0, 0 }; +#line 7649 "" i__1 = comtrill_1.ntrill; +#line 7649 "" for (itr = 1; itr <= i__1; ++itr) { +#line 7650 "" if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[ itr - 1]) { +#line 7650 "" goto L2; +#line 7650 "" } +#line 7651 "" /* L1: */ +#line 7651 "" } - s_wsle(&io___497); +#line 7652 "" + s_wsle(&io___527); +#line 7652 "" do_lio(&c__9, &c__1, "Problem in dotrill. Call Dr. Don", (ftnlen)33); +#line 7652 "" e_wsle(); +#line 7653 "" s_stop("", (ftnlen)0); +#line 7654 "" L2: +#line 7655 "" tronly = comtrill_1.xnsktr[itr - 1] < .01f; +#line 7656 "" if (tronly) { /* Writing concatenation */ +#line 7657 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7657 "" i__2[0] = 1, a__1[0] = ch__1; +#line 7657 "" i__2[1] = 9, a__1[1] = "zcharnote"; +#line 7657 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 7658 "" *lnote = 10; +#line 7659 "" } else if (bit_test(*iornq,7)) { /* Writing concatenation */ +#line 7660 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7660 "" i__2[0] = 1, a__1[0] = ch__1; +#line 7660 "" i__2[1] = 6, a__1[1] = "Trille"; +#line 7660 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 7661 "" *lnote = 7; +#line 7662 "" } else { /* Writing concatenation */ +#line 7663 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7663 "" i__2[0] = 1, a__1[0] = ch__1; +#line 7663 "" i__2[1] = 6, a__1[1] = "trille"; +#line 7663 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 7664 "" *lnote = 7; +#line 7665 "" } /* Writing concatenation */ +#line 7666 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 7666 "" i__3[1] = *lnoten, a__2[1] = noteq; +#line 7666 "" i__3[2] = 1, a__2[2] = "{"; +#line 7666 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 7667 "" *lnote = *lnote + *lnoten + 1; /* Write trill duration to nearest tenth of a noteskip */ +#line 7671 "" if (tronly) { /* Writing concatenation */ +#line 7672 "" i__3[0] = *lnote, a__2[0] = notexq; +#line 7672 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7672 "" i__3[1] = 1, a__2[1] = ch__1; +#line 7672 "" i__3[2] = 6, a__2[2] = "it tr}"; +#line 7672 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 7673 "" *lnote += 7; +#line 7674 "" return 0; +#line 7675 "" } +#line 7676 "" if (comtrill_1.xnsktr[itr - 1] < .95f) { +#line 7677 "" nfmt = 2; +#line 7678 "" } else if (comtrill_1.xnsktr[itr - 1] < 9.95f) { +#line 7679 "" nfmt = 3; +#line 7680 "" } else { +#line 7681 "" nfmt = 4; +#line 7682 "" } +#line 7683 "" i__1 = *lnote; +#line 7683 "" ici__1.icierr = 0; +#line 7683 "" ici__1.icirnum = 1; +#line 7683 "" ici__1.icirlen = *lnote + nfmt - i__1; +#line 7683 "" ici__1.iciunit = notexq + i__1; /* Writing concatenation */ +#line 7683 "" i__3[0] = 2, a__2[0] = "(f"; +#line 7683 "" i__4 = nfmt + 48; +#line 7683 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 7683 "" i__3[1] = 1, a__2[1] = ch__1; +#line 7683 "" i__3[2] = 3, a__2[2] = ".1)"; +#line 7683 "" ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2); +#line 7683 "" s_wsfi(&ici__1); +#line 7683 "" do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real)); +#line 7683 "" e_wsfi(); +#line 7685 "" *lnote += nfmt; /* Writing concatenation */ +#line 7686 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 7686 "" i__2[1] = 1, a__1[1] = "}"; +#line 7686 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 7687 "" ++(*lnote); +#line 7688 "" return 0; } /* dotrill_ */ @@ -11305,27 +18785,41 @@ L2: /* Only called to end slur started in dograce. */ +#line 7700 "" shift = ! (*stemup) && ! (*upslur); +#line 7701 "" if (! shift) { /* No shift needed */ /* Writing concatenation */ +#line 7705 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7705 "" i__1[0] = 1, a__1[0] = ch__1; +#line 7705 "" i__1[1] = 5, a__1[1] = "tslur"; +#line 7705 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7706 "" lnote = 6; +#line 7707 "" } else { /* Shift needed */ /* Writing concatenation */ +#line 7711 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 7711 "" i__1[0] = 1, a__1[0] = ch__1; +#line 7711 "" i__1[1] = 2, a__1[1] = "ts"; +#line 7711 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7712 "" lnote = 3; +#line 7713 "" } /* if (ndxslur .lt. 10) then */ /* notexq = notexq(1:lnote)//chax(48+ndxslur) */ @@ -11339,59 +18833,105 @@ L2: /* Print 23-ndxslur */ /* if (11-ndxslur .lt. 10) then */ +#line 7726 "" if (23 - *ndxslur < 10) { /* notexq = notexq(1:lnote)//chax(59-ndxslur) */ /* Writing concatenation */ +#line 7728 "" i__1[0] = lnote, a__1[0] = notexq; +#line 7728 "" i__2 = 71 - *ndxslur; +#line 7728 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7728 "" i__1[1] = 1, a__1[1] = ch__1; +#line 7728 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7729 "" ++lnote; +#line 7730 "" } else if (23 - *ndxslur < 20) { /* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ /* Writing concatenation */ +#line 7732 "" i__3[0] = lnote, a__2[0] = notexq; +#line 7732 "" i__3[1] = 2, a__2[1] = "{1"; +#line 7732 "" i__2 = 61 - *ndxslur; +#line 7732 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7732 "" i__3[2] = 1, a__2[2] = ch__1; +#line 7732 "" i__3[3] = 1, a__2[3] = "}"; +#line 7732 "" s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); +#line 7733 "" lnote += 4; +#line 7734 "" } else { /* Writing concatenation */ +#line 7735 "" i__3[0] = lnote, a__2[0] = notexq; +#line 7735 "" i__3[1] = 2, a__2[1] = "{2"; +#line 7735 "" i__2 = 51 - *ndxslur; +#line 7735 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 7735 "" i__3[2] = 1, a__2[2] = ch__1; +#line 7735 "" i__3[3] = 1, a__2[3] = "}"; +#line 7735 "" s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); +#line 7736 "" lnote += 4; +#line 7737 "" } +#line 7738 "" i__2 = *nolev + *iupdn + *ivoff; +#line 7738 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); /* Writing concatenation */ +#line 7739 "" i__1[0] = lnote, a__1[0] = notexq; +#line 7739 "" i__1[1] = lnoten, a__1[1] = noteq; +#line 7739 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7740 "" lnote += lnoten; +#line 7741 "" if (shift) { +#line 7742 "" if (*fontslur) { /* Writing concatenation */ +#line 7743 "" i__1[0] = lnote, a__1[0] = notexq; +#line 7743 "" i__1[1] = 5, a__1[1] = "{-.6}"; +#line 7743 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7744 "" } else { /* Writing concatenation */ +#line 7745 "" i__1[0] = lnote, a__1[0] = notexq; +#line 7745 "" i__1[1] = 5, a__1[1] = "{-.8}"; +#line 7745 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 7746 "" } +#line 7747 "" lnote += 5; +#line 7748 "" } +#line 7749 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 7750 "" return 0; } /* endslur_ */ @@ -11426,27 +18966,40 @@ L2: static integer ibarnop; /* Fortran I/O blocks */ - static cilist io___507 = { 0, 6, 0, 0, 0 }; - static cilist io___510 = { 0, 19, 0, "(i6)", 0 }; - static cilist io___514 = { 0, 6, 0, "(1x,a)", 0 }; - static cilist io___515 = { 0, 15, 0, "(a)", 0 }; - static cilist io___518 = { 0, 6, 0, 0, 0 }; - static cilist io___519 = { 0, 15, 0, "(a)", 0 }; + static cilist io___537 = { 0, 6, 0, 0, 0 }; + static cilist io___540 = { 0, 19, 0, "(i6)", 0 }; + static cilist io___544 = { 0, 6, 0, "(1x,a)", 0 }; + static cilist io___545 = { 0, 15, 0, "(a)", 0 }; + static cilist io___548 = { 0, 6, 0, 0, 0 }; + static cilist io___549 = { 0, 15, 0, "(a)", 0 }; +#line 7762 "" if (*iccount <= 78) { +#line 7763 "" s_copy(outq, lineq, (ftnlen)78, (ftnlen)78); +#line 7764 "" iposn = *iccount; +#line 7765 "" } else { /* Writing concatenation */ +#line 7766 "" i__1[0] = 4, a__1[0] = "... "; +#line 7766 "" i__1[1] = 74, a__1[1] = lineq + 54; +#line 7766 "" s_cat(outq, a__1, i__1, &c__2, (ftnlen)78); +#line 7767 "" iposn = *iccount - 50; +#line 7768 "" } - s_wsle(&io___507); +#line 7769 "" + s_wsle(&io___537); +#line 7769 "" e_wsle(); +#line 7770 "" ibarnop = *ibarno; +#line 7771 "" if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline > c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) { @@ -11454,160 +19007,299 @@ L2: /* nlinep = nline-linesinpmxmod */ /* Correct for comments not copied into buffer */ +#line 7778 "" nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] - c1omget_1.linesinpmxmod; +#line 7779 "" } else { /* Error is in include file */ +#line 7783 "" ibarnop = 0; +#line 7784 "" nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1; +#line 7785 "" printl_("ERROR in include file named above, description given below", (ftnlen)58); +#line 7787 "" } +#line 7788 "" o__1.oerr = 0; +#line 7788 "" o__1.ounit = 19; +#line 7788 "" o__1.ofnmlen = 11; +#line 7788 "" o__1.ofnm = "pmxaerr.dat"; +#line 7788 "" o__1.orl = 0; +#line 7788 "" o__1.osta = 0; +#line 7788 "" o__1.oacc = 0; +#line 7788 "" o__1.ofm = 0; +#line 7788 "" o__1.oblnk = 0; +#line 7788 "" f_open(&o__1); - s_wsfe(&io___510); +#line 7789 "" + s_wsfe(&io___540); +#line 7789 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7789 "" e_wsfe(); +#line 7790 "" cl__1.cerr = 0; +#line 7790 "" cl__1.cunit = 19; +#line 7790 "" cl__1.csta = 0; +#line 7790 "" f_clos(&cl__1); /* Computing MAX */ +#line 7791 "" r__1 = ibarnop + .1f; +#line 7791 "" i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1); +#line 7791 "" ndigbn = max(i__2,i__3); +#line 7792 "" r__1 = nlinep + .1f; +#line 7792 "" ndignl = (integer) (r_lg10(&r__1) + 1); +#line 7793 "" lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1; /* Split off msgq(..) since UNIX compilers don't allow concat substring!!! */ +#line 7797 "" ci__1.cierr = 0; +#line 7797 "" ci__1.ciunit = 6; /* Writing concatenation */ +#line 7797 "" i__4[0] = 8, a__2[0] = "(/,a15,i"; +#line 7797 "" i__2 = ndignl + 48; +#line 7797 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7797 "" i__4[1] = 1, a__2[1] = ch__2; +#line 7797 "" i__4[2] = 5, a__2[2] = ",a6,i"; +#line 7797 "" i__3 = ndigbn + 48; +#line 7797 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7797 "" i__4[3] = 1, a__2[3] = ch__3; +#line 7797 "" i__4[4] = 3, a__2[4] = ",$)"; +#line 7797 "" ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); +#line 7797 "" s_wsfe(&ci__1); +#line 7797 "" do_fio(&c__1, " ERROR in line ", (ftnlen)15); +#line 7797 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7797 "" do_fio(&c__1, ", bar ", (ftnlen)6); +#line 7797 "" do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); +#line 7797 "" e_wsfe(); - s_wsfe(&io___514); +#line 7799 "" + s_wsfe(&io___544); +#line 7799 "" do_fio(&c__1, msgq, lenmsg); +#line 7799 "" e_wsfe(); +#line 7800 "" ci__1.cierr = 0; +#line 7800 "" ci__1.ciunit = 15; /* Writing concatenation */ +#line 7800 "" i__4[0] = 8, a__2[0] = "(/,a15,i"; +#line 7800 "" i__2 = ndignl + 48; +#line 7800 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7800 "" i__4[1] = 1, a__2[1] = ch__2; +#line 7800 "" i__4[2] = 5, a__2[2] = ",a6,i"; +#line 7800 "" i__3 = ndigbn + 48; +#line 7800 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7800 "" i__4[3] = 1, a__2[3] = ch__3; +#line 7800 "" i__4[4] = 3, a__2[4] = ",$)"; +#line 7800 "" ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); +#line 7800 "" s_wsfe(&ci__1); +#line 7800 "" do_fio(&c__1, " ERROR in line ", (ftnlen)15); +#line 7800 "" do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7800 "" do_fio(&c__1, ", bar ", (ftnlen)6); +#line 7800 "" do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); +#line 7800 "" e_wsfe(); - s_wsfe(&io___515); +#line 7802 "" + s_wsfe(&io___545); +#line 7802 "" do_fio(&c__1, msgq, lenmsg); +#line 7802 "" e_wsfe(); +#line 7803 "" i10 = iposn / 10; +#line 7804 "" i1 = iposn - i10 * 10; +#line 7805 "" ci__1.cierr = 0; +#line 7805 "" ci__1.ciunit = 6; /* Writing concatenation */ +#line 7805 "" i__5[0] = 1, a__3[0] = "("; +#line 7805 "" i__2 = i10 + 48; +#line 7805 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7805 "" i__5[1] = 1, a__3[1] = ch__2; +#line 7805 "" i__3 = i1 + 48; +#line 7805 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7805 "" i__5[2] = 1, a__3[2] = ch__3; +#line 7805 "" i__5[3] = 4, a__3[3] = "x,a)"; +#line 7805 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7805 "" s_wsfe(&ci__1); +#line 7805 "" do_fio(&c__1, "v", (ftnlen)1); +#line 7805 "" e_wsfe(); +#line 7806 "" ci__1.cierr = 0; +#line 7806 "" ci__1.ciunit = 15; /* Writing concatenation */ +#line 7806 "" i__5[0] = 1, a__3[0] = "("; +#line 7806 "" i__2 = i10 + 48; +#line 7806 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7806 "" i__5[1] = 1, a__3[1] = ch__2; +#line 7806 "" i__3 = i1 + 48; +#line 7806 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7806 "" i__5[2] = 1, a__3[2] = ch__3; +#line 7806 "" i__5[3] = 4, a__3[3] = "x,a)"; +#line 7806 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7806 "" s_wsfe(&ci__1); +#line 7806 "" do_fio(&c__1, "v", (ftnlen)1); +#line 7806 "" e_wsfe(); - s_wsle(&io___518); +#line 7807 "" + s_wsle(&io___548); +#line 7807 "" do_lio(&c__9, &c__1, outq, (ftnlen)78); +#line 7807 "" e_wsle(); - s_wsfe(&io___519); +#line 7808 "" + s_wsfe(&io___549); /* Writing concatenation */ +#line 7808 "" i__1[0] = 1, a__1[0] = " "; +#line 7808 "" i__1[1] = 78, a__1[1] = outq; +#line 7808 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79); +#line 7808 "" do_fio(&c__1, ch__5, (ftnlen)79); +#line 7808 "" e_wsfe(); +#line 7809 "" ci__1.cierr = 0; +#line 7809 "" ci__1.ciunit = 6; /* Writing concatenation */ +#line 7809 "" i__5[0] = 1, a__3[0] = "("; +#line 7809 "" i__2 = i10 + 48; +#line 7809 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7809 "" i__5[1] = 1, a__3[1] = ch__2; +#line 7809 "" i__3 = i1 + 48; +#line 7809 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7809 "" i__5[2] = 1, a__3[2] = ch__3; +#line 7809 "" i__5[3] = 4, a__3[3] = "x,a)"; +#line 7809 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7809 "" s_wsfe(&ci__1); +#line 7809 "" do_fio(&c__1, "^", (ftnlen)1); +#line 7809 "" e_wsfe(); +#line 7810 "" ci__1.cierr = 0; +#line 7810 "" ci__1.ciunit = 15; /* Writing concatenation */ +#line 7810 "" i__5[0] = 1, a__3[0] = "("; +#line 7810 "" i__2 = i10 + 48; +#line 7810 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 7810 "" i__5[1] = 1, a__3[1] = ch__2; +#line 7810 "" i__3 = i1 + 48; +#line 7810 "" chax_(ch__3, (ftnlen)1, &i__3); +#line 7810 "" i__5[2] = 1, a__3[2] = ch__3; +#line 7810 "" i__5[3] = 4, a__3[3] = "x,a)"; +#line 7810 "" ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7810 "" s_wsfe(&ci__1); +#line 7810 "" do_fio(&c__1, "^", (ftnlen)1); +#line 7810 "" e_wsfe(); +#line 7811 "" return 0; } /* errmsg_ */ @@ -11628,50 +19320,82 @@ L2: static integer itnd, nnsk, itprev; /* Fortran I/O blocks */ - static cilist io___524 = { 0, 6, 0, 0, 0 }; + static cilist io___554 = { 0, 6, 0, 0, 0 }; /* Get elemskips to previous note. Called only for graces, no xtups involved. */ +#line 7831 "" /* Parameter adjustments */ +#line 7831 "" --tstart; +#line 7831 "" --space; +#line 7831 "" +#line 7831 "" /* Function Body */ +#line 7831 "" itnd = i_nint(&all_1.to[*in - 1]); +#line 7832 "" if (*ip == 1 || itnd == *itrpt) { /* Start of bar or after rpt. */ +#line 7836 "" *esk = *fbar; +#line 7837 "" return 0; +#line 7838 "" } else { +#line 7839 "" *esk = 0.f; +#line 7840 "" itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25]; +#line 7841 "" for (iib = *ib; iib >= 1; --iib) { +#line 7842 "" if (tstart[iib] < itprev + comtol_1.tol) { /* This is the block */ +#line 7846 "" r__1 = (real) (itnd - itprev) / space[iib]; +#line 7846 "" nnsk = i_nint(&r__1); +#line 7847 "" *esk += nnsk * feon_(&space[iib]); +#line 7848 "" return 0; +#line 7849 "" } else { +#line 7850 "" r__1 = (itnd - tstart[iib]) / space[iib]; +#line 7850 "" nnsk = i_nint(&r__1); +#line 7851 "" *esk += nnsk * feon_(&space[iib]); +#line 7852 "" itnd = i_nint(&tstart[iib]); +#line 7853 "" } +#line 7854 "" /* L1: */ +#line 7854 "" } +#line 7855 "" } - s_wsle(&io___524); +#line 7856 "" + s_wsle(&io___554); +#line 7856 "" do_lio(&c__9, &c__1, "Problem in eskb4. Send files to Dr. Don", (ftnlen) 40); +#line 7856 "" e_wsle(); +#line 7857 "" s_stop("", (ftnlen)0); +#line 7858 "" return 0; } /* eskb4_ */ @@ -11683,7 +19407,9 @@ doublereal f1eon_(real *time) /* Builtin functions */ double sqrt(doublereal); +#line 7860 "" ret_val = sqrt(*time / 2); +#line 7861 "" return ret_val; } /* f1eon_ */ @@ -11696,9 +19422,13 @@ doublereal feon_(real *time) /* Builtin functions */ double sqrt(doublereal), pow_dd(doublereal *, doublereal *); +#line 7865 "" d__1 = (doublereal) sqrt(*time / 2); +#line 7865 "" d__2 = (doublereal) (1.f - comeon_1.eonk); +#line 7865 "" ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk; +#line 7866 "" return ret_val; } /* feon_ */ @@ -11771,7 +19501,7 @@ doublereal feon_(real *time) static integer masknow; /* Fortran I/O blocks */ - static cilist io___558 = { 0, 6, 0, 0, 0 }; + static cilist io___588 = { 0, 6, 0, 0, 0 }; @@ -11780,256 +19510,425 @@ doublereal feon_(real *time) /* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */ /* * itr(48),nodue(48) */ /* logical short(48),eqonly */ +#line 7896 "" /* Parameter adjustments */ +#line 7896 "" --mapfb; +#line 7896 "" --numbms; +#line 7896 "" +#line 7896 "" /* Function Body */ +#line 7917 "" ip = 0; +#line 7918 "" nreal = 0; +#line 7919 "" itnow = 0; +#line 7920 "" L1: +#line 7921 "" ++ip; +#line 7922 "" if (ip > all_1.nn[commvl_1.ivx - 1]) { +#line 7922 "" goto L9; +#line 7922 "" } +#line 7923 "" L11: +#line 7923 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* Ignore all xtup notes except the last, the one with nodur > 0 . */ /* Xtups are irrelevant here since they are already all in forced beams. */ /* Will update itnow by nodur at the END of this loop */ +#line 7929 "" ++ip; +#line 7930 "" goto L11; +#line 7931 "" } +#line 7932 "" ++nreal; +#line 7933 "" nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 7934 "" short__[nreal - 1] = nodue[nreal - 1] < 16 && ! bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(all_1.islur[ commvl_1.ivx + ip * 24 - 25],18); /* Rule out notes that have 'alone'-flag set */ +#line 7940 "" ipr[nreal - 1] = ip; +#line 7941 "" itr[nreal - 1] = itnow; +#line 7942 "" if (nodue[nreal - 1] == 1) { /* 64th gap */ +#line 7946 "" if (itnow % 2 == 0) { /* Start of 32nd gap, lump with following note */ +#line 7950 "" ++ip; +#line 7951 "" nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1; +#line 7952 "" itnow += nodue[nreal - 1]; +#line 7953 "" } else { /* End of 32nd gap, lump with preceeding note */ +#line 7957 "" --nreal; +#line 7958 "" ++nodue[nreal - 1]; +#line 7959 "" ++itnow; +#line 7960 "" } +#line 7961 "" } else { +#line 7962 "" itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 7963 "" } +#line 7964 "" goto L1; +#line 7965 "" L9: +#line 7966 "" ir1 = 1; +#line 7967 "" itseg = all_1.lenbar / *ibmrep; +#line 7968 "" i__1 = *ibmrep; +#line 7968 "" for (irep = 1; irep <= i__1; ++irep) { /* Set bitmaps for all shorts neighbored by a short. Each bit represents a */ /* span of 32nd note. maps, mapm, mape record start, full duration, and end */ /* of consecutive span of beamable (<1/4) notes. */ +#line 7974 "" maps = 0; +#line 7975 "" mapm = 0; +#line 7976 "" mape = 0; +#line 7977 "" itend = itseg * irep; +#line 7978 "" itoff = itend - itseg; +#line 7979 "" i__2 = nreal; +#line 7979 "" for (ir = ir1; ir <= i__2; ++ir) { +#line 7980 "" it2 = itr[ir - 1] + nodue[ir - 1] - 2; +#line 7981 "" if (it2 >= itend) { +#line 7982 "" ir1 = ir; +#line 7983 "" goto L14; +#line 7984 "" } /* if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */ /* Computing MAX */ +#line 7986 "" i__3 = ir - 1; +#line 7986 "" if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir < nreal && short__[ir])) { +#line 7988 "" ib1 = (itr[ir - 1] - itoff) / 2; +#line 7989 "" ib2 = (it2 - itoff) / 2; +#line 7990 "" if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) { +#line 7990 "" return 0; +#line 7990 "" } /* Must have an odd number obe beats in a long bar. Auto-beam won't work */ +#line 7995 "" nip1[ib1] = ipr[ir - 1]; +#line 7996 "" nip2[ib2] = ipr[ir - 1]; /* nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */ +#line 8000 "" maps = bit_set(maps,ib1); +#line 8001 "" mape = bit_set(mape,ib2); +#line 8002 "" i__3 = ib2; +#line 8002 "" for (ib = ib1; ib <= i__3; ++ib) { +#line 8003 "" mapm = bit_set(mapm,ib); +#line 8004 "" /* L3: */ +#line 8004 "" } +#line 8005 "" } +#line 8006 "" /* L2: */ +#line 8006 "" } +#line 8007 "" L14: +#line 8008 "" if (mapm == 0) { +#line 8008 "" goto L13; +#line 8008 "" } /* Zero out bits from forced beams */ +#line 8012 "" maps &= ~ mapfb[irep]; +#line 8013 "" mapm &= ~ mapfb[irep]; +#line 8014 "" mape &= ~ mapfb[irep]; /* Compare map with template. */ +#line 8018 "" i__2 = nummask[combeam_1.ibmtyp - 1]; +#line 8018 "" for (it = 1; it <= i__2; ++it) { +#line 8019 "" masknow = mask[it + combeam_1.ibmtyp * 49 - 50]; +#line 8020 "" if ((masknow & mapm) == masknow) { /* Find least significant bit in the mask to check start time */ +#line 8024 "" mtemp = masknow; +#line 8025 "" maskm = masknow; +#line 8026 "" for (is1 = 0; is1 <= 47; ++is1) { +#line 8027 "" if ((1 & mtemp) == 1) { +#line 8027 "" goto L6; +#line 8027 "" } +#line 8028 "" mtemp = lbit_shift(mtemp, (ftnlen)-1); +#line 8029 "" /* L5: */ +#line 8029 "" } +#line 8030 "" L6: +#line 8031 "" if ((lbit_shift((ftnlen)1, is1) & maps) == 0) { +#line 8031 "" goto L4; +#line 8031 "" } /* is1 is the bit where the beam starts. Continue shifting to */ /* find most significant bit in the mask to check ending time */ +#line 8036 "" for (is2 = is1; is2 <= 47; ++is2) { +#line 8037 "" mtemp = lbit_shift(mtemp, (ftnlen)-1); +#line 8038 "" if ((1 & ~ mtemp) == 1) { +#line 8038 "" goto L8; +#line 8038 "" } +#line 8039 "" /* L7: */ +#line 8039 "" } +#line 8040 "" L8: /* is2 is now the bit on which the beam ends. */ +#line 8044 "" if ((lbit_shift((ftnlen)1, is2) & mape) == 0) { +#line 8044 "" goto L4; +#line 8044 "" } /* Did we pick out a single note from the middle of a longer sequence? */ +#line 8048 "" if (nip1[is1] == nip2[is2]) { +#line 8048 "" goto L4; +#line 8048 "" } /* We almost have a beam. Check equality of notes if needed. */ +#line 8052 "" if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) { +#line 8053 "" i__3 = nip2[is2]; +#line 8053 "" for (ip = nip1[is1]; ip <= i__3; ++ip) { +#line 8054 "" if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] != 8) { /* There is a non-1/8th note in this beam. Exit if not 2 quarters */ +#line 8058 "" if (is2 - is1 != 15) { +#line 8058 "" goto L4; +#line 8058 "" } /* Beam is 2 quarters long. Check if can split in half. */ +#line 8062 "" ithalf = 0; +#line 8063 "" i__4 = nip2[is2]; +#line 8063 "" for (iip = nip1[is1]; iip <= i__4; ++iip) { +#line 8064 "" ithalf += all_1.nodur[commvl_1.ivx + iip * 24 - 25]; +#line 8065 "" if (ithalf > 16) { +#line 8065 "" goto L4; +#line 8065 "" } +#line 8066 "" if (ithalf == 16) { +#line 8066 "" goto L21; +#line 8066 "" } +#line 8067 "" /* L20: */ +#line 8067 "" } - s_wsle(&io___558); - do_lio(&c__9, &c__1, "Problem in findbeam, pleas" +#line 8068 "" + s_wsle(&io___588); +#line 8068 "" + do_lio(&c__9, &c__1, "Problem in findbeam, pleas"\ "e call Dr. Don", (ftnlen)40); +#line 8068 "" e_wsle(); +#line 8069 "" goto L4; +#line 8070 "" L21: /* Otherwise, split in half by keeping only the first half. Other half will */ /* be picked up later, assuming masks are listed longest first. */ +#line 8075 "" is2 = is1 + 7; /* Reset maskm (since only used part of mask), used later to zero out */ /* bits that contain beams */ +#line 8080 "" maskm = 0; +#line 8081 "" i__4 = is2; +#line 8081 "" for (is = is1; is <= i__4; ++is) { +#line 8082 "" maskm = bit_set(maskm,is); +#line 8083 "" /* L15: */ +#line 8083 "" } +#line 8084 "" goto L16; +#line 8085 "" } +#line 8086 "" /* L10: */ +#line 8086 "" } +#line 8087 "" } +#line 8088 "" L16: /* This is a beam. If last "effective" ends on odd 64th, add 1 more */ /* if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) */ /* * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then */ +#line 8094 "" r__2 = all_1.to[comipl2_1.ipl2[commvl_1.ivx + nip2[is2] * 24 - 25] - 1] + all_1.nodur[commvl_1.ivx + nip2[is2] * 24 - 25] + comtol_1.tol * .5f; - if ((r__1 = r_mod(&r__2, &c_b1655), dabs(r__1)) > +#line 8094 "" + if ((r__1 = r_mod(&r__2, &c_b1902), dabs(r__1)) > comtol_1.tol) { +#line 8096 "" ++nip2[is2]; +#line 8097 "" } +#line 8098 "" ++numbms[commvl_1.ivx]; +#line 8099 "" numnew = numbms[commvl_1.ivx]; +#line 8100 "" logbeam_(&numnew, &nip1[is1], &nip2[is2]); /* Zero out the appropriate bits so these notes don't get used again */ +#line 8104 "" mapm &= ~ maskm; +#line 8105 "" if (mapm == 0) { +#line 8105 "" goto L13; +#line 8105 "" } +#line 8106 "" maps &= ~ maskm; +#line 8107 "" mape &= ~ maskm; +#line 8108 "" } +#line 8109 "" L4: +#line 8109 "" ; +#line 8109 "" } +#line 8110 "" L13: +#line 8110 "" ; +#line 8110 "" } +#line 8111 "" return 0; } /* findbeam_ */ @@ -12062,48 +19961,83 @@ L13: /* logical gotclef */ /* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +#line 8126 "" comeon_1.eonk = *eonk0; +#line 8127 "" niter = 0; +#line 8128 "" L1: +#line 8129 "" d__1 = (doublereal) f1eon_(dtmax); +#line 8129 "" d__2 = (doublereal) comeon_1.eonk; +#line 8129 "" comeon_1.ewmxk = pow_dd(&d__1, &d__2); +#line 8130 "" ++niter; +#line 8131 "" esum = 0.f; +#line 8132 "" desum = 0.f; +#line 8133 "" i__1 = *nptr2; +#line 8133 "" for (iptr = *nptr1; iptr <= i__1; ++iptr) { +#line 8134 "" targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]; +#line 8135 "" esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * feon_(&targ); +#line 8136 "" d__1 = (doublereal) (*dtmax / targ); +#line 8136 "" d__2 = (doublereal) comeon_1.eonk; +#line 8136 "" detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ); +#line 8137 "" desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * detarg; +#line 8138 "" /* L2: */ +#line 8138 "" } +#line 8139 "" f = *wovera * feon_(dtmin) - *xelsk - esum; +#line 8140 "" d__1 = (doublereal) (*dtmax / *dtmin); +#line 8140 "" d__2 = (doublereal) comeon_1.eonk; +#line 8140 "" fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / * dtmin) - desum; +#line 8142 "" if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) > .5f || niter > 100) { +#line 8143 "" printl_("Error in findeonk. Please send source to Dr. Don", (ftnlen) 49); +#line 8145 "" comeon_1.eonk = 0.f; +#line 8146 "" comeon_1.ewmxk = 1.f; +#line 8147 "" return 0; +#line 8148 "" } +#line 8149 "" dsoln = -f / fp; +#line 8150 "" if (dabs(dsoln) < comtol_1.tol * .1f) { +#line 8150 "" return 0; +#line 8150 "" } /* Not converged yet, try again */ +#line 8154 "" comeon_1.eonk += dsoln; +#line 8155 "" goto L1; } /* findeonk_ */ @@ -12123,80 +20057,143 @@ doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc) extern /* Subroutine */ int printl_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___574 = { 0, 6, 0, 0, 0 }; + static cilist io___604 = { 0, 6, 0, 0, 0 }; + static cilist io___605 = { 0, 6, 0, 0, 0 }; /* This return the real duration of a note */ +#line 8164 "" /* Parameter adjustments */ +#line 8164 "" nacc -= 25; +#line 8164 "" nodur -= 25; +#line 8164 "" +#line 8164 "" /* Function Body */ +#line 8164 "" ipback = *ip; +#line 8165 "" if (nodur[*ivx + *ip * 24] > 0) { +#line 8166 "" if (*ip > 1) { /* Check if this is last note of xtup */ +#line 8170 "" if (nodur[*ivx + (*ip - 1) * 24] == 0) { +#line 8171 "" ipback = *ip - 1; +#line 8172 "" goto L2; +#line 8173 "" } +#line 8174 "" } +#line 8175 "" ret_val = (real) nodur[*ivx + *ip * 24]; +#line 8176 "" return ret_val; +#line 8177 "" } +#line 8178 "" L2: /* Count back to prior non zero note. Start at ip to avoid neg index if ip=1. */ /* Count how many doubled xtups notes there are from ip-1 to first note. */ +#line 8183 "" ndoub = 0; +#line 8184 "" for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) { +#line 8185 "" if (nodur[*ivx + ip1m1 * 24] > 0) { +#line 8185 "" goto L4; +#line 8185 "" } +#line 8186 "" if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) { +#line 8186 "" ++ndoub; +#line 8186 "" } +#line 8187 "" /* L1: */ +#line 8187 "" } +#line 8188 "" L4: /* count forward to next non-0 nodur. Start at ip in case last note of xtup. */ +#line 8192 "" for (iip = *ip; iip <= 200; ++iip) { /* Count doubled xtup notes from ip to end. */ +#line 8196 "" if (bit_test(nacc[*ivx + iip * 24],18)) { +#line 8196 "" ++ndoub; +#line 8196 "" } +#line 8197 "" if (nodur[*ivx + iip * 24] > 0) { /* fnote = nodur(ivx,iip)/float(iip-ip1m1) */ +#line 8199 "" ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub); +#line 8200 "" if (bit_test(nacc[*ivx + *ip * 24],18)) { +#line 8201 "" ret_val *= 2; +#line 8202 "" } else if (bit_test(nacc[*ivx + *ip * 24],27)) { +#line 8203 "" ret_val *= 1.5f; +#line 8204 "" } else if (*ip > 1) { +#line 8205 "" if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) { +#line 8205 "" ret_val *= .5f; +#line 8205 "" } +#line 8206 "" } +#line 8207 "" return ret_val; +#line 8208 "" } +#line 8209 "" /* L3: */ +#line 8209 "" } - s_wsle(&io___574); +#line 8210 "" + s_wsle(&io___604); +#line 8210 "" do_lio(&c__9, &c__1, " ", (ftnlen)1); +#line 8210 "" e_wsle(); +#line 8211 "" printl_("Probable misplaced barline or incorrect meter, stopping", ( ftnlen)55); -/* call printl('Program error in fnote, send source to Dr. Don') */ +#line 8213 "" + s_wsle(&io___605); +#line 8213 "" + do_lio(&c__9, &c__1, "ivx,ip:", (ftnlen)7); +#line 8213 "" + do_lio(&c__3, &c__1, (char *)&(*ivx), (ftnlen)sizeof(integer)); +#line 8213 "" + do_lio(&c__3, &c__1, (char *)&(*ip), (ftnlen)sizeof(integer)); +#line 8213 "" + e_wsle(); +#line 8214 "" stop1_(); +#line 8215 "" return ret_val; } /* fnote_ */ @@ -12217,28 +20214,50 @@ L4: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ +#line 8229 "" if (*iccount == 128) { +#line 8230 "" read10_(lineq, &c1omget_1.lastchar, (ftnlen)128); +#line 8231 "" if (c1omget_1.lastchar) { +#line 8231 "" return 0; +#line 8231 "" } +#line 8232 "" if (! commac_1.endmac) { +#line 8233 "" *iccount = 0; +#line 8234 "" if (! commac_1.mplay) { +#line 8234 "" ++c1omget_1.nline; +#line 8234 "" } +#line 8235 "" } else { +#line 8236 "" commac_1.endmac = FALSE_; +#line 8237 "" *iccount = commac_1.icchold; +#line 8238 "" s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); +#line 8239 "" } +#line 8240 "" if (commac_1.mrecord) { +#line 8241 "" m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, ( ftnlen)128); +#line 8242 "" } +#line 8243 "" } +#line 8244 "" ++(*iccount); +#line 8245 "" *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; +#line 8246 "" return 0; } /* g1etchar_ */ @@ -12260,7 +20279,7 @@ L4: address a__1[3], a__2[2], a__3[4]; integer i__1, i__2[3], i__3[2], i__4, i__5, i__6, i__7, i__8[4]; real r__1; - char ch__1[42], ch__2[1], ch__3[55], ch__4[54], ch__5[46]; + char ch__1[42], ch__2[1], ch__3[2], ch__4[55], ch__5[54], ch__6[46]; icilist ici__1; /* Builtin functions */ @@ -12329,2757 +20348,4540 @@ L4: static integer lvoltxt; /* Fortran I/O blocks */ - static cilist io___585 = { 0, 6, 0, 0, 0 }; - static cilist io___586 = { 0, 6, 0, 0, 0 }; - static cilist io___587 = { 0, 6, 0, 0, 0 }; - static cilist io___588 = { 0, 6, 0, 0, 0 }; - static cilist io___589 = { 0, 15, 0, "(/a)", 0 }; - static cilist io___590 = { 0, 15, 0, "(a11,2x,i3)", 0 }; - static cilist io___591 = { 0, 15, 0, 0, 0 }; - static cilist io___592 = { 0, 6, 0, 0, 0 }; - static cilist io___600 = { 0, 6, 0, 0, 0 }; - static cilist io___601 = { 0, 6, 0, 0, 0 }; - static cilist io___602 = { 0, 6, 0, 0, 0 }; - static cilist io___607 = { 0, 6, 0, 0, 0 }; - static cilist io___608 = { 0, 6, 0, 0, 0 }; - static cilist io___609 = { 0, 6, 0, 0, 0 }; + static cilist io___616 = { 0, 6, 0, 0, 0 }; + static cilist io___617 = { 0, 6, 0, 0, 0 }; + static cilist io___618 = { 0, 6, 0, 0, 0 }; + static cilist io___619 = { 0, 6, 0, 0, 0 }; + static cilist io___620 = { 0, 15, 0, "(/a)", 0 }; + static cilist io___621 = { 0, 15, 0, "(a11,2x,i3)", 0 }; + static cilist io___622 = { 0, 15, 0, 0, 0 }; static cilist io___623 = { 0, 6, 0, 0, 0 }; - static cilist io___626 = { 0, 6, 0, 0, 0 }; - static cilist io___627 = { 0, 6, 0, 0, 0 }; - static cilist io___628 = { 0, 6, 0, 0, 0 }; static cilist io___631 = { 0, 6, 0, 0, 0 }; - static cilist io___637 = { 0, 6, 0, 0, 0 }; + static cilist io___632 = { 0, 6, 0, 0, 0 }; + static cilist io___633 = { 0, 6, 0, 0, 0 }; static cilist io___638 = { 0, 6, 0, 0, 0 }; - static cilist io___639 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___639 = { 0, 6, 0, 0, 0 }; static cilist io___640 = { 0, 6, 0, 0, 0 }; - static cilist io___641 = { 0, 6, 0, 0, 0 }; - static cilist io___642 = { 0, 15, 0, "(a)", 0 }; - static cilist io___643 = { 0, 15, 0, "(a)", 0 }; - static cilist io___648 = { 0, 6, 0, 0, 0 }; - static cilist io___649 = { 0, 15, 0, "(a)", 0 }; - static cilist io___653 = { 0, 6, 0, 0, 0 }; static cilist io___654 = { 0, 6, 0, 0, 0 }; - static cilist io___655 = { 0, 6, 0, 0, 0 }; - static cilist io___656 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 }; - static cilist io___660 = { 0, 6, 0, 0, 0 }; - static cilist io___661 = { 0, 6, 0, 0, 0 }; - static cilist io___662 = { 0, 5, 0, "(a)", 0 }; - static cilist io___666 = { 0, 6, 0, 0, 0 }; - static cilist io___667 = { 0, 6, 0, 0, 0 }; + static cilist io___657 = { 0, 6, 0, 0, 0 }; + static cilist io___658 = { 0, 6, 0, 0, 0 }; + static cilist io___659 = { 0, 6, 0, 0, 0 }; + static cilist io___662 = { 0, 6, 0, 0, 0 }; + static cilist io___668 = { 0, 6, 0, 0, 0 }; + static cilist io___669 = { 0, 6, 0, 0, 0 }; + static cilist io___670 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___671 = { 0, 6, 0, 0, 0 }; + static cilist io___672 = { 0, 6, 0, 0, 0 }; + static cilist io___673 = { 0, 15, 0, "(a)", 0 }; + static cilist io___674 = { 0, 15, 0, "(a)", 0 }; + static cilist io___679 = { 0, 6, 0, 0, 0 }; + static cilist io___680 = { 0, 15, 0, "(a)", 0 }; + static cilist io___684 = { 0, 6, 0, 0, 0 }; + static cilist io___685 = { 0, 6, 0, 0, 0 }; + static cilist io___686 = { 0, 6, 0, 0, 0 }; + static cilist io___687 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 }; + static cilist io___691 = { 0, 6, 0, 0, 0 }; + static cilist io___692 = { 0, 6, 0, 0, 0 }; + static cilist io___693 = { 0, 5, 0, "(a)", 0 }; + static cilist io___697 = { 0, 6, 0, 0, 0 }; + static cilist io___698 = { 0, 6, 0, 0, 0 }; /* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +#line 8315 "" cdot = FALSE_; +#line 8316 "" L1: +#line 8316 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8317 "" if (*(unsigned char *)charq != ' ') { +#line 8317 "" *(unsigned char *)charlq = *(unsigned char *)charq; +#line 8317 "" } +#line 8318 "" if (c1omget_1.lastchar) { +#line 8319 "" if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) { - s_wsle(&io___585); +#line 8320 "" + s_wsle(&io___616); +#line 8320 "" e_wsle(); - s_wsle(&io___586); +#line 8321 "" + s_wsle(&io___617); +#line 8321 "" do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8); +#line 8321 "" e_wsle(); - s_wsle(&io___587); +#line 8322 "" + s_wsle(&io___618); +#line 8322 "" do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29) ; +#line 8322 "" do_lio(&c__9, &c__1, charlq, (ftnlen)1); +#line 8322 "" do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12); +#line 8322 "" e_wsle(); - s_wsle(&io___588); +#line 8323 "" + s_wsle(&io___619); +#line 8323 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 8323 "" i__1 = *(unsigned char *)charlq; +#line 8323 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 8323 "" e_wsle(); - s_wsfe(&io___589); +#line 8324 "" + s_wsfe(&io___620); /* Writing concatenation */ +#line 8324 "" i__2[0] = 29, a__1[0] = "Last non-blank character is \""; +#line 8324 "" i__2[1] = 1, a__1[1] = charlq; +#line 8324 "" i__2[2] = 12, a__1[2] = "\", not \"/,%\""; +#line 8324 "" s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42); +#line 8324 "" do_fio(&c__1, ch__1, (ftnlen)42); +#line 8324 "" e_wsfe(); - s_wsfe(&io___590); +#line 8326 "" + s_wsfe(&io___621); +#line 8326 "" do_fio(&c__1, "ASCII code:", (ftnlen)11); +#line 8326 "" i__1 = *(unsigned char *)charlq; +#line 8326 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 8326 "" e_wsfe(); /* Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. */ +#line 8330 "" --inbuff_1.ilbuf; +#line 8331 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[ inbuff_1.ilbuf - 1] + 2); /* Writing concatenation */ +#line 8332 "" i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq; +#line 8332 "" i__3[1] = 2, a__2[1] = " /"; - s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)65536); - s_wsle(&io___591); +#line 8332 "" + s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)131072); +#line 8333 "" + s_wsle(&io___622); +#line 8333 "" do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 8333 "" e_wsle(); - s_wsle(&io___592); +#line 8334 "" + s_wsle(&io___623); +#line 8334 "" do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 8334 "" e_wsle(); /* Writing concatenation */ +#line 8335 "" i__3[0] = a1ll_2.iccount, a__2[0] = lineq; +#line 8335 "" i__3[1] = 2, a__2[1] = " /"; +#line 8335 "" s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128); +#line 8336 "" c1omget_1.lastchar = FALSE_; +#line 8337 "" goto L1; +#line 8338 "" } +#line 8339 "" return 0; +#line 8340 "" } +#line 8341 "" if (*(unsigned char *)charq == ' ') { +#line 8342 "" goto L1; +#line 8343 "" } else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) { +#line 8344 "" a1ll_2.iccount = 128; +#line 8345 "" goto L1; /* Replacement 1/22/12 since gfortran 4.7 with -O was choking here! */ /* else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. */ +#line 8350 "" } else if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) > 0 || *( unsigned char *)charq == 'r') { /* This is a note/rest. gotclef is only used for checking for clef before "/" */ +#line 8355 "" if (cdot) { +#line 8355 "" goto L28; +#line 8355 "" } /* if (gotclef) gotclef=.false. */ +#line 8357 "" idotform = 0; +#line 8358 "" numnum = 0; +#line 8359 "" plusmin = FALSE_; +#line 8360 "" L28: +#line 8360 "" ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; +#line 8361 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) { +#line 8362 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu" +#line 8362 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"\ "sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48); +#line 8364 "" stop1_(); +#line 8365 "" } +#line 8366 "" *(unsigned char *)dotq = 'x'; /* Check if this is 'r ' and previous note was full-bar-pause */ +#line 8370 "" i__1 = a1ll_2.iccount; /* Computing MAX */ +#line 8370 "" i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; /* Computing MAX */ +#line 8370 "" i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; +#line 8370 "" fulbrp = *(unsigned char *)charq == 'r' && s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0 && a1ll_2.nnl[ c1ommvl_1.ivx - 1] > 1 && a1ll_2.rest[c1ommvl_1.ivx + max( i__4,i__5) * 24 - 25] && a1ll_2.nodur[c1ommvl_1.ivx + max( i__6,i__7) * 24 - 25] == a1ll_2.lenbar; +#line 8373 "" L2: +#line 8373 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8374 "" ic = *(unsigned char *)durq; +#line 8375 "" if (ic <= 57 && ic >= 48) { /* Digit */ +#line 8379 "" if (numnum == 0) { +#line 8380 "" c1omnotes_1.nnodur = ic - 48; +#line 8381 "" numnum = 1; +#line 8382 "" goto L2; +#line 8383 "" } else if (numnum == 1) { +#line 8384 "" if (*(unsigned char *)charq == 'r') { +#line 8385 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a" +#line 8385 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"\ "llowed after rest symbol \"r\"!", (ftnlen)128, ( ftnlen)45); +#line 8387 "" stop1_(); +#line 8388 "" } +#line 8389 "" numnum = 2; +#line 8390 "" if (plusmin) { - s_wsle(&io___600); +#line 8391 "" + s_wsle(&io___631); +#line 8391 "" e_wsle(); - s_wsle(&io___601); +#line 8392 "" + s_wsle(&io___632); +#line 8392 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) 25); +#line 8392 "" e_wsle(); +#line 8393 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1" +#line 8393 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); - s_wsle(&io___602); - do_lio(&c__9, &c__1, "explicitly specified. May need to" +#line 8395 "" + s_wsle(&io___633); +#line 8395 "" + do_lio(&c__9, &c__1, "explicitly specified. May need to"\ " edit old editions", (ftnlen)52); +#line 8395 "" e_wsle(); +#line 8397 "" } +#line 8398 "" goto L2; +#line 8399 "" } else { +#line 8400 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy" +#line 8400 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"\ "mbol!", (ftnlen)128, (ftnlen)25); +#line 8402 "" stop1_(); +#line 8403 "" } +#line 8404 "" } else if (*(unsigned char *)durq == 'd') { +#line 8405 "" *(unsigned char *)dotq = *(unsigned char *)durq; +#line 8406 "" i__1 = a1ll_2.iccount; +#line 8406 "" if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 8407 "" c1omnotes_1.iddot = 1; +#line 8408 "" ++a1ll_2.iccount; /* Since we flow out, double dots won't work with other dot options */ +#line 8412 "" } +#line 8413 "" i__1 = a1ll_2.iccount; +#line 8413 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 - i__1) > 0) { /* move a dot, provided a number follows. */ +#line 8417 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8418 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8419 "" if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0) { /* Backup, exit the loop normally */ +#line 8423 "" a1ll_2.iccount += -2; +#line 8424 "" goto L2; +#line 8425 "" } +#line 8426 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 8427 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ +#line 8431 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 8432 "" if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0) { +#line 8433 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num" +#line 8433 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"\ "ber after 2nd +/- (shift dot)!", (ftnlen)128, (ftnlen)42); +#line 8435 "" stop1_(); +#line 8436 "" } +#line 8437 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 8438 "" } +#line 8439 "" --a1ll_2.iccount; +#line 8440 "" } +#line 8441 "" goto L2; +#line 8442 "" } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Accidental shift */ /* if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */ +#line 8447 "" i__1 = a1ll_2.iccount - 2; +#line 8447 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) == 0) { +#line 8448 "" i__1 = a1ll_2.iccount - 1; +#line 8448 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o" +#line 8448 "" + errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o"\ "r \"A\" before \"<\" or \">\"!", (ftnlen)128, (ftnlen) 48); /* * 'Expected "f", "s", or "n" before "<" or ">"!') */ +#line 8451 "" stop1_(); +#line 8452 "" } +#line 8453 "" ipm = 1; +#line 8454 "" if (*(unsigned char *)durq == '<') { +#line 8454 "" ipm = -1; +#line 8454 "" } +#line 8455 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8456 "" if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 8457 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte" +#line 8457 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"\ "r </> (accidental shift)!", (ftnlen)128, (ftnlen)45); +#line 8459 "" stop1_(); +#line 8460 "" } +#line 8461 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 8462 "" fnum = ipm * fnum; +#line 8463 "" if (fnum < -5.35f || fnum > 1.f) { +#line 8464 "" i__1 = a1ll_2.iccount - 1; +#line 8464 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu" +#line 8464 "" + errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"\ "st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52); +#line 8466 "" stop1_(); +#line 8467 "" } +#line 8468 "" --a1ll_2.iccount; +#line 8469 "" goto L2; +#line 8470 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8471 "" if (*(unsigned char *)charq != 'r') { +#line 8472 "" i__1 = a1ll_2.iccount - 2; +#line 8472 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) > 0) { +#line 8473 "" ipm = 1; +#line 8474 "" if (*(unsigned char *)durq == '-') { +#line 8474 "" ipm = -1; +#line 8474 "" } +#line 8475 "" i__1 = a1ll_2.iccount; +#line 8475 "" if (i_indx("0123456789", lineq + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) > 0) { /* This may be start of accidental shift, but may be octave jump; then duration */ +#line 8480 "" icsav = a1ll_2.iccount; +#line 8481 "" ++a1ll_2.iccount; +#line 8482 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 8483 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* This is an accid shift since there's a 2nd consecutive signed number. */ /* Check size of 1st number. */ +#line 8488 "" if (fnum > 30.5f) { +#line 8489 "" i__1 = a1ll_2.iccount - 1; +#line 8489 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Vertical accid" +#line 8489 "" + errmsg_(lineq, &i__1, &i__4, "Vertical accid"\ "ental shift must be less than 31!", ( ftnlen)128, (ftnlen)47); +#line 8491 "" stop1_(); +#line 8492 "" } +#line 8493 "" ipm = 1; +#line 8494 "" if (*(unsigned char *)durq == '-') { +#line 8494 "" ipm = -1; +#line 8494 "" } +#line 8495 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) 128, (ftnlen)1); +#line 8496 "" if (i_indx("1234567890.", durq, (ftnlen)11, ( ftnlen)1) == 0) { +#line 8497 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe" +#line 8497 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"\ "cted 2nd number of accidental shift)!" , (ftnlen)128, (ftnlen)41); +#line 8499 "" stop1_(); +#line 8500 "" } +#line 8501 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); +#line 8502 "" fnum = ipm * fnum; +#line 8503 "" if (fnum < -5.35f || fnum > 1.f) { +#line 8504 "" i__1 = a1ll_2.iccount - 1; +#line 8504 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Horiz. acciden" +#line 8504 "" + errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"\ "tal shift must be >-5.35 and <1.0!", ( ftnlen)128, (ftnlen)48); +#line 8506 "" stop1_(); +#line 8507 "" } +#line 8508 "" --a1ll_2.iccount; +#line 8509 "" goto L2; +#line 8510 "" } else { /* Not accid shift, reset, then flow out */ +#line 8514 "" a1ll_2.iccount = icsav; +#line 8515 "" } +#line 8516 "" } +#line 8517 "" } +#line 8518 "" plusmin = TRUE_; +#line 8519 "" if (numnum == 2) { - s_wsle(&io___607); +#line 8520 "" + s_wsle(&io___638); +#line 8520 "" e_wsle(); - s_wsle(&io___608); +#line 8521 "" + s_wsle(&io___639); +#line 8521 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) 25); +#line 8521 "" e_wsle(); +#line 8522 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1" +#line 8522 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); - s_wsle(&io___609); - do_lio(&c__9, &c__1, "explicitly specified. May need to" +#line 8524 "" + s_wsle(&io___640); +#line 8524 "" + do_lio(&c__9, &c__1, "explicitly specified. May need to"\ " edit old editions", (ftnlen)52); +#line 8524 "" e_wsle(); +#line 8526 "" } +#line 8527 "" goto L2; /* It's a rest containing +|- . Must refer to a vertical shift. Read past. */ +#line 8531 "" } else { +#line 8532 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8533 "" readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, ( ftnlen)1); +#line 8534 "" + i__1 = a1ll_2.iccount - 2; +#line 8534 "" + if (s_cmp(lineq + i__1, ".", a1ll_2.iccount - 1 - i__1, ( + ftnlen)1) == 0) { +#line 8534 "" + --a1ll_2.iccount; +#line 8534 "" + } +#line 8535 "" --a1ll_2.iccount; +#line 8536 "" goto L2; +#line 8537 "" } /* else if (index('ulare',durq) .gt. 0) then */ +#line 8539 "" } else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) { +#line 8540 "" goto L2; -/* else if (durq .eq. 'S') then */ +#line 8541 "" } else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Stemlength change */ +#line 8545 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8546 "" if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) { +#line 8547 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb" +#line 8547 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"\ "er or colon here!", (ftnlen)128, (ftnlen)37); +#line 8549 "" stop1_(); +#line 8550 "" } +#line 8551 "" if (*(unsigned char *)durq == ':') { +#line 8552 "" if (! comkeys_1.stickys) { +#line 8553 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick" +#line 8553 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"\ "y stemlegth changes without turning on!", (ftnlen) 128, (ftnlen)55); +#line 8555 "" stop1_(); +#line 8556 "" } +#line 8557 "" comkeys_1.stickys = FALSE_; +#line 8558 "" goto L2; +#line 8559 "" } +#line 8560 "" readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen) 1); /* if (dum.lt..5 .or. dum.gt.4.) then */ +#line 8562 "" if (*(unsigned char *)durq == 'L' && dum > 20.f || *(unsigned char *)durq == 'S' && dum > 4.f) { +#line 8564 "" i__1 = a1ll_2.iccount - 1; +#line 8564 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b" +#line 8564 "" + errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b"\ "ig!", (ftnlen)128, (ftnlen)33); +#line 8566 "" stop1_(); +#line 8567 "" } +#line 8568 "" if (*(unsigned char *)durq != ':') { +#line 8569 "" --a1ll_2.iccount; +#line 8570 "" } else { +#line 8571 "" if (comkeys_1.stickys) { +#line 8572 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky" +#line 8572 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"\ " stemshrinks when already on!", (ftnlen)128, ( ftnlen)45); +#line 8574 "" stop1_(); +#line 8575 "" } +#line 8576 "" comkeys_1.stickys = TRUE_; +#line 8577 "" } +#line 8578 "" goto L2; +#line 8579 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */ /* MUST come right after "f,s,n" */ +#line 8584 "" i__1 = a1ll_2.iccount; +#line 8584 "" if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 8584 "" ++a1ll_2.iccount; +#line 8584 "" } +#line 8585 "" goto L2; +#line 8586 "" } else if (*(unsigned char *)durq == 'p') { +#line 8587 "" fulbrp = *(unsigned char *)charq == 'r'; +#line 8588 "" if (! fulbrp) { +#line 8589 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl" +#line 8589 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"\ "y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42); +#line 8591 "" stop1_(); +#line 8592 "" } +#line 8593 "" goto L2; +#line 8594 "" } else if (*(unsigned char *)durq == 'b') { +#line 8595 "" if (*(unsigned char *)charq != 'r') { +#line 8596 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I" +#line 8596 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"\ " expected \"rb\"!", (ftnlen)128, (ftnlen)33); +#line 8598 "" stop1_(); +#line 8599 "" } else if (numnum == 2) { +#line 8600 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &" +#line 8600 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"\ " \"b\" with two numbers!", (ftnlen)128, (ftnlen)39); +#line 8602 "" } +#line 8603 "" goto L2; +#line 8604 "" } else if (*(unsigned char *)durq == 'x') { /* Xtuplet. Count number of doubled notes (for unequal xtups) */ +#line 8608 "" if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25],18)) { +#line 8609 "" ndoub = 1; +#line 8610 "" } else { +#line 8611 "" ndoub = 0; +#line 8612 "" } /* Will set all durations to 0 except last one. */ +#line 8616 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); - if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 8617 "" + if (i_indx("123456789T", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 8618 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \"" - "x\" in xtuplet must be \"1\"-\"9\"!", (ftnlen)128, ( - ftnlen)48); +#line 8618 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""\ + "x\" in xtuplet must be \"1\"-\"9\" or \"T\"!", ( + ftnlen)128, (ftnlen)55); +#line 8620 "" stop1_(); +#line 8621 "" } - readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( - ftnlen)1); - if (fnum > 99.f) { - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot have " - "more than 99 notes!", (ftnlen)128, (ftnlen)39); - stop1_(); - } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) { - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal character" - "s here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)128, ( - ftnlen)47); - stop1_(); +#line 8622 "" + if (*(unsigned char *)durq == 'T') { + +/* Check all x-tremolo inputs here; set fnum=2 */ + +#line 8626 "" + fnum = 2.f; +#line 8627 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) + ; +#line 8628 "" + if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8629 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8629 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char aft"\ + "er \"T\" in xtuplet must be \"0\"-\"3\" or blank!" + , (ftnlen)128, (ftnlen)57); +#line 8631 "" + stop1_(); +#line 8632 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8633 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8634 "" + if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8635 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8635 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This char mu"\ + "st be \"0\"-\"3\" or blank!", (ftnlen)128, ( + ftnlen)35); +#line 8637 "" + stop1_(); +#line 8638 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8639 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); + +/* Probably blank unles other options entered */ + +#line 8643 "" + } +#line 8644 "" + } +#line 8645 "" + } else { + +/* durq is digit, normal xtup */ + +#line 8649 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); + +/* Leaves durq at next char after number */ + +#line 8653 "" + if (fnum > 99.f) { +#line 8654 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8654 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot h"\ + "ave more than 99 notes!", (ftnlen)128, (ftnlen)39) + ; +#line 8656 "" + stop1_(); +#line 8657 "" + } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8658 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8658 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal chara"\ + "cters here are \" \",\"D\",\"F\",\"n\"!", (ftnlen) + 128, (ftnlen)47); +#line 8660 "" + stop1_(); +#line 8661 "" + } +#line 8662 "" } /* End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. */ +#line 8666 "" if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double xtup note to make an un= xtup. Here, number already set, but may also */ /* have used this before number was set. */ +#line 8671 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18); +#line 8672 "" ndoub = 1; +#line 8673 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8674 "" } else if (*(unsigned char *)durq == 'd') { +#line 8675 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],27); +#line 8676 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8677 "" } +#line 8678 "" if (*(unsigned char *)durq == 'n') { /* Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. */ +#line 8682 "" numshft = 0; +#line 8683 "" L30: +#line 8683 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8684 "" if (*(unsigned char *)durq == 'f') { +#line 8685 "" goto L30; +#line 8686 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8687 "" ++numshft; +#line 8688 "" if (numshft == 3) { +#line 8689 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift" +#line 8689 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"\ "s are allowed after \"n\" in xtup!", (ftnlen) 128, (ftnlen)44); +#line 8691 "" stop1_(); +#line 8692 "" } +#line 8693 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 8694 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 8695 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact" +#line 8695 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ "er should be a digit or \".\"!", (ftnlen)128, (ftnlen)40); +#line 8697 "" stop1_(); +#line 8698 "" } +#line 8699 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); +#line 8700 "" --a1ll_2.iccount; /* if ((numshft.eq.1 .and. snum.gt.15.1) .or. */ +#line 8702 "" if (numshft == 1 && snum > 64.f || numshft == 2 && snum > 1.51f) { +#line 8704 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number" +#line 8704 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"\ " after \"n\" in xtup is out of range!", ( ftnlen)128, (ftnlen)47); +#line 8706 "" stop1_(); +#line 8707 "" } +#line 8708 "" goto L30; +#line 8709 "" } else if (*(unsigned char *)durq == 's') { /* Slope alteration for bracket */ +#line 8713 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 8714 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8715 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad" - "justment, this character must be \"+\" or \"-" +#line 8715 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"\ + "justment, this character must be \"+\" or \"-"\ "\"!", (ftnlen)128, (ftnlen)56); +#line 8717 "" stop1_(); +#line 8718 "" } +#line 8719 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 8720 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 8721 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact" +#line 8721 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ "er should be a digit!", (ftnlen)128, (ftnlen) 33); +#line 8723 "" stop1_(); +#line 8724 "" } +#line 8725 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); +#line 8726 "" --a1ll_2.iccount; +#line 8727 "" if (i_nint(&snum) > 15) { +#line 8728 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust" +#line 8728 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"\ "ment cannot exceed 15!", (ftnlen)128, (ftnlen) 34); +#line 8730 "" stop1_(); +#line 8731 "" } +#line 8732 "" goto L30; +#line 8733 "" } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) > 0) { /* Unsigned integer => alternate printed number */ +#line 8737 "" readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, (ftnlen)1); +#line 8738 "" if (snum > 15.1f) { +#line 8739 "" i__1 = a1ll_2.iccount - 1; +#line 8739 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Alternate xtup number " +#line 8739 "" + errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "\ "after \"n\" must be <16!", (ftnlen)128, ( ftnlen)44); +#line 8741 "" stop1_(); +#line 8742 "" } +#line 8743 "" --a1ll_2.iccount; +#line 8744 "" goto L30; +#line 8745 "" } else if (*(unsigned char *)durq != ' ') { +#line 8746 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 8746 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36); +#line 8748 "" stop1_(); +#line 8749 "" } +#line 8750 "" } +#line 8751 "" ntup = i_nint(&fnum); +#line 8752 "" i__1 = ntup; +#line 8752 "" for (itup = 2; itup <= i__1; ++itup) { +#line 8753 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = 0; +#line 8754 "" ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; +#line 8755 "" L110: +#line 8755 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 8756 "" if (*(unsigned char *)durq == ' ') { +#line 8757 "" goto L110; +#line 8758 "" } else if (*(unsigned char *)durq == 'o') { /* Ornament in xtup. "o" symbol must come AFTER the affected note */ +#line 8762 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8763 "" if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, ( ftnlen)1) == 0) { +#line 8764 "" if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8765 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata " +#line 8765 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "\ "or segno not allowed in xtuplet!", ( ftnlen)128, (ftnlen)40); +#line 8767 "" } else { +#line 8768 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal " +#line 8768 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ "ornament!", (ftnlen)128, (ftnlen)17); +#line 8770 "" } +#line 8771 "" stop1_(); +#line 8772 "" } +#line 8773 "" if (*(unsigned char *)dumq == 'T') { /* Trill. may be followed by 't' and/or number. read 'til blank */ +#line 8777 "" L29: +#line 8777 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8778 "" if (*(unsigned char *)dumq != ' ') { +#line 8778 "" goto L29; +#line 8778 "" } +#line 8779 "" } else if (*(unsigned char *)dumq == 'e') { +#line 8780 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8781 "" if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 8782 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal " - "character after \"e\" in edit. accid. sy" +#line 8782 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ + "character after \"e\" in edit. accid. sy"\ "mbol!", (ftnlen)128, (ftnlen)51); +#line 8784 "" stop1_(); +#line 8785 "" } +#line 8786 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8787 "" if (*(unsigned char *)dumq == '?') { +#line 8787 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) 128, (ftnlen)1); +#line 8787 "" } +#line 8788 "" } else if (*(unsigned char *)dumq == ':') { +#line 8789 "" i__4 = a1ll_2.iccount; +#line 8789 "" if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - i__4, (ftnlen)1) != 0) { +#line 8790 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu" +#line 8790 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ "st be followed by blank in \"o: \"!", ( ftnlen)128, (ftnlen)39); +#line 8792 "" stop1_(); +#line 8793 "" } else if (! comkeys_1.ornrpt) { +#line 8794 "" i__4 = a1ll_2.iccount - 1; +#line 8794 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Turned off repeate" +#line 8794 "" + errmsg_(lineq, &i__4, &i__5, "Turned off repeate"\ "d ornaments before they were on!", ( ftnlen)128, (ftnlen)50); +#line 8796 "" stop1_(); +#line 8797 "" } +#line 8798 "" comkeys_1.ornrpt = FALSE_; +#line 8799 "" } else { +#line 8800 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8801 "" } +#line 8802 "" if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 8803 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#line 8803 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in ornament symbol!", (ftnlen)128, ( ftnlen)37); +#line 8805 "" stop1_(); +#line 8806 "" } +#line 8807 "" if (*(unsigned char *)dumq == ':') { +#line 8808 "" i__4 = a1ll_2.iccount; +#line 8808 "" if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - i__4, (ftnlen)1) != 0) { +#line 8809 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu" +#line 8809 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ "st be followed by blank in \"o: \"!", ( ftnlen)128, (ftnlen)39); +#line 8811 "" stop1_(); +#line 8812 "" } else if (comkeys_1.ornrpt) { +#line 8813 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o" +#line 8813 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"\ "n repeated ornaments but already on!", ( ftnlen)128, (ftnlen)44); +#line 8815 "" stop1_(); +#line 8816 "" } +#line 8817 "" comkeys_1.ornrpt = TRUE_; +#line 8818 "" } +#line 8819 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8820 "" i__4 = a1ll_2.iccount; +#line 8820 "" if (i_indx("0123456789", lineq + i__4, (ftnlen)10, a1ll_2.iccount + 1 - i__4) == 0) { +#line 8822 "" i__4 = a1ll_2.iccount + 1; +#line 8822 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "There should be an" +#line 8822 "" + errmsg_(lineq, &i__4, &i__5, "There should be an"\ " integer here!", (ftnlen)128, (ftnlen)32); +#line 8824 "" stop1_(); +#line 8825 "" } +#line 8826 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 8827 "" if (*(unsigned char *)durq == ':') { +#line 8828 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s" +#line 8828 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"\ "hift AND repeat an ornament!", (ftnlen) 128, (ftnlen)36); +#line 8830 "" stop1_(); +#line 8831 "" } /* 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */ +#line 8835 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8836 "" i__4 = a1ll_2.iccount; +#line 8836 "" if (i_indx(".0123456789", lineq + i__4, (ftnlen) 11, a1ll_2.iccount + 1 - i__4) == 0) { +#line 8838 "" i__4 = a1ll_2.iccount + 1; +#line 8838 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "There should b" +#line 8838 "" + errmsg_(lineq, &i__4, &i__5, "There should b"\ "e a number here!", (ftnlen)128, ( ftnlen)30); +#line 8841 "" stop1_(); +#line 8842 "" } +#line 8843 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); +#line 8844 "" } +#line 8845 "" } +#line 8846 "" goto L110; +#line 8847 "" } else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) { /* Slur in xtup */ +#line 8851 "" iposn = 0; +#line 8852 "" numint = 0; +#line 8853 "" L15: +#line 8853 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8854 "" ++iposn; +#line 8855 "" if (i_indx("udlbfnhtv", dumq, (ftnlen)9, (ftnlen)1) > 0) { +#line 8856 "" if (*(unsigned char *)dumq == 't' && *(unsigned char * )durq == 't') { +#line 8857 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u" +#line 8857 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"\ "se \"t\" as an option on a tie!", (ftnlen) 128, (ftnlen)37); +#line 8859 "" stop1_(); +#line 8860 "" } +#line 8861 "" goto L15; +#line 8862 "" } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8863 "" ++numint; +#line 8864 "" ++a1ll_2.iccount; +#line 8865 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 8866 "" if (numint == 1) { +#line 8867 "" if (i_nint(&fnum) > 30) { +#line 8868 "" i__4 = a1ll_2.iccount - 1; +#line 8868 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Magnitude of s" - "lur height adjustment cannot exceed " +#line 8868 "" + errmsg_(lineq, &i__4, &i__5, "Magnitude of s"\ + "lur height adjustment cannot exceed "\ "30!", (ftnlen)128, (ftnlen)53); +#line 8870 "" stop1_(); +#line 8871 "" } +#line 8872 "" } else if (numint == 2) { +#line 8873 "" if (dabs(fnum) > 6.3f) { +#line 8874 "" i__4 = a1ll_2.iccount - 1; +#line 8874 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Slur horiz shi" +#line 8874 "" + errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ "ft must be in the range (-6.3,6.3)!", (ftnlen)128, (ftnlen)49); +#line 8876 "" stop1_(); +#line 8877 "" } +#line 8878 "" } else { /* Third signed integer, must be a midslur or curve spec. */ +#line 8882 "" if (dabs(fnum) > 31.f) { +#line 8883 "" i__4 = a1ll_2.iccount - 1; +#line 8883 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Slur midheight" +#line 8883 "" + errmsg_(lineq, &i__4, &i__5, "Slur midheight"\ " must be in the range (-31,31)!", ( ftnlen)128, (ftnlen)45); +#line 8885 "" stop1_(); +#line 8886 "" } +#line 8887 "" if (*(unsigned char *)durq == ':') { /* Expecting curve parameters. Get two numbers */ +#line 8891 "" for (i__ = 1; i__ <= 2; ++i__) { +#line 8892 "" ++a1ll_2.iccount; +#line 8893 "" fnum = (real) (*(unsigned char *)&lineq[ a1ll_2.iccount - 1] - 48); +#line 8894 "" if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { +#line 8895 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 8895 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, - "Slur curve parameter must " + "Slur curve parameter must "\ "be in range (0,7)!", (ftnlen) 128, (ftnlen)44); +#line 8898 "" stop1_(); +#line 8899 "" } +#line 8900 "" /* L40: */ +#line 8900 "" } +#line 8901 "" ++a1ll_2.iccount; +#line 8902 "" } +#line 8903 "" } +#line 8904 "" --a1ll_2.iccount; +#line 8905 "" goto L15; +#line 8907 "" } else if (*(unsigned char *)dumq == 's') { /* What follows should be one or two signed numbers for adjustment of line break */ /* slur, end of 1st segment or start of second. */ +#line 8912 "" if (comslur_1.fontslur) { +#line 8913 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not " - "use linebreak slur options with font-bas" +#line 8913 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "\ + "use linebreak slur options with font-bas"\ "ed slurs!", (ftnlen)128, (ftnlen)57); +#line 8915 "" stop1_(); +#line 8916 "" } +#line 8917 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8918 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8919 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha" +#line 8919 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"\ "racter must be \"+\" or \"-\"!", (ftnlen) 128, (ftnlen)34); +#line 8921 "" stop1_(); +#line 8922 "" } +#line 8923 "" ++a1ll_2.iccount; +#line 8924 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 8925 "" if (i_nint(&fnum) > 30) { +#line 8926 "" i__4 = a1ll_2.iccount - 1; +#line 8926 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Magnitude of slur " +#line 8926 "" + errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "\ "height adjustment cannot exceed 30!", ( ftnlen)128, (ftnlen)53); +#line 8928 "" stop1_(); +#line 8929 "" } +#line 8930 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8931 "" ++a1ll_2.iccount; +#line 8932 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, ( ftnlen)128, (ftnlen)1); +#line 8933 "" if (dabs(fnum) > 6.3f) { +#line 8934 "" i__4 = a1ll_2.iccount - 1; +#line 8934 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__4, &i__5, "Slur horiz shi" +#line 8934 "" + errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ "ft must be in range (-6.3,6.3)!", ( ftnlen)128, (ftnlen)45); +#line 8936 "" stop1_(); +#line 8937 "" } +#line 8938 "" } +#line 8939 "" --a1ll_2.iccount; +#line 8940 "" goto L15; +#line 8941 "" } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { +#line 8942 "" i__4 = a1ll_2.iccount; +#line 8942 "" if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 - i__4, (ftnlen)1) == 0) { +#line 8942 "" ++a1ll_2.iccount; +#line 8942 "" } +#line 8944 "" goto L15; +#line 8945 "" } else if (*(unsigned char *)dumq == 'p') { /* local change in postscript slur/tie adjustment default */ +#line 8949 "" if (comslur_1.fontslur) { +#line 8950 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use" - " postscript slurs (\"Ap\") to use this o" +#line 8950 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"\ + " postscript slurs (\"Ap\") to use this o"\ "ption!", (ftnlen)128, (ftnlen)52); +#line 8952 "" stop1_(); +#line 8953 "" } +#line 8954 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8955 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8956 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect" +#line 8956 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ "ed \"+\" or \"-\" here!", (ftnlen)128, ( ftnlen)25); +#line 8958 "" stop1_(); +#line 8959 "" } +#line 8960 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 8961 "" if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8962 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect" +#line 8962 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ "ed \"s\" or \"t\" here!", (ftnlen)128, ( ftnlen)25); +#line 8964 "" stop1_(); +#line 8965 "" } +#line 8966 "" goto L15; +#line 8967 "" } else if (*(unsigned char *)dumq != ' ') { +#line 8968 "" ic = *(unsigned char *)dumq; +#line 8969 "" if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) { +#line 8971 "" if (iposn == 1) { +#line 8972 "" if (*(unsigned char *)durq == 't' && comslur_1.fontslur) { +#line 8973 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 8973 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, - "Slur ID not allowed on non-post" + "Slur ID not allowed on non-post"\ "script tie!", (ftnlen)128, ( ftnlen)42); +#line 8975 "" stop1_(); +#line 8976 "" + } +#line 8977 "" + i__4 = a1ll_2.iccount; +#line 8977 "" + if (s_cmp(lineq + i__4, "x", a1ll_2.iccount + + 1 - i__4, (ftnlen)1) == 0) { +#line 8977 "" + ++a1ll_2.iccount; +#line 8977 "" } +#line 8979 "" goto L15; +#line 8980 "" } +#line 8981 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID " +#line 8981 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "\ "must be 2nd character in slur symbol!", ( ftnlen)128, (ftnlen)45); +#line 8983 "" stop1_(); +#line 8984 "" } +#line 8985 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#line 8985 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in slur symbol!", (ftnlen)128, (ftnlen) 33); +#line 8987 "" stop1_(); +#line 8988 "" } +#line 8989 "" goto L110; +#line 8990 "" } else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, ( ftnlen)1) > 0) { /* We have a figure. Only allow on 1st note of xtup */ +#line 8994 "" if (itup != 2) { +#line 8995 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt" +#line 8995 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"\ "up only allowed on 1st note!", (ftnlen)128, ( ftnlen)40); +#line 8997 "" stop1_(); +#line 8998 "" } else if (*(unsigned char *)durq == 'x') { +#line 8999 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating " +#line 8999 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "\ "figures in xtuplets!", (ftnlen)128, (ftnlen) 32); +#line 9001 "" stop1_(); +#line 9002 "" } +#line 9003 "" if (compage_1.usefig && c1ommvl_1.ivx == 1) { +#line 9003 "" *ifig = 1; +#line 9003 "" } +#line 9004 "" L26: +#line 9004 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); /* if (index('0123456789#-n_.:',durq) .gt. 0) then */ +#line 9006 "" if (i_indx("0123456789#-n_.:v", durq, (ftnlen)17, (ftnlen) 1) > 0) { +#line 9007 "" goto L26; +#line 9008 "" } else if (*(unsigned char *)durq == 's') { +#line 9009 "" comligfont_1.isligfont = TRUE_; +#line 9010 "" goto L26; +#line 9011 "" } else if (*(unsigned char *)durq == '+') { /* vertical offset, must be integer then blank */ +#line 9015 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 9016 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) != 0) { +#line 9017 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer " +#line 9017 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "\ "for vertical offset expected here!", ( ftnlen)128, (ftnlen)42); +#line 9019 "" stop1_(); +#line 9020 "" } +#line 9021 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 9022 "" if (*(unsigned char *)durq != ' ') { +#line 9023 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical" +#line 9023 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"\ " offset must terminate figure!", (ftnlen) 128, (ftnlen)38); +#line 9025 "" stop1_(); +#line 9026 "" } +#line 9027 "" --a1ll_2.iccount; +#line 9028 "" goto L26; +#line 9029 "" } else if (*(unsigned char *)durq != ' ') { +#line 9030 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#line 9030 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ "acter in figure in xtuplet!", (ftnlen)128, ( ftnlen)39); +#line 9032 "" stop1_(); +#line 9033 "" } +#line 9034 "" goto L110; +#line 9035 "" } else if (*(unsigned char *)durq == 'G') { +#line 9036 "" ngr = 1; +#line 9037 "" L79: +#line 9037 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, ( ftnlen)1); +#line 9038 "" if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { +#line 9039 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 9040 "" ngr = i_nint(&fnum); +#line 9041 "" --a1ll_2.iccount; +#line 9042 "" goto L79; +#line 9043 "" } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9044 "" goto L79; +#line 9045 "" } else if (*(unsigned char *)charq == 'm') { +#line 9046 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9047 "" if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) { +#line 9048 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit " - "less than 5 must follow \"m\" in a grace" +#line 9048 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "\ + "less than 5 must follow \"m\" in a grace"\ " note!", (ftnlen)128, (ftnlen)52); +#line 9050 "" stop1_(); +#line 9051 "" } +#line 9052 "" goto L79; +#line 9053 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note */ +#line 9057 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9058 "" if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen) 1) > 0) { +#line 9059 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); +#line 9060 "" --a1ll_2.iccount; +#line 9061 "" goto L79; +#line 9062 "" } else { +#line 9063 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number" +#line 9063 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"\ " must follow \"X\" in a grace note!", ( ftnlen)128, (ftnlen)41); +#line 9065 "" stop1_(); +#line 9066 "" } +#line 9067 "" } /* At this point, charq is first note name in rest (grace?) */ +#line 9071 "" i__4 = ngr; +#line 9071 "" for (igr = 1; igr <= i__4; ++igr) { +#line 9072 "" numnum = 0; +#line 9073 "" if (igr > 1) { +#line 9074 "" L75: +#line 9074 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen) 128, (ftnlen)1); +#line 9075 "" if (*(unsigned char *)charq == ' ') { +#line 9075 "" goto L75; +#line 9075 "" } +#line 9076 "" } +#line 9077 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 9078 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace" +#line 9078 "" + errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"\ ", expected \"a\"-\"g\"!", (ftnlen)128, ( ftnlen)27); +#line 9080 "" stop1_(); +#line 9081 "" } +#line 9082 "" L78: +#line 9082 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9083 "" if (*(unsigned char *)charq != ' ') { +#line 9084 "" if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) { +#line 9085 "" if (numnum == 1) { +#line 9086 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9086 "" errmsg_(lineq, &a1ll_2.iccount, &i__5, - "Only one of \"+-1234567\" allow" + "Only one of \"+-1234567\" allow"\ "ed here in grace!", (ftnlen)128, ( ftnlen)46); +#line 9088 "" stop1_(); +#line 9089 "" } +#line 9090 "" numnum = 1; +#line 9091 "" goto L78; +#line 9092 "" } else if (i_indx("+-nfs", charq, (ftnlen)5, ( ftnlen)1) > 0) { +#line 9093 "" goto L78; +#line 9094 "" } /* Digits are possible octave numbers */ +#line 9098 "" i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal " +#line 9098 "" + errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "\ "character after note name in grace!", ( ftnlen)128, (ftnlen)43); +#line 9100 "" stop1_(); +#line 9101 "" } +#line 9102 "" /* L71: */ +#line 9102 "" } +#line 9103 "" goto L110; +#line 9104 "" } else /* if(complicated condition) */ { +#line 9104 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 9104 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0]) { +#line 9105 "" chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); +#line 9106 "" if (literr > 0) { +#line 9107 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9107 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + ( literr - 1) * 51, (ftnlen)128, (ftnlen)51) ; +#line 9109 "" stop1_(); +#line 9110 "" } +#line 9111 "" goto L110; +#line 9112 "" } else if (*(unsigned char *)durq == '"') { /* pmx lyric */ +#line 9116 "" chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen) 128); +#line 9117 "" if (lyrerr > 0) { +#line 9118 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9118 "" errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + ( lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51) ; +#line 9120 "" stop1_(); +#line 9121 "" } +#line 9122 "" goto L110; +#line 9123 "" } else if (*(unsigned char *)durq == 'M') { /* Temporary trap until I get around putting this in pmxb */ +#line 9127 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y" +#line 9127 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"\ "et allowed in xtuplets!", (ftnlen)128, ( ftnlen)35); +#line 9129 "" stop1_(); +#line 9130 "" } else if (*(unsigned char *)durq == 'X') { +#line 9131 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9131 "" g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, & i__4, &c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], &c1omnotes_1.wheadpt, (ftnlen) 128); +#line 9133 "" goto L110; +#line 9134 "" } else if (*(unsigned char *)durq == 'z') { /* Chord note in xtup. Read past for now. */ +#line 9138 "" L33: +#line 9138 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 9139 "" if (*(unsigned char *)durq != ' ') { +#line 9139 "" goto L33; +#line 9139 "" } +#line 9140 "" goto L110; +#line 9141 "" } else if (*(unsigned char *)durq == 'D') { /* Dynamic mark */ +#line 9145 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9145 "" checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128); +#line 9146 "" goto L110; +#line 9147 "" } else if (*(unsigned char *)durq == '%') { +#line 9148 "" if (a1ll_2.iccount != 1) { +#line 9149 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment " +#line 9149 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "\ "must have \"%\" in column 1!", (ftnlen) 128, (ftnlen)34); +#line 9151 "" stop1_(); +#line 9152 "" } +#line 9153 "" a1ll_2.iccount = 128; +#line 9154 "" goto L110; +#line 9155 "" } else if (*(unsigned char *)durq == '?') { +#line 9156 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 9157 "" if (*(unsigned char *)durq == ' ') { +#line 9158 "" --a1ll_2.iccount; +#line 9159 "" goto L110; +#line 9160 "" } +#line 9161 "" if (*(unsigned char *)durq != '-') { +#line 9162 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin" +#line 9162 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ "g \"-\"", (ftnlen)128, (ftnlen)13); +#line 9164 "" stop1_(); +#line 9165 "" } +#line 9166 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 9167 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9168 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin" +#line 9168 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ "g number", (ftnlen)128, (ftnlen)16); +#line 9170 "" stop1_(); +#line 9171 "" } +#line 9172 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 9173 "" --a1ll_2.iccount; +#line 9174 "" goto L110; /* 140215 Allow clef change inside xtup */ +#line 9178 "" } else if (*(unsigned char *)durq == 'C') { +#line 9179 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 9180 "" if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *(unsigned char *)durq >= 48 && *( unsigned char *)durq <= 56)) { /* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */ +#line 9183 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav" +#line 9183 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\ "e t,s,m,a,n,r,b,f or 0-8 after C!", ( ftnlen)128, (ftnlen)41); +#line 9185 "" stop1_(); +#line 9186 "" } /* gotclef = .true. */ +#line 9188 "" goto L110; /* +++ */ +#line 9190 "" } else /* if(complicated condition) */ { +#line 9190 "" i__4 = a1ll_2.iccount; +#line 9190 "" i__5 = a1ll_2.iccount + 1; +#line 9190 "" if (*(unsigned char *)durq == ']' && s_cmp(lineq + i__4, "[", a1ll_2.iccount + 1 - i__4, (ftnlen) 1) == 0 && s_cmp(lineq + i__5, " ", a1ll_2.iccount + 2 - i__5, (ftnlen)1) == 0) { +#line 9192 "" a1ll_2.iccount += 2; +#line 9193 "" goto L110; /* +++ */ +#line 9195 "" } +#line 9195 "" } +#line 9195 "" } /* End of xtup options. At this point symbol can only be note or rest */ +#line 9199 "" if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) { +#line 9200 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch" +#line 9200 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"\ "aracter is not allowed!", (ftnlen)128, (ftnlen)39) ; +#line 9202 "" stop1_(); -/* else if (durq.eq.'r' .and. itup.eq.ntup) then */ -/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ -/* * 'Sorry, PMX cannot end an xtuplet with a rest!') */ -/* call stop1() */ - } else /* if(complicated condition) */ { - i__4 = a1ll_2.iccount; - if (*(unsigned char *)durq == 'r' && itup == ntup && - i_indx(lineq + i__4, "b", a1ll_2.iccount + 2 - - i__4, (ftnlen)1) == 0) { - i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Sorry, PMX c" - "annot end an xtuplet with a non-blank rest!", - (ftnlen)128, (ftnlen)55); - stop1_(); - } +#line 9203 "" } +#line 9204 "" L7: +#line 9204 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); - if (i_indx("2345678ulcb", durq, (ftnlen)11, (ftnlen)1) > 0) { +/* if (index('2345678ulcb',durq) .gt. 0) then */ +#line 9206 "" + if (i_indx("12345678ulcb", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 9207 "" goto L7; +#line 9208 "" } else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */ +#line 9212 "" i__4 = a1ll_2.iccount; +#line 9212 "" if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, ( ftnlen)1) == 0) { +#line 9212 "" ++a1ll_2.iccount; +#line 9212 "" } +#line 9213 "" goto L7; +#line 9214 "" } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { /* May have either octave jump or shifted accid. on main xtup note */ +#line 9218 "" i__4 = a1ll_2.iccount; +#line 9218 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0 && i_indx("01234567890", lineq + i__4, (ftnlen)11, a1ll_2.iccount + 1 - i__4) == 0) { +#line 9218 "" goto L7; +#line 9218 "" } +#line 9221 "" ++a1ll_2.iccount; +#line 9222 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 9223 "" --a1ll_2.iccount; +#line 9224 "" goto L7; +#line 9225 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double an xtup note to make an unequal xtup */ +#line 9229 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18); +#line 9230 "" ++ndoub; +#line 9231 "" goto L7; +#line 9232 "" } else if (*(unsigned char *)durq == 'd') { +#line 9233 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],27); +#line 9234 "" goto L7; +#line 9235 "" } else if (*(unsigned char *)durq != ' ') { +#line 9236 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o" +#line 9236 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"\ "n xtuplet note!", (ftnlen)128, (ftnlen)31); +#line 9238 "" stop1_(); +#line 9239 "" } +#line 9240 "" if (itup == ntup - ndoub) { +#line 9240 "" goto L3; +#line 9240 "" } +#line 9241 "" /* L6: */ +#line 9241 "" } +#line 9242 "" L3: /* 6==End of loop for xtuplet input */ +#line 9246 "" ; +#line 9246 "" } else if (*(unsigned char *)durq == 'm') { /* Multi-bar rest: next 1 or two digits are # of bars. */ +#line 9250 "" if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) { +#line 9251 "" i__1 = a1ll_2.iccount - 1; +#line 9251 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be" +#line 9251 "" + errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"\ "ginning of bar!", (ftnlen)128, (ftnlen)45); +#line 9253 "" stop1_(); +#line 9254 "" } else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) { +#line 9255 "" i__1 = a1ll_2.iccount - 1; +#line 9255 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t" +#line 9255 "" + errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"\ "ime per block!", (ftnlen)128, (ftnlen)44); +#line 9257 "" stop1_(); +#line 9258 "" } /* For some purposes, pretend its one bar only */ +#line 9262 "" a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] = a1ll_2.lenbar; +#line 9263 "" c1omnotes_1.ibarmbr = a1ll_2.nbars + 1; +#line 9264 "" c1omnotes_1.mbrest = 0; /* 20 call g1etchar(lineq,iccount,durq) */ +#line 9266 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9267 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 9268 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer " +#line 9268 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "\ "after \"rm\"!", (ftnlen)128, (ftnlen)31); +#line 9270 "" stop1_(); +#line 9271 "" } +#line 9272 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9273 "" c1omnotes_1.mbrest = i_nint(&fnum); +#line 9274 "" --a1ll_2.iccount; /* if (ichar(durq).ge.48.and.ichar(durq).le.57) then */ /* mbrest = 10*mbrest+ichar(durq)-48 */ /* go to 20 */ /* end if */ +#line 9279 "" if (a1ll_2.nv > 1) { +#line 9280 "" if (a1ll_2.iv == 1) { +#line 9281 "" comkeys_1.mbrestsav = c1omnotes_1.mbrest; +#line 9282 "" } else { +#line 9283 "" if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) { +#line 9284 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s" +#line 9284 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"\ "ame multi-bar rest in every voice!", (ftnlen) 128, (ftnlen)46); +#line 9286 "" stop1_(); +#line 9287 "" } +#line 9288 "" } /* Zero out mbrestsav so can check at end of input block whether */ /* all voices have one */ +#line 9293 "" if (a1ll_2.iv == a1ll_2.nv) { +#line 9293 "" comkeys_1.mbrestsav = 0; +#line 9293 "" } +#line 9294 "" } +#line 9295 "" if (*(unsigned char *)durq != ' ') { +#line 9296 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" +#line 9296 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ "ter \"rm\"!", (ftnlen)128, (ftnlen)29); +#line 9298 "" stop1_(); +#line 9299 "" } +#line 9300 "" } else if (*(unsigned char *)durq == '.') { /* Dotted pattern. Close out note. Mult time by 3/4. */ /* Set time for next note to 1/4. Start the note. */ +#line 9305 "" idotform = 1; +#line 9306 "" } else if (*(unsigned char *)durq == ',') { +#line 9307 "" idotform = 3; /* Now flow to duration setting, as if durq=' ' */ +#line 9311 "" } else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Suppress full bar rest, or look left for height */ +#line 9315 "" if (*(unsigned char *)charq != 'r') { +#line 9316 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options " +#line 9316 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "\ "only legal for rest, not note!", (ftnlen)128, (ftnlen) 46); +#line 9318 "" stop1_(); +#line 9319 "" } +#line 9320 "" goto L2; +#line 9321 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double note for xtup. Must check here in case "D" or "F" came before "x" or on */ /* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */ +#line 9326 "" c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25],18); +#line 9327 "" goto L2; +#line 9328 "" } else if (*(unsigned char *)durq == 'A') { /* Main note accidental option */ +#line 9332 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9333 "" if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 9334 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\"" +#line 9334 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""\ "<\",\">\" are the only legal options here!", (ftnlen) 128, (ftnlen)51); +#line 9336 "" stop1_(); +#line 9337 "" } /* Need more stuff here */ +#line 9341 "" if (*(unsigned char *)durq != 'o') { /* Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will */ /* proceed to number input checking */ +#line 9346 "" --a1ll_2.iccount; +#line 9347 "" } +#line 9348 "" goto L2; +#line 9349 "" + } else if (*(unsigned char *)durq == 'T') { + +/* Single stem tremolo. Only option (optional) is 1,2,3, or 4. */ + +#line 9353 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9354 "" + if (i_indx("1234", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9354 "" + --a1ll_2.iccount; +#line 9354 "" + } +#line 9355 "" + goto L2; +#line 9356 "" } else if (*(unsigned char *)durq != ' ') { +#line 9357 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9357 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", ( ftnlen)128, (ftnlen)18); - s_wsle(&io___623); +#line 9359 "" + s_wsle(&io___654); +#line 9359 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 9359 "" i__1 = *(unsigned char *)durq; +#line 9359 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 9359 "" e_wsle(); +#line 9360 "" stop1_(); +#line 9361 "" } /* End of block for note options. */ /* Set the duration */ +#line 9367 "" if (idotform > 0) { +#line 9368 "" if (idotform == 1) { +#line 9369 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, ( ftnlen)1) * 3 / 2; +#line 9370 "" } else if (idotform == 2) { +#line 9371 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[ c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 3; +#line 9372 "" } else if (idotform == 3) { +#line 9373 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, ( ftnlen)1); +#line 9374 "" } else if (idotform == 4) { +#line 9375 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[ c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 2; +#line 9376 "" } +#line 9377 "" } else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) { +#line 9378 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (ftnlen)1); /* Check for double dot */ +#line 9382 "" if (c1omnotes_1.iddot == 1) { +#line 9383 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25] * 7 / 6; +#line 9384 "" c1omnotes_1.iddot = 0; +#line 9385 "" } +#line 9386 "" } else if (fulbrp) { +#line 9387 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.lenbar; /* Use a one-line function to set nnodur. It gives inverse of ifnodur. */ +#line 9391 "" i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48; +#line 9391 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 9391 "" c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, ( ftnlen)1) - 1; +#line 9393 "" fulbrp = FALSE_; +#line 9394 "" } +#line 9395 "" a1ll_2.rest[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq == 'r'; /* If inside forced beam, check if note is beamable */ +#line 9399 "" if (c1omget_1.fbon) { +#line 9400 "" if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] < 16) { +#line 9400 "" goto L120; +#line 9400 "" } +#line 9401 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) { +#line 9402 "" if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1) * 24 - 25] == 0) { +#line 9402 "" goto L120; +#line 9402 "" } +#line 9403 "" } +#line 9404 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc" +#line 9404 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"\ "ed beam!", (ftnlen)128, (ftnlen)32); +#line 9406 "" stop1_(); +#line 9407 "" } +#line 9408 "" L120: /* Get number of prior bars for later check on whether note spans bar line */ +#line 9412 "" nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; +#line 9413 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25]; +#line 9414 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) { +#line 9415 "" ++a1ll_2.nbars; +#line 9416 "" if (comkeys_1.shifton) { +#line 9416 "" comkeys_1.barend = TRUE_; +#line 9416 "" } /* Will check barend when 1st note of next bar is entered. */ +#line 9420 "" if (a1ll_2.nbars > 15) { +#line 9421 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha" +#line 9421 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"\ "n 15 bars in an input block!", (ftnlen)128, (ftnlen) 48); +#line 9423 "" stop1_(); +#line 9424 "" } +#line 9425 "" a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[ c1ommvl_1.ivx - 1]; +#line 9426 "" if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) { /* Just finished the pickup bar for this voice. */ +#line 9430 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) { +#line 9431 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt" +#line 9431 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"\ "h disagrees with mtrnum0!", (ftnlen)128, (ftnlen) 41); +#line 9433 "" stop1_(); +#line 9434 "" } +#line 9435 "" a1ll_2.lenbar = a1ll_2.lenbr1; +#line 9436 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; +#line 9437 "" } +#line 9438 "" } else if (comkeys_1.barend) { +#line 9439 "" if (comkeys_1.shifton) { +#line 9440 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#line 9440 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 9442 "" stop1_(); +#line 9443 "" } +#line 9444 "" comkeys_1.barend = FALSE_; +#line 9445 "" } else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) { +#line 9446 "" i__1 = a1ll_2.iccount - 1; +#line 9446 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9446 "" errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", ( ftnlen)128, (ftnlen)27); +#line 9448 "" stop1_(); +#line 9449 "" } +#line 9450 "" if (idotform == 1 || idotform == 3) { +#line 9451 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9452 "" if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) { +#line 9453 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o" +#line 9453 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"\ "r \"r\" here!", (ftnlen)128, (ftnlen)31); +#line 9455 "" stop1_(); +#line 9456 "" } +#line 9457 "" ++idotform; +#line 9458 "" numnum = 1; +#line 9459 "" goto L28; +#line 9460 "" } /* End of sub block for note-rest */ +#line 9464 "" } else if (*(unsigned char *)charq == 'z') { +#line 9465 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9466 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 9467 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name" +#line 9467 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"\ " here!", (ftnlen)128, (ftnlen)30); +#line 9469 "" stop1_(); +#line 9470 "" } +#line 9471 "" L25: +#line 9471 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); /* if (index('dre12345678',durq) .gt. 0) then */ +#line 9473 "" if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 9474 "" goto L25; +#line 9475 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */ /* MUST come right after "f,s,n" */ +#line 9480 "" i__1 = a1ll_2.iccount; +#line 9480 "" if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 9480 "" ++a1ll_2.iccount; +#line 9480 "" } +#line 9481 "" goto L25; +#line 9482 "" } else if (*(unsigned char *)durq == 'A') { +#line 9483 "" i__1 = a1ll_2.iccount - 2; +#line 9483 "" if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 - i__1) == 0) { +#line 9484 "" i__1 = a1ll_2.iccount - 1; +#line 9484 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \"" +#line 9484 "" + errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""\ "A\" in chord note!", (ftnlen)128, (ftnlen)43); +#line 9486 "" stop1_(); +#line 9487 "" } +#line 9488 "" goto L25; +#line 9489 "" } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9490 "" i__1 = a1ll_2.iccount - 2; +#line 9490 "" if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - i__1) == 0) { /* if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems */ +#line 9492 "" i__1 = a1ll_2.iccount - 1; +#line 9492 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before" +#line 9492 "" + errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"\ " \"<\" or \">\"!", (ftnlen)128, (ftnlen)38); +#line 9494 "" stop1_(); +#line 9495 "" } +#line 9496 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9497 "" if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9498 "" i__1 = a1ll_2.iccount - 1; +#line 9498 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Expected a number to start her" +#line 9498 "" + errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"\ "e for accidental shift!", (ftnlen)128, (ftnlen)53); +#line 9500 "" stop1_(); +#line 9501 "" } +#line 9502 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9503 "" --a1ll_2.iccount; +#line 9504 "" goto L25; +#line 9505 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9506 "" i__1 = a1ll_2.iccount; +#line 9506 "" if (i_indx("1234567890.", lineq + i__1, (ftnlen)11, a1ll_2.iccount + 1 - i__1) == 0) { +#line 9506 "" goto L25; +#line 9506 "" } /* Number or '.' (durq) follows +/- . Get it. */ +#line 9511 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9512 "" i__1 = a1ll_2.iccount; +#line 9512 "" if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) { +#line 9514 "" i__1 = a1ll_2.iccount - 1; +#line 9514 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by" +#line 9514 "" + errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"\ " a digit!", (ftnlen)128, (ftnlen)37); +#line 9516 "" stop1_(); +#line 9517 "" } else /* if(complicated condition) */ { +#line 9517 "" i__1 = a1ll_2.iccount - 3; +#line 9517 "" if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount - 2 - i__1) == 0) { +#line 9518 "" i__1 = a1ll_2.iccount - 1; +#line 9518 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll" +#line 9518 "" + errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"\ "ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41); +#line 9520 "" stop1_(); +#line 9521 "" } +#line 9521 "" } +#line 9522 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9523 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9524 "" --a1ll_2.iccount; +#line 9525 "" goto L25; +#line 9526 "" } /* 2nd +/- */ +#line 9530 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9531 "" if (*(unsigned char *)durq == '.') { +#line 9531 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 9531 "" } +#line 9532 "" if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 9533 "" i__1 = a1ll_2.iccount - 1; +#line 9533 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9533 "" errmsg_(lineq, &i__1, &i__4, "Expected a number here!", ( ftnlen)128, (ftnlen)23); +#line 9535 "" stop1_(); +#line 9536 "" } +#line 9537 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9538 "" --a1ll_2.iccount; +#line 9539 "" goto L25; +#line 9540 "" } else if (*(unsigned char *)durq != ' ') { +#line 9541 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho" +#line 9541 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"\ "rd note!", (ftnlen)128, (ftnlen)32); +#line 9543 "" stop1_(); +#line 9544 "" } +#line 9545 "" } else if (*(unsigned char *)charq == 'G') { +#line 9546 "" ngr = 1; +#line 9547 "" L9: +#line 9547 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9548 "" if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { +#line 9549 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9550 "" ngr = i_nint(&fnum); +#line 9551 "" --a1ll_2.iccount; +#line 9552 "" goto L9; +#line 9553 "" } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9554 "" goto L9; +#line 9555 "" } else if (*(unsigned char *)charq == 'm') { +#line 9556 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9557 "" if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) { +#line 9558 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 " +#line 9558 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "\ "must follow \"m\" in a grace note!", (ftnlen)128, ( ftnlen)52); +#line 9560 "" stop1_(); +#line 9561 "" } +#line 9562 "" goto L9; +#line 9563 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note */ +#line 9567 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9568 "" if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) { +#line 9569 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9570 "" --a1ll_2.iccount; +#line 9571 "" goto L9; +#line 9572 "" } else { +#line 9573 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll" +#line 9573 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"\ "ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41); +#line 9575 "" stop1_(); +#line 9576 "" } +#line 9577 "" } /* At this point, charq is first note name in rest (grace?) */ +#line 9581 "" i__1 = ngr; +#line 9581 "" for (igr = 1; igr <= i__1; ++igr) { +#line 9582 "" numnum = 0; +#line 9583 "" if (igr > 1) { +#line 9584 "" L55: +#line 9584 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) 1); +#line 9585 "" if (*(unsigned char *)charq == ' ') { +#line 9585 "" goto L55; +#line 9585 "" } +#line 9586 "" } +#line 9587 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 9588 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected" +#line 9588 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"\ " \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27); +#line 9590 "" stop1_(); +#line 9591 "" } +#line 9592 "" L18: +#line 9592 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9593 "" if (*(unsigned char *)charq != ' ') { +#line 9594 "" if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) { +#line 9595 "" if (numnum == 1) { +#line 9596 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of" +#line 9596 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"\ " \"+-1234567\" allowed here in grace!", ( ftnlen)128, (ftnlen)46); +#line 9598 "" stop1_(); +#line 9599 "" } +#line 9600 "" numnum = 1; +#line 9601 "" goto L18; /* else if (index('nfs',charq) .gt. 0) then */ +#line 9603 "" } else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) { +#line 9604 "" goto L18; +#line 9605 "" } /* Digits are possible octave numbers */ +#line 9609 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af" +#line 9609 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"\ "ter note name in grace!", (ftnlen)128, (ftnlen)43); +#line 9611 "" stop1_(); +#line 9612 "" } +#line 9613 "" /* L19: */ +#line 9613 "" } +#line 9614 "" } else /* if(complicated condition) */ { +#line 9614 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 9614 "" if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) { +#line 9615 "" chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); +#line 9616 "" if (literr > 0) { +#line 9617 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9617 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) * 51, (ftnlen)128, (ftnlen)51); +#line 9619 "" stop1_(); +#line 9620 "" } +#line 9621 "" } else if (*(unsigned char *)charq == '"') { /* pmx lyric */ +#line 9625 "" chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128); +#line 9626 "" if (lyrerr > 0) { +#line 9627 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9627 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51); +#line 9629 "" stop1_(); +#line 9630 "" } +#line 9631 "" } else if (*(unsigned char *)charq == 'o') { /* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */ +#line 9635 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { +#line 9636 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam" +#line 9636 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"\ "e input block, after affected note!", (ftnlen)128, ( ftnlen)53); +#line 9638 "" stop1_(); +#line 9639 "" } +#line 9640 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); /* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */ +#line 9642 "" if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (ftnlen)1) == 0) { +#line 9643 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9643 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", ( ftnlen)128, (ftnlen)17); +#line 9645 "" stop1_(); +#line 9646 "" } +#line 9647 "" if (*(unsigned char *)dumq == ':') { +#line 9648 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9649 "" if (*(unsigned char *)dumq != ' ') { +#line 9650 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a" +#line 9650 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"\ "fter \"o:\"!", (ftnlen)128, (ftnlen)26); +#line 9652 "" stop1_(); +#line 9653 "" } else if (! comkeys_1.ornrpt) { +#line 9654 "" i__1 = a1ll_2.iccount - 1; +#line 9654 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname" +#line 9654 "" + errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"\ "nts before they were on!", (ftnlen)128, (ftnlen) 50); +#line 9656 "" stop1_(); +#line 9657 "" } +#line 9658 "" comkeys_1.ornrpt = FALSE_; +#line 9659 "" } else if (*(unsigned char *)dumq == 'g') { +#line 9660 "" if (c1omget_1.issegno) { +#line 9661 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one" +#line 9661 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"\ " \"segno\" per input block!", (ftnlen)128, ( ftnlen)40); +#line 9663 "" stop1_(); +#line 9664 "" } else if (c1ommvl_1.ivx != 1) { +#line 9665 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b" +#line 9665 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"\ "e in voice 1!", (ftnlen)128, (ftnlen)29); +#line 9667 "" stop1_(); +#line 9668 "" } +#line 9669 "" c1omget_1.issegno = TRUE_; +#line 9670 "" L12: +#line 9670 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9671 "" if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >= 48 && *(unsigned char *)dumq <= 58) { +#line 9671 "" goto L12; +#line 9671 "" } +#line 9673 "" if (*(unsigned char *)dumq != ' ') { +#line 9674 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 9674 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r in segno ornament symbol!", (ftnlen)128, ( ftnlen)43); +#line 9676 "" stop1_(); +#line 9677 "" } +#line 9678 "" } else if (*(unsigned char *)dumq == 'T') { /* Trill. may be followed by 't' and/or number. read 'til blank */ +#line 9682 "" L22: +#line 9682 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9683 "" if (*(unsigned char *)dumq == ':') { +#line 9684 "" i__1 = a1ll_2.iccount; +#line 9684 "" if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) != 0) { +#line 9685 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla" +#line 9685 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\ "nk after \":\"!", (ftnlen)128, (ftnlen)25); +#line 9687 "" stop1_(); +#line 9688 "" } +#line 9689 "" goto L32; +#line 9690 "" } else if (*(unsigned char *)dumq != ' ') { +#line 9691 "" goto L22; +#line 9692 "" } +#line 9693 "" } else if (*(unsigned char *)dumq == 'f') { +#line 9694 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9695 "" if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) { +#line 9696 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 9696 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after \"f\" in fermata ornament symbol!", ( ftnlen)128, (ftnlen)55); +#line 9698 "" stop1_(); +#line 9699 "" } +#line 9700 "" if (*(unsigned char *)dumq == 'd') { +#line 9700 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 9700 "" } +#line 9701 "" if (*(unsigned char *)dumq == ':') { +#line 9701 "" goto L32; +#line 9701 "" } +#line 9702 "" } else if (*(unsigned char *)dumq == 'e') { +#line 9703 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9704 "" if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9705 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 9705 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after \"e\" in edit. accid. symbol!", (ftnlen) 128, (ftnlen)51); +#line 9707 "" stop1_(); +#line 9708 "" } +#line 9709 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9710 "" if (*(unsigned char *)dumq == '?') { +#line 9710 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 9710 "" } +#line 9711 "" } else { +#line 9712 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9713 "" } +#line 9714 "" if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9715 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#line 9715 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ " ornament symbol!", (ftnlen)128, (ftnlen)37); +#line 9717 "" stop1_(); +#line 9718 "" } +#line 9719 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9720 "" i__1 = a1ll_2.iccount; +#line 9720 "" if (i_indx("0123456789", lineq + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) { +#line 9721 "" i__1 = a1ll_2.iccount + 1; +#line 9721 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "There should be an integer" +#line 9721 "" + errmsg_(lineq, &i__1, &i__4, "There should be an integer"\ " here!", (ftnlen)128, (ftnlen)32); +#line 9723 "" stop1_(); +#line 9724 "" } +#line 9725 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9726 "" if (*(unsigned char *)durq == ':') { +#line 9727 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND" +#line 9727 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"\ " repeat an ornament!", (ftnlen)128, (ftnlen)36); +#line 9729 "" stop1_(); +#line 9730 "" } /* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */ +#line 9734 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9735 "" i__1 = a1ll_2.iccount; +#line 9735 "" if (i_indx(".0123456789", lineq + i__1, (ftnlen)11, a1ll_2.iccount + 1 - i__1) == 0) { +#line 9737 "" i__1 = a1ll_2.iccount + 1; +#line 9737 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "There should be a numb" +#line 9737 "" + errmsg_(lineq, &i__1, &i__4, "There should be a numb"\ "er here!", (ftnlen)128, (ftnlen)30); +#line 9739 "" stop1_(); +#line 9740 "" } +#line 9741 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 9742 "" } +#line 9743 "" } +#line 9744 "" L32: +#line 9745 "" if (*(unsigned char *)dumq == ':') { +#line 9746 "" i__1 = a1ll_2.iccount; +#line 9746 "" if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) != 0) { +#line 9747 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo" +#line 9747 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"\ "llowed by blank in \"o: \"!", (ftnlen)128, ( ftnlen)39); +#line 9749 "" stop1_(); +#line 9750 "" } else if (comkeys_1.ornrpt) { +#line 9751 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat" +#line 9751 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"\ "ed ornaments but already on!", (ftnlen)128, ( ftnlen)44); +#line 9753 "" stop1_(); +#line 9754 "" } +#line 9755 "" comkeys_1.ornrpt = TRUE_; +#line 9756 "" } +#line 9757 "" } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9758 "" numint = 0; +#line 9759 "" iposn = 0; +#line 9760 "" L8: +#line 9760 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); +#line 9761 "" ++iposn; +#line 9762 "" if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq == 't') { +#line 9763 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as " +#line 9763 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "\ "an option on a tie!", (ftnlen)128, (ftnlen)37); +#line 9765 "" stop1_(); +#line 9766 "" } +#line 9767 "" if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == 0) { /* Check for explicit ID code. */ +#line 9771 "" ic = *(unsigned char *)dumq; +#line 9772 "" if (ic < 48 || ic > 57 && ic < 65 || ic > 90) { /* Not 0-9 or A-Z, so exit */ +#line 9777 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 9777 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r in slur symbol!", (ftnlen)128, (ftnlen)33); +#line 9779 "" stop1_(); +#line 9780 "" } else { /* It is a possible ID code. Right place? */ +#line 9784 "" if (iposn != 1) { /* Slur ID is not 2nd! */ +#line 9788 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must" +#line 9788 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"\ " be second character in slur symbol!", ( ftnlen)128, (ftnlen)48); +#line 9790 "" stop1_(); +#line 9791 "" } else if (*(unsigned char *)charq == 't' && comslur_1.fontslur) { +#line 9792 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not " +#line 9792 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "\ "allowed on non-postscript tie!", (ftnlen)128, (ftnlen)42); +#line 9794 "" stop1_(); +#line 9795 "" + } else /* if(complicated condition) */ { +#line 9795 "" + i__1 = a1ll_2.iccount; +#line 9795 "" + if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 - + i__1, (ftnlen)1) == 0) { +#line 9796 "" + ++a1ll_2.iccount; +#line 9797 "" + } +#line 9797 "" } +#line 9798 "" } /* Slur ID is OK. Note it cannot be "H" at this point.. */ +#line 9802 "" goto L8; +#line 9803 "" } else if (*(unsigned char *)dumq == 'H') { +#line 9804 "" if (iposn == 1) { +#line 9804 "" goto L8; +#line 9804 "" } /* "H" is NOT an ID code. */ +#line 9808 "" if (! comslur_1.fontslur && *(unsigned char *)charq == 't') { +#line 9809 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p" +#line 9809 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"\ "ostscript ties this way!", (ftnlen)128, (ftnlen) 40); +#line 9811 "" stop1_(); +#line 9812 "" } +#line 9813 "" i__1 = a1ll_2.iccount; +#line 9813 "" if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) == 0) { +#line 9814 "" ++a1ll_2.iccount; +#line 9815 "" ++iposn; +#line 9816 "" } +#line 9817 "" goto L8; +#line 9818 "" } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && ! comslur_1.fontslur && *(unsigned char *)charq == 't') { /* 3/9/03 Can't reshape postscript tie. */ +#line 9823 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts" +#line 9823 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"\ "cript ties this way!", (ftnlen)128, (ftnlen)40); +#line 9825 "" stop1_(); +#line 9826 "" } else if (*(unsigned char *)dumq == 'p') { /* local change in postscript slur/tie adjustment default */ +#line 9830 "" if (comslur_1.fontslur) { +#line 9831 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr" +#line 9831 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"\ "ipt slurs (\"Ap\") to use this option!", (ftnlen) 128, (ftnlen)52); +#line 9833 "" stop1_(); +#line 9834 "" } +#line 9835 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9836 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9837 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o" +#line 9837 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"\ "r \"-\" here!", (ftnlen)128, (ftnlen)25); +#line 9839 "" stop1_(); +#line 9840 "" } +#line 9841 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9842 "" if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9843 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o" +#line 9843 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"\ "r \"t\" here!", (ftnlen)128, (ftnlen)25); +#line 9845 "" stop1_(); +#line 9846 "" } +#line 9847 "" iposn += 2; +#line 9848 "" goto L8; +#line 9849 "" } +#line 9850 "" if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) { +#line 9851 "" goto L8; +#line 9852 "" } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9853 "" ++numint; +#line 9854 "" if (comslur_1.fontslur && *(unsigned char *)charq == 't') { +#line 9855 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur" +#line 9855 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"\ " height only allowed in \"s\"-slurs!", (ftnlen) 128, (ftnlen)48); +#line 9857 "" stop1_(); +#line 9858 "" } +#line 9859 "" ++a1ll_2.iccount; +#line 9860 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9861 "" if (numint == 1) { +#line 9862 "" if (i_nint(&fnum) > 30) { +#line 9863 "" i__1 = a1ll_2.iccount - 1; +#line 9863 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig" +#line 9863 "" + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\ "ht adjustment cannot exceed 30!", (ftnlen)128, (ftnlen)53); +#line 9865 "" stop1_(); +#line 9866 "" } +#line 9867 "" } else if (numint == 2) { +#line 9868 "" if (dabs(fnum) > 6.3f) { +#line 9869 "" i__1 = a1ll_2.iccount - 1; +#line 9869 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must " +#line 9869 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ "be in range (-6.3,6.3)!", (ftnlen)128, ( ftnlen)45); +#line 9871 "" stop1_(); +#line 9872 "" } +#line 9873 "" } else { /* Third signed integer, must be a midslur or curve spec. */ +#line 9877 "" if (dabs(fnum) > 31.f) { +#line 9878 "" i__1 = a1ll_2.iccount - 1; +#line 9878 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Slur midheight must be" +#line 9878 "" + errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"\ " in the range (-31,31)!", (ftnlen)128, ( ftnlen)45); +#line 9880 "" stop1_(); +#line 9881 "" } +#line 9882 "" if (*(unsigned char *)durq == ':') { /* Expecting curve parameters. Get two numbers */ +#line 9886 "" for (i__ = 1; i__ <= 2; ++i__) { +#line 9887 "" ++a1ll_2.iccount; +#line 9888 "" fnum = (real) (*(unsigned char *)&lineq[ a1ll_2.iccount - 1] - 48); +#line 9889 "" if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { +#line 9890 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur" - " curve parameter must be in range (0" +#line 9890 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"\ + " curve parameter must be in range (0"\ ",7)!", (ftnlen)128, (ftnlen)44); +#line 9892 "" stop1_(); +#line 9893 "" } +#line 9894 "" /* L41: */ +#line 9894 "" } +#line 9895 "" ++a1ll_2.iccount; +#line 9896 "" } +#line 9897 "" } +#line 9898 "" --a1ll_2.iccount; +#line 9899 "" goto L8; +#line 9900 "" } else if (*(unsigned char *)dumq == 's') { /* What follows should be one or two signed numbers for adjustment of line break */ /* slur, end of 1st segment or start of second. */ +#line 9905 "" if (comslur_1.fontslur) { +#line 9906 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line" +#line 9906 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"\ "break slur options with font-based slurs!", ( ftnlen)128, (ftnlen)57); +#line 9908 "" stop1_(); +#line 9909 "" } +#line 9910 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) 1); +#line 9911 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9912 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m" +#line 9912 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"\ "ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34); +#line 9914 "" stop1_(); +#line 9915 "" } +#line 9916 "" ++a1ll_2.iccount; +#line 9917 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9918 "" if (i_nint(&fnum) > 30) { +#line 9919 "" i__1 = a1ll_2.iccount - 1; +#line 9919 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a" +#line 9919 "" + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"\ "djustment cannot exceed 30!", (ftnlen)128, ( ftnlen)53); +#line 9921 "" stop1_(); +#line 9922 "" } +#line 9923 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9924 "" ++a1ll_2.iccount; +#line 9925 "" readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 9926 "" if (dabs(fnum) > 6.3f) { +#line 9927 "" i__1 = a1ll_2.iccount - 1; +#line 9927 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must " +#line 9927 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ "be in range (-6.3,6.3)!", (ftnlen)128, ( ftnlen)45); +#line 9929 "" stop1_(); +#line 9930 "" } +#line 9931 "" } +#line 9932 "" --a1ll_2.iccount; +#line 9933 "" goto L8; +#line 9934 "" } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { +#line 9935 "" i__1 = a1ll_2.iccount; +#line 9935 "" if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) == 0) { +#line 9935 "" ++a1ll_2.iccount; +#line 9935 "" } +#line 9936 "" goto L8; +#line 9937 "" } +#line 9938 "" } else if (*(unsigned char *)charq == '?') { +#line 9939 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9940 "" if (*(unsigned char *)durq == ' ') { +#line 9941 "" --a1ll_2.iccount; +#line 9942 "" } else { +#line 9943 "" if (*(unsigned char *)durq != '-') { +#line 9944 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9944 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!", (ftnlen)128, (ftnlen)14); +#line 9946 "" stop1_(); +#line 9947 "" } +#line 9948 "" getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) ; +#line 9949 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9950 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 9950 "" errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!" , (ftnlen)128, (ftnlen)17); +#line 9952 "" stop1_(); +#line 9953 "" } +#line 9954 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9955 "" --a1ll_2.iccount; +#line 9956 "" } +#line 9957 "" } else if (*(unsigned char *)charq >= 48 && *(unsigned char *)charq <= 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen)1) > 0) { /* We have a figure. Must come AFTER the note it goes under */ +#line 9962 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (! a1ll_2.firstline || a1ll_2.lenbr0 == 0 || a1ll_2.lenbar == a1ll_2.lenbr0)) { /* Figure before first note in block */ +#line 9967 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be" +#line 9967 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"\ "fore first note in block!", (ftnlen)128, (ftnlen)45); +#line 9969 "" stop1_(); +#line 9970 "" } +#line 9971 "" if (*(unsigned char *)charq == 'x') { +#line 9972 "" indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - ( a1ll_2.iccount - 1), (ftnlen)1); +#line 9973 "" if (indxb < 5) { +#line 9974 "" i__1 = a1ll_2.iccount + indxb - 1; +#line 9974 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i" +#line 9974 "" + errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"\ "n floating figure!", (ftnlen)128, (ftnlen)44); +#line 9976 "" stop1_(); +#line 9977 "" } +#line 9978 "" } +#line 9979 "" if (compage_1.usefig) { +#line 9979 "" *ifig = 1; +#line 9979 "" } +#line 9980 "" L5: +#line 9980 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9981 "" if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (ftnlen)1) == 0) { +#line 9982 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#line 9982 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ " figure!", (ftnlen)128, (ftnlen)28); +#line 9984 "" stop1_(); +#line 9985 "" } else if (*(unsigned char *)charq == '+') { /* vertical offset, must be integer, then blank */ +#line 9989 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) 1); +#line 9990 "" if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) { +#line 9991 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert" +#line 9991 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"\ "ical offset expected here!", (ftnlen)128, (ftnlen) 42); +#line 9993 "" stop1_(); +#line 9994 "" } +#line 9995 "" readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 9996 "" if (*(unsigned char *)charq != ' ') { +#line 9997 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset " +#line 9997 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "\ "must terminate figure!", (ftnlen)128, (ftnlen)38); +#line 9999 "" stop1_(); +#line 10000 "" } +#line 10001 "" --a1ll_2.iccount; +#line 10002 "" goto L5; +#line 10003 "" } else if (*(unsigned char *)charq == 's') { +#line 10004 "" comligfont_1.isligfont = TRUE_; +#line 10005 "" } +#line 10006 "" if (*(unsigned char *)charq != ' ') { +#line 10006 "" goto L5; +#line 10006 "" } +#line 10007 "" } else if (*(unsigned char *)charq == '[') { +#line 10008 "" if (c1omget_1.fbon) { +#line 10009 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam " +#line 10009 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "\ "while another was open!", (ftnlen)128, (ftnlen)43); +#line 10011 "" stop1_(); +#line 10012 "" } +#line 10013 "" c1omget_1.fbon = TRUE_; +#line 10014 "" L17: +#line 10014 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10015 "" if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 10016 "" goto L17; +#line 10017 "" } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { +#line 10018 "" ++a1ll_2.iccount; +#line 10019 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 10020 "" --a1ll_2.iccount; +#line 10021 "" goto L17; +#line 10022 "" } else if (*(unsigned char *)charq == 'm') { /* Forced multiplicity, next char should be 1-4 */ +#line 10026 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) 1); +#line 10027 "" if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) { +#line 10028 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic" +#line 10028 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"\ "ity for a beam must be 1, 2, 3, or 4!", (ftnlen) 128, (ftnlen)53); +#line 10030 "" stop1_(); +#line 10031 "" } +#line 10032 "" goto L17; +#line 10033 "" } else if (*(unsigned char *)charq != ' ') { +#line 10034 "" if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) { +#line 10035 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig" +#line 10035 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\ "its must now be preceeded by \"+\" or \"-\"!", ( ftnlen)128, (ftnlen)54); - s_wsle(&io___626); - do_lio(&c__9, &c__1, "You will have to edit older source" +#line 10037 "" + s_wsle(&io___657); +#line 10037 "" + do_lio(&c__9, &c__1, "You will have to edit older source"\ "s to meet this rqmt,", (ftnlen)54); +#line 10037 "" e_wsle(); - s_wsle(&io___627); - do_lio(&c__9, &c__1, "but it was needed to allow 2-digit" +#line 10038 "" + s_wsle(&io___658); +#line 10038 "" + do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"\ " height adjustments.", (ftnlen)54); +#line 10038 "" e_wsle(); - s_wsle(&io___628); - do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th" +#line 10039 "" + s_wsle(&io___659); +#line 10039 "" + do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"\ "e Management", (ftnlen)46); +#line 10039 "" e_wsle(); +#line 10040 "" } else { +#line 10041 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 10041 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after [!", (ftnlen)128, (ftnlen)26); +#line 10043 "" } +#line 10044 "" stop1_(); +#line 10045 "" } +#line 10046 "" } else if (*(unsigned char *)charq == ']') { +#line 10047 "" if (! c1omget_1.fbon) { +#line 10048 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit" +#line 10048 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"\ "h no corresponding start!", (ftnlen)128, (ftnlen)45); +#line 10050 "" stop1_(); +#line 10051 "" } +#line 10052 "" g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10053 "" if (*(unsigned char *)charq == '-') { +#line 10054 "" i__1 = a1ll_2.iccount; +#line 10054 "" if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, ( ftnlen)2) != 0) { +#line 10055 "" i__1 = a1ll_2.iccount + 1; +#line 10055 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here" +#line 10055 "" + errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"\ " is \"[ \"!", (ftnlen)128, (ftnlen)35); +#line 10057 "" stop1_(); +#line 10058 "" } else { +#line 10059 "" a1ll_2.iccount += 2; +#line 10060 "" } +#line 10061 "" } else if (*(unsigned char *)charq == '[') { +#line 10062 "" i__1 = a1ll_2.iccount; +#line 10062 "" if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) != 0) { +#line 10063 "" i__1 = a1ll_2.iccount + 1; +#line 10063 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "This character must be a b" +#line 10063 "" + errmsg_(lineq, &i__1, &i__4, "This character must be a b"\ "lank!", (ftnlen)128, (ftnlen)31); +#line 10065 "" stop1_(); +#line 10066 "" } +#line 10067 "" } else { /* Forced beam is really ending */ +#line 10071 "" c1omget_1.fbon = FALSE_; +#line 10072 "" if (*(unsigned char *)charq == 'j') { +#line 10073 "" i__1 = a1ll_2.iccount; +#line 10073 "" if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) != 0) { +#line 10074 "" i__1 = a1ll_2.iccount + 1; +#line 10074 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "This character must be" +#line 10074 "" + errmsg_(lineq, &i__1, &i__4, "This character must be"\ " a blank!", (ftnlen)128, (ftnlen)31); +#line 10076 "" stop1_(); +#line 10077 "" } +#line 10078 "" } else if (*(unsigned char *)charq != ' ') { +#line 10079 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo" +#line 10079 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"\ "llowed by blank, \"j\", \"-\", or \"[\"!", ( ftnlen)128, (ftnlen)48); +#line 10081 "" stop1_(); +#line 10082 "" } +#line 10083 "" } +#line 10084 "" } else if (*(unsigned char *)charq == 'D') { /* Dynamic mark */ +#line 10088 "" if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { +#line 10089 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come " +#line 10089 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "\ "before any notes have been entered!", (ftnlen)128, ( ftnlen)53); +#line 10091 "" stop1_(); +#line 10092 "" } +#line 10093 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 10093 "" checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128); +#line 10094 "" } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) { /* Save position for later check */ +#line 10098 "" icclhw = a1ll_2.iccount; +#line 10099 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10100 "" if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) { +#line 10101 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" +#line 10101 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ "ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41) ; +#line 10103 "" stop1_(); +#line 10104 "" } +#line 10105 "" c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq == 'h'; +#line 10106 "" if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) { /* There is a header (or lower string?) */ +#line 10110 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* User-defined vert offset (\internote). */ +#line 10114 "" if (*(unsigned char *)charq != 'h') { +#line 10115 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \"" +#line 10115 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""\ "-\" not permitted here!", (ftnlen)128, ( ftnlen)30); +#line 10117 "" stop1_(); +#line 10118 "" } /* Have "h" followed by +/- . Check for digit. */ /* Can blow durq since not using fnum for now, but... */ +#line 10123 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10124 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10125 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b" +#line 10125 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"\ "e a digit here!", (ftnlen)128, (ftnlen)27); +#line 10127 "" stop1_(); +#line 10128 "" } /* Have "h" followed by +/- followed by a digit. No need to get the number. */ /* call readnum(lineq,iccount,durq,fnum) */ +#line 10133 "" } +#line 10134 "" if (*(unsigned char *)charq != 'w') { /* Header or lower string. */ +#line 10138 "" if (icclhw != 1) { +#line 10139 "" i__1 = a1ll_2.iccount - 1; +#line 10139 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be" +#line 10139 "" + errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"\ " first character in line!", (ftnlen)128, ( ftnlen)43); +#line 10141 "" stop1_(); +#line 10142 "" } /* Read past the next line, which has the string. */ +#line 10146 "" read10_(charq, &c1omget_1.lastchar, (ftnlen)1); +#line 10147 "" ++c1omget_1.nline; +#line 10148 "" a1ll_2.iccount = 128; +#line 10149 "" } else { +#line 10150 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi" +#line 10150 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"\ "dth) must be followed by a digit!", (ftnlen)128, ( ftnlen)47); +#line 10152 "" stop1_(); +#line 10153 "" } +#line 10154 "" } else { /* Height or width change spec. Check if at start of piece. */ +#line 10158 "" if (c1omnotes_1.ibarcnt > 0) { +#line 10159 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a" +#line 10159 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"\ "t top of first input block!", (ftnlen)128, ( ftnlen)43); +#line 10161 "" stop1_(); +#line 10162 "" } +#line 10163 "" readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, ( ftnlen)1); /* Check units. Convert to points */ +#line 10167 "" if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq == 'p') { +#line 10168 "" dimen += .5f; +#line 10169 "" } else if (*(unsigned char *)durq == 'i') { +#line 10170 "" dimen = dimen * 72 + .5f; +#line 10171 "" } else if (*(unsigned char *)durq == 'm') { +#line 10172 "" dimen = dimen / 25.4f * 72 + .5f; +#line 10173 "" } else { +#line 10174 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu" +#line 10174 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"\ "st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen) 36); +#line 10176 "" stop1_(); +#line 10177 "" } /* 151211 fix. May have extra character. */ +#line 10181 "" if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Get another character, see if it's blank */ +#line 10185 "" i__1 = a1ll_2.iccount; +#line 10185 "" if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( ftnlen)1) != 0) { +#line 10186 "" i__1 = a1ll_2.iccount + 1; +#line 10186 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "This character should " +#line 10186 "" + errmsg_(lineq, &i__1, &i__4, "This character should "\ "be a blank!", (ftnlen)128, (ftnlen)33); +#line 10188 "" stop1_(); +#line 10189 "" } +#line 10190 "" } +#line 10191 "" if (*(unsigned char *)charq == 'h') { +#line 10192 "" compage_1.ptheight = (real) ((integer) dimen); +#line 10193 "" } else { +#line 10194 "" compage_1.widthpt = (real) ((integer) dimen); +#line 10195 "" } +#line 10196 "" } +#line 10197 "" } else if (*(unsigned char *)charq == 'm') { /* Time signature change. Only allow at beginning of block. */ @@ -15088,28 +24890,44 @@ L17: /* Check whether at beginning of a block */ +#line 10205 "" if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 10206 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK" +#line 10206 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\ " in voice 1, at start of block!", (ftnlen)128, ( ftnlen)51); - s_wsle(&io___631); +#line 10208 "" + s_wsle(&io___662); +#line 10208 "" do_lio(&c__9, &c__1, "voice number is", (ftnlen)15); +#line 10208 "" do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof( integer)); +#line 10208 "" e_wsle(); +#line 10209 "" stop1_(); +#line 10210 "" } +#line 10211 "" a1ll_2.newmeter = TRUE_; +#line 10212 "" readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, ( ftnlen)128); +#line 10213 "" if (a1ll_2.mtrnuml == 0) { +#line 10214 "" i__1 = a1ll_2.iccount - 1; +#line 10214 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 10214 "" errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", ( ftnlen)128, (ftnlen)25); +#line 10216 "" stop1_(); /* else if (mtrdenl .eq. 1) then */ /* c */ @@ -15117,391 +24935,771 @@ L17: /* c */ /* mtrdenl = 2 */ /* mtrnuml = 2*mtrnuml */ +#line 10223 "" } +#line 10224 "" readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128); /* Read past printed time signature; not used in pmxa. */ +#line 10228 "" lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); +#line 10229 "" lenmult = 1; +#line 10230 "" if (mtrdenl == 2) { +#line 10231 "" lenbeat = 16; +#line 10232 "" lenmult = 2; +#line 10233 "" } +#line 10234 "" a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat; +#line 10235 "" a1ll_2.mtrnuml = 0; +#line 10236 "" } else if (*(unsigned char *)charq == 'C') { +#line 10237 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10238 "" if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *( unsigned char *)durq >= 48 && *(unsigned char *)durq <= 56)) { /* * (ichar(durq).ge.48 .and. ichar(durq).le.54))) then */ /* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */ +#line 10242 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n," +#line 10242 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n,"\ "r,b,f or 0-8 after C!", (ftnlen)128, (ftnlen)41); /* * 'Must have t,s,m,a,n,r,b,f or 1-6 after C!') */ +#line 10245 "" stop1_(); +#line 10246 "" } /* gotclef = .true. */ +#line 10248 "" } else if (*(unsigned char *)charq == 'R') { +#line 10249 "" if (c1ommvl_1.ivx != 1) { +#line 10250 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go " +#line 10250 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "\ "in voice 1!", (ftnlen)128, (ftnlen)31); +#line 10252 "" stop1_(); +#line 10253 "" } -L10: +/* 10 call g1etchar(lineq,iccount,durq) */ +/* if (index('lrdDbz',durq) .gt. 0) go to 10 */ +/* if (durq .ne. ' ') then */ +/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ +/* * 'Illegal character after "R" (repeat/double bar)!') */ +/* call stop1() */ +/* end if */ +#line 10261 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); - if (i_indx("lrdDbz", durq, (ftnlen)6, (ftnlen)1) > 0) { - goto L10; - } - if (*(unsigned char *)durq != ' ') { +#line 10262 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); +/* Writing concatenation */ +#line 10263 "" + i__3[0] = 1, a__2[0] = durq; +#line 10263 "" + i__3[1] = 1, a__2[1] = dumq; +#line 10263 "" + s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2); +#line 10263 "" + if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, (ftnlen) + 2) == 0) { +#line 10264 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" - "ter \"R\" (repeat/double bar)!", (ftnlen)128, (ftnlen) - 48); +#line 10264 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ + "ter \"R*\" (repeat/double bar)!", (ftnlen)128, ( + ftnlen)49); +#line 10266 "" stop1_(); +#line 10267 "" + } +#line 10268 "" + if (*(unsigned char *)dumq != ' ') { +#line 10269 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10270 "" + if (*(unsigned char *)durq != ' ') { +#line 10271 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10271 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have blank "\ + "after \"R**\" (repeat/double bar)!", (ftnlen)128, + (ftnlen)48); +#line 10273 "" + stop1_(); +#line 10274 "" + } +#line 10275 "" } +#line 10276 "" } else if (*(unsigned char *)charq == 'V') { /* Ending */ +#line 10280 "" if (a1ll_2.iv != 1) { +#line 10281 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo" +#line 10281 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"\ "wed in voice #1!", (ftnlen)128, (ftnlen)36); +#line 10283 "" stop1_(); +#line 10284 "" } else if (c1omget_1.isvolt) { - s_wsle(&io___637); +#line 10285 "" + s_wsle(&io___668); +#line 10285 "" e_wsle(); - s_wsle(&io___638); +#line 10286 "" + s_wsle(&io___669); +#line 10286 "" do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22); +#line 10286 "" e_wsle(); - s_wsfe(&io___639); +#line 10287 "" + s_wsfe(&io___670); +#line 10287 "" do_fio(&c__1, "*******WARNING********", (ftnlen)22); +#line 10287 "" e_wsfe(); +#line 10288 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o" +#line 10288 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\ "ne volta in this input block.!", (ftnlen)128, (ftnlen) 50); - s_wsle(&io___640); - do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT" +#line 10290 "" + s_wsle(&io___671); +#line 10290 "" + do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"\ " work in parts.", (ftnlen)53); +#line 10290 "" e_wsle(); - s_wsle(&io___641); - do_lio(&c__9, &c__1, "Safest to have only 1 volta per block," +#line 10291 "" + s_wsle(&io___672); +#line 10291 "" + do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"\ " at the start of the block", (ftnlen)64); +#line 10291 "" e_wsle(); - s_wsfe(&io___642); - do_fio(&c__1, "This may work in a score, but WILL NOT work i" +#line 10293 "" + s_wsfe(&io___673); +#line 10293 "" + do_fio(&c__1, "This may work in a score, but WILL NOT work i"\ "n parts.", (ftnlen)53); +#line 10293 "" e_wsfe(); - s_wsfe(&io___643); - do_fio(&c__1, "Safest to have only 1 volta per block, at the" +#line 10295 "" + s_wsfe(&io___674); +#line 10295 "" + do_fio(&c__1, "Safest to have only 1 volta per block, at the"\ " start of the block", (ftnlen)64); +#line 10295 "" e_wsfe(); +#line 10297 "" } +#line 10298 "" c1omget_1.isvolt = TRUE_; +#line 10299 "" lvoltxt = 0; +#line 10300 "" L11: +#line 10300 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10301 "" if (*(unsigned char *)durq != ' ') { +#line 10302 "" goto L11; +#line 10303 "" } +#line 10304 "" } else if (*(unsigned char *)charq == 'B') { +#line 10306 "" } else if (*(unsigned char *)charq == 'P') { +#line 10307 "" if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 10308 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi" +#line 10308 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"\ "nning of block!", (ftnlen)128, (ftnlen)35); +#line 10310 "" stop1_(); +#line 10311 "" } +#line 10312 "" L16: +#line 10312 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10313 "" if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq == 'r' || *(unsigned char *)durq >= 48 && *(unsigned char *) durq <= 57) { +#line 10313 "" goto L16; +#line 10313 "" } +#line 10315 "" if (*(unsigned char *)durq == 'c') { /* Expect a centered name, and it has to be last option */ +#line 10319 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10320 "" if (*(unsigned char *)durq == '"') { /* Quoted name, go to next quote mark */ +#line 10324 "" for (++a1ll_2.iccount; a1ll_2.iccount <= 127; ++a1ll_2.iccount) { +#line 10325 "" i__1 = a1ll_2.iccount - 2; +#line 10325 "" if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == '"' && s_cmp(lineq + i__1, "\\", a1ll_2.iccount - 1 - i__1, (ftnlen)1) != 0) { +#line 10325 "" goto L36; +#line 10325 "" } +#line 10327 "" /* L35: */ +#line 10327 "" } +#line 10328 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu" +#line 10328 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"\ "ote after page number command (P)!", (ftnlen)128, (ftnlen)50); +#line 10330 "" stop1_(); +#line 10331 "" L36: +#line 10332 "" ; +#line 10332 "" } else if (*(unsigned char *)durq != ' ') { /* Space-delimited name, look for next blank */ +#line 10336 "" for (++a1ll_2.iccount; a1ll_2.iccount <= 127; ++a1ll_2.iccount) { +#line 10337 "" if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == ' ') { +#line 10337 "" goto L38; +#line 10337 "" } +#line 10338 "" /* L37: */ +#line 10338 "" } +#line 10339 "" L38: +#line 10340 "" ; +#line 10340 "" } +#line 10341 "" } else if (*(unsigned char *)durq != ' ') { +#line 10342 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\"" +#line 10342 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""\ "c\" or digit allowed after \"P\"!", (ftnlen)128, ( ftnlen)44); +#line 10344 "" stop1_(); +#line 10345 "" } +#line 10346 "" } else if (*(unsigned char *)charq == 'W') { +#line 10347 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10348 "" if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 10349 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to" +#line 10349 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"\ " start here!", (ftnlen)128, (ftnlen)32); +#line 10351 "" stop1_(); +#line 10352 "" } +#line 10353 "" readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[ c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen) 1); +#line 10354 "" } else if (*(unsigned char *)charq == 'T') { /* Titles */ +#line 10358 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10359 "" if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) { +#line 10360 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \"" +#line 10360 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""\ "t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36); +#line 10362 "" stop1_(); +#line 10363 "" } +#line 10364 "" i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1; +#line 10364 "" c1omget_1.ihead += pow_ii(&c__2, &i__1); /* Maybe a number after 'Tt', but ignore here. Read past string on next line. */ +#line 10368 "" read10_(charq, &c1omget_1.lastchar, (ftnlen)1); +#line 10369 "" ++c1omget_1.nline; +#line 10370 "" a1ll_2.iccount = 128; +#line 10371 "" } else if (*(unsigned char *)charq == 'A') { +#line 10372 "" L27: +#line 10372 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); - if (i_indx("rbsdeK", durq, (ftnlen)6, (ftnlen)1) > 0) { +/* if (index('rbsdeK',durq) .gt. 0) then */ +#line 10374 "" + if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) { +#line 10375 "" + goto L27; +#line 10376 "" + } else if (*(unsigned char *)durq == 'e') { + +/* Check for is4bignv. Must do here to catch first \internote, written in topfile */ +/* before ever calling getnote. Initialize as .false. in pmxa. Make it true only */ +/* if nv>7, AI not set, Ai not set. */ + +#line 10382 "" + comis4bignv_1.is4bignv = a1ll_2.nv > 7 && ! + comis4bignv_1.aiset; +#line 10383 "" goto L27; +#line 10384 "" } else if (*(unsigned char *)durq == 'v') { +#line 10385 "" if (c1omnotes_1.ibarcnt == 0) { +#line 10385 "" comnvst_1.novshrinktop = TRUE_; +#line 10385 "" } +#line 10386 "" goto L27; +#line 10387 "" } else if (*(unsigned char *)durq == 'a') { +#line 10388 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10389 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 10390 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne" +#line 10390 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"\ "ed decimal number!", (ftnlen)128, (ftnlen)32); +#line 10392 "" stop1_(); +#line 10393 "" } +#line 10394 "" readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, ( ftnlen)128, (ftnlen)1); +#line 10395 "" --a1ll_2.iccount; +#line 10396 "" goto L27; +#line 10397 "" } else if (*(unsigned char *)durq == 'i') { +#line 10398 "" + comis4bignv_1.is4bignv = FALSE_; +#line 10399 "" + comis4bignv_1.aiset = TRUE_; +#line 10400 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); /* Local interstaff correction. Set to -1. if not specifiec, or after use, */ /* or anytime except at top, since pmxb handles all times except at top. */ +#line 10405 "" readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128, (ftnlen)1); +#line 10406 "" if (c1omnotes_1.ibarcnt == 0) { +#line 10406 "" compage_1.fintstf = tintstf; +#line 10406 "" } +#line 10407 "" --a1ll_2.iccount; +#line 10408 "" goto L27; +#line 10409 "" } else if (*(unsigned char *)durq == 'I') { /* Global interstaff correction. Use in place of fintstf if fintstf<0 */ +#line 10413 "" + comis4bignv_1.is4bignv = FALSE_; +#line 10414 "" + comis4bignv_1.aiset = TRUE_; +#line 10415 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10416 "" readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, ( ftnlen)128, (ftnlen)1); +#line 10417 "" --a1ll_2.iccount; +#line 10418 "" goto L27; +#line 10419 "" } else if (*(unsigned char *)durq == 'o') { +#line 10420 "" *optimize = TRUE_; +#line 10421 "" goto L27; +#line 10422 "" } else if (*(unsigned char *)durq == 'S') { /* 130324 */ /* do 50 iiv = 1 , nv */ +#line 10425 "" i__1 = comkeys_1.noinst; +#line 10425 "" for (iiv = 1; iiv <= i__1; ++iiv) { +#line 10426 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10427 "" if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 10428 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\"" +#line 10428 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""\ ", need nv instances of \"s,t,-,0\"!", (ftnlen) 128, (ftnlen)43); +#line 10430 "" stop1_(); +#line 10431 "" } +#line 10432 "" if (*(unsigned char *)durq == '-' || *(unsigned char *) durq == 's') { +#line 10433 "" comsize_1.isize[iiv - 1] = 1; +#line 10434 "" } else if (*(unsigned char *)durq == 't') { +#line 10435 "" comsize_1.isize[iiv - 1] = 2; +#line 10436 "" } +#line 10437 "" /* L50: */ +#line 10437 "" } +#line 10438 "" goto L27; +#line 10439 "" } else if (*(unsigned char *)durq == 'p') { +#line 10440 "" comslur_1.fontslur = FALSE_; +#line 10441 "" L42: +#line 10442 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10443 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Characters to change defaults for ps slurs */ +#line 10447 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10448 "" if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 10449 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters" +#line 10449 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"\ " allowed here are \"s\",\"h\",\"t\",\"c\"!", ( ftnlen)128, (ftnlen)46); +#line 10451 "" stop1_(); +#line 10452 "" } /* Now check for another default modifier */ +#line 10456 "" goto L42; +#line 10457 "" } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Flags for optional linebreak ties or header specials */ +#line 10461 "" goto L42; +#line 10462 "" } else { +#line 10463 "" --a1ll_2.iccount; +#line 10464 "" } +#line 10465 "" goto L27; +#line 10466 "" } else if (*(unsigned char *)durq == 'N') { /* Override default name for a part file. Must have part number, then */ /* partname in quotes. Must be on line by itself, and start in column 1. */ /* Will only be passed thru to scor2prt. */ +#line 10472 "" if (a1ll_2.iccount != 2) { +#line 10473 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star" +#line 10473 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"\ "t in column 1!", (ftnlen)128, (ftnlen)28); +#line 10475 "" stop1_(); +#line 10476 "" } +#line 10477 "" ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1); +#line 10478 "" if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789", lineq + 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote == 5 && i_indx("012", lineq + 3, (ftnlen)3, (ftnlen)1) == 0) { +#line 10481 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f" +#line 10481 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"\ "ollowed by inst. #, then quote!", (ftnlen)128, ( ftnlen)45); +#line 10483 "" stop1_(); +#line 10484 "" } +#line 10485 "" i__1 = ndxquote; +#line 10485 "" ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 10486 "" if (ndxquote == 0) { +#line 10487 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file " +#line 10487 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "\ "name must be in quotes!", (ftnlen)128, (ftnlen)37) ; +#line 10489 "" stop1_(); +#line 10490 "" } +#line 10491 "" a1ll_2.iccount = 128; +#line 10492 "" } else if (*(unsigned char *)durq == 'T') { +#line 10493 "" comnvst_1.cstuplet = TRUE_; +#line 10494 "" } else if (*(unsigned char *)durq == 'R') { /* Get full name of normal include file; must occupy remainder of line */ +#line 10498 "" i__1 = a1ll_2.iccount; +#line 10498 "" getpmxmod_(&c_false, lineq + i__1, 128 - i__1); +#line 10499 "" a1ll_2.iccount = 128; +#line 10500 "" } else if (*(unsigned char *)durq == 'c') { +#line 10501 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10502 "" if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10503 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or" +#line 10503 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"\ " \"4\" is allowed here!", (ftnlen)128, (ftnlen)32) ; +#line 10505 "" stop1_(); +#line 10506 "" } +#line 10507 "" if (*(unsigned char *)durq == 'l') { +#line 10508 "" compage_1.hoffpt = -25.f; +#line 10509 "" compage_1.voffpt = -45.f; +#line 10510 "" } else if (*(unsigned char *)durq == '4') { +#line 10511 "" compage_1.ptheight = 745.f; +#line 10512 "" compage_1.widthpt = 499.f; +#line 10513 "" compage_1.hoffpt = -24.f; +#line 10514 "" compage_1.voffpt = -24.f; +#line 10515 "" } +#line 10516 "" goto L27; +#line 10517 "" + } else if (*(unsigned char *)durq == 'V') { +#line 10518 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10519 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10520 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10520 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\ + " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32) + ; +#line 10522 "" + stop1_(); +#line 10523 "" + } +#line 10524 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10525 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 10526 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10526 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\ + "t shift before \\eject must start here!", (ftnlen) + 128, (ftnlen)54); +#line 10528 "" + stop1_(); +#line 10529 "" + } +#line 10530 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 10531 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10532 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10532 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\ + " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32) + ; +#line 10534 "" + stop1_(); +#line 10535 "" + } +#line 10536 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10537 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 10538 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10538 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\ + "t shift after \\eject must start here!", (ftnlen) + 128, (ftnlen)53); +#line 10540 "" + stop1_(); +#line 10541 "" + } +#line 10542 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 10543 "" + --a1ll_2.iccount; +#line 10544 "" + goto L27; +#line 10545 "" } else if (*(unsigned char *)durq != ' ') { +#line 10546 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol" - "low one of the letters abcdeiILNprRsST!", (ftnlen)128, - (ftnlen)57); +#line 10546 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"\ + "low one of abcdeiILNprRsSTvV!", (ftnlen)128, (ftnlen) + 47); /* * 'After "A" must follow one of the letters abcdeiINprRsST!') */ - s_wsle(&io___648); - do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have" +#line 10549 "" + s_wsle(&io___679); +#line 10549 "" + do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"\ " noinst args.", (ftnlen)51); +#line 10549 "" e_wsle(); - s_wsfe(&io___649); - do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst" +#line 10550 "" + s_wsfe(&io___680); +#line 10550 "" + do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"\ " args.", (ftnlen)51); +#line 10550 "" e_wsfe(); +#line 10552 "" stop1_(); +#line 10553 "" } +#line 10554 "" } else if (*(unsigned char *)charq == 'K') { /* Rules and function of K command */ @@ -15513,108 +25711,165 @@ L42: /* then adjust fbar to make poenom much more accurate. */ /* Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. */ +#line 10565 "" L77: +#line 10566 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); /* if (index('+-i',durq) .eq. 0) then */ +#line 10568 "" if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 10569 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or " +#line 10569 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "\ "key change) must be followed by \"+,-,i,n\"!", ( ftnlen)128, (ftnlen)60); +#line 10571 "" stop1_(); +#line 10572 "" } +#line 10573 "" if (*(unsigned char *)durq == 'n') { +#line 10573 "" goto L77; +#line 10573 "" } +#line 10574 "" if (*(unsigned char *)durq != 'i') { /* Normal key change and/or transposition) */ /* iccount = iccount+1 */ +#line 10579 "" num1 = 44 - *(unsigned char *)durq; /* num1= +1 or -1 */ +#line 10583 "" ztrans = num1 == -1; +#line 10584 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10585 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10586 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be " +#line 10586 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "\ "followed by a number!", (ftnlen)128, (ftnlen)37); +#line 10588 "" stop1_(); +#line 10589 "" } /* iccount = iccount+1 */ +#line 10591 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 10592 "" num1 = i_nint(&fnum) * num1; +#line 10593 "" ztrans = ztrans && num1 == 0; +#line 10594 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10595 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft" +#line 10595 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"\ "er \"K\" must be followed by \"+,-\"!", (ftnlen) 128, (ftnlen)47); +#line 10597 "" stop1_(); +#line 10598 "" } +#line 10599 "" ++a1ll_2.iccount; +#line 10600 "" num2 = 44 - *(unsigned char *)durq; +#line 10601 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 10602 "" num2 *= (integer) (fnum + .1f); +#line 10603 "" if (num1 == 0 && ! ztrans) { /* Key change, only one per block allowed */ +#line 10607 "" if (comkeys_1.iskchb) { +#line 10608 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key" +#line 10608 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"\ " change allowed per input block!", (ftnlen) 128, (ftnlen)44); +#line 10610 "" stop1_(); +#line 10611 "" } +#line 10612 "" comkeys_1.iskchb = TRUE_; +#line 10613 "" ++comkeys_1.nkeys; +#line 10614 "" comkeys_1.kchmid[comkeys_1.nkeys - 1] = a1ll_2.itsofar[ c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0; /* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */ +#line 10618 "" comkeys_1.ibrkch[comkeys_1.nkeys - 1] = c1omnotes_1.ibarcnt + a1ll_2.nbars; +#line 10619 "" if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) { +#line 10619 "" ++comkeys_1.ibrkch[comkeys_1.nkeys - 1]; +#line 10619 "" } +#line 10620 "" comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 + comkeys_1.idsig; /* 130316 */ /* do 43 iinst = 1 , noinst */ +#line 10623 "" commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys - 1]; /* 43 continue */ +#line 10625 "" } else { /* Transposition */ +#line 10629 "" *fulltrans = TRUE_; +#line 10630 "" if (c1omnotes_1.ibarcnt > 0) { +#line 10631 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio" +#line 10631 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"\ "n must be at top of first input block!", ( ftnlen)128, (ftnlen)50); +#line 10633 "" stop1_(); +#line 10634 "" } +#line 10635 "" comkeys_1.isig1 = num2; +#line 10636 "" comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[0]; /* idsig is the difference between sig after transposition, and sig in setup. */ /* It may alter # of accid's in key changes if there is transposition. */ +#line 10641 "" } +#line 10642 "" } else { /* 110522/110529 */ @@ -15634,55 +25889,86 @@ L77: /* call stop1() */ /* end if */ /* durq='i' */ +#line 10660 "" getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, & a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, & comkeys_1.noinst, (ftnlen)128); +#line 10662 "" } +#line 10663 "" } else if (*(unsigned char *)charq == '|') { /* Optional bar symbol */ +#line 10667 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { +#line 10668 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out " +#line 10668 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "\ "of place!", (ftnlen)128, (ftnlen)29); +#line 10670 "" stop1_(); +#line 10671 "" } else if (comkeys_1.shifton) { +#line 10672 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#line 10672 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 10674 "" stop1_(); +#line 10675 "" } +#line 10676 "" } else if (*(unsigned char *)charq == '/') { +#line 10677 "" if (comkeys_1.ornrpt) { +#line 10678 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended" +#line 10678 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ " with repeated ornament still on!", (ftnlen)128, ( ftnlen)53); +#line 10680 "" comkeys_1.ornrpt = FALSE_; +#line 10681 "" } +#line 10682 "" if (comkeys_1.stickys) { +#line 10683 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended" +#line 10683 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ " with sticky stemshrink still on!", (ftnlen)128, ( ftnlen)53); +#line 10685 "" comkeys_1.stickys = FALSE_; +#line 10686 "" } +#line 10687 "" if (c1omget_1.fbon) { +#line 10688 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for" +#line 10688 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"\ "ced beam open!", (ftnlen)128, (ftnlen)34); +#line 10690 "" stop1_(); +#line 10691 "" } else if (comkeys_1.shifton) { +#line 10692 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#line 10692 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 10694 "" stop1_(); /* 140215 Temporary to allow clef change in stup */ @@ -15691,613 +25977,1001 @@ L77: /* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ /* * 'May not enter clef at end of input block!') */ /* call stop1() */ +#line 10702 "" } +#line 10703 "" comkeys_1.barend = FALSE_; /* Perform time checks */ +#line 10707 "" if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { +#line 10708 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d" +#line 10708 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\ "ivisible by lenbar!", (ftnlen)128, (ftnlen)39); - s_wsle(&io___653); - do_lio(&c__9, &c__1, "lenbar is ", (ftnlen)10); +#line 10710 "" + s_wsle(&io___684); +#line 10710 "" + do_lio(&c__9, &c__1, "lenbar, timesofar are ", (ftnlen)22); +#line 10710 "" do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof( integer)); +#line 10710 "" + do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[c1ommvl_1.ivx - + 1], (ftnlen)sizeof(integer)); +#line 10710 "" e_wsle(); +#line 10711 "" stop1_(); +#line 10712 "" } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.itsofar[0]) { - s_wsle(&io___654); +#line 10713 "" + s_wsle(&io___685); +#line 10713 "" e_wsle(); - s_wsle(&io___655); +#line 10714 "" + s_wsle(&io___686); +#line 10714 "" do_lio(&c__9, &c__1, "# of bars in voice 1, current voice:", ( ftnlen)36); +#line 10714 "" i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar; +#line 10714 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 10714 "" i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; +#line 10714 "" do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer)); +#line 10714 "" e_wsle(); +#line 10716 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e" +#line 10716 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"\ "qual to voice 1!", (ftnlen)128, (ftnlen)36); +#line 10718 "" stop1_(); +#line 10719 "" } +#line 10720 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10721 "" if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) { /* End of input block */ +#line 10725 "" *loop = FALSE_; +#line 10726 "" } else { /* Start a new voice */ +#line 10730 "" if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) { +#line 10730 "" a1ll_2.lenbar = a1ll_2.lenbr0; +#line 10730 "" } +#line 10731 "" a1ll_2.nbars = 0; +#line 10732 "" if (*(unsigned char *)durq == ' ') { /* New voice is on next staff */ +#line 10736 "" ++a1ll_2.iv; +#line 10737 "" c1ommvl_1.ivx = a1ll_2.iv; +#line 10738 "" } else { /* New voice is on same staff. Set up for it */ +#line 10742 "" c1ommvl_1.ivx = a1ll_2.nv + 1; +#line 10743 "" i__1 = a1ll_2.nv; +#line 10743 "" for (iiv = 1; iiv <= i__1; ++iiv) { +#line 10744 "" if (c1ommvl_1.nvmx[iiv - 1] == 2) { +#line 10744 "" ++c1ommvl_1.ivx; +#line 10744 "" } +#line 10745 "" /* L23: */ +#line 10745 "" } +#line 10746 "" if (c1ommvl_1.ivx > 24) { - s_wsfe(&io___656); +#line 10747 "" + s_wsfe(&io___687); +#line 10747 "" do_fio(&c__1, "Cannot have more than", (ftnlen)21); +#line 10747 "" do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)) ; +#line 10747 "" do_fio(&c__1, " lines of music at once", (ftnlen)23); +#line 10747 "" e_wsfe(); +#line 10749 "" stop1_(); +#line 10750 "" } +#line 10751 "" c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2; +#line 10752 "" c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx; +#line 10753 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; +#line 10754 "" a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0; +#line 10755 "" for (j = 1; j <= 200; ++j) { +#line 10756 "" a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_; +#line 10757 "" c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0; +#line 10758 "" /* L24: */ +#line 10758 "" } /* For midi stuff, record that there is a 2nd line of music in this voice */ +#line 10762 "" if (commidi_1.ismidi) { +#line 10762 "" commidi_1.twoline[a1ll_2.iv - 1] = TRUE_; +#line 10762 "" } +#line 10763 "" } +#line 10764 "" } +#line 10765 "" a1ll_2.iccount = 128; +#line 10766 "" } else if (*(unsigned char *)charq == 'S') { /* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */ +#line 10770 "" if (c1omnotes_1.ibarcnt > 0) { +#line 10771 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in" +#line 10771 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"\ " first input block!", (ftnlen)128, (ftnlen)37); +#line 10773 "" stop1_(); +#line 10774 "" } +#line 10775 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10776 "" if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10777 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow" +#line 10777 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"\ " \"S\"!", (ftnlen)128, (ftnlen)24); +#line 10779 "" stop1_(); +#line 10780 "" } +#line 10781 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( ftnlen)1); +#line 10782 "" compage_1.nsyst = i_nint(&fnsyst); +#line 10783 "" L14: +#line 10784 "" if (*(unsigned char *)durq == 'P') { /* New npages for parts. */ +#line 10788 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10789 "" if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10790 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb" +#line 10790 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ "er here!", (ftnlen)128, (ftnlen)24); +#line 10792 "" stop1_(); +#line 10793 "" } +#line 10794 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( ftnlen)1); +#line 10795 "" compage_1.npages = i_nint(&fnsyst); +#line 10796 "" goto L14; +#line 10797 "" } else if (*(unsigned char *)durq == 'm') { /* Reset musize (musicsize). */ +#line 10801 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10802 "" if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10803 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb" +#line 10803 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ "er here!", (ftnlen)128, (ftnlen)24); +#line 10805 "" stop1_(); +#line 10806 "" } +#line 10807 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( ftnlen)1); +#line 10808 "" commus_1.musize = i_nint(&fnsyst); +#line 10809 "" c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; +#line 10810 "" goto L14; +#line 10811 "" } else if (*(unsigned char *)durq != ' ') { +#line 10812 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character " +#line 10812 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "\ "in \"S\" symbol!", (ftnlen)128, (ftnlen)32); +#line 10814 "" stop1_(); +#line 10815 "" } +#line 10816 "" } else if (*(unsigned char *)charq == 'L') { +#line 10817 "" ++compage_1.nflb; +#line 10818 "" compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + a1ll_2.nbars + 1; +#line 10819 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10820 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10821 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi" +#line 10821 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"\ "ne forced line break!", (ftnlen)128, (ftnlen)41); +#line 10823 "" stop1_(); +#line 10824 "" } +#line 10825 "" readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, ( ftnlen)1); +#line 10826 "" compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb); +#line 10827 "" if (compage_1.nflb > 1) { /* Check if new number is > prior one */ +#line 10831 "" if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[ compage_1.nflb - 1]) { +#line 10832 "" i__1 = a1ll_2.iccount - 1; +#line 10832 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "You already forced a line " +#line 10832 "" + errmsg_(lineq, &i__1, &i__4, "You already forced a line "\ "break at a later line!", (ftnlen)128, (ftnlen)48); +#line 10834 "" stop1_(); +#line 10835 "" } +#line 10836 "" } +#line 10837 "" if (compage_1.npages == 0) { - s_wsle(&io___660); +#line 10838 "" + s_wsle(&io___691); +#line 10838 "" e_wsle(); - s_wsle(&io___661); - do_lio(&c__9, &c__1, "WARNING! You forced a line break at li" +#line 10839 "" + s_wsle(&io___692); +#line 10839 "" + do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"\ "ne ", (ftnlen)41); +#line 10839 "" do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[ compage_1.nflb], (ftnlen)sizeof(integer)); +#line 10839 "" do_lio(&c__9, &c__1, " but npage = 0. Continue?", (ftnlen)26) ; +#line 10839 "" e_wsle(); - s_rsfe(&io___662); +#line 10841 "" + s_rsfe(&io___693); +#line 10841 "" do_fio(&c__1, charq, (ftnlen)1); +#line 10841 "" e_rsfe(); +#line 10842 "" if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10842 "" stop1_(); +#line 10842 "" } +#line 10843 "" } else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) { +#line 10844 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at" +#line 10844 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"\ " line num > nsyst!", (ftnlen)128, (ftnlen)38); +#line 10846 "" stop1_(); +#line 10847 "" } else if (i_indx(" PM", durq, (ftnlen)3, (ftnlen)1) == 0) { +#line 10848 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \"" +#line 10848 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""\ "P\", or \"M\" here!", (ftnlen)128, (ftnlen)32); +#line 10850 "" stop1_(); +#line 10851 "" } +#line 10852 "" if (*(unsigned char *)durq == 'P') { /* Forced page break here, get page number. */ +#line 10856 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10857 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10858 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to " +#line 10858 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "\ "define forced page break!", (ftnlen)128, (ftnlen) 41); +#line 10860 "" stop1_(); +#line 10861 "" } +#line 10862 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 10863 "" ++compage_1.nfpb; +#line 10864 "" compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum); +#line 10865 "" compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[ compage_1.nflb]; +#line 10866 "" if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) { +#line 10867 "" i__1 = a1ll_2.iccount - 1; +#line 10867 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Forced page break at page " +#line 10867 "" + errmsg_(lineq, &i__1, &i__4, "Forced page break at page "\ "num > npages!", (ftnlen)128, (ftnlen)39); +#line 10869 "" stop1_(); +#line 10870 "" } else if (compage_1.nfpb > 1) { +#line 10871 "" if (compage_1.ipagfpb[compage_1.nfpb] <= compage_1.ipagfpb[compage_1.nfpb - 1]) { +#line 10872 "" i__1 = a1ll_2.iccount - 1; +#line 10872 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &i__1, &i__4, "Forced page break numb" +#line 10872 "" + errmsg_(lineq, &i__1, &i__4, "Forced page break numb"\ "ers must increase!", (ftnlen)128, (ftnlen)40); +#line 10874 "" stop1_(); +#line 10875 "" } +#line 10876 "" } +#line 10877 "" } +#line 10878 "" if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10879 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#line 10879 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ " linebreak symbol!", (ftnlen)128, (ftnlen)38); +#line 10881 "" stop1_(); +#line 10882 "" } else if (*(unsigned char *)durq == 'M') { +#line 10883 "" ++compage_1.nmovbrk; +#line 10884 "" compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[ compage_1.nflb]; +#line 10885 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) 1); +#line 10886 "" L31: +#line 10886 "" if (*(unsigned char *)durq == '+') { /* Vertical spacing, read past number. */ +#line 10890 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10891 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10892 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ" +#line 10892 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"\ "ired here!", (ftnlen)128, (ftnlen)22); +#line 10894 "" stop1_(); +#line 10895 "" } +#line 10896 "" readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10897 "" goto L31; +#line 10898 "" } else if (*(unsigned char *)durq == 'i') { /* Change indentation, */ +#line 10902 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10903 "" if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10904 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb" +#line 10904 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"\ "er required here!", (ftnlen)128, (ftnlen)29); +#line 10906 "" stop1_(); +#line 10907 "" } /* fracsys was initialized in block data to all 0.'s */ +#line 10911 "" readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[ compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1); +#line 10912 "" goto L31; +#line 10913 "" } else if (*(unsigned char *)durq == 'c') { +#line 10914 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10915 "" goto L31; +#line 10916 "" } else if (*(unsigned char *)durq == 'r') { +#line 10917 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10918 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10919 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have" - " \"+\" or \"-\" after \"r\" as movement brea" +#line 10919 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\ + " \"+\" or \"-\" after \"r\" as movement brea"\ "k option!", (ftnlen)128, (ftnlen)56); +#line 10921 "" stop1_(); +#line 10922 "" } +#line 10923 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10924 "" goto L31; +#line 10925 "" } else if (*(unsigned char *)durq == 'n') { /* Change # of voices. Input ninow, iorig(1...ninow). Will use names, */ /* staves per inst. and clefs corr. to iorig in original list of instruments. */ +#line 10930 "" a1ll_2.nv = 0; +#line 10931 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10932 "" if (*(unsigned char *)durq == ':') { /* Signals a 2-digit number, get next two characters */ +#line 10936 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10937 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( ftnlen)1); +#line 10938 "" if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 || i_indx("0123456789", dumq, (ftnlen)10, ( ftnlen)1) == 0) { +#line 10940 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; /* Writing concatenation */ - i__8[0] = 34, a__3[0] = "Illegal new number of i" +#line 10940 "" + i__8[0] = 34, a__3[0] = "Illegal new number of i"\ "nstruments "; +#line 10940 "" i__8[1] = 1, a__3[1] = durq; +#line 10940 "" i__8[2] = 1, a__3[2] = dumq; +#line 10940 "" i__8[3] = 19, a__3[3] = " at movement break!"; - s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55); - errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__3, ( +#line 10940 "" + s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55); +#line 10940 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, ( ftnlen)128, (ftnlen)55); +#line 10943 "" stop1_(); +#line 10944 "" } +#line 10945 "" i__1 = a1ll_2.iccount - 2; +#line 10945 "" ici__1.icierr = 0; +#line 10945 "" ici__1.iciend = 0; +#line 10945 "" ici__1.icirnum = 1; +#line 10945 "" ici__1.icirlen = a1ll_2.iccount - i__1; +#line 10945 "" ici__1.iciunit = lineq + i__1; +#line 10945 "" ici__1.icifmt = "(i2)"; +#line 10945 "" s_rsfi(&ici__1); +#line 10945 "" do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer)) ; +#line 10945 "" e_rsfi(); +#line 10946 "" } else { /* durq is a single digit number for noinow */ +#line 10950 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10951 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; /* Writing concatenation */ - i__2[0] = 34, a__1[0] = "Illegal new number of i" +#line 10951 "" + i__2[0] = 34, a__1[0] = "Illegal new number of i"\ "nstruments "; +#line 10951 "" i__2[1] = 1, a__1[1] = durq; +#line 10951 "" i__2[2] = 19, a__1[2] = " at movement break!"; - s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)54); - errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, ( +#line 10951 "" + s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)54); +#line 10951 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__5, ( ftnlen)128, (ftnlen)54); +#line 10954 "" stop1_(); +#line 10955 "" } +#line 10956 "" ninow = *(unsigned char *)durq - 48; +#line 10957 "" } +#line 10958 "" if (ninow > comkeys_1.noinst) { +#line 10959 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o" +#line 10959 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"\ "f instruments must be <= original!", (ftnlen) 128, (ftnlen)46); +#line 10961 "" stop1_(); +#line 10962 "" } +#line 10963 "" i__1 = ninow; +#line 10963 "" for (iinow = 1; iinow <= i__1; ++iinow) { +#line 10964 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 10965 "" if (*(unsigned char *)durq == ':') { /* Signals a 2-digit number */ +#line 10969 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) 128, (ftnlen)1); +#line 10970 "" g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) 128, (ftnlen)1); +#line 10971 "" if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 || i_indx("0123456789", dumq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10973 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; /* Writing concatenation */ - i__8[0] = 34, a__3[0] = "Illegal 2-digit ins" +#line 10973 "" + i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"\ "trument number "; +#line 10973 "" i__8[1] = 1, a__3[1] = durq; +#line 10973 "" i__8[2] = 1, a__3[2] = dumq; +#line 10973 "" i__8[3] = 19, a__3[3] = " at movement break!"; - s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55); - errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__3, +#line 10973 "" + s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55); +#line 10973 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__4, (ftnlen)128, (ftnlen)55); +#line 10976 "" stop1_(); +#line 10977 "" } +#line 10978 "" i__4 = a1ll_2.iccount - 2; +#line 10978 "" ici__1.icierr = 0; +#line 10978 "" ici__1.iciend = 0; +#line 10978 "" ici__1.icirnum = 1; +#line 10978 "" ici__1.icirlen = a1ll_2.iccount - i__4; +#line 10978 "" ici__1.iciunit = lineq + i__4; +#line 10978 "" ici__1.icifmt = "(i2)"; +#line 10978 "" s_rsfi(&ici__1); +#line 10978 "" do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof( integer)); +#line 10978 "" e_rsfi(); +#line 10979 "" } else { /* durq is a single digit number for iorig */ +#line 10983 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen) 1) == 0) { +#line 10984 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; /* Writing concatenation */ - i__2[0] = 26, a__1[0] = "Illegal instrument " +#line 10984 "" + i__2[0] = 26, a__1[0] = "Illegal instrument "\ "number "; +#line 10984 "" i__2[1] = 1, a__1[1] = durq; +#line 10984 "" i__2[2] = 19, a__1[2] = " at movement break!"; - s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)46); - errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__5, +#line 10984 "" + s_cat(ch__6, a__1, i__2, &c__3, (ftnlen)46); +#line 10984 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__6, (ftnlen)128, (ftnlen)46); +#line 10987 "" stop1_(); +#line 10988 "" } +#line 10989 "" iorig = *(unsigned char *)durq - 48; +#line 10990 "" } +#line 10991 "" if (iorig > comkeys_1.noinst) { +#line 10992 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst" +#line 10992 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"\ "rument number must be <= original noinst!" , (ftnlen)128, (ftnlen)49); +#line 10994 "" stop1_(); +#line 10995 "" } +#line 10996 "" a1ll_2.nv += c1omget_1.nsperi[iorig - 1]; +#line 10997 "" /* L63: */ +#line 10997 "" } +#line 10998 "" i__1 = a1ll_2.nv; +#line 10998 "" for (iiv = 1; iiv <= i__1; ++iiv) { /* Get clef names */ +#line 11002 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 11003 "" if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *(unsigned char *)durq >= 48 && *( unsigned char *)durq <= 55)) { +#line 11005 "" i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav" - "e t,s,m,a,n,r,b,f or 1-7 as clef symbol " +#line 11005 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\ + "e t,s,m,a,n,r,b,f or 1-7 as clef symbol "\ "here!", (ftnlen)128, (ftnlen)53); +#line 11007 "" stop1_(); +#line 11008 "" } /* Initialize new voices */ +#line 11012 "" c1ommvl_1.nvmx[iiv - 1] = 1; +#line 11013 "" c1ommvl_1.ivmx[iiv - 1] = iiv; +#line 11014 "" a1ll_2.itsofar[iiv - 1] = 0; +#line 11015 "" a1ll_2.nnl[iiv - 1] = 0; +#line 11016 "" for (j = 1; j <= 200; ++j) { +#line 11017 "" a1ll_2.rest[iiv + j * 24 - 25] = FALSE_; +#line 11018 "" /* L62: */ +#line 11018 "" } +#line 11019 "" /* L61: */ +#line 11019 "" } /* Loop back up, this might not be last option in M */ +#line 11023 "" g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 11024 "" goto L31; +#line 11025 "" } else if (*(unsigned char *)durq != ' ') { +#line 11026 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#line 11026 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ "r after Movement break symbol!", (ftnlen)128, ( ftnlen)46); +#line 11028 "" stop1_(); +#line 11029 "" } +#line 11030 "" if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) { /* Since fracsys was not explicitly set, set it to prior value. */ +#line 11034 "" if (compage_1.nmovbrk == 1) { +#line 11035 "" compage_1.fracsys[compage_1.nmovbrk - 1] = c1omget_1.fracindent; +#line 11036 "" } else { +#line 11037 "" compage_1.fracsys[compage_1.nmovbrk - 1] = compage_1.fracsys[compage_1.nmovbrk - 2]; +#line 11038 "" } +#line 11039 "" } +#line 11040 "" } /* Just before exiting if-block for forced line breaks, set counter to use when */ /* dealing with vertical space calcs */ +#line 11045 "" compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1; +#line 11046 "" } else if (*(unsigned char *)charq == 'F') { +#line 11047 "" compage_1.usefig = FALSE_; +#line 11048 "" } else if (*(unsigned char *)charq == 'X') { +#line 11049 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; +#line 11049 "" g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &i__1, & c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], & c1omnotes_1.wheadpt, (ftnlen)128); +#line 11051 "" } else if (*(unsigned char *)charq == 'I') { /* MIDI settings. */ +#line 11055 "" if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 11056 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo" +#line 11056 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"\ "wed at start of block!", (ftnlen)128, (ftnlen)42); +#line 11058 "" stop1_(); +#line 11059 "" } +#line 11060 "" if (a1ll_2.nv > 15) { +#line 11061 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does " +#line 11061 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "\ "not work with more than 15 voices!", (ftnlen)128, ( ftnlen)54); +#line 11063 "" stop1_(); +#line 11064 "" } +#line 11065 "" commidi_1.ismidi = TRUE_; /* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ +#line 11067 "" getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, & c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &a1ll_2.nbars, &a1ll_2.lenbar, &mtrdenl, &c_true, (ftnlen)128); +#line 11069 "" } else if (*(unsigned char *)charq == 'M') { +#line 11070 "" setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, & c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, & c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, (ftnlen)1, ( ftnlen)1); +#line 11072 "" } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Continued rhythmic shortcut */ +#line 11076 "" idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); +#line 11077 "" if (idotform == 1) { /* Change duration of prior note */ +#line 11081 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25]; +#line 11082 "" a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[ c1ommvl_1.ivx - 1] * 24 - 25] * 3 / 2; +#line 11083 "" a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25]; +#line 11084 "" } +#line 11085 "" ++idotform; +#line 11086 "" numnum = 1; +#line 11087 "" cdot = TRUE_; +#line 11088 "" goto L1; +#line 11089 "" } else { - s_wsle(&io___666); +#line 11090 "" + s_wsle(&io___697); +#line 11090 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 11090 "" i__1 = *(unsigned char *)charq; +#line 11090 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 11090 "" e_wsle(); +#line 11091 "" i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al" +#line 11091 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\ "lowed here!", (ftnlen)128, (ftnlen)35); - s_wsle(&io___667); +#line 11093 "" + s_wsle(&io___698); +#line 11093 "" do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 11093 "" i__1 = *(unsigned char *)charq; +#line 11093 "" do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 11093 "" e_wsle(); +#line 11094 "" stop1_(); +#line 11095 "" } +#line 11095 "" } +#line 11096 "" return 0; } /* g1etnote_ */ @@ -16333,95 +27007,159 @@ L31: static integer iccount; /* Fortran I/O blocks */ - static cilist io___670 = { 0, 6, 0, 0, 0 }; - static cilist io___671 = { 0, 6, 0, "(1x,a46,i3)", 0 }; - static cilist io___672 = { 0, 6, 0, "(a)", 0 }; - static cilist io___675 = { 0, 6, 0, "(a)", 0 }; - static cilist io___676 = { 0, 6, 0, "(a)", 0 }; - static cilist io___677 = { 0, 6, 0, 0, 0 }; + static cilist io___701 = { 0, 6, 0, 0, 0 }; + static cilist io___702 = { 0, 6, 0, "(1x,a46,i3)", 0 }; + static cilist io___703 = { 0, 6, 0, "(a)", 0 }; + static cilist io___706 = { 0, 6, 0, "(a)", 0 }; + static cilist io___707 = { 0, 6, 0, "(a)", 0 }; + static cilist io___708 = { 0, 6, 0, 0, 0 }; /* Get the first line */ +#line 11114 "" iccount = 0; +#line 11115 "" c1omget_1.nline = 1; +#line 11116 "" L9: +#line 11116 "" getbuf_(lineq, (ftnlen)128); +#line 11117 "" if (*(unsigned char *)lineq == '%') { +#line 11118 "" ++c1omget_1.nline; +#line 11119 "" goto L9; +#line 11120 "" } +#line 11121 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) { /* Have TeX input until next line that starts with '---' */ +#line 11125 "" L3: +#line 11125 "" ++c1omget_1.nline; +#line 11126 "" getbuf_(lineq, (ftnlen)128); +#line 11127 "" if (inbuff_1.ilbuf > inbuff_1.nlbuf) { +#line 11127 "" goto L1; +#line 11127 "" } +#line 11128 "" goto L2; +#line 11129 "" L1: - s_wsle(&io___670); - do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \"" +#line 11129 "" + s_wsle(&io___701); +#line 11129 "" + do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""\ "---\"", (ftnlen)49); +#line 11129 "" e_wsle(); +#line 11130 "" stop1_(); +#line 11131 "" L2: +#line 11132 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { +#line 11132 "" goto L3; +#line 11132 "" } /* Force a new line read on first call to readin */ +#line 11136 "" iccount = 128; +#line 11137 "" } /* Here, lineq and nline are first non-TeX lines. */ +#line 11141 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11141 "" *nv = i_nint(&r__1); +#line 11142 "" if (*nv > 24) { - s_wsfe(&io___671); +#line 11143 "" + s_wsfe(&io___702); +#line 11143 "" do_fio(&c__1, "In setup data, number of voices cannot exceed", ( ftnlen)45); +#line 11143 "" do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)); +#line 11143 "" e_wsfe(); +#line 11145 "" stop1_(); +#line 11146 "" } +#line 11147 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11147 "" *noinst = i_nint(&r__1); +#line 11148 "" if (*noinst > *nv) { - s_wsfe(&io___672); - do_fio(&c__1, "In setup data, cannot have more instruments than stav" +#line 11149 "" + s_wsfe(&io___703); +#line 11149 "" + do_fio(&c__1, "In setup data, cannot have more instruments than stav"\ "es", (ftnlen)55); +#line 11149 "" e_wsfe(); +#line 11151 "" stop1_(); +#line 11152 "" } +#line 11153 "" newway = *noinst <= 0; +#line 11154 "" if (newway) { +#line 11154 "" *noinst = -(*noinst); +#line 11154 "" } +#line 11155 "" i__1 = *noinst; +#line 11155 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* Seve # of staves per inst in case later drop some inst's. */ +#line 11159 "" if (newway) { +#line 11160 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11160 "" c1omget_1.nsperi[iinst - 1] = i_nint(&r__1); +#line 11161 "" } else if (iinst > 1) { +#line 11162 "" c1omget_1.nsperi[iinst - 1] = 1; +#line 11163 "" } else { +#line 11164 "" c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1; +#line 11165 "" } +#line 11166 "" /* L10: */ +#line 11166 "" } +#line 11167 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11167 "" *mtrnuml = i_nint(&r__1); +#line 11168 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11168 "" *mtrdenl = i_nint(&r__1); /* c */ /* c Kluge!!! */ @@ -16430,120 +27168,208 @@ L2: /* mtrdenl = 2 */ /* mtrnuml = mtrnuml*2 */ /* end if */ +#line 11176 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11176 "" *mtrnmp = i_nint(&r__1); +#line 11177 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11177 "" *mtrdnp = i_nint(&r__1); +#line 11178 "" if (*mtrnmp == 0 && *mtrdnp >= 8) { - s_wsfe(&io___675); +#line 11179 "" + s_wsfe(&io___706); +#line 11179 "" do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", ( ftnlen)47); +#line 11179 "" e_wsfe(); +#line 11180 "" stop1_(); +#line 11181 "" } +#line 11182 "" *xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11183 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11183 "" *newkey = i_nint(&r__1); /* 130316 */ /* do 11 iinst = 1 , noinst */ +#line 11186 "" commidisig_1.midisig = *newkey; /* 11 continue */ +#line 11188 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11188 "" *npages = i_nint(&r__1); +#line 11189 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11189 "" *nsyst = i_nint(&r__1); +#line 11190 "" r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 11190 "" *musize = i_nint(&r__1); +#line 11191 "" c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen) 128); +#line 11192 "" if (c1omget_1.fracindent >= 1.f) { - s_wsfe(&io___676); +#line 11193 "" + s_wsfe(&io___707); +#line 11193 "" do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36); +#line 11193 "" e_wsfe(); +#line 11194 "" stop1_(); +#line 11195 "" } +#line 11196 "" if (*npages > *nsyst) { - s_wsle(&io___677); +#line 11197 "" + s_wsle(&io___708); +#line 11197 "" do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen) 35); +#line 11197 "" e_wsle(); +#line 11198 "" stop1_(); +#line 11199 "" } else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize - 29) != 0) { +#line 11200 "" printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35); +#line 11201 "" stop1_(); +#line 11202 "" } /* Next noinst non-comment lines are names of instruments. */ +#line 11206 "" i__1 = abs(*noinst); +#line 11206 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 11207 "" L5: +#line 11207 "" getbuf_(lineq, (ftnlen)128); +#line 11208 "" ++c1omget_1.nline; +#line 11209 "" if (*(unsigned char *)lineq == '%') { +#line 11209 "" goto L5; +#line 11209 "" } +#line 11210 "" /* L4: */ +#line 11210 "" } /* Mext non-comment line has nv clef names */ +#line 11214 "" L6: +#line 11214 "" getbuf_(lineq, (ftnlen)128); +#line 11215 "" ++c1omget_1.nline; +#line 11216 "" if (*(unsigned char *)lineq == '%') { +#line 11216 "" goto L6; +#line 11216 "" } +#line 11217 "" i__1 = *nv; +#line 11217 "" for (iv = 1; iv <= i__1; ++iv) { /* if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then */ +#line 11219 "" if (i_indx("brnamstf012345678", lineq + (iv - 1), (ftnlen)17, (ftnlen) 1) == 0) { +#line 11220 "" errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!", (ftnlen)128, (ftnlen)35); +#line 11222 "" stop1_(); +#line 11223 "" } +#line 11224 "" /* L7: */ +#line 11224 "" } +#line 11225 "" i__1 = *nv; +#line 11225 "" if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) { +#line 11226 "" i__1 = *nv + 1; +#line 11226 "" errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen) 128, (ftnlen)29); +#line 11228 "" stop1_(); +#line 11229 "" } /* Set flag if voice 1 is treble, since it affects vertical spacing */ /* bottreb = lineq(1:1).eq.'t' */ +#line 11234 "" *bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0; /* Next non-comment line has path name */ +#line 11238 "" L8: +#line 11238 "" getbuf_(lineq, (ftnlen)128); +#line 11239 "" ++c1omget_1.nline; +#line 11240 "" if (*(unsigned char *)lineq == '%') { +#line 11240 "" goto L8; +#line 11240 "" } +#line 11241 "" lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1; /* Writing concatenation */ +#line 11242 "" i__2[0] = 2, a__1[0] = "/:"; +#line 11242 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 11242 "" i__2[1] = 1, a__1[1] = ch__2; +#line 11242 "" s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3); +#line 11242 "" if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) { /* Writing concatenation */ - i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\"" +#line 11243 "" + i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""\ ":\", or \""; +#line 11243 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 11243 "" i__3[1] = 1, a__2[1] = ch__2; +#line 11243 "" i__3[2] = 2, a__2[2] = "\"!"; +#line 11243 "" s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50); +#line 11243 "" errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50); +#line 11246 "" stop1_(); +#line 11247 "" } +#line 11248 "" return 0; } /* g1etset_ */ @@ -16572,88 +27398,155 @@ L8: /* Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. */ /* In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */ +#line 11258 "" number = FALSE_; +#line 11259 "" npbsc = 0; +#line 11260 "" L1: +#line 11260 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11261 "" if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) { /* Continue checking here even if "P". */ +#line 11265 "" ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1); +#line 11266 "" if (bit_test(npbsc,ipbsc)) { +#line 11267 "" errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", ( ftnlen)128, (ftnlen)28); +#line 11268 "" stop1_(); +#line 11269 "" } +#line 11270 "" npbsc = bit_set(npbsc,ipbsc); +#line 11271 "" goto L1; +#line 11272 "" } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { +#line 11273 "" number = TRUE_; +#line 11274 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { +#line 11275 "" g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1); +#line 11276 "" if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) { +#line 11277 "" errmsg_(lineq, iccount, ibar, "Expected a number here!", ( ftnlen)128, (ftnlen)23); +#line 11278 "" stop1_(); +#line 11279 "" } +#line 11280 "" } +#line 11281 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11282 "" if (*(unsigned char *)charq == '-') { +#line 11282 "" fnum = -fnum; +#line 11282 "" } +#line 11283 "" if (*(unsigned char *)dumq != 'p') { +#line 11284 "" --(*iccount); +#line 11285 "" fnum *= *wheadpt; +#line 11286 "" } +#line 11287 "" goto L1; +#line 11288 "" } else if (*(unsigned char *)charq != ' ') { +#line 11289 "" errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen) 128, (ftnlen)26); +#line 11290 "" stop1_(); +#line 11291 "" } /* Done with parsing. Other checks */ +#line 11295 "" if ((6 & npbsc) == 6 || (24 & npbsc) == 24) { +#line 11296 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \"" +#line 11296 "" + errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""\ "S\" and \":\"!", (ftnlen)128, (ftnlen)44); +#line 11298 "" stop1_(); +#line 11299 "" } +#line 11300 "" if (bit_test(npbsc,4)) { +#line 11301 "" if (number) { +#line 11302 "" if (*shifton) { +#line 11303 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Started a group shift without s" +#line 11303 "" + errmsg_(lineq, &i__1, ibar, "Started a group shift without s"\ "topping prior one!", (ftnlen)128, (ftnlen)49); +#line 11305 "" stop1_(); +#line 11306 "" } else { +#line 11307 "" *shifton = TRUE_; +#line 11308 "" } +#line 11309 "" } else { +#line 11310 "" if (! (*shifton)) { +#line 11311 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta" +#line 11311 "" + errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"\ "rting one!", (ftnlen)128, (ftnlen)41); +#line 11313 "" stop1_(); +#line 11314 "" } else { +#line 11315 "" *shifton = FALSE_; +#line 11316 "" } +#line 11317 "" } +#line 11318 "" } /* P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) */ +#line 11322 "" if ((npbsc & 26) == 0) { +#line 11322 "" *udsp += fnum; +#line 11322 "" } +#line 11323 "" if (! number && ! bit_test(npbsc,4)) { +#line 11324 "" i__1 = *iccount - 1; - errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon " +#line 11324 "" + errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "\ "in \"X\" symbol!", (ftnlen)128, (ftnlen)51); +#line 11326 "" stop1_(); +#line 11327 "" } +#line 11328 "" return 0; } /* g1etx_ */ @@ -16672,11 +27565,16 @@ L1: /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); +#line 11343 "" i__1 = inbuff_1.ipbuf; +#line 11343 "" s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1); +#line 11344 "" inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; +#line 11345 "" ++inbuff_1.ilbuf; +#line 11346 "" return 0; } /* getbuf_ */ @@ -16695,24 +27593,43 @@ L1: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ +#line 11362 "" if (*iccount == 128) { +#line 11363 "" read10_(lineq, &comget_1.lastchar, (ftnlen)128); +#line 11364 "" if (comget_1.lastchar) { +#line 11364 "" return 0; +#line 11364 "" } +#line 11365 "" if (! commac_1.endmac) { +#line 11366 "" *iccount = 0; +#line 11367 "" } else { +#line 11368 "" commac_1.endmac = FALSE_; +#line 11369 "" *iccount = commac_1.icchold; +#line 11370 "" s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); +#line 11371 "" } +#line 11372 "" if (commac_1.mrecord) { +#line 11373 "" mrec1_(lineq, iccount, &ndxm, (ftnlen)128); +#line 11374 "" } +#line 11375 "" } +#line 11376 "" ++(*iccount); +#line 11377 "" *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; +#line 11378 "" return 0; } /* getchar_ */ @@ -16769,178 +27686,284 @@ L1: /* 01-09 (horizontal offset)/10 + 25.6 notehead widths */ /* 10 5th bit for ivx (5/15/10) */ +#line 11415 "" *irest = bit_set(*irest,26); +#line 11416 "" ++comdyn_1.ndyn; +#line 11417 "" idyn = *ivx; +#line 11418 "" comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0; +#line 11419 "" if (*ivx >= 16) { +#line 11419 "" setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1); +#line 11419 "" } +#line 11420 "" setbits_(&idyn, &c__8, &c__4, ip); +#line 11421 "" i__1 = *iccount; +#line 11421 "" if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { /* text-dynamic */ +#line 11425 "" ++comdyn_1.ntxtdyn; +#line 11426 "" iccountt = *iccount; +#line 11427 "" L3: +#line 11428 "" i__1 = iccountt + 1; +#line 11428 "" iend = iccountt + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) + 2; +#line 11429 "" i__1 = iend - 3; +#line 11429 "" if (s_cmp(lineq + i__1, "\\", iend - 2 - i__1, (ftnlen)1) == 0) { +#line 11430 "" iccountt = iend - 2; +#line 11431 "" goto L3; +#line 11432 "" } +#line 11433 "" i__1 = *iccount + 1; +#line 11433 "" s_copy(comdyn_1.txtdynq + (comdyn_1.ntxtdyn - 1 << 7), lineq + i__1, ( ftnlen)128, iend - 2 - i__1); /* Store ivx, ip in bits 0-12 */ +#line 11437 "" comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5); +#line 11438 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); +#line 11439 "" idno = 0; +#line 11440 "" } else { /* Word-group or hairpin */ +#line 11444 "" for (iend = *iccount + 2; iend <= 128; ++iend) { +#line 11445 "" ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); /* Exit the loop at first blank, "+", or "-" */ +#line 11449 "" if (ipm > 0) { +#line 11449 "" goto L2; +#line 11449 "" } +#line 11450 "" /* L1: */ +#line 11450 "" } +#line 11451 "" L2: +#line 11452 "" i__1 = *iccount; +#line 11452 "" ici__1.icierr = 0; +#line 11452 "" ici__1.iciend = 0; +#line 11452 "" ici__1.icirnum = 1; +#line 11452 "" ici__1.icirlen = iend - 1 - i__1; +#line 11452 "" ici__1.iciunit = lineq + i__1; /* Writing concatenation */ +#line 11452 "" i__2[0] = 2, a__1[0] = "(a"; +#line 11452 "" i__3 = iend + 47 - *iccount; +#line 11452 "" chax_(ch__2, (ftnlen)1, &i__3); +#line 11452 "" i__2[1] = 1, a__1[1] = ch__2; +#line 11452 "" i__2[2] = 1, a__1[2] = ")"; +#line 11452 "" ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 11452 "" s_rsfi(&ici__1); +#line 11452 "" do_fio(&c__1, dynsymq, (ftnlen)4); +#line 11452 "" e_rsfi(); - idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff " +#line 11454 "" + idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff "\ "< > ", dynsymq, (ftnlen)60, (ftnlen)4) + 3) / 4; /* Save for later down */ +#line 11460 "" idno1 = idno; +#line 11461 "" } /* Set flag to check level later if in beam */ +#line 11465 "" *iornq = bit_set(*iornq,23); +#line 11466 "" if (idno >= 14) { /* Hairpin here. Check if opposite type from one that's already on */ +#line 11470 "" if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 && bit_test(comdyn_1.listcresc,*ivx)) { +#line 11472 "" printl_(" ", (ftnlen)1); +#line 11473 "" printl_("Started one kind of hairpin while other is on", (ftnlen) 45); +#line 11474 "" stop1_(); +#line 11475 "" } /* Start or stop? */ +#line 11479 "" if (bit_test(comdyn_1.listcresc,*ivx) || bit_test( comdyn_1.listdecresc,*ivx)) { /* Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. */ +#line 11483 "" if (! comslur_1.fontslur) { +#line 11483 "" idno = 15; +#line 11483 "" } +#line 11484 "" } else if (comslur_1.fontslur) { /* Start of font slur */ +#line 11488 "" idno = 13; +#line 11489 "" } else { /* Start of postscript slur */ +#line 11493 "" --idno; +#line 11494 "" } +#line 11495 "" } /* Now that we used list[de]cresc, update */ +#line 11499 "" if (idno >= 13) { +#line 11500 "" if (idno == 15 || comslur_1.fontslur && idno == 14) { /* Something's ending */ +#line 11504 "" if (bit_test(comdyn_1.listcresc,*ivx)) { /* It's a cresc! */ +#line 11508 "" comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx); +#line 11509 "" } else { +#line 11510 "" comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx); +#line 11511 "" } +#line 11512 "" } else { /* Something's starting */ +#line 11516 "" if (idno1 == 14) { /* It's a cresc! */ +#line 11520 "" comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx); +#line 11521 "" } else { +#line 11522 "" comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx); +#line 11523 "" } +#line 11524 "" } +#line 11525 "" } +#line 11526 "" setbits_(&idyn, &c__4, &c__12, &idno); +#line 11527 "" *iccount = iend; +#line 11528 "" if (ipm != 2) { /* There is a vertical shift */ +#line 11532 "" idyn = bit_set(idyn,16); +#line 11533 "" ++(*iccount); +#line 11534 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11535 "" idno = i_nint(&fnum); +#line 11536 "" i__1 = (ipm - 2) * idno + 64; +#line 11536 "" setbits_(&idyn, &c__7, &c__17, &i__1); +#line 11537 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); +#line 11538 "" if (ipm != 2) { /* There is a horizontal shift */ /* idynda2(ndyn) = ibset(idyn,23) */ +#line 11543 "" comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[ comdyn_1.ndyn - 1],0); +#line 11544 "" ++(*iccount); +#line 11545 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11546 "" r__1 = fnum * 10; +#line 11546 "" idno = i_nint(&r__1); +#line 11547 "" i__1 = (ipm - 2) * idno + 256; +#line 11547 "" setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, & i__1); +#line 11548 "" } /* iccount should be on the blank at the end of the entire symbol */ +#line 11552 "" } +#line 11553 "" comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn; +#line 11554 "" return 0; } /* getdyn_ */ @@ -16972,74 +27995,129 @@ L2: extern integer ifnodur_(integer *, char *, ftnlen); /* * itsofar,nodur,figq,ivupfig,nfigs) */ +#line 11563 "" ++(*nfigs); +#line 11564 "" *ivupfig = 0; +#line 11565 "" *ivvfig = 0; +#line 11566 "" *itoff = 0; +#line 11567 "" if (*(unsigned char *)charq == 'x') { /* Floating figure. */ +#line 11571 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11572 "" ici__1.icierr = 0; +#line 11572 "" ici__1.iciend = 0; +#line 11572 "" ici__1.icirnum = 1; +#line 11572 "" ici__1.icirlen = 1; +#line 11572 "" ici__1.iciunit = charq; +#line 11572 "" ici__1.icifmt = "(i1)"; +#line 11572 "" s_rsfi(&ici__1); +#line 11572 "" do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer)); +#line 11572 "" e_rsfi(); +#line 11573 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11574 "" ici__1.icierr = 0; +#line 11574 "" ici__1.iciend = 0; +#line 11574 "" ici__1.icirnum = 1; +#line 11574 "" ici__1.icirlen = 1; +#line 11574 "" ici__1.iciunit = charq; +#line 11574 "" ici__1.icifmt = "(i1)"; +#line 11574 "" s_rsfi(&ici__1); +#line 11574 "" do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer)); +#line 11574 "" e_rsfi(); +#line 11575 "" *itoff = noff * ifnodur_(&loff, "x", (ftnlen)1); +#line 11576 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11577 "" } else { /* Figure on a note */ +#line 11581 "" *isfig = TRUE_; +#line 11582 "" } +#line 11583 "" *itfig = *itsofar + *itoff - *nodur; +#line 11584 "" lfig = 1; +#line 11585 "" s_copy(figq, charq, (ftnlen)10, (ftnlen)1); +#line 11586 "" L5: +#line 11586 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); /* if (index(' +',charq) .eq. 0) then */ +#line 11588 "" if (i_indx(" +v", charq, (ftnlen)3, (ftnlen)1) == 0) { /* Writing concatenation */ +#line 11589 "" i__1[0] = lfig, a__1[0] = figq; +#line 11589 "" i__1[1] = 1, a__1[1] = charq; +#line 11589 "" s_cat(figq, a__1, i__1, &c__2, (ftnlen)10); +#line 11590 "" ++lfig; +#line 11591 "" goto L5; +#line 11592 "" } else if (*(unsigned char *)charq == '+') { /* Get vertical offset for figure. Next character after number has to be blank. */ +#line 11596 "" ++(*iccount); +#line 11597 "" readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11598 "" *ivupfig = i_nint(&fnum); +#line 11599 "" } else if (*(unsigned char *)charq == 'v') { /* Get vertical change in figdrop. Must be last item in figure word. */ +#line 11603 "" isign = 1; +#line 11604 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11605 "" if (*(unsigned char *)charq == '-') { +#line 11606 "" isign = -1; +#line 11607 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11608 "" } +#line 11609 "" *ivvfig = isign * (*(unsigned char *)charq - 48); +#line 11610 "" } +#line 11611 "" return 0; } /* getfig_ */ @@ -17077,169 +28155,289 @@ L5: /* These data MUST precede note name of first note */ /* nolevg, naccg: lists of levels and accid's, indexed as described above. */ +#line 11645 "" /* Parameter adjustments */ +#line 11645 "" ndlev -= 25; +#line 11645 "" ipl -= 25; +#line 11645 "" --iornq; +#line 11645 "" islur -= 25; +#line 11645 "" --nnl; +#line 11645 "" +#line 11645 "" /* Function Body */ +#line 11645 "" ++comgrace_1.ngrace; +#line 11646 "" comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx; +#line 11647 "" comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1; +#line 11648 "" if (comgrace_1.ngrace == 1) { +#line 11649 "" comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1; +#line 11650 "" } else { +#line 11651 "" comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[ comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2] ; +#line 11652 "" } +#line 11653 "" islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1) * 24],4); +#line 11654 "" comgrace_1.nng[comgrace_1.ngrace - 1] = 1; +#line 11655 "" comgrace_1.multg[comgrace_1.ngrace - 1] = 1; +#line 11656 "" comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_; +#line 11657 "" comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_; +#line 11658 "" comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_; +#line 11659 "" L18: +#line 11659 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11660 "" if (i_indx("WA", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Grace is on note that was already done, so shift flags forward one note. */ /* This puts flag on actual note with grace; later for W will go ahead one more. */ +#line 11665 "" comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx]; +#line 11666 "" islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx] + 1) * 24],4); +#line 11667 "" islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4) ; +#line 11668 "" if (comgrace_1.slurg[comgrace_1.ngrace - 1]) { +#line 11668 "" iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] * 24],24); +#line 11668 "" } +#line 11670 "" if (*(unsigned char *)charq == 'A') { /* close After, clear way-after bit, to ensure priority of most recent A/W */ +#line 11674 "" ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* ivx] * 24],31),29); +#line 11675 "" } else { /* Way after; later assign to following note, and position like normal grace. */ +#line 11679 "" ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* ivx] * 24],29),31); +#line 11680 "" } +#line 11681 "" } else if (*(unsigned char *)charq == 'm') { +#line 11682 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11683 "" comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq - 48; +#line 11684 "" } else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { +#line 11685 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11686 "" --(*iccount); +#line 11687 "" comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum); +#line 11688 "" } else if (*(unsigned char *)charq == 'l') { +#line 11689 "" comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_; +#line 11690 "" } else if (*(unsigned char *)charq == 's') { +#line 11691 "" comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_; +#line 11692 "" if (nnl[*ivx] > 0) { /* If A- or W-grace, set signal to start slur on main note. */ +#line 11696 "" if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx + nnl[*ivx] * 24],29)) { +#line 11696 "" iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] * 24],24); +#line 11696 "" } +#line 11699 "" } +#line 11700 "" } else if (*(unsigned char *)charq == 'x') { +#line 11701 "" comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_; +#line 11702 "" } else if (*(unsigned char *)charq == 'u') { +#line 11703 "" } else if (*(unsigned char *)charq == 'X') { /* Space before main note of grace. Number will come next. */ +#line 11707 "" ++(*iccount); +#line 11708 "" readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace - 1], (ftnlen)128, (ftnlen)1); +#line 11709 "" --(*iccount); +#line 11710 "" } +#line 11711 "" if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 11711 "" goto L18; +#line 11711 "" } /* At this point, charq is first note name in grace */ +#line 11715 "" i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[ comgrace_1.ngrace - 1] - 1; +#line 11715 "" for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) { +#line 11716 "" comgrace_1.naccg[ing - 1] = 0; +#line 11717 "" ioct = 0; +#line 11718 "" if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) { +#line 11719 "" L55: +#line 11719 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11720 "" if (*(unsigned char *)charq == ' ') { +#line 11720 "" goto L55; +#line 11720 "" } +#line 11721 "" } +#line 11722 "" iclastlev = 0; +#line 11723 "" L9: +#line 11723 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11724 "" if (*(unsigned char *)durq != ' ') { +#line 11725 "" if (*(unsigned char *)durq == '+') { +#line 11726 "" *lastlev += 7; +#line 11727 "" iclastlev += 7; +#line 11728 "" } else if (*(unsigned char *)durq == '-') { +#line 11729 "" *lastlev += -7; +#line 11730 "" iclastlev += -7; +#line 11731 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { +#line 11732 "" if (comgrace_1.naccg[ing - 1] == 0) { +#line 11733 "" comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); +#line 11734 "" } else { /* Double accidental */ +#line 11738 "" comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing - 1],2); +#line 11739 "" } +#line 11740 "" } else { +#line 11741 "" ioct = *(unsigned char *)durq - 48; +#line 11742 "" } +#line 11743 "" goto L9; +#line 11744 "" } +#line 11745 "" if (ioct > 0) { +#line 11746 "" *lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[ cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1); +#line 11747 "" } else { +#line 11748 "" if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace - 1]) { +#line 11749 "" if (*ivx <= *nv) { +#line 11750 "" kv = 1; +#line 11751 "" } else { +#line 11752 "" kv = 2; +#line 11753 "" } +#line 11754 "" *lastlev = ndlev[*iv + kv * 24] + iclastlev; +#line 11755 "" } +#line 11756 "" *lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, & cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1) - *lastlev + 3) % 7; +#line 11758 "" } +#line 11759 "" comgrace_1.nolevg[ing - 1] = *lastlev; +#line 11760 "" /* L19: */ +#line 11760 "" } /* Grace could come before first note of block, so reset end level. */ +#line 11764 "" if (nnl[*ivx] == 0) { +#line 11765 "" if (*ivx <= *nv) { +#line 11766 "" kv = 1; +#line 11767 "" } else { +#line 11768 "" kv = 2; +#line 11769 "" } +#line 11770 "" ndlev[*iv + kv * 24] = *lastlev; +#line 11771 "" } +#line 11772 "" return 0; } /* getgrace_ */ @@ -17295,96 +28493,166 @@ L9: /* fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */ /* simplifies use of iTransAmt for all calls to ifnolev. */ +#line 11811 "" *(unsigned char *)durq = 'x'; /* Can't initialize in declaration stmt, only works onc */ +#line 11812 "" if (! cominsttrans_1.earlytranson) { +#line 11812 "" cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0; +#line 11812 "" } +#line 11813 "" store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && ! (*from1); +#line 11815 "" cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0; +#line 11816 "" if (store) { +#line 11816 "" cominsttrans_1.ninsttrans = 0; +#line 11816 "" } +#line 11817 "" L1: +#line 11818 "" if (*(unsigned char *)durq == ' ') { +#line 11818 "" return 0; +#line 11818 "" } +#line 11819 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11820 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11821 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "There must be an instrument number h" +#line 11821 "" + errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"\ "ere!", (ftnlen)128, (ftnlen)40); +#line 11823 "" stop1_(); +#line 11824 "" } +#line 11825 "" if (store) { +#line 11825 "" ++cominsttrans_1.ninsttrans; +#line 11825 "" } +#line 11826 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11827 "" instn = i_nint(&fnum); +#line 11828 "" if (instn > *noinst) { +#line 11829 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11829 "" errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", ( ftnlen)128, (ftnlen)31); +#line 11831 "" stop1_(); +#line 11832 "" } +#line 11833 "" if (store) { +#line 11833 "" cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn; +#line 11833 "" } /* durq is +/- following inst # (for iTransAmt), iccount is on it. */ +#line 11837 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 11838 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe" +#line 11838 "" + errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"\ "r must be \"+,-\"!", (ftnlen)128, (ftnlen)52); +#line 11840 "" stop1_(); +#line 11841 "" } +#line 11842 "" itramt = 44 - *(unsigned char *)durq; /* +1/-1 for itramt */ +#line 11843 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11844 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11845 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "There must be a transposition amount" +#line 11845 "" + errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"\ " here!", (ftnlen)128, (ftnlen)42); +#line 11847 "" stop1_(); +#line 11848 "" } +#line 11849 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11850 "" if (store) { +#line 11850 "" cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt; +#line 11850 "" } /* durq is +/- following iTransAmt (for iTransKey), iccount is on it. */ +#line 11854 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 11855 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "1st character after transposition am" +#line 11855 "" + errmsg_(lineq, iccount, &i__1, "1st character after transposition am"\ "ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55); +#line 11857 "" stop1_(); +#line 11858 "" } +#line 11859 "" ikey = 44 - *(unsigned char *)durq; /* +1/-1 */ +#line 11860 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11861 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11862 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11862 "" errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!", (ftnlen)128, (ftnlen)35); +#line 11864 "" stop1_(); +#line 11865 "" } +#line 11866 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11867 "" if (store) { +#line 11867 "" cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(& fnum) * ikey; +#line 11867 "" } /* durq is now 1st character after iTransKey, should be either 'i' or ' ' */ +#line 11871 "" if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') { +#line 11872 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11872 "" errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", ( ftnlen)128, (ftnlen)32); +#line 11874 "" stop1_(); +#line 11875 "" } +#line 11876 "" goto L1; } /* getitransinfo_ */ @@ -17426,8 +28694,8 @@ L1: char *, real *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___726 = { 0, 6, 0, "(a)", 0 }; - static cilist io___727 = { 0, 15, 0, "(a)", 0 }; + static cilist io___757 = { 0, 6, 0, "(a)", 0 }; + static cilist io___758 = { 0, 15, 0, "(a)", 0 }; /* subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ @@ -17447,278 +28715,467 @@ L1: /* bsXobXbaXclXflXreXctXvo */ +#line 11924 "" L1: +#line 11924 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11925 "" if (*(unsigned char *)durq == 't') { /* Tempo in beats ber minute */ +#line 11929 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11930 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11931 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Expected an integer here for the" +#line 11931 "" + errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ " pause!", (ftnlen)128, (ftnlen)39); +#line 11933 "" stop1_(); /* else if (mmacrec) then */ /* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ /* * 'Cannot change MIDI tempo while recording a MidiMacro!') */ /* call stop1() */ +#line 11938 "" } +#line 11939 "" readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1); +#line 11940 "" --(*iccount); +#line 11941 "" if (! (*first)) { +#line 11942 "" i__1 = i_nint(&qpm); +#line 11942 "" midievent_("t", &i__1, &c__0, (ftnlen)1); +#line 11943 "" commmac_1.gottempo = TRUE_; +#line 11944 "" } +#line 11945 "" goto L1; +#line 11946 "" } else if (*(unsigned char *)durq == 'p') { /* Insert a pause. pausemid = pause in 1/4's */ +#line 11950 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11951 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 11952 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Expected a number here for the p" +#line 11952 "" + errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"\ "ause!", (ftnlen)128, (ftnlen)37); +#line 11954 "" stop1_(); +#line 11955 "" } +#line 11956 "" readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1); +#line 11957 "" --(*iccount); +#line 11958 "" if (! (*first)) { /* Compute a meter for the pause. This is only to keep MidiNotate on track. */ /* Round pause to nearest 16th. Let denominator always be 16. */ +#line 11963 "" r__1 = pausemid * 4; +#line 11963 "" numb16 = i_nint(&r__1); +#line 11964 "" midievent_("m", &numb16, &c__16, (ftnlen)1); /* Put in pausemid beats of rest */ +#line 11968 "" i__1 = commidi_1.numchan - 1; +#line 11968 "" for (icm = 0; icm <= i__1; ++icm) { +#line 11969 "" r__1 = numb16 * 4.f; +#line 11969 "" addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); +#line 11970 "" /* L3: */ +#line 11970 "" } +#line 11971 "" r__1 = pausemid * 240; +#line 11971 "" comevent_1.miditime += i_nint(&r__1); /* Restore meter */ +#line 11975 "" i__1 = *mtrdenl * *lenbar / 64; +#line 11975 "" midievent_("m", &i__1, mtrdenl, (ftnlen)1); +#line 11976 "" } +#line 11977 "" goto L1; +#line 11978 "" } else if (*(unsigned char *)durq == 'i') { /* c Instrument numbers or letters. Expect nv of them. */ /* Instrument numbers or letters. Expect noinst of them. */ /* do 2 ivx = 1 , nv */ +#line 11984 "" i__1 = *noinstarg; +#line 11984 "" for (ivx = 1; ivx <= i__1; ++ivx) { +#line 11985 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11986 "" if (*(unsigned char *)durq > 96) { /* It's a lowercase letter. Get another, find corr. instrument #. */ +#line 11990 "" *(unsigned char *)instq = *(unsigned char *)durq; +#line 11991 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Writing concatenation */ +#line 11992 "" i__2[0] = 1, a__1[0] = instq; +#line 11992 "" i__2[1] = 1, a__1[1] = durq; +#line 11992 "" s_cat(instq, a__1, i__2, &c__2, (ftnlen)2); - iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX" +#line 11993 "" + iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"\ "frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen) 79, (ftnlen)2) / 3; +#line 11995 "" if (iname == 0) { +#line 11996 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi" +#line 11996 "" + errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"\ "di instrument name!", (ftnlen)128, (ftnlen)43); +#line 11998 "" stop1_(); +#line 11999 "" } +#line 12000 "" commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1; +#line 12001 "" } else { /* Expect a number, followed by ":" if that is followed by another number. */ /* I.e., if after call to readnum, durq is not ":", it must be either blank */ /* or next instrument letter. */ +#line 12007 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 12008 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__3, "Expected a midi instrume" +#line 12008 "" + errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"\ "nt number here!", (ftnlen)128, (ftnlen)39); +#line 12010 "" stop1_(); +#line 12011 "" } +#line 12012 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12013 "" commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1; +#line 12014 "" if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx - 1] > 255) { +#line 12015 "" i__3 = *iccount - 1; +#line 12015 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus" +#line 12015 "" + errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"\ "t be in range 1-128!", (ftnlen)128, (ftnlen)46); +#line 12017 "" stop1_(); +#line 12018 "" } +#line 12019 "" if (*(unsigned char *)durq != ':') { +#line 12019 "" --(*iccount); +#line 12019 "" } +#line 12020 "" } +#line 12021 "" /* L2: */ +#line 12021 "" } +#line 12022 "" goto L1; +#line 12023 "" } else if (*(unsigned char *)durq == 'v') { /* Get volumes for each instrument. Expect nv of them. */ /* Follow same pattern as for insttrument numbers above. */ /* do 7 ivx = 1 , nv */ +#line 12029 "" i__1 = *noinstarg; +#line 12029 "" for (ivx = 1; ivx <= i__1; ++ivx) { +#line 12030 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12031 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 12032 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num" +#line 12032 "" + errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"\ "ber here!", (ftnlen)128, (ftnlen)37); +#line 12034 "" stop1_(); +#line 12035 "" } +#line 12036 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12037 "" commvel_2.midivel[ivx - 1] = i_nint(&fnum) - 1; +#line 12038 "" if (commvel_2.midivel[ivx - 1] < 0 || commvel_2.midivel[ivx - 1] > 127) { +#line 12039 "" i__3 = *iccount - 1; +#line 12039 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range" +#line 12039 "" + errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"\ " 1-128!", (ftnlen)128, (ftnlen)37); +#line 12041 "" stop1_(); +#line 12042 "" } +#line 12043 "" if (*(unsigned char *)durq != ':') { +#line 12043 "" --(*iccount); +#line 12043 "" } +#line 12044 "" /* L7: */ +#line 12044 "" } +#line 12045 "" goto L1; +#line 12046 "" } else if (*(unsigned char *)durq == 'b') { /* Get balance for each instrument. Expect nv of them. */ /* Follow same pattern as for instrument numbers above. */ /* do 8 ivx = 1 , nv */ +#line 12052 "" i__1 = *noinstarg; +#line 12052 "" for (ivx = 1; ivx <= i__1; ++ivx) { +#line 12053 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12054 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 12055 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__3, "Expected a balance number he" +#line 12055 "" + errmsg_(lineq, iccount, &i__3, "Expected a balance number he"\ "re!", (ftnlen)128, (ftnlen)31); +#line 12057 "" stop1_(); +#line 12058 "" } +#line 12059 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12060 "" commvel_2.midibal[ivx - 1] = i_nint(&fnum) - 1; +#line 12061 "" if (commvel_2.midibal[ivx - 1] < 0 || commvel_2.midibal[ivx - 1] > 127) { +#line 12062 "" i__3 = *iccount - 1; +#line 12062 "" i__4 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range " +#line 12062 "" + errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "\ "1-128!", (ftnlen)128, (ftnlen)36); +#line 12064 "" stop1_(); +#line 12065 "" } +#line 12066 "" if (*(unsigned char *)durq != ':') { +#line 12066 "" --(*iccount); +#line 12066 "" } +#line 12067 "" /* L8: */ +#line 12067 "" } +#line 12068 "" goto L1; +#line 12069 "" } else if (*(unsigned char *)durq == 'T') { /* Get transposition for each instrument. Expect nv of them. */ /* Follow similar pattern as above, but separator is +|-. */ /* do 9 ivx = 1 , nv */ +#line 12075 "" i__1 = *noinstarg; +#line 12075 "" for (ivx = 1; ivx <= i__1; ++ivx) { +#line 12076 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12077 "" ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1); +#line 12078 "" if (ipm == 0) { +#line 12079 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for " +#line 12079 "" + errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "\ "midi transposition here!", (ftnlen)128, (ftnlen)48); +#line 12081 "" stop1_(); +#line 12082 "" } +#line 12083 "" ipm = (ipm << 1) - 3; +#line 12084 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12085 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 12086 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 12086 "" errmsg_(lineq, iccount, &i__3, "Expected a number here!", ( ftnlen)128, (ftnlen)23); +#line 12088 "" stop1_(); +#line 12089 "" } +#line 12090 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12091 "" commvel_2.miditran[ivx - 1] = ipm * i_nint(&fnum); /* if (mod(miditran(ivx),12).ne. 0) then */ /* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ /* * 'Midi transposition limited to multiples of 12!') */ /* call stop1() */ /* end if */ +#line 12097 "" --(*iccount); +#line 12098 "" /* L9: */ +#line 12098 "" } +#line 12099 "" goto L1; +#line 12100 "" } else if (*(unsigned char *)durq == 'g') { +#line 12101 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12102 "" if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 12103 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Expected an integer here for the" +#line 12103 "" + errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ " midi gap!", (ftnlen)128, (ftnlen)42); +#line 12105 "" stop1_(); +#line 12106 "" } +#line 12107 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12108 "" commidi_1.mgap = i_nint(&fnum); +#line 12109 "" --(*iccount); +#line 12110 "" goto L1; +#line 12111 "" } else if (*(unsigned char *)durq == 'M') { /* MidiMacros */ +#line 12115 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12116 "" if (*(unsigned char *)durq == 'R') { /* Start recording */ +#line 12120 "" if (commmac_1.mmacrec) { +#line 12121 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa" +#line 12121 "" + errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"\ "cro while already recording!", (ftnlen)128, (ftnlen) 56); +#line 12123 "" stop1_(); +#line 12124 "" } +#line 12125 "" commmac_1.mmacrec = TRUE_; +#line 12126 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12127 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 12128 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number" +#line 12128 "" + errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ " here!", (ftnlen)128, (ftnlen)34); +#line 12130 "" stop1_(); +#line 12131 "" } +#line 12132 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12133 "" --(*iccount); +#line 12134 "" if (! (*first)) { +#line 12135 "" commmac_1.immac = i_nint(&fnum); +#line 12136 "" if (commmac_1.immac > 20) { +#line 12137 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce" +#line 12137 "" + errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"\ "ed 20!", (ftnlen)128, (ftnlen)30); +#line 12139 "" stop1_(); +#line 12140 "" } /* Save the start time */ +#line 12144 "" commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime; +#line 12145 "" i__1 = commidi_1.numchan; +#line 12145 "" for (icm = 0; icm <= i__1; ++icm) { +#line 12146 "" if (icm < commidi_1.numchan) { +#line 12147 "" if (commidi_1.restpend[icm]) { /* Adjust if there's a rest at end of prior section. Insert dummy turnoff. */ @@ -17727,175 +29184,294 @@ L1: /* Before: section1 ------rest------- section2(to be recorded) */ /* After: section1 rest1 now rest2 section2(recorded) */ +#line 12155 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); +#line 12156 "" commidi_1.trest[icm] = 0.f; +#line 12157 "" commidi_1.restpend[icm] = FALSE_; +#line 12158 "" } +#line 12159 "" } else { +#line 12160 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track */ +#line 12164 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; +#line 12164 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); +#line 12166 "" comevent_1.lasttime = comevent_1.miditime; +#line 12167 "" } +#line 12168 "" } +#line 12169 "" commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] = commidi_1.imidi[icm] + 1; +#line 12170 "" /* L4: */ +#line 12170 "" } +#line 12171 "" } +#line 12172 "" goto L1; +#line 12173 "" } else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) { /* End recording; close the open macro. Get immac from common. */ +#line 12177 "" if (! commmac_1.mmacrec) { +#line 12178 "" i__1 = *iccount - 1; +#line 12178 "" i__3 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b" +#line 12178 "" + errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"\ "efore starting one!", (ftnlen)128, (ftnlen)49); +#line 12180 "" stop1_(); +#line 12181 "" } +#line 12182 "" commmac_1.mmacrec = FALSE_; +#line 12183 "" --(*iccount); +#line 12184 "" if (! (*first)) { /* Save the macro duration */ +#line 12188 "" commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime - commmac_1.mmactime[commmac_1.immac - 1]; +#line 12189 "" i__1 = commidi_1.numchan; +#line 12189 "" for (icm = 0; icm <= i__1; ++icm) { +#line 12190 "" if (icm < commidi_1.numchan) { +#line 12191 "" if (commidi_1.restpend[icm]) { +#line 12192 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); +#line 12193 "" commidi_1.trest[icm] = 0.f; +#line 12194 "" commidi_1.restpend[icm] = FALSE_; +#line 12195 "" } +#line 12196 "" } else { +#line 12197 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track if needed. */ +#line 12201 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; +#line 12201 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); +#line 12203 "" comevent_1.lasttime = comevent_1.miditime; +#line 12204 "" } +#line 12205 "" } +#line 12206 "" commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] = commidi_1.imidi[icm]; +#line 12207 "" /* L5: */ +#line 12207 "" } +#line 12208 "" } +#line 12209 "" if (*(unsigned char *)durq != ' ') { +#line 12209 "" goto L1; +#line 12209 "" } +#line 12210 "" } else if (*(unsigned char *)durq == 'P') { /* Play Back a Macro */ +#line 12214 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12215 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 12216 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number" +#line 12216 "" + errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ " here!", (ftnlen)128, (ftnlen)34); +#line 12218 "" stop1_(); +#line 12219 "" } +#line 12220 "" if (commmac_1.mmacrec) { +#line 12221 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr" +#line 12221 "" + errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"\ "o before ending recording!", (ftnlen)128, (ftnlen)54); +#line 12223 "" stop1_(); +#line 12224 "" } +#line 12225 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 12226 "" --(*iccount); +#line 12227 "" if (! (*first)) { +#line 12228 "" commmac_1.immac = i_nint(&fnum); +#line 12229 "" if (commmac_1.mmactime[commmac_1.immac - 1] == 0) { +#line 12230 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro" +#line 12230 "" + errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"\ " before recording it!", (ftnlen)128, (ftnlen)45); +#line 12232 "" stop1_(); +#line 12233 "" } +#line 12234 "" i__1 = commidi_1.numchan; +#line 12234 "" for (icm = 0; icm <= i__1; ++icm) { +#line 12235 "" if (icm < commidi_1.numchan) { +#line 12236 "" if (commidi_1.restpend[icm]) { +#line 12237 "" addmidi_(&icm, &c__30, &c__0, &c__0, & commidi_1.trest[icm], &c_false, &c_true); +#line 12238 "" commidi_1.trest[icm] = 0.f; +#line 12239 "" commidi_1.restpend[icm] = FALSE_; +#line 12240 "" } +#line 12241 "" } else { +#line 12242 "" if (comevent_1.miditime > comevent_1.lasttime) { /* Insert a dummy turnoff in conductor track */ +#line 12246 "" r__1 = (comevent_1.miditime - comevent_1.lasttime) / 15.f; +#line 12246 "" addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & c_false, &c_true); +#line 12248 "" } +#line 12249 "" } +#line 12250 "" commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] = commidi_1.imidi[icm]; +#line 12251 "" commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 - 25] = commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25]; +#line 12252 "" commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25] = commmac_1.mmacend[icm + commmac_1.immac * 25 - 25]; +#line 12253 "" commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 - 25] = commidi_1.imidi[icm] + 1; +#line 12254 "" /* L6: */ +#line 12254 "" } +#line 12255 "" commmac_1.nmidsec += 2; /* Update running time */ +#line 12259 "" comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1] ; +#line 12260 "" comevent_1.lasttime = comevent_1.miditime; +#line 12261 "" } +#line 12262 "" goto L1; +#line 12263 "" } else { +#line 12264 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s" +#line 12264 "" + errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"\ "ub-command!", (ftnlen)128, (ftnlen)43); +#line 12266 "" stop1_(); +#line 12267 "" } +#line 12268 "" } else if (*(unsigned char *)durq == 'd') { +#line 12269 "" commidi_1.debugmidi = TRUE_; +#line 12270 "" goto L1; +#line 12271 "" } else if (*(unsigned char *)durq != ' ') { +#line 12272 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 12272 "" errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!" , (ftnlen)128, (ftnlen)37); - s_wsfe(&io___726); - do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, " +#line 12274 "" + s_wsfe(&io___757); +#line 12274 "" + do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\ "should be noinst, not nv", (ftnlen)77); +#line 12274 "" e_wsfe(); - s_wsfe(&io___727); - do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, " +#line 12277 "" + s_wsfe(&io___758); +#line 12277 "" + do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\ "should be noinst, not nv", (ftnlen)77); +#line 12277 "" e_wsfe(); +#line 12280 "" stop1_(); +#line 12281 "" } +#line 12282 "" if (! commmac_1.gottempo && ! (*first)) { /* If no tempo is set on first call on the pmxb pass, then set it */ +#line 12286 "" midievent_("t", &c__96, &c__0, (ftnlen)1); +#line 12287 "" commmac_1.gottempo = TRUE_; +#line 12288 "" } +#line 12289 "" return 0; } /* getmidi_ */ @@ -17927,6 +29503,7 @@ L1: integer s_wsfi(icilist *), e_wsfi(void); /* Local variables */ + static real tintstf; static integer lentemp; extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, ftnlen), getgrace_(integer *, integer *, char *, integer *, @@ -17935,12 +29512,14 @@ L1: extern integer igetbits_(integer *, integer *, integer *); static integer idotform; extern /* Subroutine */ int newvoice_(integer *, char *, logical *, - ftnlen), dopmxlyr_(char *, integer *, ftnlen); - static integer j; + ftnlen); + static integer multtrem; + extern /* Subroutine */ int dopmxlyr_(char *, integer *, ftnlen); + static integer j, note1xtup; extern /* Subroutine */ int readmeter_(char *, integer *, integer *, integer *, ftnlen), midievent_(char *, integer *, integer *, ftnlen); - static integer ic, jv, kv, iip, ipm, ivf, ndx, isl, iiv; + static integer ic, jv, kv, nnb, iip, ipm, ivf, ndx, isl, iiv; static real dum; static integer iis, npg1, num1, iadj, nadj, lclf; extern /* Character */ VOID chax_(char *, ftnlen, integer *); @@ -17956,6 +29535,7 @@ L1: static integer ipg1r; extern /* Subroutine */ int stop1_(void); static integer lhead; + static real pmfac; static char charq[1], lineq[128]; static logical moved; static integer ndoub; @@ -17968,8 +29548,9 @@ L1: integer *, integer *, integer *, integer *, ftnlen); static logical quoted; static char lineqt[128], hdlndq[59]; + static logical inxtup; extern integer lenstr_(char *, integer *, ftnlen); - static integer numnum; + static integer numnum, nsolid; extern /* Subroutine */ int getorn_(char *, integer *, integer *, integer *, logical *, integer *, integer *, integer *, logical *, logical *, integer *, ftnlen); @@ -17993,121 +29574,164 @@ L1: ftnlen), getmidi_(integer *, char *, integer *, integer *, integer *, integer *, integer *, integer *, logical *, ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, ftnlen); - static integer iofforn; + static integer nindent; extern /* Subroutine */ int setbits_(integer *, integer *, integer *, integer *), chkpm4ac_(char *, integer *, integer *, logical *, ftnlen); - static integer numshft; + extern integer ifnodur_(integer *, char *, ftnlen); + static integer numshft, iofforn; static real xofforn; - extern integer ifnolev_(char *, integer *, integer *, ftnlen), ifnodur_( - integer *, char *, ftnlen), numclef_(char *, ftnlen); + extern integer ifnolev_(char *, integer *, integer *, ftnlen), numclef_( + char *, ftnlen); static integer itother; - static real fmovbrk; extern /* Subroutine */ int spsslur_(char *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, logical *, integer *, char *, ftnlen, ftnlen); + static real fmovbrk; static integer lvoltxt, ltopnam, namstrt; - static real tintstf; /* Fortran I/O blocks */ - static cilist io___731 = { 0, 11, 0, "(a)", 0 }; - static cilist io___739 = { 0, 6, 0, 0, 0 }; - static cilist io___755 = { 0, 6, 0, 0, 0 }; - static cilist io___756 = { 0, 6, 0, 0, 0 }; - static cilist io___768 = { 0, 6, 0, 0, 0 }; - static cilist io___770 = { 0, 6, 0, 0, 0 }; + static cilist io___763 = { 0, 11, 0, "(a)", 0 }; static cilist io___771 = { 0, 6, 0, 0, 0 }; - static cilist io___774 = { 0, 6, 0, 0, 0 }; - static cilist io___779 = { 0, 11, 0, "(a)", 0 }; - static cilist io___780 = { 0, 11, 0, "(a)", 0 }; - static cilist io___783 = { 0, 11, 0, "(a)", 0 }; - static cilist io___784 = { 0, 11, 0, "(a)", 0 }; - static cilist io___785 = { 0, 11, 0, "(a)", 0 }; - static cilist io___786 = { 0, 11, 0, "(a)", 0 }; - static cilist io___787 = { 0, 11, 0, "(a)", 0 }; - static cilist io___788 = { 0, 11, 0, "(a11,i2,a)", 0 }; - static cilist io___789 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___791 = { 0, 11, 0, "(a8,i1,a3)", 0 }; - static cilist io___792 = { 0, 11, 0, "(a9,i2,a4)", 0 }; - static cilist io___793 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___794 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___782 = { 0, 6, 0, 0, 0 }; + static cilist io___783 = { 0, 6, 0, 0, 0 }; + static cilist io___794 = { 0, 6, 0, 0, 0 }; static cilist io___795 = { 0, 6, 0, 0, 0 }; - static cilist io___796 = { 0, 6, 0, 0, 0 }; - static cilist io___805 = { 0, 6, 0, 0, 0 }; - static cilist io___807 = { 0, 11, 0, "(a)", 0 }; - static cilist io___808 = { 0, 11, 0, "(a)", 0 }; - static cilist io___809 = { 0, 11, 0, "(a)", 0 }; - static cilist io___810 = { 0, 11, 0, "(a)", 0 }; - static cilist io___812 = { 0, 11, 0, "(a)", 0 }; - static cilist io___815 = { 0, 11, 0, "(a)", 0 }; - static cilist io___816 = { 0, 11, 0, "(a)", 0 }; - static cilist io___817 = { 0, 11, 0, "(a)", 0 }; + static cilist io___808 = { 0, 6, 0, 0, 0 }; + static cilist io___810 = { 0, 6, 0, 0, 0 }; + static cilist io___811 = { 0, 6, 0, 0, 0 }; + static cilist io___813 = { 0, 6, 0, 0, 0 }; static cilist io___818 = { 0, 11, 0, "(a)", 0 }; static cilist io___819 = { 0, 11, 0, "(a)", 0 }; - static cilist io___820 = { 0, 11, 0, "(a)", 0 }; - static cilist io___821 = { 0, 11, 0, "(a)", 0 }; static cilist io___822 = { 0, 11, 0, "(a)", 0 }; + static cilist io___823 = { 0, 11, 0, "(a)", 0 }; + static cilist io___824 = { 0, 11, 0, "(a)", 0 }; + static cilist io___825 = { 0, 11, 0, "(a)", 0 }; + static cilist io___826 = { 0, 11, 0, "(a)", 0 }; + static cilist io___827 = { 0, 11, 0, "(a11,i2,a)", 0 }; + static cilist io___828 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___830 = { 0, 11, 0, "(a8,i1,a3)", 0 }; + static cilist io___831 = { 0, 11, 0, "(a9,i2,a4)", 0 }; + static cilist io___832 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___833 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___834 = { 0, 6, 0, 0, 0 }; + static cilist io___835 = { 0, 6, 0, 0, 0 }; + static cilist io___837 = { 0, 6, 0, 0, 0 }; + static cilist io___845 = { 0, 6, 0, 0, 0 }; + static cilist io___847 = { 0, 11, 0, "(a)", 0 }; + static cilist io___848 = { 0, 11, 0, "(a)", 0 }; + static cilist io___849 = { 0, 11, 0, "(a)", 0 }; + static cilist io___850 = { 0, 11, 0, "(a)", 0 }; + static cilist io___852 = { 0, 11, 0, "(a)", 0 }; + static cilist io___855 = { 0, 11, 0, "(a)", 0 }; + static cilist io___856 = { 0, 11, 0, "(a)", 0 }; + static cilist io___857 = { 0, 11, 0, "(a)", 0 }; + static cilist io___858 = { 0, 11, 0, "(a)", 0 }; + static cilist io___859 = { 0, 11, 0, "(a)", 0 }; + static cilist io___860 = { 0, 11, 0, "(a)", 0 }; + static cilist io___861 = { 0, 11, 0, "(a)", 0 }; + static cilist io___862 = { 0, 11, 0, "(a)", 0 }; /* nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined */ /* ivx is current ivmx, and is the index for all notes, acc's etc. */ +#line 12411 "" cdot = FALSE_; +#line 12412 "" + inxtup = FALSE_; +#line 12413 "" L1: +#line 12413 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 12414 "" if (comget_1.lastchar) { +#line 12414 "" return 0; +#line 12414 "" } +#line 12415 "" if (*(unsigned char *)charq == ' ') { +#line 12415 "" goto L1; +#line 12415 "" } +#line 12416 "" if (*(unsigned char *)charq == '%') { /* Check for a bar number format: */ +#line 12420 "" if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' && i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0) { +#line 12422 "" if (comlast_1.islast) { - s_wsfe(&io___731); +#line 12422 "" + s_wsfe(&io___763); +#line 12422 "" do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128)); +#line 12422 "" e_wsfe(); +#line 12422 "" } +#line 12423 "" } +#line 12424 "" all_1.iccount = 128; +#line 12425 "" goto L1; +#line 12426 "" } /* Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */ +#line 12430 "" if (comget_1.rptprev) { +#line 12431 "" comget_1.rptnd1 = *(unsigned char *)charq == '/'; +#line 12432 "" comget_1.rptprev = FALSE_; +#line 12433 "" } /* Repeat at end of a piece */ +#line 12437 "" if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *( unsigned char *)charq == 'r') { +#line 12439 "" if (cdot) { +#line 12439 "" goto L28; +#line 12439 "" } /* This is a note/rest. */ +#line 12443 "" idotform = 0; +#line 12444 "" numnum = 0; /* If start of line of music, set pitch from previous */ +#line 12448 "" if (commvl_1.ivx <= all_1.nv) { +#line 12449 "" kv = 1; +#line 12450 "" } else { +#line 12451 "" kv = 2; +#line 12452 "" } +#line 12453 "" if (all_1.nnl[commvl_1.ivx - 1] == 0) { +#line 12453 "" comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25]; +#line 12453 "" } /* notcrd is used to tell if orn. goes on main note or chord note */ @@ -18116,45 +29740,63 @@ L1: /* Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */ +#line 12461 "" L28: /* Moved this from just above, 2 Feb 02 */ +#line 12465 "" comnotes_1.notcrd = TRUE_; +#line 12466 "" ++all_1.nnl[commvl_1.ivx - 1]; +#line 12467 "" if (comget_1.ornrpt) { /* Replicate ornament bits, also bit 23 for beam handling if chord. */ +#line 12471 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx - 1]; +#line 12472 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ +#line 12476 "" ++comtrill_1.ntrill; +#line 12477 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; +#line 12478 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; +#line 12479 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[ comtrill_1.ntrill - 2]; +#line 12480 "" } +#line 12481 "" } +#line 12482 "" if (comget_1.stickys) { /* Grab stemlength shortening parameters from prior note */ +#line 12486 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); /* call setbits (mult(ivx,nnl(ivx)),3,28, */ /* * igetbits(mult(ivx,nnl(ivx)-1),3,28)) */ +#line 12489 "" i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10); +#line 12489 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); +#line 12491 "" } +#line 12492 "" if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && ! comget_1.fbon) { @@ -18162,337 +29804,660 @@ L28: /* starts a period. */ /* if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */ +#line 12498 "" r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; +#line 12498 "" if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { /* Start a forced beam here */ +#line 12502 "" ++comfb_1.nfb[commvl_1.ivx - 1]; +#line 12503 "" comget_1.fbon = TRUE_; +#line 12504 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ commvl_1.ivx - 1] * 24 - 25] = 'x'; +#line 12505 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 12506 "" } +#line 12507 "" } +#line 12508 "" if (comget_1.fbon) { +#line 12508 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); +#line 12508 "" } +#line 12509 "" *(unsigned char *)dotq = 'x'; +#line 12510 "" if (*(unsigned char *)charq == 'r') { +#line 12510 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0); +#line 12510 "" } +#line 12512 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { /* Rest stuff. First check if previous note was full-bar-pause */ +#line 12516 "" i__1 = all_1.iccount; +#line 12516 "" if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1) == 0 && all_1.nnl[commvl_1.ivx - 1] > 1) { +#line 12518 "" if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25],19)) { +#line 12518 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); +#line 12518 "" } +#line 12520 "" } /* Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 */ /* for voice a or b. Set a-types at 0 as encountered and adjust later */ /* after '//'. (Override heights will be set to 100+offset) */ +#line 12526 "" if (commvl_1.ivx <= all_1.nv) { +#line 12527 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; +#line 12528 "" } else { +#line 12529 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 2; +#line 12530 "" } +#line 12531 "" } +#line 12532 "" L2: +#line 12532 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12533 "" ic = *(unsigned char *)durq; +#line 12534 "" if (ic <= 57 && ic >= 48) { /* Digit */ +#line 12538 "" if (numnum == 0) { +#line 12539 "" comnotes_1.nnodur = ic - 48; +#line 12540 "" numnum = 1; +#line 12541 "" goto L2; +#line 12542 "" } else if (numnum == 1) { +#line 12543 "" ioct = ic - 48; +#line 12544 "" numnum = 2; +#line 12545 "" goto L2; +#line 12546 "" } else { - s_wsle(&io___739); +#line 12547 "" + s_wsle(&io___771); +#line 12547 "" do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", ( ftnlen)31); +#line 12547 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); +#line 12547 "" do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( ftnlen)sizeof(integer)); +#line 12547 "" e_wsle(); +#line 12548 "" stop1_(); +#line 12549 "" } +#line 12550 "" } else if (*(unsigned char *)durq == 'd') { +#line 12551 "" *(unsigned char *)dotq = *(unsigned char *)durq; +#line 12552 "" i__1 = all_1.iccount; +#line 12552 "" if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1) == 0) { /* Double dot. */ +#line 12556 "" ++all_1.iccount; +#line 12557 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],3); +#line 12558 "" } +#line 12559 "" i__1 = all_1.iccount; +#line 12559 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 - i__1) > 0) { /* move a dot, unless next char is not part of a number */ +#line 12563 "" i__1 = all_1.iccount + 1; +#line 12563 "" if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, all_1.iccount + 2 - i__1) == 0) { +#line 12563 "" goto L2; +#line 12563 "" } +#line 12565 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); +#line 12566 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12567 "" ++comcc_1.ndotmv[commvl_1.ivx - 1]; +#line 12568 "" ++all_1.iccount; +#line 12569 "" readnum_(lineq, &all_1.iccount, dumq, &comcc_1.updot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); +#line 12570 "" if (*(unsigned char *)durq == '-') { +#line 12570 "" comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25] = -comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25]; +#line 12570 "" } +#line 12572 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift also */ +#line 12576 "" ++all_1.iccount; +#line 12577 "" readnum_(lineq, &all_1.iccount, durq, &comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], (ftnlen)128, (ftnlen)1); +#line 12578 "" if (*(unsigned char *)dumq == '-') { +#line 12578 "" comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25] = -comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25]; +#line 12578 "" } +#line 12580 "" } else { +#line 12581 "" comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25] = 0.f; +#line 12582 "" } +#line 12583 "" --all_1.iccount; +#line 12584 "" } +#line 12585 "" goto L2; +#line 12586 "" } else if (*(unsigned char *)durq == 'p') { /* Full-bar rest as pause */ +#line 12590 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); +#line 12591 "" goto L2; +#line 12592 "" } else if (*(unsigned char *)durq == 'b') { /* Blank rest */ +#line 12596 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],29); +#line 12597 "" goto L2; +#line 12598 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Accidental */ - if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - - 25] == 0) { +/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */ +/* 171209 May have set bit 18 earlier if D or F preceded accidental */ +#line 12604 "" + if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25], &c__2, &c__0) == 0) { /* No accidental has been set yet */ +/* nacc(ivx,nnl(ivx)) = index('fsn',durq) */ +#line 12609 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - - 25] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); + 25] |= i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); +#line 12611 "" } else { /* Repeated accid, so must be double */ +#line 12615 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],2); +#line 12616 "" } +#line 12617 "" goto L2; +#line 12618 "" } else if (*(unsigned char *)durq == 'i') { /* Set flag for MIDI-only accidental. */ +#line 12622 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); +#line 12623 "" goto L2; +#line 12624 "" } else if (*(unsigned char *)durq == 'c') { /* Set flags for cautionary accidental */ +#line 12628 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],31); +#line 12629 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1],31); +#line 12630 "" goto L2; +#line 12631 "" } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { +#line 12632 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 12633 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { /* A note, not a rest. */ +#line 12637 "" chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, ( ftnlen)128); +#line 12638 "" if (moved) { +#line 12638 "" goto L2; +#line 12638 "" } /* Octave jump with a note */ +#line 12642 "" if (numnum < 2) { +#line 12643 "" comnotes_1.lastlev += ipm * 7; +#line 12644 "" } else { +#line 12645 "" ioct += ipm; +#line 12646 "" } +#line 12647 "" goto L2; +#line 12648 "" } else { /* Override default height of a rest */ +#line 12652 "" ++all_1.iccount; +#line 12653 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 12654 "" i__1 = all_1.iccount - 2; +#line 12654 "" if (s_cmp(lineq + i__1, ".", all_1.iccount - 1 - i__1, ( ftnlen)1) == 0) { /* Kluge in case there is a shortcut ".". It will have been sucked up by */ /* readnum. (Same doesn't hold for ",") */ - all_1.iccount += -2; - goto L2; +#line 12659 "" + --all_1.iccount; +/* go to 2 */ +#line 12661 "" } +#line 12662 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ipm * i_nint(&fnum) + 100; /* There may be more characters for this rest */ +#line 12666 "" --all_1.iccount; +#line 12667 "" goto L2; +#line 12668 "" } +#line 12669 "" } else if (*(unsigned char *)durq == 'x') { /* Xtuplet. Count number of doubled notes (for unequal xtups) */ +#line 12673 "" if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18)) { +#line 12674 "" ndoub = 1; +#line 12675 "" } else { +#line 12676 "" ndoub = 0; +#line 12677 "" + } + +/* Initialize counter for # of non-rests, so can later unbeam if = 1. */ + +#line 12681 "" + inxtup = TRUE_; +#line 12682 "" + note1xtup = all_1.nnl[commvl_1.ivx - 1]; +#line 12683 "" + nnb = 0; +#line 12684 "" + if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25],0)) { +#line 12684 "" + nnb = 1; +#line 12684 "" } /* Will set all durations to 0 except last one. Set flag on this note. */ +#line 12688 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],28); -/* Next input will be digit */ +/* Next input will be digit unless its a "T" */ +#line 12692 "" ++all_1.iccount; - readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) - 1); - ntup = i_nint(&fnum); +#line 12693 "" + if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'T') { + +/* Set up tremolo */ + +#line 12697 "" + all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],2); +#line 12698 "" + ntup = 2; + +/* Set default beaming, based on Wikipedia article */ +/* May be a problem here is nnodur is inherited */ + +#line 12703 "" + if (comnotes_1.nnodur == 4) { +#line 12704 "" + nsolid = 0; +#line 12705 "" + nindent = 3; +#line 12706 "" + } else if (comnotes_1.nnodur == 2) { +#line 12707 "" + nsolid = 3; +#line 12708 "" + nindent = 0; +#line 12709 "" + } else if (comnotes_1.nnodur == 8) { +#line 12710 "" + nsolid = 1; +#line 12711 "" + nindent = 2; +#line 12712 "" + } +#line 12713 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12714 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) { +#line 12715 "" + nsolid = i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) + - 1; +#line 12716 "" + if (nsolid == 0 && comnotes_1.nnodur == 2) { +#line 12717 "" + s_wsle(&io___782); +#line 12717 "" + do_lio(&c__9, &c__1, "", (ftnlen)0); +#line 12717 "" + e_wsle(); +#line 12718 "" + s_wsle(&io___783); +#line 12718 "" + do_lio(&c__9, &c__1, "Unbeamed half-note 2-note trem"\ + "olo forbidden.", (ftnlen)44); +#line 12718 "" + e_wsle(); +#line 12719 "" + stop1_(); +#line 12720 "" + } +#line 12721 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 12722 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) + { +#line 12723 "" + nindent = i_indx("0123456789", durq, (ftnlen)10, ( + ftnlen)1) - 1; +#line 12724 "" + } +#line 12725 "" + } +#line 12726 "" + setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25], &c__2, &c__3, &nsolid); +#line 12727 "" + setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25], &c__2, &c__5, &nindent); +#line 12728 "" + if (nsolid == 0) { +#line 12729 "" + all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); +#line 12731 "" + } +#line 12732 "" + all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],31); +#line 12733 "" + all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21); +#line 12734 "" + setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx + - 1] + 1) * 24 - 25], &c__3, &c__22, &nsolid); + +/* Set some force-beam parameters for the tremolo */ + +/* Need to check if there's already a forced beam explicitly set here. */ +/* If there was, shouldn't do any harm resetting parameters. */ + +#line 12741 "" + if (comfb_1.nfb[commvl_1.ivx - 1] == 0 || comfb_1.t1fb[ + commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - + 25] != (real) all_1.itsofar[commvl_1.ivx - 1]) { +#line 12741 "" + ++comfb_1.nfb[commvl_1.ivx - 1]; +#line 12741 "" + } +#line 12743 "" + comget_1.fbon = TRUE_; +#line 12744 "" + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = 'x'; +#line 12745 "" + comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * + 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 12746 "" + comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * + 24 - 25] = (real) (all_1.itsofar[commvl_1.ivx - 1] + + ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1)); +#line 12747 "" + nadj = 0; + +/* Set open beamed notehead flag for half-note tremolo */ +/* Just gave 2 quarters with or without flag set. Need to fix */ + +#line 12752 "" + } else { +#line 12753 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 12754 "" + ntup = i_nint(&fnum); +#line 12755 "" + } +#line 12756 "" if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { + /* Double xtup note to make an un= xtup. Here xtup number already set but may also */ /* have this command before. */ +#line 12762 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); +#line 12763 "" if (*(unsigned char *)durq == 'F') { +#line 12763 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); +#line 12763 "" } +#line 12765 "" ndoub = 1; +#line 12766 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12767 "" } else if (*(unsigned char *)durq == 'd') { +#line 12768 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); +#line 12769 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12770 "" } /* Only other possibilities here are ' ' or 'n' */ +#line 12774 "" if (*(unsigned char *)durq == 'n') { /* Alter xtup number */ +#line 12778 "" i__1 = all_1.iccount; +#line 12778 "" if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, ( ftnlen)1) == 0) { /* If the only modifier is 'n', cancel the number */ +#line 12782 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31); +#line 12783 "" } else { +#line 12784 "" numshft = 0; +#line 12785 "" L30: +#line 12785 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 12786 "" if (*(unsigned char *)durq == 'f') { /* Flip up-down-ness */ +#line 12790 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],14); +#line 12791 "" goto L30; +#line 12792 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical or horiz shift */ +#line 12796 "" ++numshft; +#line 12797 "" iofforn = 1; +#line 12798 "" if (*(unsigned char *)durq == '-') { +#line 12798 "" iofforn = -1; +#line 12798 "" } +#line 12799 "" ++all_1.iccount; +#line 12800 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); +#line 12801 "" --all_1.iccount; +#line 12802 "" if (numshft == 1) { /* Vertical shift */ /* 160214 Allow (-64,64) */ /* iofforn = iofforn*nint(xofforn) + 16 */ +#line 12807 "" iofforn = iofforn * i_nint(&xofforn) + 64; /* c Turn on bit 1; set bits 2-6 to iofforn */ @@ -18500,249 +30465,386 @@ L30: /* irest(ivx,nnl(ivx)) = */ /* * ior(irest(ivx,nnl(ivx)),2+4*iofforn) */ +#line 12814 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],1); +#line 12815 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__8, & c__16, &iofforn); +#line 12816 "" } else { /* Horizontal shift */ +#line 12820 "" r__1 = xofforn * 10; +#line 12820 "" iofforn = iofforn * i_nint(&r__1) + 16; +#line 12821 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],7); +#line 12822 "" setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, & c__9, &iofforn); +#line 12823 "" } +#line 12824 "" goto L30; +#line 12825 "" } else if (*(unsigned char *)durq == 's') { /* Slope adjustment for bracket */ +#line 12829 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],4); +#line 12830 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 12831 "" iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 12832 "" ++all_1.iccount; +#line 12833 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); +#line 12834 "" --all_1.iccount; +#line 12835 "" r__1 = iofforn * xofforn + 16; +#line 12835 "" iofforn = i_nint(&r__1); +#line 12836 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, & iofforn); +#line 12837 "" } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) > 0) { /* Replacement printed number */ +#line 12841 "" readnum_(lineq, &all_1.iccount, durq, &xofforn, ( ftnlen)128, (ftnlen)1); +#line 12842 "" i__1 = i_nint(&xofforn); +#line 12842 "" setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, & i__1); +#line 12843 "" --all_1.iccount; +#line 12844 "" goto L30; +#line 12845 "" } +#line 12846 "" } +#line 12847 "" } /* Set note level of 1st note of xtup, provided not a rest */ +#line 12851 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { +#line 12852 "" if (numnum == 2) { +#line 12853 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1); +#line 12854 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; +#line 12855 "" } else { +#line 12856 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_( charq, &c__10, &cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen) 1) - comnotes_1.lastlev + 3) % 7; +#line 12858 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; +#line 12859 "" } +#line 12860 "" } +#line 12861 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set note level for preslur on starting note of xtuplet */ +#line 12865 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & c__7, &c__19, &comnotes_1.lastlev); +#line 12866 "" /* L40: */ +#line 12866 "" } +#line 12867 "" numnum = 0; +#line 12868 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; +#line 12869 "" i__1 = ntup; +#line 12869 "" for (itup = 2; itup <= i__1; ++itup) { +#line 12870 "" if (comget_1.ornrpt) { +#line 12871 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991; +#line 12873 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ +#line 12877 "" ++comtrill_1.ntrill; +#line 12878 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; +#line 12879 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; +#line 12880 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[comtrill_1.ntrill - 2]; +#line 12881 "" } +#line 12882 "" } +#line 12883 "" ++all_1.nnl[commvl_1.ivx - 1]; +#line 12884 "" if (comget_1.fbon) { +#line 12884 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); +#line 12884 "" } +#line 12885 "" L7: +#line 12885 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1) ; +#line 12886 "" if (*(unsigned char *)charq == ' ') { +#line 12887 "" goto L7; +#line 12888 "" } else if (*(unsigned char *)charq == '%') { +#line 12889 "" all_1.iccount = 128; +#line 12890 "" goto L7; +#line 12891 "" } else if (*(unsigned char *)charq == 'o') { /* Ornament in xtuplet. "o" symbol must come AFTER the affected note */ +#line 12895 "" if (comnotes_1.notcrd) { +#line 12896 "" nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25]; +#line 12897 "" } else { +#line 12898 "" nole = 127 & lbit_shift(comtrill_1.icrdat[ comtrill_1.ncrd - 1], (ftnlen)-12); +#line 12899 "" } +#line 12900 "" i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12900 "" getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1], & all_1.iornq[commvl_1.ivx - 1], &comget_1.ornrpt, & comgrace_1.noffseg, &i__2, &commvl_1.ivx, & c_false, &comnotes_1.notcrd, &nole, (ftnlen)128); +#line 12903 "" goto L7; +#line 12904 "" } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 12905 "" nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12906 "" if (*(unsigned char *)charq == '(' || *(unsigned char *) charq == '{') { /* Detected preslur in xtuplet loop, non-chord note */ +#line 12910 "" ++nnlivx; +#line 12911 "" ++comnotes_1.npreslur; +#line 12912 "" } +#line 12913 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0); +#line 12914 "" if (*(unsigned char *)charq == 't') { +#line 12914 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); +#line 12914 "" } +#line 12916 "" if (commvl_1.ivx <= all_1.nv) { +#line 12917 "" kv = 1; +#line 12918 "" } else { +#line 12919 "" kv = 2; +#line 12920 "" } +#line 12921 "" if (comslur_1.fontslur) { +#line 12922 "" sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, & all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[ commvl_1.ivx + nnlivx * 24 - 25], charq, ( ftnlen)128, (ftnlen)1); +#line 12924 "" } else { +#line 12925 "" spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, & nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, & comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, ( ftnlen)1); +#line 12927 "" } +#line 12928 "" goto L7; +#line 12929 "" } else if (*(unsigned char *)charq == 'G') { /* Kluge to get grace in xtup at right location */ +#line 12933 "" --all_1.nnl[commvl_1.ivx - 1]; +#line 12934 "" getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount, all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, &comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128); +#line 12936 "" ++all_1.nnl[commvl_1.ivx - 1]; +#line 12937 "" goto L7; +#line 12938 "" } else if (*(unsigned char *)charq == *(unsigned char *) all_1.sq) { +#line 12939 "" littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); +#line 12940 "" goto L7; +#line 12941 "" } else if (*(unsigned char *)charq == '"') { /* pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ */ +#line 12945 "" if (! comlyr_1.inputmlyr) { +#line 12946 "" ictemp = 0; /* Writing concatenation */ +#line 12947 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 12947 "" i__3[1] = 1, a__1[1] = all_1.sq; +#line 12947 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 12947 "" i__3[3] = 15, a__1[3] = "input musixlyr "; +#line 12947 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 12947 "" s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); +#line 12948 "" i__2 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 12948 "" littex_(all_1.islur, &i__2, &commvl_1.ivx, & comas3_1.topmods, lineqt, &ictemp, (ftnlen) 128); +#line 12949 "" comlyr_1.inputmlyr = TRUE_; +#line 12950 "" } +#line 12951 "" dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 12952 "" *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 12953 "" littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); +#line 12954 "" goto L7; +#line 12955 "" } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, ( ftnlen)1) > 0) { /* Figure. Must come AFTER the first note of xtup */ +#line 12959 "" ivf = 1; +#line 12960 "" if (commvl_1.ivx > 1) { +#line 12961 "" if (comfig_1.ivxfig2 == 0) { +#line 12962 "" comfig_1.ivxfig2 = commvl_1.ivx; +#line 12963 "" } else if (commvl_1.ivx != comfig_1.ivxfig2) { - s_wsle(&io___755); +#line 12964 "" + s_wsle(&io___794); +#line 12964 "" e_wsle(); - s_wsle(&io___756); - do_lio(&c__9, &c__1, "Figures not allowed in >1 " +#line 12965 "" + s_wsle(&io___795); +#line 12965 "" + do_lio(&c__9, &c__1, "Figures not allowed in >1 "\ "voice above first", (ftnlen)43); +#line 12965 "" e_wsle(); +#line 12966 "" s_stop("", (ftnlen)0); +#line 12967 "" } +#line 12968 "" ivf = 2; +#line 12969 "" } +#line 12970 "" nfig1 = comfig_1.nfigs[ivf - 1] + 1; +#line 12971 "" getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, &all_1.iccount, &all_1.isfig[ivf + ( all_1.nnl[commvl_1.ivx - 1] - 1 << 1) - 3], & @@ -18754,10 +30856,14 @@ L7: comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, ( ftnlen)10); /* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 12976 "" goto L7; +#line 12977 "" } else if (*(unsigned char *)charq == 'X') { /* Computing MAX */ +#line 12978 "" i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12978 "" getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__2,i__4) * 24 - 25], &comnotes_1.shifton, & comask_1.wheadpt, &all_1.iornq[commvl_1.ivx + @@ -18767,146 +30873,211 @@ L7: all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, & comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, ( ftnlen)1); +#line 12982 "" goto L7; +#line 12983 "" } else if (*(unsigned char *)charq == 'z') { /* Chord note in xtup. Goes with *prior* note. */ +#line 12987 "" comnotes_1.notcrd = FALSE_; +#line 12988 "" ++comtrill_1.ncrd; +#line 12989 "" all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],10); +#line 12990 "" numnum = 0; /* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ +#line 12992 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[ commvl_1.ivx - 1] - 1; +#line 12993 "" i__2 = commvl_1.ivx % 16; +#line 12993 "" setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, & c__8, &i__2); +#line 12994 "" if (commvl_1.ivx >= 16) { +#line 12994 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],28); +#line 12994 "" } +#line 12995 "" comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; /* Get note name */ +#line 12999 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( ftnlen)1); /* Get optional inputs */ +#line 13003 "" L34: +#line 13003 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); /* When chord note is done, will get ' ', making ndx=0, so go past this block */ +#line 13007 "" ndx = i_indx("fsn+-<>12345678reic", durq, (ftnlen)19, ( ftnlen)1); +#line 13008 "" if (ndx > 0) { +#line 13009 "" if (ndx <= 3) { +#line 13010 "" if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) { +#line 13011 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(comtrill_1.icrdat[ comtrill_1.ncrd - 1],19); +#line 13012 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20; +#line 13013 "" } else { +#line 13014 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(comtrill_1.icrdat[ comtrill_1.ncrd - 1],22); +#line 13015 "" } +#line 13016 "" } else if (ndx == 19) { /* Set flags for cautionary accidental */ +#line 13020 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],31) ; +#line 13021 "" all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1] ,31); +#line 13023 "" } else if (ndx <= 7) { /* +/-/</> Check whether octave or accidental shift */ +#line 13027 "" nactmp = 0; +#line 13028 "" chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128); +#line 13029 "" if (moved) { /* Transfer accidental shift values */ +#line 13033 "" i__2 = igetbits_(&nactmp, &c__6, &c__4); +#line 13033 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, &c__14, &i__2); +#line 13035 "" i__2 = igetbits_(&nactmp, &c__7, &c__10); +#line 13035 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, &c__20, &i__2); +#line 13037 "" } else { +#line 13038 "" if (*(unsigned char *)durq == '+') { +#line 13039 "" comnotes_1.lastlev += 7; +#line 13040 "" } else if (*(unsigned char *)durq == '-') { +#line 13041 "" comnotes_1.lastlev += -7; +#line 13042 "" } +#line 13043 "" } +#line 13044 "" } else if (*(unsigned char *)durq == 'e') { +#line 13045 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],23) ; +#line 13046 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); +#line 13047 "" } else if (*(unsigned char *)durq == 'r') { +#line 13048 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],24) ; +#line 13049 "" all_1.irest[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],20); +#line 13051 "" } else if (*(unsigned char *)durq == 'i') { /* Midi-only accidental */ +#line 13055 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],27) ; +#line 13056 "" } else { /* must be a number, save it in ioct */ +#line 13060 "" numnum = 1; +#line 13061 "" ioct = ndx - 7; +#line 13062 "" } +#line 13063 "" goto L34; +#line 13064 "" } +#line 13065 "" if (numnum == 1) { +#line 13066 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1); +#line 13067 "" } else { +#line 13068 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + ( ifnolev_(charq, &c__10, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1) - comnotes_1.lastlev + 3) % 7; +#line 13070 "" } +#line 13071 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12; +#line 13072 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set note level for preslur on chord note in xtup */ +#line 13076 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7, &c__19, & comnotes_1.lastlev); @@ -18914,346 +31085,505 @@ L34: /* Following lines copied from loop for non-xtup, chord note, preslur */ /* Initially I assigned the slur(s) to next note, so fix. */ +#line 13081 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_clear(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0); +#line 13082 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],0); +#line 13083 "" all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set(all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0); +#line 13085 "" i__2 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3) - 1; +#line 13085 "" setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3, &i__2); +#line 13087 "" /* L41: */ +#line 13087 "" } +#line 13088 "" goto L7; +#line 13089 "" } else if (*(unsigned char *)charq == '?') { /* Arpeggio */ +#line 13093 "" if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25],10)) { /* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ /* of chord, will not set icrdat(25), but iornq(27) */ +#line 13098 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],25); +#line 13099 "" } else { +#line 13100 "" all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1] = bit_set(all_1.iornq[ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1],27); +#line 13101 "" } /* Check for shift */ +#line 13105 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 13106 "" if (*(unsigned char *)durq == ' ') { +#line 13107 "" --all_1.iccount; +#line 13108 "" } else { /* durq must be "-" */ +#line 13112 "" ++all_1.iccount; +#line 13113 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 13114 "" --all_1.iccount; /* record the shift */ +#line 13118 "" ++comarpshift_1.numarpshift; +#line 13119 "" comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] = commvl_1.ivx; +#line 13120 "" comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 13121 "" comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum; +#line 13122 "" } +#line 13123 "" goto L7; +#line 13124 "" } else if (*(unsigned char *)charq == 'D') { +#line 13125 "" i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 13125 "" getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25], & all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1], lineq, & all_1.iccount, (ftnlen)128); +#line 13127 "" goto L7; /* 140215 Allow clef change inside xtuplet. With normal code, came out one */ /* note too late, so try making it come earlier. */ +#line 13132 "" } else if (*(unsigned char *)charq == 'C') { /* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ /* if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 */ +#line 13137 "" if (all_1.nnl[all_1.iv - 1] - 1 > 0) { +#line 13137 "" ++comcc_1.ncc[all_1.iv - 1]; +#line 13137 "" } /* 140218 Need to get time differently inside xtup, since itsofar doesn't get */ /* updated until after xtup is done */ -/* tcc(iv,ncc(iv)) = itsofar(iv) */ +#line 13142 "" nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 13143 "" comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real) (all_1.itsofar[all_1.iv - 1] + ( integer) (nodurt * 1.f / ntup * (itup - 1))); -/* print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' */ -/* print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) */ -/* isl = ibset(islur(iv,nnl(iv)+1),11) */ +#line 13144 "" isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25],11); +#line 13145 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); /* Store clef number, or 7 if clef number = 9 (French violin clef) */ /* Computing MIN */ +#line 13149 "" i__2 = numclef_(durq, (ftnlen)1); +#line 13149 "" isl |= min(i__2,7) << 12; +#line 13150 "" comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = ncmidf_(durq, (ftnlen)1); +#line 13151 "" if (*(unsigned char *)durq == '8') { +#line 13152 "" all_1.ipl[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25] = bit_set(all_1.ipl[all_1.iv + all_1.nnl[ all_1.iv - 1] * 24 - 25],2); +#line 13153 "" cominsttrans_1.itransamt[cominsttrans_1.instno[ - all_1.iv - 1] - 1] = 7; + all_1.iv - 1] - 1] += 7; +#line 13154 "" } /* Set marker on note with lowest voice # starting at same time. */ +#line 13158 "" if (all_1.iv == 1) { +#line 13159 "" isl = bit_set(isl,15); +#line 13160 "" } else { +#line 13161 "" i__2 = all_1.iv; +#line 13161 "" for (iiv = 1; iiv <= i__2; ++iiv) { /* nnliiv = nnl(iiv) */ +#line 13163 "" nnliiv = all_1.nnl[iiv - 1] - 1; +#line 13164 "" if (iiv == all_1.iv) { +#line 13164 "" ++nnliiv; +#line 13164 "" } +#line 13165 "" itother = 0; +#line 13166 "" i__4 = nnliiv; +#line 13166 "" for (iip = 1; iip <= i__4; ++iip) { +#line 13167 "" if (itother < all_1.itsofar[all_1.iv - 1]) { +#line 13168 "" itother += all_1.nodur[iiv + iip * 24 - 25]; +#line 13169 "" goto L71; +#line 13170 "" } else if (itother == all_1.itsofar[all_1.iv - 1]) { +#line 13171 "" all_1.islur[iiv + iip * 24 - 25] = bit_set(all_1.islur[iiv + iip * 24 - 25],15); +#line 13172 "" goto L72; +#line 13173 "" } +#line 13174 "" L71: +#line 13174 "" ; +#line 13174 "" } +#line 13175 "" /* L70: */ +#line 13175 "" } +#line 13176 "" L72: +#line 13177 "" ; +#line 13177 "" } /* Need 'or' since may have set bit 15 in the above loop */ /* islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) */ +#line 13182 "" all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25] = isl | all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25]; +#line 13183 "" goto L7; /* +++ */ +#line 13185 "" } else if (*(unsigned char *)charq == ']') { /* Multiplicity up-down, must have '][ ' */ +#line 13189 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],20) ; +#line 13190 "" all_1.iccount += 2; +#line 13191 "" goto L7; /* c+++ */ +#line 13193 "" } /* End of loop for xtup options. If here, charq must be a (non-crd) note name. */ /* or rest */ +#line 13198 "" if (*(unsigned char *)charq == 'r') { /* Rest in xtup */ +#line 13202 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0); +#line 13203 "" i__2 = all_1.iccount; +#line 13203 "" if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount + 1 - i__2) > 0) { +#line 13204 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 13205 "" if (*(unsigned char *)durq == 'b') { /* Blank rest in middle of xtup */ +#line 13209 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],29); +#line 13210 "" } else { /* Override height of embedded xtup rest */ +#line 13214 "" ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 13215 "" ++all_1.iccount; +#line 13216 "" readnum_(lineq, &all_1.iccount, durq, &fnum, ( ftnlen)128, (ftnlen)1); +#line 13217 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ipm * i_nint(&fnum) + 100; +#line 13218 "" --all_1.iccount; +#line 13219 "" } +#line 13220 "" } else if (commvl_1.ivx <= all_1.nv) { +#line 13221 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; +#line 13222 "" } else { +#line 13223 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 2; +#line 13224 "" } +/* end if */ +#line 13226 "" + } else { + +/* Counter for non-rests */ + +#line 13230 "" + ++nnb; +#line 13231 "" } +#line 13232 "" comnotes_1.notcrd = TRUE_; +#line 13233 "" L8: +#line 13233 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13234 "" if (*(unsigned char *)durq != ' ') { +#line 13235 "" if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { /* Accidental horizontal shift */ +#line 13239 "" chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, (ftnlen)128); +#line 13240 "" if (! moved) { +#line 13241 "" if (*(unsigned char *)durq == '+') { +#line 13242 "" comnotes_1.lastlev += 7; +#line 13243 "" } else if (*(unsigned char *)durq == '-') { +#line 13244 "" comnotes_1.lastlev += -7; +#line 13245 "" } +#line 13246 "" } +#line 13247 "" } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { - if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - - 1] * 24 - 25] == 0) { + +/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */ +/* May have set other bits earlier */ +#line 13251 "" + if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25], &c__2, &c__0) == + 0) { /* No accid set yet */ +/* nacc(ivx,nnl(ivx)) = index('fsn',durq) */ +#line 13256 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - - 1] * 24 - 25] = i_indx("fsn", durq, ( + - 1] * 24 - 25] |= i_indx("fsn", durq, ( ftnlen)3, (ftnlen)1); +#line 13258 "" } else { /* Symbol must be repeated, so it's a double */ +#line 13262 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],2); +#line 13263 "" } +#line 13264 "" } else if (*(unsigned char *)durq == 'i') { /* Set flag for midi-only accidental */ +#line 13268 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); +#line 13270 "" } else if (*(unsigned char *)durq == 'c') { /* Set flags for cautionary accidental */ +#line 13274 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31); +#line 13275 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1],31); +#line 13276 "" } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Force stem direction for non-beamed xtup note */ +#line 13280 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30); +#line 13281 "" if (*(unsigned char *)durq == 'u') { +#line 13281 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17); +#line 13281 "" } +#line 13283 "" } else if (*(unsigned char *)durq == 'e') { /* Left-shift main xtup note */ +#line 13287 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8); +#line 13288 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); +#line 13289 "" } else if (*(unsigned char *)durq == 'r') { /* Right-shift main xtup note */ +#line 13293 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9); +#line 13294 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],20); +#line 13295 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double an xtup note to make an unequal xtup */ +#line 13299 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); +#line 13300 "" if (*(unsigned char *)durq == 'F') { +#line 13300 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19); +#line 13300 "" } +#line 13302 "" ++ndoub; +#line 13303 "" } else if (*(unsigned char *)durq == 'd') { /* Dotted xtup note */ +#line 13307 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); +#line 13308 "" } else { /* Must be an octave number */ +#line 13312 "" i__2 = *(unsigned char *)durq - 48; +#line 13312 "" comnotes_1.lastlev = ifnolev_(charq, &i__2, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1); +#line 13314 "" } +#line 13315 "" goto L8; +#line 13316 "" } +#line 13317 "" if (itup < ntup) { /* Last note is handled *after* flowing out of the xtup if block, but still */ @@ -19261,117 +31591,170 @@ L8: /* Could have problem here if rests & doubled notes are combined in xtup, */ /* since might exit the loop at the wrong place. Worry about it later. */ +#line 13324 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0)) { +#line 13325 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + ( ifnolev_(charq, &c__10, & cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], ( ftnlen)1) - comnotes_1.lastlev + 3) % 7; +#line 13327 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; +#line 13328 "" } +#line 13329 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = 0; +#line 13330 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set note level for preslur on internal xtup note */ +#line 13334 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7, &c__19, & comnotes_1.lastlev); +#line 13335 "" /* L42: */ +#line 13335 "" } +#line 13336 "" } +#line 13337 "" if (itup == ntup - ndoub) { +#line 13337 "" goto L12; +#line 13337 "" } +#line 13338 "" /* L6: */ +#line 13338 "" } +#line 13339 "" L12: +#line 13340 "" if (comget_1.ornrpt) { +#line 13341 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991; +#line 13343 "" if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] & 32896) > 0) { /* This is a trill (bit 7 or 15) so must dup the parameters */ +#line 13347 "" ++comtrill_1.ntrill; +#line 13348 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; +#line 13349 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ commvl_1.ivx - 1]; +#line 13350 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[comtrill_1.ntrill - 2]; +#line 13351 "" } +#line 13352 "" } /* End of if-block for xtuplet input */ +#line 13356 "" } else if (*(unsigned char *)durq == 'm') { /* Multi-bar rest: next 1 or two digits are # of bars. */ /* For some purposes, pretend its one bar only */ +#line 13361 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.lenbar; +#line 13362 "" comgrace_1.ibarmbr = all_1.nbars + 1; +#line 13363 "" comgrace_1.mbrest = 0; +#line 13364 "" comgrace_1.xb4mbr = 0.f; +#line 13365 "" L20: +#line 13365 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13366 "" if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) { +#line 13367 "" comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char * )durq - 48; +#line 13368 "" goto L20; +#line 13369 "" } +#line 13370 "" } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Set stem flipper */ +#line 13374 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],30); +#line 13375 "" if (*(unsigned char *)durq == 'u') { +#line 13375 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],17); +#line 13375 "" } +#line 13377 "" goto L2; +#line 13378 "" } else if (*(unsigned char *)durq == 'a') { /* "Alone", i.e., prohibit beam */ +#line 13382 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); +#line 13383 "" goto L2; +#line 13384 "" } else if (*(unsigned char *)durq == 'r') { /* Right offset by one notehead */ +#line 13388 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9); +#line 13389 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],20); +#line 13390 "" goto L2; +#line 13391 "" } else if (*(unsigned char *)durq == 'e') { /* Left offset by one notehead */ +#line 13395 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8); +#line 13396 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); +#line 13397 "" goto L2; -/* else if (durq .eq. 'S') then */ +#line 13398 "" } else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 */ @@ -19379,260 +31762,428 @@ L20: /* interbeams = internotes*2/3. */ +#line 13405 "" isign = 1; +#line 13406 "" if (*(unsigned char *)durq == 'S') { +#line 13406 "" isign = -1; +#line 13406 "" } +#line 13407 "" all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],27); +#line 13408 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13409 "" if (*(unsigned char *)durq == ':') { /* End stickyS. Grab data now from prior note, since we have to shut off stickyS. */ +#line 13413 "" i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10); +#line 13413 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); +#line 13415 "" comget_1.stickys = FALSE_; +#line 13416 "" goto L2; +#line 13417 "" } /* If durq .ne. ':' then iccount is now on the start of the number */ +#line 13421 "" readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen) 1); +#line 13422 "" dum = isign * dum; +#line 13423 "" r__1 = (dum + 4.f) * 2; +#line 13423 "" i__1 = i_nint(&r__1); +#line 13423 "" setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &c__6, &c__10, &i__1); +#line 13424 "" if (*(unsigned char *)durq == ':') { +#line 13425 "" comget_1.stickys = TRUE_; +#line 13426 "" } else { +#line 13427 "" --all_1.iccount; +#line 13428 "" } +#line 13429 "" goto L2; +#line 13430 "" } else if (*(unsigned char *)durq == ',') { /* 2:1 pattern */ +#line 13434 "" idotform = 3; /* Now flow to duration setting, as if durq=' ' */ +#line 13438 "" } else if (*(unsigned char *)durq == '.') { /* Dotted pattern. Close out note. Mult time by 3/4. */ /* Set time for next note to 1/4. Start the note. */ +#line 13443 "" idotform = 1; +#line 13444 "" } else if (*(unsigned char *)durq == 'o') { /* Suppress rest centering */ +#line 13448 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],25); +#line 13449 "" goto L2; +#line 13450 "" } else if (*(unsigned char *)durq == 'L') { /* With keyboard rest option, look left */ /* iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) */ +#line 13455 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],1); +#line 13456 "" goto L2; +#line 13457 "" } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Double note for xtup. Must check here in case "D" came before "x" or on */ /* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */ +#line 13462 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18); +#line 13463 "" if (*(unsigned char *)durq == 'F') { +#line 13463 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],19); +#line 13463 "" } +#line 13465 "" goto L2; +#line 13466 "" } else if (*(unsigned char *)durq == 'A') { /* Accidental option */ +#line 13470 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13472 "" if (*(unsigned char *)durq == 'o') { /* Ordered accidentals in a chord. Mark the main note. */ +#line 13476 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],28); +#line 13477 "" } else { /* Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */ +#line 13481 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],29); +#line 13482 "" + --all_1.iccount; +#line 13483 "" + } +#line 13484 "" + goto L2; +#line 13485 "" + } else if (*(unsigned char *)durq == 'T') { +#line 13486 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13487 "" + multtrem = i_indx("1234", durq, (ftnlen)4, (ftnlen)1); +#line 13488 "" + if (multtrem == 0) { +#line 13489 "" --all_1.iccount; +#line 13490 "" + multtrem = 1; +#line 13491 "" } +#line 13492 "" + all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = + bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25],4); +#line 13493 "" + i__1 = multtrem - 1; +#line 13493 "" + setbits_(&all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25], &c__2, &c__5, &i__1); +#line 13494 "" goto L2; +#line 13495 "" } else if (*(unsigned char *)durq != ' ') { - s_wsle(&io___768); +#line 13496 "" + s_wsle(&io___808); +#line 13496 "" do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27); +#line 13496 "" do_lio(&c__9, &c__1, durq, (ftnlen)1); +#line 13496 "" do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9); +#line 13496 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); +#line 13496 "" do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( ftnlen)sizeof(integer)); +#line 13496 "" e_wsle(); +#line 13498 "" stop1_(); +#line 13499 "" } /* Done with note/rest options. Set level and duration. */ +#line 13503 "" if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0)) { +#line 13504 "" if (numnum == 2) { +#line 13505 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1); +#line 13506 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; +#line 13507 "" } else { +#line 13508 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, &c__10, &cominsttrans_1.itransamt[ cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) % 7; +#line 13510 "" all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = comnotes_1.lastlev; +#line 13511 "" } +#line 13512 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { /* Set level for preslur on normal note, non-chord */ +#line 13516 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & c__7, &c__19, &comnotes_1.lastlev); +#line 13517 "" /* L43: */ +#line 13517 "" } + +/* Only matters if last note, non-rest of xtuplet */ + +#line 13521 "" + ++nnb; +#line 13522 "" + } + +/* Set flag for unbeamed xtup if it just has 1 note */ + +#line 13526 "" + if (inxtup && nnb == 1) { +/* ??? islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),19) */ +#line 13528 "" + all_1.islur[commvl_1.ivx + note1xtup * 24 - 25] = bit_set( + all_1.islur[commvl_1.ivx + note1xtup * 24 - 25],18); +#line 13529 "" } +#line 13530 "" if (idotform > 0) { +#line 13531 "" if (idotform == 1) { +#line 13532 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1) * 3 / 2; +#line 13533 "" } else if (idotform == 2) { +#line 13534 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25] / 3; +#line 13535 "" } else if (idotform == 3) { +#line 13536 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 13537 "" } else if (idotform == 4) { +#line 13538 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] - 1) * 24 - 25] / 2; +#line 13539 "" } +#line 13540 "" } else if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19)) { /* Set duration of full-bar rest as pause */ +#line 13544 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.lenbar; /* Use a one-line function to set nnodur. It gives inverse of ifnodur. */ +#line 13548 "" i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48; +#line 13548 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 13548 "" comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, ( ftnlen)1) - 1; +#line 13550 "" } else if (comgrace_1.ibarmbr != all_1.nbars + 1) { +#line 13551 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 13552 "" if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],3)) { +#line 13552 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25] * 7 / 6; +#line 13552 "" } +#line 13554 "" } +#line 13555 "" if (comnotes_1.shifton && ! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],16)) { /* Shift is on, and this is not first shifted note. Check for duration change */ +#line 13559 "" if (all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] != all_1.nodur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25]) { /* Must stop and restart the offset. */ +#line 13563 "" all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],17); +#line 13564 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],16); +#line 13565 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 13566 "" comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udoff[commvl_1.ivx + ( comudsp_1.nudoff[commvl_1.ivx - 1] - 1) * 24 - 25]; +#line 13567 "" } +#line 13568 "" } +#line 13569 "" all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13570 "" if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && comget_1.fbon) { /* Check to see if need to terminate auto forced beam */ +#line 13574 "" r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; +#line 13574 "" if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { /* Terminate autofb */ +#line 13578 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 13579 "" comget_1.fbon = FALSE_; +#line 13580 "" } +#line 13581 "" } +#line 13582 "" if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar == 0) { /* Finished a bar */ +#line 13586 "" ++all_1.nbars; +#line 13587 "" all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[ commvl_1.ivx - 1]; +#line 13588 "" if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) { /* Just finished the pickup bar for this voice. */ +#line 13592 "" all_1.lenbar = all_1.lenb1; +#line 13593 "" } +#line 13594 "" } +#line 13595 "" if (idotform == 1) { +#line 13596 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13597 "" idotform = 2; +#line 13598 "" numnum = 1; +#line 13599 "" goto L28; +#line 13600 "" } else if (idotform == 3) { +#line 13601 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13602 "" idotform = 4; +#line 13603 "" numnum = 1; +#line 13604 "" goto L28; +#line 13605 "" } /* End of sub block for note-rest */ +#line 13609 "" } else if (*(unsigned char *)charq == 'z') { /* Chord note. Must have note name, may have octave#,+,-,s,f,n,d */ @@ -19664,212 +32215,331 @@ L20: /* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ +#line 13640 "" ++comtrill_1.ncrd; +#line 13641 "" all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],10); +#line 13642 "" numnum = 0; /* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ +#line 13644 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1]; +#line 13645 "" i__1 = commvl_1.ivx % 16; +#line 13645 "" setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1) ; +#line 13646 "" if (commvl_1.ivx >= 16) { +#line 13646 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],28); +#line 13646 "" } +#line 13647 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0; +#line 13648 "" comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; /* Get note name */ +#line 13652 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); /* Get optional inputs */ +#line 13656 "" L25: +#line 13656 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* ndx = index('fsn+-<>12345678rediA',durq) */ +#line 13658 "" ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1); +#line 13659 "" if (ndx == 20) { /* Expect +|-|<|> , set tag, loop */ +#line 13663 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],29); +#line 13664 "" goto L25; +#line 13665 "" } else if (ndx > 0) { +#line 13666 "" if (ndx <= 3) { +#line 13667 "" if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) { +#line 13668 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],19); +#line 13669 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20; +#line 13670 "" } else { +#line 13671 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],22); +#line 13672 "" } +#line 13673 "" } else if (ndx == 21) { /* Set flags for cautionary accidental */ +#line 13677 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],31); +#line 13678 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1],31); +#line 13679 "" } else if (ndx <= 7) { /* +/-/</> Check whether octave or accidental shift */ +#line 13683 "" nactmp = 0; +#line 13684 "" chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128) ; +#line 13685 "" if (moved) { /* Transfer accidental shift values */ +#line 13689 "" i__1 = igetbits_(&nactmp, &c__6, &c__4); +#line 13689 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, & c__14, &i__1); +#line 13690 "" i__1 = igetbits_(&nactmp, &c__7, &c__10); +#line 13690 "" setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, & c__20, &i__1); +#line 13691 "" } else { +#line 13692 "" if (*(unsigned char *)durq == '+') { +#line 13693 "" comnotes_1.lastlev += 7; +#line 13694 "" } else if (*(unsigned char *)durq == '-') { +#line 13695 "" comnotes_1.lastlev += -7; +#line 13696 "" } +#line 13697 "" } +#line 13698 "" } else if (*(unsigned char *)durq == 'e') { +#line 13699 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],23); +#line 13700 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],27); +#line 13701 "" } else if (*(unsigned char *)durq == 'r') { +#line 13702 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],24); +#line 13703 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],20); +#line 13704 "" } else if (*(unsigned char *)durq == 'i') { /* Midi-only accidental on chord note */ +#line 13708 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],27); +#line 13709 "" } else if (*(unsigned char *)durq == 'd') { /* Must keep 'd' optional (backward compatibility), unless it is moved! */ +#line 13713 "" i__1 = all_1.iccount; +#line 13713 "" if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 - i__1) > 0) { /* move a dot, unless next char is not part of a number */ +#line 13717 "" i__1 = all_1.iccount + 1; +#line 13717 "" if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, all_1.iccount + 2 - i__1) == 0) { +#line 13717 "" goto L25; +#line 13717 "" } +#line 13719 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],26); +#line 13720 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 13721 "" ++all_1.iccount; +#line 13722 "" readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 13723 "" if (*(unsigned char *)durq == '+') { +#line 13724 "" r__1 = fnum * 10; +#line 13724 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(& r__1) + 64; +#line 13725 "" } else { +#line 13726 "" r__1 = fnum * 10; +#line 13726 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(& r__1) + 64; +#line 13727 "" } +#line 13728 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical shift specified also */ +#line 13732 "" ++all_1.iccount; +#line 13733 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) 128, (ftnlen)1); +#line 13734 "" if (*(unsigned char *)dumq == '+') { +#line 13735 "" r__1 = fnum * 10; +#line 13735 "" ifnum = i_nint(&r__1) + 64; +#line 13736 "" } else { +#line 13737 "" r__1 = fnum * 10; +#line 13737 "" ifnum = -i_nint(&r__1) + 64; +#line 13738 "" } +#line 13739 "" } else { +#line 13740 "" ifnum = 64; +#line 13741 "" } +#line 13742 "" comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7; +#line 13743 "" --all_1.iccount; +#line 13744 "" } +#line 13745 "" } else { /* must be a single digit, save it in ioct */ +#line 13749 "" numnum = 1; +#line 13750 "" ioct = ndx - 7; +#line 13751 "" } +#line 13752 "" goto L25; +#line 13753 "" } +#line 13754 "" if (numnum == 1) { +#line 13755 "" comnotes_1.lastlev = ifnolev_(charq, &ioct, & cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1); +#line 13756 "" } else { +#line 13757 "" comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, & c__10, &cominsttrans_1.itransamt[cominsttrans_1.instno[ all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) % 7; +#line 13759 "" } +#line 13760 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12; +#line 13761 "" for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { +#line 13762 "" setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7, &c__19, &comnotes_1.lastlev); /* Set level for chord note. */ /* Initially I assigned the slur(s) to next note, so fix. */ +#line 13767 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_clear(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],0); +#line 13768 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],0); +#line 13769 "" all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set( all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0); +#line 13770 "" i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3) - 1; +#line 13770 "" setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, &c__3, &i__1); +#line 13772 "" /* L44: */ +#line 13772 "" } +#line 13773 "" if (comnotes_1.notcrd) { /* This is the first chord note in this chord. */ /* Computing MIN */ +#line 13777 "" i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13777 "" comtrill_1.minlev = min(i__1,comnotes_1.lastlev); /* Computing MAX */ +#line 13778 "" i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13778 "" comtrill_1.maxlev = max(i__1,comnotes_1.lastlev); +#line 13779 "" } else { +#line 13780 "" comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev); +#line 13781 "" comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev); +#line 13782 "" } +#line 13783 "" comnotes_1.notcrd = FALSE_; +#line 13784 "" } else if (*(unsigned char *)charq == 'G') { +#line 13785 "" getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount, all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, & comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128); @@ -19887,146 +32557,228 @@ L25: /* These data MUST precede note name of first note */ /* nolevg, naccg: lists of levels and accid's, indexed as described above. */ +#line 13801 "" } else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) { /* Literal TeX string */ +#line 13805 "" i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 13805 "" littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); +#line 13806 "" } else if (*(unsigned char *)charq == '"') { /* pmxlyr string. Expand "..." to \pmxlyr{...}\ */ +#line 13810 "" if (! comlyr_1.inputmlyr) { +#line 13811 "" ictemp = 0; /* Writing concatenation */ +#line 13812 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 13812 "" i__3[1] = 1, a__1[1] = all_1.sq; +#line 13812 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 13812 "" i__3[3] = 15, a__1[3] = "input musixlyr "; +#line 13812 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 13812 "" s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128); +#line 13813 "" i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 13813 "" littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineqt, &ictemp, (ftnlen)128); +#line 13814 "" comlyr_1.inputmlyr = TRUE_; +#line 13815 "" } +#line 13816 "" dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 13817 "" *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 13818 "" i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 13818 "" littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & all_1.iccount, (ftnlen)128); +#line 13819 "" } else if (*(unsigned char *)charq == 'o') { /* Ornament on non-xtup note. Symbol must come AFTER the affected note */ +#line 13823 "" if (comnotes_1.notcrd) { +#line 13824 "" nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13825 "" } else { +#line 13826 "" nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], ( ftnlen)-12); +#line 13827 "" } +#line 13828 "" getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[commvl_1.ivx - 1], & comget_1.ornrpt, &comgrace_1.noffseg, &all_1.nnl[commvl_1.ivx - 1], &commvl_1.ivx, &c_true, &comnotes_1.notcrd, &nole, ( ftnlen)128); +#line 13831 "" } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 13832 "" nnlivx = all_1.nnl[commvl_1.ivx - 1]; +#line 13833 "" if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{') { /* Detect preslur on normal non-chord note */ +#line 13837 "" ++nnlivx; +#line 13838 "" ++comnotes_1.npreslur; +#line 13839 "" } +#line 13840 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[ commvl_1.ivx + nnlivx * 24 - 25],0); +#line 13841 "" if (*(unsigned char *)charq == 't') { +#line 13841 "" all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); +#line 13841 "" } +#line 13843 "" if (commvl_1.ivx <= all_1.nv) { +#line 13844 "" kv = 1; +#line 13845 "" } else { +#line 13846 "" kv = 2; +#line 13847 "" } +#line 13848 "" if (comslur_1.fontslur) { +#line 13849 "" sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, & comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, (ftnlen)1); +#line 13851 "" } else { +#line 13852 "" spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx, all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, & all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[ commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, ( ftnlen)1); +#line 13854 "" } +#line 13855 "" } else if (*(unsigned char *)charq == '?') { /* Arpeggio */ +#line 13859 "" if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],10)) { /* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */ /* of chord, will not set icrdat(25), but iornq(27) */ +#line 13864 "" comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( comtrill_1.icrdat[comtrill_1.ncrd - 1],25); +#line 13865 "" } else { +#line 13866 "" all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 1],27); +#line 13867 "" } /* Check for shift */ +#line 13871 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13872 "" if (*(unsigned char *)durq == ' ') { +#line 13873 "" --all_1.iccount; +#line 13874 "" } else { /* durq must be "-" */ +#line 13878 "" ++all_1.iccount; +#line 13879 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 13880 "" --all_1.iccount; /* record the shift */ +#line 13884 "" ++comarpshift_1.numarpshift; +#line 13885 "" comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] = commvl_1.ivx; +#line 13886 "" comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] = all_1.nnl[commvl_1.ivx - 1]; +#line 13887 "" comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum; +#line 13888 "" } +#line 13889 "" } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > 0) { /* We have a figure. Must come AFTER the note it goes under */ +#line 13894 "" ivf = 1; +#line 13895 "" if (commvl_1.ivx > 1) { +#line 13896 "" if (comfig_1.ivxfig2 == 0) { +#line 13897 "" comfig_1.ivxfig2 = commvl_1.ivx; +#line 13898 "" } else if (commvl_1.ivx != comfig_1.ivxfig2) { - s_wsle(&io___770); +#line 13899 "" + s_wsle(&io___810); +#line 13899 "" e_wsle(); - s_wsle(&io___771); - do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above " +#line 13900 "" + s_wsle(&io___811); +#line 13900 "" + do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "\ "first", (ftnlen)43); +#line 13900 "" e_wsle(); +#line 13901 "" s_stop("", (ftnlen)0); +#line 13902 "" } +#line 13903 "" ivf = 2; +#line 13904 "" } +#line 13905 "" nfig1 = comfig_1.nfigs[ivf - 1] + 1; +#line 13906 "" getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, & all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx - 1] << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], & @@ -20036,30 +32788,46 @@ L25: - 3], &comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10); /* * ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 13911 "" } else if (*(unsigned char *)charq == '[') { /* Start forced beam. Record barno & time since start of inp. blk. Set signal */ +#line 13915 "" ++comfb_1.nfb[commvl_1.ivx - 1]; +#line 13916 "" comget_1.fbon = TRUE_; +#line 13917 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ commvl_1.ivx - 1] * 24 - 25] = 'x'; +#line 13918 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 13919 "" nadj = 0; +#line 13920 "" if (comfb_1.autofbon) { +#line 13921 "" comfb_1.autofbon = FALSE_; +#line 13922 "" } +#line 13923 "" L17: +#line 13923 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13924 "" if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) { +#line 13925 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq; +#line 13926 "" goto L17; +#line 13927 "" } else if (*(unsigned char *)charq == 'j') { /* Continuing a jumped beam here */ +#line 13931 "" all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],24); @@ -20067,283 +32835,457 @@ L17: /* Set flag to watch for END of this forced beam, so can set flag rest(30) on */ /* NEXT note as signal to start a new notes group there. */ +#line 13936 "" combjmp_1.isbj2 = TRUE_; +#line 13937 "" goto L17; +#line 13938 "" } else if (*(unsigned char *)charq == 'h') { +#line 13939 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],2); +#line 13940 "" goto L17; +#line 13941 "" } else if (*(unsigned char *)charq == 'm') { /* Force multiplicity. Next input is digit */ +#line 13945 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13946 "" all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],21); +#line 13947 "" i__1 = *(unsigned char *)charq - 48; +#line 13947 "" setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &c__3, &c__22, &i__1); +#line 13948 "" goto L17; +#line 13949 "" } else if (*(unsigned char *)charq == ':') { /* Start auto forced beam pattern */ +#line 13953 "" comfb_1.autofbon = TRUE_; /* When forced later beam ends, check whether tautofv <=0; if so set it. */ +#line 13957 "" comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]); +#line 13958 "" comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 13959 "" goto L17; +#line 13960 "" } else if (*(unsigned char *)charq != ' ') { /* Must be '+/-' for height or slope shift */ +#line 13964 "" ++nadj; /* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */ +#line 13968 "" ++all_1.iccount; +#line 13969 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 13970 "" --all_1.iccount; +#line 13971 "" iadj = i_nint(&fnum); +#line 13972 "" if (*(unsigned char *)charq == '-') { +#line 13972 "" iadj = -iadj; +#line 13972 "" } +#line 13973 "" if (nadj == 1) { /* This is a level shift. Note if 0 was entered, iadj = 30 */ +#line 13977 "" i__1 = iadj + 30; +#line 13977 "" setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__11, &i__1); +#line 13978 "" } else if (nadj == 2) { /* Must be a slope shift */ +#line 13982 "" i__1 = iadj + 30; +#line 13982 "" setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__17, &i__1); +#line 13983 "" } else { /* Beam-thk fine tune */ +#line 13987 "" setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &c__2, &c__27, &iadj); +#line 13988 "" } +#line 13989 "" goto L17; +#line 13990 "" } +#line 13991 "" } else if (*(unsigned char *)charq == ']') { +#line 13992 "" if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) { +#line 13993 "" comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] + comfb_1.tautofb; +#line 13994 "" } +#line 13995 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13996 "" if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */ +#line 14000 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 14001 "" comget_1.fbon = FALSE_; +#line 14002 "" if (*(unsigned char *)charq == 'j') { +#line 14002 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],23); +#line 14002 "" } +#line 14004 "" if (combjmp_1.isbj2) { /* This is the end of a fb segment of a jump beam. Set flag on NEXT note to */ /* force start of new notes group, provided this is not last note in bar. */ +#line 14009 "" if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) { +#line 14009 "" all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],30) ; +#line 14009 "" } +#line 14011 "" combjmp_1.isbj2 = FALSE_; +#line 14012 "" } +#line 14013 "" } else if (*(unsigned char *)charq == '[') { /* Multiplicity down-up signal */ +#line 14017 "" all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],20); +#line 14018 "" } else if (*(unsigned char *)charq == '-') { /* Set signals for gap in single-slope beam [...]-[...] */ +#line 14022 "" all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],20); +#line 14023 "" all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 25],21); /* Next two characters must be "[ ". Skip over them. */ +#line 14027 "" all_1.iccount += 2; +#line 14028 "" } +#line 14029 "" } else if (*(unsigned char *)charq == 'D') { +#line 14030 "" getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], & all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1], lineq, &all_1.iccount, (ftnlen)128); +#line 14032 "" } else if (*(unsigned char *)charq == 'h') { /* Heading or height. For heading, only OK if at start of block */ /* Check whether at beginning of a block */ +#line 14037 "" if (all_1.iv != 1 || all_1.nnl[0] != 0) { - s_wsle(&io___774); +#line 14038 "" + s_wsle(&io___813); +#line 14038 "" do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block" , (ftnlen)41); +#line 14038 "" e_wsle(); +#line 14039 "" stop1_(); +#line 14040 "" } +#line 14041 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14042 "" comhead_1.ihdvrt = 0; +#line 14043 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Vertical offset */ +#line 14047 "" ++all_1.iccount; +#line 14048 "" readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 14049 "" comhead_1.ihdvrt = fnum + .1f; +#line 14050 "" if (*(unsigned char *)durq == '-') { +#line 14050 "" comhead_1.ihdvrt = -comhead_1.ihdvrt; +#line 14050 "" } +#line 14051 "" *(unsigned char *)durq = *(unsigned char *)charq; +#line 14052 "" } +#line 14053 "" if (*(unsigned char *)durq != ' ') { /* Height symbol. Read past (until next blank) */ +#line 14057 "" L3: +#line 14057 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14058 "" if (*(unsigned char *)durq != ' ') { +#line 14058 "" goto L3; +#line 14058 "" } +#line 14059 "" } else { /* Set flag for header & read it in */ +#line 14063 "" comhead_1.ihdht = 16; +#line 14064 "" getbuf_(comhead_1.headrq, (ftnlen)80); +#line 14065 "" all_1.iccount = 128; +#line 14066 "" } +#line 14067 "" } else if (*(unsigned char *)charq == 'L') { /* Linebreak, already handled in pmxa, but check for movement break */ +#line 14071 "" ++all_1.iccount; +#line 14072 "" readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen) 1); +#line 14073 "" if (*(unsigned char *)durq == 'P') { +#line 14074 "" ++all_1.iccount; +#line 14075 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 14076 "" } +#line 14077 "" if (*(unsigned char *)durq == 'M') { +#line 14078 "" comget_1.movbrk = i_nint(&fmovbrk); +#line 14079 "" comget_1.movgap = 0; +#line 14080 "" comget_1.parmov = -1.f; +#line 14081 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14082 "" L31: +#line 14082 "" if (*(unsigned char *)durq == '+') { /* Get vertical space (\internotes) */ +#line 14086 "" ++all_1.iccount; +#line 14087 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 14088 "" comget_1.movgap = i_nint(&fnum); +#line 14089 "" goto L31; +#line 14090 "" } else if (*(unsigned char *)durq == 'i') { +#line 14091 "" ++all_1.iccount; +#line 14092 "" readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, ( ftnlen)128, (ftnlen)1); +#line 14093 "" goto L31; +#line 14094 "" } else if (*(unsigned char *)durq == 'c') { +#line 14095 "" comnotes_1.nobar1 = TRUE_; +#line 14096 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14097 "" goto L31; +#line 14098 "" } else if (*(unsigned char *)durq == 'r') { /* "rename" can be set on or off. */ +#line 14102 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14103 "" comnvi_1.rename = *(unsigned char *)durq == '+'; +#line 14104 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14105 "" goto L31; +#line 14106 "" } else if (*(unsigned char *)durq == 'n') { /* Change # of voices. Input ninow, iiorig(1...ninow). Will use names, */ /* staves per inst. and clefs corr. to iiorig in original list of instruments. */ +#line 14111 "" nvold = all_1.nv; +#line 14112 "" all_1.nv = 0; +#line 14113 "" comnvi_1.rename = TRUE_; +#line 14114 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14115 "" if (*(unsigned char *)durq == ':') { +#line 14116 "" all_1.iccount += 2; +#line 14117 "" i__1 = all_1.iccount - 2; +#line 14117 "" ici__1.icierr = 0; +#line 14117 "" ici__1.iciend = 0; +#line 14117 "" ici__1.icirnum = 1; +#line 14117 "" ici__1.icirlen = all_1.iccount - i__1; +#line 14117 "" ici__1.iciunit = lineq + i__1; +#line 14117 "" ici__1.icifmt = "(i2)"; +#line 14117 "" s_rsfi(&ici__1); +#line 14117 "" do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof( integer)); +#line 14117 "" e_rsfi(); +#line 14118 "" } else { +#line 14119 "" comnotes_1.ninow = *(unsigned char *)durq - 48; +#line 14120 "" } +#line 14121 "" iiv = 0; +#line 14122 "" i__1 = comnotes_1.ninow; +#line 14122 "" for (iinow = 1; iinow <= i__1; ++iinow) { +#line 14123 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( ftnlen)1); +#line 14124 "" if (*(unsigned char *)durq == ':') { +#line 14125 "" all_1.iccount += 2; +#line 14126 "" i__2 = all_1.iccount - 2; +#line 14126 "" ici__1.icierr = 0; +#line 14126 "" ici__1.iciend = 0; +#line 14126 "" ici__1.icirnum = 1; +#line 14126 "" ici__1.icirlen = all_1.iccount - i__2; +#line 14126 "" ici__1.iciunit = lineq + i__2; +#line 14126 "" ici__1.icifmt = "(i2)"; +#line 14126 "" s_rsfi(&ici__1); +#line 14126 "" do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], ( ftnlen)sizeof(integer)); +#line 14126 "" e_rsfi(); +#line 14127 "" } else { +#line 14128 "" comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq - 48; +#line 14129 "" } +#line 14130 "" comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[ comnvi_1.iiorig[iinow - 1] - 1]; +#line 14131 "" all_1.nv += comnvi_1.nspern[iinow - 1]; +#line 14132 "" *(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[ iinow - 1] - 1] = '&'; +#line 14133 "" if (comnvi_1.nspern[iinow - 1] > 1) { +#line 14134 "" i__2 = comnvi_1.nspern[iinow - 1] - 1; +#line 14134 "" for (iis = 1; iis <= i__2; ++iis) { +#line 14135 "" *(unsigned char *)&all_1.sepsymq[iiv + iis - 1] = '|'; +#line 14136 "" /* L64: */ +#line 14136 "" } +#line 14137 "" } +#line 14138 "" iiv += comnvi_1.nspern[iinow - 1]; +#line 14139 "" /* L63: */ +#line 14139 "" } /* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */ @@ -20355,284 +33297,503 @@ L31: /* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */ /* end if */ /* end if */ +#line 14150 "" if (all_1.nv == 1 && nvold > 1) { +#line 14151 "" if (comlast_1.islast) { - s_wsfe(&io___779); +#line 14151 "" + s_wsfe(&io___818); /* Writing concatenation */ +#line 14151 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14151 "" i__5[1] = 11, a__2[1] = "nostartrule"; +#line 14151 "" s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 14151 "" do_fio(&c__1, ch__2, (ftnlen)12); +#line 14151 "" e_wsfe(); +#line 14151 "" } +#line 14152 "" } else if (all_1.nv > 1 && nvold == 1) { +#line 14153 "" if (comlast_1.islast) { - s_wsfe(&io___780); +#line 14153 "" + s_wsfe(&io___819); /* Writing concatenation */ +#line 14153 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14153 "" i__5[1] = 9, a__2[1] = "startrule"; +#line 14153 "" s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14153 "" do_fio(&c__1, ch__3, (ftnlen)10); +#line 14153 "" e_wsfe(); +#line 14153 "" } +#line 14154 "" } +#line 14155 "" iiv = 0; +#line 14156 "" i__1 = comnotes_1.ninow; +#line 14156 "" for (iinow = 1; iinow <= i__1; ++iinow) { +#line 14157 "" i__2 = comnvi_1.nspern[iinow - 1]; +#line 14157 "" for (iis = 1; iis <= i__2; ++iis) { +#line 14158 "" ++iiv; /* May not really need to re-enter clefs, but it's easier to program since */ /* clef names are not saved but are needed in newvoice to set ncmidcc. */ +#line 14163 "" getchar_(lineq, &all_1.iccount, comclefq_1.clefq + ( iiv - 1), (ftnlen)128, (ftnlen)1); +#line 14164 "" newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true, (ftnlen)1); +#line 14165 "" if (comnvi_1.nspern[iinow - 1] == 1) { +#line 14166 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( ftnlen)1) + 48; +#line 14166 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 14166 "" s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1); +#line 14167 "" lclf = 1; +#line 14168 "" } else if (iis == 1) { /* Writing concatenation */ +#line 14169 "" i__5[0] = 1, a__2[0] = "{"; +#line 14169 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( ftnlen)1) + 48; +#line 14169 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 14169 "" i__5[1] = 1, a__2[1] = ch__1; +#line 14169 "" s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); +#line 14170 "" lclf = 2; +#line 14171 "" } else if (iis < comnvi_1.nspern[iinow - 1]) { /* Writing concatenation */ +#line 14172 "" i__5[0] = lclf, a__2[0] = hdlndq; +#line 14172 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( ftnlen)1) + 48; +#line 14172 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 14172 "" i__5[1] = 1, a__2[1] = ch__1; +#line 14172 "" s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); +#line 14173 "" ++lclf; +#line 14174 "" } else { /* Writing concatenation */ +#line 14175 "" i__6[0] = lclf, a__3[0] = hdlndq; +#line 14175 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), ( ftnlen)1) + 48; +#line 14175 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 14175 "" i__6[1] = 1, a__3[1] = ch__1; +#line 14175 "" i__6[2] = 1, a__3[2] = "}"; +#line 14175 "" s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); +#line 14177 "" lclf += 2; +#line 14178 "" } +#line 14179 "" /* L61: */ +#line 14179 "" } /* setstaffs & setclef go by instrument, not voice */ +#line 14183 "" if (comlast_1.islast) { +#line 14184 "" if (iinow < 10) { - s_wsfe(&io___783); +#line 14185 "" + s_wsfe(&io___822); /* Writing concatenation */ +#line 14185 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 14185 "" i__3[1] = 9, a__1[1] = "setstaffs"; +#line 14185 "" i__2 = iinow + 48; +#line 14185 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14185 "" i__3[2] = 1, a__1[2] = ch__1; +#line 14185 "" i__4 = comnvi_1.nspern[iinow - 1] + 48; +#line 14185 "" chax_(ch__5, (ftnlen)1, &i__4); +#line 14185 "" i__3[3] = 1, a__1[3] = ch__5; +#line 14185 "" i__3[4] = 1, a__1[4] = "%"; +#line 14185 "" s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13); +#line 14185 "" do_fio(&c__1, ch__4, (ftnlen)13); +#line 14185 "" e_wsfe(); - s_wsfe(&io___784); +#line 14187 "" + s_wsfe(&io___823); /* Writing concatenation */ +#line 14187 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 14187 "" i__3[1] = 7, a__1[1] = "setclef"; +#line 14187 "" i__2 = iinow + 48; +#line 14187 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14187 "" i__3[2] = 1, a__1[2] = ch__1; +#line 14187 "" i__3[3] = lclf, a__1[3] = hdlndq; +#line 14187 "" i__3[4] = 1, a__1[4] = "%"; +#line 14187 "" s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69); +#line 14187 "" do_fio(&c__1, ch__6, lclf + 10); +#line 14187 "" e_wsfe(); +#line 14189 "" if (comfig_1.fullsize[comnvi_1.iiorig[iinow - 1] - 1] > .9f) { - s_wsfe(&io___785); +#line 14190 "" + s_wsfe(&io___824); /* Writing concatenation */ +#line 14190 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 14190 "" i__3[1] = 7, a__1[1] = "setsize"; +#line 14190 "" i__2 = iinow + 48; +#line 14190 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14190 "" i__3[2] = 1, a__1[2] = ch__1; +#line 14190 "" i__3[3] = 1, a__1[3] = all_1.sq; +#line 14190 "" i__3[4] = 12, a__1[4] = "normalvalue%"; +#line 14190 "" s_cat(ch__7, a__1, i__3, &c__5, (ftnlen)22); +#line 14190 "" do_fio(&c__1, ch__7, (ftnlen)22); +#line 14190 "" e_wsfe(); /* 140526 Account for staff size specs when noinst changes. May be confusion */ /* here if more than one staff per instrument */ +#line 14196 "" } else if (comfig_1.fullsize[comnvi_1.iiorig[ iinow - 1] - 1] > .7f) { - s_wsfe(&io___786); +#line 14197 "" + s_wsfe(&io___825); /* Writing concatenation */ +#line 14197 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 14197 "" i__3[1] = 7, a__1[1] = "setsize"; +#line 14197 "" i__2 = iinow + 48; +#line 14197 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14197 "" i__3[2] = 1, a__1[2] = ch__1; +#line 14197 "" i__3[3] = 1, a__1[3] = all_1.sq; +#line 14197 "" i__3[4] = 11, a__1[4] = "smallvalue%"; +#line 14197 "" s_cat(ch__8, a__1, i__3, &c__5, (ftnlen)21); +#line 14197 "" do_fio(&c__1, ch__8, (ftnlen)21); +#line 14197 "" e_wsfe(); +#line 14199 "" } else { - s_wsfe(&io___787); +#line 14200 "" + s_wsfe(&io___826); /* Writing concatenation */ +#line 14200 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 14200 "" i__3[1] = 7, a__1[1] = "setsize"; +#line 14200 "" i__2 = iinow + 48; +#line 14200 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14200 "" i__3[2] = 1, a__1[2] = ch__1; +#line 14200 "" i__3[3] = 1, a__1[3] = all_1.sq; +#line 14200 "" i__3[4] = 10, a__1[4] = "tinyvalue%"; +#line 14200 "" s_cat(ch__9, a__1, i__3, &c__5, (ftnlen)20); +#line 14200 "" do_fio(&c__1, ch__9, (ftnlen)20); +#line 14200 "" e_wsfe(); +#line 14202 "" } +#line 14203 "" } else { - s_wsfe(&io___788); +#line 14204 "" + s_wsfe(&io___827); /* Writing concatenation */ +#line 14204 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14204 "" i__5[1] = 10, a__2[1] = "setstaffs{"; +#line 14204 "" s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 14204 "" do_fio(&c__1, ch__10, (ftnlen)11); +#line 14204 "" do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 14204 "" i__6[0] = 1, a__3[0] = "}"; +#line 14204 "" i__2 = comnvi_1.nspern[iinow - 1] + 48; +#line 14204 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 14204 "" i__6[1] = 1, a__3[1] = ch__1; +#line 14204 "" i__6[2] = 1, a__3[2] = "%"; +#line 14204 "" s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3); +#line 14204 "" do_fio(&c__1, ch__11, (ftnlen)3); +#line 14204 "" e_wsfe(); - s_wsfe(&io___789); +#line 14206 "" + s_wsfe(&io___828); /* Writing concatenation */ +#line 14206 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14206 "" i__5[1] = 8, a__2[1] = "setclef{"; +#line 14206 "" s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14206 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 14206 "" do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 14206 "" i__6[0] = 1, a__3[0] = "}"; +#line 14206 "" i__6[1] = lclf, a__3[1] = hdlndq; +#line 14206 "" i__6[2] = 1, a__3[2] = "%"; +#line 14206 "" s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61); +#line 14206 "" do_fio(&c__1, ch__13, lclf + 2); +#line 14206 "" e_wsfe(); +#line 14208 "" } +#line 14209 "" } +#line 14210 "" /* L60: */ +#line 14210 "" } /* Loop back up, this may not be last option in M. Note flow out if durq=' ' */ +#line 14214 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14215 "" goto L31; +#line 14216 "" } /* Write instrument names */ +#line 14220 "" if (! comnvi_1.rename) { +#line 14221 "" i__1 = comnotes_1.ninow; +#line 14221 "" for (iinst = 1; iinst <= i__1; ++iinst) { +#line 14222 "" if (comlast_1.islast) { +#line 14223 "" if (iinst < 10) { - s_wsfe(&io___791); +#line 14224 "" + s_wsfe(&io___830); /* Writing concatenation */ +#line 14224 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14224 "" i__5[1] = 7, a__2[1] = "setname"; +#line 14224 "" s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 14224 "" do_fio(&c__1, ch__14, (ftnlen)8); +#line 14224 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); +#line 14224 "" do_fio(&c__1, "{}%", (ftnlen)3); +#line 14224 "" e_wsfe(); +#line 14225 "" } else { - s_wsfe(&io___792); +#line 14226 "" + s_wsfe(&io___831); /* Writing concatenation */ +#line 14226 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14226 "" i__5[1] = 8, a__2[1] = "setname{"; +#line 14226 "" s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14226 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 14226 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); +#line 14226 "" do_fio(&c__1, "}{}%", (ftnlen)4); +#line 14226 "" e_wsfe(); +#line 14227 "" } +#line 14228 "" } +#line 14229 "" /* L62: */ +#line 14229 "" } +#line 14230 "" } else { +#line 14231 "" i__1 = comnotes_1.ninow; +#line 14231 "" for (iinst = 1; iinst <= i__1; ++iinst) { +#line 14232 "" if (comlast_1.islast) { +#line 14233 "" if (iinst < 10) { - s_wsfe(&io___793); +#line 14234 "" + s_wsfe(&io___832); /* Writing concatenation */ +#line 14234 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14234 "" i__5[1] = 7, a__2[1] = "setname"; +#line 14234 "" s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 14234 "" do_fio(&c__1, ch__14, (ftnlen)8); +#line 14234 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 14234 "" i__6[0] = 1, a__3[0] = "{"; +#line 14234 "" i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - 1], a__3[1] = comtop_1.inameq + ( comnvi_1.iiorig[iinst - 1] - 1) * 79; +#line 14234 "" i__6[2] = 2, a__3[2] = "}%"; +#line 14234 "" s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82); +#line 14234 "" do_fio(&c__1, ch__15, comtop_1.lnam[ comnvi_1.iiorig[iinst - 1] - 1] + 3); +#line 14234 "" e_wsfe(); +#line 14236 "" } else { - s_wsfe(&io___794); +#line 14237 "" + s_wsfe(&io___833); /* Writing concatenation */ +#line 14237 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14237 "" i__5[1] = 8, a__2[1] = "setname{"; +#line 14237 "" s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14237 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 14237 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 14237 "" i__6[0] = 2, a__3[0] = "}{"; +#line 14237 "" i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - 1], a__3[1] = comtop_1.inameq + ( comnvi_1.iiorig[iinst - 1] - 1) * 79; +#line 14237 "" i__6[2] = 2, a__3[2] = "}%"; +#line 14237 "" s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83); +#line 14237 "" do_fio(&c__1, ch__16, comtop_1.lnam[ comnvi_1.iiorig[iinst - 1] - 1] + 4); +#line 14237 "" e_wsfe(); +#line 14239 "" } +#line 14240 "" } +#line 14241 "" /* L65: */ +#line 14241 "" } +#line 14242 "" comnvi_1.rename = FALSE_; +#line 14243 "" } +#line 14244 "" } +#line 14245 "" } else if (*(unsigned char *)charq == '|') { /* End of bar symbol. Check about end of bar hardspace. */ +#line 14249 "" if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26)) { @@ -20640,44 +33801,67 @@ L31: /* list, store with shifts instead, set special bit. Need to repeat this code */ /* at '/'. */ +#line 14255 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); +#line 14256 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 14257 "" comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; +#line 14258 "" --comudsp_1.nudsp; +#line 14259 "" all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 1],26); +#line 14260 "" } +#line 14261 "" } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Width symbol or new nsyst. Read past (until blank) */ +#line 14265 "" L4: +#line 14265 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14266 "" if (*(unsigned char *)durq != ' ') { +#line 14266 "" goto L4; +#line 14266 "" } +#line 14267 "" } else if (*(unsigned char *)charq == 'l') { /* Lower string. Only OK if at start of block */ /* Check whether at beginning of a block */ +#line 14272 "" if (all_1.iv != 1 || all_1.nnl[0] != 0) { - s_wsle(&io___795); +#line 14273 "" + s_wsle(&io___834); +#line 14273 "" do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block" , (ftnlen)41); +#line 14273 "" e_wsle(); +#line 14274 "" stop1_(); +#line 14275 "" } /* Set flag for lower string & read it in */ +#line 14279 "" comhead_1.lower = TRUE_; +#line 14280 "" getbuf_(comhead_1.lowerq, (ftnlen)80); +#line 14281 "" all_1.iccount = 128; +#line 14282 "" } else if (*(unsigned char *)charq == 'm') { /* Meter change. Only allow at beginning of block. */ @@ -20686,342 +33870,595 @@ L4: /* Check whether at beginning of a block */ +#line 14290 "" if (all_1.iv != 1 || all_1.nnl[0] != 0) { - s_wsle(&io___796); +#line 14291 "" + s_wsle(&io___835); +#line 14291 "" do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block" , (ftnlen)41); +#line 14291 "" e_wsle(); +#line 14292 "" stop1_(); +#line 14293 "" } +#line 14294 "" readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, ( ftnlen)128); +#line 14295 "" readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, ( ftnlen)128); +#line 14296 "" lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); +#line 14297 "" if (all_1.mtrdenl == 2) { +#line 14297 "" lenbeat = 16; +#line 14297 "" } +#line 14298 "" all_1.lenbar = all_1.mtrnuml * lenbeat; +#line 14299 "" if (all_1.mtrdenl == 2) { +#line 14299 "" all_1.lenbar <<= 1; +#line 14299 "" } +#line 14300 "" all_1.lenb1 = all_1.lenbar; +#line 14301 "" all_1.lenb0 = 0; +#line 14302 "" if (commidi_1.ismidi) { +#line 14302 "" midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); +#line 14302 "" } +#line 14303 "" } else if (*(unsigned char *)charq == 'C') { /* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ +#line 14307 "" if (all_1.nnl[all_1.iv - 1] > 0) { +#line 14307 "" ++comcc_1.ncc[all_1.iv - 1]; +#line 14307 "" } +#line 14308 "" comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real) all_1.itsofar[all_1.iv - 1]; +#line 14309 "" isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25],11); +#line 14310 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* Store clef number, or 7 if clef number = 9 (French violin clef) */ /* Computing MIN */ +#line 14314 "" i__1 = numclef_(durq, (ftnlen)1); +#line 14314 "" isl |= min(i__1,7) << 12; +#line 14315 "" comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = ncmidf_(durq, (ftnlen)1); +#line 14316 "" if (*(unsigned char *)durq == '8') { +#line 14317 "" all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = bit_set(all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25],2); +#line 14318 "" cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1] - = 7; + += 7; +#line 14319 "" + comnotes_1.lastlev += 7; +#line 14320 "" } else { + +/* This won't work if you really had an octave transposition with some */ +/* other clef. Need a check on whether prior clef was an octave clef. */ + +#line 14325 "" if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1] == 7) { +#line 14326 "" cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - - 1] = 0; + - 1] += -7; +#line 14327 "" + comnotes_1.lastlev += -7; +#line 14328 "" + s_wsle(&io___837); +#line 14328 "" + do_lio(&c__9, &c__1, "Reset itransamt to ", (ftnlen)19); +#line 14328 "" + do_lio(&c__3, &c__1, (char *)&cominsttrans_1.itransamt[ + cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen) + sizeof(integer)); +#line 14328 "" + e_wsle(); +#line 14329 "" } +#line 14330 "" } /* Set marker on note with lowest voice # starting at same time. */ +#line 14334 "" if (all_1.iv == 1) { +#line 14335 "" isl = bit_set(isl,15); +#line 14336 "" } else { +#line 14337 "" i__1 = all_1.iv; +#line 14337 "" for (iiv = 1; iiv <= i__1; ++iiv) { +#line 14338 "" nnliiv = all_1.nnl[iiv - 1]; +#line 14339 "" if (iiv == all_1.iv) { +#line 14339 "" ++nnliiv; +#line 14339 "" } +#line 14340 "" itother = 0; +#line 14341 "" i__2 = nnliiv; +#line 14341 "" for (iip = 1; iip <= i__2; ++iip) { +#line 14342 "" if (itother < all_1.itsofar[all_1.iv - 1]) { +#line 14343 "" itother += all_1.nodur[iiv + iip * 24 - 25]; +#line 14344 "" goto L14; +#line 14345 "" } else if (itother == all_1.itsofar[all_1.iv - 1]) { +#line 14346 "" all_1.islur[iiv + iip * 24 - 25] = bit_set( all_1.islur[iiv + iip * 24 - 25],15); +#line 14347 "" goto L15; +#line 14348 "" } +#line 14349 "" L14: +#line 14349 "" ; +#line 14349 "" } +#line 14350 "" /* L13: */ +#line 14350 "" } +#line 14351 "" L15: +#line 14352 "" ; +#line 14352 "" } /* Need 'or' since may have set bit 15 in the above loop */ +#line 14356 "" all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = isl | all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25]; +#line 14357 "" } else if (*(unsigned char *)charq == 'R') { /* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */ +#line 14361 "" L10: +#line 14361 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* Save designator in case it's a terminal Rr or Rd */ +#line 14365 "" if (*(unsigned char *)durq == 'l') { +#line 14366 "" all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[( all_1.nnl[0] + 1) * 24 - 24],5); +#line 14367 "" goto L10; +#line 14368 "" } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) { +#line 14369 "" if (*(unsigned char *)durq == 'r') { +#line 14370 "" all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6); +#line 14371 "" } else if (*(unsigned char *)durq == 'd') { +#line 14372 "" all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8); +#line 14373 "" } else if (*(unsigned char *)durq == 'D') { +#line 14374 "" all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26); +#line 14375 "" } else if (*(unsigned char *)durq == 'b') { +#line 14376 "" all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25); +#line 14377 "" } else if (*(unsigned char *)durq == 'z') { /* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */ +#line 14379 "" all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.ipl[( all_1.nnl[0] + 1) * 24 - 24],0); +#line 14380 "" } +#line 14381 "" comget_1.rptprev = TRUE_; +#line 14382 "" *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq; +#line 14383 "" goto L10; +#line 14384 "" } +#line 14385 "" } else if (*(unsigned char *)charq == 'V') { /* Ending */ +#line 14389 "" nnnl = all_1.nnl[0] + 1; +#line 14390 "" lvoltxt = 0; +#line 14391 "" L11: +#line 14391 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14392 "" if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') { /* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */ +#line 14396 "" all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24], 9); +#line 14397 "" if (*(unsigned char *)durq == 'b') { +#line 14397 "" all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24],10); +#line 14397 "" } +#line 14398 "" goto L11; +#line 14399 "" } else if (*(unsigned char *)durq != ' ') { /* Start volta; Get text */ +#line 14403 "" if (lvoltxt == 0) { /* First character for text */ +#line 14407 "" lvoltxt = 1; +#line 14408 "" all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24],7); +#line 14409 "" ++comgrace_1.nvolt; +#line 14410 "" s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq, (ftnlen)20, (ftnlen)1); +#line 14411 "" } else { /* Writing concatenation */ +#line 14412 "" i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; +#line 14412 "" i__5[1] = 1, a__2[1] = durq; +#line 14412 "" s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__2, i__5, &c__2, (ftnlen)20); +#line 14413 "" ++lvoltxt; +#line 14414 "" } +#line 14415 "" goto L11; +#line 14416 "" } +#line 14417 "" } else if (*(unsigned char *)charq == 'B') { +#line 14418 "" combc_1.bcspec = ! combc_1.bcspec; +#line 14419 "" } else if (*(unsigned char *)charq == 'P') { /* Page numbers. Print stuff right now. */ +#line 14423 "" npg1 = 0; /* Will use ltopnam to signal whether there's a centered heading */ +#line 14427 "" ltopnam = 0; +#line 14428 "" ipg1r = 0; +#line 14429 "" L16: +#line 14429 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14430 "" if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) { +#line 14431 "" npg1 = npg1 * 10 + *(unsigned char *)durq - 48; +#line 14432 "" goto L16; +#line 14433 "" } else if (*(unsigned char *)durq == 'l') { +#line 14434 "" if (npg1 == 0 || npg1 % 2 == 1) { +#line 14434 "" ipg1r = 1; +#line 14434 "" } +#line 14435 "" goto L16; +#line 14436 "" } else if (*(unsigned char *)durq == 'r') { +#line 14437 "" if (npg1 > 0 && npg1 % 2 == 0) { +#line 14437 "" ipg1r = 1; +#line 14437 "" } +#line 14438 "" goto L16; +#line 14439 "" } else if (*(unsigned char *)durq == 'c') { /* Top-centered name. Assume this is last option. Read the name. */ /* May surround name in double quotes (to allow blanks). */ +#line 14444 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14445 "" if (*(unsigned char *)durq == ' ') { +#line 14446 "" ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60); +#line 14447 "" } else { +#line 14448 "" namstrt = all_1.iccount; +#line 14449 "" if (*(unsigned char *)durq == '"') { /* Using quote delimiters. */ +#line 14453 "" quoted = TRUE_; +#line 14454 "" ++namstrt; +#line 14455 "" } else { +#line 14456 "" quoted = FALSE_; +#line 14457 "" } +#line 14458 "" for (all_1.iccount = namstrt + 1; all_1.iccount <= 128; ++all_1.iccount) { /* if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or. */ +#line 14460 "" i__1 = all_1.iccount - 2; +#line 14460 "" if (quoted && *(unsigned char *)&lineq[all_1.iccount - 1] == '"' && s_cmp(lineq + i__1, "\\", all_1.iccount - 1 - i__1, (ftnlen)1) != 0 || ! quoted && *( unsigned char *)&lineq[all_1.iccount - 1] == ' ') { +#line 14460 "" goto L36; +#line 14460 "" } /* On exit, iccount is OK, and name is in (namstrt:iccount-1) */ +#line 14467 "" /* L35: */ +#line 14467 "" } - s_wsle(&io___805); +#line 14468 "" + s_wsle(&io___845); +#line 14468 "" do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", ( ftnlen)31); +#line 14468 "" e_wsle(); +#line 14469 "" stop1_(); +#line 14470 "" L36: +#line 14471 "" ltopnam = all_1.iccount - namstrt; +#line 14472 "" s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60, all_1.iccount - 1 - (namstrt - 1)); +#line 14473 "" } +#line 14474 "" } /* Done getting data, now assemble the command */ +#line 14478 "" if (npg1 == 0) { +#line 14478 "" npg1 = 1; +#line 14478 "" } /* 2/23/03 Don't use \atnextline if on first page and only one system */ /* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ /* Writing concatenation */ +#line 14483 "" i__7[0] = 1, a__4[0] = all_1.sq; +#line 14483 "" i__7[1] = 3, a__4[1] = "def"; +#line 14483 "" i__7[2] = 1, a__4[2] = all_1.sq; +#line 14483 "" i__7[3] = 11, a__4[3] = "atnextline{"; +#line 14483 "" i__7[4] = 1, a__4[4] = all_1.sq; +#line 14483 "" i__7[5] = 10, a__4[5] = "toppageno{"; +#line 14483 "" s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59); +#line 14484 "" lhead = 27; /* else */ /* hdlndq = sq//'toppageno{' */ /* lhead = 11 */ /* end if */ +#line 14489 "" if (npg1 < 10) { /* Note we are overwriting the last "{" */ +#line 14493 "" ici__1.icierr = 0; +#line 14493 "" ici__1.icirnum = 1; +#line 14493 "" ici__1.icirlen = 1; +#line 14493 "" ici__1.iciunit = hdlndq + (lhead - 1); +#line 14493 "" ici__1.icifmt = "(i1)"; +#line 14493 "" s_wsfi(&ici__1); +#line 14493 "" do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14493 "" e_wsfi(); +#line 14494 "" } else if (npg1 < 100) { +#line 14495 "" lhead += 3; +#line 14496 "" i__1 = lhead - 3; +#line 14496 "" ici__1.icierr = 0; +#line 14496 "" ici__1.icirnum = 1; +#line 14496 "" ici__1.icirlen = lhead - i__1; +#line 14496 "" ici__1.iciunit = hdlndq + i__1; +#line 14496 "" ici__1.icifmt = "(i2,a1)"; +#line 14496 "" s_wsfi(&ici__1); +#line 14496 "" do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14496 "" do_fio(&c__1, "}", (ftnlen)1); +#line 14496 "" e_wsfi(); +#line 14497 "" } else { +#line 14498 "" lhead += 4; +#line 14499 "" i__1 = lhead - 4; +#line 14499 "" ici__1.icierr = 0; +#line 14499 "" ici__1.icirnum = 1; +#line 14499 "" ici__1.icirlen = lhead - i__1; +#line 14499 "" ici__1.iciunit = hdlndq + i__1; +#line 14499 "" ici__1.icifmt = "(i3,a1)"; +#line 14499 "" s_wsfi(&ici__1); +#line 14499 "" do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 14499 "" do_fio(&c__1, "}", (ftnlen)1); +#line 14499 "" e_wsfi(); +#line 14500 "" } /* Writing concatenation */ +#line 14501 "" i__6[0] = lhead, a__3[0] = hdlndq; +#line 14501 "" i__1 = ipg1r + 48; +#line 14501 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 14501 "" i__6[1] = 1, a__3[1] = ch__1; +#line 14501 "" i__6[2] = 1, a__3[2] = "{"; +#line 14501 "" s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); +#line 14502 "" lhead += 2; /* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ +#line 14504 "" if (ltopnam == 0) { +#line 14505 "" if (comlast_1.islast) { - s_wsfe(&io___807); +#line 14505 "" + s_wsfe(&io___847); /* Writing concatenation */ +#line 14505 "" i__5[0] = lhead, a__2[0] = hdlndq; +#line 14505 "" i__5[1] = 3, a__2[1] = "}}%"; +#line 14505 "" s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62); +#line 14505 "" do_fio(&c__1, ch__17, lhead + 3); +#line 14505 "" e_wsfe(); +#line 14505 "" } +#line 14506 "" } else { +#line 14507 "" if (comlast_1.islast) { - s_wsfe(&io___808); +#line 14507 "" + s_wsfe(&io___848); /* Writing concatenation */ +#line 14507 "" i__6[0] = lhead, a__3[0] = hdlndq; +#line 14507 "" i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq; +#line 14507 "" i__6[2] = 3, a__3[2] = "}}%"; +#line 14507 "" s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122); +#line 14507 "" do_fio(&c__1, ch__18, lhead + ltopnam + 3); +#line 14507 "" e_wsfe(); +#line 14507 "" } +#line 14509 "" } /* else */ /* if (ltopnam .eq. 0) then */ @@ -21031,491 +34468,861 @@ L36: /* * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */ /* end if */ /* end if */ +#line 14518 "" } else if (*(unsigned char *)charq == 'W') { /* Just eat the number that must follow, it was used in pmxa */ +#line 14522 "" ++all_1.iccount; +#line 14523 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14524 "" } else if (*(unsigned char *)charq == 'T') { +#line 14525 "" comtitl_1.headlog = TRUE_; +#line 14526 "" comtitl_1.inhead = 0; +#line 14527 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14528 "" if (*(unsigned char *)durq == 'i') { +#line 14529 "" getbuf_(comtitl_1.instrq, (ftnlen)120); /* A kluge for parts from separate score file for later movements. */ +#line 14533 "" if (*(unsigned char *)comtitl_1.instrq == ' ') { +#line 14533 "" comtitl_1.headlog = FALSE_; +#line 14533 "" } +#line 14534 "" s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen) 60); +#line 14535 "" } else if (*(unsigned char *)durq == 't') { +#line 14536 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* Optionally can include extra vertical \internotes above inbothd */ +#line 14540 "" if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 14541 "" ipm = 1; +#line 14542 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Don't trust readnum to round this negative integer properly */ +#line 14546 "" ++all_1.iccount; +#line 14547 "" if (*(unsigned char *)durq == '-') { +#line 14547 "" ipm = -1; +#line 14547 "" } +#line 14548 "" } +#line 14549 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 14550 "" comtitl_1.inhead = ipm * i_nint(&fnum); +#line 14551 "" } +#line 14552 "" getbuf_(comtitl_1.titleq, (ftnlen)120); +#line 14553 "" } else { +#line 14554 "" getbuf_(comtitl_1.compoq, (ftnlen)120); +#line 14555 "" } +#line 14556 "" comtitl_1.inhead += cominbot_1.inbothd; +#line 14557 "" all_1.iccount = 128; +#line 14558 "" } else if (*(unsigned char *)charq == 'A') { /* Accidental handling etc. */ +#line 14562 "" L27: +#line 14562 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14563 "" if (*(unsigned char *)durq == 'r') { +#line 14564 "" if (comlast_1.islast) { +#line 14565 "" commidi_1.relacc = TRUE_; - s_wsfe(&io___809); +#line 14566 "" + s_wsfe(&io___849); /* Writing concatenation */ +#line 14566 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14566 "" i__5[1] = 14, a__2[1] = "relativeaccid%"; +#line 14566 "" s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15); +#line 14566 "" do_fio(&c__1, ch__19, (ftnlen)15); +#line 14566 "" e_wsfe(); +#line 14567 "" } +#line 14568 "" } else if (*(unsigned char *)durq == 's') { +#line 14569 "" spfacs_1.bacfac = 1e6f; +#line 14570 "" } else if (*(unsigned char *)durq == 'b') { +#line 14571 "" if (comlast_1.islast) { - s_wsfe(&io___810); +#line 14571 "" + s_wsfe(&io___850); /* Writing concatenation */ +#line 14571 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14571 "" i__5[1] = 9, a__2[1] = "bigaccid%"; +#line 14571 "" s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14571 "" do_fio(&c__1, ch__3, (ftnlen)10); +#line 14571 "" e_wsfe(); +#line 14571 "" } +#line 14572 "" spfacs_1.accfac = spfacs_1.bacfac; +#line 14573 "" } else if (*(unsigned char *)durq == 'a') { +#line 14574 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14575 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 14576 "" --all_1.iccount; +#line 14577 "" } else if (*(unsigned char *)durq == 'i') { +#line 14578 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14579 "" readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, ( ftnlen)1); +#line 14580 "" if (! all_1.firstgulp) { +#line 14580 "" comget_1.fintstf = tintstf; +#line 14580 "" } /* Local corrections for first page were handled by pmxa */ +#line 14584 "" --all_1.iccount; +#line 14585 "" } else if (*(unsigned char *)durq == 'I') { +#line 14586 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14587 "" readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen) 128, (ftnlen)1); +#line 14588 "" --all_1.iccount; +#line 14589 "" } else if (*(unsigned char *)durq == 'd') { +#line 14590 "" comarp_1.lowdot = TRUE_; +#line 14591 "" } else if (*(unsigned char *)durq == 'o') { +#line 14593 "" } else if (*(unsigned char *)durq == 'S') { /* 130324 */ /* do 50 iiv = 1 , nv */ +#line 14596 "" i__1 = comkeys_2.noinst; +#line 14596 "" for (iiv = 1; iiv <= i__1; ++iiv) { +#line 14597 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14598 "" if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 14599 "" comfig_1.fullsize[iiv - 1] = .8f; +#line 14600 "" } else if (*(unsigned char *)durq == 't') { +#line 14601 "" comfig_1.fullsize[iiv - 1] = .64f; +#line 14602 "" } else { /* fullsize(ivx) = 1.0 */ +#line 14604 "" comfig_1.fullsize[iiv - 1] = 1.f; +#line 14605 "" } +#line 14606 "" /* L50: */ +#line 14606 "" } +#line 14607 "" } else if (*(unsigned char *)durq == 'e') { /* Line-spacing equalization */ +#line 14611 "" comget_1.equalize = TRUE_; /* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */ /* But it causes problems with some older scores and when excerpts are combined */ /* with LaTeX. So as of 2.352 we write it here. */ - s_wsfe(&io___812); +#line 14617 "" + s_wsfe(&io___852); /* Writing concatenation */ +#line 14617 "" i__8[0] = 1, a__5[0] = all_1.sq; +#line 14617 "" i__8[1] = 6, a__5[1] = "global"; +#line 14617 "" i__8[2] = 1, a__5[2] = all_1.sq; +#line 14617 "" i__8[3] = 19, a__5[3] = "parskip 0pt plus 12"; +#line 14617 "" i__8[4] = 1, a__5[4] = all_1.sq; +#line 14617 "" i__8[5] = 19, a__5[5] = "Interligne minus 99"; +#line 14617 "" i__8[6] = 1, a__5[6] = all_1.sq; +#line 14617 "" i__8[7] = 11, a__5[7] = "Interligne%"; +#line 14617 "" s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59); +#line 14617 "" do_fio(&c__1, ch__20, (ftnlen)59); +#line 14617 "" e_wsfe(); +#line 14619 "" s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1); +#line 14620 "" lentemp = 1; +#line 14621 "" i__1 = all_1.nv - 1; +#line 14621 "" for (iiv = 2; iiv <= i__1; ++iiv) { /* Writing concatenation */ +#line 14622 "" i__5[0] = lentemp, a__2[0] = tempq; +#line 14622 "" i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1); +#line 14622 "" s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24); +#line 14623 "" ++lentemp; +#line 14624 "" /* L51: */ +#line 14624 "" } - s_wsfe(&io___815); +#line 14625 "" + s_wsfe(&io___855); /* Writing concatenation */ +#line 14625 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 14625 "" i__9[1] = 3, a__6[1] = "def"; +#line 14625 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 14625 "" i__9[3] = 8, a__6[3] = "upstrut{"; +#line 14625 "" i__9[4] = 1, a__6[4] = all_1.sq; +#line 14625 "" i__9[5] = 6, a__6[5] = "znotes"; +#line 14625 "" i__9[6] = lentemp, a__6[6] = tempq; +#line 14625 "" i__9[7] = 1, a__6[7] = all_1.sq; +#line 14625 "" i__9[8] = 10, a__6[8] = "zcharnote{"; +#line 14625 "" i__9[9] = 1, a__6[9] = all_1.sq; +#line 14625 "" i__9[10] = 9, a__6[10] = "upamt}{~}"; +#line 14625 "" i__9[11] = 1, a__6[11] = all_1.sq; +#line 14625 "" i__9[12] = 4, a__6[12] = "en}%"; +#line 14625 "" s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70); +#line 14625 "" do_fio(&c__1, ch__21, lentemp + 46); +#line 14625 "" e_wsfe(); +#line 14628 "" } else if (*(unsigned char *)durq == 'v') { /* Toggle usevshrink */ +#line 14632 "" comlast_1.usevshrink = ! comlast_1.usevshrink; +#line 14633 "" } else if (*(unsigned char *)durq == 'p') { /* Postscript slurs. fontslur is already false (set in g1etnote) */ +#line 14637 "" if (! comslur_1.wrotepsslurdefaults) { /* Set postscrirpt slur adjustment defaults */ - s_wsfe(&io___816); +#line 14641 "" + s_wsfe(&io___856); /* Writing concatenation */ +#line 14641 "" i__7[0] = 1, a__4[0] = all_1.sq; +#line 14641 "" i__7[1] = 12, a__4[1] = "Nosluradjust"; +#line 14641 "" i__7[2] = 1, a__4[2] = all_1.sq; +#line 14641 "" i__7[3] = 11, a__4[3] = "Notieadjust"; +#line 14641 "" i__7[4] = 1, a__4[4] = all_1.sq; +#line 14641 "" i__7[5] = 10, a__4[5] = "nohalfties"; +#line 14641 "" s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36); +#line 14641 "" do_fio(&c__1, ch__22, (ftnlen)36); +#line 14641 "" e_wsfe(); +#line 14643 "" comslur_1.wrotepsslurdefaults = TRUE_; +#line 14644 "" } +#line 14645 "" L52: +#line 14646 "" g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* might be "+", "-", "h" or */ +#line 14647 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Characters to change defaults for ps slurs */ +#line 14651 "" g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen) 1); /* charq will be "s,t,h,c */ +#line 14652 "" if (*(unsigned char *)durq == '+') { +#line 14653 "" if (*(unsigned char *)charq == 's') { - s_wsfe(&io___817); +#line 14654 "" + s_wsfe(&io___857); /* Writing concatenation */ +#line 14654 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14654 "" i__5[1] = 10, a__2[1] = "Sluradjust"; +#line 14654 "" s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 14654 "" do_fio(&c__1, ch__10, (ftnlen)11); +#line 14654 "" e_wsfe(); +#line 14655 "" } else if (*(unsigned char *)charq == 't') { - s_wsfe(&io___818); +#line 14656 "" + s_wsfe(&io___858); /* Writing concatenation */ +#line 14656 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14656 "" i__5[1] = 9, a__2[1] = "Tieadjust"; +#line 14656 "" s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 14656 "" do_fio(&c__1, ch__3, (ftnlen)10); +#line 14656 "" e_wsfe(); +#line 14657 "" } else if (*(unsigned char *)charq == 'h') { - s_wsfe(&io___819); +#line 14658 "" + s_wsfe(&io___859); /* Writing concatenation */ +#line 14658 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14658 "" i__5[1] = 8, a__2[1] = "halfties"; +#line 14658 "" s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 14658 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 14658 "" e_wsfe(); +#line 14659 "" } else { +#line 14660 "" comslur_1.slurcurve += 1; +#line 14661 "" if (comslur_1.slurcurve > 3.1f) { +#line 14662 "" printl_("WARNING!", (ftnlen)8); - printl_("Default slur curvature advanced past HH" +#line 14663 "" + printl_("Default slur curvature advanced past HH"\ ", resetting", (ftnlen)50); +#line 14665 "" comslur_1.slurcurve = 3.f; +#line 14666 "" } +#line 14667 "" } +#line 14668 "" } else { +#line 14669 "" if (*(unsigned char *)charq == 's') { - s_wsfe(&io___820); +#line 14670 "" + s_wsfe(&io___860); /* Writing concatenation */ +#line 14670 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14670 "" i__5[1] = 12, a__2[1] = "Nosluradjust"; +#line 14670 "" s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13); +#line 14670 "" do_fio(&c__1, ch__4, (ftnlen)13); +#line 14670 "" e_wsfe(); +#line 14671 "" } else if (*(unsigned char *)charq == 't') { - s_wsfe(&io___821); +#line 14672 "" + s_wsfe(&io___861); /* Writing concatenation */ +#line 14672 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14672 "" i__5[1] = 11, a__2[1] = "Notieadjust"; +#line 14672 "" s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 14672 "" do_fio(&c__1, ch__2, (ftnlen)12); +#line 14672 "" e_wsfe(); +#line 14673 "" } else if (*(unsigned char *)charq == 'h') { - s_wsfe(&io___822); +#line 14674 "" + s_wsfe(&io___862); /* Writing concatenation */ +#line 14674 "" i__5[0] = 1, a__2[0] = all_1.sq; +#line 14674 "" i__5[1] = 10, a__2[1] = "nohalfties"; +#line 14674 "" s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 14674 "" do_fio(&c__1, ch__10, (ftnlen)11); +#line 14674 "" e_wsfe(); +#line 14675 "" } else { +#line 14676 "" comslur_1.slurcurve += -1; +#line 14677 "" if (comslur_1.slurcurve < -1.1f) { +#line 14678 "" printl_("WARNING!", (ftnlen)8); - printl_("Default slur curvature decremented belo" +#line 14679 "" + printl_("Default slur curvature decremented belo"\ "w f, resetting", (ftnlen)53); +#line 14681 "" comslur_1.slurcurve = -1.f; +#line 14682 "" } +#line 14683 "" } +#line 14684 "" } +#line 14685 "" goto L52; /* Check for another set of default changes */ +#line 14686 "" } else if (*(unsigned char *)durq == 'l') { /* Set optional linebreak ties */ +#line 14690 "" comnotes_1.optlinebreakties = TRUE_; +#line 14691 "" goto L52; +#line 14692 "" } else if (*(unsigned char *)durq == 'h') { /* Set flag to write header special on every page */ +#line 14696 "" comnotes_1.headerspecial = TRUE_; +#line 14697 "" goto L52; +#line 14698 "" } else { +#line 14699 "" --all_1.iccount; +#line 14700 "" } +#line 14701 "" } else if (*(unsigned char *)durq == 'K') { /* Toggle keyboard rest placement flag */ +#line 14705 "" comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests; +#line 14706 "" } else if (*(unsigned char *)durq == 'c') { +#line 14707 "" g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* Just eat the input; it was used in pmxa */ +#line 14711 "" + goto L27; +#line 14712 "" + } else if (*(unsigned char *)durq == 'V') { +#line 14713 "" + combottop_1.bottopgap = TRUE_; +#line 14714 "" + combottop_1.topamt = 0.f; +#line 14715 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14716 "" + pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2); +#line 14717 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14718 "" + readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, ( + ftnlen)128, (ftnlen)1); +#line 14719 "" + combottop_1.botamt *= pmfac; +#line 14720 "" + pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2); +#line 14721 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14722 "" + readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, ( + ftnlen)128, (ftnlen)1); +#line 14723 "" + combottop_1.topamt *= pmfac; +#line 14724 "" + --all_1.iccount; +#line 14725 "" goto L27; +#line 14726 "" } +#line 14727 "" if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Override default part names for scor2prt, or normal include file. */ /* Just bypass rest of input line */ +#line 14732 "" all_1.iccount = 128; +#line 14733 "" } else if (*(unsigned char *)durq != ' ') { +#line 14734 "" goto L27; +#line 14735 "" } +#line 14736 "" } else if (*(unsigned char *)charq == 'K') { +#line 14737 "" L77: +#line 14738 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14739 "" if (*(unsigned char *)durq == 'n') { +#line 14740 "" comignorenats_1.ignorenats = TRUE_; +#line 14741 "" goto L77; +#line 14742 "" } +#line 14743 "" if (*(unsigned char *)durq != 'i') { /* Normal, full-score key change and/or transposition */ +#line 14747 "" num1 = 44 - *(unsigned char *)durq; +#line 14748 "" ++all_1.iccount; +#line 14749 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 14750 "" num1 *= i_nint(&fnum); /* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */ +#line 14754 "" ++all_1.iccount; +#line 14755 "" readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( ftnlen)1); +#line 14756 "" if (commidi_1.ismidi) { +#line 14757 "" commidisig_1.midisig = i_nint(&fnum); +#line 14758 "" if (*(unsigned char *)durq == '-') { +#line 14758 "" commidisig_1.midisig = -commidisig_1.midisig; +#line 14758 "" } /* 130317 */ +#line 14760 "" commidisig_1.midisig += comtop_1.idsig; +#line 14761 "" midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1); +#line 14763 "" } /* 70 continue */ +#line 14765 "" if (num1 == 0) { /* Key change, not transposition. */ +#line 14769 "" all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + ( all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28); +#line 14770 "" comtop_1.lastisig = comtop_1.isig; +#line 14771 "" comtop_1.isig = i_nint(&fnum); +#line 14772 "" if (*(unsigned char *)durq == '-') { +#line 14772 "" comtop_1.isig = -comtop_1.isig; +#line 14772 "" } +#line 14773 "" comtop_1.isig += comtop_1.idsig; +#line 14774 "" if (commidi_1.ismidi) { +#line 14774 "" midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1); +#line 14774 "" } +#line 14775 "" } else { /* num1 .ne. 0, so transposition, so must be at beginning. isig came with K... */ /* but was passed to pmxb through pmxtex.dat. isig0 comes from setup data */ /* (signature before transposition). idsig must be added to future key changes. */ +#line 14781 "" jv = 0; +#line 14782 "" while(jv < 24) { +#line 14783 "" ++jv; +#line 14784 "" cominsttrans_1.itransamt[jv - 1] = num1; +#line 14785 "" } +#line 14786 "" comtop_1.idsig = comtop_1.isig - comtop_1.isig0; +#line 14787 "" } +#line 14788 "" } else { /* Instrument specific transposition. */ +#line 14792 "" getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, & all_1.iccount, &ibaroff, &all_1.nbars, &comkeys_2.noinst, (ftnlen)128); /* The sig parameters will have been set 1st time but that's OK */ +#line 14797 "" } +#line 14798 "" } else if (*(unsigned char *)charq == '/') { +#line 14799 "" if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26)) { /* There was a hardspace followed by end of block. Remove it from the hardspace */ /* list, store with shifts instead, set special bit. This code also at '|' */ +#line 14804 "" all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[ commvl_1.ivx - 1] * 24 - 25],18); +#line 14805 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 14806 "" comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; +#line 14807 "" --comudsp_1.nudsp; +#line 14808 "" all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[ commvl_1.ivx - 1] + 1) * 24 - 1],26); +#line 14809 "" } +#line 14810 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); /* Save ending note level: */ +#line 14814 "" if (commvl_1.ivx <= all_1.nv) { /* This is the first line of music on this staff. If previous block had only 1 */ /* voice, save last pitch from line 1 of prev. block to line 2, in case a */ /* 2nd line is started just below */ +#line 14820 "" if (! comnotes_1.was2[all_1.iv - 1]) { +#line 14820 "" comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv - 1]; +#line 14820 "" } +#line 14821 "" comnotes_1.was2[all_1.iv - 1] = FALSE_; +#line 14822 "" comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev; +#line 14823 "" } else { /* This is the 2nd line of music on this staff. */ +#line 14827 "" comnotes_1.was2[all_1.iv - 1] = TRUE_; +#line 14828 "" comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev; +#line 14829 "" } +#line 14830 "" if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) { /* End of input block */ +#line 14834 "" *loop = FALSE_; +#line 14835 "" } else { /* Start a new line of music */ +#line 14839 "" if (all_1.lenb0 != 0 && all_1.firstgulp) { +#line 14839 "" all_1.lenbar = all_1.lenb0; +#line 14839 "" } +#line 14840 "" all_1.nbars = 0; +#line 14841 "" if (*(unsigned char *)durq == ' ') { /* New line of music is on next staff */ +#line 14845 "" ++all_1.iv; +#line 14846 "" commvl_1.ivx = all_1.iv; +#line 14847 "" } else { /* durq must be 2nd '/'. New line of music is on same staff. Set up for it */ +#line 14851 "" commvl_1.ivx = all_1.nv + 1; +#line 14852 "" i__1 = all_1.nv; +#line 14852 "" for (iiv = 1; iiv <= i__1; ++iiv) { +#line 14853 "" if (commvl_1.nvmx[iiv - 1] == 2) { +#line 14853 "" ++commvl_1.ivx; +#line 14853 "" } +#line 14854 "" /* L23: */ +#line 14854 "" } +#line 14855 "" commvl_1.nvmx[all_1.iv - 1] = 2; +#line 14856 "" commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx; +#line 14857 "" all_1.itsofar[commvl_1.ivx - 1] = 0; +#line 14858 "" all_1.nnl[commvl_1.ivx - 1] = 0; +#line 14859 "" comfb_1.nfb[commvl_1.ivx - 1] = 0; +#line 14860 "" comudsp_1.nudoff[commvl_1.ivx - 1] = 0; +#line 14861 "" comcc_1.ndotmv[commvl_1.ivx - 1] = 0; +#line 14862 "" for (j = 1; j <= 200; ++j) { +#line 14863 "" all_1.irest[commvl_1.ivx + j * 24 - 25] = 0; +#line 14864 "" all_1.islur[commvl_1.ivx + j * 24 - 25] = 0; +#line 14865 "" all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0; +#line 14866 "" all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0; +#line 14867 "" all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0; +#line 14868 "" all_1.mult[commvl_1.ivx + j * 24 - 25] = 0; +#line 14869 "" /* L24: */ +#line 14869 "" } /* Go back and lower the rests in voice "a" that don't have over-ridden heights */ +#line 14873 "" i__1 = all_1.nnl[all_1.iv - 1]; +#line 14873 "" for (j = 1; j <= i__1; ++j) { +#line 14874 "" if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) && all_1.nolev[all_1.iv + j * 24 - 25] == 0) { +#line 14874 "" all_1.nolev[all_1.iv + j * 24 - 25] = -4; +#line 14874 "" } +#line 14876 "" /* L26: */ +#line 14876 "" } +#line 14877 "" } +#line 14878 "" } +#line 14879 "" all_1.iccount = 128; +#line 14880 "" } else if (*(unsigned char *)charq == 'X') { /* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */ @@ -21523,7 +35330,9 @@ L77: /* keep group shifts for crossing block boundaries. */ /* Computing MAX */ +#line 14886 "" i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1]; +#line 14886 "" getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__1, i__2) * 24 - 25], &comnotes_1.shifton, &comask_1.wheadpt, & all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * @@ -21531,91 +35340,140 @@ L77: all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[ commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen) 128, (ftnlen)1); +#line 14889 "" } else if (*(unsigned char *)charq == 'I') { /* Midi controls. */ /* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ +#line 14894 "" getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, & combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &all_1.lenbar, &all_1.mtrdenl, &c_false, (ftnlen)128); +#line 14896 "" } else if (*(unsigned char *)charq == 'M') { /* Macro action */ +#line 14900 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 14901 "" if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Record or save a macro. Get the number of the macro. */ +#line 14905 "" getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14906 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 14907 "" commac_1.macnum = i_nint(&fnum); +#line 14908 "" commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); +#line 14909 "" if (*(unsigned char *)charq == 'R') { +#line 14910 "" mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); +#line 14911 "" } else { /* Save (Record but don't activate) */ +#line 14915 "" L5: +#line 14915 "" mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); +#line 14916 "" if (commac_1.mrecord) { +#line 14917 "" getbuf_(lineq, (ftnlen)128); +#line 14918 "" all_1.iccount = 0; +#line 14919 "" goto L5; +#line 14920 "" } +#line 14921 "" all_1.iccount = all_1.iccount + ndxm + 1; +#line 14922 "" } +#line 14923 "" } else if (*(unsigned char *)charq == 'P') { /* Playback the macro */ +#line 14927 "" getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 14928 "" readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) 1); +#line 14929 "" commac_1.macnum = i_nint(&fnum); +#line 14930 "" commac_1.icchold = all_1.iccount; +#line 14931 "" s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); +#line 14932 "" all_1.iccount = 128; +#line 14933 "" c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; +#line 14934 "" commac_1.mplay = TRUE_; +#line 14935 "" } +#line 14936 "" } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Continued rhythmic shortcut */ +#line 14940 "" idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); +#line 14941 "" if (idotform == 1) { /* Check for start of forced beam on 2nd member of dotform=1 shortcut */ +#line 14945 "" if (comget_1.fbon) { +#line 14946 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] == (real) all_1.itsofar[commvl_1.ivx - 1]) { +#line 14946 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] += all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] / 2; +#line 14946 "" } +#line 14949 "" } /* Change duration of prior note */ +#line 14953 "" all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 14954 "" all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] = all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] * 3 / 2; +#line 14955 "" all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 14956 "" } +#line 14957 "" ++idotform; +#line 14958 "" numnum = 1; +#line 14959 "" cdot = TRUE_; +#line 14960 "" goto L1; +#line 14961 "" } +#line 14962 "" return 0; } /* getnote_ */ @@ -21650,7 +35508,7 @@ L5: static real xofforn; /* Fortran I/O blocks */ - static cilist io___834 = { 0, 6, 0, 0, 0 }; + static cilist io___875 = { 0, 6, 0, 0, 0 }; @@ -21664,7 +35522,9 @@ L5: /* Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U */ /* 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. */ +#line 14986 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 14987 "" if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) { /* caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */ @@ -21674,74 +35534,117 @@ L5: /* bit 27 = 0 if caesura, 1 if breath */ /* bit 28: 5th bit of ivx */ +#line 14996 "" *iornq = bit_set(*iornq,28); +#line 14997 "" ++comcb_1.nbc; /* ibcdata(nbc) = ivx+16*ip */ +#line 14999 "" comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4); +#line 15000 "" if (*ivx >= 16) { +#line 15000 "" comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ comcb_1.nbc - 1],28); +#line 15000 "" } +#line 15001 "" if (*(unsigned char *)charq == 'b') { +#line 15001 "" comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ comcb_1.nbc - 1],27); +#line 15001 "" } +#line 15002 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15003 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* We have a vertical shift, get it */ +#line 15007 "" ++(*iccount); +#line 15008 "" readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); +#line 15009 "" if (*(unsigned char *)durq == '-') { +#line 15009 "" fnum = -fnum; +#line 15009 "" } +#line 15010 "" r__1 = fnum + 32; +#line 15010 "" i__1 = i_nint(&r__1); +#line 15010 "" setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1); +#line 15011 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Horizontal shift, get it */ +#line 15015 "" ++(*iccount); +#line 15016 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 15017 "" if (*(unsigned char *)charq == '-') { +#line 15017 "" fnum = -fnum; +#line 15017 "" } +#line 15018 "" r__1 = fnum * 10; +#line 15018 "" i__1 = i_nint(&r__1) + 128; +#line 15018 "" setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, & i__1); +#line 15019 "" } +#line 15020 "" } +#line 15021 "" return 0; +#line 15022 "" } /* Set signal on main note that some note at this time has ornament. ONLY used */ /* in beamstrt to activate further tests for whether ihornb is needed. */ +#line 15027 "" *iornq = bit_set(*iornq,23); /* Isolate 21 bits defining exisiting ornaments */ +#line 15031 "" if (*notcrd) { /* iorni = iand(4194303,iornq) */ /* iorni = iand(541065215,iornq) */ +#line 15034 "" iorni = 1614807039 & *iornq; +#line 15035 "" } else { +#line 15036 "" iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1]; +#line 15037 "" } /* korn = index('stmgx+Tupf._)e:XXX>^',charq) */ +#line 15039 "" korn = i_indx("stmgx+Tupf._)e:XXX>^XXXXXXXXCG", charq, (ftnlen)30, ( ftnlen)1); +#line 15040 "" if (korn != 15) { +#line 15040 "" iorni = bit_set(iorni,korn); +#line 15040 "" } /* Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later */ /* as follows: korn=16-18 for sfn, and or 21 for bare ?. */ /* When this if-block is done, korn will = bit# of actual ornament (unless "?"). */ +#line 15046 "" if (korn == 15) { /* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */ @@ -21751,147 +35654,236 @@ L5: /* iorni = ior(iorni,iand(iornq0,1638383)) */ /* iorni = ior(iorni,iand(iornq0,3735535)) */ /* iorni = ior(iorni,iand(iornq0,540606447)) */ +#line 15055 "" iorni |= *iornq0 & 1614348271; +#line 15056 "" *ornrpt = FALSE_; +#line 15057 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* durq will be ' ' */ +#line 15061 "" } else if (korn == 14) { /* Editorial accidental */ +#line 15065 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* korn = 15+index('sfn',durq) */ +#line 15067 "" korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15; +#line 15068 "" if (korn == 19) { +#line 15068 "" korn = 21; +#line 15068 "" } +#line 15069 "" iorni = bit_set(bit_clear(iorni,14),korn); +#line 15070 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15071 "" if (*(unsigned char *)durq == '?') { /* This is "oe[s|f|n]?". Set 21st bit also. */ +#line 15075 "" iorni = bit_set(iorni,21); +#line 15076 "" korn += 6; +#line 15077 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15078 "" } /* iorni = ibset(ibclr(iorni,14),korn) */ +#line 15080 "" } else if (korn == 4 && *noxtup) { /* segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points */ +#line 15084 "" *noffseg = 0; +#line 15085 "" negseg = FALSE_; +#line 15086 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15087 "" if (*(unsigned char *)durq != ' ') { /* Segno shift is specified */ +#line 15091 "" if (*(unsigned char *)durq == '-') { +#line 15092 "" negseg = TRUE_; +#line 15093 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15094 "" } +#line 15095 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 15096 "" *noffseg = (integer) fnum; +#line 15097 "" if (negseg) { +#line 15097 "" *noffseg = -(*noffseg); +#line 15097 "" } +#line 15098 "" } +#line 15099 "" } else if (korn == 7) { /* Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" */ +#line 15103 "" ++comtrill_1.ntrill; +#line 15104 "" comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx; +#line 15105 "" comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip; +#line 15106 "" comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f; +#line 15107 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15108 "" if (*(unsigned char *)durq == 't') { /* Convert to new internal symbol for non-'"tr" trill */ +#line 15112 "" korn = 15; +#line 15113 "" iorni = bit_set(bit_clear(iorni,7),15); +#line 15114 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15115 "" } +#line 15116 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { /* We have a number for the length */ +#line 15120 "" readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[ comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1); +#line 15121 "" } +#line 15122 "" } else if (korn == 10 && *noxtup) { /* Fermata */ +#line 15126 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15127 "" if (*(unsigned char *)durq == 'd') { +#line 15128 "" korn = 14; +#line 15129 "" iorni = bit_set(bit_clear(iorni,10),14); +#line 15130 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15131 "" } +#line 15132 "" } else { +#line 15133 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15134 "" } +#line 15135 "" if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) { - s_wsle(&io___834); +#line 15136 "" + s_wsle(&io___875); +#line 15136 "" do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", ( ftnlen)41); +#line 15136 "" do_lio(&c__9, &c__1, durq, (ftnlen)1); +#line 15136 "" e_wsle(); +#line 15137 "" stop1_(); +#line 15138 "" } +#line 15139 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Shift ornament up or down */ +#line 15143 "" ++comtrill_1.nudorn; /* Set bit 25 in iorni as a signal. This may not really be necessary. */ +#line 15147 "" iorni = bit_set(iorni,25); /* Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, */ /* 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present */ +#line 15152 "" xofforn = (real) (44 - *(unsigned char *)durq); +#line 15153 "" ++(*iccount); +#line 15154 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 15155 "" r__1 = xofforn * fnum; +#line 15155 "" iofforn = i_nint(&r__1); +#line 15156 "" comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (* nole << 12) + (korn << 19) + (iofforn + 32 << 25); +#line 15158 "" comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx; +#line 15159 "" if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { /* Horizontal shift */ +#line 15163 "" comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set( comtrill_1.kudorn[comtrill_1.nudorn - 1],31); +#line 15164 "" xofforn = (real) (44 - *(unsigned char *)durq); +#line 15165 "" ++(*iccount); +#line 15166 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); /* 141226 ornhshft(nudorn) = nint(xofforn*fnum) */ +#line 15168 "" comtrill_1.ornhshft[comtrill_1.nudorn - 1] = xofforn * fnum; +#line 15169 "" } +#line 15170 "" } else if (*(unsigned char *)durq == ':') { /* Turn on repeated ornaments */ +#line 15174 "" *ornrpt = TRUE_; /* Save the ornament value just set */ +#line 15178 "" *iornq0 = iorni; +#line 15179 "" } +#line 15180 "" if (*notcrd) { +#line 15181 "" *iornq |= iorni; +#line 15182 "" } else { +#line 15183 "" comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni; +#line 15184 "" } +#line 15185 "" return 0; } /* getorn_ */ @@ -21927,9 +35919,9 @@ L5: static char lnholdq[128]; /* Fortran I/O blocks */ - static cilist io___840 = { 0, 6, 0, 0, 0 }; - static cilist io___841 = { 0, 15, 0, "()", 0 }; - static cilist io___845 = { 0, 18, 1, "(a)", 0 }; + static cilist io___881 = { 0, 6, 0, 0, 0 }; + static cilist io___882 = { 0, 15, 0, "()", 0 }; + static cilist io___886 = { 0, 18, 1, "(a)", 0 }; @@ -21952,229 +35944,410 @@ L5: /* ipbufmod = points to last character of most recent inserted line */ /* from pmx.mod */ +#line 15219 "" c1omget_1.line1pmxmod = inbuff_1.ilbuf; +#line 15220 "" if (! (*global)) { +#line 15221 "" ioin__1.inerr = 0; +#line 15221 "" ioin__1.infilen = includeq_len; +#line 15221 "" ioin__1.infile = includeq; +#line 15221 "" ioin__1.inex = &fexist; +#line 15221 "" ioin__1.inopen = 0; +#line 15221 "" ioin__1.innum = 0; +#line 15221 "" ioin__1.innamed = 0; +#line 15221 "" ioin__1.inname = 0; +#line 15221 "" ioin__1.inacc = 0; +#line 15221 "" ioin__1.inseq = 0; +#line 15221 "" ioin__1.indir = 0; +#line 15221 "" ioin__1.infmt = 0; +#line 15221 "" ioin__1.inform = 0; +#line 15221 "" ioin__1.inunf = 0; +#line 15221 "" ioin__1.inrecl = 0; +#line 15221 "" ioin__1.innrec = 0; +#line 15221 "" ioin__1.inblank = 0; +#line 15221 "" f_inqu(&ioin__1); /* Transfer includeq to temporary char variable with known length */ +#line 15225 "" s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len); +#line 15226 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); - s_wsle(&io___840); +#line 15227 "" + s_wsle(&io___881); +#line 15227 "" e_wsle(); - s_wsfe(&io___841); +#line 15228 "" + s_wsfe(&io___882); +#line 15228 "" e_wsfe(); +#line 15229 "" if (! fexist) { /* Writing concatenation */ +#line 15230 "" i__1[0] = 15, a__1[0] = "Could not find "; +#line 15230 "" i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; +#line 15230 "" i__1[2] = 19, a__1[2] = ", checking further."; +#line 15230 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114); +#line 15230 "" printl_(ch__1, lpmxmoddirq + 34); /* File named includeq doesn't not exist. Get directory from PMXMODDIR and */ /* see if it's there */ +#line 15236 "" getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); +#line 15237 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 15238 "" if (lpmxmoddirq > 0) { /* Writing concatenation */ +#line 15239 "" i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; +#line 15239 "" i__2[1] = includeq_len, a__2[1] = includeq; +#line 15239 "" s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); +#line 15240 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 15241 "" } else { +#line 15242 "" printl_("No other directory defined by PMXMODDIR, stopping", ( ftnlen)49); +#line 15244 "" stop1_(); +#line 15245 "" } +#line 15246 "" ioin__1.inerr = 0; +#line 15246 "" ioin__1.infilen = 80; +#line 15246 "" ioin__1.infile = pmxmoddirq; +#line 15246 "" ioin__1.inex = &fexist; +#line 15246 "" ioin__1.inopen = 0; +#line 15246 "" ioin__1.innum = 0; +#line 15246 "" ioin__1.innamed = 0; +#line 15246 "" ioin__1.inname = 0; +#line 15246 "" ioin__1.inacc = 0; +#line 15246 "" ioin__1.inseq = 0; +#line 15246 "" ioin__1.indir = 0; +#line 15246 "" ioin__1.infmt = 0; +#line 15246 "" ioin__1.inform = 0; +#line 15246 "" ioin__1.inunf = 0; +#line 15246 "" ioin__1.inrecl = 0; +#line 15246 "" ioin__1.innrec = 0; +#line 15246 "" ioin__1.inblank = 0; +#line 15246 "" f_inqu(&ioin__1); +#line 15247 "" if (! fexist) { /* Writing concatenation */ +#line 15248 "" i__1[0] = 15, a__1[0] = "Could not find "; +#line 15248 "" i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; +#line 15248 "" i__1[2] = 11, a__1[2] = ", stopping."; +#line 15248 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106); +#line 15248 "" printl_(ch__2, lpmxmoddirq + 26); +#line 15250 "" stop1_(); +#line 15251 "" } +#line 15252 "" } /* Writing concatenation */ +#line 15253 "" i__2[0] = 28, a__2[0] = "Opening normal include file "; +#line 15253 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 15253 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); +#line 15253 "" printl_(ch__3, lpmxmoddirq + 28); +#line 15255 "" o__1.oerr = 0; +#line 15255 "" o__1.ounit = 18; +#line 15255 "" o__1.ofnmlen = 80; +#line 15255 "" o__1.ofnm = pmxmoddirq; +#line 15255 "" o__1.orl = 0; +#line 15255 "" o__1.osta = 0; +#line 15255 "" o__1.oacc = 0; +#line 15255 "" o__1.ofm = 0; +#line 15255 "" o__1.oblnk = 0; +#line 15255 "" f_open(&o__1); +#line 15256 "" } else { /* Check for existence of pmx.mod */ +#line 15260 "" getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); +#line 15261 "" lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 15262 "" if (lpmxmoddirq == 0) { +#line 15262 "" return 0; +#line 15262 "" } /* Writing concatenation */ +#line 15263 "" i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; +#line 15263 "" i__2[1] = 7, a__2[1] = "pmx.mod"; +#line 15263 "" s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); +#line 15264 "" lpmxmoddirq += 7; +#line 15265 "" ioin__1.inerr = 0; +#line 15265 "" ioin__1.infilen = 80; +#line 15265 "" ioin__1.infile = pmxmoddirq; +#line 15265 "" ioin__1.inex = &fexist; +#line 15265 "" ioin__1.inopen = 0; +#line 15265 "" ioin__1.innum = 0; +#line 15265 "" ioin__1.innamed = 0; +#line 15265 "" ioin__1.inname = 0; +#line 15265 "" ioin__1.inacc = 0; +#line 15265 "" ioin__1.inseq = 0; +#line 15265 "" ioin__1.indir = 0; +#line 15265 "" ioin__1.infmt = 0; +#line 15265 "" ioin__1.inform = 0; +#line 15265 "" ioin__1.inunf = 0; +#line 15265 "" ioin__1.inrecl = 0; +#line 15265 "" ioin__1.innrec = 0; +#line 15265 "" ioin__1.inblank = 0; +#line 15265 "" f_inqu(&ioin__1); +#line 15266 "" if (! fexist) { +#line 15266 "" return 0; +#line 15266 "" } /* Writing concatenation */ +#line 15267 "" i__2[0] = 28, a__2[0] = "Opening global include file "; +#line 15267 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 15267 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); +#line 15267 "" printl_(ch__3, lpmxmoddirq + 28); +#line 15269 "" o__1.oerr = 0; +#line 15269 "" o__1.ounit = 18; +#line 15269 "" o__1.ofnmlen = lpmxmoddirq; +#line 15269 "" o__1.ofnm = pmxmoddirq; +#line 15269 "" o__1.orl = 0; +#line 15269 "" o__1.osta = 0; +#line 15269 "" o__1.oacc = 0; +#line 15269 "" o__1.ofm = 0; +#line 15269 "" o__1.oblnk = 0; +#line 15269 "" f_open(&o__1); +#line 15270 "" } +#line 15271 "" printl_("Adding include data", (ftnlen)19); /* Read lines in from pmx.mod one at a time */ +#line 15275 "" ipbufmod = inbuff_1.ipbuf; +#line 15276 "" lenbufmod = c1omget_1.lenbuf0; - for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 4000; ++ilbufmod) { - i__3 = s_rsfe(&io___845); +#line 15277 "" + for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 9600; ++ilbufmod) { +#line 15278 "" + i__3 = s_rsfe(&io___886); +#line 15278 "" if (i__3 != 0) { +#line 15278 "" goto L3; +#line 15278 "" } +#line 15278 "" i__3 = do_fio(&c__1, lnholdq, (ftnlen)128); +#line 15278 "" if (i__3 != 0) { +#line 15278 "" goto L3; +#line 15278 "" } +#line 15278 "" i__3 = e_rsfe(); +#line 15278 "" if (i__3 != 0) { +#line 15278 "" goto L3; +#line 15278 "" } /* A line was read. Slide all existing lengths from here forward ahead by 1 */ +#line 15282 "" i__3 = ilbufmod; +#line 15282 "" for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) { +#line 15283 "" inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1]; +#line 15284 "" /* L2: */ +#line 15284 "" } /* Get length of line from include file */ +#line 15288 "" lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128); +#line 15289 "" if (lenmodline == 0) { /* Blank line. Make it a single blank with length 1 */ +#line 15293 "" lenmodline = 1; +#line 15294 "" s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); +#line 15295 "" } +#line 15296 "" inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline; +#line 15297 "" printl_(lnholdq, lenmodline); /* Insert new stuff into bufq */ +#line 15301 "" i__3 = ipbufmod; /* Writing concatenation */ +#line 15301 "" i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq; +#line 15301 "" i__1[1] = lenmodline, a__1[1] = lnholdq; +#line 15301 "" i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3; - s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)65536); +#line 15301 "" + s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)131072); /* Update internal parameters */ +#line 15306 "" ipbufmod += inbuff_1.lbuf[ilbufmod - 1]; +#line 15307 "" lenbufmod += inbuff_1.lbuf[ilbufmod - 1]; +#line 15308 "" ++inbuff_1.nlbuf; +#line 15309 "" /* L1: */ +#line 15309 "" } +#line 15310 "" L3: /* Writing concatenation */ +#line 15311 "" i__2[0] = 8, a__2[0] = "Closing "; +#line 15311 "" i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 15311 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88); +#line 15311 "" printl_(ch__4, lpmxmoddirq + 8); +#line 15312 "" cl__1.cerr = 0; +#line 15312 "" cl__1.cunit = 18; +#line 15312 "" cl__1.csta = 0; +#line 15312 "" f_clos(&cl__1); +#line 15313 "" c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod - inbuff_1.ilbuf; +#line 15314 "" c1omget_1.lenbuf0 = lenbufmod; /* Fix Andre's error reporting problem 101211 leading to log(neg#) due */ /* to nline being 2 bigger than it should be */ +#line 15319 "" c1omget_1.nline += -2; +#line 15321 "" return 0; } /* getpmxmod_ */ @@ -22207,86 +36380,145 @@ L3: static integer iccount, nvsofar; /* Fortran I/O blocks */ - static cilist io___851 = { 0, 17, 0, "(a)", 0 }; - static cilist io___861 = { 0, 6, 0, 0, 0 }; + static cilist io___892 = { 0, 17, 0, "(a)", 0 }; + static cilist io___902 = { 0, 6, 0, 0, 0 }; /* Get the first line */ +#line 15337 "" /* Parameter adjustments */ +#line 15337 "" --sepsymq; +#line 15337 "" --clefq; +#line 15337 "" inameq -= 79; +#line 15337 "" +#line 15337 "" /* Function Body */ +#line 15337 "" iccount = 0; +#line 15338 "" L9: +#line 15338 "" getbuf_(lineq, (ftnlen)128); +#line 15339 "" if (*(unsigned char *)lineq == '%') { +#line 15339 "" goto L9; +#line 15339 "" } +#line 15340 "" *istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0; +#line 15341 "" if (*istype0) { /* Have TeX input until next line that starts with '---'. Save in scratch. */ +#line 15345 "" o__1.oerr = 0; +#line 15345 "" o__1.ounit = 17; +#line 15345 "" o__1.ofnm = 0; +#line 15345 "" o__1.orl = 0; +#line 15345 "" o__1.osta = "SCRATCH"; +#line 15345 "" o__1.oacc = 0; +#line 15345 "" o__1.ofm = 0; +#line 15345 "" o__1.oblnk = 0; +#line 15345 "" f_open(&o__1); +#line 15346 "" L3: +#line 15346 "" getbuf_(lineq, (ftnlen)128); +#line 15347 "" if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { - s_wsfe(&io___851); +#line 15348 "" + s_wsfe(&io___892); +#line 15348 "" do_fio(&c__1, lineq, (ftnlen)128); +#line 15348 "" e_wsfe(); +#line 15349 "" goto L3; +#line 15350 "" } /* Force a new line read on first call to readin */ +#line 15354 "" iccount = 128; +#line 15355 "" } /* Here, lineq is first line w/ numerical setup data. */ +#line 15359 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15359 "" *nv = i_nint(&r__1); +#line 15360 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15360 "" *noinst = i_nint(&r__1); +#line 15361 "" newway = *noinst <= 0; +#line 15362 "" if (newway) { +#line 15362 "" *noinst = -(*noinst); +#line 15362 "" } +#line 15363 "" i__1 = *noinst; +#line 15363 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* Seve # of staves per inst in case later drop some inst's. */ +#line 15367 "" if (newway) { /* Read in nvi for each instrument */ +#line 15371 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15371 "" comnvi_1.nsperi[iinst - 1] = i_nint(&r__1); +#line 15372 "" } else if (iinst > 1) { +#line 15373 "" comnvi_1.nsperi[iinst - 1] = 1; +#line 15374 "" } else { +#line 15375 "" comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1; +#line 15376 "" } +#line 15377 "" comnvi_1.iiorig[iinst - 1] = iinst; +#line 15378 "" comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1]; +#line 15379 "" /* L2: */ +#line 15379 "" } +#line 15380 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15380 "" *mtrnuml = i_nint(&r__1); +#line 15381 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15381 "" *mtrdenl = i_nint(&r__1); /* c */ /* c Kluge to make mtrdenl work */ @@ -22295,90 +36527,154 @@ L3: /* mtrdenl = 2 */ /* mtrnuml = mtrnuml*2 */ /* end if */ +#line 15389 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15389 "" *mtrnmp = i_nint(&r__1); +#line 15390 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15390 "" *mtrdnp = i_nint(&r__1); +#line 15391 "" *xmtrnum0 = readin_(lineq, &iccount, &nline, (ftnlen)128); /* Original key sig (before any trnasposition) in next position. Transposed */ /* sig for topfile was transferred thru pmxtex.dat. Need isig0 for key */ /* changes if transposed. */ +#line 15397 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15397 "" *isig0 = i_nint(&r__1); /* 130316 */ /* do 11 iinst = 1 , noinst */ /* midisig(iinst) = isig0 */ +#line 15401 "" commidisig_1.midisig = *isig0; /* 11 continue */ +#line 15403 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15403 "" *npages = i_nint(&r__1); +#line 15404 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15404 "" *nsyst = i_nint(&r__1); +#line 15405 "" r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 15405 "" *musicsize = i_nint(&r__1); +#line 15406 "" *fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128); /* Next noinst non-comment lines are names of instruments. */ +#line 15410 "" i__1 = *noinst; +#line 15410 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 15411 "" L5: +#line 15411 "" getbuf_(inameq + i__ * 79, (ftnlen)79); +#line 15412 "" if (*(unsigned char *)&inameq[i__ * 79] == '%') { +#line 15412 "" goto L5; +#line 15412 "" } +#line 15413 "" /* L4: */ +#line 15413 "" } /* Next non-comment line has nv clef names */ +#line 15417 "" L6: +#line 15417 "" getbuf_(lineq, (ftnlen)128); +#line 15418 "" if (*(unsigned char *)lineq == '%') { +#line 15418 "" goto L6; +#line 15418 "" } +#line 15419 "" iv = 0; +#line 15420 "" nvsofar = 0; +#line 15421 "" i__1 = *noinst; +#line 15421 "" for (jinst = 1; jinst <= i__1; ++jinst) { +#line 15422 "" nvsofar += comnvi_1.nsperi[jinst - 1]; +#line 15423 "" i__2 = comnvi_1.nsperi[jinst - 1]; +#line 15423 "" for (ivi = 1; ivi <= i__2; ++ivi) { +#line 15424 "" ++iv; +#line 15425 "" *(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1]; +#line 15426 "" if (iv == nvsofar) { +#line 15427 "" *(unsigned char *)&sepsymq[iv] = '&'; +#line 15428 "" } else { +#line 15429 "" *(unsigned char *)&sepsymq[iv] = '|'; +#line 15430 "" } +#line 15431 "" /* L10: */ +#line 15431 "" } +#line 15432 "" /* L1: */ +#line 15432 "" } /* Mext non-comment line has path name */ +#line 15436 "" L8: +#line 15436 "" getbuf_(pathnameq, (ftnlen)40); +#line 15437 "" if (*(unsigned char *)pathnameq == '%') { +#line 15437 "" goto L8; +#line 15437 "" } +#line 15438 "" *lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1; /* 160130 Replace '\' by '/' */ +#line 15442 "" L12: +#line 15442 "" ipos = i_indx(pathnameq, "\\", (ftnlen)40, (ftnlen)1); +#line 15443 "" if (ipos > 0) { +#line 15444 "" *(unsigned char *)&pathnameq[ipos - 1] = '/'; - s_wsle(&io___861); +#line 15445 "" + s_wsle(&io___902); +#line 15445 "" do_lio(&c__9, &c__1, "Changed pathname to ", (ftnlen)20); +#line 15445 "" do_lio(&c__9, &c__1, pathnameq, (*lpath)); +#line 15445 "" e_wsle(); +#line 15446 "" goto L12; +#line 15447 "" } +#line 15448 "" return 0; } /* getset_ */ @@ -22402,34 +36698,55 @@ doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote, /* Since notes are ordered by increasing start times, as soon as we find one */ /* that starts too late, we are done checking. */ +#line 15462 "" /* Parameter adjustments */ +#line 15462 "" --to; +#line 15462 "" --tnote; +#line 15462 "" +#line 15462 "" /* Function Body */ +#line 15462 "" tgovern = 1e3f; +#line 15463 "" tend = to[*n] + *space; +#line 15464 "" i__1 = *ntot; +#line 15464 "" for (in = 1; in <= i__1; ++in) { /* Since to() is ordered by start times, exit loop after first note that */ /* starts later than note of interest. */ +#line 15469 "" if (to[in] > to[*n] + comtol_1.tol) { +#line 15469 "" goto L2; +#line 15469 "" } +#line 15470 "" if (to[in] + tnote[in] > tend - comtol_1.tol) { /* If here, this note overlaps and must be tested. */ /* Computing MIN */ +#line 15474 "" r__1 = tgovern, r__2 = tnote[in]; +#line 15474 "" tgovern = dmin(r__1,r__2); +#line 15475 "" } +#line 15476 "" /* L1: */ +#line 15476 "" } +#line 15477 "" L2: +#line 15478 "" ret_val = *space / tgovern; +#line 15479 "" return ret_val; } /* getsquez_ */ @@ -22460,84 +36777,140 @@ L2: /* during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if */ /* not in xtup. */ +#line 15495 "" colon = FALSE_; +#line 15496 "" ess = FALSE_; +#line 15497 "" number = FALSE_; +#line 15498 "" nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount - 1), (ftnlen)1) - 1; +#line 15499 "" if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen) 1) > 0) { /* "Parts only", ignore entire symbol */ +#line 15503 "" *iccount = nextbl; +#line 15504 "" return 0; +#line 15505 "" } +#line 15506 "" L1: +#line 15506 "" getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 15507 "" if (*(unsigned char *)charq == 'B') { /* "Both parts and score," ignore character */ +#line 15511 "" goto L1; +#line 15512 "" } else if (*(unsigned char *)charq == ':') { +#line 15513 "" colon = TRUE_; +#line 15514 "" goto L1; +#line 15515 "" } else if (*(unsigned char *)charq == 'S') { +#line 15516 "" ess = TRUE_; +#line 15517 "" goto L1; +#line 15518 "" } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { +#line 15519 "" number = TRUE_; +#line 15520 "" if (*(unsigned char *)charq == '-') { +#line 15520 "" ++(*iccount); +#line 15520 "" } +#line 15521 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 15522 "" if (*(unsigned char *)charq == '-') { +#line 15522 "" fnum = -fnum; +#line 15522 "" } +#line 15523 "" if (*(unsigned char *)durq != 'p') { +#line 15524 "" fnum *= *wheadpt; +#line 15525 "" --(*iccount); +#line 15526 "" } +#line 15527 "" goto L1; +#line 15528 "" } /* charq must be blank, so done parsing */ +#line 15532 "" if (! ess && ! colon) { /* Ordinary hardspace. Goes before next note. */ /* (Later, at "|" or "/", check for presence and switch to udoff if there!) */ +#line 15537 "" ++comudsp_1.nudsp; +#line 15538 "" *iornq1 = bit_set(*iornq1,26); +#line 15539 "" comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum; +#line 15540 "" comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar); +#line 15541 "" if (*ntup > 0) { +#line 15541 "" comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + * ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1); +#line 15541 "" } /* * +float(itup-1)/ntup*ifnodur(nnodur,dotq) */ +#line 15544 "" } else if (! number) { /* Must be "X:" End a group offset. */ +#line 15548 "" *irest = bit_set(*irest,17); +#line 15549 "" *shifton = FALSE_; +#line 15550 "" return 0; +#line 15551 "" } else { /* Only other possibility is start offset, "S" for single, ':' for multiple */ +#line 15555 "" ++comudsp_1.nudoff[*ivx - 1]; +#line 15556 "" comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum; +#line 15557 "" if (ess) { +#line 15558 "" *irest1 = bit_set(*irest1,15); +#line 15559 "" } else { +#line 15560 "" *irest1 = bit_set(*irest1,16); +#line 15561 "" *shifton = TRUE_; +#line 15562 "" } +#line 15563 "" } +#line 15564 "" return 0; } /* getx_ */ @@ -22554,44 +36927,75 @@ integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len) extern /* Subroutine */ int stop1_(void); /* Fortran I/O blocks */ - static cilist io___872 = { 0, 6, 0, 0, 0 }; - static cilist io___873 = { 0, 6, 0, 0, 0 }; + static cilist io___913 = { 0, 6, 0, 0, 0 }; + static cilist io___914 = { 0, 6, 0, 0, 0 }; +#line 15568 "" if (*idur == 6) { +#line 15569 "" ret_val = 1; +#line 15570 "" } else if (*idur == 3) { +#line 15571 "" ret_val = 2; +#line 15572 "" } else if (*idur == 1) { +#line 15573 "" ret_val = 4; +#line 15574 "" } else if (*idur == 8) { +#line 15575 "" ret_val = 8; +#line 15576 "" } else if (*idur == 4) { +#line 15577 "" ret_val = 16; +#line 15578 "" } else if (*idur == 2) { +#line 15579 "" ret_val = 32; +#line 15580 "" } else if (*idur == 0) { +#line 15581 "" ret_val = 64; +#line 15582 "" } else if (*idur == 16) { /* Only used for denominator of time signatures, not for notes */ +#line 15586 "" ret_val = 4; +#line 15587 "" } else if (*idur == 9) { +#line 15588 "" ret_val = 128; +#line 15589 "" } else { - s_wsle(&io___872); +#line 15590 "" + s_wsle(&io___913); +#line 15590 "" e_wsle(); - s_wsle(&io___873); +#line 15591 "" + s_wsle(&io___914); +#line 15591 "" do_lio(&c__9, &c__1, "You entered an invalid note-length value:", ( ftnlen)41); +#line 15591 "" do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer)); +#line 15591 "" e_wsle(); +#line 15592 "" stop1_(); +#line 15593 "" } +#line 15594 "" if (*(unsigned char *)dotq == 'd') { +#line 15594 "" ret_val = ret_val * 3 / 2; +#line 15594 "" } +#line 15595 "" return ret_val; } /* i1fnodur_ */ @@ -22609,7 +37013,9 @@ integer iashft_(integer *nacc) /* System generated locals */ integer ret_val; +#line 15605 "" ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4]; +#line 15606 "" return ret_val; } /* iashft_ */ @@ -22624,39 +37030,67 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) /* Subroutine */ int s_stop(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___875 = { 0, 6, 0, 0, 0 }; + static cilist io___916 = { 0, 6, 0, 0, 0 }; +#line 15610 "" if (*idur == 6) { +#line 15611 "" ret_val = 1; +#line 15612 "" } else if (*idur == 3) { +#line 15613 "" ret_val = 2; +#line 15614 "" } else if (*idur == 1) { +#line 15615 "" ret_val = 4; +#line 15616 "" } else if (*idur == 8) { +#line 15617 "" ret_val = 8; +#line 15618 "" } else if (*idur == 4) { +#line 15619 "" ret_val = 16; +#line 15620 "" } else if (*idur == 2) { +#line 15621 "" ret_val = 32; +#line 15622 "" } else if (*idur == 0) { +#line 15623 "" ret_val = 64; +#line 15624 "" } else if (*idur == 9) { +#line 15625 "" ret_val = 128; +#line 15626 "" } else if (*idur == 16) { /* Only used for denominator of time signatures, not for notes */ +#line 15630 "" ret_val = 4; +#line 15631 "" } else { - s_wsle(&io___875); +#line 15632 "" + s_wsle(&io___916); +#line 15632 "" do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33); +#line 15632 "" e_wsle(); +#line 15633 "" s_stop("", (ftnlen)0); +#line 15634 "" } +#line 15635 "" if (*(unsigned char *)dotq == 'd') { +#line 15635 "" ret_val = ret_val * 3 / 2; +#line 15635 "" } +#line 15636 "" return ret_val; } /* ifnodur_ */ @@ -22665,7 +37099,9 @@ integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len) /* System generated locals */ integer ret_val; +#line 15641 "" ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans; +#line 15642 "" return ret_val; } /* ifnolev_ */ @@ -22709,7 +37145,9 @@ integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift) /* Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */ /* then added to ioff */ +#line 15677 "" ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift)); +#line 15678 "" return ret_val; } /* igetbits_ */ @@ -22727,31 +37165,48 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer * extern /* Subroutine */ int stop1_(void); /* Fortran I/O blocks */ - static cilist io___876 = { 0, 6, 0, 0, 0 }; + static cilist io___917 = { 0, 6, 0, 0, 0 }; /* Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */ +#line 15686 "" /* Parameter adjustments */ +#line 15686 "" mmidi -= 25; +#line 15686 "" +#line 15686 "" /* Function Body */ +#line 15686 "" ret_val = 0; +#line 15687 "" for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { +#line 15688 "" ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) * 25]); /* * +iand(127,longi(mmidi(icm,imidi+nbytes))) */ +#line 15691 "" if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) { +#line 15691 "" return ret_val; +#line 15691 "" } /* if (.not.btest(longi(mmidi(icm,imidi+nbytes)),7)) return */ +#line 15693 "" /* L1: */ +#line 15693 "" } - s_wsle(&io___876); +#line 15694 "" + s_wsle(&io___917); +#line 15694 "" do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20); +#line 15694 "" e_wsle(); +#line 15695 "" stop1_(); +#line 15696 "" return ret_val; } /* igetvarlen_ */ @@ -22768,25 +37223,41 @@ logical isdotted_(integer *nodur, integer *ivx, integer *ip) /* Function returns true if note is dotted or double-dotted. */ /* Return false for any xtuplet. */ +#line 15705 "" /* Parameter adjustments */ +#line 15705 "" nodur -= 25; +#line 15705 "" +#line 15705 "" /* Function Body */ +#line 15705 "" if (nodur[*ivx + *ip * 24] == 0) { +#line 15706 "" ret_val = FALSE_; +#line 15707 "" return ret_val; +#line 15708 "" } else if (*ip > 1) { +#line 15709 "" if (nodur[*ivx + (*ip - 1) * 24] == 0) { +#line 15710 "" ret_val = FALSE_; +#line 15711 "" return ret_val; +#line 15712 "" } +#line 15713 "" } /* Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */ +#line 15717 "" r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol * .5f; - ret_val = r_mod(&r__1, &c_b819) > comtol_1.tol; +#line 15717 "" + ret_val = r_mod(&r__1, &c_b1054) > comtol_1.tol; +#line 15719 "" return ret_val; } /* isdotted_ */ @@ -22805,27 +37276,46 @@ integer isetvarlen_(integer *idur, integer *nbytes) static integer itemp; /* Fortran I/O blocks */ - static cilist io___878 = { 0, 6, 0, 0, 0 }; + static cilist io___919 = { 0, 6, 0, 0, 0 }; +#line 15722 "" ret_val = 0; +#line 15723 "" itemp = *idur; +#line 15724 "" for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { +#line 15725 "" i__1 = *nbytes - 1; +#line 15725 "" ret_val += (itemp & 127) * pow_ii(&c__256, &i__1); +#line 15726 "" itemp = lbit_shift(itemp, (ftnlen)-7); +#line 15727 "" if (itemp > 0) { +#line 15728 "" i__1 = (*nbytes << 3) + 7; +#line 15728 "" ret_val += pow_ii(&c__2, &i__1); +#line 15729 "" } else { +#line 15730 "" return ret_val; +#line 15731 "" } +#line 15732 "" /* L1: */ +#line 15732 "" } - s_wsle(&io___878); +#line 15733 "" + s_wsle(&io___919); +#line 15733 "" do_lio(&c__9, &c__1, "Problem in function isetvarlen", (ftnlen)30); +#line 15733 "" e_wsle(); +#line 15734 "" stop1_(); +#line 15735 "" return ret_val; } /* isetvarlen_ */ @@ -22850,41 +37340,75 @@ integer isetvarlen_(integer *idur, integer *nbytes) /* Returns string with integer only if length is 1, otherwise enclosed in */ /* brackets. */ +#line 15742 "" if (*i__ != 0) { +#line 15743 "" r__1 = abs(*i__) * 1.0001f; +#line 15743 "" *len = r_lg10(&r__1) + 1; +#line 15744 "" if (*i__ < 0) { +#line 15744 "" ++(*len); +#line 15744 "" } +#line 15745 "" } else { +#line 15746 "" s_copy(string, "0", string_len, (ftnlen)1); +#line 15747 "" *len = 1; +#line 15748 "" return 0; +#line 15749 "" } +#line 15750 "" if (*len == 1) { +#line 15751 "" *(unsigned char *)&ch__1[0] = *i__ + 48; +#line 15751 "" s_copy(string, ch__1, string_len, (ftnlen)1); +#line 15752 "" } else { +#line 15753 "" s_copy(string, "{", string_len, (ftnlen)1); +#line 15754 "" ici__1.icierr = 0; +#line 15754 "" ici__1.icirnum = 1; +#line 15754 "" ici__1.icirlen = *len; +#line 15754 "" ici__1.iciunit = string + 1; /* Writing concatenation */ +#line 15754 "" i__1[0] = 2, a__1[0] = "(i"; +#line 15754 "" *(unsigned char *)&ch__1[0] = *len + 48; +#line 15754 "" i__1[1] = 1, a__1[1] = ch__1; +#line 15754 "" i__1[2] = 1, a__1[2] = ")"; +#line 15754 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2); +#line 15754 "" s_wsfi(&ici__1); +#line 15754 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 15754 "" e_wsfi(); /* Writing concatenation */ +#line 15755 "" i__2[0] = *len + 1, a__2[0] = string; +#line 15755 "" i__2[1] = 1, a__2[1] = "}"; +#line 15755 "" s_cat(string, a__2, i__2, &c__2, string_len); +#line 15756 "" *len += 2; +#line 15757 "" } +#line 15758 "" return 0; } /* istring_ */ @@ -22893,13 +37417,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) /* System generated locals */ integer ret_val; +#line 15762 "" for (ret_val = *n; ret_val >= 1; --ret_val) { +#line 15763 "" if (*(unsigned char *)&string[ret_val - 1] != ' ') { +#line 15763 "" return ret_val; +#line 15763 "" } +#line 15764 "" /* L1: */ +#line 15764 "" } +#line 15765 "" ret_val = 0; +#line 15766 "" return ret_val; } /* lenstr_ */ @@ -22916,28 +37448,45 @@ integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm, /* Used for placing numbers in xtups. Returns note level if not a rest, */ /* else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. */ +#line 15774 "" if (! bit_test(*irest,0)) { +#line 15775 "" ret_val = *nolev; +#line 15776 "" } else { /* Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. */ +#line 15780 "" if (*mult > 0) { +#line 15781 "" if (*mult == 2) { +#line 15782 "" ioff = (*iud << 1) - 1; +#line 15783 "" } else if (*mult != 4) { +#line 15784 "" ioff = *iud * *mult; +#line 15785 "" } else { +#line 15786 "" ioff = (*iud << 2) + 1; +#line 15787 "" } +#line 15788 "" } else { /* May need to futz with this later for non-beamed xtups (quarter, half rests) */ +#line 15792 "" ioff = *iud << 1; +#line 15793 "" } +#line 15794 "" ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff; +#line 15795 "" } +#line 15796 "" return ret_val; } /* levrn_ */ @@ -22957,17 +37506,29 @@ integer lfmt1_(real *x) /* Computes total length of an "f" format with one decimal place. */ /* First round to nearest 0.1 */ +#line 15803 "" if (dabs(*x) < .001f) { +#line 15804 "" ret_val = 2; +#line 15805 "" } else { +#line 15806 "" r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f; +#line 15806 "" y = r_sign(&r__1, x); +#line 15807 "" r__1 = dabs(y) * 1000 + .001f; +#line 15807 "" ret_val = (integer) r_lg10(&r__1); +#line 15808 "" if (y < 0.f) { +#line 15808 "" ++ret_val; +#line 15808 "" } +#line 15809 "" } +#line 15810 "" return ret_val; } /* lfmt1_ */ @@ -23004,7 +37565,7 @@ integer lfmt1_(real *x) static char notexq[128]; /* Fortran I/O blocks */ - static cilist io___900 = { 0, 11, 0, "(a)", 0 }; + static cilist io___941 = { 0, 11, 0, "(a)", 0 }; @@ -23019,172 +37580,300 @@ integer lfmt1_(real *x) /* closing of full tie are not used except for shape alterations. */ /* do 1 ndx = 0 , 11 */ +#line 15835 "" /* Parameter adjustments */ +#line 15835 "" --sepsymq; +#line 15835 "" --isdat4; +#line 15835 "" --isdat3; +#line 15835 "" --isdat2; +#line 15835 "" --isdat1; +#line 15835 "" +#line 15835 "" /* Function Body */ +#line 15835 "" for (ndx = 0; ndx <= 23; ++ndx) { +#line 15836 "" if (bit_test(comslur_1.listslur,ndx)) { /* Slur or tie with index ndx is open. Find the one with right ndxb, see if tie */ +#line 15840 "" i__1 = *nsdat; +#line 15840 "" for (isdat = 1; isdat <= i__1; ++isdat) { /* if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */ +#line 15842 "" if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(& isdat1[isdat], &c__1, &c__18) << 4) != ndx) { +#line 15842 "" goto L2; +#line 15842 "" } /* Wron */ +#line 15844 "" if (! bit_test(isdat1[isdat],11)) { +#line 15844 "" goto L2; +#line 15844 "" } /* Bypass if stop */ +#line 15845 "" if (bit_test(isdat2[isdat],3)) { +#line 15845 "" goto L3; +#line 15845 "" } /* "st" */ +#line 15846 "" idcode = igetbits_(&isdat1[isdat], &c__7, &c__19); +#line 15847 "" if (idcode == 1) { +#line 15847 "" goto L3; +#line 15847 "" } /* "t" */ +#line 15848 "" tie = FALSE_; +#line 15849 "" goto L5; +#line 15850 "" L2: +#line 15850 "" ; +#line 15850 "" } +#line 15851 "" } +#line 15852 "" goto L1; +#line 15853 "" L3: +#line 15854 "" tie = TRUE_; +#line 15855 "" L5: /* A slur or tie is open, with index ndx */ +#line 15859 "" iv = igetbits_(&isdat1[isdat], &c__5, &c__13); +#line 15860 "" kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1; +#line 15861 "" *(unsigned char *)udq = 'd'; +#line 15862 "" if (bit_test(isdat1[isdat],27)) { +#line 15862 "" *(unsigned char *)udq = 'u'; +#line 15862 "" } /* Writing concatenation */ +#line 15863 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15863 "" i__2[0] = 1, a__1[0] = ch__1; +#line 15863 "" i__2[1] = 6, a__1[1] = "znotes"; +#line 15863 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15864 "" lnote = 7; +#line 15865 "" i__1 = iv - 1; +#line 15865 "" for (iiv = 1; iiv <= i__1; ++iiv) { /* Writing concatenation */ +#line 15866 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15866 "" i__2[1] = 1, a__1[1] = sepsymq + iiv; +#line 15866 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15867 "" ++lnote; +#line 15868 "" /* L4: */ +#line 15868 "" } +#line 15869 "" if (kv == 2) { /* Writing concatenation */ +#line 15870 "" i__3[0] = lnote, a__2[0] = notexq; +#line 15870 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15870 "" i__3[1] = 1, a__2[1] = ch__1; +#line 15870 "" i__3[2] = 9, a__2[2] = "nextvoice"; +#line 15870 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15871 "" lnote += 10; +#line 15872 "" } /* Compute horiz and vert offsets */ /* nolev = igetbits(isdat2(isdat),7,19) */ +#line 15877 "" islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14); +#line 15878 "" ilb12 = 0; +#line 15879 "" if (*ispstie) { +#line 15879 "" ilb12 = 1; +#line 15879 "" } +#line 15880 "" i__1 = ilb12 << 4; +#line 15880 "" ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32; +#line 15881 "" if (ivoff == -32) { +#line 15881 "" ivoff = 0; +#line 15881 "" } /* nolev = nolev+ivoff */ +#line 15883 "" islhgt += ivoff; +#line 15884 "" i__1 = (ilb12 << 4) + 6; +#line 15884 "" ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64; /* This is 10X */ +#line 15885 "" if (ihoff == -64) { +#line 15885 "" ihoff = 0; +#line 15885 "" } /* Add starting stuff for command */ +#line 15889 "" if (! (*ispstie)) { /* End 1st segment */ /* Writing concatenation */ +#line 15890 "" i__3[0] = lnote, a__2[0] = notexq; +#line 15890 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15890 "" i__3[1] = 1, a__2[1] = ch__1; +#line 15890 "" i__3[2] = 8, a__2[2] = "roffset{"; +#line 15890 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15891 "" lnote += 9; /* hoff = ihoff*.1-.5 */ /* hoff = ihoff*.1-.8 */ +#line 15894 "" hoff = ihoff * .1f - .4f; +#line 15895 "" if (hoff < 0.f) { +#line 15896 "" hoff = -hoff; /* Writing concatenation */ +#line 15897 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15897 "" i__2[1] = 1, a__1[1] = "-"; +#line 15897 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15898 "" ++lnote; +#line 15899 "" } +#line 15900 "" writflot_(&hoff, notexq, &lnote, (ftnlen)128); /* Writing concatenation */ +#line 15901 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15901 "" i__2[1] = 2, a__1[1] = "}{"; +#line 15901 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15902 "" lnote += 2; +#line 15903 "" } else { /* Writing concatenation */ +#line 15904 "" i__4[0] = lnote, a__3[0] = notexq; +#line 15904 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15904 "" i__4[1] = 1, a__3[1] = ch__1; +#line 15904 "" i__4[2] = 5, a__3[2] = "off{-"; +#line 15904 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 15904 "" i__4[3] = 1, a__3[3] = ch__2; +#line 15904 "" i__4[4] = 14, a__3[4] = "afterruleskip}"; +#line 15904 "" s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); +#line 15906 "" lnote += 21; /* 091025 add dotting for 2nd segment if needed */ +#line 15910 "" if (bit_test(isdat2[isdat],4)) { /* Writing concatenation */ +#line 15911 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15911 "" i__3[0] = 1, a__2[0] = ch__1; +#line 15911 "" i__3[1] = 6, a__2[1] = "dotted"; +#line 15911 "" i__3[2] = lnote, a__2[2] = notexq; +#line 15911 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15912 "" lnote += 7; +#line 15913 "" } +#line 15914 "" } +#line 15915 "" if (*ispstie && tie) { /* Writing concatenation */ +#line 15916 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15916 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15916 "" i__5[1] = 1, a__4[1] = ch__1; +#line 15916 "" i__5[2] = 8, a__4[2] = "tieforis"; +#line 15916 "" i__5[3] = 1, a__4[3] = udq; +#line 15916 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15917 "" lnote += 10; +#line 15918 "" } +#line 15919 "" if (bit_test(isdat3[isdat],0)) { /* Curvature tweak on termination of 1st seg */ +#line 15923 "" imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; /* Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: */ @@ -23195,48 +37884,82 @@ L5: /* 6 HH */ /* Writing concatenation */ +#line 15932 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15932 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15932 "" i__5[1] = 1, a__4[1] = ch__1; +#line 15932 "" i__5[2] = 7, a__4[2] = "psforts"; +#line 15932 "" i__1 = imid + 48; +#line 15932 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 15932 "" i__5[3] = 1, a__4[3] = ch__2; +#line 15932 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15933 "" lnote += 9; /* Zero out the flag in case there's a different curv on term of 2nd, */ +#line 15937 "" isdat3[isdat] = bit_clear(isdat3[isdat],0); +#line 15938 "" } /* Add the command name */ +#line 15942 "" if (*ispstie) { /* Writing concatenation */ +#line 15943 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15943 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15943 "" i__5[1] = 1, a__4[1] = ch__1; +#line 15943 "" i__5[2] = 2, a__4[2] = "is"; +#line 15943 "" i__5[3] = 1, a__4[3] = udq; +#line 15943 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15944 "" lnote += 4; +#line 15945 "" } else if (tie) { /* Writing concatenation */ +#line 15946 "" i__3[0] = lnote, a__2[0] = notexq; +#line 15946 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15946 "" i__3[1] = 1, a__2[1] = ch__1; +#line 15946 "" i__3[2] = 4, a__2[2] = "ttie"; +#line 15946 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15947 "" lnote += 5; +#line 15948 "" } else { /* Writing concatenation */ +#line 15949 "" i__3[0] = lnote, a__2[0] = notexq; +#line 15949 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 15949 "" i__3[1] = 1, a__2[1] = ch__1; +#line 15949 "" i__3[2] = 5, a__2[2] = "tslur"; +#line 15949 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15950 "" lnote += 6; +#line 15951 "" } /* Add index */ @@ -23248,120 +37971,214 @@ L5: /* notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */ /* lnote = lnote+4 */ /* end if */ +#line 15962 "" if (23 - ndx < 10) { /* Writing concatenation */ +#line 15963 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15963 "" i__1 = 71 - ndx; +#line 15963 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 15963 "" i__2[1] = 1, a__1[1] = ch__1; +#line 15963 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15964 "" ++lnote; +#line 15965 "" } else if (23 - ndx < 20) { /* Writing concatenation */ +#line 15966 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15966 "" i__5[1] = 2, a__4[1] = "{1"; +#line 15966 "" i__1 = 61 - ndx; +#line 15966 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 15966 "" i__5[2] = 1, a__4[2] = ch__1; +#line 15966 "" i__5[3] = 1, a__4[3] = "}"; +#line 15966 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15967 "" lnote += 4; +#line 15968 "" } else { /* Writing concatenation */ +#line 15969 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15969 "" i__5[1] = 2, a__4[1] = "{2"; +#line 15969 "" i__1 = 51 - ndx; +#line 15969 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 15969 "" i__5[2] = 1, a__4[2] = ch__1; +#line 15969 "" i__5[3] = 1, a__4[3] = "}"; +#line 15969 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15970 "" lnote += 4; +#line 15971 "" } +#line 15972 "" if (*ispstie || ! tie) { /* Add note name for slur height */ +#line 15976 "" comoct_1.noctup = 0; +#line 15977 "" ncm = igetbits_(&isdat3[isdat], &c__8, &c__22); +#line 15978 "" if (ncm == 23) { +#line 15978 "" comoct_1.noctup = -2; +#line 15978 "" } /* call notefq(noteq,lnoten,nolev,ncm) */ +#line 15980 "" notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8); /* Writing concatenation */ +#line 15981 "" i__5[0] = lnote, a__4[0] = notexq; +#line 15981 "" i__5[1] = 1, a__4[1] = "{"; +#line 15981 "" i__5[2] = lnoten, a__4[2] = noteq; +#line 15981 "" i__5[3] = 1, a__4[3] = "}"; +#line 15981 "" s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 15982 "" lnote = lnote + 1 + lnoten + 1; +#line 15983 "" } +#line 15984 "" if (*ispstie) { /* Horizontal shift start of new thing */ /* Writing concatenation */ +#line 15988 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15988 "" i__2[1] = 1, a__1[1] = "{"; +#line 15988 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15989 "" ++lnote; /* ihoff = ihoff-13 */ +#line 15991 "" if (tie) { +#line 15992 "" ihoff += -12; +#line 15993 "" } else { +#line 15994 "" ihoff += -7; +#line 15995 "" } +#line 15996 "" if (ihoff < 0) { +#line 15997 "" ihoff = -ihoff; /* Writing concatenation */ +#line 15998 "" i__2[0] = lnote, a__1[0] = notexq; +#line 15998 "" i__2[1] = 1, a__1[1] = "-"; +#line 15998 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15999 "" ++lnote; +#line 16000 "" } +#line 16001 "" r__1 = ihoff * .1f; +#line 16001 "" writflot_(&r__1, notexq, &lnote, (ftnlen)128); /* Writing concatenation */ +#line 16002 "" i__2[0] = lnote, a__1[0] = notexq; +#line 16002 "" i__2[1] = 1, a__1[1] = "}"; +#line 16002 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 16003 "" ++lnote; +#line 16004 "" } /* Add closing stuff */ +#line 16008 "" if (*ispstie) { /* Writing concatenation */ +#line 16009 "" i__4[0] = lnote, a__3[0] = notexq; +#line 16009 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16009 "" i__4[1] = 1, a__3[1] = ch__1; +#line 16009 "" i__4[2] = 4, a__3[2] = "off{"; +#line 16009 "" chax_(ch__2, (ftnlen)1, &c__92); +#line 16009 "" i__4[3] = 1, a__3[3] = ch__2; +#line 16009 "" i__4[4] = 14, a__3[4] = "afterruleskip}"; +#line 16009 "" s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); +#line 16011 "" lnote += 20; +#line 16012 "" } else { /* Writing concatenation */ +#line 16013 "" i__2[0] = lnote, a__1[0] = notexq; +#line 16013 "" i__2[1] = 1, a__1[1] = "}"; +#line 16013 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 16014 "" ++lnote; +#line 16015 "" } /* Writing concatenation */ +#line 16016 "" i__3[0] = lnote, a__2[0] = notexq; +#line 16016 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16016 "" i__3[1] = 1, a__2[1] = ch__1; +#line 16016 "" i__3[2] = 3, a__2[2] = "en%"; +#line 16016 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 16017 "" lnote += 4; - s_wsfe(&io___900); +#line 16018 "" + s_wsfe(&io___941); +#line 16018 "" do_fio(&c__1, notexq, lnote); +#line 16018 "" e_wsfe(); +#line 16019 "" L1: +#line 16019 "" ; +#line 16019 "" } +#line 16020 "" *ispstie = ! (*ispstie); +#line 16021 "" return 0; } /* linebreakties_ */ @@ -23390,152 +38207,250 @@ L1: ftnlen); /* Fortran I/O blocks */ - static cilist io___904 = { 0, 6, 0, 0, 0 }; - static cilist io___905 = { 0, 6, 0, 0, 0 }; - static cilist io___906 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___907 = { 0, 11, 0, "(a)", 0 }; - static cilist io___908 = { 0, 16, 0, "(a)", 0 }; + static cilist io___945 = { 0, 6, 0, 0, 0 }; + static cilist io___946 = { 0, 6, 0, 0, 0 }; + static cilist io___947 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___948 = { 0, 11, 0, "(a)", 0 }; + static cilist io___949 = { 0, 16, 0, "(a)", 0 }; +#line 16039 "" /* Parameter adjustments */ +#line 16039 "" islur -= 25; +#line 16039 "" +#line 16039 "" /* Function Body */ +#line 16039 "" merge = FALSE_; +#line 16040 "" if (comgrace_1.nlit > 0) { +#line 16041 "" merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl == comgrace_1.iplit[comgrace_1.nlit - 1]; +#line 16042 "" } +#line 16043 "" ++comgrace_1.nlit; +#line 16044 "" comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv; +#line 16045 "" comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl; +#line 16046 "" itype = 1; +#line 16047 "" L17: +#line 16047 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 16048 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16048 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { +#line 16049 "" ++itype; +#line 16050 "" goto L17; +#line 16051 "" } /* Writing concatenation */ +#line 16052 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16052 "" i__1[0] = 1, a__1[0] = ch__1; +#line 16052 "" i__1[1] = 1, a__1[1] = durq; +#line 16052 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, ( ftnlen)128); +#line 16053 "" comgrace_1.lenlit[comgrace_1.nlit - 1] = 2; +#line 16054 "" L18: +#line 16054 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 16055 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16055 "" if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { +#line 16056 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 16057 "" if (*(unsigned char *)durq != ' ') { /* Starting a new tex command within the string */ /* Writing concatenation */ +#line 16061 "" i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 16061 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 16061 "" i__2[1] = 1, a__2[1] = ch__1; +#line 16061 "" i__2[2] = 1, a__2[2] = durq; +#line 16061 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, & c__3, (ftnlen)128); +#line 16062 "" comgrace_1.lenlit[comgrace_1.nlit - 1] += 2; +#line 16063 "" goto L18; +#line 16064 "" } +#line 16065 "" } else { /* Writing concatenation */ +#line 16066 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 16066 "" i__1[1] = 1, a__1[1] = durq; +#line 16066 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, (ftnlen)128); +#line 16067 "" ++comgrace_1.lenlit[comgrace_1.nlit - 1]; +#line 16068 "" goto L18; +#line 16069 "" } /* If here, just read backslash-blank so string is done */ +#line 16073 "" if (itype == 1) { +#line 16074 "" islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16); +#line 16075 "" if (merge) { /* There are 2 separate strings on the same note, so merge them. */ +#line 16079 "" --comgrace_1.nlit; /* Writing concatenation */ +#line 16080 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 16080 "" i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] = comgrace_1.litq + (comgrace_1.nlit << 7); +#line 16080 "" s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, & c__2, (ftnlen)128); +#line 16082 "" comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[ comgrace_1.nlit]; +#line 16083 "" if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) { - s_wsle(&io___904); +#line 16084 "" + s_wsle(&io___945); +#line 16084 "" e_wsle(); - s_wsle(&io___905); - do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than " +#line 16085 "" + s_wsle(&io___946); +#line 16085 "" + do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "\ "128 characters", (ftnlen)52); +#line 16085 "" e_wsle(); - s_wsfe(&io___906); - do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha" +#line 16087 "" + s_wsfe(&io___947); +#line 16087 "" + do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"\ "racters", (ftnlen)52); +#line 16087 "" e_wsfe(); +#line 16089 "" stop1_(); +#line 16090 "" } +#line 16091 "" } +#line 16092 "" } else { /* Type 2 or 3. */ +#line 16096 "" if (itype == 3) { /* Write the string NOW */ +#line 16100 "" if (comlast_1.islast) { - s_wsfe(&io___907); +#line 16100 "" + s_wsfe(&io___948); /* Writing concatenation */ +#line 16100 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 16100 "" i__1[1] = 1, a__1[1] = "%"; +#line 16100 "" s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); +#line 16100 "" do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1); +#line 16100 "" e_wsfe(); +#line 16100 "" } +#line 16102 "" } else { /* Must go at top */ +#line 16106 "" if (! (*topmods)) { +#line 16107 "" *topmods = TRUE_; +#line 16108 "" o__1.oerr = 0; +#line 16108 "" o__1.ounit = 16; +#line 16108 "" o__1.ofnm = 0; +#line 16108 "" o__1.orl = 0; +#line 16108 "" o__1.osta = "SCRATCH"; +#line 16108 "" o__1.oacc = 0; +#line 16108 "" o__1.ofm = 0; +#line 16108 "" o__1.oblnk = 0; +#line 16108 "" f_open(&o__1); +#line 16109 "" } /* Must write '%' here rather than later, in case string ends with blank. */ - s_wsfe(&io___908); +#line 16113 "" + s_wsfe(&io___949); /* Writing concatenation */ +#line 16113 "" i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 16113 "" i__1[1] = 1, a__1[1] = "%"; +#line 16113 "" s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); +#line 16113 "" do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1); +#line 16113 "" e_wsfe(); +#line 16114 "" } +#line 16115 "" --comgrace_1.nlit; +#line 16116 "" } +#line 16117 "" return 0; } /* littex_ */ @@ -23544,12 +38459,19 @@ integer llen_(char *strq, integer *n, ftnlen strq_len) /* System generated locals */ integer ret_val; +#line 16121 "" for (ret_val = *n; ret_val >= 0; --ret_val) { +#line 16122 "" if (*(unsigned char *)&strq[ret_val - 1] != ' ') { +#line 16122 "" return ret_val; +#line 16122 "" } +#line 16123 "" /* L1: */ +#line 16123 "" } +#line 16124 "" return ret_val; } /* llen_ */ @@ -23566,7 +38488,9 @@ integer log2_(integer *n) /* log2 = alog(1.*n)/0.6931472+.0001 */ /* log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */ +#line 16131 "" ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8); +#line 16132 "" return ret_val; } /* log2_ */ @@ -23594,153 +38518,242 @@ integer log2_(integer *n) extern /* Subroutine */ int setbits_(integer *, integer *, integer *, integer *); +#line 16151 "" all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1; +#line 16152 "" all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2; +#line 16153 "" numnow = *numnew; +#line 16154 "" if (*numnew > 1) { /* If it starts before any others, must put it in order */ +#line 16158 "" for (ib = *numnew - 1; ib >= 1; --ib) { +#line 16159 "" if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) { +#line 16159 "" goto L12; +#line 16159 "" } +#line 16160 "" all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[ commvl_1.ivx + ib * 24 - 25]; +#line 16161 "" all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[ commvl_1.ivx + ib * 24 - 25]; +#line 16162 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] = *(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25]; +#line 16163 "" all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1; +#line 16164 "" all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2; +#line 16165 "" numnow = ib; +#line 16166 "" /* L11: */ +#line 16166 "" } +#line 16167 "" L12: +#line 16168 "" ; +#line 16168 "" } +#line 16169 "" sum = 0.f; /* Beam has non-xtup within */ +#line 16173 "" nrests = 0; +#line 16174 "" isxtup = FALSE_; +#line 16175 "" i__1 = *nip2; +#line 16175 "" for (iip = *nip1; iip <= i__1; ++iip) { +#line 16176 "" if (bit_test(all_1.islur[commvl_1.ivx + *nip1 * 24 - 25],21)) { /* Forced multiplicity */ -/* mult(ivx,iip) = igetbits(islur(ivx,nip1),3,22) */ +#line 16180 "" i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], & c__3, &c__22) + 8; +#line 16180 "" setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0, &i__2); +#line 16182 "" } else if (! isxtup) { +#line 16183 "" if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { -/* mult(ivx,iip) = 4-log2(nodur(ivx,iip)) */ +#line 16184 "" i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25]) + 8; +#line 16184 "" setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, & c__0, &i__2); +#line 16185 "" } else { /* Start xtup within forced beam */ +#line 16189 "" isxtup = TRUE_; +#line 16190 "" iip1 = iip; +#line 16191 "" } +#line 16192 "" } else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { /* End of xtup within forced beam. Must count doubled notes */ +#line 16196 "" ndoub = 0; +#line 16197 "" i__2 = iip; +#line 16197 "" for (iiip = iip1; iiip <= i__2; ++iiip) { +#line 16198 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { +#line 16198 "" ++ndoub; +#line 16198 "" } +#line 16199 "" /* L1: */ +#line 16199 "" } +#line 16200 "" multx = (integer) ((log(iip + 1.f - iip1 + ndoub) * .952f - log( all_1.nodur[commvl_1.ivx + iip * 24 - 25] / 2.f)) / .69315f + 13.429f) - 10; +#line 16202 "" i__2 = iip; +#line 16202 "" for (iiip = iip1; iiip <= i__2; ++iiip) { -/* mult(ivx,iiip) = multx */ +#line 16203 "" i__3 = multx + 8; +#line 16203 "" setbits_(&all_1.mult[commvl_1.ivx + iiip * 24 - 25], &c__4, & c__0, &i__3); /* Note the following still works after making mult only the 1st 4 bits. */ +#line 16207 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { +#line 16207 "" --all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 16207 "" } +#line 16209 "" if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) { +#line 16210 "" ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 16211 "" } else if (iiip > 1) { +#line 16212 "" if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 - 25],19)) { +#line 16212 "" ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 16212 "" } +#line 16214 "" } +#line 16215 "" /* L74: */ +#line 16215 "" } +#line 16216 "" isxtup = FALSE_; +#line 16217 "" } +#line 16218 "" if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) { +#line 16219 "" ++nrests; +#line 16220 "" } else { +#line 16221 "" sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25]; +#line 16222 "" } +#line 16223 "" /* L9: */ +#line 16223 "" } /* Set beam up-down-ness */ +#line 16227 "" if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + max(1,comfb_1.ifb) * 24 - 25] != 'x') { +#line 16228 "" if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25] == 'f') { /* Get default, then trade "l" and "u" */ +#line 16232 "" r__1 = sum / (*nip2 - *nip1 + 1 - nrests); +#line 16232 "" i__1 = ncmid_(&all_1.iv, nip1); +#line 16232 "" ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); +#line 16232 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = ( char) (225 - *(unsigned char *)&ch__1[0]); +#line 16234 "" } else { +#line 16235 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + comfb_1.ifb * 24 - 25] = *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25]; +#line 16236 "" } /* This probably works only because forced beams are done first, so they */ /* don't have to be re-sorted within each voice. ???? */ +#line 16241 "" } else if (commvl_1.nvmx[all_1.iv - 1] == 2) { /* Multi-voice per staff */ +#line 16245 "" if (commvl_1.ivx <= all_1.nv) { +#line 16246 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = 'l'; +#line 16247 "" } else { +#line 16248 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = 'u'; +#line 16249 "" } +#line 16250 "" } else { /* Defaults */ +#line 16254 "" r__1 = sum / (*nip2 - *nip1 + 1 - nrests); +#line 16254 "" i__1 = ncmid_(&all_1.iv, nip1); +#line 16254 "" ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); +#line 16254 "" *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *( unsigned char *)&ch__1[0]; +#line 16256 "" } +#line 16257 "" return 0; } /* logbeam_ */ @@ -23763,44 +38776,73 @@ L12: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ +#line 16273 "" inbuff_1.lbuf[0] = inbuff_1.lbuf[0]; +#line 16274 "" if (! commac_1.mrecord) { /* Starting the macro */ +#line 16278 "" c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; +#line 16279 "" c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 16280 "" c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; +#line 16281 "" commac_1.mrecord = TRUE_; +#line 16282 "" } +#line 16283 "" if (*iccount < 128) { +#line 16284 "" i__1 = *iccount; +#line 16284 "" *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); +#line 16285 "" if (*ndxm > 0) { +#line 16285 "" i__1 = *iccount; +#line 16285 "" i__2 = 128 - *iccount; +#line 16285 "" *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); +#line 16285 "" } +#line 16287 "" if (*ndxm > 0) { /* This line ends the macro. */ +#line 16291 "" i__1 = *iccount + *ndxm; +#line 16291 "" if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen) 1) != 0) { +#line 16292 "" i__1 = *iccount + *ndxm + 1; +#line 16292 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; +#line 16292 "" errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", ( ftnlen)128, (ftnlen)27); +#line 16294 "" stop1_(); +#line 16295 "" } +#line 16296 "" c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; +#line 16297 "" c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 16298 "" commac_1.mrecord = FALSE_; +#line 16299 "" } +#line 16300 "" } +#line 16301 "" return 0; } /* m1rec1_ */ @@ -23849,116 +38891,182 @@ L12: setbits_(integer *, integer *, integer *, integer *); /* Fortran I/O blocks */ - static cilist io___953 = { 0, 6, 0, 0, 0 }; - static cilist io___954 = { 0, 6, 0, 0, 0 }; - static cilist io___955 = { 0, 15, 0, "(/a)", 0 }; + static cilist io___994 = { 0, 6, 0, 0, 0 }; + static cilist io___995 = { 0, 6, 0, 0, 0 }; + static cilist io___996 = { 0, 15, 0, "(/a)", 0 }; /* Above are factors for grace note, clef spacing. (fraction of wheadpt) */ /* In 1.04, moved to block data subprogram */ +#line 16393 "" /* Parameter adjustments */ +#line 16393 "" --istart; +#line 16393 "" --numbms; +#line 16393 "" --istop; +#line 16393 "" --squez; +#line 16393 "" --cwrest; +#line 16393 "" --tstart; +#line 16393 "" +#line 16393 "" /* Function Body */ +#line 16393 "" if (commidi_1.ismidi) { /* Initialize for this bar the accidental counter for the midi file. */ /* naccim(icm) = # of accidentals from earlier in the bar */ +#line 16398 "" i__1 = all_1.nv; +#line 16398 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16399 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 16399 "" for (kv = 1; kv <= i__2; ++kv) { +#line 16400 "" commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] = 0; +#line 16401 "" /* L45: */ +#line 16401 "" } +#line 16401 "" } +#line 16402 "" } /* Time from start of gulp to end of bar, used with forced beams */ +#line 16406 "" tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1); +#line 16407 "" if (all_1.lenb0 > 0) { +#line 16407 "" tglp2 -= all_1.lenb1; +#line 16407 "" } +#line 16408 "" *tglp1 = tglp2 - all_1.lenbar; /* infbmx will only be true if in xtup that is NOT in explicit forced beam. */ +#line 16412 "" i__2 = all_1.nv; +#line 16412 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 16413 "" i__1 = commvl_1.nvmx[all_1.iv - 1]; +#line 16413 "" for (kv = 1; kv <= i__1; ++kv) { +#line 16414 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 16415 "" cwrest[commvl_1.ivx] = FALSE_; +#line 16416 "" infbmx[commvl_1.ivx - 1] = FALSE_; +#line 16417 "" inxtup[commvl_1.ivx - 1] = FALSE_; +#line 16418 "" if (all_1.ibar > 1) { +#line 16419 "" all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] - all_1.nib[commvl_1.ivx + ( all_1.ibar - 1) * 24 - 25]; +#line 16420 "" } else { +#line 16421 "" all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25]; +#line 16422 "" } +#line 16423 "" /* L1: */ +#line 16423 "" } +#line 16423 "" } /* initialize list note counter, time(iv), curr. note(iv). The loop to 4 */ /* ONLY initializes each voice. */ +#line 16428 "" in = 1; +#line 16429 "" nxtup = 0; +#line 16430 "" comarp_1.narp = 0; +#line 16431 "" i__1 = all_1.nv; +#line 16431 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16432 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 16432 "" for (kv = 1; kv <= i__2; ++kv) { +#line 16433 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 16434 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; +#line 16435 "" cnn[commvl_1.ivx - 1] = 1; +#line 16436 "" all_1.ivxo[in - 1] = commvl_1.ivx; +#line 16437 "" all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; +#line 16438 "" all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1, all_1.nacc); +#line 16439 "" all_1.to[in - 1] = 0.f; +#line 16440 "" xit[commvl_1.ivx - 1] = all_1.tnote[in - 1]; /* Note that xit(ivx) is to END of note in voice, but it1xtup is start time. */ +#line 16444 "" if (all_1.nodur[commvl_1.ivx + all_1.ipo[in - 1] * 24 - 25] == 0) { /* First note of xtuplet at start of bar in voice ivx. */ +#line 16448 "" ++nxtup; +#line 16449 "" nxtnow[commvl_1.ivx - 1] = nxtup; +#line 16450 "" inxtup[commvl_1.ivx - 1] = TRUE_; +#line 16451 "" t1xtup[nxtup - 1] = 0.f; /* Xtup at start of bar. If no explicit forced beam, start one, set */ /* signal infbmx, and save number ifbnow for use at termination. */ +#line 16456 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { +#line 16457 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 16457 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { +#line 16458 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) { /* No explicit fb here; so exit loop and insert one. */ +#line 16462 "" goto L61; +#line 16463 "" } else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol && comfb_1.t2fb[commvl_1.ivx + @@ -23967,96 +39075,156 @@ L12: /* IS explicit fb here; must NOT insert one */ +#line 16468 "" goto L62; +#line 16469 "" } +#line 16470 "" /* L60: */ +#line 16470 "" } +#line 16471 "" } +#line 16472 "" L61: /* If here, xtup isn't in explicit fb, so must insert one */ +#line 16476 "" infbmx[commvl_1.ivx - 1] = TRUE_; +#line 16477 "" r__1 = t1xtup[nxtup - 1] + *tglp1; +#line 16477 "" addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); +#line 16479 "" ifbnow[commvl_1.ivx - 1] = ifbadd; +#line 16480 "" } +#line 16481 "" L62: +#line 16482 "" if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) < comtol_1.tol) { +#line 16482 "" xit[commvl_1.ivx - 1] = 1e3f; +#line 16482 "" } +#line 16483 "" ++in; +#line 16484 "" /* L4: */ +#line 16484 "" } +#line 16484 "" } /* Build the list: This is a manual loop starting at 5 */ +#line 16488 "" L5: /* Determine which voice comes next from end of notes done so far. */ /* tmin is the earliest ending time of notes done so far */ +#line 16493 "" tmin = 1e3f; +#line 16494 "" i__2 = all_1.nv; +#line 16494 "" for (iiv = 1; iiv <= i__2; ++iiv) { +#line 16495 "" i__1 = commvl_1.nvmx[iiv - 1]; +#line 16495 "" for (kv = 1; kv <= i__1; ++kv) { +#line 16496 "" iivx = commvl_1.ivmx[iiv + kv * 24 - 25]; /* Computing MIN */ +#line 16497 "" r__1 = tmin, r__2 = xit[iivx - 1]; +#line 16497 "" tminn = dmin(r__1,r__2); +#line 16498 "" if (tminn < tmin - comtol_1.tol) { +#line 16499 "" tmin = tminn; +#line 16500 "" commvl_1.ivx = iivx; +#line 16501 "" } +#line 16502 "" /* L6: */ +#line 16502 "" } +#line 16502 "" } +#line 16503 "" if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) { +#line 16503 "" goto L7; +#line 16503 "" } +#line 16504 "" all_1.ivxo[in - 1] = commvl_1.ivx; +#line 16505 "" ++cnn[commvl_1.ivx - 1]; +#line 16506 "" all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; +#line 16507 "" all_1.to[in - 1] = tmin; /* Check if this voice is done */ +#line 16511 "" all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[ commvl_1.ivx - 1], all_1.nacc); +#line 16512 "" if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) { +#line 16513 "" xit[commvl_1.ivx - 1] = 1e3f; +#line 16514 "" } else { +#line 16515 "" xit[commvl_1.ivx - 1] += all_1.tnote[in - 1]; +#line 16516 "" } /* Flag xtups */ +#line 16520 "" if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) { +#line 16521 "" if (! inxtup[commvl_1.ivx - 1]) { /* First note of xtup, not at start of bar. */ +#line 16525 "" ++nxtup; +#line 16526 "" nxtnow[commvl_1.ivx - 1] = nxtup; +#line 16527 "" inxtup[commvl_1.ivx - 1] = TRUE_; +#line 16528 "" t1xtup[nxtup - 1] = xit[commvl_1.ivx - 1] - all_1.tnote[in - 1]; /* (Note: can't be on last note in voice, so xit(ivx) <> 1000) */ /* Put xtuplet in a forced beam if not already in forced beam */ +#line 16533 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { +#line 16534 "" i__1 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 16534 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) { +#line 16535 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > * tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) { /* NO explicit bm; put one in */ +#line 16539 "" goto L71; +#line 16540 "" } else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol && comfb_1.t2fb[commvl_1.ivx + @@ -24065,38 +39233,59 @@ L5: /* IS explicit bm. Don't put one */ +#line 16545 "" goto L72; +#line 16546 "" } +#line 16547 "" /* L70: */ +#line 16547 "" } +#line 16548 "" } +#line 16549 "" L71: /* If here, no explicit bm, so put one in */ +#line 16553 "" infbmx[commvl_1.ivx - 1] = TRUE_; +#line 16554 "" r__1 = t1xtup[nxtup - 1] + *tglp1; +#line 16554 "" addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); +#line 16556 "" ifbnow[commvl_1.ivx - 1] = ifbadd; +#line 16557 "" } +#line 16558 "" L72: +#line 16559 "" ; +#line 16559 "" } else if (inxtup[commvl_1.ivx - 1]) { /* This test is sufficient because already know nodur>0 */ +#line 16563 "" inxtup[commvl_1.ivx - 1] = FALSE_; +#line 16564 "" if (infbmx[commvl_1.ivx - 1]) { /* Xtup is in auto-forced beam, so end it */ +#line 16568 "" comfb_1.t2fb[commvl_1.ivx + ifbnow[commvl_1.ivx - 1] * 24 - 25] = t1xtup[nxtnow[commvl_1.ivx - 1] - 1] + all_1.nodur[ commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] + *tglp1; +#line 16570 "" infbmx[commvl_1.ivx - 1] = FALSE_; +#line 16571 "" } +#line 16572 "" } +#line 16573 "" if (bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] ,24) || bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],30)) { @@ -24104,35 +39293,62 @@ L72: /* For staff jumped beam, flag the first note (lowest voice) at same time. */ /* Later will start new notes group here. */ +#line 16579 "" inj = in; +#line 16580 "" if (all_1.ivxo[in - 1] > 1) { +#line 16581 "" for (iin = in - 1; iin >= 1; --iin) { +#line 16582 "" if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) { +#line 16582 "" goto L41; +#line 16582 "" } +#line 16583 "" if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1)) < comtol_1.tol) { +#line 16584 "" inj = iin; +#line 16585 "" goto L40; +#line 16586 "" } +#line 16587 "" L40: +#line 16587 "" ; +#line 16587 "" } +#line 16588 "" } +#line 16589 "" L41: +#line 16590 "" all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25] = bit_set(all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25],29); +#line 16591 "" } +#line 16592 "" ++in; +#line 16593 "" goto L5; +#line 16594 "" L7: +#line 16595 "" comntot_1.ntot = in - 1; +#line 16596 "" i__1 = comntot_1.ntot - 1; +#line 16596 "" for (in = 1; in <= i__1; ++in) { +#line 16597 "" all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1]; +#line 16598 "" /* L8: */ +#line 16598 "" } +#line 16599 "" all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1]; /* Debug writes */ @@ -24148,21 +39364,32 @@ L7: /* Done w/ list. Loop for parsing into note blocks: */ +#line 16614 "" ib = 1; +#line 16615 "" istart[1] = 1; +#line 16616 "" comnsp_2.space[0] = 0.f; +#line 16617 "" in = 1; /* A manual loop to set space(ib) and istop(ib) */ +#line 16621 "" L9: /* Computing MIN */ +#line 16623 "" i__1 = in + 1; +#line 16623 "" commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1]; /* Computing MIN */ +#line 16624 "" i__1 = in + 1; +#line 16624 "" ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1]; +#line 16625 "" isl = all_1.islur[commvl_1.ivx + ip * 24 - 25]; +#line 16626 "" if (in == comntot_1.ntot || (commvl_1.ivx == 1 && ((isl & 67109216) > 0 || bit_test(all_1.ipl[ip * 24 - 24],28) || bit_test(all_1.iornq[ip * 24],4)) || bit_test(isl,15)) || bit_test(all_1.irest[ @@ -24184,224 +39411,353 @@ L9: /* 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */ /* changes on last note in the list? */ +#line 16647 "" if (bit_test(isl,15) && in < comntot_1.ntot) { +#line 16648 "" for (iin = in; iin >= 1; --iin) { +#line 16649 "" if (all_1.tno[iin - 1] > comtol_1.tol) { +#line 16650 "" in = iin; +#line 16651 "" all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear( all_1.islur[commvl_1.ivx + ip * 24 - 25],15); +#line 16652 "" all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25] = bit_set(all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25],15); +#line 16654 "" goto L51; +#line 16655 "" } +#line 16656 "" /* L50: */ +#line 16656 "" } +#line 16657 "" L51: +#line 16658 "" ; +#line 16658 "" } +#line 16659 "" if (comnsp_2.space[ib - 1] < comtol_1.tol) { +#line 16660 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 16661 "" squez[ib] = 1.f; +#line 16662 "" } +#line 16663 "" istop[ib] = in; +#line 16664 "" } else if (comnsp_2.space[ib - 1] < comtol_1.tol) { /* space hasn't been set yet, so tentatively set: */ +#line 16668 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 16669 "" if (comnsp_2.space[ib - 1] < comtol_1.tol) { +#line 16670 "" ++in; +#line 16671 "" } else { +#line 16672 "" squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); +#line 16673 "" istop[ib] = in; +#line 16674 "" } +#line 16675 "" goto L9; +#line 16676 "" } else if (all_1.tno[in] < comtol_1.tol) { /* This is not the last note in the group, so */ +#line 16680 "" ++in; +#line 16681 "" goto L9; +#line 16682 "" } else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) < comtol_1.tol) { +#line 16683 "" i__1 = in + 1; +#line 16683 "" xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); +#line 16684 "" if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) { /* Keep spacing the same, update tentative stop point */ +#line 16688 "" ++in; +#line 16689 "" istop[ib] = in; +#line 16690 "" goto L9; +#line 16691 "" } +#line 16692 "" } /* At this point istart and istop are good, so finalize block */ +#line 16696 "" tstart[ib] = all_1.to[istart[ib] - 1]; +#line 16697 "" if (istop[ib] == comntot_1.ntot) { +#line 16697 "" goto L15; +#line 16697 "" } +#line 16698 "" ++ib; +#line 16699 "" istart[ib] = istop[ib - 1] + 1; +#line 16700 "" in = istart[ib]; /* Set tentative block space and squeeze-factor for upcoming block */ +#line 16704 "" comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 16705 "" if (comnsp_2.space[ib - 1] > comtol_1.tol) { +#line 16705 "" squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1], all_1.tnote, all_1.to); +#line 16705 "" } +#line 16707 "" istop[ib] = in; +#line 16708 "" goto L9; +#line 16709 "" L15: +#line 16710 "" comnsp_2.nb = ib; /* Invert the list of places into ipl(0-7), making it easier to analyze a voice */ +#line 16714 "" i__1 = comntot_1.ntot; +#line 16714 "" for (in = 1; in <= i__1; ++in) { /* ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. */ /* ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) */ +#line 16719 "" comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in; +#line 16720 "" /* L13: */ +#line 16720 "" } /* Compute elemskips from start of bar to each note in the bar, for beam slopes */ +#line 16724 "" eskzb = 0.f; +#line 16725 "" ib = 1; +#line 16726 "" i__1 = comntot_1.ntot; +#line 16726 "" for (in = 1; in <= i__1; ++in) { +#line 16727 "" if (in == istart[ib]) { +#line 16728 "" r__1 = comnsp_2.space[ib - 1] / squez[ib]; +#line 16728 "" deskb = squez[ib] * feon_(&r__1); +#line 16729 "" } else if (all_1.tno[in - 2] > comtol_1.tol) { +#line 16730 "" eskzb += deskb; +#line 16731 "" } +#line 16732 "" all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb; +#line 16733 "" comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb; +#line 16734 "" if (in == istop[ib]) { +#line 16735 "" eskzb += deskb; +#line 16736 "" ++ib; +#line 16737 "" } +#line 16738 "" /* L30: */ +#line 16738 "" } -/* Debug writes */ - -/* print* */ -/* write(*,'(16f5.1)')(eskz(ivxo(in),ipo(in)),in=1,ntot) */ -/* print*,'PMXB has now got blocks' */ -/* write(*,'(16i5)')(istart(ib),ib=1,nb) */ -/* write(*,'(16i5)')(istop(ib),ib=1,nb) */ -/* write(*,'(16f5.1)')(space(ib),ib=1,nb) */ -/* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */ -/* write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) */ -/* c write(*,'(26i3)')(iand(islur(ivxo(in),ipo(in)),30720)/2048, */ -/* * in=1,ntot) */ -/* write(*,'(1x,26a3)')(ornq(ivxo(in),ipo(in)),in=1,ntot) */ - - /* Analyze for beams. */ +#line 16742 "" i__1 = all_1.nv; +#line 16742 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16743 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 16743 "" for (kv = 1; kv <= i__2; ++kv) { +#line 16744 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 16745 "" numbms[commvl_1.ivx] = 0; +#line 16746 "" mapfb[0] = 0; +#line 16747 "" mapfb[1] = 0; +#line 16748 "" mapfb[2] = 0; +#line 16749 "" mapfb[3] = 0; /* First forced beams. */ +#line 16753 "" if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { /* tglp2 is time from start of gulp to end of current bar. */ +#line 16757 "" nfbbar = 0; +#line 16758 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 16758 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { +#line 16759 "" if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > tglp2 - comtol_1.tol) { +#line 16759 "" goto L81; +#line 16759 "" } +#line 16760 "" ++nfbbar; +#line 16761 "" ++numbms[commvl_1.ivx]; +#line 16762 "" numnew = numbms[commvl_1.ivx]; /* Times from beginning of bar */ +#line 16766 "" itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); +#line 16767 "" itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); +#line 16768 "" i__4 = all_1.nn[commvl_1.ivx - 1]; +#line 16768 "" for (ip = 1; ip <= i__4; ++ip) { +#line 16769 "" if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) { +#line 16770 "" nip1fb = ip; +#line 16771 "" i__5 = all_1.nn[commvl_1.ivx - 1]; +#line 16771 "" for (ip1 = ip; ip1 <= i__5; ++ip1) { +#line 16772 "" inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 * 24 - 25]; +#line 16773 "" if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[ inip1 - 1] - itbb2, dabs(r__1)) < comtol_1.tol) { +#line 16774 "" nip2fb = ip1; +#line 16775 "" itbb3 = itbb2 - 2; +#line 16776 "" goto L85; +#line 16777 "" } +#line 16778 "" /* L84: */ +#line 16778 "" } +#line 16779 "" } +#line 16780 "" /* L83: */ +#line 16780 "" } - s_wsle(&io___953); +#line 16781 "" + s_wsle(&io___994); +#line 16781 "" e_wsle(); - s_wsle(&io___954); +#line 16782 "" + s_wsle(&io___995); +#line 16782 "" do_lio(&c__9, &c__1, "Timing problem w/ forced beams", ( ftnlen)30); +#line 16782 "" e_wsle(); - s_wsfe(&io___955); +#line 16783 "" + s_wsfe(&io___996); +#line 16783 "" do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen) 30); +#line 16783 "" e_wsfe(); +#line 16784 "" L85: +#line 16785 "" logbeam_(&numnew, &nip1fb, &nip2fb); /* Set up mapfb for forced beam just logged: */ +#line 16789 "" ib1 = itbb1 / 2; +#line 16790 "" ib2 = itbb3 / 2; +#line 16791 "" ibrep = all_1.lenbar / *ibmrep / 2; +#line 16792 "" i__4 = *ibmrep; +#line 16792 "" for (irep = 1; irep <= i__4; ++irep) { /* Computing MAX */ +#line 16793 "" i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep; +#line 16793 "" ib1now = max(i__5,i__6); /* Computing MIN */ +#line 16794 "" i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) * ibrep; +#line 16794 "" ib2now = min(i__5,i__6); +#line 16795 "" mapnow = 0; +#line 16796 "" i__5 = ib2now; +#line 16796 "" for (ib = ib1now; ib <= i__5; ++ib) { +#line 16797 "" mapnow = bit_set(mapnow,ib); +#line 16798 "" /* L87: */ +#line 16798 "" } +#line 16799 "" mapfb[irep - 1] |= mapnow; +#line 16800 "" /* L86: */ +#line 16800 "" } /* Since we are cycling thru forced beams, for those that start with a rest and */ @@ -24409,6 +39765,7 @@ L85: /* 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */ /* start of beam */ +#line 16807 "" if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25], 0)) { /* call setbits(ipl(ivx,nip1fb+1),6,11, */ @@ -24417,57 +39774,88 @@ L85: /* * igetbits(ipl(ivx,nip1fb),6,17)) */ /* call setbits(islur(ivx,nip1fb+1),2,27, */ /* * igetbits(islur(ivx,nip1fb),2,27)) */ +#line 16814 "" i__4 = nip2fb; +#line 16814 "" for (kp = nip1fb + 1; kp <= i__4; ++kp) { +#line 16815 "" i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb * 24 - 25], &c__6, &c__11); +#line 16815 "" setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], &c__6, &c__11, &i__5); +#line 16817 "" i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb * 24 - 25], &c__6, &c__17); +#line 16817 "" setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], &c__6, &c__17, &i__5); +#line 16819 "" i__5 = igetbits_(&all_1.islur[commvl_1.ivx + nip1fb * 24 - 25], &c__2, &c__27); +#line 16819 "" setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25] , &c__2, &c__27, &i__5); +#line 16821 "" /* L88: */ +#line 16821 "" } +#line 16822 "" } +#line 16823 "" /* L80: */ +#line 16823 "" } +#line 16824 "" L81: /* Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar. */ /* Remember, makeabar is called 1/bar, and it calls findbeam once per voice. */ +#line 16829 "" if (nfbbar > 0) { +#line 16830 "" comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar; +#line 16831 "" i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 16831 "" for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { +#line 16832 "" comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; +#line 16833 "" comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; +#line 16834 "" *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 - 25] = *(unsigned char *)& comfb_1.ulfbq[commvl_1.ivx + (comfb_1.ifb + nfbbar) * 24 - 25]; +#line 16835 "" /* L82: */ +#line 16835 "" } +#line 16836 "" } +#line 16837 "" } +#line 16838 "" comfb_1.ifb = 0; /* Done with forced beam masks for this bar and voice. Now get normal beams. */ +#line 16842 "" findbeam_(ibmrep, &numbms[1], mapfb); +#line 16843 "" /* L20: */ +#line 16843 "" } +#line 16843 "" } +#line 16844 "" return 0; } /* make1bar_ */ @@ -24497,6 +39885,7 @@ L81: char *, ftnlen), e_wsle(void); /* Subroutine */ int s_stop(char *, ftnlen); integer pow_ii(integer *, integer *); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); double r_lg10(real *); integer s_cmp(char *, char *, ftnlen, ftnlen); @@ -24507,6 +39896,7 @@ L81: extern /* Subroutine */ int beamstrt_(char *, integer *, integer *, integer *, real *, real *, integer *, ftnlen); static real ptsavail; + static integer multtrem; extern /* Subroutine */ int dopsslur_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, logical *, integer *, char *, integer *, char *, @@ -24516,9 +39906,13 @@ L81: static integer ib, ig, il, in, ip, kv; extern /* Subroutine */ int adjusteskz_(integer *, integer *, real *); static integer iib, icm, ing, len; - static real esk, xnd; - static integer ivf, iiv; - static real wgr, pts; + static real esk; + static char udq[1]; + static real xnd; + static integer ivf; + static real wgr; + static integer iiv; + static real pts; static logical secondgrace; extern integer log2_(integer *); extern /* Subroutine */ int chkkbdrests_(integer *, integer *, integer *, @@ -24556,10 +39950,10 @@ L81: char *, integer *, ftnlen, ftnlen), docrd_(integer *, integer *, integer *, integer *, integer *, real *, char *, integer *, char * , integer *, integer *, integer *, integer *, logical *, integer * - , integer *, integer *, real *, logical *, integer *, ftnlen, - ftnlen), putcb_(integer *, integer *, char *, integer *, ftnlen), - beamn1_(char *, integer *, ftnlen), notex_(char *, integer *, - ftnlen); + , integer *, integer *, real *, logical *, integer *, integer *, + ftnlen, ftnlen), putcb_(integer *, integer *, char *, integer *, + ftnlen), beamn1_(char *, integer *, ftnlen), notex_(char *, + integer *, ftnlen); static logical iscacc; extern /* Subroutine */ int addask_(real *, real *, real *, real *, real * , real *, logical *); @@ -24610,7 +40004,7 @@ L81: static integer icashft; static real ptbneed; extern /* Subroutine */ int beamid_(char *, integer *, ftnlen); - static integer itleft, itendb; + static integer lineno, itleft; static real ptsneed; extern /* Subroutine */ int clefsym_(integer *, char *, integer *, integer *, ftnlen); @@ -24621,53 +40015,54 @@ L81: integer *, integer *, integer *, integer *, char *, integer *, logical *, ftnlen), setbits_(integer *, integer *, integer *, integer *); - static integer itright; + static integer itright, itendb; extern integer iashft_(integer *); static integer nolevc, ivlast; + static real wheadpt1; extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) ; - static real wheadpt1; static integer mtrspc; /* Fortran I/O blocks */ - static icilist io___975 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 }; - static icilist io___977 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 }; - static icilist io___978 = { 0, noteq, 0, "(i1)", 1, 1 }; - static cilist io___981 = { 0, 11, 0, "(a)", 0 }; - static cilist io___982 = { 0, 11, 0, "(a)", 0 }; - static cilist io___985 = { 0, 11, 0, "(a20,i1,a)", 0 }; - static cilist io___986 = { 0, 11, 0, "(a20,i2,a)", 0 }; - static cilist io___987 = { 0, 11, 0, "(a)", 0 }; - static icilist io___990 = { 0, soutq+8, 0, "(f4.1)", 4, 1 }; - static icilist io___991 = { 0, soutq+8, 0, "(f4.2)", 4, 1 }; - static icilist io___992 = { 0, soutq+10, 0, "(i2)", 2, 1 }; - static icilist io___993 = { 0, soutq+11, 0, "(i1)", 1, 1 }; - static cilist io___998 = { 0, 6, 0, 0, 0 }; - static cilist io___999 = { 0, 6, 0, 0, 0 }; - static cilist io___1019 = { 0, 6, 0, 0, 0 }; - static cilist io___1035 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1036 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1037 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1038 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1039 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1016 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 }; + static icilist io___1018 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 }; + static icilist io___1019 = { 0, noteq, 0, "(i1)", 1, 1 }; + static cilist io___1022 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1023 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1026 = { 0, 11, 0, "(a20,i1,a)", 0 }; + static cilist io___1027 = { 0, 11, 0, "(a20,i2,a)", 0 }; + static cilist io___1028 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1031 = { 0, soutq+8, 0, "(f4.1)", 4, 1 }; + static icilist io___1032 = { 0, soutq+8, 0, "(f4.2)", 4, 1 }; + static icilist io___1033 = { 0, soutq+10, 0, "(i2)", 2, 1 }; + static icilist io___1034 = { 0, soutq+11, 0, "(i1)", 1, 1 }; + static cilist io___1039 = { 0, 6, 0, 0, 0 }; static cilist io___1040 = { 0, 6, 0, 0, 0 }; - static cilist io___1041 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1042 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1043 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1047 = { 0, notexq+11, 0, "(i2)", 2, 1 }; - static icilist io___1053 = { 0, notexq+6, 0, "(f3.1)", 3, 1 }; - static icilist io___1054 = { 0, notexq+6, 0, "(f4.1)", 4, 1 }; - static icilist io___1056 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; - static icilist io___1057 = { 0, notexq+5, 0, "(f4.1)", 4, 1 }; - static cilist io___1059 = { 0, 6, 0, 0, 0 }; - static cilist io___1060 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1061 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1069 = { 0, notexq, 0, "(f4.1)", 79, 1 }; - static cilist io___1072 = { 0, 6, 0, 0, 0 }; - static cilist io___1085 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1088 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1091 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1093 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1060 = { 0, 6, 0, 0, 0 }; + static cilist io___1076 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1077 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1078 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1079 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1080 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1081 = { 0, 6, 0, 0, 0 }; + static cilist io___1082 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1083 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1084 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1088 = { 0, notexq+11, 0, "(i2)", 2, 1 }; + static icilist io___1094 = { 0, notexq+6, 0, "(f3.1)", 3, 1 }; + static icilist io___1095 = { 0, notexq+6, 0, "(f4.1)", 4, 1 }; + static icilist io___1097 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; + static icilist io___1098 = { 0, notexq+5, 0, "(f4.1)", 4, 1 }; + static cilist io___1100 = { 0, 6, 0, 0, 0 }; + static cilist io___1101 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1102 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1110 = { 0, notexq, 0, "(f4.1)", 79, 1 }; + static icilist io___1116 = { 0, noteq, 0, "(a1,i2,a1)", 8, 1 }; + static cilist io___1117 = { 0, 6, 0, 0, 0 }; + static cilist io___1130 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1133 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1136 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1138 = { 0, 11, 0, "(a)", 0 }; @@ -24675,234 +40070,419 @@ L81: /* In 1.04, moved to block data subprogram */ /* 130316 */ +#line 16964 "" /* Parameter adjustments */ +#line 16964 "" --clefq; +#line 16964 "" --istart; +#line 16964 "" --numbms; +#line 16964 "" --istop; +#line 16964 "" --squez; +#line 16964 "" --cwrest; +#line 16964 "" --tstart; +#line 16964 "" +#line 16964 "" /* Function Body */ +#line 16964 "" xjbeambrests_1.nbrests = 0; /* Set up main ib loop within which a block (notes group) is written */ +#line 16968 "" i__1 = all_1.nv; +#line 16968 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16969 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 16969 "" for (kv = 1; kv <= i__2; ++kv) { +#line 16970 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 16971 "" all_1.ibmcnt[commvl_1.ivx - 1] = 1; +#line 16972 "" ibmcnt1[commvl_1.ivx - 1] = 1; +#line 16973 "" all_1.beamon[commvl_1.ivx - 1] = FALSE_; +#line 16974 "" beamon1[commvl_1.ivx - 1] = FALSE_; +#line 16975 "" nornb[commvl_1.ivx - 1] = 0; +#line 16976 "" iaskb[commvl_1.ivx - 1] = 1; +#line 16977 "" comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; +#line 16978 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 16979 "" /* L25: */ +#line 16979 "" } +#line 16979 "" } +#line 16980 "" comas1_1.naskb = 0; +#line 16981 "" ifig[0] = 1; +#line 16982 "" ifig[1] = 1; +#line 16983 "" comxtup_1.ixtup = 0; +#line 16984 "" bspend = FALSE_; +#line 16985 "" iscwr = FALSE_; +#line 16986 "" rpndot = FALSE_; +#line 16987 "" i__2 = comnsp_2.nb; +#line 16987 "" for (ib = 1; ib <= i__2; ++ib) { /* Check for segno */ +#line 16991 "" if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) && all_1.ivxo[istart[ib] - 1] == 1) { +#line 16993 "" if (comgrace_1.noffseg <= -10) { - s_wsfi(&io___975); +#line 16994 "" + s_wsfi(&io___1016); +#line 16994 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); +#line 16994 "" e_wsfi(); +#line 16995 "" lnoten = 5; +#line 16996 "" } else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) { - s_wsfi(&io___977); +#line 16997 "" + s_wsfi(&io___1018); +#line 16997 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); +#line 16997 "" e_wsfi(); +#line 16998 "" lnoten = 4; +#line 16999 "" } else { - s_wsfi(&io___978); +#line 17000 "" + s_wsfi(&io___1019); +#line 17000 "" do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( integer)); +#line 17000 "" e_wsfi(); +#line 17001 "" lnoten = 1; +#line 17002 "" } /* Writing concatenation */ +#line 17003 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 17003 "" i__3[1] = 6, a__1[1] = "znotes"; +#line 17003 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 17003 "" i__3[3] = 6, a__1[3] = "segnoo"; +#line 17003 "" i__3[4] = lnoten, a__1[4] = noteq; +#line 17003 "" i__3[5] = 1, a__1[5] = "9"; +#line 17003 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 17004 "" lnote = lnoten + 15; +#line 17005 "" i__1 = all_1.nv; +#line 17005 "" for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) { +#line 17006 "" if (lnote > 60) { +#line 17007 "" if (comlast_1.islast) { - s_wsfe(&io___981); +#line 17007 "" + s_wsfe(&io___1022); /* Writing concatenation */ +#line 17007 "" i__4[0] = lnote, a__2[0] = notexq; +#line 17007 "" i__4[1] = 1, a__2[1] = "%"; +#line 17007 "" s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80); +#line 17007 "" do_fio(&c__1, ch__1, lnote + 1); +#line 17007 "" e_wsfe(); +#line 17007 "" } /* Writing concatenation */ +#line 17008 "" i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2); +#line 17008 "" i__5[1] = 1, a__3[1] = all_1.sq; +#line 17008 "" i__5[2] = 6, a__3[2] = "segnoo"; +#line 17008 "" i__5[3] = lnoten, a__3[3] = noteq; +#line 17008 "" i__5[4] = 1, a__3[4] = "9"; +#line 17008 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 17010 "" lnote = lnoten + 9; +#line 17011 "" } else { /* Writing concatenation */ +#line 17012 "" i__3[0] = lnote, a__1[0] = notexq; +#line 17012 "" i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2); +#line 17012 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 17012 "" i__3[3] = 6, a__1[3] = "segnoo"; +#line 17012 "" i__3[4] = lnoten, a__1[4] = noteq; +#line 17012 "" i__3[5] = 1, a__1[5] = "9"; +#line 17012 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 17014 "" lnote = lnote + lnoten + 9; +#line 17015 "" } +#line 17016 "" /* L130: */ +#line 17016 "" } +#line 17017 "" if (comlast_1.islast) { - s_wsfe(&io___982); +#line 17017 "" + s_wsfe(&io___1023); /* Writing concatenation */ +#line 17017 "" i__6[0] = lnote, a__4[0] = notexq; +#line 17017 "" i__6[1] = 1, a__4[1] = all_1.sq; +#line 17017 "" i__6[2] = 2, a__4[2] = "en"; +#line 17017 "" s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); +#line 17017 "" do_fio(&c__1, ch__2, lnote + 3); +#line 17017 "" e_wsfe(); +#line 17017 "" } +#line 17018 "" lnote = 0; +#line 17019 "" } /* Check for new clefs */ +#line 17023 "" isclef = FALSE_; +#line 17024 "" if (bit_test(all_1.islur[all_1.ivxo[istart[ib] - 1] + all_1.ipo[ istart[ib] - 1] * 24 - 25],15)) { /* In preceding line, fl32 gave wrong result for ... .gt.0 !!! */ +#line 17029 "" i__1 = istop[ib]; +#line 17029 "" for (in = istart[ib]; in <= i__1; ++in) { +#line 17030 "" if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],11)) { +#line 17031 "" i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7; +#line 17031 "" wsclef_(&all_1.ivxo[in - 1], ninow, &i__7); /* If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% */ /* if (clefq(ivxo(in)) .eq. '8') then */ +#line 17037 "" if (bit_test(all_1.ipl[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25],2)) { +#line 17038 "" if (all_1.iv <= 9) { - s_wsfe(&io___985); +#line 17039 "" + s_wsfe(&io___1026); /* Writing concatenation */ +#line 17039 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17039 "" i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; +#line 17039 "" s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); +#line 17039 "" do_fio(&c__1, ch__3, (ftnlen)20); - do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( +#line 17039 "" + do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 17039 "" i__8[0] = 1, a__5[0] = all_1.sq; +#line 17039 "" i__8[1] = 13, a__5[1] = "treblelowoct%"; +#line 17039 "" s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); +#line 17039 "" do_fio(&c__1, ch__4, (ftnlen)14); +#line 17039 "" e_wsfe(); +#line 17041 "" } else { - s_wsfe(&io___986); +#line 17042 "" + s_wsfe(&io___1027); /* Writing concatenation */ +#line 17042 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17042 "" i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; +#line 17042 "" s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); +#line 17042 "" do_fio(&c__1, ch__3, (ftnlen)20); - do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( +#line 17042 "" + do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 17042 "" i__8[0] = 1, a__5[0] = all_1.sq; +#line 17042 "" i__8[1] = 13, a__5[1] = "treblelowoct%"; +#line 17042 "" s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); +#line 17042 "" do_fio(&c__1, ch__4, (ftnlen)14); +#line 17042 "" e_wsfe(); +#line 17044 "" } +#line 17045 "" } +#line 17046 "" } +#line 17047 "" /* L140: */ +#line 17047 "" } +#line 17048 "" if (comlast_1.islast) { - s_wsfe(&io___987); +#line 17048 "" + s_wsfe(&io___1028); /* Writing concatenation */ +#line 17048 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17048 "" i__4[1] = 11, a__2[1] = "pmxnewclefs"; +#line 17048 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 17048 "" do_fio(&c__1, ch__5, (ftnlen)12); +#line 17048 "" e_wsfe(); +#line 17048 "" } +#line 17049 "" isclef = TRUE_; +#line 17050 "" } /* Start a notes group. We're just gonna define every one using pnotes{n}, */ /* where \def\pnotes#1{\vnotes#1\elemskip} */ /* Writing concatenation */ +#line 17055 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17055 "" i__4[1] = 7, a__2[1] = "pnotes{"; +#line 17055 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 17056 "" r__1 = comnsp_2.space[ib - 1] / squez[ib]; +#line 17056 "" eonsqz = squez[ib] * feon_(&r__1); +#line 17057 "" if (eonsqz > 9.995f) { - s_wsfi(&io___990); +#line 17058 "" + s_wsfi(&io___1031); +#line 17058 "" do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); +#line 17058 "" e_wsfi(); +#line 17059 "" } else if (eonsqz > .995f) { - s_wsfi(&io___991); +#line 17060 "" + s_wsfi(&io___1032); +#line 17060 "" do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); +#line 17060 "" e_wsfi(); +#line 17061 "" } else if (eonsqz > .095f) { /* Writing concatenation */ +#line 17062 "" i__4[0] = 8, a__2[0] = soutq; +#line 17062 "" i__4[1] = 2, a__2[1] = "0."; +#line 17062 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); - s_wsfi(&io___992); +#line 17063 "" + s_wsfi(&io___1033); +#line 17063 "" r__1 = eonsqz * 100; +#line 17063 "" i__1 = i_nint(&r__1); +#line 17063 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 17063 "" e_wsfi(); +#line 17064 "" } else { /* Writing concatenation */ +#line 17065 "" i__4[0] = 8, a__2[0] = soutq; +#line 17065 "" i__4[1] = 3, a__2[1] = "0.0"; +#line 17065 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); - s_wsfi(&io___993); +#line 17066 "" + s_wsfi(&io___1034); +#line 17066 "" r__1 = eonsqz * 100; +#line 17066 "" i__1 = i_nint(&r__1); +#line 17066 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 17066 "" e_wsfi(); +#line 17067 "" } /* Writing concatenation */ +#line 17068 "" i__4[0] = 12, a__2[0] = soutq; +#line 17068 "" i__4[1] = 1, a__2[1] = "}"; +#line 17068 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 17069 "" lsout = 13; /* Check whole block, flag accidentals etc that are too close, one per *time*. */ @@ -24910,52 +40490,87 @@ L81: /* (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */ /* (dotsfac*wheadpt) is presumed to be filled up. */ +#line 17076 "" in = istart[ib] - 1; +#line 17077 "" itrpt = -1; +#line 17078 "" itsig = -1; /* Begin big manual loop over notes in this block; ends at 112 */ +#line 17082 "" L111: +#line 17082 "" ++in; +#line 17083 "" if (in > istop[ib]) { +#line 17083 "" goto L112; +#line 17083 "" } +#line 17084 "" ip = all_1.ipo[in - 1]; +#line 17085 "" commvl_1.ivx = all_1.ivxo[in - 1]; +#line 17086 "" if (commvl_1.ivx <= all_1.nv) { +#line 17087 "" all_1.iv = commvl_1.ivx; +#line 17088 "" } else { +#line 17089 "" i__1 = all_1.nv; +#line 17089 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 17090 "" if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[ all_1.iv + 23] == commvl_1.ivx) { +#line 17090 "" goto L129; +#line 17090 "" } +#line 17091 "" /* L128: */ +#line 17091 "" } - s_wsle(&io___998); +#line 17092 "" + s_wsle(&io___1039); +#line 17092 "" do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", ( ftnlen)35); +#line 17092 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( integer)); +#line 17092 "" do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof( integer)); +#line 17092 "" do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof( integer)); +#line 17092 "" e_wsle(); - s_wsle(&io___999); +#line 17093 "" + s_wsle(&io___1040); +#line 17093 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof( integer)); +#line 17093 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof( integer)); +#line 17093 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof( integer)); +#line 17093 "" do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof( integer)); +#line 17093 "" e_wsle(); +#line 17094 "" s_stop("", (ftnlen)0); +#line 17095 "" } +#line 17096 "" L129: /* Call precrd here so we know how much space to add for accid's in chords */ @@ -24969,47 +40584,65 @@ L129: /* * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */ /* * btest(nacc(ivx,ip),21)) then */ /* if (.not.btest(irest(ivx,ip),24)) then */ +#line 17109 "" if (numbms[commvl_1.ivx] > 0 && ibmcnt1[commvl_1.ivx - 1] <= numbms[ commvl_1.ivx] && all_1.ibm1[commvl_1.ivx + ibmcnt1[ commvl_1.ivx - 1] * 24 - 25] == ip) { +#line 17111 "" beamon1[commvl_1.ivx - 1] = TRUE_; +#line 17112 "" } +#line 17113 "" icashft = 0; +#line 17114 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. */ +#line 17118 "" if (beamon1[commvl_1.ivx - 1]) { +#line 17119 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], & all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[ commvl_1.ivx + ip * 24 - 25], all_1.ulq + ( commvl_1.ivx + ibmcnt1[commvl_1.ivx - 1] * 24 - 25), & c_false, &icashft, (ftnlen)1); +#line 17122 "" } else { +#line 17123 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 17123 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); +#line 17123 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], & all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[ commvl_1.ivx + ip * 24 - 25], ch__6, &c_false, & icashft, (ftnlen)1); +#line 17127 "" } +#line 17128 "" } /* Turn beam off? */ +#line 17132 "" if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[ commvl_1.ivx - 1] * 24 - 25] == ip) { +#line 17133 "" beamon1[commvl_1.ivx - 1] = FALSE_; +#line 17134 "" ++ibmcnt1[commvl_1.ivx - 1]; +#line 17135 "" } /* Remember, rpts & internal sigs can only come at start of (internal) block */ +#line 17139 "" isacc = (all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10); @@ -25018,6 +40651,7 @@ L129: /* !!! Need to do this for chord notes too. Maybe in chkarp? */ +#line 17147 "" isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0); /* 5/15/02 Add check for ) ornament of prior note. */ @@ -25025,100 +40659,154 @@ L129: /* if (ip .gt. 1) then */ /* isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */ /* end if */ +#line 17154 "" isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27); +#line 17155 "" iscacc = FALSE_; +#line 17156 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord here; check for arpeggios and accidentals. Note accid shifts are */ /* not of concern here, only whether there's an accid, whick causes iscacc=.true. */ +#line 17161 "" iscacc = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__3, &c__0) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17); +#line 17163 "" chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, & iscacc, &isarp); +#line 17164 "" } /* When we get motivated, will do spacing for arpeggios here. */ +#line 17168 "" if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] & 96) > 0) { +#line 17168 "" itrpt = i_nint(&all_1.to[in - 1]); +#line 17168 "" } +#line 17170 "" issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28); +#line 17171 "" if (commvl_1.ivx == 1 && issig) { +#line 17171 "" itsig = i_nint(&all_1.to[in - 1]); +#line 17171 "" } +#line 17172 "" isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31); +#line 17174 "" isgaft = FALSE_; +#line 17175 "" if (ip > 1) { +#line 17176 "" xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 - 25] - 1]; +#line 17177 "" isgaft = bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25], 31); +#line 17178 "" isgrace = isgrace || isgaft; +#line 17179 "" } +#line 17180 "" iscln = isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 11); /* Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd */ +#line 17184 "" isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol; +#line 17185 "" if (isflag) { +#line 17185 "" i__7 = ip - 1; +#line 17185 "" i__1 = ncmid_(&all_1.iv, &i__7); +#line 17185 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + (ip - 1) * 24 - 25], &i__1, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); +#line 17185 "" isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25] ,0) && *(unsigned char *)&ch__6[0] == 'u'; +#line 17185 "" } +#line 17189 "" if (isflag) { +#line 17190 "" i__1 = numbms[commvl_1.ivx]; +#line 17190 "" for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) { +#line 17191 "" if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) { +#line 17192 "" goto L117; /* Add check for non-beamed xtuplets. May be problem with stem direction. */ +#line 17196 "" } else if (ip - 1 <= all_1.ibm2[commvl_1.ivx + ibmchk * 24 - 25] && ! bit_test(all_1.islur[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25] * 24 - 25] ,18)) { +#line 17198 "" isflag = FALSE_; +#line 17199 "" goto L117; +#line 17200 "" } +#line 17201 "" /* L116: */ +#line 17201 "" } +#line 17202 "" } +#line 17203 "" L117: /* If isflag, then won't need to check for dot on prev. note. */ /* 5/16/02 ??? Try using this for ) ornament. */ +#line 17209 "" isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24 - 1],13); +#line 17210 "" isdot = ip > 1; +#line 17211 "" if (isdot) { +#line 17211 "" i__1 = ip - 1; +#line 17211 "" isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1); +#line 17211 "" } +#line 17212 "" isrshft = ip > 1; +#line 17213 "" if (isrshft) { +#line 17213 "" isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], 20); +#line 17213 "" } +#line 17214 "" if (! (isaccs || isgrace || iscln || isflag || isrshft || isdot || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],21) || isarp || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27) || iscacc)) { +#line 17214 "" goto L111; +#line 17214 "" } /* Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */ @@ -25126,42 +40814,71 @@ L117: /* 130324 */ /* wheadpt1 = wheadpt*fullsize(iv) */ +#line 17224 "" wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[ all_1.iv - 1] - 1]; +#line 17225 "" pts = wheadpt1; /* Set up for possible cautionary accidental here */ +#line 17229 "" if (isaccs || iscacc) { +#line 17230 "" if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) { +#line 17231 "" taccfac = spfacs_1.accfac; +#line 17232 "" } else { +#line 17233 "" taccfac = spfacs_1.accfac * 1.4f; /* cautionary accidental */ +#line 17234 "" } +#line 17235 "" } +#line 17236 "" if (isgrace) { +#line 17237 "" secondgrace = FALSE_; +#line 17238 "" i__1 = comgrace_1.ngrace; +#line 17238 "" for (ig = 1; ig <= i__1; ++ig) { +#line 17239 "" if (! isgaft) { +#line 17240 "" if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { +#line 17240 "" goto L123; +#line 17240 "" } +#line 17241 "" } else if (ip > 1) { +#line 17242 "" if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { +#line 17242 "" goto L123; +#line 17242 "" } +#line 17243 "" } +#line 17244 "" /* L122: */ +#line 17244 "" } - s_wsle(&io___1019); +#line 17245 "" + s_wsle(&io___1060); +#line 17245 "" do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", ( ftnlen)39); +#line 17245 "" e_wsle(); +#line 17246 "" s_stop("", (ftnlen)0); +#line 17247 "" L123: /* wgr = distance to backspace (in headwidths), less main acc. */ @@ -25169,87 +40886,146 @@ L123: /* spgr = total space needed (w/o main acc). */ /* Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. */ +#line 17254 "" if (comgrace_1.nng[ig - 1] == 1) { +#line 17255 "" wgr = spfacs_1.grafac; +#line 17256 "" if (comgrace_1.multg[ig - 1] == 0) { +#line 17256 "" wgr += -.4f; +#line 17256 "" } +#line 17257 "" } else { +#line 17258 "" wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; +#line 17259 "" i__1 = comgrace_1.nng[ig - 1]; +#line 17259 "" for (ing = 2; ing <= i__1; ++ing) { +#line 17260 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing - 1] > 0) { +#line 17260 "" wgr += spfacs_1.acgfac; +#line 17260 "" } +#line 17261 "" /* L126: */ +#line 17261 "" } +#line 17262 "" } +#line 17263 "" if (comgrace_1.graspace[ig - 1] > 0.f) { /* User-defined space before grace */ +#line 17267 "" wgr += comgrace_1.graspace[ig - 1]; +#line 17268 "" } +#line 17269 "" ptgr[ig - 1] = wgr * wheadpt1; +#line 17270 "" spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1; /* !!! May need to mod for chord accid's */ +#line 17274 "" if (isaccs || iscacc) { +#line 17274 "" ptgr[ig - 1] += taccfac * wheadpt1; +#line 17274 "" } +#line 17275 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) { +#line 17275 "" spgr += wheadpt1 * spfacs_1.agc1fac; +#line 17275 "" } +#line 17276 "" pts += spgr; /* Special check for after-grace on ip-1 and normal on ip. Must go back thru */ /* loop again for the normal grace. */ +#line 17281 "" if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) { +#line 17282 "" if (comgrace_1.ipg[ig] == ip) { +#line 17283 "" secondgrace = TRUE_; +#line 17284 "" ++ig; +#line 17285 "" goto L123; +#line 17286 "" } +#line 17287 "" } +#line 17288 "" } +#line 17289 "" if (iscln) { +#line 17290 "" pts += spfacs_1.clefac * wheadpt1; /* How far to backspace when printing the clef */ +#line 17294 "" ptclef[commvl_1.ivx - 1] = 0.f; /* !!! May need to mod for chord accid's */ +#line 17298 "" if (isaccs || iscacc) { +#line 17298 "" ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1; +#line 17298 "" } +#line 17300 "" if (isgrace) { +#line 17300 "" ptclef[commvl_1.ivx - 1] += spgr; +#line 17300 "" } +#line 17301 "" } +#line 17302 "" if (isrshft) { +#line 17303 "" pts += spfacs_1.rtshfac * wheadpt1; +#line 17304 "" } else if (isflag) { +#line 17305 "" pts += spfacs_1.flagfac * wheadpt1; +#line 17306 "" } else if (isdot) { +#line 17307 "" pts += spfacs_1.dotfac * wheadpt1; +#line 17308 "" } +#line 17309 "" if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) { /* Repeat, need a little extra space */ +#line 17313 "" pts += spfacs_1.dotsfac * wheadpt1; +#line 17314 "" } +#line 17315 "" if (isarp) { +#line 17316 "" pts += spfacs_1.arpfac * wheadpt1; +#line 17317 "" } /* Add in padding space */ +#line 17321 "" pts += spfacs_1.xspfac * wheadpt1; /* Now done with all items needing space except accidentals, */ @@ -25258,26 +41034,37 @@ L123: /* Get available space in elemskips (esk) */ +#line 17329 "" isfirst = ip == 1 || (r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol || (r__2 = all_1.to[in - 1] - itsig, dabs(r__2)) < comtol_1.tol; +#line 17331 "" if (isfirst) { /* At start of bar or after repeat sign or new signature */ +#line 17335 "" if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol) { +#line 17336 "" esk = 0.f; +#line 17337 "" } else { +#line 17338 "" esk = comask_1.fbar; +#line 17339 "" } +#line 17340 "" } else { /* Not 1st note of bar */ +#line 17344 "" esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ commvl_1.ivx + (ip - 1) * 24 - 25]; +#line 17345 "" } +#line 17346 "" if (isgrace) { /* Since graces can be very long, cannot assume no interference if prior */ @@ -25287,647 +41074,1059 @@ L123: /* 10/8/05 Kluge to not zero out esk if in xtup */ +#line 17355 "" esksav = esk; /* Computing MAX */ +#line 17356 "" i__1 = 1, i__7 = ip - 2; +#line 17356 "" if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__1,i__7) * 24 - 25] > 0) && (r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) > comtol_1.tol) { +#line 17356 "" eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[ 1], &comask_1.fbar, &itrpt, &esk); +#line 17356 "" } /* * to(in).ne.itsig) */ +#line 17360 "" if (dabs(esk) < comtol_1.tol) { +#line 17360 "" esk = esksav; +#line 17360 "" } +#line 17361 "" } /* Done getting available elemskips. Remove headwidth if first. Must do here */ /* rather than earlier since check uses isfirst */ +#line 17366 "" if (isfirst) { +#line 17366 "" pts -= wheadpt1; +#line 17366 "" } /* Deal with accidental shifts and left-notehead shifts */ +#line 17370 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* In a chord */ +#line 17374 "" ptsl = 0.f; +#line 17375 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) { +#line 17375 "" ptsl = wheadpt1; +#line 17375 "" } /* Computing MAX */ +#line 17376 "" r__1 = ptsl, r__2 = icashft * .05f * wheadpt1; +#line 17376 "" ptsadd = dmax(r__1,r__2); /* Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */ +#line 17380 "" } else { /* Not in a chord */ +#line 17384 "" ihshft = 0; +#line 17385 "" if (isaccs) { +#line 17386 "" ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & c__7, &c__10); /* if (ihshft .ne. 0) ihshft = max(0,64-ihshft) */ +#line 17388 "" if (ihshft != 0) { /* Computing MAX */ +#line 17388 "" i__1 = 0, i__7 = 107 - ihshft; +#line 17388 "" ihshft = max(i__1,i__7); +#line 17388 "" } +#line 17389 "" } /* Check for left-shifted main note */ +#line 17393 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { +#line 17393 "" ihshft = max(20,ihshft); +#line 17393 "" } +#line 17394 "" ptsadd = ihshft * .05f * wheadpt1; +#line 17395 "" } +#line 17396 "" pts += ptsadd; +#line 17397 "" if (isgrace) { +#line 17397 "" ptgr[ig - 1] += ptsadd; +#line 17397 "" } +#line 17398 "" if (iscln) { +#line 17398 "" ptclef[commvl_1.ivx - 1] += ptsadd; +#line 17398 "" } /* Left-shifted, non-chord note before? */ +#line 17402 "" if (ip > 1) { +#line 17403 "" if (! bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],10) && bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], 27)) { +#line 17403 "" pts -= wheadpt1; +#line 17403 "" } +#line 17405 "" } /* Try big accidentals first */ +#line 17409 "" ptbneed = pts; +#line 17410 "" if (isaccs || iscacc) { +#line 17411 "" ptbneed += wheadpt1 * spfacs_1.bacfac; +#line 17412 "" } +#line 17413 "" if (comask_1.poenom * esk > ptbneed) { /* Set flag for big accidental */ +#line 17417 "" if (isacc) { +#line 17417 "" all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],3); +#line 17417 "" } +#line 17418 "" goto L99; +#line 17419 "" } /* Cannot use big, so try small */ +#line 17423 "" ptsneed = pts; +#line 17424 "" if (isaccs || iscacc) { +#line 17425 "" ptsneed += taccfac * wheadpt1; +#line 17426 "" } +/* if (poenom*esk .lt. ptsneed) call addask(to(in),ptsneed, */ +/* * esk,fixednew,scaldold,0.,.false.) */ +#line 17429 "" if (comask_1.poenom * esk < ptsneed) { +#line 17430 "" addask_(&all_1.to[in - 1], &ptsneed, &esk, &comask_1.fixednew, & - comask_1.scaldold, &c_b774, &c_false); + comask_1.scaldold, &c_b1009, &c_false); +#line 17432 "" } +#line 17433 "" L99: +#line 17434 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) { /* User-defined space. Warning, "zero" may change value in addask! */ +#line 17438 "" zero = 0.f; +#line 17439 "" addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, & comask_1.scaldold, tglp1, &c_true); +#line 17441 "" } /* End of big manual loop over "in" for accidental checking */ +#line 17445 "" goto L111; +#line 17446 "" L112: /* End of ask analysis for this block. */ /* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */ +#line 17452 "" if (comas1_1.naskb > 0) { +#line 17452 "" adjusteskz_(&ib, &istart[1], &comask_1.poenom); +#line 17452 "" } /* Check for internal repeat or sig change. */ +#line 17456 "" if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) { +#line 17457 "" iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] & 67109216; +#line 17458 "" if (iirpt > 0) { /* Internal repeat */ +#line 17462 "" if (comlast_1.islast) { - s_wsfe(&io___1035); +#line 17462 "" + s_wsfe(&io___1076); /* Writing concatenation */ +#line 17462 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 17462 "" i__9[1] = 7, a__6[1] = "advance"; +#line 17462 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 17462 "" i__9[3] = 8, a__6[3] = "barno-1%"; +#line 17462 "" s_cat(ch__7, a__6, i__9, &c__4, (ftnlen)17); +#line 17462 "" do_fio(&c__1, ch__7, (ftnlen)17); +#line 17462 "" e_wsfe(); +#line 17462 "" } +#line 17463 "" if (iirpt == 96) { +#line 17464 "" if (comlast_1.islast) { - s_wsfe(&io___1036); +#line 17464 "" + s_wsfe(&io___1077); /* Writing concatenation */ +#line 17464 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17464 "" i__4[1] = 15, a__2[1] = "leftrightrepeat"; +#line 17464 "" s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)16); +#line 17464 "" do_fio(&c__1, ch__8, (ftnlen)16); +#line 17464 "" e_wsfe(); +#line 17464 "" } +#line 17465 "" comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt; +#line 17466 "" } else if (bit_test(iirpt,5)) { +#line 17467 "" if (comlast_1.islast) { - s_wsfe(&io___1037); +#line 17467 "" + s_wsfe(&io___1078); /* Writing concatenation */ +#line 17467 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17467 "" i__4[1] = 10, a__2[1] = "leftrepeat"; +#line 17467 "" s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); +#line 17467 "" do_fio(&c__1, ch__9, (ftnlen)11); +#line 17467 "" e_wsfe(); +#line 17467 "" } +#line 17468 "" comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; +#line 17469 "" } else if (bit_test(iirpt,6)) { +#line 17470 "" if (comlast_1.islast) { - s_wsfe(&io___1038); +#line 17470 "" + s_wsfe(&io___1079); /* Writing concatenation */ +#line 17470 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17470 "" i__4[1] = 11, a__2[1] = "rightrepeat"; +#line 17470 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 17470 "" do_fio(&c__1, ch__5, (ftnlen)12); +#line 17470 "" e_wsfe(); +#line 17470 "" } +#line 17471 "" comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; +#line 17472 "" } else if (bit_test(iirpt,8)) { +#line 17473 "" if (comlast_1.islast) { - s_wsfe(&io___1039); +#line 17473 "" + s_wsfe(&io___1080); /* Writing concatenation */ +#line 17473 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17473 "" i__4[1] = 9, a__2[1] = "doublebar"; +#line 17473 "" s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); +#line 17473 "" do_fio(&c__1, ch__10, (ftnlen)10); +#line 17473 "" e_wsfe(); +#line 17473 "" } +#line 17474 "" } else { - s_wsle(&io___1040); - do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command " +#line 17475 "" + s_wsle(&io___1081); +#line 17475 "" + do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "\ "R*", (ftnlen)36); +#line 17475 "" e_wsle(); +#line 17476 "" stop1_(); +#line 17477 "" } +#line 17478 "" comask_1.scaldold -= comask_1.fbar; +#line 17479 "" } +#line 17480 "" if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) { /* Internal signature change. */ /* Writing concatenation */ +#line 17484 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17484 "" i__4[1] = 17, a__2[1] = "generalsignature{"; +#line 17484 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17485 "" lnote = 18; +#line 17486 "" if (comtop_1.isig < 0) { /* Writing concatenation */ +#line 17487 "" i__4[0] = lnote, a__2[0] = notexq; +#line 17487 "" i__4[1] = 1, a__2[1] = "-"; +#line 17487 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17488 "" ++lnote; +#line 17489 "" } +#line 17490 "" if (comlast_1.islast) { - s_wsfe(&io___1041); +#line 17490 "" + s_wsfe(&io___1082); /* Writing concatenation */ +#line 17490 "" i__6[0] = lnote, a__4[0] = notexq; +#line 17490 "" i__1 = abs(comtop_1.isig) + 48; +#line 17490 "" chax_(ch__6, (ftnlen)1, &i__1); +#line 17490 "" i__6[1] = 1, a__4[1] = ch__6; +#line 17490 "" i__6[2] = 2, a__4[2] = "}%"; +#line 17490 "" s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); +#line 17490 "" do_fio(&c__1, ch__2, lnote + 3); +#line 17490 "" e_wsfe(); +#line 17490 "" } +#line 17492 "" if (comlast_1.islast && comignorenats_1.ignorenats) { - s_wsfe(&io___1042); +#line 17492 "" + s_wsfe(&io___1083); /* Writing concatenation */ +#line 17492 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17492 "" i__4[1] = 11, a__2[1] = "ignorenats%"; +#line 17492 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 17492 "" do_fio(&c__1, ch__5, (ftnlen)12); +#line 17492 "" e_wsfe(); +#line 17492 "" } +#line 17494 "" if (comlast_1.islast) { - s_wsfe(&io___1043); +#line 17494 "" + s_wsfe(&io___1084); /* Writing concatenation */ +#line 17494 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 17494 "" i__3[1] = 14, a__1[1] = "zchangecontext"; +#line 17494 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 17494 "" i__3[3] = 12, a__1[3] = "addspace{-.5"; +#line 17494 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 17494 "" i__3[5] = 15, a__1[5] = "afterruleskip}%"; +#line 17494 "" s_cat(ch__11, a__1, i__3, &c__6, (ftnlen)44); +#line 17494 "" do_fio(&c__1, ch__11, (ftnlen)44); +#line 17494 "" e_wsfe(); +#line 17494 "" } +#line 17496 "" lnote = 0; +#line 17497 "" } +#line 17498 "" } +#line 17499 "" comnsp_2.flgndb = FALSE_; /* Done with start-of-block stuff. Begin main loop over voices. */ +#line 17503 "" i__1 = all_1.nv; +#line 17503 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 17504 "" i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 17504 "" for (kv = 1; kv <= i__7; ++kv) { +#line 17505 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 17506 "" icm = commidi_1.midchan[all_1.iv + kv * 24 - 25]; /* A rather klugey way to set flag for figure in this voice */ /* Must always check figbass before figchk. */ +#line 17511 "" if (all_1.figbass) { +#line 17512 "" ivf = 0; +#line 17513 "" if (commvl_1.ivx == 1) { +#line 17514 "" ivf = 1; +#line 17515 "" } else if (commvl_1.ivx == comfig_1.ivxfig2) { +#line 17516 "" ivf = 2; +#line 17517 "" } +#line 17518 "" if (ivf > 0) { +#line 17518 "" all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0; +#line 17518 "" } +#line 17519 "" } +#line 17520 "" if (commvl_1.ivx > 1) { +#line 17521 "" if (commvl_1.ivx <= all_1.nv) { +#line 17522 "" addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 17523 "" } else { /* Writing concatenation */ +#line 17524 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17524 "" i__4[1] = 9, a__2[1] = "nextvoice"; +#line 17524 "" s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); +#line 17524 "" addstr_(ch__10, &c__10, soutq, &lsout, (ftnlen)10, ( ftnlen)80); +#line 17525 "" } +#line 17526 "" } +#line 17527 "" if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) { /* Write header. First adjust height if needed to miss barno. */ +#line 17531 "" if (comask_1.bar1syst && all_1.iline != 1) { +#line 17532 "" comhead_1.ihdht = comsln_1.irzbnd + 15 + comsln_1.isnx; +#line 17533 "" } /* Add user-defined vertical shift */ +#line 17537 "" comhead_1.ihdht += comhead_1.ihdvrt; +#line 17538 "" lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80); /* Writing concatenation */ +#line 17539 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17539 "" i__4[1] = 10, a__2[1] = "zcharnote{"; +#line 17539 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); - s_wsfi(&io___1047); +#line 17540 "" + s_wsfi(&io___1088); +#line 17540 "" do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof( integer)); +#line 17540 "" e_wsfi(); /* Writing concatenation */ +#line 17541 "" i__3[0] = 13, a__1[0] = notexq; +#line 17541 "" i__3[1] = 2, a__1[1] = "}{"; +#line 17541 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 17541 "" i__3[3] = 7, a__1[3] = "bigfont"; +#line 17541 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 17541 "" i__3[5] = 10, a__1[5] = "kern-30pt "; +#line 17541 "" s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 17542 "" addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, ( ftnlen)80); /* Writing concatenation */ +#line 17543 "" i__4[0] = lchead, a__2[0] = comhead_1.headrq; +#line 17543 "" i__4[1] = 1, a__2[1] = "}"; +#line 17543 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 17543 "" i__10 = lchead + 1; +#line 17543 "" addstr_(ch__12, &i__10, soutq, &lsout, lchead + 1, ( ftnlen)80); +#line 17544 "" comhead_1.ihdht = 0; +#line 17545 "" } +#line 17546 "" if (comhead_1.lower && commvl_1.ivx == all_1.nv) { +#line 17547 "" lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80); /* Writing concatenation */ +#line 17548 "" i__11[0] = 1, a__7[0] = all_1.sq; +#line 17548 "" i__11[1] = 14, a__7[1] = "zcharnote{-6}{"; +#line 17548 "" i__11[2] = 1, a__7[2] = all_1.sq; +#line 17548 "" i__11[3] = 5, a__7[3] = "tempo"; +#line 17548 "" i__11[4] = 1, a__7[4] = all_1.sq; +#line 17548 "" i__11[5] = 10, a__7[5] = "kern-10pt "; +#line 17548 "" i__11[6] = lclow, a__7[6] = comhead_1.lowerq; +#line 17548 "" i__11[7] = 1, a__7[7] = "}"; +#line 17548 "" s_cat(ch__13, a__7, i__11, &c__8, (ftnlen)113); +#line 17548 "" i__10 = lclow + 33; +#line 17548 "" addstr_(ch__13, &i__10, soutq, &lsout, lclow + 33, ( ftnlen)80); +#line 17551 "" comhead_1.lower = FALSE_; +#line 17552 "" } +#line 17553 "" tnow = tstart[ib]; +#line 17554 "" nofirst = TRUE_; /* Done setting up voice ivx for start of block ib. Loop over notes in voice. */ +#line 17558 "" i__10 = istop[ib]; +#line 17558 "" for (all_1.jn = istart[ib]; all_1.jn <= i__10; ++all_1.jn) { +#line 17559 "" if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) { +#line 17559 "" goto L10; +#line 17559 "" } +#line 17560 "" ip = all_1.ipo[all_1.jn - 1]; /* May have problem with not initializing islhgt, so do it here */ +#line 17564 "" islhgt = 0; +#line 17566 "" if (nofirst) { +#line 17567 "" comoct_1.noctup = 0; +#line 17568 "" if (ncmid_(&all_1.iv, &ip) == 23) { +#line 17568 "" comoct_1.noctup = -2; +#line 17568 "" } +#line 17569 "" nofirst = FALSE_; +#line 17570 "" } /* Check for internal floating figure (before last note of group). */ +#line 17574 "" L12: +#line 17574 "" if (all_1.figbass) { +#line 17575 "" if (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { +#line 17576 "" ivf = 1; +#line 17577 "" if (commvl_1.ivx > 1) { +#line 17577 "" ivf = 2; +#line 17577 "" } +#line 17578 "" if (all_1.figchk[ivf - 1] && (real) comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3] < tnow - comtol_1.tol) { /* Bypassed figure location. Backup, place fig, return. */ +#line 17583 "" offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ ivf - 1] << 1) - 3]) / comnsp_2.space[ ib - 1]; +#line 17584 "" putfig_(&ivf, &ifig[ivf - 1], &offnsk, & all_1.figchk[ivf - 1], soutq, &lsout, (ftnlen)80); +#line 17586 "" goto L12; +#line 17587 "" } +#line 17588 "" } +#line 17589 "" } /* Put in \sk if needed */ +#line 17593 "" if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) { /* Writing concatenation */ +#line 17594 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17594 "" i__4[1] = 2, a__2[1] = "sk"; +#line 17594 "" s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); +#line 17594 "" addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, ( ftnlen)80); +#line 17595 "" tnow += comnsp_2.space[ib - 1]; +#line 17596 "" goto L12; +#line 17597 "" } /* Check for user-defined shifts */ +#line 17601 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],16)) { +#line 17601 "" putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, ( ftnlen)80); +#line 17601 "" } +#line 17603 "" L21: +#line 17603 "" if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow > comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] - comtol_1.tol) { +#line 17605 "" if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] > tstart[ib] - comtol_1.tol) { /* Insert placeholder for accidental skip */ /* Writing concatenation */ +#line 17609 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17609 "" i__4[1] = 8, a__2[1] = "ask "; +#line 17609 "" s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)9); +#line 17609 "" addstr_(ch__15, &c__9, soutq, &lsout, (ftnlen)9, ( ftnlen)80); +#line 17610 "" ++comas2_1.nasksys; +#line 17611 "" comas2_1.wasksys[comas2_1.nasksys - 1] = comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] ; +#line 17612 "" if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] > 0.f) { +#line 17613 "" comas2_1.elasksys[comas2_1.nasksys - 1] = comas1_1.elask[iaskb[commvl_1.ivx - 1] - 1]; +#line 17614 "" } else { /* This is a signal to permit negative ask's. Should really have elask>=0. */ +#line 17618 "" comas2_1.elasksys[comas2_1.nasksys - 1] = -comas1_1.elask[iaskb[commvl_1.ivx - 1] - 1]; +#line 17619 "" } +#line 17620 "" } /* May have skipped some task's in earlier blocks (due to void voice) */ +#line 17624 "" ++iaskb[commvl_1.ivx - 1]; +#line 17625 "" goto L21; +#line 17626 "" } +#line 17627 "" if (all_1.figbass) { +#line 17628 "" if (commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { +#line 17629 "" ivf = 1; +#line 17630 "" if (commvl_1.ivx > 1) { +#line 17630 "" ivf = 2; +#line 17630 "" } +#line 17631 "" if (all_1.figchk[ivf - 1] && (r__1 = comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3] - tnow, dabs(r__1)) < comtol_1.tol) { /* Figure on a note. NB: later special check for late figs. */ - putfig_(&ivf, &ifig[ivf - 1], &c_b774, & +#line 17636 "" + putfig_(&ivf, &ifig[ivf - 1], &c_b1009, & all_1.figchk[ivf - 1], soutq, &lsout, (ftnlen)80); +#line 17637 "" } +#line 17638 "" } +#line 17639 "" } /* Check for new clef here. */ +#line 17643 "" if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],11)) { -/* print*,'At clef insertion, ptclef:',ptclef(iv) */ +#line 17644 "" if (ptclef[all_1.iv - 1] > 0.f) { /* Writing concatenation */ +#line 17645 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17645 "" i__4[1] = 5, a__2[1] = "off{-"; +#line 17645 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17646 "" if (ptclef[all_1.iv - 1] < 9.95f) { - s_wsfi(&io___1053); +#line 17647 "" + s_wsfi(&io___1094); +#line 17647 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); +#line 17647 "" e_wsfi(); +#line 17648 "" lnote = 9; +#line 17649 "" } else { - s_wsfi(&io___1054); +#line 17650 "" + s_wsfi(&io___1095); +#line 17650 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); +#line 17650 "" e_wsfi(); +#line 17651 "" lnote = 10; +#line 17652 "" } /* Writing concatenation */ +#line 17653 "" i__4[0] = lnote, a__2[0] = notexq; +#line 17653 "" i__4[1] = 3, a__2[1] = "pt}"; +#line 17653 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17654 "" lnote += 3; +#line 17655 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); -/* print*,'Just added: ',notexq(1:lnote) */ +#line 17656 "" } +#line 17657 "" clefsym_(&all_1.islur[all_1.iv + ip * 24 - 25], notexq, &lnote, &nclef, (ftnlen)79); /* 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' */ +#line 17661 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],2) ) { /* Writing concatenation */ +#line 17661 "" i__6[0] = 8, a__4[0] = notexq; +#line 17661 "" i__6[1] = 1, a__4[1] = "8"; +#line 17661 "" i__6[2] = 1, a__4[2] = notexq + 9; +#line 17661 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); +#line 17661 "" } +#line 17663 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 17664 "" if (ptclef[all_1.iv - 1] > 0.f) { /* Writing concatenation */ +#line 17665 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17665 "" i__4[1] = 4, a__2[1] = "off{"; +#line 17665 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17666 "" if (ptclef[all_1.iv - 1] < 9.95f) { - s_wsfi(&io___1056); +#line 17667 "" + s_wsfi(&io___1097); +#line 17667 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); +#line 17667 "" e_wsfi(); +#line 17668 "" lnote = 8; +#line 17669 "" } else { - s_wsfi(&io___1057); +#line 17670 "" + s_wsfi(&io___1098); +#line 17670 "" do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( ftnlen)sizeof(real)); +#line 17670 "" e_wsfi(); +#line 17671 "" lnote = 9; +#line 17672 "" } /* Writing concatenation */ +#line 17673 "" i__4[0] = lnote, a__2[0] = notexq; +#line 17673 "" i__4[1] = 3, a__2[1] = "pt}"; +#line 17673 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17674 "" lnote += 3; +#line 17675 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); +#line 17676 "" } +#line 17677 "" } /* Checking for literal TeX string BEFORE starting beams!! */ +#line 17681 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16)) { +#line 17682 "" i__12 = comgrace_1.nlit; +#line 17682 "" for (il = 1; il <= i__12; ++il) { +#line 17683 "" if (comgrace_1.iplit[il - 1] == ip && comgrace_1.ivlit[il - 1] == commvl_1.ivx) { +#line 17683 "" goto L125; +#line 17683 "" } +#line 17684 "" /* L124: */ +#line 17684 "" } - s_wsle(&io___1059); - do_lio(&c__9, &c__1, "Problem finding index for lite" +#line 17685 "" + s_wsle(&io___1100); +#line 17685 "" + do_lio(&c__9, &c__1, "Problem finding index for lite"\ "ral string", (ftnlen)40); +#line 17685 "" e_wsle(); +#line 17686 "" stop1_(); +#line 17687 "" L125: /* Write a type 1 tex string. */ +#line 17691 "" if (comgrace_1.lenlit[il - 1] < 71) { /* Add normally */ +#line 17695 "" addstr_(comgrace_1.litq + (il - 1 << 7), & comgrace_1.lenlit[il - 1], soutq, &lsout, (ftnlen)128, (ftnlen)80); +#line 17696 "" } else { /* Longer than 71. Write souq, Write string, start new soutq. */ +#line 17700 "" if (comlast_1.islast) { - s_wsfe(&io___1060); +#line 17700 "" + s_wsfe(&io___1101); /* Writing concatenation */ +#line 17700 "" i__4[0] = lsout, a__2[0] = soutq; +#line 17700 "" i__4[1] = 1, a__2[1] = "%"; +#line 17700 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 17700 "" do_fio(&c__1, ch__12, lsout + 1); +#line 17700 "" e_wsfe(); +#line 17700 "" } +#line 17701 "" if (comlast_1.islast) { - s_wsfe(&io___1061); +#line 17701 "" + s_wsfe(&io___1102); /* Writing concatenation */ +#line 17701 "" i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] = comgrace_1.litq + (il - 1 << 7); +#line 17701 "" i__4[1] = 1, a__2[1] = "%"; +#line 17701 "" s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)129); +#line 17701 "" do_fio(&c__1, ch__16, comgrace_1.lenlit[il - 1] + 1); +#line 17701 "" e_wsfe(); +#line 17701 "" } +#line 17702 "" lsout = 0; +#line 17703 "" } +#line 17704 "" } /* Arpeggio on a main (non-chordal) note? */ +#line 17708 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27)) { /* call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), */ +#line 17710 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17710 "" putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, soutq, & lsout, (ftnlen)80); +#line 17712 "" } /* See if a beam starts here */ +#line 17716 "" if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && all_1.ibm1[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == ip || bit_test(all_1.nacc[ commvl_1.ivx + ip * 24 - 25],21)) { +#line 17719 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],24)) { /* Not a jump start */ +#line 17723 "" if (comkbdrests_1.kbdrests && bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && ! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[ all_1.iv - 1] == 2 && all_1.nolev[ commvl_1.ivx + ip * 24 - 25] <= 50) { +#line 17723 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, @@ -25936,80 +42135,117 @@ L125: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); +#line 17723 "" } +#line 17729 "" beamstrt_(notexq, &lnote, nornb, ihornb, comnsp_2.space, &squez[1], &ib, (ftnlen) 79); /* Shift beam start if notehead was shifted */ +#line 17733 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { /* Writing concatenation */ +#line 17734 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17734 "" i__4[1] = 5, a__2[1] = "loff{"; +#line 17734 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 17734 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) 6, (ftnlen)80); +#line 17735 "" } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)) { /* Writing concatenation */ +#line 17736 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 17736 "" i__4[1] = 5, a__2[1] = "roff{"; +#line 17736 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 17736 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) 6, (ftnlen)80); +#line 17737 "" } +#line 17738 "" if (lnote > 0) { +#line 17738 "" addstr_(notexq, &lnote, soutq, &lsout, ( ftnlen)79, (ftnlen)80); +#line 17738 "" } +#line 17739 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)) { +#line 17739 "" addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 17739 "" } +#line 17741 "" } else { /* Jump start. Set marker for second part of a jump beam. Note ivbj2 was set */ /* to 0 at end of first part of jump beam */ +#line 17746 "" combjmp_1.ivbj2 = commvl_1.ivx; /* Check for xtup since we bypassed beamstrt wherein vxtup is normally set */ +#line 17750 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28) && strtmid_1.ixrest[commvl_1.ivx - 1] != 2) { +#line 17750 "" comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 17750 "" } /* Since beamstrt is not called, and drawbm is normally set there, need to set */ /* it here. This could cause problems if someone tries a staff-jumping, */ /* unbarred beam, which I'll deal with when it comes up. */ +#line 17757 "" comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 17758 "" } +#line 17759 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { +#line 17760 "" all_1.beamon[commvl_1.ivx - 1] = TRUE_; +#line 17761 "" bspend = TRUE_; +#line 17762 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],24)) { +#line 17762 "" bspend = TRUE_; +#line 17762 "" } +#line 17763 "" } +#line 17764 "" } /* Setup for chords and possible slurs in chords */ +#line 17768 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* There is a chord on this note. Just rerun precrd. Klunky, but saves */ /* me from tracking down errors instroduced when I moved 1st call */ /* forward for accidental spacing analysis. */ +#line 17774 "" if (all_1.beamon[commvl_1.ivx - 1]) { +#line 17775 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.ipl[ @@ -26018,42 +42254,57 @@ L125: all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &c_true, & icashft, (ftnlen)1); +#line 17778 "" } else { +#line 17779 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17779 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], & commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); +#line 17779 "" precrd_(&commvl_1.ivx, &ip, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.ipl[ commvl_1.ivx + ip * 24 - 25], & all_1.irest[commvl_1.ivx + ip * 24 - 25], ch__6, &c_true, &icashft, (ftnlen)1); +#line 17783 "" } +#line 17784 "" } /* Is there slur or grace activity? */ +#line 17788 "" isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4); +#line 17789 "" if (ip > 1) { +#line 17789 "" isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],31); +#line 17789 "" } /* isgrace if not 1st note in bar and previous note has Way-after grace. */ +#line 17793 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0) || isgrace) { +#line 17794 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 0)) { +#line 17795 "" if (comslur_1.fontslur) { /* Call routine for non-postscript slurs */ +#line 17799 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17799 "" doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 - 25], all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, &ip, & @@ -26070,11 +42321,14 @@ L125: - 25] - 1], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], (ftnlen)80, (ftnlen) 1); +#line 17804 "" } else { /* Postscript slurs */ +#line 17808 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17808 "" dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24 - 25], all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, & @@ -26091,21 +42345,33 @@ L125: commvl_1.ivx + ip * 24 - 25] - 1], & all_1.nacc[commvl_1.ivx + ip * 24 - 25], (ftnlen)80, (ftnlen)1); +#line 17814 "" } +#line 17815 "" } +#line 17816 "" if (isgrace) { /* Grace note. */ +#line 17820 "" iphold = ip; +#line 17821 "" isgrace = FALSE_; +#line 17822 "" if (ip > 1) { +#line 17822 "" isgrace = bit_test(all_1.ipl[commvl_1.ivx + ( ip - 1) * 24 - 25],31); +#line 17822 "" } +#line 17823 "" if (isgrace) { +#line 17823 "" --iphold; +#line 17823 "" } +#line 17824 "" isgrace = isgrace || ! bit_test(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],31) && ! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 @@ -26114,9 +42380,13 @@ L125: /* Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace */ /* on current note. Do A-grace on current note, and W-grace at barend, later. */ +#line 17830 "" if (isgrace) { +#line 17831 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17831 "" i__13 = ncmid_(&all_1.iv, &ip); +#line 17831 "" dograce_(&commvl_1.ivx, &iphold, ptgr, soutq, &lsout, &i__12, &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &ig, & @@ -26133,153 +42403,233 @@ L125: all_1.iv - 1], (ftnlen)80, (ftnlen)1); /* 130324 */ /* * tnote(ipl2(ivx,ip)),ulq) */ +#line 17838 "" if (comgrace_1.slurg[ig - 1]) { /* Terminate slur started in dograce. Get direction of main note stem */ +#line 17842 "" if (! all_1.beamon[commvl_1.ivx - 1]) { /* Separate note. Get stem direction. */ +#line 17846 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17846 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &all_1.nv); +#line 17846 "" stemup = *(unsigned char *)&ch__6[0] == 'u'; +#line 17848 "" } else { /* In a beam */ +#line 17852 "" stemup = *(unsigned char *)&all_1.ulq[ commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == 'u'; +#line 17853 "" } /* Stop the shift if whole note */ +#line 17857 "" stemup = stemup || all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] > 63.f; +#line 17859 "" L__1 = ! comgrace_1.upg[ig - 1]; +#line 17859 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17859 "" endslur_(&stemup, &L__1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], & c__0, &comslur_1.ndxslur, &c__0, & i__12, soutq, &lsout, & comslur_1.fontslur, (ftnlen)80); +#line 17861 "" } +#line 17862 "" } +#line 17863 "" } +#line 17864 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1], 24)) { /* Start slur on main note for After- or Way-after-grace. */ /* ???? ndxslur = log2(33554431-listslur) */ +#line 17869 "" i__12 = 16777215 - comslur_1.listslur; +#line 17869 "" comslur_1.ndxslur = log2_(&i__12); /* Get note name */ +#line 17873 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17873 "" notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, (ftnlen)8); /* Get slur direction */ +#line 17877 "" *(unsigned char *)slurudq = 'u'; +#line 17878 "" if (! all_1.beamon[commvl_1.ivx - 1]) { +#line 17879 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17879 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); +#line 17879 "" if (*(unsigned char *)&ch__6[0] == 'u') { +#line 17879 "" *(unsigned char *)slurudq = 'd'; +#line 17879 "" } +#line 17881 "" } else { +#line 17882 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 17882 "" *(unsigned char *)slurudq = 'd'; +#line 17882 "" } +#line 17883 "" } /* c Replace ndxslur by 11-ndxslur when printing only. */ /* Replace ndxslur by 23-ndxslur when printing only. */ /* if (11-ndxslur .lt. 10) then */ +#line 17889 "" if (23 - comslur_1.ndxslur < 10) { /* notexq = sq//'islur'//slurudq//chax(59-ndxslur) */ /* Writing concatenation */ +#line 17891 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 17891 "" i__5[1] = 5, a__3[1] = "islur"; +#line 17891 "" i__5[2] = 1, a__3[2] = slurudq; +#line 17891 "" i__12 = 71 - comslur_1.ndxslur; +#line 17891 "" chax_(ch__6, (ftnlen)1, &i__12); +#line 17891 "" i__5[3] = 1, a__3[3] = ch__6; +#line 17891 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 17891 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 17893 "" i__12 = lnoten + 8; +#line 17893 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); +#line 17894 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 17895 "" i__14[0] = 1, a__8[0] = all_1.sq; +#line 17895 "" i__14[1] = 5, a__8[1] = "islur"; +#line 17895 "" i__14[2] = 1, a__8[2] = slurudq; +#line 17895 "" i__14[3] = 2, a__8[3] = "{1"; +#line 17895 "" i__12 = 61 - comslur_1.ndxslur; +#line 17895 "" chax_(ch__6, (ftnlen)1, &i__12); +#line 17895 "" i__14[4] = 1, a__8[4] = ch__6; +#line 17895 "" i__14[5] = 1, a__8[5] = "}"; +#line 17895 "" i__14[6] = lnoten, a__8[6] = noteq; +#line 17895 "" s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); +#line 17897 "" i__12 = lnoten + 11; +#line 17897 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); +#line 17898 "" } else { /* Writing concatenation */ +#line 17899 "" i__14[0] = 1, a__8[0] = all_1.sq; +#line 17899 "" i__14[1] = 5, a__8[1] = "islur"; +#line 17899 "" i__14[2] = 1, a__8[2] = slurudq; +#line 17899 "" i__14[3] = 2, a__8[3] = "{2"; +#line 17899 "" i__12 = 51 - comslur_1.ndxslur; +#line 17899 "" chax_(ch__6, (ftnlen)1, &i__12); +#line 17899 "" i__14[4] = 1, a__8[4] = ch__6; +#line 17899 "" i__14[5] = 1, a__8[5] = "}"; +#line 17899 "" i__14[6] = lnoten, a__8[6] = noteq; +#line 17899 "" s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); +#line 17901 "" i__12 = lnoten + 11; +#line 17901 "" addstr_(notexq, &i__12, soutq, &lsout, ( ftnlen)79, (ftnlen)80); +#line 17902 "" } /* call setbits(ipl(ivx,ip),4,23,ndxslur) */ +#line 17904 "" setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25], &c__5, &c__23, &comslur_1.ndxslur); +#line 17905 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31)) { +#line 17905 "" comslur_1.listslur = bit_set( comslur_1.listslur,comslur_1.ndxslur); +#line 17905 "" } /* Starting slur on W-grace on THIS note. Record ndxslur. */ +#line 17910 "" } +#line 17911 "" } /* Process dynamic marks */ +#line 17915 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26)) { +#line 17916 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17916 "" L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64; +#line 17916 "" dodyn_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__12, &all_1.ipl[ commvl_1.ivx + ip * 24 - 25], &all_1.islur[ @@ -26289,10 +42639,12 @@ L125: commvl_1.ivx - 1], ihornb, nornb, all_1.ulq, & all_1.ibmcnt[commvl_1.ivx - 1], &L__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 17920 "" } /* Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. */ +#line 17924 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { /* Need a duration to set type of note head */ @@ -26301,20 +42653,61 @@ L125: /* Clumsy test, but vxtup is not set until main note is processed. */ +#line 17932 "" if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25],28))) { +#line 17933 "" nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; -/* else if (mult(ivx,ip) .lt. 0) then */ +/* c else if (iand(mult(ivx,ip),15)-8 .lt. 0) then */ +/* else if (iand(mult(ivx,ip),15)-8 .lt. 0 .or. */ +/* * (btest(irest(ivx,ip),2).and.nodur(ivx,ip+1).eq.32) .or. */ +/* * (ip.gt.1.and.btest(irest(ivx,ip-1),2) */ +/* * .and.nodur(ivx,ip).eq.32)) then */ +/* nodu = 32 */ +/* else */ +/* nodu = 16 */ +/* end if */ +#line 17943 "" + } else if (bit_test(all_1.irest[commvl_1.ivx + ip * + 24 - 25],2) || ip > 1 && bit_test(all_1.irest[ + commvl_1.ivx + (ip - 1) * 24 - 25],2)) { + +/* In a 2-note tremolo */ + +#line 17948 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],2)) { + +/* First note of tremolo, duration is on next note */ + +#line 17952 "" + nodu = all_1.nodur[commvl_1.ivx + (ip + 1) * + 24 - 25]; +#line 17953 "" + } else { +#line 17954 "" + nodu = all_1.nodur[commvl_1.ivx + ip * 24 - + 25]; +#line 17955 "" + } +#line 17956 "" } else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8 < 0) { +#line 17957 "" nodu = 32; +#line 17958 "" } else { +#line 17959 "" nodu = 16; +#line 17960 "" } +#line 17961 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 17961 "" L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27); +#line 17961 "" docrd_(&commvl_1.ivx, &ip, &nodu, &i__12, &all_1.iv, & tnow, soutq, &lsout, all_1.ulq, &all_1.ibmcnt[ commvl_1.ivx - 1], &all_1.islur[commvl_1.ivx @@ -26322,22 +42715,29 @@ L125: &all_1.nv, &all_1.beamon[commvl_1.ivx - 1], & all_1.nolev[commvl_1.ivx + ip * 24 - 25], ihornb, nornb, &all_1.stemlen, &L__1, & - all_1.nacc[commvl_1.ivx + ip * 24 - 25], ( - ftnlen)80, (ftnlen)1); + all_1.nacc[commvl_1.ivx + ip * 24 - 25], + all_1.irest, (ftnlen)80, (ftnlen)1); +#line 17966 "" } /* Now that chords are done, add stuff to midi file */ +#line 17970 "" if (commidi_1.ismidi) { +#line 17970 "" i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + commvel_1.miditran[cominsttrans_1.instno[ all_1.iv - 1] - 1]; +#line 17970 "" i__13 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; +#line 17970 "" L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0); +#line 17970 "" addmidi_(&icm, &i__12, &i__13, &commidisig_1.midisig, &all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1], &L__1, &c_false); +#line 17970 "" } /* 130316 */ /* * nolev(ivx,ip)-iTransAmt(instno(iv)), */ @@ -26345,12 +42745,16 @@ L125: /* Check for breath or caesura */ +#line 17981 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28)) { +#line 17982 "" putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79) ; +#line 17983 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 17984 "" } /* Check for main-note ornaments. ')' on dotted notes go in with note, not here. */ @@ -26359,53 +42763,73 @@ L125: /* isacc = iand(iornq(ivx,ip),4194287) .gt. 0 */ /* isacc = iand(iornq(ivx,ip),541065199) .gt. 0 */ +#line 17992 "" isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 1614807023) > 0; /* isacc=.true. if any ornament except segno */ +#line 17996 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) { /* If ). is only ornament, bypass. If with others, temporarirly zero the bit. */ +#line 18000 "" i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); +#line 18000 "" if (pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx + ip * 24 - 25]) { +#line 18001 "" if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 516079) == 0) { /* ). is the only non-segno ornament */ +#line 18005 "" isacc = FALSE_; +#line 18006 "" } else { /* There are other ornaments in addition */ +#line 18010 "" rpndot = TRUE_; +#line 18011 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13); +#line 18012 "" } +#line 18013 "" } +#line 18014 "" } +#line 18015 "" if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { /* Check for centered whole-bar rest with fermata (bits 10 or 14). */ +#line 18019 "" if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 17408) > 0 && bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == all_1.lenbar && ! ( all_1.firstgulp && all_1.ibar == 1 && all_1.lenb0 > 0)) { +#line 18023 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_; +#line 18024 "" goto L30; +#line 18025 "" } +#line 18026 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 18026 "" L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] ,10); +#line 18026 "" putorn_(&all_1.iornq[commvl_1.ivx + ip * 24 - 1], & all_1.nolev[commvl_1.ivx + ip * 24 - 25], & all_1.nolev[commvl_1.ivx + ip * 24 - 25], & @@ -26417,45 +42841,66 @@ L125: all_1.stemlen, notexq, &lnote, &ip, &islhgt, & all_1.beamon[commvl_1.ivx - 1], &L__1, ( ftnlen)1, (ftnlen)79); +#line 18031 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 18032 "" } +#line 18033 "" if (rpndot) { +#line 18034 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( all_1.iornq[commvl_1.ivx + ip * 24 - 1],13); +#line 18035 "" rpndot = FALSE_; +#line 18036 "" } +#line 18037 "" L30: /* Check for main note accidental */ +#line 18041 "" if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25], 17)) { +#line 18043 "" ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__7, &c__10); +#line 18044 "" if (ihshft != 0) { +#line 18044 "" ihshft += -107; +#line 18044 "" } +#line 18045 "" if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 10) && bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { +#line 18045 "" ihshft += -20; +#line 18045 "" } /* Not a chord, and left-shifted main note, so left-shift accid */ +#line 18050 "" i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__6, &c__4); +#line 18050 "" i__13 = ncmid_(&all_1.iv, &ip); +#line 18050 "" L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],31); +#line 18050 "" doacc_(&ihshft, &i__12, notexq, &lnote, &all_1.nacc[ commvl_1.ivx + ip * 24 - 25], &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__13, &L__1, ( ftnlen)79); +#line 18053 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 18054 "" } /* Lower dot for lower-voice notes. Conditions are: */ @@ -26466,111 +42911,158 @@ L30: /* . 5. Flag (lowdot) is set to true */ /* 6. Not in an xtuplet */ +#line 18064 "" if (comarp_1.lowdot && commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivx <= all_1.nv && all_1.nodur[ commvl_1.ivx + ip * 24 - 25] != 0) { +#line 18066 "" i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); +#line 18066 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx + ip * 24 - 25] && ( all_1.nolev[commvl_1.ivx + ip * 24 - 25] - ncmid_(&commvl_1.ivx, &ip)) % 2 == 0) { +#line 18069 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19)) { /* Note already in movdot list. Drop by 2. */ +#line 18073 "" comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[ commvl_1.ivx - 1] + 1) * 24 - 25] += -2.f; +#line 18075 "" } else { /* Not in list so just move it right now */ +#line 18079 "" i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 - 25], &c__1, &c__3); - dotmov_(&c_b773, &c_b774, soutq, &lsout, & +#line 18079 "" + dotmov_(&c_b1008, &c_b1009, soutq, &lsout, & i__12, (ftnlen)80); +#line 18081 "" } +#line 18082 "" } +#line 18083 "" } -/* Check for dotted notes with moved dots */ +/* Check for dotted main notes with moved dots. Chord notes done elsewhere. */ +/* Added check rules out special chordal 2nds, but later must check */ +/* substituted chord note for dot shift that now applies to main note. */ +#line 18089 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19)) { +#line 18090 "" ++comcc_1.ndotmv[commvl_1.ivx - 1]; +#line 18091 "" i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 - 25], &c__1, &c__3); +#line 18091 "" dotmov_(&comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[ commvl_1.ivx - 1] * 24 - 25], &comcc_1.rtdot[ commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25], soutq, &lsout, &i__12, (ftnlen) 80); +#line 18093 "" } /* Stemlength changes */ +#line 18097 "" if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27)) { +#line 18098 "" dstemlen = igetbits_(&all_1.mult[commvl_1.ivx + ip * 24 - 25], &c__6, &c__10) * .5f - 4.f; +#line 18099 "" stemshort = dstemlen * .667f + 4.66f; /* Writing concatenation */ +#line 18100 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18100 "" i__4[1] = 11, a__2[1] = "stemlength{"; +#line 18100 "" s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 18100 "" addstr_(ch__5, &c__12, soutq, &lsout, (ftnlen)12, ( ftnlen)80); - s_wsfi(&io___1069); +#line 18101 "" + s_wsfi(&io___1110); +#line 18101 "" do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real) ); +#line 18101 "" e_wsfi(); /* Writing concatenation */ +#line 18102 "" i__4[0] = 4, a__2[0] = notexq; +#line 18102 "" i__4[1] = 1, a__2[1] = "}"; +#line 18102 "" s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 18102 "" addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, ( ftnlen)80); +#line 18103 "" } else if (ip > 1) { +#line 18104 "" if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { /* Writing concatenation */ +#line 18104 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18104 "" i__4[1] = 16, a__2[1] = "stemlength{4.66}"; +#line 18104 "" s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)17); +#line 18104 "" addstr_(ch__7, &c__17, soutq, &lsout, (ftnlen)17, (ftnlen)80); +#line 18104 "" } /* Cancel shortening. Looks like it gets automatically restored if new inst. or */ /* new line, so no need to worry about affecting other lines */ +#line 18110 "" } /* Zero out slur-height marker for raising ornaments */ +#line 18114 "" islhgt = 0; /* Now start with spacing notes. Is a beam start pending? */ +#line 18118 "" if (bspend && all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] > all_1.ibm1[ commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]) { +#line 18120 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) { /* Special path for single note at end of otherwise beamed xtup */ +#line 18124 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 18125 "" } else { +#line 18126 "" if (comkbdrests_1.kbdrests && bit_test( all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && ! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[ all_1.iv - 1] == 2 && all_1.nolev[ commvl_1.ivx + ip * 24 - 25] <= 50) { +#line 18126 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, @@ -26579,58 +43071,84 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); +#line 18126 "" } +#line 18132 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],24)) { /* Writing concatenation */ +#line 18134 "" chax_(ch__6, (ftnlen)1, &c__92); +#line 18134 "" i__4[0] = 1, a__2[0] = ch__6; +#line 18134 "" i__4[1] = 2, a__2[1] = "sk"; +#line 18134 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18135 "" lnote = 3; +#line 18136 "" } else { +#line 18137 "" beamn1_(notexq, &lnote, (ftnlen)79); +#line 18138 "" } +#line 18139 "" } +#line 18140 "" bspend = FALSE_; /* Is a beam ending? */ +#line 18144 "" } else if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[ commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && ( all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25] == ip || bit_test( all_1.nacc[commvl_1.ivx + ip * 24 - 25],20))) { /* * .and. ibm2(ivx,ibmcnt(ivx)) .eq. ip) then */ +#line 18148 "" if (bspend) { /* Must be a single-note ending of a jump-beam */ +#line 18152 "" bspend = FALSE_; +#line 18153 "" } +#line 18154 "" beamend_(notexq, &lnote, (ftnlen)79); +#line 18155 "" if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25] ,20)) { +#line 18156 "" comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; +#line 18157 "" nornb[commvl_1.ivx - 1] = 0; +#line 18158 "" ++all_1.ibmcnt[commvl_1.ivx - 1]; +#line 18159 "" all_1.beamon[commvl_1.ivx - 1] = FALSE_; +#line 18160 "" } /* Or if we're in the middle of a beam */ +#line 18164 "" } else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[ commvl_1.ivx - 1]) { /* Added 130127 */ +#line 18168 "" if (comkbdrests_1.kbdrests && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test( all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[all_1.iv - 1] == 2 && all_1.nolev[commvl_1.ivx + ip * 24 - 25] <= 50) { +#line 18168 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, & @@ -26639,11 +43157,14 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); +#line 18168 "" } +#line 18174 "" beamid_(notexq, &lnote, (ftnlen)79); /* Or whole-bar rest */ +#line 18178 "" } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == all_1.lenbar && ! (all_1.firstgulp && @@ -26654,12 +43175,18 @@ L30: /* Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp */ +#line 18186 "" cwrest[commvl_1.ivx] = TRUE_; +#line 18187 "" iscwr = TRUE_; +#line 18188 "" notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ commvl_1.ivx - 1], (ftnlen)79); +#line 18189 "" tnow += all_1.lenbar; +#line 18190 "" goto L10; +#line 18191 "" } else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { /* Before writing note or rest, check for keyboard rest height adjustment. */ @@ -26667,103 +43194,15 @@ L30: /* 1. kbdrests = .true. */ /* 2. There are two voices on the staff */ /* 3. No user-def height adjustments have been applied (nolev<50) */ -/* c 4. Not last note in bar */ -/* c 5. Followed by note (add better test later) */ +#line 18199 "" if (comkbdrests_1.kbdrests && bit_test(all_1.irest[ commvl_1.ivx + ip * 24 - 25],0) && ! bit_test( all_1.islur[commvl_1.ivx + ip * 24 - 25],29) && commvl_1.nvmx[all_1.iv - 1] == 2 && all_1.nolev[commvl_1.ivx + ip * 24 - 25] <= 50) { -/* * nolev(ivx,ip).le.50 .and. ip.ne.nn(ivx) */ -/* * .and. .not.(btest(irest(ivx,ip+1),0))) then */ - -/* 130127 Replaced following code with a subroutine */ - -/* c Get reference level: next following note if no intervening blank rests, */ -/* c otherwise next prior note. */ -/* c */ -/* c levnext = nolev(ivx,ip+1)-ncmid(iv,ip)+4 ! Relative to bottom line */ -/* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */ -/* c */ -/* c Not the last note and not "look-left" for level */ -/* c */ -/* do 8 kkp = ip+1 , nn(ivx) */ -/* if (btest(islur(ivx,kkp),29)) go to 4 */ -/* if (.not.btest(irest(ivx,kkp),0)) then */ -/* levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line */ -/* go to 9 */ -/* end if */ -/* 8 continue */ -/* end if */ -/* 4 continue */ -/* c */ -/* c If here, there were no following notes or came to a blank rest, or */ -/* c "look-left" option set. So look before */ -/* c */ -/* if (ip .eq. 1) go to 2 ! Get out if this is the first note. */ -/* do 3 kkp = ip-1, 1, -1 */ -/* if (.not.btest(irest(ivx,kkp),0)) then */ -/* levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line */ -/* go to 9 */ -/* end if */ -/* 3 continue */ -/* go to 2 ! Pretty odd, should never be here, but get out if so. */ -/* 9 continue */ -/* c */ -/* c Find note in other voice at same time */ -/* c */ -/* iupdown = sign(1,ivx-nv-1) */ -/* ivother = ivmx(iv,(3-iupdown)/2) */ -/* tother = 0. */ -/* do 5 kkp = 1 , nib(ivother,ibar) */ -/* if (abs(tother-tnow) .lt. tol) go to 6 */ -/* tother = tother+nodur(ivother,kkp) */ -/* 5 continue */ -/* c */ -/* c If here, then no note starts in other voice at same time, so set default */ -/* c */ -/* levother = -iupdown*50 */ -/* go to 7 */ -/* 6 continue */ -/* c */ -/* c If here, have just identified a simultaneous note or rest in other voice */ -/* c */ -/* if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it */ -/* levother = nolev(ivother,kkp)-ncmid(iv,ip)+4 */ -/* else */ -/* if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then */ -/* c */ -/* c Rest in other voice has same duration, get out (so defualt spacing is used) */ -/* c */ -/* go to 2 */ -/* end if */ -/* levother = -iupdown*50 */ -/* end if */ -/* 7 continue */ -/* indxr = log2(nodur(ivx,ip))+1 */ -/* if (iupdown .lt. 0) then */ -/* levtop = levtopr(indxr) */ -/* iraise1 = levother-levtop-3 ! Based on other note */ -/* iraise2 = levnext-levtop ! Based on following note */ -/* if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2 */ -/* iraise = min(iraise1,iraise2) */ -/* if (mod(iraise+50,2).eq.1 .and. */ -/* * iraise+levtop.gt.-1) iraise = iraise-1 */ -/* else */ -/* levbot = levbotr(indxr) */ -/* iraise1 = levother-levbot+3 */ -/* iraise2 = levnext-levbot */ -/* if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1 */ -/* iraise = max(iraise1,iraise2) */ -/* if (mod(iraise+50,2).eq.1 .and. */ -/* * iraise+levbot.le.9) iraise = iraise-1 */ -/* end if */ -/* nolev(ivx,ip) = 100+iraise */ - -/* The new subroutine call, to replace above code */ - +#line 18202 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, all_1.nn, all_1.islur, all_1.irest, all_1.nolev, commvl_1.ivmx, all_1.nib, & @@ -26772,50 +43211,199 @@ L30: comkbdrests_1.levtopr, comkbdrests_1.levbotr, all_1.mult, all_1.ipl); +#line 18205 "" + } +#line 18206 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],4) + ) { + +/* Deal with single stem tremolo */ +/* Get up-downness, borrowed from notex */ + +#line 18211 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 18211 "" + udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + + ip * 24 - 25], &i__12, &all_1.islur[ + commvl_1.ivx + ip * 24 - 25], & + commvl_1.nvmx[all_1.iv - 1], & + commvl_1.ivx, &all_1.nv); +#line 18211 "" + if (*(unsigned char *)&ch__6[0] == 'u') { +#line 18213 "" + *(unsigned char *)udq = 'u'; +#line 18214 "" + } else { +#line 18215 "" + *(unsigned char *)udq = 'l'; +#line 18216 "" + } +#line 18217 "" + multtrem = igetbits_(&all_1.ipl[commvl_1.ivx + ip + * 24 - 25], &c__2, &c__5) + 1; +#line 18218 "" + if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] < 64) + { +/* Writing concatenation */ +#line 18219 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 18219 "" + i__4[1] = 2, a__2[1] = "tr"; +#line 18219 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18220 "" + } else { +/* Writing concatenation */ +#line 18221 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 18221 "" + i__4[1] = 2, a__2[1] = "Tr"; +#line 18221 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18222 "" + } +#line 18223 "" + lnote = 3; +#line 18224 "" + if (multtrem == 2) { +/* Writing concatenation */ +#line 18225 "" + i__4[0] = 3, a__2[0] = notexq; +#line 18225 "" + i__4[1] = 1, a__2[1] = "r"; +#line 18225 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18226 "" + lnote = 4; +#line 18227 "" + } else if (multtrem == 3) { +/* Writing concatenation */ +#line 18228 "" + i__4[0] = 3, a__2[0] = notexq; +#line 18228 "" + i__4[1] = 2, a__2[1] = "rr"; +#line 18228 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18229 "" + lnote = 5; +#line 18230 "" + } + +/* Get a numerical pitch argument */ + +#line 18234 "" + lineno = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + - ncmid_(&all_1.iv, &ip) + 4; +#line 18235 "" + if (lineno < 0 || lineno > 9) { +#line 18236 "" + s_wsfi(&io___1116); +#line 18236 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 18236 "" + do_fio(&c__1, (char *)&lineno, (ftnlen)sizeof( + integer)); +#line 18236 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 18236 "" + e_wsfi(); +#line 18237 "" + lnoten = 4; +#line 18238 "" + } else { +#line 18239 "" + *(unsigned char *)&ch__6[0] = lineno + 48; +#line 18239 "" + s_copy(noteq, ch__6, (ftnlen)8, (ftnlen)1); +#line 18240 "" + lnoten = 1; +#line 18241 "" + } +/* Writing concatenation */ +#line 18242 "" + i__9[0] = lnote, a__6[0] = notexq; +#line 18242 "" + i__9[1] = 1, a__6[1] = "m"; +#line 18242 "" + i__9[2] = 1, a__6[2] = udq; +#line 18242 "" + i__9[3] = lnoten, a__6[3] = noteq; +#line 18242 "" + s_cat(notexq, a__6, i__9, &c__4, (ftnlen)79); +#line 18243 "" + lnote = lnote + 2 + lnoten; +#line 18244 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, + (ftnlen)80); +#line 18245 "" } -/* Write a separate note or rest */ +/* Get code for a separate note or rest */ +/* If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), */ +/* pitch will be shifted +/-1 inside notex. */ +#line 18251 "" notex_(notexq, &lnote, (ftnlen)79); +#line 18252 "" } /* Right offset? This may cause trouble */ +#line 18256 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { /* Writing concatenation */ +#line 18257 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18257 "" i__4[1] = 5, a__2[1] = "loff{"; +#line 18257 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 18257 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( ftnlen)80); +#line 18258 "" } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] ,9)) { /* Writing concatenation */ +#line 18259 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18259 "" i__4[1] = 5, a__2[1] = "roff{"; +#line 18259 "" s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 18259 "" addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( ftnlen)80); +#line 18260 "" } +#line 18261 "" if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0) { +#line 18262 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 18263 "" } +#line 18264 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9) ) { +#line 18264 "" addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen) 80); +#line 18264 "" } /* Terminate user-defined offsets. Fix format */ +#line 18269 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],17)) { +#line 18269 "" putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, ( ftnlen)80); +#line 18269 "" } /* Deal with After- and Way-after-graces. First, if end of bar, compute space */ @@ -26823,142 +43411,225 @@ L30: /* rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. */ /* But will still need to add extra space as hardspace. */ +#line 18277 "" if (ip == all_1.nn[commvl_1.ivx - 1] && (bit_test( all_1.ipl[commvl_1.ivx + ip * 24 - 25],31) || bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 29))) { +#line 18279 "" i__12 = comgrace_1.ngrace; +#line 18279 "" for (ig = 1; ig <= i__12; ++ig) { +#line 18280 "" if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1] == commvl_1.ivx) { +#line 18280 "" goto L78; +#line 18280 "" } +#line 18281 "" /* L77: */ +#line 18281 "" } - s_wsle(&io___1072); - do_lio(&c__9, &c__1, "Problem finding grace index " +#line 18282 "" + s_wsle(&io___1117); +#line 18282 "" + do_lio(&c__9, &c__1, "Problem finding grace index "\ "at \"do 77\"", (ftnlen)38); +#line 18282 "" e_wsle(); +#line 18283 "" stop1_(); +#line 18284 "" L78: /* Get elemskip to end of bar. WON'T WORK IF XTUPS !! */ +#line 18288 "" esk = 0.f; +#line 18289 "" i__12 = comnsp_2.nb; +#line 18289 "" for (iib = ib; iib <= i__12; ++iib) { +#line 18290 "" if (iib == ib) { +#line 18291 "" itleft = i_nint(&all_1.to[comipl2_1.ipl2[ commvl_1.ivx + ip * 24 - 25] - 1]); +#line 18292 "" } else { +#line 18293 "" itleft = i_nint(&tstart[ib]); +#line 18294 "" } +#line 18295 "" if (iib < comnsp_2.nb) { +#line 18296 "" itright = i_nint(&tstart[iib + 1]); +#line 18297 "" } else { +#line 18298 "" itright = all_1.lenbar; +#line 18299 "" } +#line 18300 "" esk += feon_(&comnsp_2.space[ib - 1]) * (itright - itleft) / comnsp_2.space[ib - 1]; +#line 18302 "" /* L40: */ +#line 18302 "" } +#line 18303 "" ptsavail = comask_1.poenom * esk - comask_1.wheadpt; +#line 18304 "" if (comgrace_1.nng[ig - 1] == 1) { +#line 18305 "" wgr = spfacs_1.grafac; +#line 18306 "" } else { +#line 18307 "" wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; +#line 18308 "" i__12 = comgrace_1.nng[ig - 1]; +#line 18308 "" for (ing = 1; ing <= i__12; ++ing) { +#line 18309 "" if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing - 1] > 0) { +#line 18309 "" wgr += spfacs_1.acgfac; +#line 18309 "" } +#line 18310 "" /* L41: */ +#line 18310 "" } +#line 18311 "" } +#line 18312 "" ptgr[ig - 1] = wgr * comask_1.wheadpt; +#line 18313 "" ptsneed = (wgr + .5f) * comask_1.wheadpt; +#line 18314 "" ptsndg[commvl_1.ivx - 1] = 0.f; +#line 18315 "" if (ptsavail < ptsneed) { +#line 18316 "" ptsndg[commvl_1.ivx - 1] = ptsneed; +#line 18317 "" eskndg[commvl_1.ivx - 1] = esk; +#line 18318 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31)) { /* Convert GW to GA */ +#line 18322 "" all_1.ipl[commvl_1.ivx + ip * 24 - 25] = bit_set(bit_clear(all_1.ipl[ commvl_1.ivx + ip * 24 - 25],31),29); +#line 18323 "" } +#line 18324 "" } +#line 18325 "" } /* Check for GA */ +#line 18329 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) { +#line 18329 "" i__12 = ncmid_(&all_1.iv, &ip); +#line 18329 "" dograce_(&commvl_1.ivx, &ip, ptgr, soutq, &lsout, & i__12, &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &ig, &all_1.ipl[commvl_1.ivx + ip * 24 - 25], &c_false, &c_false, &c__0, &c__0, &c__0, - &c__0, &c__0, &c__0, &c_b774, all_1.ulq, & + &c__0, &c__0, &c__0, &c_b1009, all_1.ulq, & cominsttrans_1.instno[all_1.iv - 1], (ftnlen) 80, (ftnlen)1); +#line 18329 "" } /* 130324 */ /* * .false.,0,0,0,0,0,0,0.,ulq) */ /* Update running time */ +#line 18338 "" tnow += comnsp_2.space[ib - 1]; +#line 18339 "" L10: +#line 18339 "" ; +#line 18339 "" } /* Have finished last note in this voice and block */ +#line 18343 "" r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1]; +#line 18343 "" itendb = i_nint(&r__1); +#line 18344 "" if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { +#line 18345 "" ivf = 1; +#line 18346 "" if (commvl_1.ivx > 1) { +#line 18346 "" ivf = 2; +#line 18346 "" } +#line 18347 "" L17: +#line 18347 "" if (all_1.figchk[ivf - 1] && comfig_1.itfig[ivf + (ifig[ ivf - 1] << 1) - 3] < itendb) { /* There's at least one figure left. offnsk could be <0 */ +#line 18351 "" offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) - 3]) / comnsp_2.space[ib - 1]; +#line 18352 "" putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[ ivf - 1], soutq, &lsout, (ftnlen)80); +#line 18353 "" goto L17; +#line 18354 "" } +#line 18355 "" } /* Check for flag, dot, or upstem on last note of bar. */ +#line 18359 "" if (ib == comnsp_2.nb) { +#line 18360 "" ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[ commvl_1.ivx - 1] * 24 - 25] - 1]; +#line 18361 "" comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f; +#line 18362 "" if ((r__1 = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] - comnsp_2.space[ib - 1], dabs( r__1)) < comtol_1.tol) { +#line 18363 "" if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) { /* Note in last space, smaller than a quarter note. */ +#line 18367 "" i__10 = ncmid_(&all_1.iv, &ip); +#line 18367 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - 25], &i__10, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], & commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); +#line 18367 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0) && *(unsigned char *)&ch__6[0] == 'u' || isdotted_(all_1.nodur, & @@ -26967,7 +43638,9 @@ L17: /* Upstem non-rest, or dotted */ /* Computing MAX */ +#line 18374 "" i__10 = 1, i__12 = numbms[commvl_1.ivx]; +#line 18374 "" if (numbms[commvl_1.ivx] > 0 && ip == all_1.ibm2[commvl_1.ivx + max(i__10, i__12) * 24 - 25] && ! isdotted_( @@ -26975,48 +43648,70 @@ L17: /* In beam and not dotted, so use smaller space */ +#line 18381 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.upstmfac; +#line 18382 "" } else { +#line 18383 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.flagfac; +#line 18384 "" } +#line 18385 "" } +#line 18386 "" } else { /* Last space, nonflagged (no beam) only worry dot or up */ +#line 18390 "" if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { +#line 18391 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.flagfac; +#line 18392 "" } else /* if(complicated condition) */ { +#line 18392 "" i__10 = ncmid_(&all_1.iv, &ip); +#line 18392 "" udqq_(ch__6, (ftnlen)1, &all_1.nolev[ commvl_1.ivx + ip * 24 - 25], &i__10, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], & commvl_1.ivx, &all_1.nv); +#line 18392 "" if (all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1] < 64.f && *( unsigned char *)&ch__6[0] == 'u') { /* Upstem on last note , non-flagged */ +#line 18398 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.upstmfac; +#line 18399 "" } +#line 18399 "" } +#line 18400 "" } +#line 18401 "" } /* Check for right-shifted chordal note */ +#line 18405 "" if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20)) { +#line 18405 "" comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac; +#line 18405 "" } +#line 18406 "" comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[ commvl_1.ivx - 1] > 0.f; +#line 18407 "" if (commidi_1.ismidi) { /* For midi, set flags for accidentals on last note of bar. Assume they affect */ @@ -27028,64 +43723,102 @@ L17: /* c Old old lbacc(icm) = iand(nacc(ivx,ip),7) */ /* New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) */ +#line 18418 "" if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0) { /* Explicit accidental on last main note in bar */ +#line 18422 "" i__10 = comslm_1.naccbl[icm]; +#line 18422 "" for (kacc = 1; kacc <= i__10; ++kacc) { +#line 18423 "" if (comslm_1.laccbl[icm + kacc * 25 - 25] == all_1.nolev[commvl_1.ivx + ip * 24 - 25]) { +#line 18423 "" goto L56; +#line 18423 "" } +#line 18424 "" /* L55: */ +#line 18424 "" } +#line 18425 "" ++comslm_1.naccbl[icm]; +#line 18426 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; +#line 18427 "" i__10 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; +#line 18427 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = iashft_(&i__10); +#line 18428 "" } +#line 18429 "" L56: +#line 18430 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], 10) && commidi_1.crdacc) { +#line 18431 "" i__10 = comtrill_1.icrd2; +#line 18431 "" for (icrd = comtrill_1.icrd1; icrd <= i__10; ++icrd) { +#line 18432 "" iacc = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); +#line 18433 "" if (iacc > 0) { /* Explicit accidental on chord note at end of bar */ +#line 18437 "" nolevc = igetbits_(&comtrill_1.icrdat[ icrd - 1], &c__7, &c__12); +#line 18438 "" i__12 = comslm_1.naccbl[icm]; +#line 18438 "" for (kacc = 1; kacc <= i__12; ++kacc) { +#line 18439 "" if (comslm_1.laccbl[icm + kacc * 25 - 25] == nolevc) { +#line 18439 "" goto L59; +#line 18439 "" } +#line 18440 "" /* L58: */ +#line 18440 "" } +#line 18441 "" ++comslm_1.naccbl[icm]; +#line 18442 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = nolevc; +#line 18443 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = iashft_(&iacc); +#line 18444 "" } +#line 18445 "" L59: +#line 18446 "" /* L57: */ +#line 18446 "" ; +#line 18446 "" } +#line 18447 "" } /* if (lbacc(icm).eq.0 .and. accb4(icm)) then */ +#line 18449 "" i__10 = commidi_1.naccim[icm]; +#line 18449 "" for (kacc = 1; kacc <= i__10; ++kacc) { /* If naccim(icm)>0, */ @@ -27094,336 +43827,570 @@ L59: /* explicit action from just above. Assuming any accid on last note in bar, */ /* either explicit or implicit, has same effect on 1st note of next bar. */ +#line 18457 "" if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] == commidi_1.laccim[icm + kacc * 25 - 25]) { +#line 18457 "" goto L66; +#line 18457 "" } +#line 18458 "" if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { +#line 18459 "" i__12 = comtrill_1.icrd2; +#line 18459 "" for (icrd = comtrill_1.icrd1; icrd <= i__12; ++icrd) { +#line 18460 "" if ((lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-12) & 127) == commidi_1.laccim[icm + kacc * 25 - 25]) { +#line 18460 "" goto L66; +#line 18460 "" } +#line 18462 "" /* L67: */ +#line 18462 "" } +#line 18463 "" } +#line 18464 "" goto L65; +#line 18465 "" L66: /* So far we know there is a main or chord note at level laccim(icm,kacc). So */ /* it will get a bl-accid if it didn't just already get one. */ +#line 18470 "" i__12 = comslm_1.naccbl[icm]; +#line 18470 "" for (macc = 1; macc <= i__12; ++macc) { +#line 18471 "" if (comslm_1.laccbl[icm + macc * 25 - 25] == commidi_1.laccim[icm + kacc * 25 - 25] ) { +#line 18471 "" goto L65; +#line 18471 "" } +#line 18472 "" /* L68: */ +#line 18472 "" } +#line 18473 "" ++comslm_1.naccbl[icm]; +#line 18474 "" comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = commidi_1.laccim[icm + kacc * 25 - 25]; +#line 18475 "" comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - 25] = commidi_1.jaccim[icm + kacc * 25 - 25]; +#line 18476 "" L65: +#line 18476 "" ; +#line 18476 "" } +#line 18477 "" } +#line 18478 "" } +#line 18479 "" /* L11: */ +#line 18479 "" } +#line 18479 "" } /* Close out the notes group */ /* Writing concatenation */ +#line 18483 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18483 "" i__4[1] = 2, a__2[1] = "en"; +#line 18483 "" s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); +#line 18483 "" addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80); +#line 18484 "" if (comlast_1.islast && lsout > 0) { - s_wsfe(&io___1085); +#line 18484 "" + s_wsfe(&io___1130); /* Writing concatenation */ +#line 18484 "" i__4[0] = lsout, a__2[0] = soutq; +#line 18484 "" i__4[1] = 1, a__2[1] = "%"; +#line 18484 "" s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 18484 "" do_fio(&c__1, ch__12, lsout + 1); +#line 18484 "" e_wsfe(); +#line 18484 "" } +#line 18485 "" /* L16: */ +#line 18485 "" } /* Check for way-after graces at end of bar. We could not link these to notes */ /* as in midbar since there is no note following grace! Also, set flag if */ /* hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. */ +#line 18491 "" isgrace = FALSE_; +#line 18492 "" i__2 = all_1.nv; +#line 18492 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 18493 "" comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1]; +#line 18494 "" i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 18494 "" for (kv = 1; kv <= i__7; ++kv) { +#line 18495 "" comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[ all_1.iv + kv * 24 - 25]; +#line 18496 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 18497 "" comnsp_2.ptsgnd = 0.f; +#line 18498 "" if ((bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) && ptsndg[ commvl_1.ivx - 1] > 0.f) { +#line 18500 "" comnsp_2.flgndb = TRUE_; +#line 18501 "" if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) { +#line 18502 "" comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1]; +#line 18503 "" comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1]; +#line 18504 "" } +#line 18505 "" } +#line 18506 "" if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) { /* This voice has a way-after grace here at end of bar */ +#line 18510 "" if (! isgrace) { /* This is the first one, so set up the string */ +#line 18514 "" isgrace = TRUE_; +#line 18515 "" ivlast = 1; /* Writing concatenation */ +#line 18516 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18516 "" i__4[1] = 6, a__2[1] = "znotes"; +#line 18516 "" s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 18517 "" lsout = 7; +#line 18518 "" } +#line 18519 "" i__1 = all_1.iv - 1; +#line 18519 "" for (iiv = ivlast; iiv <= i__1; ++iiv) { +#line 18520 "" addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, ( ftnlen)1, (ftnlen)80); +#line 18521 "" /* L76: */ +#line 18521 "" } +#line 18522 "" ivlast = all_1.iv; /* No need to put in 'nextvoice', even if 2 lines/staff */ +#line 18526 "" i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]); +#line 18526 "" dograce_(&commvl_1.ivx, &all_1.nn[commvl_1.ivx - 1], ptgr, soutq, &lsout, &i__1, &all_1.nacc[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25], &ig, & all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25], &c_true, &c_false, &c__0, &c__0, &c__0, & - c__0, &c__0, &c__0, &c_b774, all_1.ulq, & + c__0, &c__0, &c__0, &c_b1009, all_1.ulq, & cominsttrans_1.instno[all_1.iv - 1], (ftnlen)80, ( ftnlen)1); /* 130324 */ /* * .false.,0,0,0,0,0,0,0.,ulq) */ +#line 18531 "" } +#line 18532 "" /* L75: */ +#line 18532 "" } +#line 18532 "" } +#line 18533 "" if (isgrace) { /* Writing concatenation */ +#line 18534 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18534 "" i__4[1] = 3, a__2[1] = "en%"; +#line 18534 "" s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)4); +#line 18534 "" addstr_(ch__19, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80); +#line 18535 "" if (comlast_1.islast && lsout > 0) { - s_wsfe(&io___1088); +#line 18535 "" + s_wsfe(&io___1133); +#line 18535 "" do_fio(&c__1, soutq, lsout); +#line 18535 "" e_wsfe(); +#line 18535 "" } +#line 18536 "" } +#line 18537 "" lsout = 0; /* Write multibar rest. Assuming nv = 1 and do not worry about cwbrest */ /* This has to be the only use of atnextbar */ +#line 18542 "" if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) { /* Writing concatenation */ +#line 18543 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 18543 "" i__3[1] = 3, a__1[1] = "def"; +#line 18543 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 18543 "" i__3[3] = 10, a__1[3] = "atnextbar{"; +#line 18543 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 18543 "" i__3[5] = 6, a__1[5] = "znotes"; +#line 18543 "" s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80); +#line 18544 "" lsout = 22; /* Writing concatenation */ +#line 18545 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18545 "" i__4[1] = 6, a__2[1] = "mbrest"; +#line 18545 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18546 "" lnote = 7; +#line 18547 "" istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8); /* Writing concatenation */ +#line 18548 "" i__4[0] = lnote, a__2[0] = notexq; +#line 18548 "" i__4[1] = len, a__2[1] = noteq; +#line 18548 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 18549 "" lnote += len; +#line 18550 "" mtrspc = i_nint(&comgrace_1.xb4mbr); +#line 18551 "" comgrace_1.xb4mbr = 0.f; +#line 18552 "" istring_(&mtrspc, noteq, &len, (ftnlen)8); /* Writing concatenation */ +#line 18553 "" i__6[0] = lnote, a__4[0] = notexq; +#line 18553 "" i__6[1] = len, a__4[1] = noteq; +#line 18553 "" i__6[2] = 1, a__4[2] = "0"; +#line 18553 "" s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); +#line 18554 "" lnote = lnote + len + 1; +#line 18555 "" i__7 = all_1.nv; +#line 18555 "" for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 18556 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); +#line 18557 "" if (all_1.iv < all_1.nv) { +#line 18557 "" addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 18557 "" } +#line 18558 "" /* L62: */ +#line 18558 "" } /* Writing concatenation */ +#line 18559 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18559 "" i__4[1] = 4, a__2[1] = "en}%"; +#line 18559 "" s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 18559 "" addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); - s_wsfe(&io___1091); +#line 18560 "" + s_wsfe(&io___1136); +#line 18560 "" do_fio(&c__1, soutq, lsout); +#line 18560 "" e_wsfe(); +#line 18561 "" lsout = 0; +#line 18562 "" if (comgrace_1.mbrest > 1) { +#line 18563 "" r__1 = comgrace_1.mbrest - 1 + .01f; +#line 18563 "" ndig = (integer) r_lg10(&r__1) + 1; +#line 18564 "" ci__1.cierr = 0; +#line 18564 "" ci__1.ciunit = 11; /* Writing concatenation */ +#line 18564 "" i__6[0] = 6, a__4[0] = "(a14,i"; +#line 18564 "" i__7 = ndig + 48; +#line 18564 "" chax_(ch__6, (ftnlen)1, &i__7); +#line 18564 "" i__6[1] = 1, a__4[1] = ch__6; +#line 18564 "" i__6[2] = 4, a__4[2] = ",a1)"; +#line 18564 "" ci__1.cifmt = (s_cat(ch__9, a__4, i__6, &c__3, (ftnlen)11), ch__9) ; +#line 18564 "" s_wsfe(&ci__1); /* Writing concatenation */ +#line 18564 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 18564 "" i__9[1] = 7, a__6[1] = "advance"; +#line 18564 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 18564 "" i__9[3] = 5, a__6[3] = "barno"; +#line 18564 "" s_cat(ch__4, a__6, i__9, &c__4, (ftnlen)14); +#line 18564 "" do_fio(&c__1, ch__4, (ftnlen)14); +#line 18564 "" i__2 = comgrace_1.mbrest - 1; +#line 18564 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 18564 "" do_fio(&c__1, "%", (ftnlen)1); +#line 18564 "" e_wsfe(); +#line 18566 "" } +#line 18567 "" } else if (iscwr) { /* Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar */ /* to check for new clef and add space by redefining \CenterBar */ +#line 18572 "" comclefrests_1.centrests = TRUE_; /* Writing concatenation */ +#line 18573 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 18573 "" i__9[1] = 3, a__6[1] = "def"; +#line 18573 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 18573 "" i__9[3] = 8, a__6[3] = "value{0}"; +#line 18573 "" s_cat(ch__20, a__6, i__9, &c__4, (ftnlen)13); +#line 18573 "" addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, (ftnlen)80); /* Writing concatenation */ +#line 18574 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 18574 "" i__3[1] = 3, a__1[1] = "def"; +#line 18574 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 18574 "" i__3[3] = 10, a__1[3] = "atnextbar{"; +#line 18574 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 18574 "" i__3[5] = 6, a__1[5] = "znotes"; +#line 18574 "" s_cat(ch__21, a__1, i__3, &c__6, (ftnlen)22); +#line 18574 "" addstr_(ch__21, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80); +#line 18576 "" i__7 = all_1.nv; +#line 18576 "" for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { /* added */ +#line 18578 "" lnote = 0; +#line 18580 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 18580 "" for (kv = 1; kv <= i__2; ++kv) { +#line 18581 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 18582 "" if (cwrest[commvl_1.ivx]) { /* Writing concatenation */ +#line 18583 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18583 "" i__4[1] = 10, a__2[1] = "CenterBar{"; +#line 18583 "" s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); +#line 18583 "" addstr_(ch__9, &c__11, soutq, &lsout, (ftnlen)11, (ftnlen) 80); +#line 18584 "" if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { +#line 18585 "" if (lcwr[commvl_1.ivx - 1] >= 11 && *(unsigned char *) &cwrq[(commvl_1.ivx - 1) * 79 + 10] != 'p') { /* Kluge to use new definitions for centered, stacked rests */ +#line 18589 "" if (s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1), "liftpause", (ftnlen)9, (ftnlen)9) == 0 || s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1), "liftPAuse", (ftnlen)9, (ftnlen)9) == 0) { +#line 18589 "" *(unsigned char *)&cwrq[(commvl_1.ivx - 1) * 79 + 9] = 'c'; +#line 18589 "" } +#line 18592 "" } +#line 18593 "" addstr_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ commvl_1.ivx - 1], soutq, &lsout, lcwr[ commvl_1.ivx - 1], (ftnlen)80); /* Writing concatenation */ +#line 18595 "" i__6[0] = 6, a__4[0] = "}{-2}{"; +#line 18595 "" i__6[1] = 1, a__4[1] = all_1.sq; +#line 18595 "" i__6[2] = 6, a__4[2] = "value}"; +#line 18595 "" s_cat(ch__20, a__4, i__6, &c__3, (ftnlen)13); +#line 18595 "" addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, ( ftnlen)80); +#line 18596 "" } else { /* Fermata on centered rest. Will need to fix up level. */ /* 12/6/07 shift it left so it's centered over rest */ /* Writing concatenation */ +#line 18601 "" i__15[0] = lnote, a__9[0] = notexq; +#line 18601 "" i__15[1] = 1, a__9[1] = all_1.sq; +#line 18601 "" i__15[2] = 13, a__9[2] = "loffset{.33}{"; +#line 18601 "" i__15[3] = 1, a__9[3] = all_1.sq; +#line 18601 "" i__15[4] = 11, a__9[4] = "fermataup7}"; +#line 18601 "" i__15[5] = lcwr[commvl_1.ivx - 1], a__9[5] = cwrq + ( commvl_1.ivx - 1) * 79; +#line 18601 "" i__15[6] = 6, a__9[6] = "}{-2}{"; +#line 18601 "" i__15[7] = 1, a__9[7] = all_1.sq; +#line 18601 "" i__15[8] = 6, a__9[8] = "value}"; +#line 18601 "" s_cat(notexq, a__9, i__15, &c__9, (ftnlen)79); +#line 18604 "" lnote = lnote + 26 + lcwr[commvl_1.ivx - 1] + 13; +#line 18605 "" addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( ftnlen)80); +#line 18606 "" comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; +#line 18607 "" } +#line 18608 "" } +#line 18609 "" /* L61: */ +#line 18609 "" } +#line 18610 "" if (all_1.iv != all_1.nv) { +#line 18610 "" addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 18610 "" } +#line 18611 "" /* L60: */ +#line 18611 "" } +#line 18612 "" if (comlast_1.islast) { /* Writing concatenation */ +#line 18613 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 18613 "" i__4[1] = 4, a__2[1] = "en}%"; +#line 18613 "" s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 18613 "" addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); +#line 18614 "" if (lsout > 0) { - s_wsfe(&io___1093); +#line 18614 "" + s_wsfe(&io___1138); +#line 18614 "" do_fio(&c__1, soutq, lsout); +#line 18614 "" e_wsfe(); +#line 18614 "" } +#line 18615 "" } +#line 18616 "" } /* End of block for centered whole-bar rests and multi-bar rests */ @@ -27431,33 +44398,52 @@ L65: /* If at end of block, save durations of last notes in bar, for possible use */ /* if clef changes at start of next bar */ +#line 18623 "" if (all_1.ibar == all_1.nbars) { +#line 18624 "" i__7 = all_1.nv; +#line 18624 "" for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 18625 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 18625 "" for (kv = 1; kv <= i__2; ++kv) { +#line 18626 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 18627 "" comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25] - 1]; +#line 18628 "" /* L63: */ +#line 18628 "" } +#line 18628 "" } +#line 18629 "" } /* Update time for midi. This is only used for the event track */ +#line 18633 "" if (commidi_1.ismidi) { +#line 18634 "" comevent_1.miditime += all_1.lenbar * 15; /* If pickup, write the real time signature to the event track. Cannot use */ /* mtrnuml since it was reset to 0, have to recompute it */ +#line 18639 "" if (all_1.lenb0 == all_1.lenbar) { +#line 18639 "" i__2 = all_1.mtrdenl * all_1.lenb1 / 64; +#line 18639 "" midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1); +#line 18639 "" } +#line 18641 "" } +#line 18642 "" return 0; } /* make2bar_ */ @@ -27523,106 +44509,185 @@ L65: /* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ /* logical rest,firstline,newmeter,gotclef */ +#line 18691 "" linecom_1.elskb = 0.f; +#line 18692 "" linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f; +#line 18693 "" i__1 = a1ll_2.nv; +#line 18693 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 18694 "" i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 18694 "" for (kv = 1; kv <= i__2; ++kv) { +#line 18695 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 18696 "" if (a1ll_2.ibar > 1) { +#line 18697 "" a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25] - a1ll_2.nib[c1ommvl_1.ivx + ( a1ll_2.ibar - 1) * 24 - 25]; +#line 18698 "" } else { +#line 18699 "" a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25]; +#line 18700 "" } +#line 18701 "" /* L1: */ +#line 18701 "" } +#line 18701 "" } /* initialize list note counter, time(iv), curr. note(iv) */ +#line 18705 "" ilnc = 1; +#line 18706 "" i__2 = a1ll_2.nv; +#line 18706 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { +#line 18707 "" i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 18707 "" for (kv = 1; kv <= i__1; ++kv) { +#line 18708 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 18709 "" cnn[c1ommvl_1.ivx - 1] = 1; +#line 18710 "" a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx; +#line 18711 "" a1ll_2.ipo[ilnc - 1] = 1; +#line 18712 "" a1ll_2.to[ilnc - 1] = 0.f; +#line 18713 "" tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1, c1ommvl_1.nacc); +#line 18714 "" xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1]; +#line 18715 "" if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) < comtol_1.tol) { +#line 18715 "" xit[c1ommvl_1.ivx - 1] = 1e3f; +#line 18715 "" } +#line 18716 "" ++ilnc; +#line 18717 "" /* L4: */ +#line 18717 "" } +#line 18717 "" } /* Build the list */ +#line 18721 "" L5: /* Determine which voice comes next from end of notes done so far. */ /* tmin is the earliest ending time of notes done so far */ +#line 18726 "" tmin = 1e3f; +#line 18727 "" i__1 = a1ll_2.nv; +#line 18727 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 18728 "" i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 18728 "" for (kv = 1; kv <= i__2; ++kv) { +#line 18729 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; /* Computing MIN */ +#line 18730 "" r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1]; +#line 18730 "" tminn = dmin(r__1,r__2); +#line 18731 "" if (tminn < tmin) { +#line 18732 "" tmin = tminn; +#line 18733 "" ivnext = c1ommvl_1.ivx; +#line 18734 "" } +#line 18735 "" /* L6: */ +#line 18735 "" } +#line 18735 "" } +#line 18736 "" if (tmin > 999.f) { +#line 18736 "" goto L7; +#line 18736 "" } +#line 18737 "" a1ll_2.ivxo[ilnc - 1] = ivnext; +#line 18738 "" ++cnn[ivnext - 1]; +#line 18739 "" a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1]; +#line 18740 "" a1ll_2.to[ilnc - 1] = tmin; /* Check if this voice is done */ +#line 18744 "" tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1], c1ommvl_1.nacc); +#line 18745 "" if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) { +#line 18746 "" xit[ivnext - 1] = 1e3f; +#line 18747 "" } else { +#line 18748 "" xit[ivnext - 1] += tnote[ilnc - 1]; +#line 18749 "" } +#line 18750 "" ++ilnc; +#line 18751 "" goto L5; +#line 18752 "" L7: +#line 18753 "" ntot = ilnc - 1; +#line 18754 "" if (ntot > 600) { +#line 18755 "" printl_(" ", (ftnlen)1); +#line 18756 "" printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen) 49); +#line 18757 "" stop1_(); +#line 18758 "" } +#line 18759 "" i__2 = ntot - 1; +#line 18759 "" for (in = 1; in <= i__2; ++in) { +#line 18760 "" a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1]; +#line 18761 "" /* L8: */ +#line 18761 "" } +#line 18762 "" a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], & a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc); +#line 18763 "" tnote[ntot - 1] = a1ll_2.tno[ntot - 1]; /* Debug writes */ @@ -27637,130 +44702,198 @@ L7: /* Done w/ list. Initialize loop for building note blocks: */ +#line 18777 "" ib = 1; +#line 18778 "" istart[0] = 1; +#line 18779 "" space[0] = 0.f; +#line 18780 "" in = 1; /* Start the loop */ +#line 18784 "" L9: +#line 18785 "" if (in == ntot) { +#line 18786 "" if (space[ib - 1] < comtol_1.tol) { +#line 18787 "" space[ib - 1] = a1ll_2.tno[in - 1]; /* Last gap in bar is spanned by a note, so cannot need a squeeze. */ +#line 18791 "" squez[ib - 1] = 1.f; +#line 18792 "" } +#line 18793 "" istop[ib - 1] = ntot; /* From here flow out of this if block and into block-setup */ +#line 18797 "" } else if (space[ib - 1] < comtol_1.tol) { /* space hasn't been set yet, so tentatively set: */ +#line 18801 "" space[ib - 1] = a1ll_2.tno[in - 1]; +#line 18802 "" if (space[ib - 1] < comtol_1.tol) { +#line 18803 "" ++in; +#line 18804 "" } else { /* Tentative space tno(in) is non-zero. Set squez, which will be kept (since */ /* it is a unique property of the particular increment starting here) : */ +#line 18809 "" squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, a1ll_2.to); +#line 18810 "" istop[ib - 1] = in; +#line 18811 "" } +#line 18812 "" goto L9; +#line 18813 "" } else if (a1ll_2.tno[in] < comtol_1.tol) { /* This is not the last note in the space, so */ +#line 18817 "" ++in; +#line 18818 "" goto L9; +#line 18819 "" } else if ((r__1 = a1ll_2.tno[in] - space[ib - 1], dabs(r__1)) < comtol_1.tol) { /* Next increment has same space. Does it have same squez? */ +#line 18823 "" i__2 = in + 1; +#line 18823 "" xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to); /* If it does have the same squez, loop, otherwise flow out */ +#line 18827 "" if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) { /* Keep spacing the same, update tentative stop point */ +#line 18831 "" ++in; +#line 18832 "" istop[ib - 1] = in; +#line 18833 "" goto L9; +#line 18834 "" } +#line 18835 "" } /* At this point istart, istop, space, and squez are good, so close out block */ +#line 18839 "" tstart[ib - 1] = a1ll_2.to[istart[ib - 1] - 1]; /* Compute elemskips assuming no flattening to increase min space. The formula */ /* is only correct if f1eon(t) = sqrt(t/2); more generally (after possible */ /* flattening in pmxb), elsperns = squez*feon(space/squez) */ +#line 18845 "" r__1 = space[ib - 1] * squez[ib - 1]; +#line 18845 "" elsperns = f1eon_(&r__1); +#line 18846 "" if (istop[ib - 1] == ntot) { +#line 18847 "" r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1]; +#line 18847 "" nnsk = i_nint(&r__1); +#line 18848 "" } else { +#line 18849 "" r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1]; +#line 18849 "" nnsk = i_nint(&r__1); +#line 18850 "" } +#line 18851 "" linecom_1.elskb += elsperns * nnsk; +#line 18852 "" if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[ c1omnotes_1.ibarcnt - 1]) { +#line 18853 "" catspace_(&space[ib - 1], &squez[ib - 1], &nnsk); +#line 18854 "" } else { /* This is the first entry for this bar */ +#line 18858 "" c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = nnsk; +#line 18859 "" c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = space[ib - 1]; +#line 18860 "" c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = squez[ib - 1]; +#line 18861 "" ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; +#line 18862 "" } /* Update minimum space spanned by a note */ +#line 18866 "" if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) { /* Computing MIN */ +#line 18866 "" r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1] ; +#line 18866 "" linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3); +#line 18866 "" } +#line 18868 "" if (istop[ib - 1] == ntot) { +#line 18868 "" goto L15; +#line 18868 "" } /* End of spatial accounting for now */ +#line 18872 "" ++ib; +#line 18873 "" istart[ib - 1] = istop[ib - 2] + 1; +#line 18874 "" in = istart[ib - 1]; /* Set tentative block space for new block */ +#line 18878 "" space[ib - 1] = a1ll_2.tno[in - 1]; +#line 18879 "" if (space[ib - 1] > comtol_1.tol) { +#line 18879 "" squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, a1ll_2.to); +#line 18879 "" } +#line 18881 "" istop[ib - 1] = in; +#line 18882 "" goto L9; +#line 18883 "" L15: /* nb = ib */ @@ -27771,6 +44904,7 @@ L15: /* write(*,'(16f5.1)')(space(ib),ib=1,nb) */ /* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */ +#line 18893 "" return 0; } /* makeabar_ */ @@ -27793,89 +44927,136 @@ L15: static integer nbytes, misperq; /* Fortran I/O blocks */ - static cilist io___1117 = { 0, 6, 0, 0, 0 }; + static cilist io___1162 = { 0, 6, 0, 0, 0 }; /* We now store "conductor" events in mmidi(numchan,.), and count bytes */ /* with imidi(numchan) */ +#line 18912 "" i__1 = comevent_1.miditime - comevent_1.lasttime; +#line 18912 "" idur = isetvarlen_(&i__1, &nbytes); +#line 18913 "" commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] + nbytes + 1; +#line 18914 "" i__1 = nbytes; +#line 18914 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 18915 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256) ; +#line 18916 "" idur = lbit_shift(idur, (ftnlen)-8); +#line 18917 "" /* L1: */ +#line 18917 "" } +#line 18918 "" commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] * 25 - 25] = 255; +#line 18919 "" if (*(unsigned char *)typeq == 't') { /* Tempo event. in1 = quarters per minute (integer) */ +#line 18923 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 81; +#line 18924 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 3; +#line 18925 "" r__1 = 6e7f / *in1; +#line 18925 "" misperq = i_nint(&r__1); +#line 18926 "" for (i__ = 1; i__ <= 3; ++i__) { +#line 18927 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) ( misperq % 256); +#line 18928 "" misperq = lbit_shift(misperq, (ftnlen)-8); +#line 18929 "" /* L2: */ +#line 18929 "" } +#line 18930 "" commidi_1.imidi[commidi_1.numchan] += 5; +#line 18931 "" } else if (*(unsigned char *)typeq == 'm') { /* Meter event. in1=numerator, in2=denom (power of 2) */ +#line 18935 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 88; +#line 18936 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 4; +#line 18937 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1); +#line 18938 "" if (*in2 > 0) { +#line 18939 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2) ; +#line 18940 "" } else { +#line 18941 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = 0; +#line 18942 "" } +#line 18943 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 5) * 25 - 25] = 24; +#line 18944 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 6) * 25 - 25] = 8; +#line 18945 "" commidi_1.imidi[commidi_1.numchan] += 6; +#line 18946 "" } else if (*(unsigned char *)typeq == 'k') { /* Keychange event. in1 = isig */ +#line 18950 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 1) * 25 - 25] = 89; +#line 18951 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 2) * 25 - 25] = 2; +#line 18952 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256) % 256); +#line 18953 "" commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ commidi_1.numchan] + 4) * 25 - 25] = 0; +#line 18954 "" commidi_1.imidi[commidi_1.numchan] += 4; +#line 18955 "" } else { - s_wsle(&io___1117); +#line 18956 "" + s_wsle(&io___1162); +#line 18956 "" do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29); +#line 18956 "" e_wsle(); +#line 18957 "" stop1_(); +#line 18958 "" } +#line 18959 "" comevent_1.lasttime = comevent_1.miditime; +#line 18960 "" return 0; } /* midievent_ */ @@ -27894,32 +45075,55 @@ L15: static integer lenout; /* Fortran I/O blocks */ - static cilist io___1118 = { 0, 0, 1, "(a)", 0 }; - static cilist io___1121 = { 0, 0, 0, "(a)", 0 }; + static cilist io___1163 = { 0, 0, 1, "(a)", 0 }; + static cilist io___1166 = { 0, 0, 0, "(a)", 0 }; +#line 18965 "" *done = FALSE_; - io___1118.ciunit = *iuin; - i__1 = s_rsfe(&io___1118); +#line 18966 "" + io___1163.ciunit = *iuin; +#line 18966 "" + i__1 = s_rsfe(&io___1163); +#line 18966 "" if (i__1 != 0) { +#line 18966 "" goto L1; +#line 18966 "" } +#line 18966 "" i__1 = do_fio(&c__1, outq, (ftnlen)129); +#line 18966 "" if (i__1 != 0) { +#line 18966 "" goto L1; +#line 18966 "" } +#line 18966 "" i__1 = e_rsfe(); +#line 18966 "" if (i__1 != 0) { +#line 18966 "" goto L1; +#line 18966 "" } +#line 18967 "" lenout = llen_(outq, &c__129, (ftnlen)129); - io___1121.ciunit = *iuout; - s_wsfe(&io___1121); +#line 18968 "" + io___1166.ciunit = *iuout; +#line 18968 "" + s_wsfe(&io___1166); +#line 18968 "" do_fio(&c__1, outq, lenout); +#line 18968 "" e_wsfe(); +#line 18969 "" return 0; +#line 18970 "" L1: +#line 18970 "" *done = TRUE_; +#line 18971 "" return 0; } /* moveln_ */ @@ -27939,34 +45143,55 @@ L1: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ +#line 18987 "" if (! commac_1.mrecord) { /* Starting the macro */ +#line 18991 "" c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; +#line 18992 "" c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 18993 "" c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; +#line 18994 "" commac_1.mrecord = TRUE_; +#line 18995 "" } +#line 18996 "" if (*iccount < 128) { +#line 18997 "" i__1 = *iccount; +#line 18997 "" *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); +#line 18998 "" if (*ndxm > 0) { +#line 18998 "" i__1 = *iccount; +#line 18998 "" i__2 = 128 - *iccount; +#line 18998 "" *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); +#line 18998 "" } +#line 19000 "" if (*ndxm > 0) { /* This line ends the macro. */ +#line 19004 "" c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; +#line 19005 "" c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 19006 "" commac_1.mrecord = FALSE_; +#line 19007 "" } +#line 19008 "" } +#line 19009 "" return 0; } /* mrec1_ */ @@ -27985,25 +45210,42 @@ integer ncmid_(integer *iv, integer *ip) static real xtime; /* Fortran I/O blocks */ - static cilist io___1124 = { 0, 6, 0, 0, 0 }; + static cilist io___1169 = { 0, 6, 0, 0, 0 }; +#line 19029 "" if (comcc_1.ncc[*iv - 1] == 1) { +#line 19030 "" ret_val = comcc_1.ncmidcc[*iv - 1]; +#line 19031 "" } else { +#line 19032 "" xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1]; +#line 19033 "" for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) { +#line 19034 "" if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) { +#line 19035 "" ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25]; +#line 19036 "" return ret_val; +#line 19037 "" } +#line 19038 "" /* L1: */ +#line 19038 "" } - s_wsle(&io___1124); +#line 19039 "" + s_wsle(&io___1169); +#line 19039 "" do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18); +#line 19039 "" e_wsle(); +#line 19040 "" s_stop("", (ftnlen)0); +#line 19041 "" } +#line 19042 "" return ret_val; } /* ncmid_ */ @@ -28018,32 +45260,21 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* Return middle line of a clef */ -/* if (clefq.eq.'t' .or. clefq.eq.'0') then */ -/* ncmidf = 35 */ -/* else if (clefq.eq.'s' .or. clefq.eq.'1') then */ -/* ncmidf = 33 */ -/* else if (clefq.eq.'m' .or. clefq.eq.'2') then */ -/* ncmidf = 31 */ -/* else if (clefq.eq.'a' .or. clefq.eq.'3') then */ -/* ncmidf = 29 */ -/* else if (clefq.eq.'n' .or. clefq.eq.'4') then */ -/* ncmidf = 27 */ -/* else if (clefq.eq.'r' .or. clefq.eq.'5') then */ -/* ncmidf = 25 */ -/* else if (clefq.eq.'f' .or. clefq.eq.'7') then */ -/* ncmidf = 37 */ -/* else */ -/* ncmidf = 23 */ -/* end if */ +#line 19048 "" if (*(unsigned char *)clefq == '8') { /* treblelowoct; will treat as treble for this purpose */ +#line 19052 "" ret_val = 35; +#line 19053 "" } else { +#line 19054 "" ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) / 2 << 1) + 21; +#line 19055 "" } +#line 19056 "" return ret_val; } /* ncmidf_ */ @@ -28053,33 +45284,60 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) static integer j; extern integer ncmidf_(char *, ftnlen); +#line 19079 "" commvl_1.nvmx[*jv - 1] = 1; +#line 19080 "" commvl_1.ivmx[*jv - 1] = *jv; +#line 19081 "" all_1.itsofar[*jv - 1] = 0; +#line 19082 "" all_1.nnl[*jv - 1] = 0; +#line 19083 "" comfb_1.nfb[*jv - 1] = 0; +#line 19084 "" if (all_1.firstgulp || *change) { +#line 19085 "" comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1); +#line 19086 "" } else { +#line 19087 "" comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1] * 24 - 25]; +#line 19088 "" } +#line 19089 "" comcc_1.tcc[*jv - 1] = 0.f; +#line 19090 "" comcc_1.ncc[*jv - 1] = 1; +#line 19091 "" comudsp_1.nudoff[*jv - 1] = 0; +#line 19092 "" comcc_1.ndotmv[*jv - 1] = 0; +#line 19093 "" for (j = 1; j <= 200; ++j) { +#line 19094 "" all_1.irest[*jv + j * 24 - 25] = 0; +#line 19095 "" all_1.islur[*jv + j * 24 - 25] = 0; +#line 19096 "" all_1.ipl[*jv + j * 24 - 25] = 0; +#line 19097 "" all_1.nacc[*jv + j * 24 - 25] = 0; +#line 19098 "" all_1.iornq[*jv + j * 24 - 1] = 0; +#line 19099 "" all_1.mult[*jv + j * 24 - 25] = 0; +#line 19100 "" if (*jv <= 2) { +#line 19100 "" all_1.isfig[*jv + (j << 1) - 3] = FALSE_; +#line 19100 "" } +#line 19101 "" /* L5: */ +#line 19101 "" } +#line 19102 "" return 0; } /* newvoice_ */ @@ -28106,66 +45364,118 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* Returns name of note level with octave transpositions, updates noctup. */ +#line 19111 "" nupfroma = (*nolev + 1) % 7; +#line 19112 "" iname = nupfroma + 97; +#line 19113 "" ioctup = (*nolev + 1) / 7 - 4; +#line 19114 "" chax_(ch__1, (ftnlen)1, &iname); +#line 19114 "" *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; +#line 19115 "" if (*ncmid == 23) { +#line 19115 "" upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1); +#line 19115 "" *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; +#line 19115 "" } +#line 19116 "" if (ioctup == comoct_1.noctup) { +#line 19117 "" s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1); +#line 19118 "" *lnote = 1; /* Must ALWAYS check if lnote=1 for use with functions requiring a blank */ +#line 19122 "" } else if (ioctup > comoct_1.noctup) { /* Raise octave. Encase in {} */ +#line 19126 "" ici__1.icierr = 0; +#line 19126 "" ici__1.icirnum = 1; +#line 19126 "" ici__1.icirlen = 8; +#line 19126 "" ici__1.iciunit = noteq; +#line 19126 "" ici__1.icifmt = "(8a1)"; +#line 19126 "" s_wsfi(&ici__1); +#line 19126 "" do_fio(&c__1, "{", (ftnlen)1); +#line 19126 "" i__1 = ioctup - 1; +#line 19126 "" for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) { +#line 19126 "" chax_(ch__2, (ftnlen)1, &c__39); +#line 19126 "" *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; +#line 19126 "" do_fio(&c__1, ch__1, (ftnlen)1); +#line 19126 "" } +#line 19126 "" do_fio(&c__1, noteqt, (ftnlen)1); +#line 19126 "" do_fio(&c__1, "}", (ftnlen)1); +#line 19126 "" e_wsfi(); +#line 19128 "" *lnote = ioctup + 3 - comoct_1.noctup; +#line 19129 "" comoct_1.noctup = ioctup; +#line 19130 "" } else { /* Lower octave */ +#line 19134 "" ici__1.icierr = 0; +#line 19134 "" ici__1.icirnum = 1; +#line 19134 "" ici__1.icirlen = 8; +#line 19134 "" ici__1.iciunit = noteq; +#line 19134 "" ici__1.icifmt = "(8a1)"; +#line 19134 "" s_wsfi(&ici__1); +#line 19134 "" do_fio(&c__1, "{", (ftnlen)1); +#line 19134 "" i__1 = comoct_1.noctup - 1; +#line 19134 "" for (i__ = ioctup; i__ <= i__1; ++i__) { +#line 19134 "" chax_(ch__2, (ftnlen)1, &c__96); +#line 19134 "" *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; +#line 19134 "" do_fio(&c__1, ch__1, (ftnlen)1); +#line 19134 "" } +#line 19134 "" do_fio(&c__1, noteqt, (ftnlen)1); +#line 19134 "" do_fio(&c__1, "}", (ftnlen)1); +#line 19134 "" e_wsfi(); +#line 19136 "" *lnote = comoct_1.noctup + 3 - ioctup; +#line 19137 "" comoct_1.noctup = ioctup; +#line 19138 "" } +#line 19139 "" return 0; } /* notefq_ */ @@ -28208,575 +45518,980 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) static integer lnoten; /* Fortran I/O blocks */ - static icilist io___1143 = { 0, noteq, 0, "(i2)", 2, 1 }; - static icilist io___1147 = { 0, numq, 0, "(i2)", 2, 1 }; - static icilist io___1148 = { 0, noteq+1, 0, "(i2)", 2, 1 }; - static icilist io___1149 = { 0, noteq+1, 0, "(i3)", 3, 1 }; + static icilist io___1188 = { 0, noteq, 0, "(i2)", 2, 1 }; + static icilist io___1192 = { 0, numq, 0, "(i2)", 2, 1 }; + static icilist io___1193 = { 0, noteq+1, 0, "(i2)", 2, 1 }; + static icilist io___1194 = { 0, noteq+1, 0, "(i3)", 3, 1 }; /* Returns non-beamed full note name */ +#line 19169 "" ip = all_1.ipo[all_1.jn - 1]; +#line 19170 "" nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; /* Check for special situations with 2nds (see precrd) */ +#line 19174 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 19175 "" --nole; +#line 19176 "" } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 19177 "" ++nole; +#line 19178 "" } +#line 19179 "" nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 19180 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 19181 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 19181 "" udqq_(ch__1, (ftnlen)1, &nole, &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, & all_1.nv); +#line 19181 "" *(unsigned char *)udq = *(unsigned char *)&ch__1[0]; +#line 19183 "" } /* Check figure level */ /* if (figbass .and. isfig(ivx,ip) */ /* * .and. .not.btest(irest(ivx,ip),0)) then */ +#line 19189 "" if (all_1.figbass && ! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25], 0) && (commvl_1.ivx == 1 && all_1.isfig[(ip << 1) - 2] || commvl_1.ivx == comfig_1.ivxfig2 && all_1.isfig[(ip << 1) - 1])) { +#line 19192 "" if (*(unsigned char *)udq == 'u' || nodu >= 64) { /* Upper or no stem, fnole (in noleunits) set by notehead */ +#line 19196 "" fnole = (real) nole; +#line 19197 "" } else { /* Lower stem, fnole set by bottom of stem */ +#line 19201 "" fnole = nole - all_1.stemlen; +#line 19202 "" } +#line 19203 "" zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4; +#line 19204 "" if (commvl_1.ivx == 1) { /* Computing MAX */ +#line 19205 "" r__1 = 4 - zmin; +#line 19205 "" i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1); +#line 19205 "" all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2); +#line 19206 "" } else { /* Computing MAX */ +#line 19207 "" r__1 = 4 - zmin; +#line 19207 "" i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1); +#line 19207 "" all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2); +#line 19208 "" } +#line 19209 "" } +#line 19210 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 19211 "" i__1 = ncmid_(&all_1.iv, &ip); +#line 19211 "" notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 19212 "" if (lnoten == 1) { +#line 19212 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 19212 "" } +#line 19213 "" if (nodu == 1) { /* Writing concatenation */ +#line 19214 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19214 "" i__3[1] = 4, a__1[1] = "cccc"; +#line 19214 "" i__3[2] = 1, a__1[2] = udq; +#line 19214 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19214 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19215 "" *lnote = lnoten + 6; +#line 19216 "" } else if (nodu == 2) { /* Writing concatenation */ +#line 19217 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19217 "" i__3[1] = 3, a__1[1] = "ccc"; +#line 19217 "" i__3[2] = 1, a__1[2] = udq; +#line 19217 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19217 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19218 "" *lnote = lnoten + 5; +#line 19219 "" } else if (nodu == 4) { /* Writing concatenation */ +#line 19220 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19220 "" i__3[1] = 2, a__1[1] = "cc"; +#line 19220 "" i__3[2] = 1, a__1[2] = udq; +#line 19220 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19220 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19221 "" *lnote = lnoten + 4; +#line 19222 "" } else if (nodu == 8) { /* Writing concatenation */ +#line 19223 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19223 "" i__3[1] = 1, a__1[1] = "c"; +#line 19223 "" i__3[2] = 1, a__1[2] = udq; +#line 19223 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19223 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19224 "" *lnote = lnoten + 3; +#line 19225 "" } else if (nodu == 16) { /* Writing concatenation */ +#line 19226 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19226 "" i__3[1] = 1, a__1[1] = "q"; +#line 19226 "" i__3[2] = 1, a__1[2] = udq; +#line 19226 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19226 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19227 "" *lnote = lnoten + 3; +#line 19228 "" } else if (nodu == 32) { /* Writing concatenation */ +#line 19229 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19229 "" i__3[1] = 1, a__1[1] = "h"; +#line 19229 "" i__3[2] = 1, a__1[2] = udq; +#line 19229 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19229 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19230 "" *lnote = lnoten + 3; +#line 19231 "" } else if (nodu == 64) { /* Writing concatenation */ +#line 19232 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 19232 "" i__4[1] = 2, a__2[1] = "wh"; +#line 19232 "" i__4[2] = lnoten, a__2[2] = noteq; +#line 19232 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 19233 "" *lnote = lnoten + 3; +#line 19234 "" } else if (nodu == 128) { /* notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */ /* lnote = lnoten+10 */ /* Writing concatenation */ +#line 19237 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 19237 "" i__4[1] = 5, a__2[1] = "breve"; +#line 19237 "" i__4[2] = lnoten, a__2[2] = noteq; +#line 19237 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 19238 "" *lnote = lnoten + 6; +#line 19239 "" } else { +#line 19240 "" s_copy(dotq, "p", (ftnlen)4, (ftnlen)1); +#line 19241 "" ldot = 1; +#line 19242 "" if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { /* Dotted note with ')' ornament */ +#line 19246 "" s_copy(dotq, "m", (ftnlen)4, (ftnlen)1); +#line 19247 "" } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { /* Double dot */ +#line 19251 "" s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2); +#line 19252 "" ldot = 2; +#line 19253 "" } +#line 19254 "" if (nodu >= 192) { /* Writing concatenation */ +#line 19255 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19255 "" i__3[1] = 5, a__1[1] = "breve"; +#line 19255 "" i__3[2] = ldot, a__1[2] = dotq; +#line 19255 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19255 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19256 "" *lnote = lnoten + 6 + ldot; +#line 19257 "" } else if (nodu >= 96) { /* Writing concatenation */ +#line 19258 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 19258 "" i__3[1] = 2, a__1[1] = "wh"; +#line 19258 "" i__3[2] = ldot, a__1[2] = dotq; +#line 19258 "" i__3[3] = lnoten, a__1[3] = noteq; +#line 19258 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19259 "" *lnote = lnoten + 3 + ldot; +#line 19260 "" } else if (nodu >= 48) { /* Writing concatenation */ +#line 19261 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19261 "" i__5[1] = 1, a__3[1] = "h"; +#line 19261 "" i__5[2] = 1, a__3[2] = udq; +#line 19261 "" i__5[3] = ldot, a__3[3] = dotq; +#line 19261 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 19261 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19262 "" *lnote = lnoten + 3 + ldot; +#line 19263 "" } else if (nodu >= 24) { /* Writing concatenation */ +#line 19264 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19264 "" i__5[1] = 1, a__3[1] = "q"; +#line 19264 "" i__5[2] = 1, a__3[2] = udq; +#line 19264 "" i__5[3] = ldot, a__3[3] = dotq; +#line 19264 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 19264 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19265 "" *lnote = lnoten + 3 + ldot; +#line 19266 "" } else if (nodu >= 12) { /* Writing concatenation */ +#line 19267 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19267 "" i__5[1] = 1, a__3[1] = "c"; +#line 19267 "" i__5[2] = 1, a__3[2] = udq; +#line 19267 "" i__5[3] = ldot, a__3[3] = dotq; +#line 19267 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 19267 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19268 "" *lnote = lnoten + 3 + ldot; +#line 19269 "" } else if (nodu >= 6) { /* Writing concatenation */ +#line 19270 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19270 "" i__5[1] = 2, a__3[1] = "cc"; +#line 19270 "" i__5[2] = 1, a__3[2] = udq; +#line 19270 "" i__5[3] = ldot, a__3[3] = dotq; +#line 19270 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 19270 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19271 "" *lnote = lnoten + 4 + ldot; +#line 19272 "" compoi_1.ispoi = TRUE_; +#line 19273 "" } else { /* Writing concatenation */ +#line 19274 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19274 "" i__5[1] = 3, a__3[1] = "ccc"; +#line 19274 "" i__5[2] = 1, a__3[2] = udq; +#line 19274 "" i__5[3] = ldot, a__3[3] = dotq; +#line 19274 "" i__5[4] = lnoten, a__3[4] = noteq; +#line 19274 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19275 "" *lnote = lnoten + 5 + ldot; +#line 19276 "" compoi_1.ispoi = TRUE_; +#line 19277 "" } +#line 19278 "" if (*(unsigned char *)dotq == 'm') { /* Need another call to the note, in case the first one has octave shifts */ +#line 19282 "" if (lnoten == 2) { /* Writing concatenation */ +#line 19283 "" i__3[0] = *lnote, a__1[0] = notexq; +#line 19283 "" i__3[1] = 1, a__1[1] = "{"; +#line 19283 "" i__3[2] = 1, a__1[2] = noteq + 1; +#line 19283 "" i__3[3] = 1, a__1[3] = "}"; +#line 19283 "" s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 19284 "" *lnote += 3; +#line 19285 "" } else { +#line 19286 "" i__1 = lnoten - 2; /* Writing concatenation */ +#line 19286 "" i__6[0] = *lnote, a__4[0] = notexq; +#line 19286 "" i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1; +#line 19286 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19287 "" ++(*lnote); +#line 19288 "" } +#line 19289 "" } +#line 19290 "" } +#line 19291 "" } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { /* Blank rest */ /* Writing concatenation */ +#line 19295 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19295 "" i__6[1] = 2, a__4[1] = "sk"; +#line 19295 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19296 "" *lnote = 3; +#line 19297 "" } else { /* Non-blank rest */ +#line 19301 "" *lnote = 0; +#line 19302 "" nole = (nole + 20) % 100 - 20; /* Kluge to get pause symbol for rp: */ +#line 19306 "" if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) { +#line 19306 "" nodu = 64; +#line 19306 "" } +#line 19307 "" if (nodu <= 28) { /* Normal rest < or = double-dotted quarter */ +#line 19311 "" lrest = 3; +#line 19312 "" if (nodu > 14) { /* Writing concatenation */ +#line 19313 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19313 "" i__6[1] = 2, a__4[1] = "qp"; +#line 19313 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19314 "" } else if (nodu > 7) { /* Writing concatenation */ +#line 19315 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19315 "" i__6[1] = 2, a__4[1] = "ds"; +#line 19315 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19316 "" } else if (nodu > 3) { /* Writing concatenation */ +#line 19317 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19317 "" i__6[1] = 2, a__4[1] = "qs"; +#line 19317 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19318 "" } else if (nodu > 1) { /* Writing concatenation */ +#line 19319 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19319 "" i__6[1] = 2, a__4[1] = "hs"; +#line 19319 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19320 "" } else { /* Writing concatenation */ +#line 19321 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19321 "" i__6[1] = 3, a__4[1] = "qqs"; +#line 19321 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19322 "" lrest = 4; +#line 19323 "" } -/* if (2**log2(nodu) .ne. nodu) then */ -/* c */ -/* c One or two dots on rest */ -/* c */ -/* restq = restq(1:3)//'p' */ -/* lrest = 4 */ -/* if (2*nodu .gt. 3*2**log2(nodu)) then */ -/* c */ -/* c Double dotted rest */ -/* c */ -/* restq = restq(1:4)//'p' */ -/* lrest = 5 */ -/* end if */ -/* end if */ + +/* Special case for rest at start of F-tuplet inside a forced beam */ + +#line 19327 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18) && + bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19)) { +/* Writing concatenation */ +#line 19329 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 19329 "" + i__4[1] = 3, a__2[1] = "pt4"; +#line 19329 "" + i__4[2] = lrest, a__2[2] = restq; +#line 19329 "" + s_cat(restq, a__2, i__4, &c__3, (ftnlen)40); +#line 19330 "" + lrest += 4; +#line 19331 "" + } +#line 19332 "" s_copy(notexq, restq, (ftnlen)79, (ftnlen)40); +#line 19333 "" *lnote = lrest; /* At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. */ +#line 19337 "" if (nole != 0) { +#line 19338 "" if (abs(nole) < 10) { +#line 19339 "" i__1 = abs(nole) + 48; +#line 19339 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 19339 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 19340 "" lnoten = 1; +#line 19341 "" } else { - s_wsfi(&io___1143); +#line 19342 "" + s_wsfi(&io___1188); +#line 19342 "" i__1 = abs(nole); +#line 19342 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 19342 "" e_wsfi(); +#line 19343 "" lnoten = 2; +#line 19344 "" } +#line 19345 "" if (nole > 0) { /* Writing concatenation */ +#line 19346 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19346 "" i__5[1] = 5, a__3[1] = "raise"; +#line 19346 "" i__5[2] = lnoten, a__3[2] = noteq; +#line 19346 "" i__5[3] = 1, a__3[3] = all_1.sq; +#line 19346 "" i__5[4] = 9, a__3[4] = "internote"; +#line 19346 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19347 "" } else { /* Writing concatenation */ +#line 19348 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 19348 "" i__5[1] = 5, a__3[1] = "lower"; +#line 19348 "" i__5[2] = lnoten, a__3[2] = noteq; +#line 19348 "" i__5[3] = 1, a__3[3] = all_1.sq; +#line 19348 "" i__5[4] = 9, a__3[4] = "internote"; +#line 19348 "" s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 19349 "" } +#line 19350 "" *lnote = lnoten + 16; -/* if (2**log2(nodu) .ne. nodu) then */ -/* c */ -/* c Have dot in raised rest. must put in hbox! */ -/* c */ -/* notexq = notexq(1:lnote)//sq//'hbox{' */ -/* lnote = lnote+6 */ -/* end if */ /* Writing concatenation */ +#line 19351 "" i__6[0] = *lnote, a__4[0] = notexq; +#line 19351 "" i__6[1] = lrest, a__4[1] = restq; +#line 19351 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19352 "" *lnote += lrest; -/* if (2**log2(nodu) .ne. nodu) then */ -/* notexq = notexq(1:lnote)//'}' */ -/* lnote = lnote+1 */ -/* end if */ +#line 19353 "" } +#line 19354 "" i__1 = log2_(&nodu); +#line 19354 "" if (pow_ii(&c__2, &i__1) != nodu) { /* Deal with dots (on rests shorter than half rest) */ /* Writing concatenation */ +#line 19358 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19358 "" i__6[1] = 2, a__4[1] = "pt"; +#line 19358 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19359 "" lrest = 3; +#line 19360 "" i__1 = log2_(&nodu); +#line 19360 "" if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { /* Writing concatenation */ +#line 19361 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19361 "" i__6[1] = 3, a__4[1] = "ppt"; +#line 19361 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19362 "" lrest = 4; +#line 19363 "" } +#line 19364 "" nole += 4; +#line 19365 "" raisedot = 0.f; /* Tweak dot positions for special cases */ +#line 19369 "" even = (nole + 100) % 2 == 0; /* if (.not.even.and.nodu.gt.8.and. */ /* * (nole.lt.0.or.nole.gt.8)) then */ +#line 19372 "" if (! even && (nole < 0 || nole > 8)) { +#line 19373 "" raisedot = 1.f; +#line 19374 "" } +#line 19375 "" if (nole >= 10 || nole <= -1) { - s_wsfi(&io___1147); +#line 19376 "" + s_wsfi(&io___1192); +#line 19376 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 19376 "" e_wsfi(); /* Writing concatenation */ +#line 19377 "" i__3[0] = lrest, a__1[0] = restq; +#line 19377 "" i__3[1] = 1, a__1[1] = "{"; +#line 19377 "" i__3[2] = 2, a__1[2] = numq; +#line 19377 "" i__3[3] = 1, a__1[3] = "}"; +#line 19377 "" s_cat(restq, a__1, i__3, &c__4, (ftnlen)40); +#line 19378 "" lrest += 4; +#line 19379 "" } else { /* Writing concatenation */ +#line 19380 "" i__6[0] = lrest, a__4[0] = restq; +#line 19380 "" i__1 = nole + 48; +#line 19380 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 19380 "" i__6[1] = 1, a__4[1] = ch__1; +#line 19380 "" s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 19381 "" ++lrest; +#line 19382 "" } +#line 19383 "" if (raisedot > 0.f) { /* Writing concatenation */ +#line 19384 "" i__7[0] = 1, a__5[0] = all_1.sq; +#line 19384 "" i__7[1] = 5, a__5[1] = "raise"; +#line 19384 "" i__7[2] = 1, a__5[2] = all_1.sq; +#line 19384 "" i__7[3] = 9, a__5[3] = "internote"; +#line 19384 "" i__7[4] = 1, a__5[4] = all_1.sq; +#line 19384 "" i__7[5] = 5, a__5[5] = "hbox{"; +#line 19384 "" i__7[6] = lrest, a__5[6] = restq; +#line 19384 "" i__7[7] = 1, a__5[7] = "}"; +#line 19384 "" s_cat(restq, a__5, i__7, &c__8, (ftnlen)40); +#line 19386 "" lrest += 23; +#line 19387 "" } /* Writing concatenation */ +#line 19388 "" i__6[0] = lrest, a__4[0] = restq; +#line 19388 "" i__6[1] = *lnote, a__4[1] = notexq; +#line 19388 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19389 "" *lnote += lrest; +#line 19390 "" } +#line 19391 "" } else { /* Half rest or longer */ +#line 19395 "" if (nole == 0) { /* Half or longer rest is not raised or lowered */ +#line 19399 "" if (nodu <= 56) { /* Writing concatenation */ +#line 19400 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19400 "" i__6[1] = 6, a__4[1] = "hpause"; +#line 19400 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19401 "" *lnote = 7; +#line 19402 "" } else if (nodu <= 112) { +#line 19403 "" if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], 19) || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],25)) { /* Writing concatenation */ +#line 19405 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19405 "" i__6[1] = 5, a__4[1] = "pause"; +#line 19405 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19406 "" } else { /* Writing concatenation */ +#line 19407 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19407 "" i__6[1] = 5, a__4[1] = "pausc"; +#line 19407 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19408 "" } +#line 19409 "" *lnote = 6; +#line 19410 "" } else { /* Writing concatenation */ +#line 19411 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19411 "" i__6[1] = 5, a__4[1] = "PAuse"; +#line 19411 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19412 "" *lnote = 6; +#line 19413 "" } +#line 19414 "" i__1 = log2_(&nodu); +#line 19414 "" if (pow_ii(&c__2, &i__1) != nodu) { /* Dotted rest, hpause or longer */ /* Writing concatenation */ +#line 19418 "" i__6[0] = *lnote, a__4[0] = notexq; +#line 19418 "" i__6[1] = 1, a__4[1] = "p"; +#line 19418 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19419 "" ++(*lnote); +#line 19420 "" i__1 = log2_(&nodu); +#line 19420 "" if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { /* Double dotted long rest */ /* Writing concatenation */ +#line 19424 "" i__6[0] = *lnote, a__4[0] = notexq; +#line 19424 "" i__6[1] = 1, a__4[1] = "p"; +#line 19424 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19425 "" ++(*lnote); +#line 19426 "" } +#line 19427 "" } +#line 19428 "" } else { /* Raised or lowered half or whole rest */ +#line 19432 "" if (nodu == 32) { /* Writing concatenation */ +#line 19433 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19433 "" i__6[1] = 10, a__4[1] = "lifthpause"; +#line 19433 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19434 "" *lnote = 11; +#line 19435 "" } else if (nodu == 48) { /* Writing concatenation */ +#line 19436 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19436 "" i__6[1] = 11, a__4[1] = "lifthpausep"; +#line 19436 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19437 "" *lnote = 12; +#line 19438 "" } else if (nodu == 56) { /* Writing concatenation */ +#line 19439 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19439 "" i__6[1] = 12, a__4[1] = "lifthpausepp"; +#line 19439 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19440 "" *lnote = 13; +#line 19441 "" } else if (nodu == 64) { /* Writing concatenation */ +#line 19442 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19442 "" i__6[1] = 9, a__4[1] = "liftpause"; +#line 19442 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19443 "" *lnote = 10; +#line 19444 "" } else if (nodu == 96) { /* Writing concatenation */ +#line 19445 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19445 "" i__6[1] = 10, a__4[1] = "liftpausep"; +#line 19445 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19446 "" *lnote = 11; +#line 19447 "" } else if (nodu == 112) { /* Writing concatenation */ +#line 19448 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19448 "" i__6[1] = 11, a__4[1] = "liftpausepp"; +#line 19448 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19449 "" *lnote = 12; +#line 19450 "" } else if (nodu == 128) { /* Writing concatenation */ +#line 19451 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19451 "" i__6[1] = 9, a__4[1] = "liftPAuse"; +#line 19451 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19452 "" *lnote = 10; +#line 19453 "" } else { /* Assume dotted double whole rest */ /* Writing concatenation */ +#line 19457 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 19457 "" i__6[1] = 10, a__4[1] = "liftPAusep"; +#line 19457 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19458 "" *lnote = 11; +#line 19459 "" } /* Set up height spec */ +#line 19463 "" i__1 = abs(nole) / 2; +#line 19463 "" nole = i_sign(&i__1, &nole); +#line 19464 "" if (nole <= 9 && nole >= 0) { +#line 19465 "" i__1 = nole + 48; +#line 19465 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 19465 "" s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 19466 "" lnoten = 1; +#line 19467 "" } else { +#line 19468 "" s_copy(noteq, "{", (ftnlen)8, (ftnlen)1); +#line 19469 "" if (nole >= -9) { - s_wsfi(&io___1148); +#line 19470 "" + s_wsfi(&io___1193); +#line 19470 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 19470 "" e_wsfi(); +#line 19471 "" lnoten = 3; +#line 19472 "" } else { - s_wsfi(&io___1149); +#line 19473 "" + s_wsfi(&io___1194); +#line 19473 "" do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 19473 "" e_wsfi(); +#line 19474 "" lnoten = 4; +#line 19475 "" } /* Writing concatenation */ +#line 19476 "" i__6[0] = lnoten, a__4[0] = noteq; +#line 19476 "" i__6[1] = 1, a__4[1] = "}"; +#line 19476 "" s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8); +#line 19477 "" ++lnoten; +#line 19478 "" } /* Writing concatenation */ +#line 19479 "" i__6[0] = *lnote, a__4[0] = notexq; +#line 19479 "" i__6[1] = lnoten, a__4[1] = noteq; +#line 19479 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 19480 "" *lnote += lnoten; +#line 19481 "" } +#line 19482 "" } +#line 19483 "" } +#line 19484 "" return 0; } /* notex_ */ @@ -28803,56 +46518,98 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */ +#line 19493 "" ndxs2 = i_indx(line, s2q, line_len, s2q_len); +#line 19494 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 19494 "" ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1); +#line 19495 "" if (ndxbs == 0 || ndxs2 < ndxbs) { +#line 19496 "" ret_val = ndxs2; +#line 19497 "" } else { /* There are both bs and s2q, and bs is to the left of sq2. So check bs's to */ /* right of first: End is '\ ', start is ' \' */ +#line 19502 "" len = lenstr_(line, lenline, line_len); +#line 19503 "" intex = TRUE_; +#line 19504 "" i__1 = len; +#line 19504 "" for (ic = ndxbs + 1; ic <= i__1; ++ic) { +#line 19505 "" if (ic == ndxs2) { +#line 19506 "" if (intex) { +#line 19507 "" ret_val = 0; +#line 19508 "" i__2 = ic; +#line 19508 "" ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) + ic; +#line 19509 "" } else { +#line 19510 "" ret_val = ndxs2; +#line 19511 "" return ret_val; +#line 19512 "" } +#line 19513 "" } else /* if(complicated condition) */ { +#line 19513 "" i__2 = ic; /* Writing concatenation */ +#line 19513 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 19513 "" i__3[0] = 1, a__1[0] = ch__1; +#line 19513 "" i__3[1] = 1, a__1[1] = " "; +#line 19513 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); +#line 19513 "" if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen) 2) == 0) { +#line 19514 "" intex = FALSE_; +#line 19515 "" } else /* if(complicated condition) */ { +#line 19515 "" i__2 = ic; /* Writing concatenation */ +#line 19515 "" i__3[0] = 1, a__1[0] = " "; +#line 19515 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 19515 "" i__3[1] = 1, a__1[1] = ch__1; +#line 19515 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); +#line 19515 "" if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, ( ftnlen)2) == 0) { +#line 19517 "" intex = TRUE_; +#line 19518 "" } +#line 19518 "" } +#line 19518 "" } +#line 19519 "" /* L1: */ +#line 19519 "" } +#line 19520 "" } +#line 19521 "" return ret_val; } /* ntindex_ */ @@ -28879,32 +46636,56 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* This appends to notexq e.g. '\ibbbu1' */ +#line 19532 "" if (*n >= 5) { +#line 19532 "" combbm_1.isbbm = TRUE_; +#line 19532 "" } +#line 19533 "" if (*lnote > 0) { /* Writing concatenation */ +#line 19534 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 19534 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 19534 "" i__1[1] = 1, a__1[1] = ch__1; +#line 19534 "" i__1[2] = 1, a__1[2] = char1q; +#line 19534 "" s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); +#line 19535 "" } else { /* Writing concatenation */ +#line 19536 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 19536 "" i__2[0] = 1, a__2[0] = ch__1; +#line 19536 "" i__2[1] = 1, a__2[1] = char1q; +#line 19536 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 19537 "" } +#line 19538 "" *lnote += 2; +#line 19539 "" i__3 = *n; +#line 19539 "" for (im = 1; im <= i__3; ++im) { /* Writing concatenation */ +#line 19540 "" i__2[0] = *lnote, a__2[0] = notexq; +#line 19540 "" i__2[1] = 1, a__2[1] = "b"; +#line 19540 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 19541 "" ++(*lnote); +#line 19542 "" /* L3: */ +#line 19542 "" } /* add the number, 0 if 12 */ @@ -28912,21 +46693,36 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* 5/25/08 Allow >12 */ /* call istring(mod(iv,12),tempq,len) */ +#line 19549 "" if (*iv < 24) { +#line 19550 "" istring_(iv, tempq, &len, (ftnlen)4); +#line 19551 "" } else if (*iv == 24) { +#line 19552 "" *(unsigned char *)tempq = '0'; +#line 19553 "" len = 1; +#line 19554 "" } else { +#line 19555 "" printl_("Sorry, too man open beams", (ftnlen)25); +#line 19556 "" stop1_(); +#line 19557 "" } /* Writing concatenation */ +#line 19558 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 19558 "" i__1[1] = 1, a__1[1] = ulqq; +#line 19558 "" i__1[2] = len, a__1[2] = tempq; +#line 19558 "" s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); +#line 19559 "" *lnote = *lnote + 1 + len; +#line 19560 "" return 0; } /* ntrbbb_ */ @@ -28944,17 +46740,27 @@ integer numclef_(char *clefq, ftnlen clefq_len) /* 7 f 9 */ /* 8 0 */ +#line 19570 "" if (*(unsigned char *)clefq < 55) { /* if (ichar(clefq) .le. 55) then */ +#line 19572 "" ret_val = *(unsigned char *)clefq - 48; /* if (numclef .eq. 7) numclef = 9 */ +#line 19574 "" } else if (*(unsigned char *)clefq == '7') { +#line 19575 "" ret_val = 9; +#line 19576 "" } else if (*(unsigned char *)clefq == '8') { +#line 19577 "" ret_val = 0; +#line 19578 "" } else { +#line 19579 "" ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1; +#line 19580 "" } +#line 19581 "" return ret_val; } /* numclef_ */ @@ -28976,65 +46782,121 @@ integer numclef_(char *clefq, ftnlen clefq_len) extern /* Character */ VOID chax_(char *, ftnlen, integer *); static integer nfmt; +#line 19585 "" r__1 = *i__ + .5f; +#line 19585 "" nfmt = r_lg10(&r__1) + 2; +#line 19586 "" if (*jlast + 5 + nfmt < 80) { +#line 19587 "" ci__1.cierr = 0; +#line 19587 "" ci__1.ciunit = 6; /* Writing concatenation */ +#line 19587 "" i__1[0] = 5, a__1[0] = "(a5,i"; +#line 19587 "" i__2 = nfmt + 48; +#line 19587 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 19587 "" i__1[1] = 1, a__1[1] = ch__2; +#line 19587 "" i__1[2] = 3, a__1[2] = ",$)"; +#line 19587 "" ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); +#line 19587 "" s_wsfe(&ci__1); +#line 19587 "" do_fio(&c__1, " Bar", (ftnlen)5); +#line 19587 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 19587 "" e_wsfe(); +#line 19588 "" ci__1.cierr = 0; +#line 19588 "" ci__1.ciunit = 15; /* Writing concatenation */ +#line 19588 "" i__1[0] = 5, a__1[0] = "(a5,i"; +#line 19588 "" i__2 = nfmt + 48; +#line 19588 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 19588 "" i__1[1] = 1, a__1[1] = ch__2; +#line 19588 "" i__1[2] = 3, a__1[2] = ",$)"; +#line 19588 "" ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); +#line 19588 "" s_wsfe(&ci__1); +#line 19588 "" do_fio(&c__1, " Bar", (ftnlen)5); +#line 19588 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 19588 "" e_wsfe(); +#line 19589 "" *jlast = *jlast + 5 + nfmt; +#line 19590 "" } else { +#line 19591 "" ci__1.cierr = 0; +#line 19591 "" ci__1.ciunit = 6; /* Writing concatenation */ +#line 19591 "" i__1[0] = 7, a__1[0] = "(/,a5,i"; +#line 19591 "" i__2 = nfmt + 48; +#line 19591 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 19591 "" i__1[1] = 1, a__1[1] = ch__2; +#line 19591 "" i__1[2] = 3, a__1[2] = ",$)"; +#line 19591 "" ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); +#line 19591 "" s_wsfe(&ci__1); +#line 19591 "" do_fio(&c__1, " Bar", (ftnlen)5); +#line 19591 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 19591 "" e_wsfe(); +#line 19592 "" ci__1.cierr = 0; +#line 19592 "" ci__1.ciunit = 15; /* Writing concatenation */ +#line 19592 "" i__1[0] = 7, a__1[0] = "(/,a5,i"; +#line 19592 "" i__2 = nfmt + 48; +#line 19592 "" chax_(ch__2, (ftnlen)1, &i__2); +#line 19592 "" i__1[1] = 1, a__1[1] = ch__2; +#line 19592 "" i__1[2] = 3, a__1[2] = ",$)"; +#line 19592 "" ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); +#line 19592 "" s_wsfe(&ci__1); +#line 19592 "" do_fio(&c__1, " Bar", (ftnlen)5); +#line 19592 "" do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 19592 "" e_wsfe(); +#line 19593 "" *jlast = nfmt + 5; +#line 19594 "" } +#line 19595 "" return 0; } /* outbar_ */ @@ -29125,32 +46987,32 @@ integer numclef_(char *clefq, ftnlen clefq_len) static integer instnow, nsystpp; /* Fortran I/O blocks */ - static cilist io___1162 = { 0, 6, 0, 0, 0 }; - static cilist io___1163 = { 0, 6, 0, 0, 0 }; - static cilist io___1164 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1165 = { 0, 19, 0, "(i6)", 0 }; - static cilist io___1177 = { 0, 6, 0, 0, 0 }; - static cilist io___1181 = { 0, 6, 0, 0, 0 }; - static cilist io___1187 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1188 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1193 = { 0, 6, 0, 0, 0 }; - static cilist io___1195 = { 0, 6, 0, 0, 0 }; - static cilist io___1196 = { 0, 6, 0, 0, 0 }; - static cilist io___1197 = { 0, 6, 0, 0, 0 }; - static cilist io___1198 = { 0, 15, 0, "(a,2i5)", 0 }; - static cilist io___1199 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1201 = { 0, 12, 0, "(a)", 0 }; - static cilist io___1202 = { 0, 12, 0, 0, 0 }; - static cilist io___1203 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 }; - static cilist io___1204 = { 0, 12, 0, 0, 0 }; - static cilist io___1223 = { 0, 12, 0, 0, 0 }; - static cilist io___1238 = { 0, 12, 0, "(i5)", 0 }; - static cilist io___1256 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 }; - static cilist io___1257 = { 0, 13, 0, "(i5)", 0 }; - static cilist io___1258 = { 0, 6, 0, "(/,a)", 0 }; - static cilist io___1259 = { 0, 6, 0, 0, 0 }; - static cilist io___1260 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___1261 = { 0, 15, 0, "()", 0 }; + static cilist io___1207 = { 0, 6, 0, 0, 0 }; + static cilist io___1208 = { 0, 6, 0, 0, 0 }; + static cilist io___1209 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1210 = { 0, 19, 0, "(i6)", 0 }; + static cilist io___1222 = { 0, 6, 0, 0, 0 }; + static cilist io___1226 = { 0, 6, 0, 0, 0 }; + static cilist io___1232 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1233 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1238 = { 0, 6, 0, 0, 0 }; + static cilist io___1240 = { 0, 6, 0, 0, 0 }; + static cilist io___1241 = { 0, 6, 0, 0, 0 }; + static cilist io___1242 = { 0, 6, 0, 0, 0 }; + static cilist io___1243 = { 0, 15, 0, "(a,2i5)", 0 }; + static cilist io___1244 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1246 = { 0, 12, 0, "(a)", 0 }; + static cilist io___1247 = { 0, 12, 0, 0, 0 }; + static cilist io___1248 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 }; + static cilist io___1249 = { 0, 12, 0, 0, 0 }; + static cilist io___1268 = { 0, 12, 0, 0, 0 }; + static cilist io___1283 = { 0, 12, 0, "(i5)", 0 }; + static cilist io___1301 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 }; + static cilist io___1302 = { 0, 13, 0, "(i5)", 0 }; + static cilist io___1303 = { 0, 6, 0, "(/,a)", 0 }; + static cilist io___1304 = { 0, 6, 0, 0, 0 }; + static cilist io___1305 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___1306 = { 0, 15, 0, "()", 0 }; /* ccccccccccccccccccccccccccccccccccccccccccccccc */ @@ -29184,195 +47046,359 @@ integer numclef_(char *clefq, ftnlen clefq_len) /* cccccccccccccccccccccccccccccccccc */ /* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ /* logical mrecord,mplay,endmac,gotclef,cstuplet */ +#line 19680 "" /* Parameter adjustments */ +#line 19680 "" --nbarss; +#line 19680 "" +#line 19680 "" /* Function Body */ +#line 19682 "" + comis4bignv_1.is4bignv = FALSE_; +#line 19683 "" + comis4bignv_1.aiset = FALSE_; +#line 19684 "" commus_1.whead20 = .3f; +#line 19685 "" if (! (*optimize)) { - s_wsle(&io___1162); +#line 19686 "" + s_wsle(&io___1207); +#line 19686 "" e_wsle(); - s_wsle(&io___1163); +#line 19687 "" + s_wsle(&io___1208); +#line 19687 "" do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23); +#line 19687 "" e_wsle(); - s_wsfe(&io___1164); +#line 19688 "" + s_wsfe(&io___1209); +#line 19688 "" do_fio(&c__1, " Starting first PMX pass", (ftnlen)24); +#line 19688 "" e_wsfe(); +#line 19689 "" } +#line 19690 "" if (*isfirst) { +#line 19691 "" o__1.oerr = 0; +#line 19691 "" o__1.ounit = 19; +#line 19691 "" o__1.ofnmlen = 11; +#line 19691 "" o__1.ofnm = "pmxaerr.dat"; +#line 19691 "" o__1.orl = 0; +#line 19691 "" o__1.osta = 0; +#line 19691 "" o__1.oacc = 0; +#line 19691 "" o__1.ofm = 0; +#line 19691 "" o__1.oblnk = 0; +#line 19691 "" f_open(&o__1); - s_wsfe(&io___1165); +#line 19692 "" + s_wsfe(&io___1210); +#line 19692 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 19692 "" e_wsfe(); +#line 19693 "" cl__1.cerr = 0; +#line 19693 "" cl__1.cunit = 19; +#line 19693 "" cl__1.csta = 0; +#line 19693 "" f_clos(&cl__1); +#line 19694 "" } +#line 19695 "" if (! (*optimize)) { +#line 19695 "" jprntb = 81; +#line 19695 "" } +#line 19696 "" commac_1.macuse = 0; +#line 19697 "" comkeys_1.ornrpt = FALSE_; +#line 19698 "" comkeys_1.stickys = FALSE_; +#line 19699 "" commac_1.mrecord = FALSE_; +#line 19700 "" commac_1.mplay = FALSE_; +#line 19701 "" c1omget_1.lastchar = FALSE_; +#line 19702 "" comnvst_2.novshrinktop = FALSE_; +#line 19703 "" cstuplet = FALSE_; +#line 19704 "" comslur_1.fontslur = TRUE_; +#line 19705 "" comligfont_1.isligfont = FALSE_; +#line 19706 "" fulltrans = FALSE_; +#line 19707 "" for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999; ++c1omnotes_1.ibarcnt) { +#line 19708 "" c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f; +#line 19709 "" c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f; +#line 19710 "" /* L42: */ +#line 19710 "" } /* Initialize input buffer */ +#line 19714 "" c1omget_1.lenbuf0 = inbuff_1.ipbuf; +#line 19715 "" inbuff_1.ipbuf = 0; +#line 19716 "" inbuff_1.ilbuf = 1; +#line 19717 "" g1etset_(&a1ll_2.nv, &comkeys_1.noinst, &a1ll_2.mtrnuml, &mtrdenl, & mtrnmp, &mtrdnp, &xmtrnum0, comkeys_1.newkey, &compage_1.npages, & compage_1.nsyst, &commus_1.musize, &bottreb); /* Set up list of instrument numbers (iv) */ +#line 19722 "" ivnow = 0; +#line 19723 "" i__1 = comkeys_1.noinst; +#line 19723 "" for (instnow = 1; instnow <= i__1; ++instnow) { +#line 19724 "" i__2 = c1omget_1.nsperi[instnow - 1]; +#line 19724 "" for (iscount = 1; iscount <= i__2; ++iscount) { +#line 19725 "" ++ivnow; +#line 19726 "" cominsttrans_1.instno[ivnow - 1] = instnow; +#line 19727 "" /* L14: */ +#line 19727 "" } +#line 19728 "" /* L13: */ +#line 19728 "" } /* Save initial meter for midi */ +#line 19732 "" if (! (*isfirst) && compage_1.npages == 0) { - s_wsle(&io___1177); +#line 19733 "" + s_wsle(&io___1222); +#line 19733 "" do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", ( ftnlen)43); +#line 19733 "" e_wsle(); +#line 19734 "" stop1_(); +#line 19735 "" } +#line 19736 "" *nsyout = compage_1.nsyst; /* isig1 will be changed in getnote if there is a transposition */ +#line 19740 "" comkeys_1.isig1 = comkeys_1.newkey[0]; +#line 19741 "" if (compage_1.npages > compage_1.nsyst) { +#line 19742 "" printl_("npages > nsyst in input. Please fix the input.", (ftnlen)47) ; +#line 19743 "" stop1_(); +#line 19744 "" } /* fbar = afterruleskip/elemskip */ /* apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */ +#line 19749 "" c1ommvl_1.fbar = 1.f; +#line 19750 "" c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; +#line 19751 "" ifig = 0; +#line 19752 "" compage_1.usefig = TRUE_; +#line 19753 "" lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); +#line 19754 "" lenmult = 1; +#line 19755 "" if (mtrdenl == 2) { +#line 19756 "" lenbeat = 16; +#line 19757 "" lenmult = 2; +#line 19758 "" } +#line 19759 "" a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat; +#line 19760 "" r__1 = lenmult * xmtrnum0 * lenbeat; +#line 19760 "" a1ll_2.lenbr0 = i_nint(&r__1); +#line 19761 "" a1ll_2.mtrnuml = 0; +#line 19762 "" if (a1ll_2.lenbr0 != 0) { +#line 19763 "" c1omnotes_1.ibaroff = 1; +#line 19764 "" a1ll_2.lenbar = a1ll_2.lenbr0; +#line 19765 "" } else { +#line 19766 "" c1omnotes_1.ibaroff = 0; +#line 19767 "" a1ll_2.lenbar = a1ll_2.lenbr1; +#line 19768 "" } +#line 19769 "" c1omnotes_1.ibarcnt = 0; +#line 19770 "" c1omnotes_1.nptr[0] = 1; +#line 19771 "" a1ll_2.iccount = 128; +#line 19772 "" compage_1.nmovbrk = 0; +#line 19773 "" compage_1.nflb = 0; +#line 19774 "" compage_1.nfpb = 0; +#line 19775 "" compage_1.ipagfpb[0] = 1; +#line 19776 "" compage_1.isysfpb[0] = 1; +#line 19777 "" compage_1.ibarflb[0] = 1; +#line 19778 "" compage_1.isysflb[0] = 1; +#line 19779 "" compage_1.nistaff[0] = a1ll_2.nv - 1; /* Check for pmx.mod */ +#line 19783 "" c1omget_1.linesinpmxmod = 0; /* line1pmxmod = ilbuf */ +#line 19785 "" getpmxmod_(&c_true, " ", (ftnlen)1); +#line 19786 "" if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) { - s_wsle(&io___1181); - do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f" +#line 19787 "" + s_wsle(&io___1226); +#line 19787 "" + do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"\ "ile", (ftnlen)49); +#line 19787 "" e_wsle(); +#line 19788 "" stop1_(); +#line 19789 "" } /* Initialize for loop over lines */ +#line 19793 "" comkeys_1.nkeys = 1; +#line 19794 "" comkeys_1.ibrkch[0] = 1; +#line 19795 "" comkeys_1.mbrestsav = 0; +#line 19796 "" comkeys_1.shifton = FALSE_; +#line 19797 "" a1ll_2.firstline = TRUE_; +#line 19798 "" a1ll_2.newmeter = FALSE_; +#line 19799 "" c1omget_1.ihead = 0; +#line 19800 "" c1omget_1.isheadr = FALSE_; /* gotclef = .false. */ +#line 19802 "" comkeys_1.idsig = 0; +#line 19803 "" c1omnotes_1.iddot = 0; +#line 19804 "" compage_1.fintstf = -1.f; +#line 19805 "" compage_1.gintstf = 1.f; +#line 19806 "" listcresc = 0; +#line 19807 "" listdecresc = 0; +#line 19808 "" L30: +#line 19808 "" loop = TRUE_; +#line 19809 "" comkeys_1.iskchb = FALSE_; +#line 19810 "" c1omget_1.issegno = FALSE_; +#line 19811 "" a1ll_2.nbars = 0; +#line 19812 "" c1omnotes_1.ibarmbr = 0; +#line 19813 "" i__1 = a1ll_2.nv; +#line 19813 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 19814 "" c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1; +#line 19815 "" c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv; +#line 19816 "" a1ll_2.itsofar[a1ll_2.iv - 1] = 0; +#line 19817 "" a1ll_2.nnl[a1ll_2.iv - 1] = 0; +#line 19818 "" for (j = 1; j <= 200; ++j) { +#line 19819 "" a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_; +#line 19820 "" c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f; +#line 19821 "" /* L5: */ +#line 19821 "" } +#line 19822 "" /* L4: */ +#line 19822 "" } +#line 19823 "" a1ll_2.iv = 1; +#line 19824 "" c1ommvl_1.ivx = 1; +#line 19825 "" c1omget_1.fbon = FALSE_; +#line 19826 "" comkeys_1.barend = FALSE_; +#line 19827 "" c1omget_1.isvolt = FALSE_; +#line 19828 "" L2: +#line 19828 "" if (loop) { /* Within this short loop, nv voices are filled up for the duration of a block. */ @@ -29380,293 +47406,525 @@ L2: /* nodur(..),rest(..). nnl will later be */ /* increased and things slid around as accidental skips are added. */ +#line 19835 "" g1etnote_(&loop, &ifig, optimize, &fulltrans); +#line 19836 "" if (c1omget_1.lastchar) { +#line 19836 "" goto L20; +#line 19836 "" } +#line 19837 "" goto L2; +#line 19838 "" } +#line 19839 "" if (comkeys_1.mbrestsav > 0) { +#line 19840 "" printl_(" ", (ftnlen)1); +#line 19841 "" printl_("You must enter the same multibar rest in ALL parts", (ftnlen) 50); +#line 19843 "" stop1_(); +#line 19844 "" } +#line 19845 "" i__1 = a1ll_2.nbars; +#line 19845 "" for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { +#line 19846 "" ++c1omnotes_1.ibarcnt; /* The following is just a signal to start a new bar when cataloging spaces */ /* for catspace(...) */ +#line 19851 "" c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[ c1omnotes_1.ibarcnt - 1]; +#line 19852 "" newmb[c1omnotes_1.ibarcnt - 1] = FALSE_; +#line 19853 "" if (a1ll_2.newmeter && a1ll_2.ibar == 1) { +#line 19853 "" newmb[c1omnotes_1.ibarcnt - 1] = TRUE_; +#line 19853 "" } /* Above is only for spacing calcs later on. Remember new meter can only occur */ /* at START of a new input line (ibar = 1) */ +#line 19858 "" if (a1ll_2.ibar != c1omnotes_1.ibarmbr) { +#line 19859 "" if (! (*optimize)) { +#line 19859 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 19859 "" outbar_(&i__2, &jprntb); +#line 19859 "" } +#line 19860 "" } else { +#line 19861 "" if (! (*optimize)) { - s_wsfe(&io___1187); +#line 19862 "" + s_wsfe(&io___1232); +#line 19862 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 19862 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 19862 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 19862 "" do_fio(&c__1, "-", (ftnlen)1); +#line 19862 "" i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + c1omnotes_1.mbrest - 1; +#line 19862 "" do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); +#line 19862 "" e_wsfe(); - s_wsfe(&io___1188); +#line 19864 "" + s_wsfe(&io___1233); +#line 19864 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 19864 "" i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 19864 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 19864 "" do_fio(&c__1, "-", (ftnlen)1); +#line 19864 "" i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + c1omnotes_1.mbrest - 1; +#line 19864 "" do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); +#line 19864 "" e_wsfe(); +#line 19866 "" jprntb = 0; +#line 19867 "" } +#line 19868 "" c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest + 1; +#line 19869 "" } +#line 19870 "" if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) { +#line 19871 "" if (a1ll_2.ibar == 1) { +#line 19872 "" a1ll_2.lenbar = a1ll_2.lenbr0; +#line 19873 "" } else { +#line 19874 "" a1ll_2.lenbar = a1ll_2.lenbr1; +#line 19875 "" } +#line 19876 "" } +#line 19877 "" if (a1ll_2.ibar > 1) { /* For bars after first, slide all stuff down to beginning of arrays */ +#line 19881 "" i__2 = a1ll_2.nv; +#line 19881 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { +#line 19882 "" i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 19882 "" for (kv = 1; kv <= i__3; ++kv) { +#line 19883 "" c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 19884 "" ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24 - 25]; +#line 19885 "" i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25] - ioff; +#line 19885 "" for (ip = 1; ip <= i__4; ++ip) { +#line 19886 "" a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 19887 "" a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] = a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 19888 "" c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] = c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 19889 "" /* L12: */ +#line 19889 "" } +#line 19890 "" /* L11: */ +#line 19890 "" } +#line 19890 "" } +#line 19891 "" } +#line 19892 "" i__3 = a1ll_2.nv; +#line 19892 "" for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) { +#line 19893 "" i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 19893 "" for (kv = 1; kv <= i__2; ++kv) { +#line 19894 "" ioff = 0; +#line 19895 "" if (a1ll_2.ibar > 1) { +#line 19895 "" ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25] + (a1ll_2.ibar - 1) * 24 - 25]; +#line 19895 "" } +#line 19896 "" /* L67: */ +#line 19896 "" } +#line 19896 "" } +#line 19897 "" makeabar_(); +#line 19898 "" elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar; +#line 19899 "" /* L10: */ +#line 19899 "" } +#line 19900 "" a1ll_2.newmeter = FALSE_; +#line 19901 "" a1ll_2.firstline = FALSE_; +#line 19902 "" goto L30; +#line 19903 "" L20: /* Vertical analysis. */ +#line 19907 "" if (compage_1.npages == 0) { +#line 19908 "" if (compage_1.nsyst == 0) { - s_wsle(&io___1193); - do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n" +#line 19909 "" + s_wsle(&io___1238); +#line 19909 "" + do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"\ "ot 0", (ftnlen)46); +#line 19909 "" e_wsle(); +#line 19910 "" stop1_(); +#line 19911 "" } +#line 19912 "" compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1; +#line 19913 "" if (a1ll_2.nv == 1) { +#line 19914 "" nsystpp = 12; +#line 19915 "" } else if (a1ll_2.nv == 2) { +#line 19916 "" nsystpp = 7; +#line 19917 "" } else if (a1ll_2.nv == 3) { +#line 19918 "" nsystpp = 5; +#line 19919 "" } else if (a1ll_2.nv == 4) { +#line 19920 "" nsystpp = 3; +#line 19921 "" } else if (a1ll_2.nv <= 7) { +#line 19922 "" nsystpp = 2; +#line 19923 "" } else { +#line 19924 "" nsystpp = 1; +#line 19925 "" } +#line 19926 "" compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1; +#line 19927 "" } /* Check nsyst vs ibarcnt */ +#line 19931 "" if (compage_1.nsyst > c1omnotes_1.ibarcnt) { - s_wsle(&io___1195); +#line 19932 "" + s_wsle(&io___1240); +#line 19932 "" e_wsle(); - s_wsle(&io___1196); +#line 19933 "" + s_wsle(&io___1241); +#line 19933 "" do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14); +#line 19933 "" do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer) ); +#line 19933 "" do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof( integer)); +#line 19933 "" e_wsle(); - s_wsle(&io___1197); +#line 19934 "" + s_wsle(&io___1242); +#line 19934 "" do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33); +#line 19934 "" e_wsle(); - s_wsfe(&io___1198); +#line 19935 "" + s_wsfe(&io___1243); +#line 19935 "" do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15); +#line 19935 "" do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); +#line 19935 "" do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer)); +#line 19935 "" e_wsfe(); - s_wsfe(&io___1199); +#line 19936 "" + s_wsfe(&io___1244); +#line 19936 "" do_fio(&c__1, " There are more systems than bars.", (ftnlen)34); +#line 19936 "" e_wsfe(); +#line 19937 "" stop1_(); +#line 19938 "" } /* Set up dummy forced line & page breaks after last real one */ +#line 19942 "" ++compage_1.nflb; +#line 19943 "" compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1; +#line 19944 "" compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1; +#line 19945 "" ++compage_1.nfpb; +#line 19946 "" compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1; +#line 19947 "" compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1; +#line 19948 "" heightil = compage_1.ptheight * 4.f / commus_1.musize; +#line 19949 "" o__1.oerr = 0; +#line 19949 "" o__1.ounit = 12; +#line 19949 "" o__1.ofnm = 0; +#line 19949 "" o__1.orl = 0; +#line 19949 "" o__1.osta = "SCRATCH"; +#line 19949 "" o__1.oacc = 0; +#line 19949 "" o__1.ofm = 0; +#line 19949 "" o__1.oblnk = 0; +#line 19949 "" f_open(&o__1); - s_wsfe(&io___1201); +#line 19950 "" + s_wsfe(&io___1246); +#line 19950 "" do_fio(&c__1, basenameq, (*lbase)); +#line 19950 "" e_wsfe(); - s_wsle(&io___1202); +#line 19951 "" + s_wsle(&io___1247); +#line 19951 "" do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer)); +#line 19951 "" e_wsle(); /* Pass to pmxb the initial signature, including effect of transposition. */ - s_wsfe(&io___1203); +#line 19955 "" + s_wsfe(&io___1248); +#line 19955 "" do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real)); +#line 19955 "" do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)); +#line 19955 "" do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer)); +#line 19955 "" do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer)); +#line 19955 "" e_wsfe(); - s_wsle(&io___1204); +#line 19957 "" + s_wsle(&io___1249); +#line 19957 "" do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer)); +#line 19957 "" do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real)); +#line 19957 "" do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real)); +#line 19957 "" do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real)); +#line 19957 "" do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real)); +#line 19957 "" do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); +#line 19957 "" e_wsle(); +#line 19958 "" iflbnow = -1; +#line 19959 "" isysb4 = 0; +#line 19960 "" i__1 = compage_1.nfpb; +#line 19960 "" for (ifpb = 1; ifpb <= i__1; ++ifpb) { /* Each time thru this loop is like a single score with several pages */ +#line 19964 "" compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb - 1]; +#line 19965 "" compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb - 1]; +#line 19966 "" nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1; +#line 19967 "" nshort = nomnsystp * compage_1.npages - compage_1.nsyst; +#line 19968 "" i__2 = compage_1.npages; +#line 19968 "" for (ipage = 1; ipage <= i__2; ++ipage) { +#line 19969 "" nsystp = nomnsystp; +#line 19970 "" if (ipage <= nshort) { +#line 19970 "" --nsystp; +#line 19970 "" } /* Last system number on this page: */ +#line 19973 "" isysendpg = isysb4 + nsystp; +#line 19974 "" nintpg = 0; +#line 19975 "" i__3 = isysendpg; +#line 19975 "" for (isy = isysb4 + 1; isy <= i__3; ++isy) { +#line 19976 "" if (compage_1.isysflb[iflbnow + 1] == isy) { +#line 19976 "" ++iflbnow; +#line 19976 "" } +#line 19977 "" nintpg += compage_1.nistaff[iflbnow]; +#line 19978 "" /* L15: */ +#line 19978 "" } +#line 19979 "" xilfrac = 0.f; +#line 19980 "" xiltxt = 0.f; +#line 19981 "" if (ipage == 1 && c1omget_1.ihead > 0) { /* Needn't zero out ihead after printing titles if we only allow titles at top? */ +#line 19985 "" if ((c1omget_1.ihead & 1) == 1) { +#line 19986 "" xiltxt += cblock_1.hgtin * 4 / commus_1.musize; +#line 19987 "" xilfrac += cblock_1.etait; +#line 19988 "" } +#line 19989 "" if ((c1omget_1.ihead & 2) == 2) { +#line 19990 "" xiltxt += cblock_1.hgtti * 4 / commus_1.musize; +#line 19991 "" xilfrac += cblock_1.etatc; +#line 19992 "" } +#line 19993 "" if ((c1omget_1.ihead & 4) == 4) { +#line 19994 "" xiltxt += cblock_1.hgtco * 4 / commus_1.musize; +#line 19995 "" xilfrac += cblock_1.etacs1; +#line 19996 "" } else { /* Use double the title-composer space if there is no composer */ +#line 20000 "" xilfrac += cblock_1.etatc; +#line 20001 "" } +#line 20002 "" } +#line 20003 "" d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot; /* C = nsystp*(nv-1) */ +#line 20005 "" c__ = (real) nintpg; /* xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */ +#line 20007 "" xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) * cblock_1.xilbn; +#line 20008 "" if (bottreb) { +#line 20008 "" xn -= (nsystp - 1) * cblock_1.xilbtc; +#line 20008 "" } +#line 20009 "" if (c1omget_1.ihead == 0 && c1omget_1.isheadr) { +#line 20009 "" xn -= cblock_1.xilhdr; +#line 20009 "" } +#line 20010 "" if (ifig == 1) { +#line 20011 "" xn -= nsystp * cblock_1.xilfig; +#line 20012 "" } +#line 20013 "" glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__); +#line 20014 "" omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a * c__); @@ -29695,335 +47953,573 @@ L20: /* Only the first page will get local adjustment now if needed, others in pmxb */ +#line 20041 "" if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) { +#line 20042 "" facins = compage_1.fintstf; +#line 20043 "" compage_1.fintstf = -1.f; +#line 20044 "" } else { /* gintstf = 1.0 by default, but may be changed with AI<x> */ +#line 20048 "" facins = compage_1.gintstf; +#line 20049 "" } - s_wsle(&io___1223); +#line 20050 "" + s_wsle(&io___1268); +#line 20050 "" do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer)); /* Computing MAX */ +#line 20050 "" r__2 = 0.f, r__3 = cblock_1.etatop * glueil; +#line 20050 "" r__1 = dmax(r__2,r__3); +#line 20050 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 20050 "" r__4 = facins * (omegag + 4); +#line 20050 "" do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real)); +#line 20050 "" e_wsle(); +#line 20051 "" c1omget_1.ihead = 0; +#line 20052 "" c1omget_1.isheadr = FALSE_; +#line 20053 "" isysb4 = isysendpg; +#line 20054 "" /* L7: */ +#line 20054 "" } +#line 20055 "" /* L8: */ +#line 20055 "" } /* Done with vertical, now do horizontals */ +#line 20059 "" celsk[1] = elsk[0]; +#line 20060 "" i__1 = c1omnotes_1.ibarcnt; +#line 20060 "" for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { +#line 20061 "" celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1]; +#line 20062 "" /* L21: */ +#line 20062 "" } +#line 20063 "" lastbar[0] = 0; +#line 20064 "" ibar1 = 1; +#line 20065 "" wmins = -1.f; +#line 20066 "" iflb = 1; +#line 20067 "" imovbrk = 0; +#line 20068 "" ikey = 1; /* Return nsyst to its *total* value */ +#line 20072 "" compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1; +#line 20073 "" i__1 = compage_1.nsyst; +#line 20073 "" for (isyst = 1; isyst <= i__1; ++isyst) { +#line 20074 "" if (isyst == compage_1.isysflb[iflb]) { +#line 20074 "" ++iflb; +#line 20074 "" } +#line 20075 "" if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) { +#line 20076 "" if (isyst == compage_1.isysmb[imovbrk + 1]) { +#line 20076 "" ++imovbrk; +#line 20076 "" } +#line 20077 "" } +#line 20078 "" ibarb4 = lastbar[isyst - 1]; +#line 20079 "" if (isyst == 1) { +#line 20080 "" if (*isfirst) { +#line 20080 "" elsstarg = celsk[compage_1.ibarflb[1] - 1] / ( compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1 - c1omget_1.fracindent); +#line 20080 "" } +#line 20082 "" celskb4 = 0.f; +#line 20083 "" } else { +#line 20084 "" celskb4 = celsk[ibarb4]; /* Must dimension isysmb(0:*) just so I can execute this test! */ +#line 20088 "" if (*isfirst) { +#line 20089 "" if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[ imovbrk]) { /* First syst after forced line break. There may be indentation. */ +#line 20093 "" elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4) / (compage_1.isysflb[iflb] - isyst - compage_1.fracsys[imovbrk - 1]) * (1 - compage_1.fracsys[imovbrk - 1]); +#line 20096 "" } else { /* There is no indentation to deal with */ +#line 20100 "" elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4) / (compage_1.isysflb[iflb] - isyst); +#line 20102 "" } +#line 20103 "" } +#line 20104 "" } +#line 20105 "" if (*isfirst) { +#line 20106 "" diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1)); +#line 20107 "" i__2 = c1omnotes_1.ibarcnt; +#line 20107 "" for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) { +#line 20108 "" diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4); +#line 20109 "" if (dabs(diff) >= diff1) { +#line 20109 "" goto L24; +#line 20109 "" } +#line 20110 "" diff1 = dabs(diff); +#line 20111 "" /* L23: */ +#line 20111 "" } +#line 20112 "" L24: +#line 20112 "" --a1ll_2.ibar; +#line 20113 "" lastbar[isyst] = a1ll_2.ibar; +#line 20114 "" nbarss[isyst] = a1ll_2.ibar - ibarb4; +#line 20115 "" } else { /* nbarss is given as an input, must compute lastbar and ibar */ +#line 20119 "" lastbar[isyst] = nbarss[isyst] + ibarb4; +#line 20120 "" a1ll_2.ibar = lastbar[isyst]; +#line 20121 "" } /* elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */ +#line 20125 "" elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4; - s_wsfe(&io___1238); +#line 20126 "" + s_wsfe(&io___1283); +#line 20126 "" i__2 = lastbar[isyst - 1] + 1; +#line 20126 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 20126 "" e_wsfe(); /* Transposed sigs are isig1, newkey(2,3,...). */ +#line 20130 "" if (ikey == 1) { +#line 20131 "" key1 = comkeys_1.isig1; +#line 20132 "" } else { +#line 20133 "" key1 = comkeys_1.newkey[ikey - 1]; +#line 20134 "" } +#line 20135 "" fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize; +#line 20136 "" xelsk = 0.f; +#line 20137 "" L1: +#line 20137 "" if (ikey < comkeys_1.nkeys) { +#line 20138 "" if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) { /* Add space for all key changes */ +#line 20142 "" ++ikey; +#line 20143 "" key2 = comkeys_1.newkey[ikey - 1]; /* Computing MAX */ /* Computing MAX */ +#line 20144 "" i__5 = abs(key1), i__6 = abs(key2); +#line 20144 "" i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6); +#line 20144 "" naccs = max(i__3,i__4); +#line 20145 "" fsyst += naccs * wkeysig; /* Account for afterruleskips (fbar) */ +#line 20149 "" xelsk += c1ommvl_1.fbar / 2; +#line 20150 "" if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && ! comkeys_1.kchmid[ikey - 1]) { +#line 20150 "" xelsk += -1.f; +#line 20150 "" } +#line 20152 "" key1 = key2; +#line 20153 "" goto L1; +#line 20154 "" } +#line 20155 "" } /* Add extra fixed space for double bar */ +#line 20159 "" if (isyst == compage_1.nsyst) { +#line 20160 "" fsyst += 4.5f / commus_1.musize; +#line 20161 "" } /* Add extra fixed space for initial time signature */ +#line 20165 "" if (isyst == 1) { +#line 20166 "" fsyst += wtimesig; +#line 20167 "" } /* Add extra fixed space for time signature changes & user-defined spaces */ +#line 20171 "" i__2 = lastbar[isyst]; +#line 20171 "" for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) { +#line 20172 "" if (newmb[ibars - 1]) { +#line 20172 "" fsyst += wtimesig; +#line 20172 "" } +#line 20173 "" fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize; +#line 20174 "" /* L26: */ +#line 20174 "" } +#line 20175 "" if (isyst == 1) { +#line 20176 "" wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent); +#line 20177 "" } else { +#line 20178 "" if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == compage_1.isysmb[imovbrk]) { +#line 20180 "" wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1] ); +#line 20181 "" } else { +#line 20182 "" wdpt = compage_1.widthpt; +#line 20183 "" } +#line 20184 "" } +#line 20185 "" wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f; /* Checks for min spacing */ /* Get min allowable space */ +#line 20190 "" dtmin = 1e3f; +#line 20191 "" i__2 = ibar1 + nbarss[isyst] - 1; +#line 20191 "" for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) { /* Computing MIN */ +#line 20192 "" r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1]; +#line 20192 "" dtmin = dmin(r__1,r__2); +#line 20193 "" if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) { +#line 20193 "" wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1]; +#line 20193 "" } +#line 20194 "" /* L45: */ +#line 20194 "" } +#line 20195 "" if (wmins < 0.f) { +#line 20195 "" wmins = .3f; +#line 20195 "" } +#line 20196 "" wminpt = (wmins + 1) * .3f * commus_1.musize; /* Find max duration & # of notes for this system */ +#line 20200 "" dtmax = 0.f; +#line 20201 "" nns = 0; +#line 20202 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 20202 "" for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { /* Computing MAX */ +#line 20203 "" r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1]; +#line 20203 "" dtmax = dmax(r__1,r__2); +#line 20204 "" nns += c1omnotes_1.nnpd[iptr - 1]; +#line 20205 "" /* L43: */ +#line 20205 "" } +#line 20206 "" elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk); +#line 20207 "" if (elmin0 >= wminpt) { /* Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */ /* there is no need to "flatten" */ +#line 20212 "" sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst]; +#line 20213 "" comeon_1.eonk = 0.f; +#line 20214 "" comeon_1.ewmxk = 1.f; +#line 20215 "" } else { +#line 20216 "" elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) / f1eon_(&dtmax) + nns); +#line 20217 "" if (elmin1 <= wminpt) { /* print* */ /* print*,'In system #',isyst,' cannot meet min. space rqmt' */ /* write(15,'(/a,i5,a)') */ /* * 'In system #',isyst,' cannot meet min. space rqmt' */ +#line 20222 "" comeon_1.eonk = .9f; +#line 20223 "" } else { /* Find eonk by Newton method */ -/* eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) */ +#line 20227 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 20227 "" r__1 = wsyspt / wminpt; +#line 20227 "" r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk; +#line 20227 "" r__3 = (wminpt - elmin0) / (elmin1 - elmin0); +#line 20227 "" findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, & dtmin, &dtmax, &r__3); +#line 20230 "" comeon_1.eonk = dmin(.9f,comeon_1.eonk); +#line 20231 "" } +#line 20232 "" d__1 = (doublereal) f1eon_(&dtmax); +#line 20232 "" d__2 = (doublereal) comeon_1.eonk; +#line 20232 "" comeon_1.ewmxk = pow_dd(&d__1, &d__2); /* Recompute poenom! */ +#line 20236 "" sumelsk = 0.f; +#line 20237 "" i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 20237 "" for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { +#line 20238 "" r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1] ; +#line 20238 "" sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * feon_(&r__1); +#line 20240 "" /* L44: */ +#line 20240 "" } +#line 20241 "" } +#line 20242 "" poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk); /* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */ +#line 20246 "" if (isyst > 0) { +#line 20247 "" if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == compage_1.isysmb[imovbrk]) { +#line 20249 "" c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1]; +#line 20250 "" } else { +#line 20251 "" c1omget_1.fracindent = 0.f; +#line 20252 "" } +#line 20253 "" } - s_wsfe(&io___1256); +#line 20254 "" + s_wsfe(&io___1301); +#line 20254 "" do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real)); +#line 20254 "" do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer)); +#line 20254 "" do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real)); +#line 20254 "" do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real)); +#line 20254 "" do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real)); +#line 20254 "" do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)); +#line 20254 "" do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)); +#line 20254 "" e_wsfe(); +#line 20256 "" ibar1 += nbarss[isyst]; +#line 20257 "" /* L22: */ +#line 20257 "" } +#line 20258 "" al__1.aerr = 0; +#line 20258 "" al__1.aunit = 12; +#line 20258 "" f_rew(&al__1); +#line 20259 "" o__1.oerr = 0; +#line 20259 "" o__1.ounit = 13; +#line 20259 "" o__1.ofnm = 0; +#line 20259 "" o__1.orl = 0; +#line 20259 "" o__1.osta = "SCRATCH"; +#line 20259 "" o__1.oacc = 0; +#line 20259 "" o__1.ofm = 0; +#line 20259 "" o__1.oblnk = 0; +#line 20259 "" f_open(&o__1); - s_wsfe(&io___1257); +#line 20260 "" + s_wsfe(&io___1302); +#line 20260 "" do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer)); +#line 20260 "" e_wsfe(); +#line 20261 "" al__1.aerr = 0; +#line 20261 "" al__1.aunit = 13; +#line 20261 "" f_rew(&al__1); +#line 20262 "" inbuff_1.ilbuf = 1; +#line 20263 "" inbuff_1.ipbuf = 0; +#line 20264 "" if (! (*optimize)) { - s_wsfe(&io___1258); +#line 20265 "" + s_wsfe(&io___1303); +#line 20265 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 20265 "" e_wsfe(); - s_wsle(&io___1259); +#line 20266 "" + s_wsle(&io___1304); +#line 20266 "" e_wsle(); - s_wsfe(&io___1260); +#line 20267 "" + s_wsfe(&io___1305); +#line 20267 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 20267 "" e_wsfe(); - s_wsfe(&io___1261); +#line 20268 "" + s_wsfe(&io___1306); +#line 20268 "" e_wsfe(); +#line 20269 "" } /* Following syntax is needed since pmxa is called with literal argument .false. */ +#line 20273 "" if (*isfirst) { +#line 20273 "" *isfirst = FALSE_; +#line 20273 "" } +#line 20274 "" return 0; } /* pmxa_ */ @@ -30042,8 +48538,9 @@ L1: 107], ch__13[17], ch__14[12], ch__15[11], ch__16[15], ch__17[13], ch__18[9], ch__19[32], ch__20[10], ch__21[4], ch__22[16], ch__23[ 33], ch__24[18], ch__25[82], ch__26[66], ch__27[60], ch__28[45], - ch__29[6], ch__30[76], ch__31[40], ch__32[69], ch__33[41], ch__34[ - 44], ch__35[5], ch__36[7], ch__37[24], ch__38[22], ch__39[96]; + ch__29[11], ch__30[6], ch__31[76], ch__32[40], ch__33[69], ch__34[ + 41], ch__35[44], ch__36[5], ch__37[7], ch__38[24], ch__39[22], + ch__40[96]; cilist ci__1; icilist ici__1; olist o__1; @@ -30067,7 +48564,9 @@ L1: f_clos(cllist *), f_rew(alist *); /* Local variables */ - static integer islnow, iplnow, lvoltxt, nbarss; + extern /* Subroutine */ int clefsym_(integer *, char *, integer *, + integer *, ftnlen), wsclef_(integer *, integer *, integer *); + static integer nvalue, islnow, iplnow, lvoltxt, nbarss; static real elsktot; static integer ndigbn, indsym; extern /* Subroutine */ int wgmeter_(integer *, integer *); @@ -30096,7 +48595,7 @@ L1: static char basenameq[44], pathnameq[40]; extern /* Subroutine */ int midievent_(char *, integer *, integer *, ftnlen); - static real xintstaff[40]; + static real xintstaff[75]; static integer ia, ig, il, ip, it, kv, ip2, ibc, icc, ipa, ipi; static real esk; static char nmq[40]; @@ -30140,20 +48639,17 @@ L1: static logical onvolt; static real tstart[80]; static logical putmbr; - static real etatop, etabot; + static real etatop; + static logical istype0; + static real etabot; static integer inhnoh; extern /* Subroutine */ int getset_(integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *, real *, logical *, char *, char *, char *, char *, integer *, integer *, ftnlen, ftnlen, ftnlen, ftnlen); - static logical istype0; - static integer noinst, npages, ibcoff, ibmrep, nhstot, jprntb, nhssys, - lenbeat; - extern /* Subroutine */ int addmidi_(integer *, integer *, integer *, - integer *, real *, logical *, logical *), outbar_(integer *, - integer *); + static integer noinst, npages, ibcoff, ibmrep, lenbeat, nhstot, jprntb; static logical newclef; - static real ptsndb; + static integer nhssys; extern /* Subroutine */ int topfile_(char *, integer *, integer *, char *, integer *, integer *, real *, integer *, integer *, logical *, real *, logical *, ftnlen, ftnlen); @@ -30162,132 +48658,133 @@ L1: static real xntrial; extern integer ifnodur_(integer *, char *, ftnlen); static integer isystpg; - extern /* Subroutine */ int getnote_(logical *); - static real ptsndv, ptsdflt; - extern /* Subroutine */ int clefsym_(integer *, char *, integer *, - integer *, ftnlen), wsclef_(integer *, integer *, integer *); - static real xnsttop[40]; - static integer nvalue; + extern /* Subroutine */ int getnote_(logical *), addmidi_(integer *, + integer *, integer *, integer *, real *, logical *, logical *), + outbar_(integer *, integer *); + static real ptsndb, ptsndv, xnsttop[75], ptsdflt; /* Fortran I/O blocks */ - static cilist io___1262 = { 0, 6, 0, 0, 0 }; - static cilist io___1263 = { 0, 6, 0, 0, 0 }; - static cilist io___1264 = { 0, 6, 0, 0, 0 }; - static cilist io___1265 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1269 = { 0, 12, 0, "(a)", 0 }; - static cilist io___1271 = { 0, 12, 0, 0, 0 }; - static cilist io___1273 = { 0, 12, 0, 0, 0 }; - static cilist io___1289 = { 0, 6, 0, 0, 0 }; - static cilist io___1290 = { 0, 12, 0, 0, 0 }; - static cilist io___1296 = { 0, 13, 0, 0, 0 }; - static cilist io___1298 = { 0, 14, 0, "(a)", 0 }; - static cilist io___1301 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1302 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1303 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1306 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1316 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1318 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1319 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1323 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1324 = { 0, 11, 0, "(a14,f4.1,a)", 0 }; - static cilist io___1333 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1342 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1343 = { 0, 11, 0, "(a20,i1,a)", 0 }; - static cilist io___1344 = { 0, 11, 0, "(a20,i2,a)", 0 }; - static cilist io___1345 = { 0, 11, 0, "(a20)", 0 }; + static cilist io___1307 = { 0, 6, 0, 0, 0 }; + static cilist io___1308 = { 0, 6, 0, 0, 0 }; + static cilist io___1309 = { 0, 6, 0, 0, 0 }; + static cilist io___1310 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1314 = { 0, 12, 0, "(a)", 0 }; + static cilist io___1316 = { 0, 12, 0, 0, 0 }; + static cilist io___1318 = { 0, 12, 0, 0, 0 }; + static cilist io___1334 = { 0, 6, 0, 0, 0 }; + static cilist io___1335 = { 0, 12, 0, 0, 0 }; + static cilist io___1341 = { 0, 13, 0, 0, 0 }; + static cilist io___1343 = { 0, 14, 0, "(a)", 0 }; static cilist io___1346 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1348 = { 0, 11, 0, "(a11,i2,a2)", 0 }; - static cilist io___1349 = { 0, 11, 0, "(a11,i1,a2)", 0 }; - static cilist io___1350 = { 0, 12, 0, 0, 0 }; - static cilist io___1353 = { 0, 6, 0, 0, 0 }; - static cilist io___1354 = { 0, 6, 0, 0, 0 }; - static cilist io___1357 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1358 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1359 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1360 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1347 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1348 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1351 = { 0, 11, 0, "(a)", 0 }; static cilist io___1361 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1362 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1365 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1366 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1363 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1364 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; static cilist io___1368 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1369 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1369 = { 0, 11, 0, "(a14,f4.1,a)", 0 }; static cilist io___1378 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1379 = { 0, 12, 0, 0, 0 }; - static cilist io___1381 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 }; - static cilist io___1384 = { 0, 11, 0, fmtq, 0 }; - static cilist io___1386 = { 0, 6, 0, 0, 0 }; - static cilist io___1387 = { 0, 6, 0, 0, 0 }; - static cilist io___1388 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1391 = { 0, nmq+12, 0, "(2i1)", 2, 1 }; - static icilist io___1392 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 }; - static cilist io___1393 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1394 = { 0, 11, 0, "(a18,i1,a2)", 0 }; - static cilist io___1395 = { 0, 11, 0, "(a18,i2,a2)", 0 }; - static cilist io___1397 = { 0, 11, 0, "(a11,i1,a2)", 0 }; - static cilist io___1398 = { 0, 11, 0, "(a11,i2,a2)", 0 }; - static cilist io___1399 = { 0, 11, 0, "(a11,i3,a2)", 0 }; - static cilist io___1401 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1387 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1388 = { 0, 11, 0, "(a20,i1,a)", 0 }; + static cilist io___1389 = { 0, 11, 0, "(a20,i2,a)", 0 }; + static cilist io___1390 = { 0, 11, 0, "(a20)", 0 }; + static cilist io___1391 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1393 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1394 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1395 = { 0, 12, 0, 0, 0 }; + static cilist io___1398 = { 0, 6, 0, 0, 0 }; + static cilist io___1399 = { 0, 6, 0, 0, 0 }; static cilist io___1402 = { 0, 11, 0, "(a)", 0 }; static cilist io___1403 = { 0, 11, 0, "(a)", 0 }; static cilist io___1404 = { 0, 11, 0, "(a)", 0 }; static cilist io___1405 = { 0, 11, 0, "(a)", 0 }; static cilist io___1406 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1408 = { 0, 11, 0, fmtq, 0 }; - static cilist io___1409 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1410 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1407 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1410 = { 0, 11, 0, "(a)", 0 }; static cilist io___1411 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1412 = { 0, 11, 0, "(a)", 0 }; static cilist io___1413 = { 0, 11, 0, "(a)", 0 }; static cilist io___1414 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1415 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1416 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1417 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1418 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1419 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1420 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1421 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1422 = { 0, 11, 0, "(a)", 0 }; static cilist io___1423 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1424 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1425 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1426 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1427 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1428 = { 0, 11, 0, "(a16,i1,a14)", 0 }; - static cilist io___1429 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1430 = { 0, 12, 1, 0, 0 }; + static cilist io___1424 = { 0, 12, 0, 0, 0 }; + static cilist io___1426 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 }; + static cilist io___1429 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1431 = { 0, 6, 0, 0, 0 }; + static cilist io___1432 = { 0, 6, 0, 0, 0 }; static cilist io___1433 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1434 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1435 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1437 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1436 = { 0, nmq+12, 0, "(2i1)", 2, 1 }; + static icilist io___1437 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 }; static cilist io___1438 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1439 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1440 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1441 = { 0, 11, 0, "(a,2i1,a)", 0 }; - static cilist io___1442 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1443 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1439 = { 0, 11, 0, "(a18,i1,a2)", 0 }; + static cilist io___1440 = { 0, 11, 0, "(a18,i2,a2)", 0 }; + static cilist io___1442 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1443 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1444 = { 0, 11, 0, "(a11,i3,a2)", 0 }; + static cilist io___1446 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1447 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1448 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1449 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1450 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1451 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1452 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1454 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1455 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1456 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1457 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1458 = { 0, 11, 0, "(a)", 0 }; static cilist io___1459 = { 0, 11, 0, "(a)", 0 }; static cilist io___1460 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1468 = { 0, 11, 0, "(a11,f5.1,a4)", 0 }; + static cilist io___1461 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1462 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1463 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1464 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1465 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1466 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1467 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1468 = { 0, 11, 0, "(a)", 0 }; static cilist io___1469 = { 0, 11, 0, "(a)", 0 }; static cilist io___1470 = { 0, 11, 0, "(a)", 0 }; static cilist io___1471 = { 0, 11, 0, "(a)", 0 }; static cilist io___1472 = { 0, 11, 0, "(a)", 0 }; static cilist io___1473 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1474 = { 0, 6, 0, 0, 0 }; - static cilist io___1475 = { 0, 6, 0, 0, 0 }; - static cilist io___1476 = { 0, 15, 0, 0, 0 }; - static cilist io___1477 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1478 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1479 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1474 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1475 = { 0, 11, 0, "(a16,i1,a14)", 0 }; + static cilist io___1476 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1477 = { 0, 12, 1, 0, 0 }; static cilist io___1480 = { 0, 11, 0, "(a)", 0 }; static cilist io___1481 = { 0, 11, 0, "(a)", 0 }; static cilist io___1482 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1483 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 }; - static cilist io___1484 = { 0, 6, 0, 0, 0 }; - static cilist io___1485 = { 0, 6, 0, 0, 0 }; - static cilist io___1486 = { 0, 6, 0, 0, 0 }; - static cilist io___1487 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___1488 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1484 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1485 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1486 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1487 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1488 = { 0, 11, 0, "(a,2i1,a)", 0 }; + static cilist io___1489 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1490 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1506 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1507 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1515 = { 0, 11, 0, "(a11,f5.1,a4)", 0 }; + static cilist io___1516 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1517 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1518 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1519 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1520 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1521 = { 0, 6, 0, 0, 0 }; + static cilist io___1522 = { 0, 6, 0, 0, 0 }; + static cilist io___1523 = { 0, 15, 0, 0, 0 }; + static cilist io___1524 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1525 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1526 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1527 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1528 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1529 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1530 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1531 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 }; + static cilist io___1532 = { 0, 6, 0, 0, 0 }; + static cilist io___1533 = { 0, 6, 0, 0, 0 }; + static cilist io___1534 = { 0, 6, 0, 0, 0 }; + static cilist io___1535 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___1536 = { 0, 15, 0, "(a)", 0 }; /* ccccccccccccccccccccccccc */ @@ -30433,20 +48930,19 @@ L1: /* cccccccccccc */ /* c ipl cc */ /* cccccccccccc */ -/* c 0-7 Location in list [0,200] */ -/* c 0-7 Unused */ /* 0 blank barline (must be iv=1) (would have used islur but no room) */ /* 1 look left for K rests, moved here from iornq(30) */ /* 2 treblelowoct */ -/* c 2-7 Unused */ -/* 3-7 unused */ +/* 3 Open notehead in forced beam xtup */ +/* 4 Set if single stem tremolo */ +/* 5-6 termulo multiplicity - 1 */ +/* 7 unused */ /* 8 left offset main note one headwidth */ /* 9 right offset main note one headwidth */ /* 10 chord present? */ /* 11-16 Forced beam height adjustment (-30 to +30) */ /* 17-22 Forced beam slope adjustment (-30 to +30) */ /* 23-26 Slur index for Way-after grace. Inserted when slur is started. */ -/* c 27 Unused? */ /* 27 5th bit for slur index for Way-after grace (100712) */ /* 28 key change: only in voice 1 */ /* 29 Grace after main note. (Type A) */ @@ -30484,8 +48980,9 @@ L1: /* cccccccccccc */ /* 0 rest=1, no rest = 0 */ /* 1 There will be a vertical shift for number of this xtup */ -/* Moved hgt shft to mult 16-22, so could span -64,64. */ -/* c 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n' */ +/* 2 Set if 2-note tremolo starts here */ +/* 3-4 nsolid, # of solid beams in 2-note tremolo */ +/* 5-6 nindent, # of indented beams in 2-note tremolo */ /* 7 There is a horizontal shift for xtup number */ /* 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5 */ /* 14 Flip up/down-ness of xtup number */ @@ -30611,63 +49108,122 @@ L1: /* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ /* ccccccccccccccccccccccccccccccc */ +#line 20733 "" /* Parameter adjustments */ +#line 20733 "" --poevec; +#line 20733 "" +#line 20733 "" /* Function Body */ +#line 20733 "" + combottop_1.bottopgap = FALSE_; +#line 20734 "" + comlyr_1.inputmlyr = FALSE_; +#line 20735 "" + comhair_2.idhairuse = 0; +#line 20736 "" if (! (*optimize)) { - s_wsle(&io___1262); +#line 20737 "" + s_wsle(&io___1307); +#line 20737 "" e_wsle(); - s_wsle(&io___1263); +#line 20738 "" + s_wsle(&io___1308); +#line 20738 "" do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24); +#line 20738 "" e_wsle(); - s_wsle(&io___1264); +#line 20739 "" + s_wsle(&io___1309); +#line 20739 "" e_wsle(); - s_wsfe(&io___1265); +#line 20740 "" + s_wsfe(&io___1310); +#line 20740 "" do_fio(&c__1, "Starting second PMX pass", (ftnlen)24); +#line 20740 "" e_wsfe(); +#line 20741 "" } +#line 20742 "" newclef = FALSE_; +#line 20743 "" comclefrests_1.centrests = FALSE_; +#line 20744 "" ++(*ncalls); +#line 20745 "" comlast_1.islast = *inlast; +#line 20746 "" commac_1.macuse = 0; +#line 20747 "" isyscnt = 0; +#line 20748 "" all_1.stemmax = 8.2f; +#line 20749 "" all_1.stemmin = 3.9f; +#line 20750 "" all_1.stemlen = 6.f; +#line 20751 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 20751 "" *(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0]; +#line 20752 "" comignorenats_1.ignorenats = FALSE_; +#line 20753 "" combc_1.bcspec = TRUE_; +#line 20754 "" comas3_1.topmods = FALSE_; +#line 20755 "" ismbr = FALSE_; - s_rsfe(&io___1269); +#line 20756 "" + s_rsfe(&io___1314); +#line 20756 "" do_fio(&c__1, basenameq, (ftnlen)44); +#line 20756 "" e_rsfe(); - s_rsle(&io___1271); +#line 20757 "" + s_rsle(&io___1316); +#line 20757 "" do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer)); +#line 20757 "" e_rsle(); - s_rsle(&io___1273); +#line 20758 "" + s_rsle(&io___1318); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real)); +#line 20758 "" do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)) ; +#line 20758 "" do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer)); +#line 20758 "" do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); +#line 20758 "" e_rsle(); +#line 20760 "" inbuff_1.ilbuf = 1; +#line 20761 "" inbuff_1.ipbuf = 0; +#line 20762 "" getset_(&all_1.nv, &noinst, &all_1.mtrnuml, &all_1.mtrdenl, &all_1.mtrnmp, &all_1.mtrdnp, &xmtrnum0, &npages, &nsyst, &all_1.musicsize, & comtop_1.fracindent, &istype0, comtop_1.inameq, comclefq_1.clefq, all_1.sepsymq, pathnameq, &lpath, &comtop_1.isig0, (ftnlen)79, ( ftnlen)1, (ftnlen)1, (ftnlen)40); +#line 20765 "" if (commidi_1.ismidi) { /* Initial key signature and meter for pickup bar */ @@ -30680,113 +49236,199 @@ L1: /* Above is probably cosmetic */ /* call midievent('k',midisig,0) */ +#line 20777 "" if (xmtrnum0 > comtol_1.tol) { /* We have a pickup. Some tricky stuff to get a meter: */ +#line 20781 "" xntrial = xmtrnum0; +#line 20782 "" for (ip2 = 0; ip2 <= 5; ++ip2) { - if ((r__1 = r_mod(&xntrial, &c_b819), dabs(r__1)) < +#line 20783 "" + if ((r__1 = r_mod(&xntrial, &c_b1054), dabs(r__1)) < comtol_1.tol) { +#line 20783 "" goto L6; +#line 20783 "" } +#line 20784 "" xntrial *= 2; +#line 20785 "" /* L5: */ +#line 20785 "" } - s_wsle(&io___1289); +#line 20786 "" + s_wsle(&io___1334); +#line 20786 "" do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", ( ftnlen)36); +#line 20786 "" e_wsle(); +#line 20787 "" xntrial = 1.f; +#line 20788 "" ip2 = 0; +#line 20789 "" L6: +#line 20790 "" i__1 = i_nint(&xntrial); +#line 20790 "" i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl; +#line 20790 "" midievent_("m", &i__1, &i__2, (ftnlen)1); +#line 20791 "" } else { /* No pickup, enter the starting meter */ +#line 20795 "" midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); +#line 20796 "" } +#line 20797 "" } /* Set musicsize from value passed in common, due to possible reset by S[n]m16 */ +#line 20801 "" all_1.musicsize = commus_1.musize; - s_rsle(&io___1290); +#line 20802 "" + s_rsle(&io___1335); +#line 20802 "" do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real)); +#line 20802 "" do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer)); +#line 20802 "" i__1 = npages; +#line 20802 "" for (ipa = 1; ipa <= i__1; ++ipa) { +#line 20802 "" do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen) sizeof(integer)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real)); +#line 20802 "" do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real) ); +#line 20802 "" } +#line 20802 "" do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer)); +#line 20802 "" e_rsle(); /* If default width ever changes, must adjust this stmt. */ +#line 20807 "" slfac1 = 2.98156f / comtop_1.widthpt; +#line 20808 "" all_1.figbass = FALSE_; - s_rsle(&io___1296); +#line 20809 "" + s_rsle(&io___1341); +#line 20809 "" do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer)); +#line 20809 "" e_rsle(); +#line 20810 "" if (ifig == 1) { +#line 20811 "" all_1.figbass = TRUE_; +#line 20812 "" o__1.oerr = 0; +#line 20812 "" o__1.ounit = 14; +#line 20812 "" o__1.ofnm = 0; +#line 20812 "" o__1.orl = 0; +#line 20812 "" o__1.osta = "SCRATCH"; +#line 20812 "" o__1.oacc = 0; +#line 20812 "" o__1.ofm = 0; +#line 20812 "" o__1.oblnk = 0; +#line 20812 "" f_open(&o__1); - s_wsfe(&io___1298); +#line 20813 "" + s_wsfe(&io___1343); /* Writing concatenation */ +#line 20813 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 20813 "" i__3[1] = 3, a__1[1] = "def"; +#line 20813 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 20813 "" i__3[3] = 8, a__1[3] = "fixdrop{"; +#line 20813 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 20813 "" i__3[5] = 7, a__1[5] = "advance"; +#line 20813 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 20813 "" i__3[7] = 10, a__1[7] = "sysno by 1"; +#line 20813 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 20813 "" i__3[9] = 6, a__1[9] = "ifcase"; +#line 20813 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 20813 "" i__3[11] = 6, a__1[11] = "sysno%"; +#line 20813 "" s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46); +#line 20813 "" do_fio(&c__1, ch__2, (ftnlen)46); +#line 20813 "" e_wsfe(); +#line 20815 "" } +#line 20816 "" comget_1.lastchar = FALSE_; +#line 20817 "" ibcoff = 0; +#line 20818 "" if (xmtrnum0 > 0.f) { +#line 20818 "" ibcoff = -1; +#line 20818 "" } +#line 20819 "" o__1.oerr = 0; +#line 20819 "" o__1.ounit = 11; +#line 20819 "" o__1.ofnm = 0; +#line 20819 "" o__1.orl = 0; +#line 20819 "" o__1.osta = "SCRATCH"; +#line 20819 "" o__1.oacc = 0; +#line 20819 "" o__1.ofm = 0; +#line 20819 "" o__1.oblnk = 0; +#line 20819 "" f_open(&o__1); /* vshrink for the first page is calculated in topfile, */ /* and if true set interstaff=10. vshrink affects Titles. */ /* Must also save vshrink for page ending. */ +#line 20825 "" topfile_(basenameq, &lbase, &all_1.nv, comclefq_1.clefq, &noinst, & all_1.musicsize, xintstaff, &all_1.mtrnmp, &all_1.mtrdnp, & vshrink, &comask_1.fbar, &comslur_1.fontslur, (ftnlen)44, (ftnlen) @@ -30794,224 +49436,394 @@ L6: /* ninow is working value of # of instruments. noinst is max #, and # at start. */ +#line 20830 "" comnotes_1.ninow = noinst; /* Save original printed meter in case movement breaks */ +#line 20834 "" comget_1.movnmp = all_1.mtrnmp; +#line 20835 "" comget_1.movdnp = all_1.mtrdnp; +#line 20837 "" if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) { - s_wsfe(&io___1301); +#line 20837 "" + s_wsfe(&io___1346); /* Writing concatenation */ +#line 20837 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 20837 "" i__4[1] = 3, a__2[1] = "def"; +#line 20837 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 20837 "" i__4[3] = 8, a__2[3] = "figfont{"; +#line 20837 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 20837 "" i__4[5] = 9, a__2[5] = "eightrm}%"; +#line 20837 "" s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23); +#line 20837 "" do_fio(&c__1, ch__3, (ftnlen)23); +#line 20837 "" e_wsfe(); +#line 20837 "" } +#line 20840 "" if (comlast_1.islast && comligfont_1.isligfont) { +#line 20841 "" if (all_1.musicsize == 16) { - s_wsfe(&io___1302); +#line 20842 "" + s_wsfe(&io___1347); /* Writing concatenation */ +#line 20842 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 20842 "" i__5[1] = 4, a__3[1] = "font"; +#line 20842 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 20842 "" i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%"; +#line 20842 "" s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26); +#line 20842 "" do_fio(&c__1, ch__4, (ftnlen)26); +#line 20842 "" e_wsfe(); +#line 20843 "" } else { - s_wsfe(&io___1303); +#line 20844 "" + s_wsfe(&io___1348); /* Writing concatenation */ +#line 20844 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 20844 "" i__5[1] = 4, a__3[1] = "font"; +#line 20844 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 20844 "" i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%"; +#line 20844 "" s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); +#line 20844 "" do_fio(&c__1, ch__5, (ftnlen)27); +#line 20844 "" e_wsfe(); +#line 20845 "" } +#line 20846 "" } +#line 20847 "" lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); +#line 20848 "" if (all_1.mtrdenl == 2) { +#line 20848 "" lenbeat = 16; +#line 20848 "" } +#line 20849 "" all_1.lenb1 = all_1.mtrnuml * lenbeat; +#line 20850 "" if (all_1.mtrdenl == 2) { +#line 20850 "" all_1.lenb1 <<= 1; +#line 20850 "" } +#line 20851 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep); +#line 20852 "" r__1 = xmtrnum0 * lenbeat; +#line 20852 "" all_1.lenb0 = i_nint(&r__1); +#line 20853 "" if (all_1.mtrdenl == 2) { +#line 20853 "" all_1.lenb0 <<= 1; +#line 20853 "" } +#line 20854 "" if (all_1.lenb0 != 0) { +#line 20855 "" if (comlast_1.islast) { - s_wsfe(&io___1306); +#line 20855 "" + s_wsfe(&io___1351); /* Writing concatenation */ +#line 20855 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 20855 "" i__5[1] = 7, a__3[1] = "advance"; +#line 20855 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 20855 "" i__5[3] = 11, a__3[3] = "barno by -1"; +#line 20855 "" s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20); +#line 20855 "" do_fio(&c__1, ch__6, (ftnlen)20); +#line 20855 "" e_wsfe(); +#line 20855 "" } +#line 20856 "" all_1.lenbar = all_1.lenb0; +#line 20857 "" } else { +#line 20858 "" all_1.lenbar = all_1.lenb1; +#line 20859 "" } /* Initialize full-program variables */ +#line 20863 "" comask_1.fixednew = 0.f; +#line 20864 "" comask_1.scaldold = 0.f; +#line 20865 "" comget_1.fintstf = -1.f; +#line 20866 "" comget_1.gintstf = 1.f; +#line 20867 "" comas2_1.nasksys = 0; +#line 20868 "" combibarcnt_1.ibarcnt = 0; +#line 20869 "" all_1.iline = 0; +#line 20870 "" comget_1.movbrk = 0; +#line 20871 "" isystpg = 0; +#line 20872 "" comnotes_1.ipage = 1; +#line 20873 "" all_1.iccount = 128; +#line 20874 "" comas3_1.iask = 0; +#line 20875 "" nhstot = 0; +#line 20876 "" comnsp_2.nb = 1; +#line 20877 "" if (! (*optimize)) { +#line 20877 "" jprntb = 81; +#line 20877 "" } +#line 20878 "" comtop_1.idsig = 0; /* Next 5 are raise-barno parameters. irzbnd is integer part of default level. */ +#line 20882 "" comsln_1.irzbnd = 3; +#line 20883 "" if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv - 1] == 't') { +#line 20883 "" comsln_1.irzbnd = 4; +#line 20883 "" } +#line 20884 "" comsln_1.is1n1 = 0; +#line 20885 "" comsln_1.isnx = 0; +#line 20886 "" comslur_1.slurcurve = 0.f; /* 111109 Made global rather than per gulp */ +#line 20890 "" comdyn_1.ndyn = 0; +#line 20891 "" compoi_1.ispoi = FALSE_; +#line 20892 "" slint = FALSE_; +#line 20893 "" lrptpend = FALSE_; +#line 20894 "" comget_1.rptnd1 = FALSE_; +#line 20895 "" *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 20896 "" comget_1.rptprev = FALSE_; +#line 20897 "" onvolt = FALSE_; +#line 20898 "" comnsp_2.flgndb = FALSE_; +#line 20899 "" comget_1.fbon = FALSE_; +#line 20900 "" comnotes_1.shifton = FALSE_; +#line 20901 "" comget_1.ornrpt = FALSE_; +#line 20902 "" comnotes_1.setis = FALSE_; +#line 20903 "" comarp_1.lowdot = FALSE_; +#line 20904 "" comnvi_1.rename = FALSE_; +#line 20905 "" comnotes_1.nobar1 = FALSE_; +#line 20906 "" comget_1.equalize = FALSE_; +#line 20907 "" comlast_1.usevshrink = TRUE_; +#line 20908 "" comslur_1.wrotepsslurdefaults = FALSE_; +#line 20909 "" comnotes_1.optlinebreakties = FALSE_; +#line 20910 "" comnotes_1.headerspecial = FALSE_; /* vshrink is initialized in topfile */ +#line 20914 "" comget_1.stickys = FALSE_; /* ixrest = 1 or 2 if xtup has started with a rest */ +#line 20918 "" for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) { +#line 20919 "" strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 20920 "" comfig_1.fullsize[commvl_1.ivx - 1] = 1.f; /* Set legacy note level to middle c as default */ +#line 20924 "" comnotes_1.ndlev[commvl_1.ivx - 1] = 29; +#line 20925 "" comnotes_1.ndlev[commvl_1.ivx + 23] = 29; +#line 20926 "" /* L1: */ +#line 20926 "" } +#line 20927 "" comnotes_1.npreslur = 0; +#line 20928 "" nhssys = 0; +#line 20929 "" comslur_1.listslur = 0; +#line 20930 "" for (i__ = 1; i__ <= 202; ++i__) { +#line 20931 "" all_1.isdat1[i__ - 1] = 0; +#line 20932 "" all_1.isdat2[i__ - 1] = 0; +#line 20933 "" /* L31: */ +#line 20933 "" } +#line 20934 "" all_1.nsdat = 0; /* Initialize flag for figures in any other voice than 1 */ +#line 20938 "" comfig_1.ivxfig2 = 0; /* Initialize for loop over gulps */ +#line 20942 "" all_1.firstgulp = TRUE_; /* Start a gulp */ +#line 20946 "" L30: +#line 20946 "" loop = TRUE_; +#line 20947 "" comnotes_1.notcrd = TRUE_; +#line 20948 "" combjmp_1.isbjmp = FALSE_; +#line 20949 "" combjmp_1.isbj2 = FALSE_; +#line 20950 "" comfb_1.autofbon = FALSE_; +#line 20951 "" comfb_1.tautofb = 0.f; +#line 20952 "" all_1.nbars = 0; +#line 20953 "" comfig_1.nfigs[0] = 0; +#line 20954 "" comfig_1.nfigs[1] = 0; +#line 20955 "" comgrace_1.ngrace = 0; +#line 20956 "" comtrill_1.ntrill = 0; +#line 20957 "" comtrill_1.ncrd = 0; +#line 20958 "" comtrill_1.nudorn = 0; +#line 20959 "" comgrace_1.nlit = 0; +#line 20960 "" comgrace_1.nvolt = 0; +#line 20961 "" comgrace_1.ibarmbr = 0; +#line 20962 "" comudsp_1.nudsp = 0; /* ndyn = 0 ! 111109 */ +#line 20964 "" comdyn_1.ntxtdyn = 0; +#line 20965 "" comcb_1.nbc = 0; +#line 20966 "" comarpshift_1.numarpshift = 0; +#line 20967 "" for (i__ = 1; i__ <= 37; ++i__) { +#line 20968 "" comgrace_1.graspace[i__ - 1] = 0.f; +#line 20969 "" /* L3: */ +#line 20969 "" } /* Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst. */ /* and also if nv increases in an 'M' directive. */ +#line 20974 "" i__1 = all_1.nv; +#line 20974 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 20975 "" newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, ( ftnlen)1); +#line 20976 "" /* L4: */ +#line 20976 "" } /* Check if endsymbol was set earlier */ +#line 20980 "" if (comget_1.rptnd1) { +#line 20981 "" comget_1.rptnd1 = FALSE_; +#line 20982 "" *(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1; +#line 20983 "" } else { /* Only use if movbrk>0, to signal default ('RD') */ +#line 20987 "" *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 20988 "" } +#line 20989 "" all_1.iv = 1; +#line 20990 "" commvl_1.ivx = 1; +#line 20991 "" L2: +#line 20991 "" if (loop) { /* Within this loop, nv voices are filled up for the duration of the block. */ @@ -31021,119 +49833,212 @@ L2: /* Only at the beginning of an input block will there be a possible mtr change, */ /* signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) */ +#line 21000 "" getnote_(&loop); +#line 21001 "" if (comget_1.lastchar) { +#line 21001 "" goto L40; +#line 21001 "" } +#line 21002 "" goto L2; +#line 21003 "" } /* Finished an input block (gulp). */ +#line 21007 "" if (commidi_1.ismidi) { /* Put rests into midi array for 2nd lines that were not used in this gulp. */ +#line 21011 "" i__1 = all_1.nv; +#line 21011 "" for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 21012 "" if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1] == 1) { +#line 21013 "" if (all_1.firstgulp && all_1.lenb0 != 0) { +#line 21014 "" r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0; +#line 21014 "" addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); +#line 21016 "" } else { +#line 21017 "" r__1 = all_1.nbars * 1.f * all_1.lenbar; +#line 21017 "" addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); +#line 21019 "" } +#line 21020 "" } +#line 21021 "" /* L60: */ +#line 21021 "" } +#line 21022 "" } +#line 21023 "" comgrace_1.nvolt = 0; +#line 21024 "" for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) { +#line 21025 "" comudsp_1.nudoff[all_1.iv - 1] = 0; +#line 21026 "" + comcc_1.maxdotmv[all_1.iv - 1] = comcc_1.ndotmv[all_1.iv - 1]; +#line 21027 "" comcc_1.ndotmv[all_1.iv - 1] = 0; +#line 21028 "" /* L28: */ +#line 21028 "" } /* Put stuff at top of p.1. Must wait until now to have read title info. */ +#line 21032 "" if (combibarcnt_1.ibarcnt == 0) { +#line 21033 "" puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &etatop, all_1.sq, &etait, &etatc, &etacs1, &all_1.nv, &vshrink, all_1.sepsymq, ( ftnlen)1, (ftnlen)1); +#line 21035 "" if (comnotes_1.headerspecial) { - s_wsfe(&io___1316); +#line 21035 "" + s_wsfe(&io___1361); /* Writing concatenation */ +#line 21035 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 21035 "" i__6[0] = 1, a__4[0] = ch__1; +#line 21035 "" i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"; +#line 21035 "" s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); +#line 21035 "" do_fio(&c__1, ch__7, (ftnlen)29); +#line 21035 "" e_wsfe(); +#line 21035 "" } /* Write special header for first page */ +#line 21040 "" } +#line 21041 "" i__1 = all_1.nbars; +#line 21041 "" for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) { +#line 21042 "" ++combibarcnt_1.ibarcnt; +#line 21043 "" comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto; /* Computing MAX */ +#line 21044 "" r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff; +#line 21044 "" i__2 = 0, i__7 = (integer) r_lg10(&r__1); +#line 21044 "" ndig = max(i__2,i__7); +#line 21045 "" if (comlast_1.islast) { +#line 21045 "" ci__1.cierr = 0; +#line 21045 "" ci__1.ciunit = 11; /* Writing concatenation */ +#line 21045 "" i__8[0] = 6, a__5[0] = "(a11,i"; +#line 21045 "" i__2 = ndig + 50; +#line 21045 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 21045 "" i__8[1] = 1, a__5[1] = ch__1; +#line 21045 "" i__8[2] = 1, a__5[2] = ")"; +#line 21045 "" ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8); +#line 21045 "" s_wsfe(&ci__1); +#line 21045 "" do_fio(&c__1, "% Bar count", (ftnlen)11); +#line 21045 "" i__7 = combibarcnt_1.ibarcnt + ibcoff; +#line 21045 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 21045 "" e_wsfe(); +#line 21045 "" } +#line 21048 "" if (all_1.ibar != comgrace_1.ibarmbr) { +#line 21049 "" if (! (*optimize)) { +#line 21049 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 21049 "" outbar_(&i__2, &jprntb); +#line 21049 "" } +#line 21050 "" } else { +#line 21051 "" if (! (*optimize)) { - s_wsfe(&io___1318); +#line 21052 "" + s_wsfe(&io___1363); +#line 21052 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 21052 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 21052 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 21052 "" do_fio(&c__1, "-", (ftnlen)1); +#line 21052 "" i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; +#line 21052 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 21052 "" e_wsfe(); - s_wsfe(&io___1319); +#line 21054 "" + s_wsfe(&io___1364); +#line 21054 "" do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 21054 "" i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 21054 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 21054 "" do_fio(&c__1, "-", (ftnlen)1); +#line 21054 "" i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; +#line 21054 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 21054 "" e_wsfe(); +#line 21056 "" jprntb = 0; +#line 21057 "" } +#line 21058 "" ibcoff = ibcoff + comgrace_1.mbrest - 1; /* if (ibar.eq.1 .and. firstgulp .and. */ /* * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize */ +#line 21061 "" if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[ 0],5)) { +#line 21061 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21061 "" } +#line 21063 "" } /* Move the read to after end-of-bar hardspace checks, so we get right poenom */ @@ -31150,82 +50055,137 @@ L2: /* compute additional pts and store them in hpttot(1...nhstot). Finally in */ /* subroutine askfig, write true pts where placeholders are. */ +#line 21079 "" ioff = 0; +#line 21080 "" if (all_1.ibar > 1) { +#line 21080 "" ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24]; +#line 21080 "" } +#line 21081 "" clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15); +#line 21082 "" putmbr = FALSE_; +#line 21083 "" if (ismbr) { +#line 21084 "" if (clchb) { /* cc */ /* cc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */ /* cc */ - s_wsfe(&io___1323); +#line 21088 "" + s_wsfe(&io___1368); /* Writing concatenation */ +#line 21088 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 21088 "" i__9[1] = 3, a__6[1] = "let"; +#line 21088 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 21088 "" i__9[3] = 4, a__6[3] = "mbrt"; +#line 21088 "" i__9[4] = 1, a__6[4] = all_1.sq; +#line 21088 "" i__9[5] = 6, a__6[5] = "mbrest"; +#line 21088 "" i__9[6] = 1, a__6[6] = all_1.sq; +#line 21088 "" i__9[7] = 3, a__6[7] = "def"; +#line 21088 "" i__9[8] = 1, a__6[8] = all_1.sq; +#line 21088 "" i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%"; +#line 21088 "" s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35); +#line 21088 "" do_fio(&c__1, ch__9, (ftnlen)35); +#line 21088 "" e_wsfe(); - s_wsfe(&io___1324); +#line 21090 "" + s_wsfe(&io___1369); /* Writing concatenation */ +#line 21090 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21090 "" i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{"; +#line 21090 "" s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); +#line 21090 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21090 "" r__1 = all_1.musicsize * .55f; +#line 21090 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); /* Writing concatenation */ +#line 21090 "" i__10[0] = 1, a__7[0] = "}"; +#line 21090 "" i__10[1] = 1, a__7[1] = all_1.sq; +#line 21090 "" i__10[2] = 6, a__7[2] = "global"; +#line 21090 "" i__10[3] = 1, a__7[3] = all_1.sq; +#line 21090 "" i__10[4] = 3, a__7[4] = "let"; +#line 21090 "" i__10[5] = 1, a__7[5] = all_1.sq; +#line 21090 "" i__10[6] = 6, a__7[6] = "mbrest"; +#line 21090 "" i__10[7] = 1, a__7[7] = all_1.sq; +#line 21090 "" i__10[8] = 6, a__7[8] = "mbrt}%"; +#line 21090 "" s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26); +#line 21090 "" do_fio(&c__1, ch__4, (ftnlen)26); +#line 21090 "" e_wsfe(); /* c */ /* c RDT suggestion is inset blank barline - 160103 Abandoned */ /* c */ /* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' */ /* * //sq//'advance'//sq//'barno-1' */ +#line 21097 "" } +#line 21098 "" ismbr = FALSE_; +#line 21099 "" putmbr = TRUE_; +#line 21100 "" } +#line 21101 "" if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21101 "" ismbr = TRUE_; +#line 21101 "" } /* Set flag here so at start of next bar, if there's a clef change, can add space */ /* after the mbr with the above kluge */ +#line 21106 "" if (! (clchb || comnsp_2.flgndb)) { +#line 21106 "" goto L23; +#line 21106 "" } /* Must check available space */ +#line 21110 "" ptsndb = 0.f; /* Zero out block signal */ +#line 21114 "" if (clchb) { +#line 21114 "" all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff + 1) * 24 - 24],15); +#line 21114 "" } /* In this loop, we determine how much hardspace is needed (if any) */ @@ -31235,148 +50195,240 @@ L2: /* one. */ /* 4/18/98 Apparently nmxsav was a solution to the above problem */ +#line 21123 "" i__2 = all_1.nv; +#line 21123 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 21124 "" i__7 = comnsp_2.nvmxsav[all_1.iv - 1]; +#line 21124 "" for (kv = 1; kv <= i__7; ++kv) { +#line 21125 "" commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25]; +#line 21126 "" ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt; +#line 21127 "" ioff = 0; +#line 21128 "" if (all_1.ibar > 1) { +#line 21129 "" ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21130 "" ip = ioff; +#line 21131 "" if (all_1.ibar > 2) { +#line 21131 "" ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 21131 "" } /* prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */ +#line 21133 "" comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[ comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1]; /* If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. */ +#line 21137 "" } /* Only allow clef changes when ivx <= nv */ +#line 21141 "" if (commvl_1.ivx <= all_1.nv) { +#line 21142 "" clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[ all_1.iv + (ioff + 1) * 24 - 25],11); +#line 21143 "" if (clchv[all_1.iv - 1]) { /* Clef change in this voice. Turn off signal. Get space avail. */ +#line 21147 "" all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] = bit_clear(all_1.islur[all_1.iv + (ioff + 1) * 24 - 25],11); +#line 21148 "" if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] - comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) < comtol_1.tol) { +#line 21148 "" ptsndv += combmh_1.clefend * comask_1.wheadpt; +#line 21148 "" } +#line 21150 "" } +#line 21151 "" } /* Computing MAX */ +#line 21152 "" r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt * spfacs_1.xspfac; +#line 21152 "" ptsndb = dmax(r__1,r__2); +#line 21153 "" /* L16: */ +#line 21153 "" } +#line 21153 "" } /* ???? where is nb set??? nb probably in left over from makeabar */ +#line 21157 "" r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1]; +#line 21157 "" esk = feon_(&r__1); +#line 21158 "" ptsdflt = esk * comask_1.poenom - comask_1.wheadpt; /* if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */ +#line 21160 "" if ((ptsndb > ptsdflt || comnsp_2.ptsgnd > 0.f) && comget_1.movbrk == 0 && ! putmbr) { /* Must ADD hardspace! So put in a placeholder, and store params for later. */ +#line 21165 "" if (comlast_1.islast) { - s_wsfe(&io___1333); +#line 21165 "" + s_wsfe(&io___1378); /* Writing concatenation */ +#line 21165 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21165 "" i__6[1] = 18, a__4[1] = "xardspace{ pt}%"; +#line 21165 "" s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); +#line 21165 "" do_fio(&c__1, ch__11, (ftnlen)19); +#line 21165 "" e_wsfe(); +#line 21165 "" } +#line 21166 "" ++nhssys; +#line 21167 "" if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom * comnsp_2.eskgnd) { +#line 21168 "" hesk[nhssys - 1] = esk; +#line 21169 "" hpts[nhssys - 1] = ptsndb + comask_1.wheadpt; +#line 21170 "" } else { +#line 21171 "" hesk[nhssys - 1] = comnsp_2.eskgnd; +#line 21172 "" hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt; +#line 21173 "" } +#line 21174 "" comask_1.fixednew += hpts[nhssys - 1]; +#line 21175 "" comask_1.scaldold += hesk[nhssys - 1]; +#line 21176 "" } +#line 21177 "" if (clchb) { +#line 21178 "" i__7 = all_1.nv; +#line 21178 "" for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 21179 "" if (clchv[all_1.iv - 1]) { /* Writing concatenation */ +#line 21180 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21180 "" i__6[1] = 6, a__4[1] = "znotes"; +#line 21180 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21181 "" lnote = 7; +#line 21182 "" i__2 = all_1.iv; +#line 21182 "" for (iiv = 2; iiv <= i__2; ++iiv) { /* Writing concatenation */ +#line 21183 "" i__6[0] = lnote, a__4[0] = notexq; +#line 21183 "" i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2); +#line 21183 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21184 "" ++lnote; +#line 21185 "" /* L24: */ +#line 21185 "" } /* Recompute ioff since it will vary from voice to voice */ +#line 21189 "" if (all_1.ibar == 1) { +#line 21190 "" ioff = 0; +#line 21191 "" } else { +#line 21192 "" ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 - 25]; +#line 21193 "" } /* Must call clefsym to get nclef, even if there is a movement break */ +#line 21197 "" clefsym_(&all_1.islur[all_1.iv + (ioff + 1) * 24 - 25], fmtq, &lclef, &nclef, (ftnlen)24); /* If clefq = '8', must change '0' in pos'n 9 to '8' */ +#line 21201 "" if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) ) { /* Writing concatenation */ +#line 21201 "" i__8[0] = 8, a__5[0] = fmtq; +#line 21201 "" i__8[1] = 1, a__5[1] = "8"; +#line 21201 "" i__8[2] = 1, a__5[2] = fmtq + 9; +#line 21201 "" s_cat(fmtq, a__5, i__8, &c__3, (ftnlen)24); +#line 21201 "" } +#line 21203 "" if (comget_1.movbrk == 0 && comlast_1.islast) { - s_wsfe(&io___1342); +#line 21203 "" + s_wsfe(&io___1387); /* Writing concatenation */ +#line 21203 "" i__5[0] = lnote, a__3[0] = notexq; +#line 21203 "" i__5[1] = lclef, a__3[1] = fmtq; +#line 21203 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21203 "" i__5[3] = 3, a__3[3] = "en%"; +#line 21203 "" s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107); +#line 21203 "" do_fio(&c__1, ch__12, lnote + lclef + 4); +#line 21203 "" e_wsfe(); +#line 21203 "" } /* call wsclef(iv,ninow,clefq,nclef) */ +#line 21207 "" wsclef_(&all_1.iv, &comnotes_1.ninow, &nclef); /* Set new flag to be used just outside this loop, to kluge */ /* any calls to \CenterBar for full-bar rests, to make room for clef. */ +#line 21212 "" newclef = TRUE_; /* 151220 */ @@ -31386,329 +50438,576 @@ L2: /* and if we change from TLO to normal clef, need to resetclefsymbols */ /* if (clefq(iv) .eq. '8') then */ +#line 21221 "" if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) ) { +#line 21222 "" if (all_1.iv <= 9) { - s_wsfe(&io___1343); +#line 21223 "" + s_wsfe(&io___1388); /* Writing concatenation */ +#line 21223 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21223 "" i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; +#line 21223 "" s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); +#line 21223 "" do_fio(&c__1, ch__6, (ftnlen)20); - do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( +#line 21223 "" + do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 21223 "" i__11[0] = 1, a__8[0] = all_1.sq; +#line 21223 "" i__11[1] = 13, a__8[1] = "treblelowoct%"; +#line 21223 "" s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); +#line 21223 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21223 "" e_wsfe(); +#line 21225 "" } else { - s_wsfe(&io___1344); +#line 21226 "" + s_wsfe(&io___1389); /* Writing concatenation */ +#line 21226 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21226 "" i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; +#line 21226 "" s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); +#line 21226 "" do_fio(&c__1, ch__6, (ftnlen)20); - do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( +#line 21226 "" + do_fio(&c__1, (char *)&all_1.iv, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 21226 "" i__11[0] = 1, a__8[0] = all_1.sq; +#line 21226 "" i__11[1] = 13, a__8[1] = "treblelowoct%"; +#line 21226 "" s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); +#line 21226 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21226 "" e_wsfe(); +#line 21228 "" } +#line 21229 "" } else { +#line 21230 "" if (*(unsigned char *)&comclefq_1.clefq[all_1.iv - 1] == '8') { - s_wsfe(&io___1345); +#line 21231 "" + s_wsfe(&io___1390); /* Writing concatenation */ +#line 21231 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21231 "" i__6[1] = 16, a__4[1] = "resetclefsymbols"; +#line 21231 "" s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)17); +#line 21231 "" do_fio(&c__1, ch__13, (ftnlen)17); +#line 21231 "" e_wsfe(); +#line 21232 "" } +#line 21233 "" } +#line 21234 "" } +#line 21235 "" /* L17: */ +#line 21235 "" } +#line 21236 "" if (comlast_1.islast) { - s_wsfe(&io___1346); +#line 21236 "" + s_wsfe(&io___1391); /* Writing concatenation */ +#line 21236 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21236 "" i__6[1] = 11, a__4[1] = "pmxnewclefs"; +#line 21236 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21236 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21236 "" e_wsfe(); +#line 21236 "" } +#line 21237 "" } +#line 21238 "" L23: /* Kluge \CenterBar for whole bar rests if necessary */ +#line 21242 "" if (newclef && comclefrests_1.centrests) { /* write(11,'(a)')sq//'def'//sq//'value{11}%' */ +#line 21244 "" r__1 = all_1.musicsize * .55f; +#line 21244 "" nvalue = i_nint(&r__1); +#line 21245 "" if (nvalue > 10) { - s_wsfe(&io___1348); +#line 21246 "" + s_wsfe(&io___1393); /* Writing concatenation */ +#line 21246 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21246 "" i__5[1] = 3, a__3[1] = "def"; +#line 21246 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21246 "" i__5[3] = 6, a__3[3] = "value{"; +#line 21246 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 21246 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21246 "" do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); +#line 21246 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 21246 "" e_wsfe(); +#line 21248 "" } else { - s_wsfe(&io___1349); +#line 21249 "" + s_wsfe(&io___1394); /* Writing concatenation */ +#line 21249 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21249 "" i__5[1] = 3, a__3[1] = "def"; +#line 21249 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21249 "" i__5[3] = 6, a__3[3] = "value{"; +#line 21249 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 21249 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21249 "" do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); +#line 21249 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 21249 "" e_wsfe(); +#line 21251 "" } +#line 21252 "" } +#line 21253 "" newclef = FALSE_; +#line 21254 "" comclefrests_1.centrests = FALSE_; /* End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */ +#line 21258 "" if (comask_1.bar1syst) { - s_rsle(&io___1350); +#line 21259 "" + s_rsle(&io___1395); +#line 21259 "" do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof( real)); +#line 21259 "" e_rsle(); +#line 21260 "" } /* Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */ +#line 21264 "" if (all_1.ibar == 1) { +#line 21265 "" islnow = all_1.islur[0]; /* iornqnow = iornq(1,1) */ +#line 21267 "" iplnow = all_1.ipl[0]; +#line 21268 "" } else { +#line 21269 "" islnow = all_1.islur[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) * 24 - 24]; /* iornqnow = iornq(1,nib(1,ibar-1)+1) */ +#line 21271 "" iplnow = all_1.ipl[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) * 24 - 24]; +#line 21272 "" } /* Check for R-symbols set at end of prior input block */ +#line 21276 "" if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E') { +#line 21277 "" if (*(unsigned char *)comget_1.rptfq2 == 'D') { +#line 21278 "" islnow = bit_set(islnow,26); +#line 21279 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'r') { +#line 21280 "" islnow = bit_set(islnow,6); +#line 21281 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { +#line 21282 "" islnow = bit_set(islnow,8); +#line 21283 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { +#line 21284 "" islnow = bit_set(islnow,25); +#line 21285 "" } else { - s_wsle(&io___1353); +#line 21286 "" + s_wsle(&io___1398); +#line 21286 "" e_wsle(); - s_wsle(&io___1354); - do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in" +#line 21287 "" + s_wsle(&io___1399); +#line 21287 "" + do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"\ "put block:", (ftnlen)46); +#line 21287 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 21287 "" e_wsle(); +#line 21289 "" stop1_(); +#line 21290 "" } +#line 21291 "" *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 21292 "" } +#line 21293 "" if ((islnow & 352) != 0) { /* Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */ +#line 21297 "" lrpt = bit_test(islnow,5); +#line 21298 "" rrpt = bit_test(islnow,6); +#line 21299 "" lrptpend = lrpt && comask_1.bar1syst; +#line 21300 "" if (lrpt && ! lrptpend) { +#line 21301 "" if (rrpt) { +#line 21302 "" if (comlast_1.islast) { - s_wsfe(&io___1357); +#line 21302 "" + s_wsfe(&io___1402); /* Writing concatenation */ +#line 21302 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21302 "" i__6[1] = 18, a__4[1] = "setleftrightrepeat"; +#line 21302 "" s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); +#line 21302 "" do_fio(&c__1, ch__11, (ftnlen)19); +#line 21302 "" e_wsfe(); +#line 21302 "" } +#line 21303 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.lrrptfac - .4f; +#line 21304 "" } else { +#line 21305 "" if (comlast_1.islast) { - s_wsfe(&io___1358); +#line 21305 "" + s_wsfe(&io___1403); /* Writing concatenation */ +#line 21305 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21305 "" i__6[1] = 13, a__4[1] = "setleftrepeat"; +#line 21305 "" s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); +#line 21305 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21305 "" e_wsfe(); +#line 21305 "" } +#line 21306 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.rptfac - .4f; +#line 21307 "" } +#line 21308 "" } else if (rrpt) { +#line 21309 "" if (comlast_1.islast) { - s_wsfe(&io___1359); +#line 21309 "" + s_wsfe(&io___1404); /* Writing concatenation */ +#line 21309 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21309 "" i__6[1] = 14, a__4[1] = "setrightrepeat"; +#line 21309 "" s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); +#line 21309 "" do_fio(&c__1, ch__16, (ftnlen)15); +#line 21309 "" e_wsfe(); +#line 21309 "" } +#line 21310 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.rptfac - .4f; +#line 21311 "" } else if (bit_test(islnow,8)) { +#line 21312 "" if (comlast_1.islast) { - s_wsfe(&io___1360); +#line 21312 "" + s_wsfe(&io___1405); /* Writing concatenation */ +#line 21312 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21312 "" i__6[1] = 12, a__4[1] = "setdoublebar"; +#line 21312 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 21312 "" do_fio(&c__1, ch__17, (ftnlen)13); +#line 21312 "" e_wsfe(); +#line 21312 "" } +#line 21313 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.dbarfac - .4f; +#line 21314 "" } +#line 21315 "" } else if (bit_test(islnow,26)) { /* doubleBAR */ +#line 21319 "" if (comlast_1.islast) { - s_wsfe(&io___1361); +#line 21319 "" + s_wsfe(&io___1406); /* Writing concatenation */ +#line 21319 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21319 "" i__6[1] = 12, a__4[1] = "setdoubleBAR"; +#line 21319 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 21319 "" do_fio(&c__1, ch__17, (ftnlen)13); +#line 21319 "" e_wsfe(); +#line 21319 "" } +#line 21320 "" comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * spfacs_1.ddbarfac - .4f; /* else if (btest(iornqnow,29)) then */ +#line 21322 "" } else if (bit_test(iplnow,0)) { /* no bar line */ /* -- if (islast) write(11,'(a)')sq//'setzalaligne' */ /* ++ */ +#line 21328 "" if (comlast_1.islast) { +#line 21329 "" if (comget_1.movbrk == 0) { - s_wsfe(&io___1362); +#line 21330 "" + s_wsfe(&io___1407); /* Writing concatenation */ +#line 21330 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21330 "" i__6[1] = 12, a__4[1] = "setzalaligne"; +#line 21330 "" s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 21330 "" do_fio(&c__1, ch__17, (ftnlen)13); +#line 21330 "" e_wsfe(); +#line 21331 "" } else { /* Encountered "Rz" at start of input block at start of new movement, Must */ /* use newmovement macro with arg 4 rather than setzalaligne, since former */ /* already redefines stoppiece. */ +#line 21337 "" *(unsigned char *)comget_1.rptfq2 = 'z'; +#line 21338 "" } +#line 21339 "" } /* ++ */ +#line 21341 "" comask_1.fixednew += -.4f; +#line 21342 "" } /* 1st and 2nd endings */ +#line 21346 "" svolta = bit_test(islnow,7); +#line 21347 "" evolta = bit_test(islnow,9); +#line 21348 "" if (evolta) { +#line 21349 "" if (bit_test(islnow,10)) { +#line 21350 "" if (comlast_1.islast) { - s_wsfe(&io___1365); +#line 21350 "" + s_wsfe(&io___1410); /* Writing concatenation */ +#line 21350 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21350 "" i__6[1] = 11, a__4[1] = "endvoltabox"; +#line 21350 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21350 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21350 "" e_wsfe(); +#line 21350 "" } +#line 21351 "" } else { +#line 21352 "" if (comlast_1.islast) { - s_wsfe(&io___1366); +#line 21352 "" + s_wsfe(&io___1411); /* Writing concatenation */ +#line 21352 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21352 "" i__6[1] = 8, a__4[1] = "endvolta"; +#line 21352 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21352 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21352 "" e_wsfe(); +#line 21352 "" } +#line 21353 "" } +#line 21354 "" onvolt = FALSE_; +#line 21355 "" } +#line 21356 "" if (svolta) { +#line 21357 "" ++comgrace_1.nvolt; +#line 21358 "" lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, " ", (ftnlen)20, (ftnlen)1) - 1; +#line 21359 "" if (lvoltxt == 1) { +#line 21360 "" if (comlast_1.islast) { - s_wsfe(&io___1368); +#line 21360 "" + s_wsfe(&io___1413); /* Writing concatenation */ +#line 21360 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21360 "" i__5[1] = 8, a__3[1] = "Setvolta"; +#line 21360 "" i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; +#line 21360 "" i__5[3] = 1, a__3[3] = "%"; +#line 21360 "" s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 21360 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21360 "" e_wsfe(); +#line 21360 "" } +#line 21362 "" } else { +#line 21363 "" if (comlast_1.islast) { - s_wsfe(&io___1369); +#line 21363 "" + s_wsfe(&io___1414); /* Writing concatenation */ +#line 21363 "" i__12[0] = 1, a__9[0] = all_1.sq; +#line 21363 "" i__12[1] = 8, a__9[1] = "Setvolta"; +#line 21363 "" i__12[2] = 1, a__9[2] = "{"; +#line 21363 "" i__12[3] = lvoltxt, a__9[3] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; +#line 21363 "" i__12[4] = 2, a__9[4] = "}%"; +#line 21363 "" s_cat(ch__19, a__9, i__12, &c__5, (ftnlen)32); +#line 21363 "" do_fio(&c__1, ch__19, lvoltxt + 12); +#line 21363 "" e_wsfe(); +#line 21363 "" } +#line 21365 "" } +#line 21366 "" onvolt = TRUE_; +#line 21367 "" } +#line 21368 "" if (all_1.ibar > 1) { +#line 21369 "" ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1; +#line 21370 "" } else { +#line 21371 "" ipnow = 1; +#line 21372 "" } +#line 21373 "" iplnow = all_1.ipl[ipnow * 24 - 24]; +#line 21374 "" if (comask_1.bar1syst) { /* If listslur>0, then there is at least one slur or tie carried over the break */ +#line 21378 "" ispstie = FALSE_; +#line 21379 "" if (comnotes_1.optlinebreakties && ! comslur_1.fontslur && comslur_1.listslur != 0 && comlast_1.islast) { +#line 21379 "" linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( ftnlen)1); +#line 21379 "" } +#line 21383 "" ++all_1.iline; /* End an old system, Start a new system */ @@ -31716,140 +51015,225 @@ L23: /* Reduce space before mbrest at start of system */ /* Need this even if no accidentals in key signature */ +#line 21390 "" if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21390 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21390 "" } +#line 21392 "" if (all_1.iline != 1) { /* Not first line. */ /* Get corrected poe = points/elemskip for *previous* system */ +#line 21397 "" wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); +#line 21398 "" poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew) / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold); +#line 21400 "" ++isyscnt; +#line 21401 "" poevec[isyscnt] = poe; /* Transfer data for system into global arrays to hold until very end */ +#line 21405 "" i__7 = comas2_1.nasksys; +#line 21405 "" for (ia = 1; ia <= i__7; ++ia) { +#line 21406 "" ++comas3_1.iask; +#line 21407 "" comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1] / poe - (r__1 = comas2_1.elasksys[ia - 1], dabs( r__1)); /* Only admit negative ask if it was user-defined space, signalled by elask<=0. */ +#line 21411 "" if (comas2_1.elasksys[ia - 1] > 0.f) { +#line 21411 "" comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ - comas3_1.iask - 1], &c_b774); + comas3_1.iask - 1], &c_b1009); +#line 21411 "" } +#line 21412 "" /* L9: */ +#line 21412 "" } +#line 21413 "" i__7 = nhssys; +#line 21413 "" for (ia = 1; ia <= i__7; ++ia) { +#line 21414 "" ++nhstot; /* Computing MAX */ +#line 21415 "" r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; +#line 21415 "" comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); +#line 21416 "" /* L25: */ +#line 21416 "" } /* Reset counters for new system */ +#line 21420 "" comask_1.scaldold = 0.f; +#line 21421 "" comask_1.fixednew = 0.f; +#line 21422 "" comas2_1.nasksys = 0; +#line 21423 "" nhssys = 0; +#line 21424 "" } /* End of if block for first bar of non-first system. Still 1st bar, any system */ +#line 21428 "" if (comlast_1.islast && all_1.figbass) { - s_wsfe(&io___1378); +#line 21428 "" + s_wsfe(&io___1423); /* Writing concatenation */ +#line 21428 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21428 "" i__6[1] = 8, a__4[1] = "fixdrop%"; +#line 21428 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21428 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21428 "" e_wsfe(); +#line 21428 "" } +#line 21429 "" ++isystpg; /* Try moving the next stmt way down, to fix a bug and get \eject printed at */ /* end of single-system page. */ /* if (isystpg .eq. nsystp(ipage)) isystpg = 0 */ - s_rsle(&io___1379); +#line 21434 "" + s_rsle(&io___1424); +#line 21434 "" do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer)); +#line 21434 "" do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real)); +#line 21434 "" do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real)); +#line 21434 "" do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real)); +#line 21434 "" do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)) ; +#line 21434 "" do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real) ); +#line 21434 "" e_rsle(); +#line 21435 "" if (all_1.iline > 1) { +#line 21435 "" comtop_1.fracindent = frac; +#line 21435 "" } +#line 21436 "" if (all_1.figbass) { +#line 21437 "" all_1.ifigdr[(all_1.iline << 1) - 2] = 4; +#line 21438 "" all_1.ifigdr[(all_1.iline << 1) - 1] = 4; +#line 21439 "" } +#line 21440 "" all_1.slfac = slfac1 * all_1.musicsize * elsktot; +#line 21441 "" if (all_1.iline != 1) { /* For the line just _finished_, put figdrop in separate file. */ +#line 21445 "" if (all_1.figbass) { - s_wsfe(&io___1381); +#line 21445 "" + s_wsfe(&io___1426); /* Writing concatenation */ +#line 21445 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21445 "" i__6[1] = 8, a__4[1] = "figdrop="; +#line 21445 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21445 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21445 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) - 2], (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 21445 "" i__8[0] = 1, a__5[0] = " "; +#line 21445 "" i__8[1] = 1, a__5[1] = all_1.sq; +#line 21445 "" i__8[2] = 8, a__5[2] = "figdtwo="; +#line 21445 "" s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); +#line 21445 "" do_fio(&c__1, ch__20, (ftnlen)10); +#line 21445 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) - 1], (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 21445 "" i__11[0] = 1, a__8[0] = all_1.sq; +#line 21445 "" i__11[1] = 3, a__8[1] = "or%"; +#line 21445 "" s_cat(ch__21, a__8, i__11, &c__2, (ftnlen)4); +#line 21445 "" do_fio(&c__1, ch__21, (ftnlen)4); +#line 21445 "" e_wsfe(); +#line 21445 "" } /* Check slurs in top staff for interference w/ barno. Only check when */ /* # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS */ /* keep track of ons and offs when |isig|<=3. */ +#line 21453 "" r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f; +#line 21453 "" ndigbn = (integer) r_lg10(&r__1) + 1; +#line 21454 "" comsln_1.isnx = 0; +#line 21455 "" if (ndigbn >= abs(comtop_1.isig) && comsln_1.is1n1 > 0) { /* There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 */ /* Look for termination in remainder of this input block. If not found, */ /* just use is1n1. Remember, haven't slid down yet. */ +#line 21461 "" ioff = 0; +#line 21462 "" if (all_1.ibar > 1) { +#line 21462 "" ioff = all_1.nib[commvl_1.ivmx[all_1.nv + commvl_1.nvmx[all_1.nv - 1] * 24 - 25] + ( all_1.ibar - 1) * 24 - 25]; +#line 21462 "" } +#line 21463 "" i__7 = all_1.nsdat; +#line 21463 "" for (isdat = 1; isdat <= i__7; ++isdat) { +#line 21464 "" if (igetbits_(&all_1.isdat1[isdat - 1], &c__5, &c__13) == commvl_1.ivmx[all_1.nv + commvl_1.nvmx[ all_1.nv - 1] * 24 - 25] && ! bit_test( @@ -31861,50 +51245,82 @@ L23: /* is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */ /* Computing MAX */ +#line 21471 "" i__2 = comsln_1.is1n1, i__13 = igetbits_(& all_1.isdat2[isdat - 1], &c__7, &c__19); +#line 21471 "" comsln_1.is1n1 = max(i__2,i__13); +#line 21472 "" goto L51; +#line 21473 "" } +#line 21474 "" /* L50: */ +#line 21474 "" } /* If exiting loop normally, did not find end of slur. c'est la vie. */ +#line 21478 "" L51: +#line 21479 "" i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd; +#line 21479 "" comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7); +#line 21480 "" if (comsln_1.isnx > 0) { /* AHA! Slur likely to interfere with barno. */ /* Modified 090525 to use \bnrs */ +#line 21486 "" slint = TRUE_; +#line 21487 "" s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12); +#line 21488 "" if (comsln_1.irzbnd + comsln_1.isnx > 9) { +#line 21488 "" s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen) 12); +#line 21488 "" } +#line 21489 "" if (comlast_1.islast) { - s_wsfe(&io___1384); +#line 21489 "" + s_wsfe(&io___1429); /* Writing concatenation */ +#line 21489 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21489 "" i__5[1] = 3, a__3[1] = "def"; +#line 21489 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21489 "" i__5[3] = 11, a__3[3] = "raisebarno{"; +#line 21489 "" s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); +#line 21489 "" do_fio(&c__1, ch__22, (ftnlen)16); +#line 21489 "" i__7 = comsln_1.irzbnd + comsln_1.isnx; +#line 21489 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof( integer)); /* Writing concatenation */ +#line 21489 "" i__8[0] = 2, a__5[0] = ".5"; +#line 21489 "" i__8[1] = 1, a__5[1] = all_1.sq; +#line 21489 "" i__8[2] = 11, a__5[2] = "internote}%"; +#line 21489 "" s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); +#line 21489 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21489 "" e_wsfe(); +#line 21489 "" } /* if (islast) then */ /* if (isnx .le. 9) then */ @@ -31914,8 +51330,11 @@ L51: /* end if */ /* end if */ +#line 21499 "" } +#line 21500 "" } +#line 21501 "" if (comget_1.movbrk > 0) { /* movbrk = 0 */ @@ -31926,46 +51345,78 @@ L51: /* indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */ /* This is passed to \newmovement. */ +#line 21511 "" if (*(unsigned char *)comget_1.rptfq2 == 'E') { +#line 21511 "" *(unsigned char *)comget_1.rptfq2 = 'D'; +#line 21511 "" } +#line 21512 "" indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, ( ftnlen)1) - 1; +#line 21513 "" *(unsigned char *)comget_1.rptfq2 = 'E'; /* Also check for Rd or Rr set the normal way */ +#line 21517 "" if (bit_test(islnow,8)) { +#line 21518 "" indsym = 1; +#line 21519 "" } else if (bit_test(islnow,6)) { +#line 21520 "" indsym = 2; +#line 21521 "" } +#line 21522 "" if (indsym < 0) { - s_wsle(&io___1386); +#line 21523 "" + s_wsle(&io___1431); +#line 21523 "" e_wsle(); - s_wsle(&io___1387); +#line 21524 "" + s_wsle(&io___1432); +#line 21524 "" do_lio(&c__9, &c__1, "Illegal end symbol before \"/\"" , (ftnlen)29); +#line 21524 "" e_wsle(); +#line 21525 "" stop1_(); +#line 21526 "" } /* Check for continuation (no bar number reset) */ +#line 21530 "" if (comlast_1.islast && comnotes_1.nobar1) { - s_wsfe(&io___1388); +#line 21530 "" + s_wsfe(&io___1433); /* Writing concatenation */ +#line 21530 "" i__14[0] = 1, a__10[0] = all_1.sq; +#line 21530 "" i__14[1] = 7, a__10[1] = "advance"; +#line 21530 "" i__14[2] = 1, a__10[2] = all_1.sq; +#line 21530 "" i__14[3] = 6, a__10[3] = "barno1"; +#line 21530 "" i__14[4] = 1, a__10[4] = all_1.sq; +#line 21530 "" i__14[5] = 10, a__10[5] = "startbarno"; +#line 21530 "" i__14[6] = 1, a__10[6] = all_1.sq; +#line 21530 "" i__14[7] = 6, a__10[7] = "barno%"; +#line 21530 "" s_cat(ch__23, a__10, i__14, &c__8, (ftnlen)33); +#line 21530 "" do_fio(&c__1, ch__23, (ftnlen)33); +#line 21530 "" e_wsfe(); +#line 21530 "" } /* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */ @@ -31977,166 +51428,294 @@ L51: /* if (islast) write(11,'(a13,i2,a1,i1,a1)') */ /* * sq//'newmovement{',movgap,'}',indsym,'%' */ /* end if */ +#line 21543 "" if (comlast_1.islast) { /* Writing concatenation */ +#line 21544 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21544 "" i__6[1] = 11, a__4[1] = "newmovement"; +#line 21544 "" s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40); +#line 21545 "" lnmq = 12; +#line 21546 "" if (comget_1.movgap < 10) { +#line 21547 "" lnmq = 14; - s_wsfi(&io___1391); +#line 21548 "" + s_wsfi(&io___1436); +#line 21548 "" do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) sizeof(integer)); +#line 21548 "" do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( integer)); +#line 21548 "" e_wsfi(); +#line 21549 "" } else { +#line 21550 "" lnmq = 17; - s_wsfi(&io___1392); +#line 21551 "" + s_wsfi(&io___1437); +#line 21551 "" do_fio(&c__1, "{", (ftnlen)1); +#line 21551 "" do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) sizeof(integer)); +#line 21551 "" do_fio(&c__1, "}", (ftnlen)1); +#line 21551 "" do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( integer)); +#line 21551 "" e_wsfi(); +#line 21552 "" } +#line 21553 "" if (comnotes_1.ninow < 10) { +#line 21554 "" ++lnmq; +#line 21555 "" ici__1.icierr = 0; +#line 21555 "" ici__1.icirnum = 1; +#line 21555 "" ici__1.icirlen = 1; +#line 21555 "" ici__1.iciunit = nmq + (lnmq - 1); +#line 21555 "" ici__1.icifmt = "(i1)"; +#line 21555 "" s_wsfi(&ici__1); +#line 21555 "" do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) sizeof(integer)); +#line 21555 "" e_wsfi(); +#line 21556 "" } else { +#line 21557 "" lnmq += 4; +#line 21558 "" i__7 = lnmq - 4; +#line 21558 "" ici__1.icierr = 0; +#line 21558 "" ici__1.icirnum = 1; +#line 21558 "" ici__1.icirlen = lnmq - i__7; +#line 21558 "" ici__1.iciunit = nmq + i__7; +#line 21558 "" ici__1.icifmt = "(a1,i2,a1)"; +#line 21558 "" s_wsfi(&ici__1); +#line 21558 "" do_fio(&c__1, "{", (ftnlen)1); +#line 21558 "" do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) sizeof(integer)); +#line 21558 "" do_fio(&c__1, "}", (ftnlen)1); +#line 21558 "" e_wsfi(); +#line 21559 "" } +#line 21560 "" ++lnmq; +#line 21561 "" ici__1.icierr = 0; +#line 21561 "" ici__1.icirnum = 1; +#line 21561 "" ici__1.icirlen = 1; +#line 21561 "" ici__1.iciunit = nmq + (lnmq - 1); +#line 21561 "" ici__1.icifmt = "(a1)"; +#line 21561 "" s_wsfi(&ici__1); +#line 21561 "" do_fio(&c__1, "%", (ftnlen)1); +#line 21561 "" e_wsfi(); - s_wsfe(&io___1393); +#line 21562 "" + s_wsfe(&io___1438); +#line 21562 "" do_fio(&c__1, nmq, lnmq); +#line 21562 "" e_wsfe(); +#line 21563 "" } /* Change generalmeter if necessary */ +#line 21567 "" if (comlast_1.islast) { +#line 21567 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21567 "" } /* (Moved all name-writing to getnote, right when 'M' is detected) */ +#line 21571 "" if (bit_test(iplnow,28)) { /* Key signature at movement break */ +#line 21575 "" iplnow = bit_clear(iplnow,28); +#line 21576 "" if (comtop_1.isig > 0) { +#line 21577 "" if (comlast_1.islast) { - s_wsfe(&io___1394); +#line 21577 "" + s_wsfe(&io___1439); /* Writing concatenation */ +#line 21577 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21577 "" i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 21577 "" s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18); +#line 21577 "" do_fio(&c__1, ch__24, (ftnlen)18); +#line 21577 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) sizeof(integer)); +#line 21577 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 21577 "" e_wsfe(); +#line 21577 "" } +#line 21579 "" } else { +#line 21580 "" if (comlast_1.islast) { - s_wsfe(&io___1395); +#line 21580 "" + s_wsfe(&io___1440); /* Writing concatenation */ +#line 21580 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21580 "" i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 21580 "" s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18); +#line 21580 "" do_fio(&c__1, ch__24, (ftnlen)18); +#line 21580 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) sizeof(integer)); +#line 21580 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 21580 "" e_wsfe(); +#line 21580 "" } +#line 21582 "" } +#line 21583 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 21584 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); +#line 21586 "" } +#line 21587 "" } +#line 21588 "" if (comget_1.parmov >= -.1f) { /* Resent paragraph indentation */ +#line 21592 "" ipi = comget_1.parmov * comtop_1.widthpt + .1f; +#line 21593 "" if (ipi < 10) { +#line 21594 "" if (comlast_1.islast) { - s_wsfe(&io___1397); +#line 21594 "" + s_wsfe(&io___1442); /* Writing concatenation */ +#line 21594 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21594 "" i__6[1] = 10, a__4[1] = "parindent "; +#line 21594 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21594 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21594 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); +#line 21594 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 21594 "" e_wsfe(); +#line 21594 "" } +#line 21596 "" } else if (ipi < 100) { +#line 21597 "" if (comlast_1.islast) { - s_wsfe(&io___1398); +#line 21597 "" + s_wsfe(&io___1443); /* Writing concatenation */ +#line 21597 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21597 "" i__6[1] = 10, a__4[1] = "parindent "; +#line 21597 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21597 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21597 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); +#line 21597 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 21597 "" e_wsfe(); +#line 21597 "" } +#line 21599 "" } else { +#line 21600 "" if (comlast_1.islast) { - s_wsfe(&io___1399); +#line 21600 "" + s_wsfe(&io___1444); /* Writing concatenation */ +#line 21600 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21600 "" i__6[1] = 10, a__4[1] = "parindent "; +#line 21600 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21600 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21600 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( integer)); +#line 21600 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 21600 "" e_wsfe(); +#line 21600 "" } +#line 21602 "" } +#line 21603 "" } +#line 21604 "" } +#line 21605 "" if (isystpg == 1) { /* First line on a page (not 1st page, still first bar). Tidy up old page */ @@ -32152,137 +51731,247 @@ L51: /* Check for meter change at start of a new PAGE */ +#line 21620 "" if (all_1.mtrnuml > 0) { /* Meter change at start of a new page. Ugly repeated coding here. */ +#line 21624 "" mtrnms = all_1.mtrnuml; +#line 21625 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); +#line 21626 "" all_1.mtrnuml = mtrnms; +#line 21627 "" if (comget_1.movbrk == 0 && comlast_1.islast) { +#line 21627 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21627 "" } +#line 21629 "" } /* Key signature change? */ +#line 21633 "" if (bit_test(iplnow,28) && comget_1.movbrk == 0) { /* Writing concatenation */ +#line 21634 "" i__14[0] = 1, a__10[0] = all_1.sq; +#line 21634 "" i__14[1] = 4, a__10[1] = "xbar"; +#line 21634 "" i__14[2] = 1, a__10[2] = all_1.sq; +#line 21634 "" i__14[3] = 10, a__10[3] = "addspace{-"; +#line 21634 "" i__14[4] = 1, a__10[4] = all_1.sq; +#line 21634 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 21634 "" i__14[6] = 1, a__10[6] = all_1.sq; +#line 21634 "" i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 21634 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 21636 "" lnote = 49; +#line 21637 "" if (comtop_1.isig < 0) { /* Writing concatenation */ +#line 21638 "" i__6[0] = 49, a__4[0] = notexq; +#line 21638 "" i__6[1] = 1, a__4[1] = "-"; +#line 21638 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21639 "" lnote = 50; +#line 21640 "" } +#line 21641 "" if (comlast_1.islast) { - s_wsfe(&io___1401); +#line 21641 "" + s_wsfe(&io___1446); /* Writing concatenation */ +#line 21641 "" i__8[0] = lnote, a__5[0] = notexq; +#line 21641 "" i__7 = abs(comtop_1.isig) + 48; +#line 21641 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 21641 "" i__8[1] = 1, a__5[1] = ch__1; +#line 21641 "" i__8[2] = 2, a__5[2] = "}%"; +#line 21641 "" s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 21641 "" do_fio(&c__1, ch__25, lnote + 3); +#line 21641 "" e_wsfe(); +#line 21641 "" } +#line 21643 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 21644 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); +#line 21646 "" } +#line 21647 "" if (comlast_1.islast && comignorenats_1.ignorenats) { - s_wsfe(&io___1402); +#line 21647 "" + s_wsfe(&io___1447); /* Writing concatenation */ +#line 21647 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21647 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21647 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21647 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21647 "" e_wsfe(); +#line 21647 "" } +#line 21649 "" if (comlast_1.islast) { - s_wsfe(&io___1403); +#line 21649 "" + s_wsfe(&io___1448); /* Writing concatenation */ +#line 21649 "" i__9[0] = 1, a__6[0] = all_1.sq; +#line 21649 "" i__9[1] = 14, a__6[1] = "zchangecontext"; +#line 21649 "" i__9[2] = 1, a__6[2] = all_1.sq; +#line 21649 "" i__9[3] = 10, a__6[3] = "addspace{-"; +#line 21649 "" i__9[4] = 1, a__6[4] = all_1.sq; +#line 21649 "" i__9[5] = 14, a__6[5] = "afterruleskip}"; +#line 21649 "" i__9[6] = 1, a__6[6] = all_1.sq; +#line 21649 "" i__9[7] = 10, a__6[7] = "zstoppiece"; +#line 21649 "" i__9[8] = 1, a__6[8] = all_1.sq; +#line 21649 "" i__9[9] = 13, a__6[9] = "PMXbarnotrue%"; +#line 21649 "" s_cat(ch__26, a__6, i__9, &c__10, (ftnlen)66); +#line 21649 "" do_fio(&c__1, ch__26, (ftnlen)66); +#line 21649 "" e_wsfe(); +#line 21649 "" } +#line 21652 "" } else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) { /* Meter change but no signature change */ +#line 21656 "" if (comlast_1.islast) { - s_wsfe(&io___1404); +#line 21656 "" + s_wsfe(&io___1449); /* Writing concatenation */ +#line 21656 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 21656 "" i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 21656 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 21656 "" i__3[3] = 10, a__1[3] = "addspace{-"; +#line 21656 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 21656 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 21656 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 21656 "" i__3[7] = 3, a__1[7] = "let"; +#line 21656 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 21656 "" i__3[9] = 4, a__1[9] = "bnat"; +#line 21656 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 21656 "" i__3[11] = 9, a__1[11] = "barnoadd%"; +#line 21656 "" s_cat(ch__27, a__1, i__3, &c__12, (ftnlen)60); +#line 21656 "" do_fio(&c__1, ch__27, (ftnlen)60); +#line 21656 "" e_wsfe(); +#line 21656 "" } +#line 21660 "" if (comlast_1.islast) { - s_wsfe(&io___1405); +#line 21660 "" + s_wsfe(&io___1450); /* Writing concatenation */ +#line 21660 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 21660 "" i__3[1] = 3, a__1[1] = "def"; +#line 21660 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 21660 "" i__3[3] = 9, a__1[3] = "barnoadd{"; +#line 21660 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 21660 "" i__3[5] = 3, a__1[5] = "let"; +#line 21660 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 21660 "" i__3[7] = 8, a__1[7] = "barnoadd"; +#line 21660 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 21660 "" i__3[9] = 5, a__1[9] = "bnat}"; +#line 21660 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 21660 "" i__3[11] = 11, a__1[11] = "zstoppiece%"; +#line 21660 "" s_cat(ch__28, a__1, i__3, &c__12, (ftnlen)45); +#line 21660 "" do_fio(&c__1, ch__28, (ftnlen)45); +#line 21660 "" e_wsfe(); +#line 21660 "" } +#line 21663 "" } else { +#line 21664 "" if (comlast_1.islast) { - s_wsfe(&io___1406); +#line 21664 "" + s_wsfe(&io___1451); /* Writing concatenation */ +#line 21664 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21664 "" i__6[1] = 10, a__4[1] = "stoppiece%"; +#line 21664 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21664 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21664 "" e_wsfe(); +#line 21664 "" } +#line 21665 "" } /* This is the key spot when vshrink is used. Value of vshrink here comes from */ @@ -32296,310 +51985,665 @@ L51: /* second pass, vshrink at top of page one is dealt with in topfile, which is called */ /* *before* any reading in any "Av" at the top of the first input block. */ +#line 21678 "" if (! vshrink) { +#line 21679 "" + if (comlast_1.islast && combottop_1.bottopgap) { +#line 21680 "" + if (dabs(combottop_1.botamt) > 1e-6f) { +#line 21681 "" + if (combottop_1.botamt > 9.95f) { +#line 21682 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21683 "" + } else if (combottop_1.botamt > 0.f) { +#line 21684 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21685 "" + } else if (combottop_1.botamt > -9.95f) { +#line 21686 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21687 "" + } else { +#line 21688 "" + s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21689 "" + } +#line 21690 "" + s_wsfe(&io___1452); +/* Writing concatenation */ +#line 21690 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 21690 "" + i__5[1] = 4, a__3[1] = "null"; +#line 21690 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 21690 "" + i__5[3] = 5, a__3[3] = "vskip"; +#line 21690 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 21690 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 21690 "" + do_fio(&c__1, (char *)&combottop_1.botamt, ( + ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 21690 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21690 "" + i__6[1] = 10, a__4[1] = "Internote%"; +#line 21690 "" + s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11); +#line 21690 "" + do_fio(&c__1, ch__29, (ftnlen)11); +#line 21690 "" + e_wsfe(); +#line 21692 "" + } +#line 21693 "" + } +#line 21694 "" xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop; +#line 21695 "" if (xnstbot < 9.95f) { +#line 21696 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10) ; +#line 21697 "" } else { +#line 21698 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10) ; +#line 21699 "" } +#line 21700 "" if (comlast_1.islast) { - s_wsfe(&io___1408); +#line 21700 "" + s_wsfe(&io___1454); /* Writing concatenation */ +#line 21700 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21700 "" i__6[1] = 5, a__4[1] = "vskip"; - s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6); - do_fio(&c__1, ch__29, (ftnlen)6); +#line 21700 "" + s_cat(ch__30, a__4, i__6, &c__2, (ftnlen)6); +#line 21700 "" + do_fio(&c__1, ch__30, (ftnlen)6); +#line 21700 "" do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof( real)); /* Writing concatenation */ +#line 21700 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21700 "" i__5[1] = 10, a__3[1] = "Interligne"; +#line 21700 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21700 "" i__5[3] = 6, a__3[3] = "eject%"; +#line 21700 "" s_cat(ch__24, a__3, i__5, &c__4, (ftnlen)18); +#line 21700 "" do_fio(&c__1, ch__24, (ftnlen)18); +#line 21700 "" e_wsfe(); +#line 21700 "" + } +#line 21702 "" + if (comlast_1.islast && combottop_1.bottopgap) { +#line 21703 "" + if (dabs(combottop_1.topamt) > 1e-6f) { +#line 21704 "" + if (combottop_1.topamt > 9.95f) { +#line 21705 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21706 "" + } else if (combottop_1.topamt > 0.f) { +#line 21707 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21708 "" + } else if (combottop_1.topamt > -9.95f) { +#line 21709 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21710 "" + } else { +#line 21711 "" + s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, ( + ftnlen)10); +#line 21712 "" + } +#line 21713 "" + s_wsfe(&io___1455); +/* Writing concatenation */ +#line 21713 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 21713 "" + i__5[1] = 4, a__3[1] = "null"; +#line 21713 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 21713 "" + i__5[3] = 5, a__3[3] = "vskip"; +#line 21713 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 21713 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 21713 "" + do_fio(&c__1, (char *)&combottop_1.topamt, ( + ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 21713 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21713 "" + i__6[1] = 10, a__4[1] = "Internote%"; +#line 21713 "" + s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11); +#line 21713 "" + do_fio(&c__1, ch__29, (ftnlen)11); +#line 21713 "" + e_wsfe(); +#line 21715 "" + } +#line 21716 "" + combottop_1.bottopgap = FALSE_; +#line 21717 "" } +#line 21718 "" } else { +#line 21719 "" if (comlast_1.islast) { - s_wsfe(&io___1409); +#line 21719 "" + s_wsfe(&io___1456); /* Writing concatenation */ +#line 21719 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21719 "" i__5[1] = 5, a__3[1] = "vfill"; +#line 21719 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21719 "" i__5[3] = 6, a__3[3] = "eject%"; +#line 21719 "" s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)13); +#line 21719 "" do_fio(&c__1, ch__17, (ftnlen)13); +#line 21719 "" e_wsfe(); +#line 21719 "" } +#line 21720 "" } +#line 21721 "" ++comnotes_1.ipage; /* Now that page is ejected, compute new vshrink */ +#line 21725 "" vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f && comlast_1.usevshrink; +#line 21726 "" if (vshrink) { +#line 21727 "" comarp_1.xinsnow = 10.f; +#line 21728 "" } else { +#line 21729 "" comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1]; +#line 21730 "" } +#line 21731 "" if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) { +#line 21732 "" comarp_1.xinsnow = comarp_1.xinsnow * comget_1.fintstf / comget_1.gintstf; +#line 21733 "" comget_1.fintstf = -1.f; +#line 21734 "" } +#line 21735 "" if (comarp_1.xinsnow < 9.95f) { +#line 21736 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 21737 "" } else if (comarp_1.xinsnow < 99.95f) { +#line 21738 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 21739 "" } else { +#line 21740 "" s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10); +#line 21741 "" } /* Vertical spacing parameters, then restart */ +#line 21745 "" + if (comis4bignv_1.is4bignv) { +#line 21745 "" + comarp_1.xinsnow *= .95f; +#line 21745 "" + } +#line 21746 "" if (comlast_1.islast) { - s_wsfe(&io___1410); +#line 21746 "" + s_wsfe(&io___1457); /* Writing concatenation */ +#line 21746 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21746 "" i__6[1] = 11, a__4[1] = "interstaff{"; +#line 21746 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21746 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21746 "" do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen) sizeof(real)); /* Writing concatenation */ +#line 21746 "" i__8[0] = 1, a__5[0] = "}"; +#line 21746 "" i__8[1] = 1, a__5[1] = all_1.sq; +#line 21746 "" i__8[2] = 9, a__5[2] = "contpiece"; +#line 21746 "" s_cat(ch__15, a__5, i__8, &c__3, (ftnlen)11); +#line 21746 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21746 "" e_wsfe(); +#line 21746 "" } /* Check for meter change at start of a new PAGE */ +#line 21751 "" if (all_1.mtrnuml > 0) { /* Meter change at start of a new page */ +#line 21755 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); +#line 21756 "" if (comget_1.movbrk == 0) { +#line 21757 "" if (comlast_1.islast) { +#line 21757 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21757 "" } +#line 21758 "" if (all_1.mtrdnp > 0) { +#line 21759 "" if (comlast_1.islast) { - s_wsfe(&io___1411); +#line 21759 "" + s_wsfe(&io___1458); /* Writing concatenation */ +#line 21759 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21759 "" i__6[1] = 10, a__4[1] = "newtimes2%"; +#line 21759 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen) 11); +#line 21759 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21759 "" e_wsfe(); +#line 21759 "" } +#line 21760 "" if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21760 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21760 "" } +#line 21761 "" } +#line 21762 "" } +#line 21763 "" } /* If no real titles here, which there probably will never be, make vertical */ /* space at page top with \titles{...}. headlog=.false.<=>no real titles */ +#line 21768 "" puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], & etatop, all_1.sq, &etait, &etatc, &etacs1, & all_1.nv, &vshrink, all_1.sepsymq, (ftnlen)1, ( ftnlen)1); +#line 21770 "" if (comnotes_1.headerspecial) { - s_wsfe(&io___1412); +#line 21770 "" + s_wsfe(&io___1459); /* Writing concatenation */ +#line 21770 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 21770 "" i__6[0] = 1, a__4[0] = ch__1; +#line 21770 "" i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%" ; +#line 21770 "" s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); +#line 21770 "" do_fio(&c__1, ch__7, (ftnlen)29); +#line 21770 "" e_wsfe(); +#line 21770 "" } /* Write special header for first page */ +#line 21775 "" } else { /* First bar of system, not a new page, force line break */ +#line 21779 "" if (bit_test(iplnow,28)) { /* Signature change */ /* Writing concatenation */ +#line 21783 "" i__14[0] = 1, a__10[0] = all_1.sq; +#line 21783 "" i__14[1] = 4, a__10[1] = "xbar"; +#line 21783 "" i__14[2] = 1, a__10[2] = all_1.sq; +#line 21783 "" i__14[3] = 10, a__10[3] = "addspace{-"; +#line 21783 "" i__14[4] = 1, a__10[4] = all_1.sq; +#line 21783 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 21783 "" i__14[6] = 1, a__10[6] = all_1.sq; +#line 21783 "" i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 21783 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 21785 "" lnote = 49; +#line 21786 "" if (comtop_1.isig < 0) { /* Writing concatenation */ +#line 21787 "" i__6[0] = 49, a__4[0] = notexq; +#line 21787 "" i__6[1] = 1, a__4[1] = "-"; +#line 21787 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21788 "" lnote = 50; +#line 21789 "" } +#line 21790 "" if (comlast_1.islast) { - s_wsfe(&io___1413); +#line 21790 "" + s_wsfe(&io___1460); /* Writing concatenation */ +#line 21790 "" i__8[0] = lnote, a__5[0] = notexq; +#line 21790 "" i__7 = abs(comtop_1.isig) + 48; +#line 21790 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 21790 "" i__8[1] = 1, a__5[1] = ch__1; +#line 21790 "" i__8[2] = 2, a__5[2] = "}%"; +#line 21790 "" s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 21790 "" do_fio(&c__1, ch__25, lnote + 3); +#line 21790 "" e_wsfe(); +#line 21790 "" } +#line 21792 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 21793 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); +#line 21795 "" } +#line 21796 "" if (comlast_1.islast) { - s_wsfe(&io___1414); +#line 21796 "" + s_wsfe(&io___1461); /* Writing concatenation */ +#line 21796 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21796 "" i__5[1] = 7, a__3[1] = "advance"; +#line 21796 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21796 "" i__5[3] = 8, a__3[3] = "barno-1%"; +#line 21796 "" s_cat(ch__13, a__3, i__5, &c__4, (ftnlen)17); +#line 21796 "" do_fio(&c__1, ch__13, (ftnlen)17); +#line 21796 "" e_wsfe(); +#line 21796 "" } +#line 21797 "" if (all_1.mtrnuml != 0) { /* Meter+sig change, new line, may need mods if movement break here. */ +#line 21801 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); +#line 21802 "" if (comlast_1.islast) { +#line 21803 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21804 "" if (comignorenats_1.ignorenats) { - s_wsfe(&io___1415); +#line 21804 "" + s_wsfe(&io___1462); /* Writing concatenation */ +#line 21804 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21804 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21804 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); +#line 21804 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21804 "" e_wsfe(); +#line 21804 "" } - s_wsfe(&io___1416); +#line 21805 "" + s_wsfe(&io___1463); /* Writing concatenation */ +#line 21805 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 21805 "" i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 21805 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 21805 "" i__3[3] = 10, a__1[3] = "addspace{-"; +#line 21805 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 21805 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 21805 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 21805 "" i__3[7] = 10, a__1[7] = "zstoppiece"; +#line 21805 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 21805 "" i__3[9] = 12, a__1[9] = "PMXbarnotrue"; +#line 21805 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 21805 "" i__3[11] = 10, a__1[11] = "contpiece%"; - s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76); - do_fio(&c__1, ch__30, (ftnlen)76); +#line 21805 "" + s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)76); +#line 21805 "" + do_fio(&c__1, ch__31, (ftnlen)76); +#line 21805 "" e_wsfe(); /* * 'addspace{-'//sq//'afterruleskip}'//sq//'def' */ /* * //sq//'writezbarno{}'//sq//'zalaligne%' */ - s_wsfe(&io___1417); +#line 21810 "" + s_wsfe(&io___1464); /* Writing concatenation */ +#line 21810 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21810 "" i__5[1] = 10, a__3[1] = "addspace{-"; +#line 21810 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21810 "" i__5[3] = 15, a__3[3] = "afterruleskip}%"; +#line 21810 "" s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); +#line 21810 "" do_fio(&c__1, ch__5, (ftnlen)27); +#line 21810 "" e_wsfe(); +#line 21812 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21813 "" if (comignorenats_1.ignorenats) { - s_wsfe(&io___1418); +#line 21813 "" + s_wsfe(&io___1465); /* Writing concatenation */ +#line 21813 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21813 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21813 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); +#line 21813 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21813 "" e_wsfe(); +#line 21813 "" } - s_wsfe(&io___1419); +#line 21814 "" + s_wsfe(&io___1466); /* Writing concatenation */ +#line 21814 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21814 "" i__6[1] = 14, a__4[1] = "zchangecontext"; +#line 21814 "" s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); +#line 21814 "" do_fio(&c__1, ch__16, (ftnlen)15); +#line 21814 "" e_wsfe(); +#line 21815 "" } +#line 21816 "" } else { +#line 21817 "" if (comlast_1.islast && comignorenats_1.ignorenats) { - s_wsfe(&io___1420); +#line 21817 "" + s_wsfe(&io___1467); /* Writing concatenation */ +#line 21817 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21817 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21817 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21817 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21817 "" e_wsfe(); +#line 21817 "" } +#line 21819 "" if (comlast_1.islast) { - s_wsfe(&io___1421); +#line 21819 "" + s_wsfe(&io___1468); /* Writing concatenation */ +#line 21819 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 21819 "" i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 21819 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 21819 "" i__3[3] = 10, a__1[3] = "addspace{-"; +#line 21819 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 21819 "" i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 21819 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 21819 "" i__3[7] = 10, a__1[7] = "zstoppiece"; +#line 21819 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 21819 "" i__3[9] = 12, a__1[9] = "PMXbarnotrue"; +#line 21819 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 21819 "" i__3[11] = 10, a__1[11] = "contpiece%"; - s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76); - do_fio(&c__1, ch__30, (ftnlen)76); +#line 21819 "" + s_cat(ch__31, a__1, i__3, &c__12, (ftnlen)76); +#line 21819 "" + do_fio(&c__1, ch__31, (ftnlen)76); +#line 21819 "" e_wsfe(); +#line 21819 "" } /* * 'addspace{-'//sq//'afterruleskip}'//sq//'def'// */ /* * sq//'writezbarno{}'//sq//'zalaligne%' */ +#line 21824 "" } +#line 21825 "" } else if (all_1.mtrnuml == 0) { /* No meter change */ +#line 21829 "" if (comlast_1.islast) { - s_wsfe(&io___1422); +#line 21829 "" + s_wsfe(&io___1469); /* Writing concatenation */ +#line 21829 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21829 "" i__6[1] = 8, a__4[1] = "alaligne"; +#line 21829 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21829 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21829 "" e_wsfe(); +#line 21829 "" } +#line 21830 "" } else { /* New meter, no new sig, end of line, not new page. */ @@ -32609,356 +52653,620 @@ L51: /* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */ /* \zchangecontext */ +#line 21839 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); +#line 21840 "" if (comget_1.movbrk == 0) { +#line 21841 "" if (comlast_1.islast) { +#line 21841 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21841 "" } +#line 21842 "" if (all_1.mtrdnp > 0) { +#line 21843 "" if (comlast_1.islast) { - s_wsfe(&io___1423); +#line 21844 "" + s_wsfe(&io___1470); /* Writing concatenation */ +#line 21844 "" i__3[0] = 1, a__1[0] = all_1.sq; +#line 21844 "" i__3[1] = 3, a__1[1] = "let"; +#line 21844 "" i__3[2] = 1, a__1[2] = all_1.sq; +#line 21844 "" i__3[3] = 4, a__1[3] = "bnat"; +#line 21844 "" i__3[4] = 1, a__1[4] = all_1.sq; +#line 21844 "" i__3[5] = 8, a__1[5] = "barnoadd"; +#line 21844 "" i__3[6] = 1, a__1[6] = all_1.sq; +#line 21844 "" i__3[7] = 3, a__1[7] = "def"; +#line 21844 "" i__3[8] = 1, a__1[8] = all_1.sq; +#line 21844 "" i__3[9] = 9, a__1[9] = "barnoadd{"; +#line 21844 "" i__3[10] = 1, a__1[10] = all_1.sq; +#line 21844 "" i__3[11] = 7, a__1[11] = "empty}%"; - s_cat(ch__31, a__1, i__3, &c__12, (ftnlen) +#line 21844 "" + s_cat(ch__32, a__1, i__3, &c__12, (ftnlen) 40); - do_fio(&c__1, ch__31, (ftnlen)40); +#line 21844 "" + do_fio(&c__1, ch__32, (ftnlen)40); +#line 21844 "" e_wsfe(); - s_wsfe(&io___1424); +#line 21847 "" + s_wsfe(&io___1471); /* Writing concatenation */ +#line 21847 "" i__15[0] = 1, a__11[0] = all_1.sq; +#line 21847 "" i__15[1] = 14, a__11[1] = "xchangecontext" ; +#line 21847 "" i__15[2] = 1, a__11[2] = all_1.sq; +#line 21847 "" i__15[3] = 10, a__11[3] = "addspace{-"; +#line 21847 "" i__15[4] = 1, a__11[4] = all_1.sq; +#line 21847 "" i__15[5] = 14, a__11[5] = "afterruleskip}" ; +#line 21847 "" i__15[6] = 1, a__11[6] = all_1.sq; +#line 21847 "" i__15[7] = 9, a__11[7] = "zalaligne"; +#line 21847 "" i__15[8] = 1, a__11[8] = all_1.sq; +#line 21847 "" i__15[9] = 3, a__11[9] = "let"; +#line 21847 "" i__15[10] = 1, a__11[10] = all_1.sq; +#line 21847 "" i__15[11] = 8, a__11[11] = "barnoadd"; +#line 21847 "" i__15[12] = 1, a__11[12] = all_1.sq; +#line 21847 "" i__15[13] = 4, a__11[13] = "bnat"; - s_cat(ch__32, a__11, i__15, &c__14, ( +#line 21847 "" + s_cat(ch__33, a__11, i__15, &c__14, ( ftnlen)69); - do_fio(&c__1, ch__32, (ftnlen)69); +#line 21847 "" + do_fio(&c__1, ch__33, (ftnlen)69); +#line 21847 "" e_wsfe(); +#line 21850 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); - s_wsfe(&io___1425); +#line 21851 "" + s_wsfe(&io___1472); /* Writing concatenation */ +#line 21851 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 21851 "" i__4[1] = 10, a__2[1] = "addspace{-"; +#line 21851 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 21851 "" i__4[3] = 14, a__2[3] = "afterruleskip}"; +#line 21851 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 21851 "" i__4[5] = 14, a__2[5] = "zchangecontext"; - s_cat(ch__33, a__2, i__4, &c__6, (ftnlen) +#line 21851 "" + s_cat(ch__34, a__2, i__4, &c__6, (ftnlen) 41); - do_fio(&c__1, ch__33, (ftnlen)41); +#line 21851 "" + do_fio(&c__1, ch__34, (ftnlen)41); +#line 21851 "" e_wsfe(); +#line 21853 "" } +#line 21854 "" if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21854 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21854 "" } +#line 21855 "" } else { +#line 21856 "" if (comlast_1.islast) { - s_wsfe(&io___1426); +#line 21856 "" + s_wsfe(&io___1473); /* Writing concatenation */ +#line 21856 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21856 "" i__6[1] = 8, a__4[1] = "alaligne"; +#line 21856 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen) 9); +#line 21856 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21856 "" e_wsfe(); +#line 21856 "" } +#line 21857 "" } +#line 21858 "" } else { +#line 21859 "" if (comlast_1.islast) { - s_wsfe(&io___1427); +#line 21859 "" + s_wsfe(&io___1474); /* Writing concatenation */ +#line 21859 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21859 "" i__6[1] = 8, a__4[1] = "alaligne"; +#line 21859 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21859 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 21859 "" e_wsfe(); +#line 21859 "" } +#line 21860 "" } +#line 21861 "" } +#line 21862 "" } /* Modified 090525 to use \bnrs */ +#line 21866 "" if (slint) { +#line 21867 "" slint = FALSE_; +#line 21868 "" if (comlast_1.islast) { - s_wsfe(&io___1428); +#line 21868 "" + s_wsfe(&io___1475); /* Writing concatenation */ +#line 21868 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 21868 "" i__5[1] = 3, a__3[1] = "def"; +#line 21868 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 21868 "" i__5[3] = 11, a__3[3] = "raisebarno{"; +#line 21868 "" s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); +#line 21868 "" do_fio(&c__1, ch__22, (ftnlen)16); +#line 21868 "" do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen) sizeof(integer)); /* Writing concatenation */ +#line 21868 "" i__8[0] = 2, a__5[0] = ".5"; +#line 21868 "" i__8[1] = 1, a__5[1] = all_1.sq; +#line 21868 "" i__8[2] = 11, a__5[2] = "internote}%"; +#line 21868 "" s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); +#line 21868 "" do_fio(&c__1, ch__10, (ftnlen)14); +#line 21868 "" e_wsfe(); +#line 21868 "" } +#line 21870 "" } +#line 21871 "" comget_1.movbrk = 0; +#line 21872 "" } /* Clean up if we squelched bar number reset at movement break */ +#line 21876 "" if (comnotes_1.nobar1) { +#line 21877 "" if (comlast_1.islast) { - s_wsfe(&io___1429); +#line 21877 "" + s_wsfe(&io___1476); /* Writing concatenation */ +#line 21877 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21877 "" i__6[1] = 11, a__4[1] = "startbarno1"; +#line 21877 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21877 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21877 "" e_wsfe(); +#line 21877 "" } +#line 21878 "" comnotes_1.nobar1 = FALSE_; +#line 21879 "" } - i__7 = s_rsle(&io___1430); +#line 21880 "" + i__7 = s_rsle(&io___1477); +#line 21880 "" if (i__7 != 0) { +#line 21880 "" goto L14; +#line 21880 "" } +#line 21880 "" i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof( integer)); +#line 21880 "" if (i__7 != 0) { +#line 21880 "" goto L14; +#line 21880 "" } +#line 21880 "" i__7 = e_rsle(); +#line 21880 "" if (i__7 != 0) { +#line 21880 "" goto L14; +#line 21880 "" } +#line 21881 "" L14: /* We come thru here for the 1st bar of every system, so initialize is1n1 */ +#line 21885 "" comsln_1.is1n1 = 0; /* Brought down from above */ +#line 21889 "" if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) { +#line 21889 "" isystpg = 0; +#line 21889 "" } /* Check for linebreak ties */ +#line 21893 "" if (ispstie) { +#line 21893 "" linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( ftnlen)1); +#line 21893 "" } +#line 21896 "" } else { /* Not first bar of system */ +#line 21900 "" if (bit_test(iplnow,28)) { /* Signature change */ +#line 21904 "" if (all_1.mtrnuml != 0) { /* Meter+signature change mid line, assume no movement break */ +#line 21908 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & combeam_1.ibmtyp, &ibmrep); +#line 21909 "" if (comlast_1.islast) { +#line 21909 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21909 "" } /* Writing concatenation */ +#line 21910 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21910 "" i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 21910 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21911 "" lnote = 18; +#line 21912 "" if (comtop_1.isig < 0) { /* Writing concatenation */ +#line 21913 "" i__6[0] = 18, a__4[0] = notexq; +#line 21913 "" i__6[1] = 1, a__4[1] = "-"; +#line 21913 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21914 "" lnote = 19; +#line 21915 "" } +#line 21916 "" if (comlast_1.islast) { +#line 21917 "" iptemp = abs(comtop_1.isig) + 48; +#line 21918 "" chax_(ch__1, (ftnlen)1, &iptemp); +#line 21918 "" *(unsigned char *)charq = *(unsigned char *)&ch__1[0]; /* Writing concatenation */ +#line 21919 "" i__8[0] = lnote, a__5[0] = notexq; +#line 21919 "" i__8[1] = 1, a__5[1] = charq; +#line 21919 "" i__8[2] = 2, a__5[2] = "}%"; +#line 21919 "" s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79); +#line 21920 "" lnote += 3; - s_wsfe(&io___1433); +#line 21921 "" + s_wsfe(&io___1480); +#line 21921 "" do_fio(&c__1, notexq, lnote); +#line 21921 "" e_wsfe(); +#line 21922 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 21923 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); +#line 21925 "" } +#line 21926 "" if (comignorenats_1.ignorenats) { - s_wsfe(&io___1434); +#line 21926 "" + s_wsfe(&io___1481); /* Writing concatenation */ +#line 21926 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21926 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21926 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21926 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21926 "" e_wsfe(); +#line 21926 "" } - s_wsfe(&io___1435); +#line 21927 "" + s_wsfe(&io___1482); /* Writing concatenation */ +#line 21927 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21927 "" i__6[1] = 15, a__4[1] = "xchangecontext%"; +#line 21927 "" s_cat(ch__22, a__4, i__6, &c__2, (ftnlen)16); +#line 21927 "" do_fio(&c__1, ch__22, (ftnlen)16); +#line 21927 "" e_wsfe(); +#line 21928 "" } +#line 21929 "" if (all_1.ibar == comgrace_1.ibarmbr) { /* Compute space for multibar rest */ +#line 21933 "" if (comtop_1.lastisig * comtop_1.isig >= 0) { /* Computing MAX */ +#line 21934 "" i__7 = abs(comtop_1.lastisig), i__2 = abs( comtop_1.isig); +#line 21934 "" naccs = max(i__7,i__2); +#line 21935 "" } else { +#line 21936 "" naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, abs(i__7)); +#line 21937 "" } /* xb4mbr = (facmtr+naccs*.24)*musicsize */ +#line 21939 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21940 "" } +#line 21941 "" } else { /* Signature change only */ /* Writing concatenation */ +#line 21945 "" i__14[0] = 1, a__10[0] = all_1.sq; +#line 21945 "" i__14[1] = 4, a__10[1] = "xbar"; +#line 21945 "" i__14[2] = 1, a__10[2] = all_1.sq; +#line 21945 "" i__14[3] = 10, a__10[3] = "addspace{-"; +#line 21945 "" i__14[4] = 1, a__10[4] = all_1.sq; +#line 21945 "" i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 21945 "" i__14[6] = 1, a__10[6] = all_1.sq; +#line 21945 "" i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 21945 "" s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 21947 "" lnote = 49; +#line 21948 "" if (comtop_1.isig < 0) { /* Writing concatenation */ +#line 21949 "" i__6[0] = 49, a__4[0] = notexq; +#line 21949 "" i__6[1] = 1, a__4[1] = "-"; +#line 21949 "" s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 21950 "" lnote = 50; +#line 21951 "" } +#line 21952 "" if (comlast_1.islast) { - s_wsfe(&io___1437); +#line 21952 "" + s_wsfe(&io___1484); /* Writing concatenation */ +#line 21952 "" i__8[0] = lnote, a__5[0] = notexq; +#line 21952 "" i__7 = abs(comtop_1.isig) + 48; +#line 21952 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 21952 "" i__8[1] = 1, a__5[1] = ch__1; +#line 21952 "" i__8[2] = 2, a__5[2] = "}%"; +#line 21952 "" s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 21952 "" do_fio(&c__1, ch__25, lnote + 3); +#line 21952 "" e_wsfe(); +#line 21952 "" } +#line 21954 "" if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 21955 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, & cominsttrans_1.laterinsttrans); +#line 21957 "" } +#line 21958 "" if (comlast_1.islast && comignorenats_1.ignorenats) { - s_wsfe(&io___1438); +#line 21958 "" + s_wsfe(&io___1485); /* Writing concatenation */ +#line 21958 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21958 "" i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 21958 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21958 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 21958 "" e_wsfe(); +#line 21958 "" } +#line 21960 "" if (comlast_1.islast) { - s_wsfe(&io___1439); +#line 21960 "" + s_wsfe(&io___1486); /* Writing concatenation */ +#line 21960 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 21960 "" i__4[1] = 14, a__2[1] = "zchangecontext"; +#line 21960 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 21960 "" i__4[3] = 12, a__2[3] = "addspace{-.5"; +#line 21960 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 21960 "" i__4[5] = 15, a__2[5] = "afterruleskip}%"; - s_cat(ch__34, a__2, i__4, &c__6, (ftnlen)44); - do_fio(&c__1, ch__34, (ftnlen)44); +#line 21960 "" + s_cat(ch__35, a__2, i__4, &c__6, (ftnlen)44); +#line 21960 "" + do_fio(&c__1, ch__35, (ftnlen)44); +#line 21960 "" e_wsfe(); +#line 21960 "" } +#line 21962 "" if (all_1.ibar == comgrace_1.ibarmbr) { /* Compute space for multibar rest */ +#line 21966 "" if (comtop_1.lastisig * comtop_1.isig >= 0) { /* Computing MAX */ +#line 21967 "" i__7 = abs(comtop_1.lastisig), i__2 = abs( comtop_1.isig); +#line 21967 "" naccs = max(i__7,i__2); +#line 21968 "" } else { +#line 21969 "" naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, abs(i__7)); +#line 21970 "" } /* xb4mbr = naccs*.24*musicsize */ +#line 21972 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21973 "" } +#line 21974 "" } +#line 21975 "" } else if (all_1.mtrnuml == 0) { /* No meter change */ +#line 21979 "" if (comlast_1.islast) { - s_wsfe(&io___1440); +#line 21979 "" + s_wsfe(&io___1487); /* Writing concatenation */ +#line 21979 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21979 "" i__6[1] = 4, a__4[1] = "xbar"; - s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5); - do_fio(&c__1, ch__35, (ftnlen)5); +#line 21979 "" + s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)5); +#line 21979 "" + do_fio(&c__1, ch__36, (ftnlen)5); +#line 21979 "" e_wsfe(); +#line 21979 "" } +#line 21980 "" } else { /* Change meter midline */ +#line 21984 "" setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, & ibmrep); +#line 21985 "" if (comget_1.movbrk == 0) { +#line 21986 "" if (comlast_1.islast) { +#line 21986 "" wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21986 "" } +#line 21987 "" if (all_1.mtrdnp > 0) { +#line 21988 "" if (comlast_1.islast) { /* if (mbrest .gt. 0) then */ /* c write(11,'(a)')sq//'addspace{-2'//sq// */ @@ -32966,670 +53274,1225 @@ L14: /* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq// */ /* * 'advance'//sq//'barno-1%' */ /* end if */ - s_wsfe(&io___1441); +#line 21995 "" + s_wsfe(&io___1488); /* Writing concatenation */ +#line 21995 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 21995 "" i__6[1] = 10, a__4[1] = "newtimes0%"; +#line 21995 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21995 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 21995 "" e_wsfe(); +#line 21996 "" } /* if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize */ +#line 21998 "" if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21998 "" comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21998 "" } +#line 21999 "" } else { +#line 22000 "" if (comlast_1.islast) { - s_wsfe(&io___1442); +#line 22000 "" + s_wsfe(&io___1489); /* Writing concatenation */ +#line 22000 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22000 "" i__6[1] = 4, a__4[1] = "xbar"; - s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5); - do_fio(&c__1, ch__35, (ftnlen)5); +#line 22000 "" + s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)5); +#line 22000 "" + do_fio(&c__1, ch__36, (ftnlen)5); +#line 22000 "" e_wsfe(); +#line 22000 "" } +#line 22001 "" } +#line 22002 "" } +#line 22003 "" } +#line 22004 "" } /* Now that xbar's are written, can put in left-repeats at line beginnings */ +#line 22008 "" if (lrptpend) { +#line 22009 "" if (comlast_1.islast) { - s_wsfe(&io___1443); +#line 22009 "" + s_wsfe(&io___1490); /* Writing concatenation */ +#line 22009 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 22009 "" i__4[1] = 7, a__2[1] = "advance"; +#line 22009 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 22009 "" i__4[3] = 7, a__2[3] = "barno-1"; +#line 22009 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 22009 "" i__4[5] = 10, a__2[5] = "leftrepeat"; +#line 22009 "" s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); +#line 22009 "" do_fio(&c__1, ch__5, (ftnlen)27); +#line 22009 "" e_wsfe(); +#line 22009 "" } +#line 22011 "" lrptpend = FALSE_; +#line 22012 "" } +#line 22013 "" if (all_1.ibar > 1) { /* For bars after first, slide all stuff down to beginning of arrays */ +#line 22017 "" i__7 = all_1.nv; +#line 22017 "" for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 22018 "" i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 22018 "" for (kv = 1; kv <= i__2; ++kv) { +#line 22019 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 22020 "" ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22021 "" i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] - ioff; +#line 22021 "" for (ip = 1; ip <= i__13; ++ip) { +#line 22022 "" all_1.nolev[commvl_1.ivx + ip * 24 - 25] = all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22023 "" all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22024 "" all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[ commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22025 "" all_1.irest[commvl_1.ivx + ip * 24 - 25] = all_1.irest[commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22026 "" all_1.islur[commvl_1.ivx + ip * 24 - 25] = all_1.islur[commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22027 "" all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[ commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 22028 "" all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[ commvl_1.ivx + (ip + ioff) * 24 - 1]; +#line 22029 "" all_1.mult[commvl_1.ivx + ip * 24 - 25] = all_1.mult[ commvl_1.ivx + (ip + ioff) * 24 - 25]; -/* if (ivx.le.2 .and. figbass) */ -/* * isfig(ivx,ip) = isfig(ivx,ip+ioff) */ +#line 22030 "" if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx == comfig_1.ivxfig2) { +#line 22031 "" if (commvl_1.ivx == 1) { +#line 22032 "" all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip + ioff << 1) - 2]; +#line 22033 "" } else { +#line 22034 "" all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip + ioff << 1) - 1]; +#line 22035 "" } +#line 22036 "" } +#line 22037 "" /* L12: */ +#line 22037 "" } +#line 22038 "" if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1] > 1) { +#line 22039 "" islide = 0; +#line 22040 "" i__13 = comcc_1.ncc[all_1.iv - 1]; +#line 22040 "" for (icc = 1; icc <= i__13; ++icc) { +#line 22041 "" if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= ( real) all_1.lenbar) { /* This time will drop <=0 when slid. */ +#line 22045 "" islide = icc - 1; +#line 22046 "" comcc_1.ncmidcc[all_1.iv - 1] = comcc_1.ncmidcc[all_1.iv + icc * 24 - 25]; +#line 22047 "" } else { +#line 22048 "" comcc_1.tcc[all_1.iv + (icc - islide) * 24 - 25] = comcc_1.tcc[all_1.iv + icc * 24 - 25] - all_1.lenbar; +#line 22049 "" comcc_1.ncmidcc[all_1.iv + (icc - islide) * 24 - 25] = comcc_1.ncmidcc[all_1.iv + icc * 24 - 25]; +#line 22050 "" } +#line 22051 "" /* L13: */ +#line 22051 "" } +#line 22052 "" comcc_1.ncc[all_1.iv - 1] -= islide; +#line 22053 "" comcc_1.tcc[all_1.iv - 1] = 0.f; +#line 22054 "" } +#line 22055 "" /* L11: */ +#line 22055 "" } +#line 22055 "" } +#line 22056 "" i__2 = comgrace_1.ngrace; +#line 22056 "" for (ig = 1; ig <= i__2; ++ig) { +#line 22057 "" comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + ( all_1.ibar - 1) * 24 - 25]; +#line 22058 "" if (all_1.ibar > 2) { +#line 22058 "" comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1] + (all_1.ibar - 2) * 24 - 25]; +#line 22058 "" } +#line 22059 "" /* L15: */ +#line 22059 "" } +#line 22060 "" i__2 = comgrace_1.nlit; +#line 22060 "" for (il = 1; il <= i__2; ++il) { +#line 22061 "" comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1] + (all_1.ibar - 1) * 24 - 25]; +#line 22062 "" if (all_1.ibar > 2) { +#line 22062 "" comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il - 1] + (all_1.ibar - 2) * 24 - 25]; +#line 22062 "" } +#line 22063 "" /* L21: */ +#line 22063 "" } +#line 22064 "" i__2 = comtrill_1.ntrill; +#line 22064 "" for (it = 1; it <= i__2; ++it) { +#line 22065 "" comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it - 1] + (all_1.ibar - 1) * 24 - 25]; +#line 22066 "" if (all_1.ibar > 2) { +#line 22066 "" comtrill_1.iptrill[it - 1] += all_1.nib[ comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) * 24 - 25]; +#line 22066 "" } +#line 22068 "" /* L22: */ +#line 22068 "" } +#line 22069 "" i__2 = comtrill_1.ncrd; +#line 22069 "" for (icrd = 1; icrd <= i__2; ++icrd) { -/* ivx = iand(15,ishft(icrdat(icrd),-8)) */ +#line 22070 "" commvl_1.ivx = (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], ( ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__28) << 4); +#line 22072 "" ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22073 "" if (all_1.ibar > 2) { +#line 22073 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22073 "" } +#line 22074 "" comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd - 1]; +#line 22075 "" comtrill_1.icrdat[icrd - 1] = max(0,ipnew) | comtrill_1.icrdat[icrd - 1]; +#line 22076 "" /* L27: */ +#line 22076 "" } +#line 22077 "" i__2 = comtrill_1.nudorn; +#line 22077 "" for (iudorn = 1; iudorn <= i__2; ++iudorn) { -/* ivx = iand(15,ishft(kudorn(iudorn),-8)) */ +#line 22078 "" commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1]; +#line 22079 "" ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22080 "" if (all_1.ibar > 2) { +#line 22080 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22080 "" } +#line 22081 "" comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[ iudorn - 1]; +#line 22082 "" comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) | comtrill_1.kudorn[iudorn - 1]; +#line 22083 "" /* L29: */ +#line 22083 "" } +#line 22084 "" i__2 = comdyn_1.ndyn; +#line 22084 "" for (idyn = 1; idyn <= i__2; ++idyn) { +#line 22085 "" idynd = comdyn_1.idyndat[idyn - 1]; -/* ivx = iand(15,idynd) */ +#line 22086 "" commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[ idyn - 1], &c__1, &c__10) << 4); +#line 22087 "" ipnew = igetbits_(&idynd, &c__8, &c__4) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; /* The following construction avoids array bound errors in some compilers */ +#line 22091 "" if (all_1.ibar > 2) { +#line 22092 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22093 "" } +#line 22094 "" ipnew = i_dim(&ipnew, &c__0); +#line 22095 "" setbits_(&idynd, &c__8, &c__4, &ipnew); +#line 22096 "" comdyn_1.idyndat[idyn - 1] = idynd; +#line 22097 "" /* L42: */ +#line 22097 "" } +#line 22098 "" i__2 = comdyn_1.ntxtdyn; +#line 22098 "" for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) { +#line 22099 "" idynd = comdyn_1.ivxiptxt[itxtdyn - 1]; -/* ivx = iand(15,idynd) */ +#line 22100 "" commvl_1.ivx = 31 & idynd; -/* ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) */ +#line 22101 "" ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22102 "" if (all_1.ibar > 2) { +#line 22103 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22104 "" } +#line 22105 "" ipnew = i_dim(&ipnew, &c__0); /* call setbits(idynd,8,4,ipnew) */ +#line 22107 "" setbits_(&idynd, &c__8, &c__5, &ipnew); +#line 22108 "" comdyn_1.ivxiptxt[itxtdyn - 1] = idynd; +#line 22109 "" /* L43: */ +#line 22109 "" } +#line 22110 "" i__2 = all_1.nsdat; +#line 22110 "" for (isdat = 1; isdat <= i__2; ++isdat) { +#line 22111 "" isdata = all_1.isdat1[isdat - 1]; +#line 22112 "" commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13) + (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25]; +#line 22113 "" ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[ commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22114 "" if (all_1.ibar > 2) { +#line 22115 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22116 "" } +#line 22117 "" ipnew = i_dim(&ipnew, &c__0); +#line 22118 "" setbits_(&isdata, &c__8, &c__3, &ipnew); +#line 22119 "" all_1.isdat1[isdat - 1] = isdata; +#line 22120 "" /* L41: */ +#line 22120 "" } +#line 22121 "" i__2 = comcb_1.nbc; +#line 22121 "" for (ibc = 1; ibc <= i__2; ++ibc) { -/* ivx = iand(15,ibcdata(ibc)) */ +#line 22122 "" commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(& comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4); +#line 22123 "" ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) - all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 22124 "" if (all_1.ibar > 2) { +#line 22125 "" ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - 25]; +#line 22126 "" } +#line 22127 "" ipnew = i_dim(&ipnew, &c__0); +#line 22128 "" setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew); +#line 22129 "" /* L44: */ +#line 22129 "" } +#line 22130 "" i__2 = comarpshift_1.numarpshift; +#line 22130 "" for (iarps = 1; iarps <= i__2; ++iarps) { +#line 22131 "" comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[ comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1) * 24 - 25]; +#line 22133 "" if (all_1.ibar > 2) { +#line 22134 "" comarpshift_1.iparpshift[iarps - 1] += all_1.nib[ comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 2) * 24 - 25]; +#line 22136 "" } +#line 22137 "" /* L45: */ +#line 22137 "" } /* Bookkeeping for figures. This will set nfigs = 0 if there are no figs left. */ /* If there are figs left, it will reset all times relative to start of */ /* current bar. */ +#line 22143 "" for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) { +#line 22144 "" if (all_1.figbass) { +#line 22145 "" islide = 0; +#line 22146 "" i__2 = comfig_1.nfigs[commvl_1.ivx - 1]; +#line 22146 "" for (jfig = 1; jfig <= i__2; ++jfig) { +#line 22147 "" if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] < all_1.lenbar) { /* This figure was already used */ +#line 22151 "" islide = jfig; +#line 22152 "" } else { +#line 22153 "" comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.itfig[commvl_1.ivx + ( jfig << 1) - 3] - all_1.lenbar; +#line 22154 "" s_copy(comfig_1.figq + (commvl_1.ivx + (jfig - islide << 1) - 3) * 10, comfig_1.figq + ( commvl_1.ivx + (jfig << 1) - 3) * 10, ( ftnlen)10, (ftnlen)10); +#line 22155 "" comgrace_1.itoff[commvl_1.ivx + (jfig - islide << 1) - 3] = comgrace_1.itoff[commvl_1.ivx + (jfig << 1) - 3]; +#line 22156 "" comfig_1.ivupfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.ivupfig[commvl_1.ivx + (jfig << 1) - 3]; +#line 22157 "" comfig_1.ivvfig[commvl_1.ivx + (jfig - islide << 1) - 3] = comfig_1.ivvfig[commvl_1.ivx + ( jfig << 1) - 3]; +#line 22158 "" } +#line 22159 "" /* L20: */ +#line 22159 "" } +#line 22160 "" comfig_1.nfigs[commvl_1.ivx - 1] -= islide; +#line 22161 "" } +#line 22162 "" if (comfig_1.nfigs[1] == 0) { +#line 22162 "" goto L47; +#line 22162 "" } +#line 22163 "" /* L46: */ +#line 22163 "" } +#line 22164 "" L47: +#line 22165 "" ; +#line 22165 "" } /* End of sliding down for bars after first in gulp. */ /* The following may not be needed by makeabar, but just in case... */ +#line 22171 "" if (all_1.firstgulp && all_1.lenb0 != 0) { +#line 22172 "" if (all_1.ibar == 1) { +#line 22173 "" all_1.lenbar = all_1.lenb0; +#line 22174 "" } else { +#line 22175 "" all_1.lenbar = all_1.lenb1; +#line 22176 "" } +#line 22177 "" } /* Equal line spacing stuff */ +#line 22181 "" if (comget_1.equalize && comask_1.bar1syst) { +#line 22182 "" if (isystpg == 1) { - s_wsfe(&io___1459); +#line 22183 "" + s_wsfe(&io___1506); /* Writing concatenation */ +#line 22183 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22183 "" i__6[1] = 8, a__4[1] = "starteq%"; +#line 22183 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 22183 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 22183 "" e_wsfe(); +#line 22184 "" } else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1) { - s_wsfe(&io___1460); +#line 22185 "" + s_wsfe(&io___1507); /* Writing concatenation */ +#line 22185 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22185 "" i__6[1] = 6, a__4[1] = "endeq%"; - s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)7); - do_fio(&c__1, ch__36, (ftnlen)7); +#line 22185 "" + s_cat(ch__37, a__4, i__6, &c__2, (ftnlen)7); +#line 22185 "" + do_fio(&c__1, ch__37, (ftnlen)7); +#line 22185 "" e_wsfe(); +#line 22186 "" } +#line 22187 "" } +#line 22188 "" make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms, istart); +#line 22190 "" make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop, numbms, istart, comclefq_1.clefq, (ftnlen)1); /* Hardspace before barline? */ +#line 22195 "" hardb4 = 0.f; +#line 22196 "" i__2 = all_1.nv; +#line 22196 "" for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 22197 "" i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 22197 "" for (kv = 1; kv <= i__7; ++kv) { +#line 22198 "" commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 22199 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] * 24 - 25],18)) { +#line 22200 "" ++comudsp_1.nudoff[commvl_1.ivx - 1]; /* Computing MAX */ +#line 22201 "" r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25]; +#line 22201 "" hardb4 = dmax(r__1,r__2); +#line 22202 "" } +#line 22203 "" /* L35: */ +#line 22203 "" } +#line 22203 "" } +#line 22204 "" if (hardb4 > 0.f) { +#line 22205 "" if (comlast_1.islast) { - s_wsfe(&io___1468); +#line 22205 "" + s_wsfe(&io___1515); /* Writing concatenation */ +#line 22205 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22205 "" i__6[1] = 10, a__4[1] = "hardspace{"; +#line 22205 "" s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 22205 "" do_fio(&c__1, ch__15, (ftnlen)11); +#line 22205 "" do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real)); +#line 22205 "" do_fio(&c__1, "pt}%", (ftnlen)4); +#line 22205 "" e_wsfe(); +#line 22205 "" } /* This was causing an incorrect poe in an example, which did not affect main */ /* spacing, but did cause an extra accidental space to be too small */ +#line 22211 "" comask_1.fixednew -= hardb4; +#line 22212 "" } +#line 22213 "" /* L10: */ +#line 22213 "" } +#line 22214 "" all_1.firstgulp = FALSE_; +#line 22215 "" all_1.lenb0 = 0; +#line 22216 "" goto L30; +#line 22217 "" L40: +#line 22217 "" cl__1.cerr = 0; +#line 22217 "" cl__1.cunit = 12; +#line 22217 "" cl__1.csta = 0; +#line 22217 "" f_clos(&cl__1); +#line 22218 "" cl__1.cerr = 0; +#line 22218 "" cl__1.cunit = 13; +#line 22218 "" cl__1.csta = 0; +#line 22218 "" f_clos(&cl__1); +#line 22219 "" inbuff_1.ilbuf = 1; +#line 22220 "" inbuff_1.ipbuf = 0; +#line 22221 "" wdpt = comtop_1.widthpt; +#line 22222 "" if (all_1.iline == 1) { +#line 22222 "" wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); +#line 22222 "" } +#line 22223 "" poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew) / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold); +#line 22225 "" poevec[nsyst] = poe; +#line 22226 "" if (! comlast_1.islast) { +#line 22227 "" cl__1.cerr = 0; +#line 22227 "" cl__1.cunit = 11; +#line 22227 "" cl__1.csta = 0; +#line 22227 "" f_clos(&cl__1); +#line 22228 "" cl__1.cerr = 0; +#line 22228 "" cl__1.cunit = 16; +#line 22228 "" cl__1.csta = 0; +#line 22228 "" f_clos(&cl__1); +#line 22229 "" if (all_1.figbass) { +#line 22229 "" cl__1.cerr = 0; +#line 22229 "" cl__1.cunit = 14; +#line 22229 "" cl__1.csta = 0; +#line 22229 "" f_clos(&cl__1); +#line 22229 "" } +#line 22230 "" return 0; +#line 22231 "" } +#line 22232 "" i__1 = comas2_1.nasksys; +#line 22232 "" for (ia = 1; ia <= i__1; ++ia) { +#line 22233 "" ++comas3_1.iask; +#line 22234 "" comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1] / poe - ( r__1 = comas2_1.elasksys[ia - 1], dabs(r__1)); +#line 22235 "" if (comas2_1.elasksys[ia - 1] > 0.f) { +#line 22235 "" comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ - comas3_1.iask - 1], &c_b774); + comas3_1.iask - 1], &c_b1009); +#line 22235 "" } +#line 22236 "" /* L19: */ +#line 22236 "" } +#line 22237 "" i__1 = nhssys; +#line 22237 "" for (ia = 1; ia <= i__1; ++ia) { +#line 22238 "" ++nhstot; /* Computing MAX */ +#line 22239 "" r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; +#line 22239 "" comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); +#line 22240 "" /* L26: */ +#line 22240 "" } +#line 22241 "" if (comlast_1.islast && onvolt) { - s_wsfe(&io___1469); +#line 22241 "" + s_wsfe(&io___1516); /* Writing concatenation */ +#line 22241 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22241 "" i__6[1] = 11, a__4[1] = "endvoltabox"; +#line 22241 "" s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 22241 "" do_fio(&c__1, ch__14, (ftnlen)12); +#line 22241 "" e_wsfe(); +#line 22241 "" } +#line 22243 "" if (*(unsigned char *)comget_1.rptfq2 != 'E') { /* Terminal repeat. Right or double? */ +#line 22247 "" if (*(unsigned char *)comget_1.rptfq2 == 'r') { +#line 22248 "" if (comlast_1.islast) { - s_wsfe(&io___1470); +#line 22248 "" + s_wsfe(&io___1517); /* Writing concatenation */ +#line 22248 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 22248 "" i__5[1] = 14, a__3[1] = "setrightrepeat"; +#line 22248 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 22248 "" i__5[3] = 8, a__3[3] = "endpiece"; - s_cat(ch__37, a__3, i__5, &c__4, (ftnlen)24); - do_fio(&c__1, ch__37, (ftnlen)24); +#line 22248 "" + s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)24); +#line 22248 "" + do_fio(&c__1, ch__38, (ftnlen)24); +#line 22248 "" e_wsfe(); +#line 22248 "" } +#line 22250 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { +#line 22251 "" if (comlast_1.islast) { - s_wsfe(&io___1471); +#line 22251 "" + s_wsfe(&io___1518); /* Writing concatenation */ +#line 22251 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 22251 "" i__5[1] = 12, a__3[1] = "setdoublebar"; +#line 22251 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 22251 "" i__5[3] = 8, a__3[3] = "endpiece"; - s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22); - do_fio(&c__1, ch__38, (ftnlen)22); +#line 22251 "" + s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)22); +#line 22251 "" + do_fio(&c__1, ch__39, (ftnlen)22); +#line 22251 "" e_wsfe(); +#line 22251 "" } +#line 22252 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { +#line 22253 "" if (comlast_1.islast) { - s_wsfe(&io___1472); +#line 22253 "" + s_wsfe(&io___1519); /* Writing concatenation */ +#line 22253 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22253 "" i__6[1] = 8, a__4[1] = "endpiece"; +#line 22253 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 22253 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 22253 "" e_wsfe(); +#line 22253 "" } +#line 22254 "" } else if (*(unsigned char *)comget_1.rptfq2 == 'z') { +#line 22255 "" if (comlast_1.islast) { - s_wsfe(&io___1473); +#line 22255 "" + s_wsfe(&io___1520); /* Writing concatenation */ +#line 22255 "" i__5[0] = 1, a__3[0] = all_1.sq; +#line 22255 "" i__5[1] = 12, a__3[1] = "setzalaligne"; +#line 22255 "" i__5[2] = 1, a__3[2] = all_1.sq; +#line 22255 "" i__5[3] = 8, a__3[3] = "Endpiece"; - s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22); - do_fio(&c__1, ch__38, (ftnlen)22); +#line 22255 "" + s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)22); +#line 22255 "" + do_fio(&c__1, ch__39, (ftnlen)22); +#line 22255 "" e_wsfe(); +#line 22255 "" } +#line 22256 "" } else { -/* else if (rptfq2 .ne. 'D') then */ - s_wsle(&io___1474); +#line 22257 "" + s_wsle(&io___1521); +#line 22257 "" e_wsle(); - s_wsle(&io___1475); - do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf" +#line 22258 "" + s_wsle(&io___1522); +#line 22258 "" + do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ "q2:", (ftnlen)37); +#line 22258 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 22258 "" e_wsle(); - s_wsle(&io___1476); - do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf" +#line 22259 "" + s_wsle(&io___1523); +#line 22259 "" + do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ "q2:", (ftnlen)37); +#line 22259 "" do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 22259 "" e_wsle(); +#line 22260 "" if (comlast_1.islast) { - s_wsfe(&io___1477); +#line 22260 "" + s_wsfe(&io___1524); /* Writing concatenation */ +#line 22260 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22260 "" i__6[1] = 8, a__4[1] = "Endpiece"; +#line 22260 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 22260 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 22260 "" e_wsfe(); +#line 22260 "" } +#line 22261 "" } +#line 22262 "" } else { +#line 22263 "" if (comlast_1.islast) { - s_wsfe(&io___1478); +#line 22263 "" + s_wsfe(&io___1525); /* Writing concatenation */ +#line 22263 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22263 "" i__6[1] = 8, a__4[1] = "Endpiece"; +#line 22263 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 22263 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 22263 "" e_wsfe(); +#line 22263 "" } +#line 22264 "" } +#line 22265 "" if (! vshrink) { +#line 22266 "" + if (comlast_1.islast && combottop_1.bottopgap) { +#line 22267 "" + if (dabs(combottop_1.botamt) > 1e-6f) { +#line 22268 "" + if (combottop_1.botamt > 9.95f) { +#line 22269 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 22270 "" + } else if (combottop_1.botamt > 0.f) { +#line 22271 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 22272 "" + } else if (combottop_1.botamt > -9.95f) { +#line 22273 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 22274 "" + } else { +#line 22275 "" + s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10); +#line 22276 "" + } +#line 22277 "" + s_wsfe(&io___1526); +/* Writing concatenation */ +#line 22277 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 22277 "" + i__5[1] = 4, a__3[1] = "null"; +#line 22277 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 22277 "" + i__5[3] = 5, a__3[3] = "vskip"; +#line 22277 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 22277 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 22277 "" + do_fio(&c__1, (char *)&combottop_1.botamt, (ftnlen)sizeof( + real)); +/* Writing concatenation */ +#line 22277 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 22277 "" + i__6[1] = 10, a__4[1] = "Internote%"; +#line 22277 "" + s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)11); +#line 22277 "" + do_fio(&c__1, ch__29, (ftnlen)11); +#line 22277 "" + e_wsfe(); +#line 22279 "" + } +#line 22280 "" + } +#line 22281 "" xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop; +#line 22282 "" if (xnstbot < 9.95f) { +#line 22283 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 22284 "" } else { +#line 22285 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 22286 "" } +#line 22287 "" if (comlast_1.islast) { - s_wsfe(&io___1479); +#line 22287 "" + s_wsfe(&io___1527); /* Writing concatenation */ +#line 22287 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22287 "" i__6[1] = 5, a__4[1] = "vskip"; - s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6); - do_fio(&c__1, ch__29, (ftnlen)6); +#line 22287 "" + s_cat(ch__30, a__4, i__6, &c__2, (ftnlen)6); +#line 22287 "" + do_fio(&c__1, ch__30, (ftnlen)6); +#line 22287 "" do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real)); /* Writing concatenation */ +#line 22287 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 22287 "" i__4[1] = 10, a__2[1] = "Interligne"; +#line 22287 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 22287 "" i__4[3] = 5, a__2[3] = "eject"; +#line 22287 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 22287 "" i__4[5] = 9, a__2[5] = "endmuflex"; +#line 22287 "" s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); +#line 22287 "" do_fio(&c__1, ch__5, (ftnlen)27); +#line 22287 "" e_wsfe(); +#line 22287 "" } +#line 22289 "" if (comlast_1.islast) { - s_wsfe(&io___1480); +#line 22289 "" + s_wsfe(&io___1528); /* Writing concatenation */ +#line 22289 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22289 "" i__6[1] = 3, a__4[1] = "bye"; +#line 22289 "" s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); +#line 22289 "" do_fio(&c__1, ch__21, (ftnlen)4); +#line 22289 "" e_wsfe(); +#line 22289 "" } +#line 22290 "" } else { +#line 22291 "" if (comlast_1.islast) { - s_wsfe(&io___1481); +#line 22291 "" + s_wsfe(&io___1529); /* Writing concatenation */ +#line 22291 "" i__4[0] = 1, a__2[0] = all_1.sq; +#line 22291 "" i__4[1] = 5, a__2[1] = "vfill"; +#line 22291 "" i__4[2] = 1, a__2[2] = all_1.sq; +#line 22291 "" i__4[3] = 5, a__2[3] = "eject"; +#line 22291 "" i__4[4] = 1, a__2[4] = all_1.sq; +#line 22291 "" i__4[5] = 9, a__2[5] = "endmuflex"; - s_cat(ch__38, a__2, i__4, &c__6, (ftnlen)22); - do_fio(&c__1, ch__38, (ftnlen)22); +#line 22291 "" + s_cat(ch__39, a__2, i__4, &c__6, (ftnlen)22); +#line 22291 "" + do_fio(&c__1, ch__39, (ftnlen)22); +#line 22291 "" e_wsfe(); +#line 22291 "" } +#line 22293 "" if (comlast_1.islast) { - s_wsfe(&io___1482); +#line 22293 "" + s_wsfe(&io___1530); /* Writing concatenation */ +#line 22293 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22293 "" i__6[1] = 3, a__4[1] = "bye"; +#line 22293 "" s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); +#line 22293 "" do_fio(&c__1, ch__21, (ftnlen)4); +#line 22293 "" e_wsfe(); +#line 22293 "" } +#line 22294 "" } +#line 22295 "" al__1.aerr = 0; +#line 22295 "" al__1.aunit = 11; +#line 22295 "" f_rew(&al__1); +#line 22296 "" if (all_1.figbass) { - s_wsfe(&io___1483); +#line 22297 "" + s_wsfe(&io___1531); /* Writing concatenation */ +#line 22297 "" i__6[0] = 1, a__4[0] = all_1.sq; +#line 22297 "" i__6[1] = 8, a__4[1] = "figdrop="; +#line 22297 "" s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 22297 "" do_fio(&c__1, ch__18, (ftnlen)9); +#line 22297 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen) sizeof(integer)); /* Writing concatenation */ +#line 22297 "" i__8[0] = 1, a__5[0] = " "; +#line 22297 "" i__8[1] = 1, a__5[1] = all_1.sq; +#line 22297 "" i__8[2] = 8, a__5[2] = "figdtwo="; +#line 22297 "" s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); +#line 22297 "" do_fio(&c__1, ch__20, (ftnlen)10); +#line 22297 "" do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen) sizeof(integer)); /* Writing concatenation */ +#line 22297 "" i__11[0] = 1, a__8[0] = all_1.sq; +#line 22297 "" i__11[1] = 4, a__8[1] = "fi}%"; - s_cat(ch__35, a__8, i__11, &c__2, (ftnlen)5); - do_fio(&c__1, ch__35, (ftnlen)5); +#line 22297 "" + s_cat(ch__36, a__8, i__11, &c__2, (ftnlen)5); +#line 22297 "" + do_fio(&c__1, ch__36, (ftnlen)5); +#line 22297 "" e_wsfe(); +#line 22300 "" al__1.aerr = 0; +#line 22300 "" al__1.aunit = 14; +#line 22300 "" f_rew(&al__1); +#line 22301 "" } +#line 22302 "" askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, ( ftnlen)40, (ftnlen)44); +#line 22303 "" if (! (*optimize)) { - s_wsle(&io___1484); +#line 22304 "" + s_wsle(&io___1532); +#line 22304 "" e_wsle(); - s_wsle(&io___1485); +#line 22305 "" + s_wsle(&io___1533); /* Writing concatenation */ +#line 22305 "" i__5[0] = 8, a__3[0] = "Writing "; +#line 22305 "" i__5[1] = lpath, a__3[1] = pathnameq; +#line 22305 "" i__5[2] = lbase, a__3[2] = basenameq; +#line 22305 "" i__5[3] = 4, a__3[3] = ".tex"; - s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96); - do_lio(&c__9, &c__1, ch__39, lpath + 8 + lbase + 4); +#line 22305 "" + s_cat(ch__40, a__3, i__5, &c__4, (ftnlen)96); +#line 22305 "" + do_lio(&c__9, &c__1, ch__40, lpath + 8 + lbase + 4); +#line 22305 "" e_wsle(); - s_wsle(&io___1486); +#line 22307 "" + s_wsle(&io___1534); +#line 22307 "" do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26); +#line 22307 "" e_wsle(); - s_wsfe(&io___1487); +#line 22308 "" + s_wsfe(&io___1535); /* Writing concatenation */ +#line 22308 "" i__5[0] = 8, a__3[0] = "Writing "; +#line 22308 "" i__5[1] = lpath, a__3[1] = pathnameq; +#line 22308 "" i__5[2] = lbase, a__3[2] = basenameq; +#line 22308 "" i__5[3] = 4, a__3[3] = ".tex"; - s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96); - do_fio(&c__1, ch__39, lpath + 8 + lbase + 4); +#line 22308 "" + s_cat(ch__40, a__3, i__5, &c__4, (ftnlen)96); +#line 22308 "" + do_fio(&c__1, ch__40, lpath + 8 + lbase + 4); +#line 22308 "" e_wsfe(); - s_wsfe(&io___1488); +#line 22310 "" + s_wsfe(&io___1536); +#line 22310 "" do_fio(&c__1, " Done with second PMX pass. Now run TeX", (ftnlen)40); +#line 22310 "" e_wsfe(); +#line 22311 "" } +#line 22312 "" return 0; } /* pmxb_ */ @@ -33651,24 +54514,41 @@ L40: /* Compute avg. & norm. std. dev. of poe. */ +#line 22320 "" /* Parameter adjustments */ +#line 22320 "" --poe; +#line 22320 "" +#line 22320 "" /* Function Body */ +#line 22320 "" sumx = 0.f; +#line 22321 "" sumxx = 0.f; +#line 22322 "" i__1 = *nsyst; +#line 22322 "" for (isyst = 1; isyst <= i__1; ++isyst) { +#line 22323 "" sumx += poe[isyst]; /* Computing 2nd power */ +#line 22324 "" r__1 = poe[isyst]; +#line 22324 "" sumxx += r__1 * r__1; +#line 22325 "" /* L1: */ +#line 22325 "" } /* Computing 2nd power */ +#line 22326 "" r__1 = sumx; +#line 22326 "" *devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1); +#line 22327 "" *poebar = sumx / *nsyst; +#line 22328 "" return 0; } /* poestats_ */ @@ -33697,10 +54577,10 @@ L40: integer *); /* Fortran I/O blocks */ - static cilist io___1496 = { 0, 6, 0, 0, 0 }; - static cilist io___1497 = { 0, 6, 0, 0, 0 }; - static cilist io___1508 = { 0, 6, 0, 0, 0 }; - static cilist io___1509 = { 0, 6, 0, 0, 0 }; + static cilist io___1544 = { 0, 6, 0, 0, 0 }; + static cilist io___1545 = { 0, 6, 0, 0, 0 }; + static cilist io___1556 = { 0, 6, 0, 0, 0 }; + static cilist io___1557 = { 0, 6, 0, 0, 0 }; @@ -33715,192 +54595,308 @@ L40: /* levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. */ /* icrdot(icrd)(27-29) sequence order of chord note if accid, top down */ +#line 22350 "" for (i__ = 1; i__ <= 88; ++i__) { +#line 22351 "" levtabl[i__ - 1] = 0; +#line 22352 "" /* L11: */ +#line 22352 "" } +#line 22353 "" i__1 = comtrill_1.ncrd; +#line 22353 "" for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) { +#line 22354 "" ivx1 = (15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], ( ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd1 - 1], &c__1, &c__28) << 4); +#line 22356 "" ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]; +#line 22357 "" if (ip1 == *ip && ivx1 == *ivx) { +#line 22357 "" goto L2; +#line 22357 "" } +#line 22358 "" /* L1: */ +#line 22358 "" } - s_wsle(&io___1496); +#line 22359 "" + s_wsle(&io___1544); +#line 22359 "" e_wsle(); - s_wsle(&io___1497); - do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc" +#line 22360 "" + s_wsle(&io___1545); +#line 22360 "" + do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"\ "e to Dr. Don!", (ftnlen)63); +#line 22360 "" e_wsle(); +#line 22362 "" stop1_(); +#line 22363 "" L2: +#line 22364 "" comtrill_1.maxlev = *nolevm; +#line 22365 "" comtrill_1.minlev = *nolevm; +#line 22366 "" levtabl[*nolevm - 1] = -1; +#line 22367 "" is2nd = FALSE_; +#line 22368 "" naccid = 0; +#line 22369 "" levmaxacc = -100; +#line 22370 "" levminacc = 1000; /* Check 1st 3 bits of nacc for accid on main note of chord. */ +#line 22374 "" if ((7 & *nacc) > 0) { +#line 22375 "" naccid = 1; /* Start list of notes with accid's. There will be naccid of them. kicrd=0 if main, */ /* otherwise icrd value for note with accidental. */ +#line 22380 "" kicrd[0] = 0; +#line 22381 "" levmaxacc = *nolevm; +#line 22382 "" levminacc = *nolevm; /* Start the level-ranking */ +#line 22386 "" icrdot0 = 1; +#line 22387 "" } +#line 22388 "" i__1 = comtrill_1.ncrd; +#line 22388 "" for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1; ++comtrill_1.icrd2) { +#line 22389 "" nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, & c__12); +#line 22390 "" levtabl[nolev - 1] = comtrill_1.icrd2; +#line 22391 "" comtrill_1.maxlev = max(comtrill_1.maxlev,nolev); +#line 22392 "" comtrill_1.minlev = min(comtrill_1.minlev,nolev); /* Check for accidental */ +#line 22396 "" if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) { +#line 22397 "" ++naccid; +#line 22398 "" levmaxacc = max(levmaxacc,nolev); +#line 22399 "" levminacc = min(levminacc,nolev); /* Add this icrd to list of values for notes with accid's. */ +#line 22403 "" kicrd[naccid - 1] = comtrill_1.icrd2; +#line 22404 "" if (! bit_test(*nacc,28)) { /* Order not forced, so get the level-ranking, top down */ +#line 22408 "" iorder = 1; +#line 22409 "" i__2 = naccid - 1; +#line 22409 "" for (iaccid = 1; iaccid <= i__2; ++iaccid) { +#line 22410 "" if (kicrd[iaccid - 1] == 0) { +#line 22411 "" if (*nolevm > nolev) { +#line 22412 "" ++iorder; +#line 22413 "" } else { +#line 22414 "" ++icrdot0; +#line 22415 "" } +#line 22416 "" } else { +#line 22417 "" if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] - 1], &c__7, &c__12) > nolev) { +#line 22419 "" ++iorder; +#line 22420 "" } else { +#line 22421 "" iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1], &c__3, &c__27); +#line 22422 "" i__3 = iold + 1; +#line 22422 "" setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1] , &c__3, &c__27, &i__3); +#line 22423 "" } +#line 22424 "" } +#line 22425 "" /* L12: */ +#line 22425 "" } +#line 22426 "" setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, & c__27, &iorder); +#line 22427 "" } +#line 22428 "" } /* Exit loop if last note in this chord */ +#line 22432 "" if (comtrill_1.icrd2 == comtrill_1.ncrd) { +#line 22432 "" goto L4; +#line 22432 "" } +#line 22433 "" if (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__8, &c__0) != * ip || igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__4, & c__8) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], & c__1, &c__28) << 4) != *ivx) { +#line 22433 "" goto L4; +#line 22433 "" } /* * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */ +#line 22437 "" /* L3: */ +#line 22437 "" } - s_wsle(&io___1508); +#line 22438 "" + s_wsle(&io___1556); +#line 22438 "" e_wsle(); - s_wsle(&io___1509); - do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr." +#line 22439 "" + s_wsle(&io___1557); +#line 22439 "" + do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."\ " Don!", (ftnlen)55); +#line 22439 "" e_wsle(); +#line 22440 "" stop1_(); +#line 22441 "" L4: /* Now icrd1, icrd2 define range of icrd for this chord. */ /* Bypass autos-shifting if any manual shifts are present */ +#line 22447 "" if (bit_test(*irest,20) || bit_test(*irest,27)) { +#line 22447 "" goto L10; +#line 22447 "" } /* Check for 2nds */ +#line 22451 "" for (ilev = 1; ilev <= 87; ++ilev) { +#line 22452 "" if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) { /* There is at least one 2nd.. */ +#line 22456 "" if (*(unsigned char *)udq == 'u') { /* Upstem. Start with 2nd just found and go up, rt-shifting upper */ /* member of each pair */ +#line 22461 "" ile = ilev; /* Set main-note flag for ANY right-shift */ +#line 22465 "" *irest = bit_set(*irest,20); +#line 22466 "" L7: +#line 22467 "" if (levtabl[ile] < 0) { /* Upstem, & upper member is main so must be rt-shifted. This would move */ /* stem too, so we rt-shift the OTHER note, and set flag that signals */ /* to interchange pitches just when these two notes are placed. */ +#line 22473 "" *nacc = bit_set(*nacc,30); +#line 22474 "" comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 1] - 1],24); +#line 22475 "" } else { /* Upper member is chord note, must be rt-shifted */ +#line 22479 "" comtrill_1.icrdat[levtabl[ile] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile] - 1],24); +#line 22480 "" } +#line 22481 "" ++ile; +#line 22482 "" L8: +#line 22483 "" ++ile; +#line 22484 "" if (ile < 87) { +#line 22485 "" if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) { +#line 22486 "" goto L7; +#line 22487 "" } else { +#line 22488 "" goto L8; +#line 22489 "" } +#line 22490 "" } +#line 22491 "" goto L10; +#line 22492 "" } else { /* Downstem. Start at top and work down, left-shifting lower member of each pair. */ /* We know that lowest pair is at (ilev,ilev+1). */ +#line 22497 "" ile = 88; /* Set main-note flag for ANY right-shift */ +#line 22501 "" *irest = bit_set(*irest,27); +#line 22502 "" L9: +#line 22503 "" if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) { +#line 22504 "" if (levtabl[ile - 2] < 0) { /* ipl = ibset(ipl,8) */ @@ -33908,36 +54904,57 @@ L9: /* stem too, so we left-shift the OTHER note, and set flag that signals */ /* to interchange pitches just when these two notes are placed. */ +#line 22511 "" *nacc = bit_set(*nacc,31); +#line 22512 "" comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 1] - 1],23); +#line 22513 "" } else { /* Lower member is chord note, must be shifted */ +#line 22517 "" comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set( comtrill_1.icrdat[levtabl[ile - 2] - 1],23); +#line 22519 "" } +#line 22520 "" --ile; +#line 22521 "" } +#line 22522 "" --ile; +#line 22523 "" if (ile >= ilev + 1) { +#line 22523 "" goto L9; +#line 22523 "" } +#line 22524 "" goto L10; +#line 22525 "" } +#line 22526 "" } +#line 22527 "" /* L5: */ +#line 22527 "" } +#line 22528 "" L10: /* Done with 2nds, now do accid's. Call even if just one, in case left shifts. */ /* if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, */ +#line 22533 "" if (naccid >= 1) { +#line 22533 "" crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, & levminacc, &icrdot0, twooftwo, icashft); +#line 22533 "" } +#line 22535 "" return 0; } /* precrd_ */ @@ -33949,19 +54966,26 @@ L10: e_wsfe(void); /* Fortran I/O blocks */ - static cilist io___1512 = { 0, 6, 0, 0, 0 }; - static cilist io___1513 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1560 = { 0, 6, 0, 0, 0 }; + static cilist io___1561 = { 0, 15, 0, "(a)", 0 }; /* Send string to console and to log file */ - s_wsle(&io___1512); +#line 22542 "" + s_wsle(&io___1560); +#line 22542 "" do_lio(&c__9, &c__1, string, string_len); +#line 22542 "" e_wsle(); - s_wsfe(&io___1513); +#line 22543 "" + s_wsfe(&io___1561); +#line 22543 "" do_fio(&c__1, string, string_len); +#line 22543 "" e_wsfe(); +#line 22544 "" return 0; } /* printl_ */ @@ -33999,9 +55023,9 @@ L10: static integer iivivx1; /* Fortran I/O blocks */ - static icilist io___1519 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 }; - static cilist io___1525 = { 0, 6, 0, 0, 0 }; - static cilist io___1526 = { 0, 6, 0, 0, 0 }; + static icilist io___1567 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 }; + static cilist io___1573 = { 0, 6, 0, 0, 0 }; + static cilist io___1574 = { 0, 6, 0, 0, 0 }; @@ -34009,187 +55033,320 @@ L10: /* Find which iarp, if any */ +#line 22565 "" i__1 = comarp_1.narp; +#line 22565 "" for (iarp = 1; iarp <= i__1; ++iarp) { +#line 22566 "" if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) < comtol_1.tol) { +#line 22566 "" goto L2; +#line 22566 "" } +#line 22567 "" /* L1: */ +#line 22567 "" } /* If here, this is the *first* call for this arp. */ +#line 22571 "" ++comarp_1.narp; +#line 22572 "" comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f; +#line 22573 "" comarp_1.ivar1[comarp_1.narp - 1] = *iv; +#line 22574 "" comarp_1.ipar1[comarp_1.narp - 1] = *ip; +#line 22575 "" comarp_1.levar1[comarp_1.narp - 1] = *nolev; +#line 22576 "" comarp_1.ncmar1[comarp_1.narp - 1] = *ncm; +#line 22577 "" return 0; +#line 22578 "" L2: /* If here, this is *second* call at this time, narp points to values from 1st. */ /* Check for shift. Set IsArpShift and iarps */ +#line 22584 "" i__1 = comarpshift_1.numarpshift; +#line 22584 "" for (iarps = 1; iarps <= i__1; ++iarps) { +#line 22585 "" if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] && comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp - 1]) { +#line 22587 "" isarpshift = TRUE_; /* Writing concatenation */ +#line 22588 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22588 "" i__2[0] = 1, a__1[0] = ch__1; +#line 22588 "" i__2[1] = 8, a__1[1] = "loffset{"; +#line 22588 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); - s_wsfi(&io___1519); +#line 22589 "" + s_wsfi(&io___1567); +#line 22589 "" do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen) sizeof(real)); +#line 22589 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 22589 "" e_wsfi(); +#line 22590 "" lnote = 14; +#line 22591 "" goto L4; +#line 22592 "" } +#line 22593 "" /* L3: */ +#line 22593 "" } +#line 22594 "" isarpshift = FALSE_; +#line 22595 "" lnote = 0; +#line 22596 "" L4: +#line 22597 "" if (*iv == comarp_1.ivar1[iarp - 1]) { /* Arp is in a single voice. */ /* Computing MIN */ +#line 22601 "" i__1 = comarp_1.levar1[iarp - 1]; +#line 22601 "" levbot = min(i__1,*nolev) - *ncm + 3; +#line 22602 "" invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1; +#line 22603 "" } else { /* Arp covers >1 voice. Lower voice has to be the first, upper is current and */ /* is where the symbol will be written. */ /* Check whether ivx's ivar1(iarp) & iv are in same staff */ +#line 22609 "" for (iiv = 1; iiv <= 24; ++iiv) { +#line 22610 "" if (commvl_1.ivmx[iiv - 1] == comarp_1.ivar1[iarp - 1] || commvl_1.nvmx[iiv - 1] == 2 && commvl_1.ivmx[iiv + 23] == comarp_1.ivar1[iarp - 1]) { +#line 22612 "" iivivx1 = iiv; +#line 22613 "" goto L6; +#line 22614 "" } +#line 22615 "" /* L5: */ +#line 22615 "" } - s_wsle(&io___1525); +#line 22616 "" + s_wsle(&io___1573); +#line 22616 "" do_lio(&c__9, &c__1, "Screwup#1 in putarp", (ftnlen)19); +#line 22616 "" e_wsle(); +#line 22617 "" s_stop("", (ftnlen)0); +#line 22618 "" L6: +#line 22619 "" for (iiv = 1; iiv <= 24; ++iiv) { +#line 22620 "" if (commvl_1.ivmx[iiv - 1] == *iv || commvl_1.nvmx[iiv - 1] == 2 && commvl_1.ivmx[iiv + 23] == *iv) { +#line 22620 "" goto L8; +#line 22620 "" } /* Found iv for both voices (iivivx1, iiv), done looking */ +#line 22625 "" /* L7: */ +#line 22625 "" } - s_wsle(&io___1526); +#line 22626 "" + s_wsle(&io___1574); +#line 22626 "" do_lio(&c__9, &c__1, "Screwup#2 in putarp", (ftnlen)19); +#line 22626 "" e_wsle(); +#line 22627 "" s_stop("", (ftnlen)0); +#line 22628 "" L8: +#line 22629 "" if (iivivx1 == iiv) { +#line 22630 "" nstaffshift = 0; +#line 22631 "" } else { +#line 22632 "" r__1 = comarp_1.xinsnow * 2; +#line 22632 "" nstaffshift = -i_nint(&r__1); +#line 22633 "" } /* levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) */ +#line 22635 "" levbot = nstaffshift + 3 + comarp_1.levar1[iarp - 1] - comarp_1.ncmar1[iarp - 1]; +#line 22636 "" invert = -levbot + 4 + *nolev - *ncm; -/* print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' */ -/* write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), */ -/* *levbot,nolev,ncm */ +#line 22637 "" } /* isym will be (1,2) if invert is (even,odd). If even, raise .5\internote */ +#line 22641 "" isym = invert % 2 + 1; +#line 22642 "" ilvert = (invert + 1) / 2; +#line 22643 "" if (levbot >= 0 && levbot <= 9) { /* Single digit */ +#line 22647 "" if (! isarpshift) { /* Writing concatenation */ +#line 22648 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22648 "" i__3[0] = 1, a__2[0] = ch__1; +#line 22648 "" i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); +#line 22648 "" i__1 = levbot + 48; +#line 22648 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 22648 "" i__3[2] = 1, a__2[2] = ch__2; +#line 22648 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 22649 "" } else { /* Writing concatenation */ +#line 22650 "" i__4[0] = lnote, a__3[0] = notexq; +#line 22650 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22650 "" i__4[1] = 1, a__3[1] = ch__1; +#line 22650 "" i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); +#line 22650 "" i__1 = levbot + 48; +#line 22650 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 22650 "" i__4[3] = 1, a__3[3] = ch__2; +#line 22650 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 22652 "" } +#line 22653 "" lnote += 10; +#line 22654 "" } else { +#line 22655 "" if (! isarpshift) { /* Writing concatenation */ +#line 22656 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22656 "" i__3[0] = 1, a__2[0] = ch__1; +#line 22656 "" i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); +#line 22656 "" i__3[2] = 1, a__2[2] = "{"; +#line 22656 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 22657 "" } else { /* Writing concatenation */ +#line 22658 "" i__4[0] = lnote, a__3[0] = notexq; +#line 22658 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22658 "" i__4[1] = 1, a__3[1] = ch__1; +#line 22658 "" i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); +#line 22658 "" i__4[3] = 1, a__3[3] = "{"; +#line 22658 "" s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 22659 "" } +#line 22660 "" lnote += 10; +#line 22661 "" if (levbot >= -9) { /* Need two spaces for number */ +#line 22665 "" i__1 = lnote; +#line 22665 "" ici__1.icierr = 0; +#line 22665 "" ici__1.icirnum = 1; +#line 22665 "" ici__1.icirlen = lnote + 3 - i__1; +#line 22665 "" ici__1.iciunit = notexq + i__1; +#line 22665 "" ici__1.icifmt = "(i2,a1)"; +#line 22665 "" s_wsfi(&ici__1); +#line 22665 "" do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); +#line 22665 "" do_fio(&c__1, "}", (ftnlen)1); +#line 22665 "" e_wsfi(); +#line 22666 "" lnote += 3; +#line 22667 "" } else { +#line 22668 "" i__1 = lnote; +#line 22668 "" ici__1.icierr = 0; +#line 22668 "" ici__1.icirnum = 1; +#line 22668 "" ici__1.icirlen = lnote + 4 - i__1; +#line 22668 "" ici__1.iciunit = notexq + i__1; +#line 22668 "" ici__1.icifmt = "(i3,a1)"; +#line 22668 "" s_wsfi(&ici__1); +#line 22668 "" do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); +#line 22668 "" do_fio(&c__1, "}", (ftnlen)1); +#line 22668 "" e_wsfi(); +#line 22669 "" lnote += 4; +#line 22670 "" } +#line 22671 "" } /* if (ilvert .le. 9) then */ /* call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */ @@ -34198,40 +55355,70 @@ L8: /* write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' */ /* call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) */ /* end if */ +#line 22680 "" if (ilvert > 9) { +#line 22681 "" i__1 = lnote; +#line 22681 "" ici__1.icierr = 0; +#line 22681 "" ici__1.icirnum = 1; +#line 22681 "" ici__1.icirlen = lnote + 4 - i__1; +#line 22681 "" ici__1.iciunit = notexq + i__1; +#line 22681 "" ici__1.icifmt = "(a1,i2,a1)"; +#line 22681 "" s_wsfi(&ici__1); +#line 22681 "" do_fio(&c__1, "{", (ftnlen)1); +#line 22681 "" do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer)); +#line 22681 "" do_fio(&c__1, "}", (ftnlen)1); +#line 22681 "" e_wsfi(); +#line 22682 "" lnote += 4; +#line 22683 "" } else { /* Writing concatenation */ +#line 22684 "" i__2[0] = lnote, a__1[0] = notexq; +#line 22684 "" i__1 = ilvert + 48; +#line 22684 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 22684 "" i__2[1] = 1, a__1[1] = ch__1; +#line 22684 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22685 "" ++lnote; +#line 22686 "" } +#line 22687 "" if (isarpshift) { /* Writing concatenation */ +#line 22688 "" i__2[0] = lnote, a__1[0] = notexq; +#line 22688 "" i__2[1] = 1, a__1[1] = "}"; +#line 22688 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22689 "" ++lnote; +#line 22690 "" } +#line 22691 "" addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); /* cancel out the stored time, to permit two arps at same time! */ +#line 22695 "" comarp_1.tar[iarp - 1] = -1.f; +#line 22696 "" return 0; } /* putarp_ */ @@ -34254,25 +55441,42 @@ L8: static char tag[129], fmtq[9]; /* Fortran I/O blocks */ - static icilist io___1532 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 }; + static icilist io___1580 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 }; +#line 22701 "" if (*elask >= 0.f) { +#line 22702 "" if (*elask < .995f) { +#line 22703 "" lp = 3; +#line 22704 "" } else if (*elask < 9.995f) { +#line 22705 "" lp = 4; +#line 22706 "" } else { +#line 22707 "" lp = 5; +#line 22708 "" } - s_wsfi(&io___1532); +#line 22709 "" + s_wsfi(&io___1580); +#line 22709 "" do_fio(&c__1, "(a2,f", (ftnlen)5); +#line 22709 "" do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer)); +#line 22709 "" do_fio(&c__1, ".2)", (ftnlen)3); +#line 22709 "" e_wsfi(); +#line 22710 "" } else { +#line 22711 "" lp = 5; +#line 22712 "" s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9); +#line 22713 "" } /* Overwrite as follows: ...xyz*ask *lmnop... -> */ @@ -34280,23 +55484,40 @@ L8: /* ...xyz*ast{n.nn}*lmnop... */ /* ...xyz*ast{nn.nn}*lmnop... */ /* or for negative, ...xyz*ast{-nn.n}*lmnop... */ +#line 22720 "" i__1 = *indxask + 8; +#line 22720 "" s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1); +#line 22721 "" i__1 = *indxask + 2; +#line 22721 "" ici__1.icierr = 0; +#line 22721 "" ici__1.icirnum = 1; +#line 22721 "" ici__1.icirlen = 129 - i__1; +#line 22721 "" ici__1.iciunit = outq + i__1; +#line 22721 "" ici__1.icifmt = fmtq; +#line 22721 "" s_wsfi(&ici__1); +#line 22721 "" do_fio(&c__1, "t{", (ftnlen)2); +#line 22721 "" do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real)); +#line 22721 "" e_wsfi(); /* Writing concatenation */ +#line 22722 "" i__2[0] = *indxask + 4 + lp, a__1[0] = outq; +#line 22722 "" i__2[1] = 1, a__1[1] = "}"; +#line 22722 "" i__2[2] = 129, a__1[2] = tag; +#line 22722 "" s_cat(outq, a__1, i__2, &c__3, (ftnlen)129); +#line 22723 "" return 0; } /* putast_ */ @@ -34324,133 +55545,247 @@ L8: extern /* Subroutine */ int printl_(char *, ftnlen); /* ivxip = ivx+16*ip */ +#line 22730 "" i__1 = comcb_1.nbc; +#line 22730 "" for (ibc = 1; ibc <= i__1; ++ibc) { /* if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 */ /* if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) */ /* * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 */ +#line 22734 "" ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[ ibc - 1], &c__1, &c__28) << 4); +#line 22735 "" ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4); +#line 22736 "" if (*ivx == ivxbc && *ip == ipbc) { +#line 22736 "" goto L2; +#line 22736 "" } +#line 22737 "" /* L1: */ +#line 22737 "" } +#line 22738 "" printl_("Error in putbc, Call Dr. Don", (ftnlen)28); +#line 22739 "" s_stop("", (ftnlen)0); +#line 22740 "" L2: +#line 22741 "" if (bit_test(comcb_1.ibcdata[ibc - 1],27)) { +#line 22742 "" *lnote = 8; +#line 22743 "" s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8); +#line 22744 "" } else { +#line 22745 "" *lnote = 9; +#line 22746 "" s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9); +#line 22747 "" } +#line 22748 "" ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13); /* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */ +#line 22750 "" if (ivshft > 0) { +#line 22750 "" ivshft += -32; +#line 22750 "" } +#line 22751 "" if (ivshft < 0 || ivshft > 9) { /* Writing concatenation */ +#line 22752 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22752 "" i__2[1] = 1, a__1[1] = "{"; +#line 22752 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22753 "" ++(*lnote); +#line 22754 "" if (ivshft < -9) { +#line 22755 "" i__1 = *lnote; +#line 22755 "" ici__1.icierr = 0; +#line 22755 "" ici__1.icirnum = 1; +#line 22755 "" ici__1.icirlen = *lnote + 3 - i__1; +#line 22755 "" ici__1.iciunit = notexq + i__1; +#line 22755 "" ici__1.icifmt = "(i3)"; +#line 22755 "" s_wsfi(&ici__1); +#line 22755 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 22755 "" e_wsfi(); +#line 22756 "" *lnote += 3; +#line 22757 "" } else { +#line 22758 "" i__1 = *lnote; +#line 22758 "" ici__1.icierr = 0; +#line 22758 "" ici__1.icirnum = 1; +#line 22758 "" ici__1.icirlen = *lnote + 2 - i__1; +#line 22758 "" ici__1.iciunit = notexq + i__1; +#line 22758 "" ici__1.icifmt = "(i2)"; +#line 22758 "" s_wsfi(&ici__1); +#line 22758 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 22758 "" e_wsfi(); +#line 22759 "" *lnote += 2; +#line 22760 "" } /* Writing concatenation */ +#line 22761 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22761 "" i__2[1] = 1, a__1[1] = "}"; +#line 22761 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22762 "" ++(*lnote); +#line 22763 "" } else { /* Writing concatenation */ +#line 22764 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22764 "" *(unsigned char *)&ch__1[0] = ivshft + 48; +#line 22764 "" i__2[1] = 1, a__1[1] = ch__1; +#line 22764 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22765 "" ++(*lnote); +#line 22766 "" } +#line 22767 "" ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19); +#line 22768 "" if (ihshft == 0) { /* Writing concatenation */ +#line 22769 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22769 "" i__2[1] = 1, a__1[1] = "0"; +#line 22769 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22770 "" ++(*lnote); +#line 22771 "" } else { +#line 22772 "" hshft = (ihshft - 128) * .1f; /* -12.8<hshft<12.8 */ /* Writing concatenation */ +#line 22776 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22776 "" i__2[1] = 1, a__1[1] = "{"; +#line 22776 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22777 "" ++(*lnote); +#line 22778 "" if (hshft < -9.95f) { +#line 22779 "" i__1 = *lnote; +#line 22779 "" ici__1.icierr = 0; +#line 22779 "" ici__1.icirnum = 1; +#line 22779 "" ici__1.icirlen = *lnote + 5 - i__1; +#line 22779 "" ici__1.iciunit = notexq + i__1; +#line 22779 "" ici__1.icifmt = "(f5.1)"; +#line 22779 "" s_wsfi(&ici__1); +#line 22779 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 22779 "" e_wsfi(); +#line 22780 "" *lnote += 5; +#line 22781 "" } else if (hshft < -.05f || hshft > 9.95f) { +#line 22782 "" i__1 = *lnote; +#line 22782 "" ici__1.icierr = 0; +#line 22782 "" ici__1.icirnum = 1; +#line 22782 "" ici__1.icirlen = *lnote + 4 - i__1; +#line 22782 "" ici__1.iciunit = notexq + i__1; +#line 22782 "" ici__1.icifmt = "(f4.1)"; +#line 22782 "" s_wsfi(&ici__1); +#line 22782 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 22782 "" e_wsfi(); +#line 22783 "" *lnote += 4; +#line 22784 "" } else { +#line 22785 "" i__1 = *lnote; +#line 22785 "" ici__1.icierr = 0; +#line 22785 "" ici__1.icirnum = 1; +#line 22785 "" ici__1.icirlen = *lnote + 3 - i__1; +#line 22785 "" ici__1.iciunit = notexq + i__1; +#line 22785 "" ici__1.icifmt = "(f3.1)"; +#line 22785 "" s_wsfi(&ici__1); +#line 22785 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 22785 "" e_wsfi(); +#line 22786 "" *lnote += 3; +#line 22787 "" } /* Writing concatenation */ +#line 22788 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 22788 "" i__2[1] = 1, a__1[1] = "}"; +#line 22788 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 22789 "" ++(*lnote); +#line 22790 "" } +#line 22791 "" return 0; } /* putcb_ */ @@ -34490,112 +55825,188 @@ L2: ; /* Fortran I/O blocks */ - static icilist io___1545 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; - static icilist io___1546 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; - static icilist io___1547 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; - static icilist io___1548 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; - static icilist io___1561 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; - static icilist io___1562 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; - static icilist io___1563 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; - static icilist io___1564 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; + static icilist io___1593 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; + static icilist io___1594 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; + static icilist io___1595 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; + static icilist io___1596 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; + static icilist io___1609 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; + static icilist io___1610 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; + static icilist io___1611 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; + static icilist io___1612 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; +#line 22803 "" if (*ivx == 1) { +#line 22804 "" s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4); +#line 22805 "" s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4); +#line 22806 "" } else { +#line 22807 "" s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4); +#line 22808 "" s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4); +#line 22809 "" } +#line 22810 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 22810 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 22811 "" if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] != 0) { /* Alter figdrop */ /* Writing concatenation */ +#line 22815 "" i__1[0] = 1, a__1[0] = sq; +#line 22815 "" i__1[1] = 6, a__1[1] = "global"; +#line 22815 "" i__1[2] = 1, a__1[2] = sq; +#line 22815 "" i__1[3] = 7, a__1[3] = "advance"; +#line 22815 "" i__1[4] = 1, a__1[4] = sq; +#line 22815 "" i__1[5] = 7, a__1[5] = "figdrop"; +#line 22815 "" s_cat(notexq, a__1, i__1, &c__6, (ftnlen)80); +#line 22816 "" lnote = 23; +#line 22817 "" if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] < 0) { /* Writing concatenation */ +#line 22818 "" i__2[0] = lnote, a__2[0] = notexq; +#line 22818 "" i__2[1] = 1, a__2[1] = "-"; +#line 22818 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 22819 "" ++lnote; +#line 22820 "" } /* Writing concatenation */ +#line 22821 "" i__2[0] = lnote, a__2[0] = notexq; +#line 22821 "" *(unsigned char *)&ch__1[0] = (i__3 = comfig_2.ivvfig[*ivx + (*ifig << 1) - 3], abs(i__3)) + 48; +#line 22821 "" i__2[1] = 1, a__2[1] = ch__1; +#line 22821 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 22822 "" ++lnote; +#line 22823 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 22824 "" } +#line 22825 "" if (dabs(*offnsk) > 1e-4f) { /* Write offset for floating figure, to two decimal places */ /* Writing concatenation */ +#line 22829 "" i__2[0] = 1, a__2[0] = sq; +#line 22829 "" i__2[1] = 4, a__2[1] = "off{"; +#line 22829 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 22830 "" if (-(*offnsk) < -9.995f) { - s_wsfi(&io___1545); +#line 22831 "" + s_wsfi(&io___1593); +#line 22831 "" r__1 = -(*offnsk); +#line 22831 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 22831 "" e_wsfi(); +#line 22832 "" lnote = 11; +#line 22833 "" } else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) { - s_wsfi(&io___1546); +#line 22834 "" + s_wsfi(&io___1594); +#line 22834 "" r__1 = -(*offnsk); +#line 22834 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 22834 "" e_wsfi(); +#line 22835 "" lnote = 10; +#line 22836 "" } else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) { - s_wsfi(&io___1547); +#line 22837 "" + s_wsfi(&io___1595); +#line 22837 "" r__1 = -(*offnsk); +#line 22837 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 22837 "" e_wsfi(); +#line 22838 "" lnote = 9; +#line 22839 "" } else { - s_wsfi(&io___1548); +#line 22840 "" + s_wsfi(&io___1596); +#line 22840 "" r__1 = -(*offnsk); +#line 22840 "" do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 22840 "" e_wsfi(); +#line 22841 "" lnote = 8; +#line 22842 "" } /* Writing concatenation */ +#line 22843 "" i__4[0] = lnote, a__3[0] = notexq; +#line 22843 "" i__4[1] = 1, a__3[1] = sq; +#line 22843 "" i__4[2] = 9, a__3[2] = "noteskip}"; +#line 22843 "" s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); +#line 22844 "" i__3 = lnote + 10; +#line 22844 "" addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 22845 "" } +#line 22846 "" s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10, (ftnlen)10); +#line 22847 "" ic = 1; /* nof = 0 */ /* nofa = -1 */ +#line 22850 "" nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3]; +#line 22851 "" nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1; /* Beginning of manual loop */ +#line 22855 "" L1: +#line 22855 "" *(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1]; /* Exit when first blank is encountered */ +#line 22859 "" if (*(unsigned char *)ch1q == ' ') { +#line 22859 "" goto L2; +#line 22859 "" } /* Starting a level. Set up vertical offset. */ @@ -34616,217 +56027,387 @@ L1: /* lnofa = 2 */ /* nofaq = '1'//chax(nofa+38) */ /* end if */ +#line 22879 "" istring_(&nof, nofq, &lnof, (ftnlen)5); +#line 22880 "" istring_(&nofa, nofaq, &lnofa, (ftnlen)5); +#line 22881 "" if (*(unsigned char *)ch1q == '0') { /* Continuation figure. Next number is length (in noteskips). The number will */ /* end at the first blank or char that is not digit or decimal point. If */ /* colon, it is a separator and must be skipped */ +#line 22887 "" icnum = ic + 1; +#line 22888 "" L3: +#line 22889 "" ++ic; +#line 22890 "" if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0) { +#line 22890 "" goto L3; +#line 22890 "" } +#line 22891 "" lnum = ic - icnum; /* Writing concatenation */ +#line 22892 "" i__1[0] = 1, a__1[0] = sq; +#line 22892 "" i__1[1] = 4, a__1[1] = conttq; +#line 22892 "" i__1[2] = lnof, a__1[2] = nofq; +#line 22892 "" i__1[3] = 1, a__1[3] = "{"; +#line 22892 "" i__1[4] = ic - 1 - (icnum - 1), a__1[4] = figq + (icnum - 1); +#line 22892 "" i__1[5] = 1, a__1[5] = "}"; +#line 22892 "" s_cat(ch__2, a__1, i__1, &c__6, (ftnlen)22); +#line 22892 "" i__3 = ic + 7 - icnum + lnof; +#line 22892 "" addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1)) + 1, (ftnlen)80); +#line 22894 "" if (*(unsigned char *)&figq[ic - 1] != ':') { +#line 22894 "" --ic; +#line 22894 "" } +#line 22895 "" } else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-' || *(unsigned char *)ch1q == 'n') { +#line 22896 "" ++ic; +#line 22897 "" *(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1]; +#line 22898 "" if (*(unsigned char *)ch2q == ' ') { /* Figure is a stand-alone accidental, so must be centered */ +#line 22902 "" if (*(unsigned char *)ch1q == '#') { /* Writing concatenation */ +#line 22903 "" i__1[0] = 1, a__1[0] = sq; +#line 22903 "" i__1[1] = 4, a__1[1] = figutq; +#line 22903 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22903 "" i__1[3] = 1, a__1[3] = "{"; +#line 22903 "" i__1[4] = 1, a__1[4] = sq; +#line 22903 "" i__1[5] = 9, a__1[5] = "sharpfig}"; +#line 22903 "" s_cat(ch__3, a__1, i__1, &c__6, (ftnlen)21); +#line 22903 "" i__3 = lnofa + 16; +#line 22903 "" addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80); +#line 22905 "" } else if (*(unsigned char *)ch1q == '-') { /* Writing concatenation */ +#line 22906 "" i__1[0] = 1, a__1[0] = sq; +#line 22906 "" i__1[1] = 4, a__1[1] = figutq; +#line 22906 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22906 "" i__1[3] = 1, a__1[3] = "{"; +#line 22906 "" i__1[4] = 1, a__1[4] = sq; +#line 22906 "" i__1[5] = 8, a__1[5] = "flatfig}"; +#line 22906 "" s_cat(ch__4, a__1, i__1, &c__6, (ftnlen)20); +#line 22906 "" i__3 = lnofa + 15; +#line 22906 "" addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80); +#line 22908 "" } else if (*(unsigned char *)ch1q == 'n') { /* Writing concatenation */ +#line 22909 "" i__1[0] = 1, a__1[0] = sq; +#line 22909 "" i__1[1] = 4, a__1[1] = figutq; +#line 22909 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22909 "" i__1[3] = 1, a__1[3] = "{"; +#line 22909 "" i__1[4] = 1, a__1[4] = sq; +#line 22909 "" i__1[5] = 7, a__1[5] = "natfig}"; +#line 22909 "" s_cat(ch__5, a__1, i__1, &c__6, (ftnlen)19); +#line 22909 "" i__3 = lnofa + 14; +#line 22909 "" addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80); +#line 22911 "" } +#line 22912 "" goto L2; +#line 22913 "" } else { /* Figure is an accidental followed by a number */ /* First put the accidental (offset to the left) */ +#line 22918 "" if (*(unsigned char *)ch1q == '#') { /* Writing concatenation */ +#line 22919 "" i__1[0] = 1, a__1[0] = sq; +#line 22919 "" i__1[1] = 4, a__1[1] = figutq; +#line 22919 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22919 "" i__1[3] = 1, a__1[3] = "{"; +#line 22919 "" i__1[4] = 1, a__1[4] = sq; +#line 22919 "" i__1[5] = 6, a__1[5] = "fsmsh}"; +#line 22919 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 22919 "" i__3 = lnofa + 13; +#line 22919 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 22922 "" } else if (*(unsigned char *)ch1q == '-') { /* Writing concatenation */ +#line 22923 "" i__1[0] = 1, a__1[0] = sq; +#line 22923 "" i__1[1] = 4, a__1[1] = figutq; +#line 22923 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22923 "" i__1[3] = 1, a__1[3] = "{"; +#line 22923 "" i__1[4] = 1, a__1[4] = sq; +#line 22923 "" i__1[5] = 6, a__1[5] = "fsmfl}"; +#line 22923 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 22923 "" i__3 = lnofa + 13; +#line 22923 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 22926 "" } else if (*(unsigned char *)ch1q == 'n') { /* Writing concatenation */ +#line 22927 "" i__1[0] = 1, a__1[0] = sq; +#line 22927 "" i__1[1] = 4, a__1[1] = figutq; +#line 22927 "" i__1[2] = lnofa, a__1[2] = nofaq; +#line 22927 "" i__1[3] = 1, a__1[3] = "{"; +#line 22927 "" i__1[4] = 1, a__1[4] = sq; +#line 22927 "" i__1[5] = 6, a__1[5] = "fsmna}"; +#line 22927 "" s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 22927 "" i__3 = lnofa + 13; +#line 22927 "" addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 22930 "" } /* Now put the number */ /* Writing concatenation */ +#line 22934 "" i__1[0] = 1, a__1[0] = sq; +#line 22934 "" i__1[1] = 4, a__1[1] = figutq; +#line 22934 "" i__1[2] = lnof, a__1[2] = nofq; +#line 22934 "" i__1[3] = 1, a__1[3] = "{"; +#line 22934 "" i__1[4] = 1, a__1[4] = ch2q; +#line 22934 "" i__1[5] = 1, a__1[5] = "}"; +#line 22934 "" s_cat(ch__7, a__1, i__1, &c__6, (ftnlen)13); +#line 22934 "" i__3 = lnof + 8; +#line 22934 "" addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80); +#line 22936 "" } +#line 22937 "" } else if (*(unsigned char *)ch1q == '_') { /* Placeholder only (for lowering a figure). Don't do anything! */ +#line 22942 "" } else { /* Figure is a single number, maybe with s after */ /* Writing concatenation */ +#line 22946 "" i__5[0] = 1, a__4[0] = sq; +#line 22946 "" i__5[1] = 4, a__4[1] = figutq; +#line 22946 "" i__5[2] = lnof, a__4[2] = nofq; +#line 22946 "" i__5[3] = 1, a__4[3] = "{"; +#line 22946 "" s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11); +#line 22946 "" i__3 = lnof + 6; +#line 22946 "" addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80); +#line 22948 "" i__3 = ic; +#line 22948 "" s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3); +#line 22949 "" if (*(unsigned char *)ch2q == 's') { /* Use a special character. Insert font call */ +#line 22953 "" ++ic; /* Writing concatenation */ +#line 22954 "" i__2[0] = 1, a__2[0] = sq; +#line 22954 "" i__2[1] = 7, a__2[1] = "ligfont"; +#line 22954 "" s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); +#line 22954 "" addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80); +#line 22955 "" } /* Writing concatenation */ +#line 22956 "" i__2[0] = 1, a__2[0] = ch1q; +#line 22956 "" i__2[1] = 1, a__2[1] = "}"; +#line 22956 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)2); +#line 22956 "" addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); /* call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */ /* * 8+lnof,soutq,lsout) */ +#line 22959 "" } +#line 22960 "" if (ic >= 10) { +#line 22960 "" goto L2; +#line 22960 "" } +#line 22961 "" ++ic; +#line 22962 "" nof += 4; +#line 22963 "" nofa += 4; +#line 22964 "" goto L1; +#line 22965 "" L2: +#line 22966 "" if (dabs(*offnsk) > 1e-4f) { /* Writing concatenation */ +#line 22967 "" i__2[0] = 1, a__2[0] = sq; +#line 22967 "" i__2[1] = 4, a__2[1] = "off{"; +#line 22967 "" s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 22968 "" if (*offnsk < -9.995f) { - s_wsfi(&io___1561); +#line 22969 "" + s_wsfi(&io___1609); +#line 22969 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 22969 "" e_wsfi(); +#line 22970 "" lnote = 11; +#line 22971 "" } else if (*offnsk < -.995f || *offnsk > 9.995f) { - s_wsfi(&io___1562); +#line 22972 "" + s_wsfi(&io___1610); +#line 22972 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 22972 "" e_wsfi(); +#line 22973 "" lnote = 10; +#line 22974 "" } else if (*offnsk < -1e-4f || *offnsk > .995f) { - s_wsfi(&io___1563); +#line 22975 "" + s_wsfi(&io___1611); +#line 22975 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 22975 "" e_wsfi(); +#line 22976 "" lnote = 9; +#line 22977 "" } else { - s_wsfi(&io___1564); +#line 22978 "" + s_wsfi(&io___1612); +#line 22978 "" do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 22978 "" e_wsfi(); +#line 22979 "" lnote = 8; +#line 22980 "" } /* Writing concatenation */ +#line 22981 "" i__4[0] = lnote, a__3[0] = notexq; +#line 22981 "" i__4[1] = 1, a__3[1] = sq; +#line 22981 "" i__4[2] = 9, a__3[2] = "noteskip}"; +#line 22981 "" s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); +#line 22982 "" i__3 = lnote + 10; +#line 22982 "" addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 22983 "" } +#line 22984 "" if (*ifig < comfig_2.nfigs[*ivx - 1]) { +#line 22985 "" ++(*ifig); +#line 22986 "" } else { +#line 22987 "" comfig_2.nfigs[*ivx - 1] = 0; +#line 22988 "" *figcheck = FALSE_; +#line 22989 "" } +#line 22990 "" return 0; } /* putfig_ */ @@ -34879,56 +56460,95 @@ L2: /* notcrd = .true. if ornament is on main note. */ /* nolevm is level of main note (for chords) */ +#line 23010 "" /* Parameter adjustments */ +#line 23010 "" ihornb -= 25; +#line 23010 "" ulq -= 25; +#line 23010 "" --nornb; +#line 23010 "" +#line 23010 "" /* Function Body */ +#line 23010 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 23010 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 23011 "" *lout = 0; +#line 23012 "" usehornb = FALSE_; +#line 23013 "" if (*nodur < 64) { +#line 23014 "" stemlen = *stemlin; +#line 23015 "" } else { +#line 23016 "" stemlen = 0.f; +#line 23017 "" } /* Get up-downness. ulpzq is opposite from stem direction for both beams and */ /* non beams. Can use in name of ornament [ . or _ ] */ +#line 23022 "" if (*beamon) { +#line 23023 "" if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { +#line 23024 "" *(unsigned char *)ulpzq = 'l'; +#line 23025 "" } else { +#line 23026 "" *(unsigned char *)ulpzq = 'u'; +#line 23027 "" } +#line 23028 "" } else { +#line 23029 "" udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv); +#line 23029 "" if (*(unsigned char *)&ch__1[0] == 'l') { +#line 23030 "" *(unsigned char *)ulpzq = 'u'; +#line 23031 "" } else { +#line 23032 "" *(unsigned char *)ulpzq = 'l'; +#line 23033 "" } +#line 23034 "" } /* To enable >1 ornament on a note, next line is top of manual loop. */ +#line 23038 "" L2: /* c Bit # of last ornament (last of bits 0-21) */ /* c Bit # of last ornament (last of bits 0-24) */ /* Bit # of last ornament (last of bits 0-24,29-30) */ +#line 23043 "" if (bit_test(*iornq,29)) { +#line 23044 "" ibit = 29; +#line 23045 "" } else if (bit_test(*iornq,30)) { +#line 23046 "" ibit = 30; +#line 23047 "" } else { +#line 23048 "" i__1 = *iornq & 4194303; +#line 23048 "" ibit = log2_(&i__1); /* ibit = log2(iand(iornq,33554431)) */ +#line 23050 "" } +#line 23051 "" iornt = pow_ii(&c__2, &ibit); /* Begin routine to set height. Bits 0-13: (stmgx+Tupf._) */ @@ -34938,334 +56558,568 @@ L2: /* Do not use beam height for . or _ */ +#line 23060 "" if (bit_test(*iornq,22) && (iornt & 6144) == 0) { /* Height is set by special beam stuff. */ /* Do not leave ihorn set, do separately for every ornament */ +#line 23065 "" ihorn = ihornb[*ivx + nornb[*ivx] * 24]; +#line 23066 "" if (*(unsigned char *)ulpzq == 'u') { +#line 23066 "" ihorn += -2; +#line 23066 "" } /* Following flag tells whether to increment nornb when exiting the subroutine. */ +#line 23070 "" usehornb = TRUE_; +#line 23071 "" } else if (ibit == 14) { /* Down fermata. Don't worry about upper chord notes. */ +#line 23075 "" if (*(unsigned char *)ulpzq == 'l') { /* Computing MIN */ +#line 23076 "" i__1 = *nolev, i__2 = *ncm - 3; +#line 23076 "" ihorn = min(i__1,i__2); +#line 23077 "" } else { /* Computing MIN */ +#line 23078 "" r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; +#line 23078 "" ihorn = dmin(r__1,r__2); +#line 23079 "" } +#line 23080 "" } else if (bit_test(iornt,13) || bit_test(iornt,0)) { /* ( or ) */ +#line 23084 "" ihorn = *nolev; +#line 23085 "" } else if ((iornt & 6144) > 0) { /* c Staccato . or tenuto _ , but not special beam stuff. Need up-down info */ /* NOTE: removed .&_ from special beam treatment. */ /* Staccato . or tenuto _ Need up-down info */ +#line 23091 "" if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *) ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned char *)ulpzq == 'u') { +#line 23093 "" ihorn = *nolev; +#line 23094 "" } else if (comtrill_1.maxlev == *nolev) { +#line 23095 "" *(unsigned char *)ulpzq = 'u'; /* Computing MAX */ +#line 23096 "" r__1 = *nolev + stemlen, r__2 = *ncm + 3.f; +#line 23096 "" ihorn = dmax(r__1,r__2); +#line 23097 "" } else { +#line 23098 "" *(unsigned char *)ulpzq = 'l'; /* Computing MIN */ +#line 23099 "" r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; +#line 23099 "" ihorn = dmin(r__1,r__2); +#line 23100 "" } +#line 23101 "" } else if (*iscrd && *nolev == comtrill_1.minlev) { +#line 23102 "" if (*(unsigned char *)ulpzq == 'l') { /* Computing MIN */ +#line 23103 "" i__1 = *nolev - 3, i__2 = *ncm - 6; +#line 23103 "" ihorn = min(i__1,i__2); +#line 23104 "" } else { /* Computing MIN */ +#line 23105 "" i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6; +#line 23105 "" ihorn = min(i__1,i__2); +#line 23106 "" } +#line 23107 "" } else if (ibit == 10 && *nolev > 90) { /* Special treatment for fermata on a shifted rest */ +#line 23111 "" ihorn = *ncm + 5; +#line 23112 "" } else if (*(unsigned char *)ulpzq == 'l') { /* (iscrd and nolev=maxlev) or (.not.iscrd) */ /* Computing MAX */ +#line 23116 "" r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f; +#line 23116 "" ihorn = dmax(r__1,r__2); +#line 23117 "" } else if (ibit == 29 || ibit == 30) { /* coda or new segno, no height tweak */ +#line 23121 "" ihorn = *ncm + 5; +#line 23122 "" } else { /* Computing MAX */ +#line 23123 "" i__1 = *nolev + 2, i__2 = *ncm + 5; +#line 23123 "" ihorn = max(i__1,i__2); +#line 23124 "" } +#line 23125 "" ioff = 0; +#line 23126 "" iclracc = 0; /* Begin routine to set name. Bits 0-13: (stmgx+Tupf._) */ /* 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n */ +#line 23131 "" if (bit_test(iornt,2)) { /* Writing concatenation */ +#line 23132 "" i__3[0] = 1, a__1[0] = sq; +#line 23132 "" i__3[1] = 5, a__1[1] = "shake"; +#line 23132 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23133 "" lnote = 6; +#line 23134 "" } else if (bit_test(iornt,3)) { /* Writing concatenation */ +#line 23135 "" i__3[0] = 1, a__1[0] = sq; +#line 23135 "" i__3[1] = 7, a__1[1] = "mordent"; +#line 23135 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23136 "" lnote = 8; +#line 23137 "" } else if (bit_test(iornt,1)) { /* Writing concatenation */ +#line 23138 "" i__3[0] = 1, a__1[0] = sq; +#line 23138 "" i__3[1] = 3, a__1[1] = "mtr"; +#line 23138 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23139 "" lnote = 4; +#line 23140 "" } else if (bit_test(iornt,5)) { /* Writing concatenation */ +#line 23141 "" i__3[0] = 1, a__1[0] = sq; +#line 23141 "" i__3[1] = 3, a__1[1] = "xtr"; +#line 23141 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23142 "" lnote = 4; +#line 23143 "" } else if (bit_test(iornt,6)) { /* Writing concatenation */ +#line 23144 "" i__3[0] = 1, a__1[0] = sq; +#line 23144 "" i__3[1] = 3, a__1[1] = "ptr"; +#line 23144 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23145 "" lnote = 4; +#line 23146 "" } else if (bit_test(iornt,13)) { /* Writing concatenation */ +#line 23147 "" i__3[0] = 1, a__1[0] = sq; +#line 23147 "" i__3[1] = 3, a__1[1] = "rpn"; +#line 23147 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23148 "" lnote = 4; +#line 23149 "" } else if (bit_test(iornt,0)) { /* Writing concatenation */ +#line 23150 "" i__3[0] = 1, a__1[0] = sq; +#line 23150 "" i__3[1] = 3, a__1[1] = "lpn"; +#line 23150 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23151 "" lnote = 4; +#line 23152 "" } else if (bit_test(iornt,12)) { /* Writing concatenation */ +#line 23153 "" i__4[0] = 1, a__2[0] = sq; +#line 23153 "" i__4[1] = 1, a__2[1] = ulpzq; +#line 23153 "" i__4[2] = 2, a__2[2] = "st"; +#line 23153 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 23154 "" lnote = 4; +#line 23155 "" } else if (bit_test(iornt,11)) { /* Writing concatenation */ +#line 23156 "" i__4[0] = 1, a__2[0] = sq; +#line 23156 "" i__4[1] = 1, a__2[1] = ulpzq; +#line 23156 "" i__4[2] = 2, a__2[2] = "pz"; +#line 23156 "" s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 23157 "" lnote = 4; +#line 23158 "" } else if (bit_test(iornt,8)) { /* Writing concatenation */ +#line 23159 "" i__3[0] = 1, a__1[0] = sq; +#line 23159 "" i__3[1] = 3, a__1[1] = "upz"; +#line 23159 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23160 "" lnote = 4; +#line 23161 "" ioff = -2; +#line 23162 "" } else if (bit_test(iornt,9)) { /* Writing concatenation */ +#line 23163 "" i__3[0] = 1, a__1[0] = sq; +#line 23163 "" i__3[1] = 4, a__1[1] = "uppz"; +#line 23163 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23164 "" lnote = 5; +#line 23165 "" ioff = -2; +#line 23166 "" } else if (bit_test(iornt,10)) { +#line 23167 "" if (*nodur < 48) { /* Writing concatenation */ +#line 23168 "" i__3[0] = 1, a__1[0] = sq; +#line 23168 "" i__3[1] = 9, a__1[1] = "fermataup"; +#line 23168 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23169 "" } else { /* Writing concatenation */ +#line 23170 "" i__3[0] = 1, a__1[0] = sq; +#line 23170 "" i__3[1] = 9, a__1[1] = "Fermataup"; +#line 23170 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23171 "" } +#line 23172 "" lnote = 10; +#line 23173 "" ioff = -2; +#line 23174 "" } else if (bit_test(iornt,14)) { +#line 23175 "" if (*nodur < 48) { /* Writing concatenation */ +#line 23176 "" i__3[0] = 1, a__1[0] = sq; +#line 23176 "" i__3[1] = 11, a__1[1] = "fermatadown"; +#line 23176 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23177 "" } else { /* Writing concatenation */ +#line 23178 "" i__3[0] = 1, a__1[0] = sq; +#line 23178 "" i__3[1] = 11, a__1[1] = "Fermatadown"; +#line 23178 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23179 "" } +#line 23180 "" lnote = 12; +#line 23181 "" } else if (bit_test(iornt,21)) { /* "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 */ +#line 23185 "" if (bit_test(*iornq,16)) { /* Writing concatenation */ +#line 23186 "" i__3[0] = 1, a__1[0] = sq; +#line 23186 "" i__3[1] = 6, a__1[1] = "qsharp"; +#line 23186 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23187 "" lnote = 7; +#line 23188 "" ioff = 2; +#line 23189 "" *iornq = bit_clear(*iornq,16); +#line 23190 "" iclracc = 16; +#line 23191 "" } else if (bit_test(*iornq,17)) { /* Writing concatenation */ +#line 23192 "" i__3[0] = 1, a__1[0] = sq; +#line 23192 "" i__3[1] = 5, a__1[1] = "qflat"; +#line 23192 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23193 "" lnote = 6; +#line 23194 "" ioff = 1; +#line 23195 "" *iornq = bit_clear(*iornq,17); +#line 23196 "" iclracc = 17; +#line 23197 "" } else if (bit_test(*iornq,18)) { /* Writing concatenation */ +#line 23198 "" i__3[0] = 1, a__1[0] = sq; +#line 23198 "" i__3[1] = 4, a__1[1] = "qnat"; +#line 23198 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23199 "" lnote = 5; +#line 23200 "" ioff = 2; +#line 23201 "" *iornq = bit_clear(*iornq,18); +#line 23202 "" iclracc = 18; +#line 23203 "" } else { /* Writing concatenation */ +#line 23204 "" i__3[0] = 1, a__1[0] = sq; +#line 23204 "" i__3[1] = 5, a__1[1] = "qedit"; +#line 23204 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23205 "" lnote = 6; +#line 23206 "" ioff = 0; +#line 23207 "" } +#line 23208 "" } else if (bit_test(iornt,16)) { /* Writing concatenation */ +#line 23209 "" i__3[0] = 1, a__1[0] = sq; +#line 23209 "" i__3[1] = 6, a__1[1] = "esharp"; +#line 23209 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23210 "" lnote = 7; +#line 23211 "" ioff = 2; +#line 23212 "" } else if (bit_test(iornt,17)) { /* Writing concatenation */ +#line 23213 "" i__3[0] = 1, a__1[0] = sq; +#line 23213 "" i__3[1] = 5, a__1[1] = "eflat"; +#line 23213 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23214 "" lnote = 6; +#line 23215 "" ioff = 1; +#line 23216 "" } else if (bit_test(iornt,18)) { /* Writing concatenation */ +#line 23217 "" i__3[0] = 1, a__1[0] = sq; +#line 23217 "" i__3[1] = 4, a__1[1] = "enat"; +#line 23217 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23218 "" lnote = 5; +#line 23219 "" ioff = 2; +#line 23220 "" } else if (bit_test(iornt,19)) { /* Writing concatenation */ +#line 23221 "" i__3[0] = 1, a__1[0] = sq; +#line 23221 "" i__3[1] = 3, a__1[1] = "usf"; +#line 23221 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23222 "" lnote = 4; +#line 23223 "" ioff = -2; +#line 23224 "" } else if (bit_test(iornt,20)) { /* Writing concatenation */ +#line 23225 "" i__3[0] = 1, a__1[0] = sq; +#line 23225 "" i__3[1] = 4, a__1[1] = "usfz"; +#line 23225 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23226 "" lnote = 5; +#line 23227 "" ioff = -2; +#line 23228 "" } else if (bit_test(iornt,29)) { /* Writing concatenation */ +#line 23229 "" i__3[0] = 1, a__1[0] = sq; +#line 23229 "" i__3[1] = 5, a__1[1] = "ccoda"; +#line 23229 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23230 "" lnote = 6; +#line 23231 "" } else if (bit_test(iornt,30)) { /* Writing concatenation */ +#line 23232 "" i__3[0] = 1, a__1[0] = sq; +#line 23232 "" i__3[1] = 6, a__1[1] = "ssegno"; +#line 23232 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23233 "" lnote = 7; +#line 23234 "" } +#line 23235 "" iudorn = 0; /* User-defined level shift of ornament from default? */ +#line 23239 "" if (bit_test(*iornq,25)) { /* Find which (if any) element of kudorn has the shift. */ +#line 23243 "" i__1 = comtrill_1.nudorn; +#line 23243 "" for (iudorn = 1; iudorn <= i__1; ++iudorn) { /* if (ibit .lt. 21) then */ /* if (ibit.lt.21 .or. ibit.eq.29) then */ +#line 23246 "" if (ibit < 21 || ibit == 29 || ibit == 30) { +#line 23247 "" ibitt = ibit; /* Could have oes, but not oe? or oes? */ +#line 23251 "" } else if (iclracc > 0) { /* Earlier cleared edit. accid, meaning it was oes? */ +#line 23255 "" ibitt = iclracc + 6; +#line 23256 "" } else { +#line 23257 "" ibitt = 21; +#line 23258 "" } +#line 23259 "" ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19); /* if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */ +#line 23261 "" if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx == comivxudorn_1.ivxudorn[iudorn - 1]) { +#line 23261 "" goto L4; +#line 23261 "" } +#line 23263 "" /* L3: */ +#line 23263 "" } /* Nothing shifted on this note; exit this if block */ +#line 23267 "" iudorn = 0; +#line 23268 "" goto L5; +#line 23269 "" L4: +#line 23270 "" ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25) ) - 32; +#line 23271 "" if (ibit == 19 && ioffinc < -7) { /* Convert usf to lsf. The reason has to do with positioning being impossile */ /* for some mysterious reason when you drop \usf below the staff */ /* Writing concatenation */ +#line 23276 "" i__3[0] = 1, a__1[0] = sq; +#line 23276 "" i__3[1] = 3, a__1[1] = "lsf"; +#line 23276 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23277 "" ioffinc += 6; +#line 23278 "" } +#line 23279 "" ioff += ioffinc; +#line 23280 "" } +#line 23281 "" L5: /* Shift level to avoid slur. Conditions are */ @@ -35275,88 +57129,149 @@ L5: /* 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */ /* 5. islhgt+3 >= height already computed. */ +#line 23290 "" if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) { +#line 23290 "" i__1 = *islhgt + 3; +#line 23290 "" ioff += i_dim(&i__1, &ihorn); +#line 23290 "" } +#line 23293 "" i__1 = ihorn + ioff; +#line 23293 "" notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8); +#line 23294 "" if (lnoten == 1) { +#line 23294 "" addblank_(noteq, &lnoten, (ftnlen)8); +#line 23294 "" } +#line 23295 "" if ((iornt & 32896) > 0) { /* T-trill or trill w/o "tr" */ +#line 23299 "" dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, ( ftnlen)79); +#line 23300 "" } else { /* Writing concatenation */ +#line 23301 "" i__3[0] = lnote, a__1[0] = notexq; +#line 23301 "" i__3[1] = lnoten, a__1[1] = noteq; +#line 23301 "" s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 23302 "" lnote += lnoten; +#line 23303 "" } +#line 23304 "" if (iudorn > 0) { +#line 23305 "" if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) { /* Horizontal shift */ +#line 23309 "" lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]); +#line 23310 "" ici__1.icierr = 0; +#line 23310 "" ici__1.icirnum = 1; +#line 23310 "" ici__1.icirlen = lform; +#line 23310 "" ici__1.iciunit = noteq; /* Writing concatenation */ +#line 23310 "" i__4[0] = 2, a__2[0] = "(f"; +#line 23310 "" i__1 = lform + 48; +#line 23310 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 23310 "" i__4[1] = 1, a__2[1] = ch__1; +#line 23310 "" i__4[2] = 3, a__2[2] = ".1)"; +#line 23310 "" ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6), ch__2); +#line 23310 "" s_wsfi(&ici__1); +#line 23310 "" do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen) sizeof(real)); +#line 23310 "" e_wsfi(); /* Writing concatenation */ +#line 23312 "" i__5[0] = 1, a__3[0] = sq; +#line 23312 "" i__5[1] = 8, a__3[1] = "roffset{"; +#line 23312 "" i__5[2] = lform, a__3[2] = noteq; +#line 23312 "" i__5[3] = 2, a__3[3] = "}{"; +#line 23312 "" i__5[4] = lnote, a__3[4] = notexq; +#line 23312 "" i__5[5] = 1, a__3[5] = "}"; +#line 23312 "" s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79); +#line 23314 "" lnote = lnote + lform + 12; +#line 23315 "" comtrill_1.ornhshft[iudorn - 1] = 0.f; +#line 23316 "" comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[ iudorn - 1],31); +#line 23317 "" } +#line 23318 "" } /* Zero out the bit for ornament just dealt with. */ +#line 23322 "" *iornq = bit_clear(*iornq,ibit); +#line 23323 "" if (*lout == 0) { +#line 23324 "" s_copy(outq, notexq, (ftnlen)79, lnote); +#line 23325 "" } else { /* Writing concatenation */ +#line 23326 "" i__3[0] = *lout, a__1[0] = outq; +#line 23326 "" i__3[1] = lnote, a__1[1] = notexq; +#line 23326 "" s_cat(outq, a__1, i__3, &c__2, (ftnlen)79); +#line 23327 "" } +#line 23328 "" *lout += lnote; /* Check bits 0-21, go back if any are still set */ /* If bit 29 or 30 had been set, would have been used first time thru, */ /* and you wouldn't use both coda and segno on same note */ +#line 23334 "" if ((*iornq & 4194303) > 0) { +#line 23334 "" goto L2; +#line 23334 "" } +#line 23335 "" if (usehornb) { +#line 23335 "" ++nornb[*ivx]; +#line 23335 "" } +#line 23336 "" return 0; } /* putorn_ */ @@ -35385,52 +57300,91 @@ L5: ftnlen, ftnlen); static char notexq[80]; +#line 23344 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 23344 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; /* Start user-defined offsets X(...): or X(...)S */ +#line 23348 "" if (*onoff) { +#line 23348 "" ++comudsp_1.nudoff[*ivx - 1]; +#line 23348 "" } /* Xoff is in pts. Round off to nearest .1. Will use at end of shift. */ +#line 23352 "" xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25]; +#line 23353 "" r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f; +#line 23353 "" xoff = r_sign(&r__1, &xoff); +#line 23354 "" if (! (*onoff)) { +#line 23354 "" xoff = -xoff; +#line 23354 "" } +#line 23355 "" if (xoff < -9.95f) { +#line 23356 "" ifmt = 5; +#line 23357 "" } else if (xoff < -.95f || xoff > 9.95f) { +#line 23358 "" ifmt = 4; +#line 23359 "" } else { +#line 23360 "" ifmt = 3; +#line 23361 "" } +#line 23362 "" ici__1.icierr = 0; +#line 23362 "" ici__1.icirnum = 1; +#line 23362 "" ici__1.icirlen = 80; +#line 23362 "" ici__1.iciunit = notexq; /* Writing concatenation */ +#line 23362 "" i__1[0] = 2, a__1[0] = "(f"; +#line 23362 "" i__2 = ifmt + 48; +#line 23362 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 23362 "" i__1[1] = 1, a__1[1] = ch__1; +#line 23362 "" i__1[2] = 3, a__1[2] = ".1)"; +#line 23362 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 23362 "" s_wsfi(&ici__1); +#line 23362 "" do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real)); +#line 23362 "" e_wsfi(); /* Writing concatenation */ +#line 23363 "" i__3[0] = 1, a__2[0] = sq; +#line 23363 "" i__3[1] = 4, a__2[1] = "off{"; +#line 23363 "" i__3[2] = ifmt, a__2[2] = notexq; +#line 23363 "" i__3[3] = 3, a__2[3] = "pt}"; +#line 23363 "" s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88); +#line 23363 "" i__2 = ifmt + 8; +#line 23363 "" addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80); +#line 23365 "" return 0; } /* putshft_ */ @@ -35463,9 +57417,9 @@ L5: static integer lenline; /* Fortran I/O blocks */ - static cilist io___1592 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1595 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1598 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1640 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1643 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1646 = { 0, 11, 0, "(a)", 0 }; @@ -35473,192 +57427,352 @@ L5: /* Actual titles only allowed on p.1. (set by headlog). */ /* 3/18/01: The above comment is probably bogus...can use Tt on later pages. */ +#line 23384 "" /* Parameter adjustments */ +#line 23384 "" --sepsymq; +#line 23384 "" +#line 23384 "" /* Function Body */ /* Writing concatenation */ +#line 23384 "" i__1[0] = 1, a__1[0] = sq; +#line 23384 "" i__1[1] = 6, a__1[1] = "znotes"; +#line 23384 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23385 "" lenline = 7; +#line 23386 "" i__2 = *nv - 1; +#line 23386 "" for (iv = 1; iv <= i__2; ++iv) { /* Writing concatenation */ +#line 23387 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23387 "" i__1[1] = 1, a__1[1] = sepsymq + iv; +#line 23387 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23388 "" ++lenline; +#line 23389 "" /* L22: */ +#line 23389 "" } /* Writing concatenation */ +#line 23390 "" i__3[0] = lenline, a__2[0] = notexq; +#line 23390 "" i__3[1] = 1, a__2[1] = sq; +#line 23390 "" i__3[2] = 10, a__2[2] = "zcharnote{"; +#line 23390 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); +#line 23391 "" lenline += 11; +#line 23392 "" if (! comtitl_1.headlog) { +#line 23393 "" comtitl_1.inhead = *inhnoh; +#line 23394 "" } +#line 23395 "" if (*vshrink && comlast_1.usevshrink) { +#line 23396 "" comtitl_1.inhead = 16; +#line 23397 "" } +#line 23398 "" r__1 = comtitl_1.inhead + .01f; +#line 23398 "" ndig = (integer) r_lg10(&r__1) + 1; +#line 23399 "" i__2 = lenline; +#line 23399 "" ici__1.icierr = 0; +#line 23399 "" ici__1.icirnum = 1; +#line 23399 "" ici__1.icirlen = lenline + ndig + 10 - i__2; +#line 23399 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 23399 "" i__3[0] = 2, a__2[0] = "(i"; +#line 23399 "" i__4 = ndig + 48; +#line 23399 "" chax_(ch__2, (ftnlen)1, &i__4); +#line 23399 "" i__3[1] = 1, a__2[1] = ch__2; +#line 23399 "" i__3[2] = 5, a__2[2] = ",a10)"; +#line 23399 "" ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1); +#line 23399 "" s_wsfi(&ici__1); +#line 23399 "" do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 23399 "" i__5[0] = 2, a__3[0] = "}{"; +#line 23399 "" i__5[1] = 1, a__3[1] = sq; +#line 23399 "" i__5[2] = 7, a__3[2] = "titles{"; +#line 23399 "" s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10); +#line 23399 "" do_fio(&c__1, ch__3, (ftnlen)10); +#line 23399 "" e_wsfi(); +#line 23401 "" lenline = lenline + ndig + 10; /* Vertical skip at top of page (\Il) = etatop*glueil. Needed whether */ /* headers are present or not. */ +#line 23406 "" glueil = *xnsttop / *etatop; +#line 23407 "" vskil = *etatop * glueil; +#line 23408 "" if (*vshrink && comlast_1.usevshrink) { +#line 23408 "" vskil = 2.f; +#line 23408 "" } +#line 23409 "" writflot_(&vskil, notexq, &lenline, (ftnlen)127); +#line 23410 "" if (! comtitl_1.headlog) { +#line 23411 "" if (comlast_1.islast) { - s_wsfe(&io___1592); +#line 23411 "" + s_wsfe(&io___1640); /* Writing concatenation */ +#line 23411 "" i__6[0] = lenline, a__4[0] = notexq; +#line 23411 "" i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}"; +#line 23411 "" i__6[2] = 1, a__4[2] = sq; +#line 23411 "" i__6[3] = 3, a__4[3] = "en%"; +#line 23411 "" s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148); +#line 23411 "" do_fio(&c__1, ch__4, lenline + 21); +#line 23411 "" e_wsfe(); +#line 23411 "" } +#line 23413 "" } else { /* Writing concatenation */ +#line 23414 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23414 "" i__1[1] = 2, a__1[1] = "}{"; +#line 23414 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23415 "" lenline += 2; +#line 23416 "" lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120); +#line 23417 "" if (lcq > 0) { +#line 23418 "" xitil = *etait * glueil; +#line 23419 "" if (*vshrink && comlast_1.usevshrink) { +#line 23419 "" xitil = 2.f; +#line 23419 "" } /* Writing concatenation */ +#line 23420 "" i__3[0] = lenline, a__2[0] = notexq; +#line 23420 "" i__3[1] = lcq, a__2[1] = comtitl_1.instrq; +#line 23420 "" i__3[2] = 2, a__2[2] = "}{"; +#line 23420 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); /* Null out instrument once used */ +#line 23424 "" s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1); +#line 23425 "" lenline = lenline + lcq + 2; +#line 23426 "" writflot_(&xitil, notexq, &lenline, (ftnlen)127); +#line 23427 "" } else { /* Writing concatenation */ +#line 23428 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23428 "" i__1[1] = 3, a__1[1] = "}{0"; +#line 23428 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23429 "" lenline += 3; +#line 23430 "" } +#line 23431 "" if (comlast_1.islast) { - s_wsfe(&io___1595); +#line 23431 "" + s_wsfe(&io___1643); /* Writing concatenation */ +#line 23431 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23431 "" i__1[1] = 2, a__1[1] = "}%"; +#line 23431 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129); +#line 23431 "" do_fio(&c__1, ch__5, lenline + 2); +#line 23431 "" e_wsfe(); +#line 23431 "" } +#line 23432 "" s_copy(notexq, "{", (ftnlen)127, (ftnlen)1); +#line 23433 "" lenline = 1; +#line 23434 "" lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120); +#line 23435 "" if (lcq > 0) { /* Writing concatenation */ +#line 23436 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23436 "" i__1[1] = lcq, a__1[1] = comtitl_1.titleq; +#line 23436 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23437 "" lenline += lcq; +#line 23438 "" } else { +#line 23439 "" printl_(" ", (ftnlen)1); +#line 23440 "" printl_("WARNING", (ftnlen)7); +#line 23441 "" printl_(" In a title block, you have specified instrument and/or" , (ftnlen)56); +#line 23443 "" printl_(" composer but no title for the piece.", (ftnlen)38); +#line 23445 "" } /* Writing concatenation */ +#line 23446 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23446 "" i__1[1] = 2, a__1[1] = "}{"; +#line 23446 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23447 "" lenline += 2; +#line 23448 "" xtcil = *etatc * glueil; +#line 23449 "" lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120); +#line 23450 "" if (lcq == 0) { +#line 23450 "" xtcil *= 2; +#line 23450 "" } +#line 23451 "" if (*vshrink && comlast_1.usevshrink) { +#line 23451 "" xtcil = 2.f; +#line 23451 "" } +#line 23452 "" writflot_(&xtcil, notexq, &lenline, (ftnlen)127); /* Writing concatenation */ +#line 23453 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23453 "" i__1[1] = 2, a__1[1] = "}{"; +#line 23453 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23454 "" lenline += 2; +#line 23455 "" if (lcq > 0) { /* Writing concatenation */ +#line 23456 "" i__3[0] = lenline, a__2[0] = notexq; +#line 23456 "" i__3[1] = lcq, a__2[1] = comtitl_1.compoq; +#line 23456 "" i__3[2] = 2, a__2[2] = "}{"; +#line 23456 "" s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); +#line 23457 "" lenline = lenline + 2 + lcq; /* Null out compoq so it does not get written later */ +#line 23461 "" s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1); +#line 23462 "" xcsil = *etacs1 * glueil; +#line 23463 "" if (*vshrink && comlast_1.usevshrink) { +#line 23463 "" xcsil = 2.f; +#line 23463 "" } +#line 23464 "" writflot_(&xcsil, notexq, &lenline, (ftnlen)127); +#line 23465 "" } else { /* Writing concatenation */ +#line 23466 "" i__1[0] = lenline, a__1[0] = notexq; +#line 23466 "" i__1[1] = 3, a__1[1] = "}{0"; +#line 23466 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 23467 "" lenline += 3; +#line 23468 "" } +#line 23469 "" if (comlast_1.islast) { - s_wsfe(&io___1598); +#line 23469 "" + s_wsfe(&io___1646); /* Writing concatenation */ +#line 23469 "" i__6[0] = lenline, a__4[0] = notexq; +#line 23469 "" i__6[1] = 2, a__4[1] = "}}"; +#line 23469 "" i__6[2] = 1, a__4[2] = sq; +#line 23469 "" i__6[3] = 3, a__4[3] = "en%"; +#line 23469 "" s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133); +#line 23469 "" do_fio(&c__1, ch__6, lenline + 6); +#line 23469 "" e_wsfe(); +#line 23469 "" } +#line 23470 "" comtitl_1.headlog = FALSE_; +#line 23471 "" } +#line 23472 "" return 0; } /* puttitle_ */ @@ -35694,120 +57808,218 @@ L5: /* Places digit for xtuplet. */ +#line 23485 "" if (*iflop != 0 && *multb > 0) { /* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */ +#line 23489 "" *eloff -= *iud * .5f * *wheadpt / *poenom; /* Number goes on beam side, must use beam parameters to set pos'n */ +#line 23493 "" *nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8); +#line 23494 "" if (*multb >= 2) { +#line 23494 "" *nlnum += *iup; +#line 23494 "" } +#line 23495 "" } else { +#line 23496 "" r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11; +#line 23496 "" *nlnum = i_nint(&r__1); +#line 23497 "" } +#line 23498 "" if (! bit_test(*islur,31)) { /* Only print number when wanted. First check vert, horiz offset */ -/* if (btest(irest,1)) nlnum = nlnum+iand(31,ishft(irest,-2))-16 */ +#line 23502 "" if (bit_test(*irest,1)) { +#line 23502 "" *nlnum = *nlnum + igetbits_(mult, &c__8, &c__16) - 64; +#line 23502 "" } +#line 23503 "" if (bit_test(*irest,7)) { +#line 23503 "" *eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * * wheadpt / *poenom; +#line 23503 "" } +#line 23505 "" if (! (*usexnumt)) { /* Writing concatenation */ +#line 23506 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 23506 "" i__1[0] = 1, a__1[0] = ch__1; +#line 23506 "" i__1[1] = 5, a__1[1] = "xnum{"; +#line 23506 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 23507 "" *lnote = 10; +#line 23508 "" istrtn = 7; +#line 23509 "" } else { /* Writing concatenation */ +#line 23510 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 23510 "" i__1[0] = 1, a__1[0] = ch__1; +#line 23510 "" i__1[1] = 6, a__1[1] = "xnumt{"; +#line 23510 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 23511 "" *lnote = 11; +#line 23512 "" istrtn = 8; +#line 23513 "" } +#line 23514 "" if (*eloff < .995f) { +#line 23515 "" ici__1.icierr = 0; +#line 23515 "" ici__1.icirnum = 1; +#line 23515 "" ici__1.icirlen = 4; +#line 23515 "" ici__1.iciunit = notexq + (istrtn - 1); +#line 23515 "" ici__1.icifmt = "(i1,f3.2)"; +#line 23515 "" s_wsfi(&ici__1); +#line 23515 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 23515 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 23515 "" e_wsfi(); +#line 23516 "" } else if (*eloff < 9.995f) { +#line 23517 "" ici__1.icierr = 0; +#line 23517 "" ici__1.icirnum = 1; +#line 23517 "" ici__1.icirlen = 4; +#line 23517 "" ici__1.iciunit = notexq + (istrtn - 1); +#line 23517 "" ici__1.icifmt = "(f4.2)"; +#line 23517 "" s_wsfi(&ici__1); +#line 23517 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 23517 "" e_wsfi(); +#line 23518 "" } else { +#line 23519 "" ici__1.icierr = 0; +#line 23519 "" ici__1.icirnum = 1; +#line 23519 "" ici__1.icirlen = 5; +#line 23519 "" ici__1.iciunit = notexq + (istrtn - 1); +#line 23519 "" ici__1.icifmt = "(f5.2)"; +#line 23519 "" s_wsfi(&ici__1); +#line 23519 "" do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 23519 "" e_wsfi(); +#line 23520 "" ++(*lnote); +#line 23521 "" } +#line 23522 "" notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8); /* Writing concatenation */ +#line 23523 "" i__2[0] = *lnote, a__2[0] = notexq; +#line 23523 "" i__2[1] = 1, a__2[1] = "}"; +#line 23523 "" i__2[2] = lnoten, a__2[2] = noteq; +#line 23523 "" s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); +#line 23524 "" *lnote = *lnote + 1 + lnoten; +#line 23525 "" if (*ntupv < 10) { +#line 23526 "" i__3 = *lnote; +#line 23526 "" ici__1.icierr = 0; +#line 23526 "" ici__1.icirnum = 1; +#line 23526 "" ici__1.icirlen = *lnote + 1 - i__3; +#line 23526 "" ici__1.iciunit = notexq + i__3; +#line 23526 "" ici__1.icifmt = "(i1)"; +#line 23526 "" s_wsfi(&ici__1); +#line 23526 "" do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); +#line 23526 "" e_wsfi(); +#line 23527 "" ++(*lnote); +#line 23528 "" } else { /* Writing concatenation */ +#line 23529 "" i__1[0] = *lnote, a__1[0] = notexq; +#line 23529 "" i__1[1] = 1, a__1[1] = "{"; +#line 23529 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 23530 "" i__3 = *lnote + 1; +#line 23530 "" ici__1.icierr = 0; +#line 23530 "" ici__1.icirnum = 1; +#line 23530 "" ici__1.icirlen = *lnote + 3 - i__3; +#line 23530 "" ici__1.iciunit = notexq + i__3; +#line 23530 "" ici__1.icifmt = "(i2)"; +#line 23530 "" s_wsfi(&ici__1); +#line 23530 "" do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); +#line 23530 "" e_wsfi(); /* Writing concatenation */ +#line 23531 "" i__1[0] = *lnote + 3, a__1[0] = notexq; +#line 23531 "" i__1[1] = 1, a__1[1] = "}"; +#line 23531 "" s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 23532 "" *lnote += 4; +#line 23533 "" } +#line 23534 "" } +#line 23535 "" return 0; } /* putxtn_ */ @@ -35821,62 +58033,97 @@ L5: static integer ip1, ip2; extern /* Subroutine */ int getbuf_(char *, ftnlen); +#line 23549 "" if (! commac_1.mplay) { +#line 23550 "" if (inbuff_1.ilbuf > inbuff_1.nlbuf) { +#line 23550 "" goto L999; +#line 23550 "" } +#line 23551 "" getbuf_(string, string_len); +#line 23552 "" return 0; +#line 23553 "" L999: +#line 23553 "" *lastchar = TRUE_; +#line 23554 "" return 0; +#line 23555 "" } else { /* Play a macro. Set pointer to first character needed in buffer */ +#line 23559 "" if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) { /* Getting first line of macro */ +#line 23563 "" ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1]; +#line 23564 "" c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1]; +#line 23565 "" } else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) { /* Beyond first line of macro. Advance line-start pointer. */ +#line 23569 "" c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2]; +#line 23570 "" ip1 = c1ommac_1.iplmac + 1; +#line 23571 "" } else { /* Beyond last line of macro. Terminate it! */ +#line 23575 "" commac_1.mplay = FALSE_; +#line 23576 "" commac_1.endmac = TRUE_; +#line 23577 "" return 0; +#line 23578 "" } +#line 23579 "" if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) { /* Getting last line of macro. */ +#line 23583 "" ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1]; +#line 23584 "" } else { /* Getting line before last line of macro. */ +#line 23588 "" ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1]; +#line 23589 "" } +#line 23590 "" if (ip2 >= ip1) { +#line 23591 "" s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1 - 1)); +#line 23592 "" } else { /* Kluge for when macro start is on a line by itself */ +#line 23596 "" s_copy(string, " ", string_len, (ftnlen)1); +#line 23597 "" } +#line 23598 "" ++c1ommac_1.ilmac; +#line 23599 "" return 0; +#line 23600 "" } +#line 23601 "" return 0; } /* read10_ */ @@ -35905,7 +58152,7 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen getchar_(char *, integer *, char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1607 = { 0, 6, 0, 0, 0 }; + static cilist io___1655 = { 0, 6, 0, 0, 0 }; @@ -35913,71 +58160,123 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen /* file 10 (jobname.pmx) and increments nline if needed, passes over */ /* comment lines */ +#line 23610 "" L4: +#line 23610 "" if (*iccount == 128) { +#line 23611 "" L1: +#line 23611 "" getbuf_(lineq, (ftnlen)128); +#line 23612 "" ++(*nline); +#line 23613 "" if (*(unsigned char *)lineq == '%') { +#line 23613 "" goto L1; +#line 23613 "" } +#line 23614 "" *iccount = 0; +#line 23615 "" } +#line 23616 "" ++(*iccount); /* Find next non-blank or end of line */ +#line 23620 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { +#line 23621 "" if (*(unsigned char *)&lineq[*iccount - 1] != ' ') { +#line 23621 "" goto L3; +#line 23621 "" } +#line 23622 "" /* L2: */ +#line 23622 "" } /* If here, need to get a new line */ +#line 23626 "" *iccount = 128; +#line 23627 "" goto L4; +#line 23628 "" L3: /* iccount now points to start of number to read */ +#line 23632 "" i1 = *iccount; +#line 23633 "" L5: +#line 23633 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar increments iccount, then reads a character. */ +#line 23637 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 23637 "" goto L5; +#line 23637 "" } +#line 23638 "" i2 = *iccount - 1; +#line 23639 "" if (i2 < i1) { - s_wsle(&io___1607); +#line 23640 "" + s_wsle(&io___1655); /* Writing concatenation */ +#line 23640 "" i__1[0] = 7, a__1[0] = "Found \""; +#line 23640 "" i__1[1] = 1, a__1[1] = durq; +#line 23640 "" i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 23640 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 23640 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 23640 "" e_wsle(); +#line 23641 "" stop1_(); +#line 23642 "" } +#line 23643 "" icf = i2 - i1 + 49; +#line 23644 "" ici__1.icierr = 0; +#line 23644 "" ici__1.iciend = 0; +#line 23644 "" ici__1.icirnum = 1; +#line 23644 "" ici__1.icirlen = i2 - (i1 - 1); +#line 23644 "" ici__1.iciunit = lineq + (i1 - 1); /* Writing concatenation */ +#line 23644 "" i__1[0] = 2, a__1[0] = "(f"; +#line 23644 "" chax_(ch__3, (ftnlen)1, &icf); +#line 23644 "" i__1[1] = 1, a__1[1] = ch__3; +#line 23644 "" i__1[2] = 3, a__1[2] = ".0)"; +#line 23644 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 23644 "" s_rsfi(&ici__1); +#line 23644 "" do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); +#line 23644 "" e_rsfi(); +#line 23645 "" return ret_val; } /* readin_ */ @@ -36003,96 +58302,160 @@ L5: extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, ftnlen); +#line 23650 "" i__1 = *iccount; +#line 23650 "" if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) { /* No slashes, so use old method */ +#line 23654 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23655 "" if (*(unsigned char *)durq == '-') { /* Negative numerator is used only to printed; signals vertical slash */ +#line 23659 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23660 "" *mtrnum = -(*(unsigned char *)durq - 48); +#line 23661 "" } else if (*(unsigned char *)durq == 'o') { /* Numerator is EXACTLY 1 */ +#line 23665 "" *mtrnum = 1; +#line 23666 "" } else { +#line 23667 "" *mtrnum = *(unsigned char *)durq - 48; +#line 23668 "" if (*mtrnum == 1) { /* Numerator is >9 */ +#line 23672 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23673 "" *mtrnum = *(unsigned char *)durq - 38; +#line 23674 "" } +#line 23675 "" } +#line 23676 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23677 "" if (*(unsigned char *)durq == 'o') { +#line 23678 "" *mtrden = 1; +#line 23679 "" } else { +#line 23680 "" *mtrden = *(unsigned char *)durq - 48; +#line 23681 "" if (*mtrden == 1) { +#line 23682 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23683 "" *mtrden = *(unsigned char *)durq - 38; +#line 23684 "" } +#line 23685 "" } +#line 23686 "" } else { /* Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */ +#line 23690 "" ++(*iccount); +#line 23691 "" ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), ( ftnlen)1); +#line 23692 "" ici__1.icierr = 0; +#line 23692 "" ici__1.iciend = 0; +#line 23692 "" ici__1.icirnum = 1; +#line 23692 "" ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); +#line 23692 "" ici__1.iciunit = lineq + (*iccount - 1); /* Writing concatenation */ +#line 23692 "" i__2[0] = 2, a__1[0] = "(i"; +#line 23692 "" i__1 = ns + 47; +#line 23692 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 23692 "" i__2[1] = 1, a__1[1] = ch__2; +#line 23692 "" i__2[2] = 1, a__1[2] = ")"; +#line 23692 "" ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 23692 "" s_rsfi(&ici__1); +#line 23692 "" do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer)); +#line 23692 "" e_rsfi(); /* Reset iccount to start of second integer */ +#line 23696 "" *iccount += ns; /* There must be either a slash or a blank at pos'n 2 or 3 */ +#line 23700 "" ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1); +#line 23701 "" if (ns == 0) { +#line 23701 "" ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1); +#line 23701 "" } +#line 23702 "" ici__1.icierr = 0; +#line 23702 "" ici__1.iciend = 0; +#line 23702 "" ici__1.icirnum = 1; +#line 23702 "" ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); +#line 23702 "" ici__1.iciunit = lineq + (*iccount - 1); /* Writing concatenation */ +#line 23702 "" i__2[0] = 2, a__1[0] = "(i"; +#line 23702 "" i__1 = ns + 47; +#line 23702 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 23702 "" i__2[1] = 1, a__1[1] = ch__2; +#line 23702 "" i__2[2] = 1, a__1[2] = ")"; +#line 23702 "" ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 23702 "" s_rsfi(&ici__1); +#line 23702 "" do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer)); +#line 23702 "" e_rsfi(); /* Set iccount to last character used */ +#line 23706 "" *iccount = *iccount + ns - 1; +#line 23707 "" } +#line 23708 "" return 0; } /* readmeter_ */ @@ -36119,7 +58482,7 @@ L5: char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1613 = { 0, 6, 0, 0, 0 }; + static cilist io___1661 = { 0, 6, 0, 0, 0 }; @@ -36128,43 +58491,78 @@ L5: /* call this routine *after* detecting a number or decimal. */ /* On exit, durq is next character after end of number. */ +#line 23719 "" i1 = *iccount; +#line 23720 "" L1: +#line 23720 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23721 "" if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { +#line 23721 "" goto L1; +#line 23721 "" } +#line 23722 "" i2 = *iccount - 1; +#line 23723 "" if (i2 < i1) { - s_wsle(&io___1613); +#line 23724 "" + s_wsle(&io___1661); /* Writing concatenation */ +#line 23724 "" i__1[0] = 7, a__1[0] = "Found \""; +#line 23724 "" i__1[1] = 1, a__1[1] = durq; +#line 23724 "" i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 23724 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 23724 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 23724 "" e_wsle(); +#line 23725 "" stop1_(); +#line 23726 "" } else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)& lineq[i2 - 1] == '.') { +#line 23727 "" --i2; +#line 23728 "" --(*iccount); +#line 23729 "" } +#line 23730 "" icf = i2 - i1 + 49; +#line 23731 "" ici__1.icierr = 0; +#line 23731 "" ici__1.iciend = 0; +#line 23731 "" ici__1.icirnum = 1; +#line 23731 "" ici__1.icirlen = i2 - (i1 - 1); +#line 23731 "" ici__1.iciunit = lineq + (i1 - 1); /* Writing concatenation */ +#line 23731 "" i__1[0] = 2, a__1[0] = "(f"; +#line 23731 "" chax_(ch__3, (ftnlen)1, &icf); +#line 23731 "" i__1[1] = 1, a__1[1] = ch__3; +#line 23731 "" i__1[2] = 3, a__1[2] = ".0)"; +#line 23731 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 23731 "" s_rsfi(&ici__1); +#line 23731 "" do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real)); +#line 23731 "" e_rsfi(); +#line 23732 "" return 0; } /* readnum_ */ @@ -36172,37 +58570,21 @@ L1: ishift, integer *ivalue) { /* Builtin functions */ - integer pow_ii(integer *, integer *), s_wsle(cilist *), e_wsle(void), - do_lio(integer *, integer *, char *, ftnlen), s_wsfe(cilist *), - do_fio(integer *, char *, ftnlen), e_wsfe(void), lbit_shift( - integer, integer); + integer pow_ii(integer *, integer *), lbit_shift(integer, integer); /* Local variables */ static integer ibase; - /* Fortran I/O blocks */ - static cilist io___1616 = { 0, 6, 0, 0, 0 }; - static cilist io___1617 = { 0, 6, 0, 0, 0 }; - static cilist io___1618 = { 0, 15, 0, "(/,a)", 0 }; - - /* Sets iwidbits of isdata, shifted by ishift, to ivalue */ +#line 23738 "" ibase = pow_ii(&c__2, iwidbit) - 1; - if (*ivalue > ibase) { - s_wsle(&io___1616); - e_wsle(); - s_wsle(&io___1617); - do_lio(&c__9, &c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34) - ; - e_wsle(); - s_wsfe(&io___1618); - do_fio(&c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34); - e_wsfe(); - } +#line 23739 "" *isdata = ~ lbit_shift(ibase, *ishift) & *isdata; +#line 23740 "" *isdata |= lbit_shift(*ivalue, *ishift); +#line 23741 "" return 0; } /* setbits_ */ @@ -36224,54 +58606,97 @@ L1: /* The MEAN SQUARE slope algorithm */ +#line 23763 "" /* Parameter adjustments */ +#line 23763 "" --ipb; +#line 23763 "" --xelsk; +#line 23763 "" +#line 23763 "" /* Function Body */ +#line 23763 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 23764 "" sumxx = 0.f; +#line 23765 "" sumxy = 0.f; +#line 23766 "" i__1 = *nnb; +#line 23766 "" for (inb = 1; inb <= i__1; ++inb) { /* Computing 2nd power */ +#line 23767 "" r__1 = xelsk[inb]; +#line 23767 "" sumxx += r__1 * r__1; +#line 23768 "" sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; +#line 23769 "" /* L2: */ +#line 23769 "" } +#line 23770 "" delta = *nnb * sumxx - *sumx * *sumx; +#line 23771 "" em = (*nnb * sumxy - *sumx * *sumy) / delta; +#line 23772 "" r__1 = em * .5f * all_1.slfac; +#line 23772 "" *islope = i_nint(&r__1); +#line 23773 "" if (abs(*islope) > 9) { +#line 23773 "" *islope = i_sign(&c__9, islope); +#line 23773 "" } +#line 23774 "" beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb; +#line 23775 "" *nolev1 = i_nint(&beta); /* Check if any stems are too short */ +#line 23779 "" smin = 100.f; +#line 23780 "" iul = -1; +#line 23781 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 23781 "" iul = 1; +#line 23781 "" } +#line 23782 "" i__1 = *nnb; +#line 23782 "" for (inb = 1; inb <= i__1; ++inb) { +#line 23783 "" ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] / all_1.slfac; +#line 23784 "" ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; /* Computing MIN */ +#line 23785 "" r__1 = smin, r__2 = iul * (ybeam - ynote); +#line 23785 "" smin = dmin(r__1,r__2); +#line 23786 "" /* L4: */ +#line 23786 "" } +#line 23787 "" if (smin < all_1.stemmin) { +#line 23788 "" deficit = all_1.stemmin - smin; +#line 23789 "" r__1 = *nolev1 + iul * deficit; +#line 23789 "" *nolev1 = i_nint(&r__1); +#line 23790 "" } +#line 23791 "" return 0; } /* setbm2_ */ @@ -36299,102 +58724,165 @@ L1: ftnlen), g1etchar_(char *, integer *, char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1631 = { 0, 6, 0, 0, 0 }; - static cilist io___1632 = { 0, 6, 0, 0, 0 }; - static cilist io___1633 = { 0, 6, 0, 0, 0 }; + static cilist io___1676 = { 0, 6, 0, 0, 0 }; + static cilist io___1677 = { 0, 6, 0, 0, 0 }; + static cilist io___1678 = { 0, 6, 0, 0, 0 }; /* Macro action */ +#line 23804 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 23805 "" if (*(unsigned char *)charq == 'S' && *ivx != 1) { - s_wsle(&io___1631); +#line 23806 "" + s_wsle(&io___1676); +#line 23806 "" e_wsle(); - s_wsle(&io___1632); +#line 23807 "" + s_wsle(&io___1677); +#line 23807 "" e_wsle(); - s_wsle(&io___1633); +#line 23808 "" + s_wsle(&io___1678); +#line 23808 "" do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25); +#line 23808 "" e_wsle(); +#line 23809 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2" +#line 23809 "" + errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"\ "prt if in voice #1!", (ftnlen)128, (ftnlen)53); +#line 23811 "" } +#line 23812 "" if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) { +#line 23813 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro" +#line 23813 "" + errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"\ ")!", (ftnlen)128, (ftnlen)36); +#line 23815 "" stop1_(); +#line 23816 "" } else if (*(unsigned char *)charq != ' ') { /* Record or playback a macro. Get the number of the macro. */ +#line 23820 "" g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23821 "" if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 23822 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\"" +#line 23822 "" + errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""\ ",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43); +#line 23824 "" stop1_(); +#line 23825 "" } +#line 23826 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23827 "" commac_1.macnum = i_nint(&fnum); +#line 23828 "" if (*(unsigned char *)durq != ' ') { +#line 23829 "" i__1 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, iccount, &i__1, "Macro number must be followed by" +#line 23829 "" + errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"\ " a blank!", (ftnlen)128, (ftnlen)41); +#line 23831 "" stop1_(); +#line 23832 "" } +#line 23833 "" if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { /* Record or save a macro */ +#line 23837 "" if (commac_1.macnum < 1 || commac_1.macnum > 20) { +#line 23838 "" i__1 = *iccount - 1; +#line 23838 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; +#line 23838 "" errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!" , (ftnlen)128, (ftnlen)31); +#line 23840 "" stop1_(); -/* else if (btest(macuse,macnum)) then */ -/* print* */ -/* print*,'WARNING: Redefining macro # ',macnum */ +#line 23841 "" } +#line 23842 "" commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); +#line 23843 "" if (*(unsigned char *)charq == 'R') { +#line 23844 "" m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( ftnlen)128); +#line 23845 "" } else if (*(unsigned char *)charq == 'S') { /* Save (Record but don't activate) */ +#line 23849 "" L1: +#line 23849 "" m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( ftnlen)128); +#line 23850 "" if (commac_1.mrecord) { +#line 23851 "" getbuf_(lineq, (ftnlen)128); +#line 23852 "" ++(*nline); +#line 23853 "" *iccount = 0; +#line 23854 "" goto L1; +#line 23855 "" } +#line 23856 "" *iccount = *iccount + ndxm + 1; +#line 23857 "" } +#line 23858 "" } else { /* Playback the macro */ +#line 23862 "" if (! bit_test(commac_1.macuse,commac_1.macnum)) { +#line 23863 "" i__1 = *iccount - 1; +#line 23863 "" i__2 = *ibarcnt - *ibaroff + *nbars + 1; - errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n" +#line 23863 "" + errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"\ "ot been recorded!", (ftnlen)128, (ftnlen)47); +#line 23865 "" stop1_(); +#line 23866 "" } +#line 23867 "" commac_1.icchold = *iccount; +#line 23868 "" s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); +#line 23869 "" *iccount = 128; +#line 23870 "" commac_1.mplay = TRUE_; +#line 23871 "" c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; +#line 23872 "" } +#line 23873 "" } +#line 23874 "" return 0; } /* setmac_ */ @@ -36409,36 +58897,67 @@ L1: /* 3: triple w/ denom=8, subdivide in groups of 3 8ths */ /* Note that lenbar is set at top or when 'm' symbol is read in getnote */ +#line 23885 "" if (*mtrdenl == 4) { +#line 23886 "" if (*mtrnuml % 3 == 0) { +#line 23887 "" *ibmtyp = 2; +#line 23888 "" *ibmrep = *mtrnuml / 3; +#line 23889 "" } else { +#line 23890 "" *ibmtyp = 1; +#line 23891 "" *ibmrep = *mtrnuml / 2; +#line 23892 "" } +#line 23893 "" } else if (*mtrdenl == 2) { +#line 23894 "" *ibmtyp = 1; +#line 23895 "" if (*mtrnuml == 3) { +#line 23896 "" *ibmrep = 3; +#line 23897 "" } else { +#line 23898 "" *ibmrep = (*mtrnuml << 1) / *mtrdenl; +#line 23899 "" } +#line 23900 "" + } else if (*mtrdenl == 8 && (*mtrnuml == 8 || *mtrnuml == 4)) { + +/* Added 170726 */ + +#line 23904 "" + *ibmtyp = 1; +#line 23905 "" + *ibmrep = *mtrnuml / 4; +#line 23906 "" } else { /* Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */ +#line 23910 "" *ibmtyp = 3; +#line 23911 "" *ibmrep = *mtrnuml / 3; +#line 23912 "" } /* Reset so we don't keep writing new meters */ +#line 23916 "" *mtrnuml = 0; /* Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter */ +#line 23920 "" *ibmrep = max(*ibmrep,1); +#line 23921 "" return 0; } /* setmeter_ */ @@ -36483,54 +59002,86 @@ L1: /* The outer combo algorithm */ +#line 23955 "" /* Parameter adjustments */ +#line 23955 "" --ipb; +#line 23955 "" --xelsk; +#line 23955 "" +#line 23955 "" /* Function Body */ +#line 23955 "" ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 23956 "" comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; +#line 23957 "" n1 = comipl2_1.ipl2[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; /* Initialize counters used in this subroutine, and then later during actual */ /* beam drawing, to count later segments of single-slope beam groups */ +#line 23962 "" comxtup_2.nssb[commvl_1.ivx - 1] = 0; +#line 23963 "" comxtup_2.issb[commvl_1.ivx - 1] = 0; /* Set flag for xtup beam starting with rest (no others can start with rest) */ +#line 23967 "" if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) { +#line 23967 "" *ixrest = 1; +#line 23967 "" } /* Figure how many elemskips to each note. Use the list, counting only non-rests. */ +#line 23971 "" eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24 - 25]; +#line 23972 "" *nnb = 0; +#line 23973 "" *sumx = 0.f; +#line 23974 "" *sumy = 0.f; +#line 23975 "" ipxt1 = 0; +#line 23976 "" iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; +#line 23977 "" i__1 = iplast; +#line 23977 "" for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) { +#line 23978 "" if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 23979 "" ++(*nnb); +#line 23980 "" ipb[*nnb] = ip; +#line 23981 "" xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0; +#line 23982 "" *sumx += xelsk[*nnb]; +#line 23983 "" *sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25]; +#line 23984 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) { /* This is the starting note of later segment of single-slope beam group */ /* Temporarily store ip here. */ +#line 23989 "" ++comxtup_2.nssb[commvl_1.ivx - 1]; +#line 23990 "" comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx - 1] * 24 - 25] = *nnb; +#line 23991 "" } +#line 23992 "" } /* New xtup stuff here. Final object is to get distance from start of xtup */ @@ -36538,137 +59089,220 @@ L1: /* number. ntupv is number of notes in xtup, and is only used to get */ /* eloff, the distance from start of xtup to the number. */ +#line 23999 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { +#line 23999 "" ++ndoub; +#line 23999 "" } +#line 24000 "" if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { /* Xtup is starting here */ +#line 24004 "" ++comxtup_2.nxtinbm[commvl_1.ivx - 1]; +#line 24005 "" ipxt1 = ip; +#line 24006 "" if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { +#line 24007 "" ndoub = 1; +#line 24008 "" } else { +#line 24009 "" ndoub = 0; +#line 24010 "" } +#line 24011 "" } else if (ipxt1 > 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) { /* Xtup ends here. Set total number of notes in xtup. */ +#line 24015 "" comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = ip + 1 - ipxt1; /* Set printed number for embedded xtup. */ +#line 24019 "" comxtup_2.mtupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] + ndoub; /* Middle note of xtup if ntupv odd, note to left of gap if even. */ +#line 24023 "" ipxtmid = (ip + ipxt1) / 2; +#line 24024 "" comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] = comeskz2_1.eskz2[commvl_1.ivx + ipxtmid * 24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipxt1 * 24 - 25]; +#line 24025 "" if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { +#line 24025 "" comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] += (comeskz2_1.eskz2[commvl_1.ivx + ( ipxtmid + 1) * 24 - 25] - comeskz2_1.eskz2[ commvl_1.ivx + ipxtmid * 24 - 25]) * .5f; +#line 24025 "" } +#line 24028 "" ipxt1 = 0; +#line 24029 "" } +#line 24030 "" /* L2: */ +#line 24030 "" } /* Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */ +#line 24034 "" comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; +#line 24035 "" *smed = 0.f; - if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) { +/* if (.not.btest(islur(ivx,ipb(1)),2)) then */ +#line 24037 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *nnb > + 1) { /* No forced 0 slope */ - if (*nnb == 1) { - goto L6; - } +/* if (nnb .eq. 1) go to 6 */ +#line 24042 "" nsc = 0; +#line 24043 "" i__1 = *nnb - 1; +#line 24043 "" for (inb = 1; inb <= i__1; ++inb) { +#line 24044 "" i__2 = *nnb; +#line 24044 "" for (jnb = inb + 1; jnb <= i__2; ++jnb) { +#line 24045 "" ++nsc; +#line 24046 "" slope[nsc - 1] = (all_1.nolev[commvl_1.ivx + ipb[jnb] * 24 - 25] - all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]) / (xelsk[jnb] - xelsk[inb]); +#line 24048 "" if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) { +#line 24049 "" ++nsc; +#line 24050 "" slope[nsc - 1] = slope[nsc - 2]; +#line 24051 "" ++nsc; +#line 24052 "" slope[nsc - 1] = slope[nsc - 2]; +#line 24053 "" } +#line 24054 "" /* L5: */ +#line 24054 "" } +#line 24054 "" } +#line 24055 "" if (nsc == 1) { +#line 24056 "" *smed = slope[0]; +#line 24057 "" goto L6; +#line 24058 "" } +#line 24059 "" nscmid = nsc / 2 + 1; +#line 24060 "" i__2 = nscmid; +#line 24060 "" for (i__ = 1; i__ <= i__2; ++i__) { +#line 24061 "" i__1 = nsc; +#line 24061 "" for (j = i__ + 1; j <= i__1; ++j) { +#line 24062 "" if (slope[j - 1] < slope[i__ - 1]) { +#line 24063 "" t = slope[j - 1]; +#line 24064 "" slope[j - 1] = slope[i__ - 1]; +#line 24065 "" slope[i__ - 1] = t; +#line 24066 "" } +#line 24067 "" /* L7: */ +#line 24067 "" } +#line 24067 "" } +#line 24068 "" *smed = slope[nscmid - 1]; +#line 24069 "" if (nsc == nsc / 2 << 1) { /* Even number of slopes in the list, so median is ambiguous */ +#line 24073 "" if ((r__2 = slope[nscmid - 2], dabs(r__2)) < (r__1 = slope[nscmid - 1], dabs(r__1)) - comtol_1.tol) { /* Lower-numbered one is truly less in absolute value, so use it */ +#line 24077 "" *smed = slope[nscmid - 2]; +#line 24078 "" } else if ((r__1 = slope[nscmid - 2] + slope[nscmid - 1], dabs( r__1)) < comtol_1.tol) { /* Two slopes are effectively equal. Take the one with sign of the average */ +#line 24082 "" sum = 0.f; +#line 24083 "" i__1 = nsc; +#line 24083 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 24084 "" sum += slope[i__ - 1]; +#line 24085 "" /* L1: */ +#line 24085 "" } +#line 24086 "" *smed = r_sign(smed, &sum); +#line 24087 "" } +#line 24088 "" } +#line 24089 "" L6: +#line 24090 "" r__1 = *smed * .5f * all_1.slfac; +#line 24090 "" comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); +#line 24091 "" if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) { +#line 24091 "" comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, & comxtup_2.islope[commvl_1.ivx - 1]); +#line 24091 "" } +#line 24093 "" } else { /* Forced horizontal beam */ +#line 24097 "" comxtup_2.islope[commvl_1.ivx - 1] = 0; +#line 24098 "" } +#line 24099 "" beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx) / *nnb; @@ -36676,111 +59310,177 @@ L6: /* as is for placing xtup number and/or bracket, then reset it for start of */ /* actual beam */ +#line 24105 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta); /* Check if any stems are too short */ +#line 24109 "" smin = 100.f; +#line 24110 "" iul = -1; +#line 24111 "" if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 24111 "" iul = 1; +#line 24111 "" } +#line 24112 "" ssq = 0.f; +#line 24113 "" syb = 0.f; -/* yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) */ +#line 24114 "" yb1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * (all_1.stemlen + combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 - 25]) - 9)); +#line 24116 "" i__1 = *nnb; +#line 24116 "" for (inb = 1; inb <= i__1; ++inb) { +#line 24117 "" ybeam = yb1 + comxtup_2.islope[commvl_1.ivx - 1] * xelsk[inb] / all_1.slfac - iul * combmh_1.bmhgt * ((15 & all_1.mult[ commvl_1.ivx + ipb[inb] * 24 - 25]) - 9); -/* * -iul*bmhgt*(mult(ivx,ipb(inb))-1) */ +#line 24119 "" syb += ybeam; +#line 24120 "" ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; +#line 24121 "" off = ybeam - ynote; +#line 24122 "" if (inb == 1) { +#line 24123 "" off1 = off; +#line 24124 "" } else if (inb == *nnb) { +#line 24125 "" off2 = off; +#line 24126 "" } +#line 24127 "" ssq += off * off; /* Computing MIN */ +#line 24128 "" r__1 = smin, r__2 = iul * off; +#line 24128 "" smin = dmin(r__1,r__2); +#line 24129 "" /* L4: */ +#line 24129 "" } +#line 24130 "" dnolev = 0.f; +#line 24131 "" if (smin < all_1.stemmin) { +#line 24132 "" deficit = all_1.stemmin - smin; +#line 24133 "" nolevo = comxtup_2.nolev1[commvl_1.ivx - 1]; +#line 24134 "" r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit; +#line 24134 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 24135 "" dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo); +#line 24136 "" off1 += dnolev; +#line 24137 "" off2 += dnolev; +#line 24138 "" } /* Computing 2nd power */ +#line 24139 "" r__1 = dnolev; +#line 24139 "" ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1; +#line 24140 "" if (! comxtup_2.vxtup[commvl_1.ivx - 1] && sqrt(ssq / *nnb) > all_1.stemmax && (dabs(off1) < all_1.stemmax || dabs(off2) < all_1.stemmax) && ! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * - 24 - 25],2)) { + 24 - 25],2) && *nnb != 1) { +/* * .and. .not.btest(islur(ivx,ipb(1)),2)) then */ /* The first check is to save trouble of putting xtup's in setbm2. */ /* The penultimate check is that first and last stems aren't both excessive. */ /* The last check is that a 0 slope has not been forced */ +#line 24150 "" setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[ commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]); +#line 24151 "" } /* Check if beam starts or ends too high or low. */ -/* xboff = bmhgt*(mult(ivx,ipb(1))-1) */ +#line 24155 "" xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 - 25]) - 9); +#line 24156 "" l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[ 1])) + xboff + 7 < 0.f; +#line 24157 "" xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[ commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb]; +#line 24158 "" l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f; +#line 24159 "" if (l1ng || l2ng) { /* Need to correct start or stop, also slope */ +#line 24163 "" if (l1ng) { +#line 24164 "" r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul; +#line 24164 "" comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 24165 "" } +#line 24166 "" if (l2ng) { +#line 24167 "" r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul; +#line 24167 "" xnolev2 = (real) i_nint(&r__1); +#line 24168 "" } /* Since one or the other end has changed, need to change slope */ - if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) { +/* if (.not.btest(islur(ivx,ipb(1)),2)) */ +#line 24173 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && * + nnb != 1) { +#line 24173 "" r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1] ) / xelsk[*nnb]; +#line 24173 "" comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); +#line 24173 "" } +#line 24175 "" } +#line 24176 "" if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) { /* This is a single-slope beam group. Store start heights for later segs. */ +#line 24180 "" i__1 = comxtup_2.nssb[commvl_1.ivx - 1]; +#line 24180 "" for (issbs = 1; issbs <= i__1; ++issbs) { +#line 24181 "" comxtup_2.lev1ssb[commvl_1.ivx + issbs * 24 - 25] = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[ commvl_1.ivx - 1] / all_1.slfac * xelsk[comxtup_2.lev1ssb[ commvl_1.ivx + issbs * 24 - 25]]; +#line 24183 "" /* L3: */ +#line 24183 "" } +#line 24184 "" } +#line 24185 "" return 0; } /* setupb_ */ @@ -36795,36 +59495,60 @@ L6: /* Initialize ipoe: */ +#line 24194 "" /* Parameter adjustments */ +#line 24194 "" --ipoe; +#line 24194 "" --poe; +#line 24194 "" +#line 24194 "" /* Function Body */ +#line 24194 "" i__1 = *nsyst; +#line 24194 "" for (iord = 1; iord <= i__1; ++iord) { +#line 24195 "" ipoe[iord] = iord; +#line 24196 "" /* L3: */ +#line 24196 "" } /* Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will */ /* be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. */ +#line 24201 "" i__1 = *nsyst - 1; +#line 24201 "" for (io1 = 1; io1 <= i__1; ++io1) { +#line 24202 "" i__2 = *nsyst; +#line 24202 "" for (io2 = io1 + 1; io2 <= i__2; ++io2) { +#line 24203 "" if (poe[ipoe[io1]] > poe[ipoe[io2]]) { /* Interchange the indices */ +#line 24207 "" itemp = ipoe[io1]; +#line 24208 "" ipoe[io1] = ipoe[io2]; +#line 24209 "" ipoe[io2] = itemp; +#line 24210 "" } +#line 24211 "" /* L5: */ +#line 24211 "" } +#line 24212 "" /* L4: */ +#line 24212 "" } +#line 24213 "" return 0; } /* sortpoe_ */ @@ -36861,287 +59585,488 @@ L6: /* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ +#line 24238 "" /* Parameter adjustments */ +#line 24238 "" --isdat4; +#line 24238 "" --isdat3; +#line 24238 "" --isdat2; +#line 24238 "" --isdat1; +#line 24238 "" +#line 24238 "" /* Function Body */ +#line 24238 "" numint = 0; +#line 24239 "" ivoff = 0; +#line 24240 "" ihoff = 0; +#line 24241 "" ++(*nsdat); +#line 24242 "" if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') { +#line 24242 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 24242 "" } +#line 24244 "" setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); +#line 24245 "" i__1 = *kv - 1; +#line 24245 "" setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); +#line 24246 "" setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); +#line 24247 "" isdat3[*nsdat] = 0; +#line 24248 "" isdat4[*nsdat] = 0; +#line 24249 "" ilb12 = 0; /* Get ID code */ /* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */ +#line 24253 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* if (index('uldtb+-hfnHps ',durq) .gt. 0) then */ +#line 24255 "" if (i_indx("uldtb+-hfnHpsv ", durq, (ftnlen)15, (ftnlen)1) > 0) { /* Null id. Note for ps slurs, 'H' cannot be an ID */ +#line 24259 "" --(*iccount); +#line 24260 "" if (*(unsigned char *)&lineq[*iccount - 1] == 't') { +#line 24261 "" idcode = 1; +#line 24262 "" } else { +#line 24263 "" idcode = 32; +#line 24264 "" } +#line 24265 "" } else { /* Set explicit idcode */ +#line 24269 "" idcode = *(unsigned char *)durq; +#line 24270 "" i__1 = *iccount - 2; +#line 24270 "" if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) { /* Make t[ID] look like s[ID]t */ +#line 24274 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 24275 "" + } +#line 24276 "" + i__1 = *iccount; +#line 24276 "" + if (s_cmp(lineq + i__1, "x", *iccount + 1 - i__1, (ftnlen)1) == 0) { + +/* Flag for 2-voice, indexed slurs */ + +#line 24280 "" + ++(*iccount); +#line 24281 "" + setbits_(&isdat1[*nsdat], &c__1, &c__1, &c__1); +#line 24282 "" } +#line 24283 "" } +#line 24284 "" setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); /* Set start/stop: look thru list from end for same idcode,iv,kv */ +#line 24288 "" for (isdat = *nsdat - 1; isdat >= 1; --isdat) { +#line 24289 "" if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv == - igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 == - igetbits_(&isdat1[isdat], &c__1, &c__12)) { + igetbits_(&isdat1[isdat], &c__5, &c__13) && (*kv - 1 == + igetbits_(&isdat1[isdat], &c__1, &c__12) || bit_test(isdat1[ + isdat],1))) { +/* * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then */ /* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */ +#line 24297 "" if (bit_test(isdat1[isdat],11)) { +#line 24297 "" goto L3; +#line 24297 "" } /* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ +#line 24301 "" goto L4; +#line 24302 "" } +#line 24303 "" /* L2: */ +#line 24303 "" } /* If here, this is turnon. */ +#line 24307 "" L4: +#line 24308 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); +#line 24309 "" L3: /* Now done with initial turnon- or turnoff-specifics. */ +#line 24313 "" if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) { /* There's a default curvature tweak */ +#line 24317 "" icurv1 = i_nint(&comslur_1.slurcurve) + 3; +#line 24318 "" if (icurv1 == 2) { +#line 24318 "" icurv1 = 1; +#line 24318 "" } +#line 24319 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 24320 "" i__1 = icurv1 + 32; +#line 24320 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 24321 "" } /* Loop for rest of input */ +#line 24325 "" L1: +#line 24325 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 24326 "" if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Force direction */ +#line 24330 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); +#line 24331 "" if (*(unsigned char *)durq == 'u') { +#line 24331 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); +#line 24331 "" } +#line 24332 "" goto L1; +#line 24333 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 24334 "" ++numint; +#line 24335 "" if (numint == 1) { /* Vertical offset */ +#line 24339 "" ++(*iccount); +#line 24340 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24341 "" --(*iccount); +#line 24342 "" ivoff = i_nint(&fnum); +#line 24343 "" if (*(unsigned char *)durq == '-') { +#line 24343 "" ivoff = -ivoff; +#line 24343 "" } +#line 24344 "" } else if (numint == 2) { /* Horizontal offset */ +#line 24348 "" ++(*iccount); +#line 24349 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24350 "" --(*iccount); /* fnum is abs(hshift), must be 0 to 6.3 */ +#line 24354 "" ihoff = fnum * 10 + .5f; +#line 24355 "" if (*(unsigned char *)durq == '-') { +#line 24355 "" ihoff = -ihoff; +#line 24355 "" } /* Later will set bits to 1...127 to represent -6.3,...+6.3 */ +#line 24359 "" } else { /* Must be the 3rd signed integer, so it's a curve specification */ +#line 24363 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 24364 "" ++(*iccount); +#line 24365 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24366 "" icurv1 = i_nint(&fnum); +#line 24367 "" if (*(unsigned char *)durq == '-') { +#line 24367 "" icurv1 = -icurv1; +#line 24367 "" } +#line 24368 "" i__1 = icurv1 + 32; +#line 24368 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 24369 "" if (*(unsigned char *)dumq != ':') { /* Back up the pointer and loop for more input */ +#line 24373 "" --(*iccount); +#line 24374 "" } else { /* Expect two single digits as parameters for curve */ +#line 24378 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); +#line 24379 "" i__1 = *iccount; +#line 24379 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 24379 "" setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); +#line 24381 "" i__1 = *iccount + 1; +#line 24381 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 24381 "" setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); +#line 24383 "" *iccount += 2; +#line 24384 "" } +#line 24385 "" } +#line 24386 "" goto L1; +#line 24387 "" } else if (*(unsigned char *)durq == 't') { +#line 24388 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 24389 "" goto L1; +#line 24390 "" } else if (*(unsigned char *)durq == 'b') { +#line 24391 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); +#line 24392 "" goto L1; +#line 24393 "" } else if (*(unsigned char *)durq == 's') { /* Endpoint tweaks for linebreak slurs. */ +#line 24397 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* Next is vertical offset */ /* Must be +|- */ +#line 24401 "" ++(*iccount); +#line 24402 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24403 "" if (*(unsigned char *)durq == '-') { +#line 24403 "" fnum = -fnum; +#line 24403 "" } +#line 24404 "" i__1 = ilb12 << 4; +#line 24404 "" i__2 = i_nint(&fnum) + 32; +#line 24404 "" setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2); +#line 24405 "" if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { /* Also a horizontal offset */ +#line 24409 "" ++(*iccount); +#line 24410 "" readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24411 "" if (*(unsigned char *)dumq == '-') { +#line 24411 "" fnum = -fnum; +#line 24411 "" } +#line 24412 "" i__1 = (ilb12 << 4) + 6; +#line 24412 "" r__1 = fnum * 10; +#line 24412 "" i__2 = i_nint(&r__1) + 64; +#line 24412 "" setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2); +#line 24413 "" } +#line 24414 "" --(*iccount); +#line 24415 "" ilb12 = 1; +#line 24416 "" goto L1; +#line 24417 "" } else if (i_indx("fnhH", durq, (ftnlen)4, (ftnlen)1) > 0) { /* Special ps slur curvatures. */ /* Translate to old \midslur args (1,4,5,6) */ +#line 24422 "" icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1); +#line 24423 "" if (icurv1 == 5) { /* check for 2nd H */ +#line 24427 "" i__1 = *iccount; +#line 24427 "" if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 24428 "" ++(*iccount); +#line 24429 "" icurv1 = 6; +#line 24430 "" } +#line 24431 "" } +#line 24432 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 24433 "" i__1 = icurv1 + 32; +#line 24433 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 24434 "" goto L1; +#line 24435 "" } else if (*(unsigned char *)durq == 'p') { /* Local adjustment */ +#line 24436 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); /* +|- */ +#line 24437 "" getchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1); /* 26 \sluradjust (p+s) */ /* 27 \nosluradjust (p-s) */ /* 28 \tieadjust (p+t) */ /* 29 \notieadjust (p-t) */ /* s|t */ +#line 24442 "" if (*(unsigned char *)durq == '+') { +#line 24443 "" if (*(unsigned char *)dumq == 's') { +#line 24444 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],26); +#line 24445 "" } else { +#line 24446 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],28); +#line 24447 "" } +#line 24448 "" } else { +#line 24449 "" if (*(unsigned char *)dumq == 's') { +#line 24450 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],27); +#line 24451 "" } else { +#line 24452 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],29); +#line 24453 "" } +#line 24454 "" } +#line 24455 "" goto L1; +#line 24456 "" } else if (*(unsigned char *)durq == 'v') { /* Stem slur */ +#line 24457 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],2); +#line 24458 "" goto L1; +#line 24459 "" } /* Record shifts */ +#line 24463 "" i__1 = ivoff + 32; +#line 24463 "" setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); +#line 24464 "" i__1 = ihoff + 64; +#line 24464 "" setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); /* Record chord flag, note level, notehead shift */ +#line 24468 "" if (*notcrd) { +#line 24469 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); +#line 24470 "" } else { +#line 24471 "" nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & c__12); +#line 24472 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); +#line 24473 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); +#line 24474 "" i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & c__23); +#line 24474 "" setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); +#line 24475 "" } +#line 24476 "" return 0; } /* spsslur_ */ @@ -37176,215 +60101,346 @@ L1: /* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ +#line 24501 "" /* Parameter adjustments */ +#line 24501 "" --isdat3; +#line 24501 "" --isdat2; +#line 24501 "" --isdat1; +#line 24501 "" +#line 24501 "" /* Function Body */ +#line 24501 "" numint = 0; +#line 24502 "" ivoff = 0; +#line 24503 "" ihoff = 0; +#line 24504 "" ++(*nsdat); +#line 24505 "" if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') { +#line 24505 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 24505 "" } +#line 24507 "" setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); +#line 24508 "" i__1 = *kv - 1; +#line 24508 "" setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); +#line 24509 "" setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); +#line 24510 "" isdat3[*nsdat] = 0; /* Get id letter */ +#line 24514 "" if (*(unsigned char *)&lineq[*iccount - 1] == 't') { /* Old-style t-slur. Use special idcode = 1 */ +#line 24518 "" idcode = 1; +#line 24519 "" } else { +#line 24520 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 24521 "" if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) { /* Null id */ +#line 24525 "" idcode = 32; +#line 24526 "" --(*iccount); +#line 24527 "" } else if (*(unsigned char *)durq == 'H') { /* Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */ +#line 24531 "" idcode = 32; +#line 24532 "" --(*iccount); /* There may be another "H", but no need to deal with it yet */ +#line 24536 "" } else { /* Set explicit idcode */ +#line 24540 "" idcode = *(unsigned char *)durq; +#line 24541 "" } +#line 24542 "" } +#line 24543 "" setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); /* Set start/stop: look thru list from end for same idcode,iv,kv */ +#line 24547 "" for (isdat = *nsdat - 1; isdat >= 1; --isdat) { +#line 24548 "" if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 == igetbits_(&isdat1[isdat], &c__1, &c__12)) { /* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */ +#line 24554 "" if (bit_test(isdat1[isdat],11)) { +#line 24554 "" goto L3; +#line 24554 "" } /* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ +#line 24558 "" goto L4; +#line 24559 "" } +#line 24560 "" /* L2: */ +#line 24560 "" } /* If here, this is turnon. */ +#line 24564 "" L4: +#line 24565 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); +#line 24566 "" L3: /* Now done with initial turnon- or turnoff-specifics. Loop for rest of input */ +#line 24570 "" L1: +#line 24570 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 24571 "" if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Force direction */ +#line 24575 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); +#line 24576 "" if (*(unsigned char *)durq == 'u') { +#line 24576 "" isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); +#line 24576 "" } +#line 24577 "" goto L1; +#line 24578 "" } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 24579 "" ++numint; +#line 24580 "" if (numint == 1) { /* Vertical offset */ +#line 24584 "" ++(*iccount); +#line 24585 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24586 "" --(*iccount); +#line 24587 "" ivoff = i_nint(&fnum); +#line 24588 "" if (*(unsigned char *)durq == '-') { +#line 24588 "" ivoff = -ivoff; +#line 24588 "" } +#line 24589 "" } else if (numint == 2) { /* Horizontal offset */ +#line 24593 "" ++(*iccount); +#line 24594 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24595 "" --(*iccount); /* fnum is abs(hshift), must be 0 to 6.3 */ +#line 24599 "" ihoff = fnum * 10 + .5f; +#line 24600 "" if (*(unsigned char *)durq == '-') { +#line 24600 "" ihoff = -ihoff; +#line 24600 "" } /* Later will set bits to 1...127 to represent -6.3,...+6.3 */ +#line 24604 "" } else { /* Must be the 3rd signed integer, so it's a curve specification */ +#line 24608 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 24609 "" ++(*iccount); +#line 24610 "" readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 24611 "" icurv1 = i_nint(&fnum); +#line 24612 "" if (*(unsigned char *)durq == '-') { +#line 24612 "" icurv1 = -icurv1; +#line 24612 "" } +#line 24613 "" i__1 = icurv1 + 32; +#line 24613 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 24614 "" if (*(unsigned char *)dumq != ':') { /* Back up the pointer and loop for more input */ +#line 24618 "" --(*iccount); +#line 24619 "" } else { /* Expect two single digits as parameters for curve */ +#line 24623 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); +#line 24624 "" i__1 = *iccount; +#line 24624 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 24624 "" setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); +#line 24626 "" i__1 = *iccount + 1; +#line 24626 "" i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 24626 "" setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); +#line 24628 "" *iccount += 2; +#line 24629 "" } +#line 24630 "" } +#line 24631 "" goto L1; +#line 24632 "" } else if (*(unsigned char *)durq == 't') { +#line 24633 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 24634 "" goto L1; +#line 24635 "" } else if (*(unsigned char *)durq == 'b') { +#line 24636 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); +#line 24637 "" goto L1; +#line 24638 "" } else if (i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) > 0) { /* Special ps slur curvatures. Translate to old \midslur args (1,4,5,6) */ +#line 24642 "" icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2; +#line 24643 "" if (icurv1 == 3) { +#line 24644 "" icurv1 = 1; +#line 24645 "" } else if (icurv1 == 5) { /* check for 2nd H */ +#line 24649 "" i__1 = *iccount; +#line 24649 "" if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) { +#line 24650 "" ++(*iccount); +#line 24651 "" icurv1 = 6; +#line 24652 "" } +#line 24653 "" } +#line 24654 "" isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); /* Must change sign if downslur, but cannot do it now since we don't know */ /* slur direction for sure. */ +#line 24659 "" i__1 = icurv1 + 32; +#line 24659 "" setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 24660 "" goto L1; +#line 24661 "" } /* Record shifts */ +#line 24665 "" i__1 = ivoff + 32; +#line 24665 "" setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); +#line 24666 "" i__1 = ihoff + 64; +#line 24666 "" setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); /* Record chord flag, note level, notehead shift */ +#line 24670 "" if (*notcrd) { +#line 24671 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); +#line 24672 "" } else { +#line 24673 "" nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & c__12); +#line 24674 "" setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); +#line 24675 "" isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); +#line 24676 "" i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & c__23); +#line 24676 "" setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); +#line 24677 "" } +#line 24678 "" return 0; } /* sslur_ */ @@ -37392,7 +60448,9 @@ L1: { extern /* Subroutine */ int exit_(integer *); +#line 24681 "" exit_(&c__1); +#line 24682 "" return 0; } /* stop1_ */ @@ -37431,6 +60489,7 @@ L1: static char fmtq[24]; extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *, logical *); + static real facis; static char fbarq[5]; static integer lname, lfmtq, iinst; static char clefqiv[1]; @@ -37439,188 +60498,299 @@ L1: static integer nstaves; /* Fortran I/O blocks */ - static cilist io___1698 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1699 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1700 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1701 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1702 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1703 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1704 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1705 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1706 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1707 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1708 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1709 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1710 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1711 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1712 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1714 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1715 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___1716 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1717 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static icilist io___1719 = { 0, fbarq, 0, "(f5.3)", 5, 1 }; - static cilist io___1720 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1721 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1722 = { 0, 11, 0, "(a7,i3,a2)", 0 }; - static cilist io___1723 = { 0, 11, 0, "(a8,i3,a2)", 0 }; - static cilist io___1724 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1725 = { 0, 11, 0, "(a8,i1,a2)", 0 }; - static cilist io___1726 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1727 = { 0, 11, 0, "(a8,i3,a2)", 0 }; - static cilist io___1728 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1729 = { 0, 11, 0, "(a8,i1,a2)", 0 }; - static cilist io___1730 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1731 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1732 = { 0, 11, 0, "(a19,i1,a1)", 0 }; - static cilist io___1733 = { 0, 11, 0, "(a19,i2,a1)", 0 }; - static cilist io___1736 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1737 = { 0, 11, 0, "(a11,i2,a)", 0 }; - static cilist io___1742 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1743 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1743 = { 0, 11, 0, "(a)", 0 }; static cilist io___1744 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1745 = { 0, 11, 0, "(a21,i2,a)", 0 }; - static cilist io___1747 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1748 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___1749 = { 0, 11, 0, "(a18,i2,a2)", 0 }; - static cilist io___1751 = { 0, 11, 0, "(a11,i1,a2)", 0 }; - static cilist io___1752 = { 0, 11, 0, "(a11,i2,a2)", 0 }; - static cilist io___1753 = { 0, 11, 0, "(a11,i3,a2)", 0 }; + static cilist io___1745 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1746 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1747 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1748 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1749 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1750 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1751 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1752 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1753 = { 0, 11, 0, "(a)", 0 }; static cilist io___1754 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1755 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1755 = { 0, 11, 0, "(a)", 0 }; static cilist io___1756 = { 0, 11, 0, "(a)", 0 }; static cilist io___1757 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1758 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1759 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1760 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1761 = { 0, 11, 0, "(a)", 0 }; - - + static cilist io___1759 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1760 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1761 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1762 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static icilist io___1764 = { 0, fbarq, 0, "(f5.3)", 5, 1 }; + static cilist io___1765 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1766 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1767 = { 0, 11, 0, "(a7,i3,a2)", 0 }; + static cilist io___1768 = { 0, 11, 0, "(a8,i3,a2)", 0 }; + static cilist io___1769 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + static cilist io___1770 = { 0, 11, 0, "(a8,i1,a2)", 0 }; + static cilist io___1771 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + static cilist io___1772 = { 0, 11, 0, "(a8,i3,a2)", 0 }; + static cilist io___1773 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + static cilist io___1774 = { 0, 11, 0, "(a8,i1,a2)", 0 }; + static cilist io___1775 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + static cilist io___1776 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1777 = { 0, 11, 0, "(a19,i1,a1)", 0 }; + static cilist io___1778 = { 0, 11, 0, "(a19,i2,a1)", 0 }; + static cilist io___1781 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1782 = { 0, 11, 0, "(a11,i2,a)", 0 }; + static cilist io___1787 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1788 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1789 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1790 = { 0, 11, 0, "(a21,i2,a)", 0 }; + static cilist io___1792 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1793 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1794 = { 0, 11, 0, "(a18,i2,a2)", 0 }; + static cilist io___1796 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1797 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1798 = { 0, 11, 0, "(a11,i3,a2)", 0 }; + static cilist io___1799 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1801 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1802 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1803 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1804 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1805 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1806 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1807 = { 0, 11, 0, "(a)", 0 }; + + +#line 24709 "" /* Parameter adjustments */ +#line 24709 "" --clefq; +#line 24709 "" +#line 24709 "" /* Function Body */ +#line 24709 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 24709 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 24710 "" *vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop; +#line 24711 "" if (*vshrink) { +#line 24712 "" comarp_1.xinsnow = 10.f; +#line 24713 "" } else { +#line 24714 "" comarp_1.xinsnow = *xinstf1; +#line 24715 "" } +#line 24716 "" if (! comlast_1.islast) { +#line 24716 "" return 0; +#line 24716 "" } - s_wsfe(&io___1698); +#line 24717 "" + s_wsfe(&io___1743); +#line 24717 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17); +#line 24717 "" e_wsfe(); - s_wsfe(&io___1699); +#line 24718 "" + s_wsfe(&io___1744); +#line 24718 "" do_fio(&c__1, "%", (ftnlen)1); +#line 24718 "" e_wsfe(); - s_wsfe(&io___1700); +#line 24719 "" + s_wsfe(&io___1745); /* Writing concatenation */ +#line 24719 "" i__1[0] = 2, a__1[0] = "% "; +#line 24719 "" i__1[1] = *lbase, a__1[1] = basenameq; +#line 24719 "" i__1[2] = 4, a__1[2] = ".tex"; +#line 24719 "" s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50); +#line 24719 "" do_fio(&c__1, ch__2, *lbase + 6); +#line 24719 "" e_wsfe(); - s_wsfe(&io___1701); +#line 24720 "" + s_wsfe(&io___1746); +#line 24720 "" do_fio(&c__1, "%", (ftnlen)1); +#line 24720 "" e_wsfe(); - s_wsfe(&io___1702); +#line 24721 "" + s_wsfe(&io___1747); +#line 24721 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16); +#line 24721 "" e_wsfe(); - s_wsfe(&io___1703); +#line 24722 "" + s_wsfe(&io___1748); /* Writing concatenation */ +#line 24722 "" i__2[0] = 1, a__2[0] = sq; +#line 24722 "" i__2[1] = 14, a__2[1] = "input musixtex"; +#line 24722 "" s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 24722 "" do_fio(&c__1, ch__3, (ftnlen)15); +#line 24722 "" e_wsfe(); - s_wsfe(&io___1704); +#line 24723 "" + s_wsfe(&io___1749); /* Writing concatenation */ +#line 24723 "" i__2[0] = 1, a__2[0] = sq; +#line 24723 "" i__2[1] = 9, a__2[1] = "input pmx"; +#line 24723 "" s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10); +#line 24723 "" do_fio(&c__1, ch__4, (ftnlen)10); +#line 24723 "" e_wsfe(); /* write(11,'(a)')sq//'input musixmad' */ /* write(11,'(a)')sq//'input musixxad' */ - s_wsfe(&io___1705); +#line 24726 "" + s_wsfe(&io___1750); /* Writing concatenation */ +#line 24726 "" i__3[0] = 1, a__3[0] = sq; +#line 24726 "" i__3[1] = 15, a__3[1] = "setmaxslurs{24}"; +#line 24726 "" i__3[2] = 1, a__3[2] = sq; +#line 24726 "" i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%"; +#line 24726 "" s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39); +#line 24726 "" do_fio(&c__1, ch__5, (ftnlen)39); +#line 24726 "" e_wsfe(); +#line 24728 "" if (! (*fontslur)) { - s_wsfe(&io___1706); +#line 24728 "" + s_wsfe(&io___1751); /* Writing concatenation */ +#line 24728 "" i__2[0] = 1, a__2[0] = sq; +#line 24728 "" i__2[1] = 13, a__2[1] = "input musixps"; +#line 24728 "" s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); +#line 24728 "" do_fio(&c__1, ch__6, (ftnlen)14); +#line 24728 "" e_wsfe(); +#line 24728 "" } /* Need to input musixmad to permit more slurs. */ +#line 24732 "" if (*musicsize == 20) { - s_wsfe(&io___1707); +#line 24733 "" + s_wsfe(&io___1752); /* Writing concatenation */ +#line 24733 "" i__2[0] = 1, a__2[0] = sq; +#line 24733 "" i__2[1] = 16, a__2[1] = "normalmusicsize%"; +#line 24733 "" s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17); +#line 24733 "" do_fio(&c__1, ch__7, (ftnlen)17); +#line 24733 "" e_wsfe(); +#line 24734 "" } else if (*musicsize == 16) { - s_wsfe(&io___1708); +#line 24735 "" + s_wsfe(&io___1753); /* Writing concatenation */ +#line 24735 "" i__2[0] = 1, a__2[0] = sq; +#line 24735 "" i__2[1] = 15, a__2[1] = "smallmusicsize%"; +#line 24735 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 24735 "" do_fio(&c__1, ch__8, (ftnlen)16); +#line 24735 "" e_wsfe(); +#line 24736 "" } else if (*musicsize == 24) { - s_wsfe(&io___1709); +#line 24737 "" + s_wsfe(&io___1754); /* Writing concatenation */ +#line 24737 "" i__2[0] = 1, a__2[0] = sq; +#line 24737 "" i__2[1] = 15, a__2[1] = "largemusicsize%"; +#line 24737 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 24737 "" do_fio(&c__1, ch__8, (ftnlen)16); +#line 24737 "" e_wsfe(); - s_wsfe(&io___1710); +#line 24738 "" + s_wsfe(&io___1755); /* Writing concatenation */ +#line 24738 "" i__4[0] = 1, a__4[0] = sq; +#line 24738 "" i__4[1] = 3, a__4[1] = "def"; +#line 24738 "" i__4[2] = 1, a__4[2] = sq; +#line 24738 "" i__4[3] = 10, a__4[3] = "meterfont{"; +#line 24738 "" i__4[4] = 1, a__4[4] = sq; +#line 24738 "" i__4[5] = 16, a__4[5] = "meterlargefont}%"; +#line 24738 "" s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32); +#line 24738 "" do_fio(&c__1, ch__9, (ftnlen)32); +#line 24738 "" e_wsfe(); +#line 24740 "" } else if (*musicsize == 29) { - s_wsfe(&io___1711); +#line 24741 "" + s_wsfe(&io___1756); /* Writing concatenation */ +#line 24741 "" i__2[0] = 1, a__2[0] = sq; +#line 24741 "" i__2[1] = 15, a__2[1] = "Largemusicsize%"; +#line 24741 "" s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 24741 "" do_fio(&c__1, ch__8, (ftnlen)16); +#line 24741 "" e_wsfe(); - s_wsfe(&io___1712); +#line 24742 "" + s_wsfe(&io___1757); /* Writing concatenation */ +#line 24742 "" i__4[0] = 1, a__4[0] = sq; +#line 24742 "" i__4[1] = 3, a__4[1] = "def"; +#line 24742 "" i__4[2] = 1, a__4[2] = sq; +#line 24742 "" i__4[3] = 10, a__4[3] = "meterfont{"; +#line 24742 "" i__4[4] = 1, a__4[4] = sq; +#line 24742 "" i__4[5] = 16, a__4[5] = "meterLargefont}%"; +#line 24742 "" s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32); +#line 24742 "" do_fio(&c__1, ch__9, (ftnlen)32); +#line 24742 "" e_wsfe(); +#line 24744 "" } /* Set sizes. Have sizes per staff in isize(.) and noinst per staff in */ @@ -37628,611 +60798,1165 @@ L1: /* 130324 */ /* iiv = 1 */ +#line 24751 "" i__5 = *noinst; +#line 24751 "" for (iinst = 1; iinst <= i__5; ++iinst) { /* if (isize(iiv) .eq. 1) then */ +#line 24753 "" if (comsize_1.isize[iinst - 1] == 1) { +#line 24754 "" if (iinst <= 9) { - s_wsfe(&io___1714); +#line 24755 "" + s_wsfe(&io___1759); /* Writing concatenation */ +#line 24755 "" i__2[0] = 1, a__2[0] = sq; +#line 24755 "" i__2[1] = 7, a__2[1] = "setsize"; +#line 24755 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24755 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24755 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24755 "" i__6[0] = 1, a__5[0] = sq; +#line 24755 "" i__6[1] = 11, a__5[1] = "smallvalue%"; +#line 24755 "" s_cat(ch__11, a__5, i__6, &c__2, (ftnlen)12); +#line 24755 "" do_fio(&c__1, ch__11, (ftnlen)12); +#line 24755 "" e_wsfe(); +#line 24757 "" } else { - s_wsfe(&io___1715); +#line 24758 "" + s_wsfe(&io___1760); /* Writing concatenation */ +#line 24758 "" i__2[0] = 1, a__2[0] = sq; +#line 24758 "" i__2[1] = 8, a__2[1] = "setsize{"; +#line 24758 "" s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 24758 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 24758 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24758 "" i__1[0] = 1, a__1[0] = "}"; +#line 24758 "" i__1[1] = 1, a__1[1] = sq; +#line 24758 "" i__1[2] = 11, a__1[2] = "smallvalue%"; +#line 24758 "" s_cat(ch__13, a__1, i__1, &c__3, (ftnlen)13); +#line 24758 "" do_fio(&c__1, ch__13, (ftnlen)13); +#line 24758 "" e_wsfe(); +#line 24760 "" } /* else if (isize(iiv) .eq. 2) then */ +#line 24762 "" } else if (comsize_1.isize[iinst - 1] == 2) { +#line 24763 "" if (iinst <= 9) { - s_wsfe(&io___1716); +#line 24764 "" + s_wsfe(&io___1761); /* Writing concatenation */ +#line 24764 "" i__2[0] = 1, a__2[0] = sq; +#line 24764 "" i__2[1] = 7, a__2[1] = "setsize"; +#line 24764 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24764 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24764 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24764 "" i__6[0] = 1, a__5[0] = sq; +#line 24764 "" i__6[1] = 10, a__5[1] = "tinyvalue%"; +#line 24764 "" s_cat(ch__14, a__5, i__6, &c__2, (ftnlen)11); +#line 24764 "" do_fio(&c__1, ch__14, (ftnlen)11); +#line 24764 "" e_wsfe(); +#line 24766 "" } else { - s_wsfe(&io___1717); +#line 24767 "" + s_wsfe(&io___1762); /* Writing concatenation */ +#line 24767 "" i__2[0] = 1, a__2[0] = sq; +#line 24767 "" i__2[1] = 8, a__2[1] = "setsize{"; +#line 24767 "" s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 24767 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 24767 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24767 "" i__1[0] = 1, a__1[0] = "}"; +#line 24767 "" i__1[1] = 1, a__1[1] = sq; +#line 24767 "" i__1[2] = 10, a__1[2] = "tinyvalue%"; +#line 24767 "" s_cat(ch__11, a__1, i__1, &c__3, (ftnlen)12); +#line 24767 "" do_fio(&c__1, ch__11, (ftnlen)12); +#line 24767 "" e_wsfe(); +#line 24769 "" } +#line 24770 "" } /* iiv = iiv+nsperi(iinst) */ +#line 24772 "" /* L5: */ +#line 24772 "" } - s_wsfi(&io___1719); +#line 24773 "" + s_wsfi(&io___1764); +#line 24773 "" do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real)); +#line 24773 "" e_wsfi(); - s_wsfe(&io___1720); +#line 24774 "" + s_wsfe(&io___1765); /* Writing concatenation */ +#line 24774 "" i__2[0] = 1, a__2[0] = sq; +#line 24774 "" i__2[1] = 13, a__2[1] = "nopagenumbers"; +#line 24774 "" s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); +#line 24774 "" do_fio(&c__1, ch__6, (ftnlen)14); +#line 24774 "" e_wsfe(); - s_wsfe(&io___1721); +#line 24775 "" + s_wsfe(&io___1766); /* Writing concatenation */ +#line 24775 "" i__3[0] = 1, a__3[0] = sq; +#line 24775 "" i__3[1] = 14, a__3[1] = "tracingstats=2"; +#line 24775 "" i__3[2] = 1, a__3[2] = sq; +#line 24775 "" i__3[3] = 5, a__3[3] = "relax"; +#line 24775 "" s_cat(ch__15, a__3, i__3, &c__4, (ftnlen)21); +#line 24775 "" do_fio(&c__1, ch__15, (ftnlen)21); +#line 24775 "" e_wsfe(); - s_wsfe(&io___1722); +#line 24776 "" + s_wsfe(&io___1767); /* Writing concatenation */ +#line 24776 "" i__2[0] = 1, a__2[0] = sq; +#line 24776 "" i__2[1] = 6, a__2[1] = "hsize="; +#line 24776 "" s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)7); +#line 24776 "" do_fio(&c__1, ch__16, (ftnlen)7); +#line 24776 "" i__5 = i_nint(&comtop_1.widthpt); +#line 24776 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24776 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24776 "" e_wsfe(); +#line 24777 "" ci__1.cierr = 0; +#line 24777 "" ci__1.ciunit = 11; /* Writing concatenation */ +#line 24777 "" i__1[0] = 5, a__1[0] = "(a6,i"; +#line 24777 "" r__1 = comtop_1.height + .1f; +#line 24777 "" i__5 = (integer) r_lg10(&r__1) + 49; +#line 24777 "" chax_(ch__1, (ftnlen)1, &i__5); +#line 24777 "" i__1[1] = 1, a__1[1] = ch__1; +#line 24777 "" i__1[2] = 4, a__1[2] = ",a2)"; +#line 24777 "" ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4); +#line 24777 "" s_wsfe(&ci__1); /* Writing concatenation */ +#line 24777 "" i__2[0] = 1, a__2[0] = sq; +#line 24777 "" i__2[1] = 5, a__2[1] = "vsize"; +#line 24777 "" s_cat(ch__17, a__2, i__2, &c__2, (ftnlen)6); +#line 24777 "" do_fio(&c__1, ch__17, (ftnlen)6); +#line 24777 "" i__7 = (integer) (comtop_1.height + .1f); +#line 24777 "" do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 24777 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24777 "" e_wsfe(); +#line 24779 "" if (dabs(comtop_1.hoffpt) > .1f) { +#line 24780 "" if (comtop_1.hoffpt <= -10.f) { - s_wsfe(&io___1723); +#line 24781 "" + s_wsfe(&io___1768); /* Writing concatenation */ +#line 24781 "" i__2[0] = 1, a__2[0] = sq; +#line 24781 "" i__2[1] = 7, a__2[1] = "hoffset"; +#line 24781 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24781 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24781 "" i__5 = i_nint(&comtop_1.hoffpt); +#line 24781 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24781 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24781 "" e_wsfe(); +#line 24782 "" } else if (comtop_1.hoffpt < 0.f) { - s_wsfe(&io___1724); +#line 24783 "" + s_wsfe(&io___1769); /* Writing concatenation */ +#line 24783 "" i__2[0] = 1, a__2[0] = sq; +#line 24783 "" i__2[1] = 7, a__2[1] = "hoffset"; +#line 24783 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24783 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24783 "" i__5 = i_nint(&comtop_1.hoffpt); +#line 24783 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24783 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24783 "" e_wsfe(); +#line 24784 "" } else if (comtop_1.hoffpt < 10.f) { - s_wsfe(&io___1725); +#line 24785 "" + s_wsfe(&io___1770); /* Writing concatenation */ +#line 24785 "" i__2[0] = 1, a__2[0] = sq; +#line 24785 "" i__2[1] = 7, a__2[1] = "hoffset"; +#line 24785 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24785 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24785 "" i__5 = i_nint(&comtop_1.hoffpt); +#line 24785 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24785 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24785 "" e_wsfe(); +#line 24786 "" } else { - s_wsfe(&io___1726); +#line 24787 "" + s_wsfe(&io___1771); /* Writing concatenation */ +#line 24787 "" i__2[0] = 1, a__2[0] = sq; +#line 24787 "" i__2[1] = 7, a__2[1] = "hoffset"; +#line 24787 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24787 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24787 "" i__5 = i_nint(&comtop_1.hoffpt); +#line 24787 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24787 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24787 "" e_wsfe(); +#line 24788 "" } +#line 24789 "" } +#line 24790 "" if (dabs(comtop_1.voffpt) > .1f) { +#line 24791 "" if (comtop_1.voffpt <= -10.f) { - s_wsfe(&io___1727); +#line 24792 "" + s_wsfe(&io___1772); /* Writing concatenation */ +#line 24792 "" i__2[0] = 1, a__2[0] = sq; +#line 24792 "" i__2[1] = 7, a__2[1] = "voffset"; +#line 24792 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24792 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24792 "" i__5 = i_nint(&comtop_1.voffpt); +#line 24792 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24792 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24792 "" e_wsfe(); +#line 24793 "" } else if (comtop_1.voffpt < 0.f) { - s_wsfe(&io___1728); +#line 24794 "" + s_wsfe(&io___1773); /* Writing concatenation */ +#line 24794 "" i__2[0] = 1, a__2[0] = sq; +#line 24794 "" i__2[1] = 7, a__2[1] = "voffset"; +#line 24794 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24794 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24794 "" i__5 = i_nint(&comtop_1.voffpt); +#line 24794 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24794 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24794 "" e_wsfe(); +#line 24795 "" } else if (comtop_1.voffpt < 10.f) { - s_wsfe(&io___1729); +#line 24796 "" + s_wsfe(&io___1774); /* Writing concatenation */ +#line 24796 "" i__2[0] = 1, a__2[0] = sq; +#line 24796 "" i__2[1] = 7, a__2[1] = "voffset"; +#line 24796 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24796 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24796 "" i__5 = i_nint(&comtop_1.voffpt); +#line 24796 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24796 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24796 "" e_wsfe(); +#line 24797 "" } else { - s_wsfe(&io___1730); +#line 24798 "" + s_wsfe(&io___1775); /* Writing concatenation */ +#line 24798 "" i__2[0] = 1, a__2[0] = sq; +#line 24798 "" i__2[1] = 7, a__2[1] = "voffset"; +#line 24798 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24798 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24798 "" i__5 = i_nint(&comtop_1.voffpt); +#line 24798 "" do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 24798 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24798 "" e_wsfe(); +#line 24799 "" } +#line 24800 "" } /* The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if */ /* 3 sharps and treble clef, to avoid vertical clash with top space g# */ +#line 24805 "" if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') { - s_wsfe(&io___1731); +#line 24805 "" + s_wsfe(&io___1776); /* Writing concatenation */ +#line 24805 "" i__4[0] = 1, a__4[0] = sq; +#line 24805 "" i__4[1] = 3, a__4[1] = "def"; +#line 24805 "" i__4[2] = 1, a__4[2] = sq; +#line 24805 "" i__4[3] = 14, a__4[3] = "raisebarno{4.5"; +#line 24805 "" i__4[4] = 1, a__4[4] = sq; +#line 24805 "" i__4[5] = 10, a__4[5] = "internote}"; +#line 24805 "" s_cat(ch__18, a__4, i__4, &c__6, (ftnlen)30); +#line 24805 "" do_fio(&c__1, ch__18, (ftnlen)30); +#line 24805 "" e_wsfe(); +#line 24805 "" } +#line 24807 "" if (*noinst < 10) { - s_wsfe(&io___1732); +#line 24808 "" + s_wsfe(&io___1777); /* Writing concatenation */ +#line 24808 "" i__3[0] = 1, a__3[0] = sq; +#line 24808 "" i__3[1] = 3, a__3[1] = "def"; +#line 24808 "" i__3[2] = 1, a__3[2] = sq; +#line 24808 "" i__3[3] = 14, a__3[3] = "nbinstruments{"; +#line 24808 "" s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19); +#line 24808 "" do_fio(&c__1, ch__19, (ftnlen)19); +#line 24808 "" do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); +#line 24808 "" do_fio(&c__1, "}", (ftnlen)1); +#line 24808 "" e_wsfe(); +#line 24810 "" } else { - s_wsfe(&io___1733); +#line 24811 "" + s_wsfe(&io___1778); /* Writing concatenation */ +#line 24811 "" i__3[0] = 1, a__3[0] = sq; +#line 24811 "" i__3[1] = 3, a__3[1] = "def"; +#line 24811 "" i__3[2] = 1, a__3[2] = sq; +#line 24811 "" i__3[3] = 14, a__3[3] = "nbinstruments{"; +#line 24811 "" s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19); +#line 24811 "" do_fio(&c__1, ch__19, (ftnlen)19); +#line 24811 "" do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); +#line 24811 "" do_fio(&c__1, "}", (ftnlen)1); +#line 24811 "" e_wsfe(); +#line 24813 "" } +#line 24814 "" iv = 0; +#line 24815 "" i__5 = *noinst; +#line 24815 "" for (iinst = 1; iinst <= i__5; ++iinst) { +#line 24816 "" nstaves = comnvi_1.nsperi[iinst - 1]; +#line 24817 "" if (iinst < 10) { - s_wsfe(&io___1736); +#line 24818 "" + s_wsfe(&io___1781); /* Writing concatenation */ +#line 24818 "" i__3[0] = 1, a__3[0] = sq; +#line 24818 "" i__3[1] = 9, a__3[1] = "setstaffs"; +#line 24818 "" i__7 = iinst + 48; +#line 24818 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24818 "" i__3[2] = 1, a__3[2] = ch__1; +#line 24818 "" i__8 = nstaves + 48; +#line 24818 "" chax_(ch__20, (ftnlen)1, &i__8); +#line 24818 "" i__3[3] = 1, a__3[3] = ch__20; +#line 24818 "" s_cat(ch__11, a__3, i__3, &c__4, (ftnlen)12); +#line 24818 "" do_fio(&c__1, ch__11, (ftnlen)12); +#line 24818 "" e_wsfe(); +#line 24820 "" } else { - s_wsfe(&io___1737); +#line 24821 "" + s_wsfe(&io___1782); /* Writing concatenation */ +#line 24821 "" i__2[0] = 1, a__2[0] = sq; +#line 24821 "" i__2[1] = 10, a__2[1] = "setstaffs{"; +#line 24821 "" s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 24821 "" do_fio(&c__1, ch__14, (ftnlen)11); +#line 24821 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24821 "" i__6[0] = 1, a__5[0] = "}"; +#line 24821 "" i__7 = nstaves + 48; +#line 24821 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24821 "" i__6[1] = 1, a__5[1] = ch__1; +#line 24821 "" s_cat(ch__21, a__5, i__6, &c__2, (ftnlen)2); +#line 24821 "" do_fio(&c__1, ch__21, (ftnlen)2); +#line 24821 "" e_wsfe(); +#line 24823 "" } +#line 24824 "" ++iv; +#line 24825 "" *(unsigned char *)clefqiv = *(unsigned char *)&clefq[iv]; +#line 24826 "" if (*(unsigned char *)clefqiv == '8') { +#line 24827 "" *(unsigned char *)clefqiv = 't'; - cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] = 7; +#line 24828 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] += 7; +#line 24829 "" } +#line 24830 "" if (nstaves == 1) { +#line 24831 "" i__7 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 24831 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24831 "" s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1); +#line 24832 "" lfmtq = 1; +#line 24833 "" } else { /* Writing concatenation */ +#line 24834 "" i__2[0] = 1, a__2[0] = "{"; +#line 24834 "" i__7 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 24834 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24834 "" i__2[1] = 1, a__2[1] = ch__1; +#line 24834 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 24835 "" lfmtq = 2; +#line 24836 "" i__7 = nstaves; +#line 24836 "" for (k = 2; k <= i__7; ++k) { +#line 24837 "" ++iv; /* Writing concatenation */ +#line 24838 "" i__2[0] = lfmtq, a__2[0] = fmtq; +#line 24838 "" i__8 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 24838 "" chax_(ch__1, (ftnlen)1, &i__8); +#line 24838 "" i__2[1] = 1, a__2[1] = ch__1; +#line 24838 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 24839 "" ++lfmtq; +#line 24840 "" /* L2: */ +#line 24840 "" } /* Writing concatenation */ +#line 24841 "" i__2[0] = lfmtq, a__2[0] = fmtq; +#line 24841 "" i__2[1] = 1, a__2[1] = "}"; +#line 24841 "" s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 24842 "" ++lfmtq; +#line 24843 "" } +#line 24844 "" if (iinst < 10) { - s_wsfe(&io___1742); +#line 24845 "" + s_wsfe(&io___1787); /* Writing concatenation */ +#line 24845 "" i__3[0] = 1, a__3[0] = sq; +#line 24845 "" i__3[1] = 7, a__3[1] = "setclef"; +#line 24845 "" i__7 = iinst + 48; +#line 24845 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24845 "" i__3[2] = 1, a__3[2] = ch__1; +#line 24845 "" i__3[3] = lfmtq, a__3[3] = fmtq; +#line 24845 "" s_cat(ch__22, a__3, i__3, &c__4, (ftnlen)33); +#line 24845 "" do_fio(&c__1, ch__22, lfmtq + 9); +#line 24845 "" e_wsfe(); +#line 24846 "" } else { - s_wsfe(&io___1743); +#line 24847 "" + s_wsfe(&io___1788); /* Writing concatenation */ +#line 24847 "" i__2[0] = 1, a__2[0] = sq; +#line 24847 "" i__2[1] = 8, a__2[1] = "setclef{"; +#line 24847 "" s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 24847 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 24847 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24847 "" i__6[0] = 1, a__5[0] = "}"; +#line 24847 "" i__6[1] = lfmtq, a__5[1] = fmtq; +#line 24847 "" s_cat(ch__23, a__5, i__6, &c__2, (ftnlen)25); +#line 24847 "" do_fio(&c__1, ch__23, lfmtq + 1); +#line 24847 "" e_wsfe(); +#line 24848 "" } +#line 24849 "" if (*(unsigned char *)&clefq[iv] == '8') { +#line 24850 "" if (iinst < 10) { - s_wsfe(&io___1744); +#line 24851 "" + s_wsfe(&io___1789); /* Writing concatenation */ +#line 24851 "" i__9[0] = 1, a__6[0] = sq; +#line 24851 "" i__9[1] = 19, a__6[1] = "settrebleclefsymbol"; +#line 24851 "" i__7 = iinst + 48; +#line 24851 "" chax_(ch__1, (ftnlen)1, &i__7); +#line 24851 "" i__9[2] = 1, a__6[2] = ch__1; +#line 24851 "" i__9[3] = 1, a__6[3] = sq; +#line 24851 "" i__9[4] = 13, a__6[4] = "treblelowoct%"; +#line 24851 "" s_cat(ch__24, a__6, i__9, &c__5, (ftnlen)35); +#line 24851 "" do_fio(&c__1, ch__24, (ftnlen)35); +#line 24851 "" e_wsfe(); +#line 24853 "" } else { - s_wsfe(&io___1745); +#line 24854 "" + s_wsfe(&io___1790); /* Writing concatenation */ +#line 24854 "" i__2[0] = 1, a__2[0] = sq; +#line 24854 "" i__2[1] = 20, a__2[1] = "settrebleclefsymbol{"; +#line 24854 "" s_cat(ch__15, a__2, i__2, &c__2, (ftnlen)21); +#line 24854 "" do_fio(&c__1, ch__15, (ftnlen)21); +#line 24854 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24854 "" i__1[0] = 1, a__1[0] = "}"; +#line 24854 "" i__1[1] = 1, a__1[1] = sq; +#line 24854 "" i__1[2] = 13, a__1[2] = "treblelowoct%"; +#line 24854 "" s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)15); +#line 24854 "" do_fio(&c__1, ch__3, (ftnlen)15); +#line 24854 "" e_wsfe(); +#line 24856 "" } +#line 24857 "" } +#line 24858 "" for (lname = 79; lname >= 2; --lname) { +#line 24859 "" if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname - 1)] != ' ') { +#line 24859 "" goto L4; +#line 24859 "" } +#line 24860 "" /* L3: */ +#line 24860 "" } +#line 24861 "" L4: +#line 24862 "" comtop_1.lnam[iinst - 1] = lname; +#line 24863 "" if (iinst < 10) { - s_wsfe(&io___1747); +#line 24864 "" + s_wsfe(&io___1792); /* Writing concatenation */ +#line 24864 "" i__2[0] = 1, a__2[0] = sq; +#line 24864 "" i__2[1] = 7, a__2[1] = "setname"; +#line 24864 "" s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 24864 "" do_fio(&c__1, ch__10, (ftnlen)8); +#line 24864 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24864 "" i__1[0] = 1, a__1[0] = "{"; +#line 24864 "" i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; +#line 24864 "" i__1[2] = 1, a__1[2] = "}"; +#line 24864 "" s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)81); +#line 24864 "" do_fio(&c__1, ch__25, lname + 2); +#line 24864 "" e_wsfe(); +#line 24866 "" } else { - s_wsfe(&io___1748); +#line 24867 "" + s_wsfe(&io___1793); /* Writing concatenation */ +#line 24867 "" i__2[0] = 1, a__2[0] = sq; +#line 24867 "" i__2[1] = 8, a__2[1] = "setname{"; +#line 24867 "" s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 24867 "" do_fio(&c__1, ch__12, (ftnlen)9); +#line 24867 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); /* Writing concatenation */ +#line 24867 "" i__1[0] = 2, a__1[0] = "}{"; +#line 24867 "" i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; +#line 24867 "" i__1[2] = 1, a__1[2] = "}"; +#line 24867 "" s_cat(ch__26, a__1, i__1, &c__3, (ftnlen)82); +#line 24867 "" do_fio(&c__1, ch__26, lname + 3); +#line 24867 "" e_wsfe(); +#line 24869 "" } +#line 24870 "" /* L1: */ +#line 24870 "" } - s_wsfe(&io___1749); +#line 24871 "" + s_wsfe(&io___1794); /* Writing concatenation */ +#line 24871 "" i__2[0] = 1, a__2[0] = sq; +#line 24871 "" i__2[1] = 17, a__2[1] = "generalsignature{"; +#line 24871 "" s_cat(ch__27, a__2, i__2, &c__2, (ftnlen)18); +#line 24871 "" do_fio(&c__1, ch__27, (ftnlen)18); +#line 24871 "" do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); +#line 24871 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 24871 "" e_wsfe(); +#line 24872 "" if (cominsttrans_1.earlytranson) { +#line 24872 "" writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, cominsttrans_1.itranskey, &cominsttrans_1.earlytranson); +#line 24872 "" } +#line 24874 "" wgmeter_(mtrnmp, mtrdnp); +#line 24875 "" r__1 = comtop_1.fracindent * comtop_1.widthpt; +#line 24875 "" ipi = i_nint(&r__1); +#line 24876 "" if (ipi < 10) { - s_wsfe(&io___1751); +#line 24877 "" + s_wsfe(&io___1796); /* Writing concatenation */ +#line 24877 "" i__2[0] = 1, a__2[0] = sq; +#line 24877 "" i__2[1] = 10, a__2[1] = "parindent "; +#line 24877 "" s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 24877 "" do_fio(&c__1, ch__14, (ftnlen)11); +#line 24877 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 24877 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24877 "" e_wsfe(); +#line 24878 "" } else if (ipi < 100) { - s_wsfe(&io___1752); +#line 24879 "" + s_wsfe(&io___1797); /* Writing concatenation */ +#line 24879 "" i__2[0] = 1, a__2[0] = sq; +#line 24879 "" i__2[1] = 10, a__2[1] = "parindent "; +#line 24879 "" s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 24879 "" do_fio(&c__1, ch__14, (ftnlen)11); +#line 24879 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 24879 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24879 "" e_wsfe(); +#line 24880 "" } else { - s_wsfe(&io___1753); +#line 24881 "" + s_wsfe(&io___1798); /* Writing concatenation */ +#line 24881 "" i__2[0] = 1, a__2[0] = sq; +#line 24881 "" i__2[1] = 10, a__2[1] = "parindent "; +#line 24881 "" s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 24881 "" do_fio(&c__1, ch__14, (ftnlen)11); +#line 24881 "" do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 24881 "" do_fio(&c__1, "pt", (ftnlen)2); +#line 24881 "" e_wsfe(); +#line 24882 "" } - s_wsfe(&io___1754); +#line 24883 "" + s_wsfe(&io___1799); /* Writing concatenation */ +#line 24883 "" i__10[0] = 1, a__7[0] = sq; +#line 24883 "" i__10[1] = 11, a__7[1] = "elemskip1pt"; +#line 24883 "" i__10[2] = 1, a__7[2] = sq; +#line 24883 "" i__10[3] = 13, a__7[3] = "afterruleskip"; +#line 24883 "" i__10[4] = 5, a__7[4] = fbarq; +#line 24883 "" i__10[5] = 2, a__7[5] = "pt"; +#line 24883 "" i__10[6] = 1, a__7[6] = sq; +#line 24883 "" i__10[7] = 17, a__7[7] = "beforeruleskip0pt"; +#line 24883 "" i__10[8] = 1, a__7[8] = sq; +#line 24883 "" i__10[9] = 5, a__7[9] = "relax"; +#line 24883 "" s_cat(ch__28, a__7, i__10, &c__10, (ftnlen)57); +#line 24883 "" do_fio(&c__1, ch__28, (ftnlen)57); +#line 24883 "" e_wsfe(); +#line 24885 "" if (! (*vshrink)) { +#line 24886 "" if (*xinstf1 < 9.95f) { +#line 24887 "" s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 24888 "" } else { +#line 24889 "" s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 24890 "" } - s_wsfe(&io___1755); +#line 24891 "" + facis = 1.f; +#line 24892 "" + if (comis4bignv_1.is4bignv) { +#line 24892 "" + facis = .95f; +#line 24892 "" + } +#line 24893 "" + s_wsfe(&io___1801); /* Writing concatenation */ +#line 24893 "" i__4[0] = 1, a__4[0] = sq; +#line 24893 "" i__4[1] = 15, a__4[1] = "stafftopmarg0pt"; +#line 24893 "" i__4[2] = 1, a__4[2] = sq; +#line 24893 "" i__4[3] = 15, a__4[3] = "staffbotmarg0pt"; +#line 24893 "" i__4[4] = 1, a__4[4] = sq; +#line 24893 "" i__4[5] = 11, a__4[5] = "interstaff{"; +#line 24893 "" s_cat(ch__29, a__4, i__4, &c__6, (ftnlen)44); +#line 24893 "" do_fio(&c__1, ch__29, (ftnlen)44); - do_fio(&c__1, (char *)&(*xinstf1), (ftnlen)sizeof(real)); +#line 24893 "" + r__1 = *xinstf1 * facis; +#line 24893 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); /* Writing concatenation */ +#line 24893 "" i__1[0] = 1, a__1[0] = "}"; +#line 24893 "" i__1[1] = 1, a__1[1] = sq; +#line 24893 "" i__1[2] = 5, a__1[2] = "relax"; +#line 24893 "" s_cat(ch__16, a__1, i__1, &c__3, (ftnlen)7); +#line 24893 "" do_fio(&c__1, ch__16, (ftnlen)7); +#line 24893 "" e_wsfe(); +#line 24895 "" } else { - s_wsfe(&io___1756); +#line 24896 "" + s_wsfe(&io___1802); /* Writing concatenation */ +#line 24896 "" i__10[0] = 1, a__7[0] = sq; +#line 24896 "" i__10[1] = 15, a__7[1] = "stafftopmarg0pt"; +#line 24896 "" i__10[2] = 1, a__7[2] = sq; +#line 24896 "" i__10[3] = 13, a__7[3] = "staffbotmarg5"; +#line 24896 "" i__10[4] = 1, a__7[4] = sq; +#line 24896 "" i__10[5] = 10, a__7[5] = "Interligne"; +#line 24896 "" i__10[6] = 1, a__7[6] = sq; +#line 24896 "" i__10[7] = 14, a__7[7] = "interstaff{10}"; +#line 24896 "" i__10[8] = 1, a__7[8] = sq; +#line 24896 "" i__10[9] = 5, a__7[9] = "relax"; +#line 24896 "" s_cat(ch__30, a__7, i__10, &c__10, (ftnlen)62); +#line 24896 "" do_fio(&c__1, ch__30, (ftnlen)62); +#line 24896 "" e_wsfe(); +#line 24899 "" } +#line 24900 "" if (*nv == 1) { - s_wsfe(&io___1757); +#line 24900 "" + s_wsfe(&io___1803); /* Writing concatenation */ +#line 24900 "" i__2[0] = 1, a__2[0] = sq; +#line 24900 "" i__2[1] = 11, a__2[1] = "nostartrule"; +#line 24900 "" s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)12); +#line 24900 "" do_fio(&c__1, ch__11, (ftnlen)12); +#line 24900 "" e_wsfe(); +#line 24900 "" } - s_wsfe(&io___1758); +#line 24901 "" + s_wsfe(&io___1804); /* Writing concatenation */ +#line 24901 "" i__3[0] = 1, a__3[0] = sq; +#line 24901 "" i__3[1] = 8, a__3[1] = "readmod{"; +#line 24901 "" i__3[2] = *lbase, a__3[2] = basenameq; +#line 24901 "" i__3[3] = 1, a__3[3] = "}"; +#line 24901 "" s_cat(ch__31, a__3, i__3, &c__4, (ftnlen)54); +#line 24901 "" do_fio(&c__1, ch__31, *lbase + 10); +#line 24901 "" e_wsfe(); +#line 24902 "" if (comnvst_1.cstuplet) { - s_wsfe(&io___1759); +#line 24903 "" + s_wsfe(&io___1805); /* Writing concatenation */ +#line 24903 "" i__11[0] = 1, a__8[0] = sq; +#line 24903 "" i__11[1] = 12, a__8[1] = "input tuplet"; +#line 24903 "" i__11[2] = 1, a__8[2] = sq; +#line 24903 "" i__11[3] = 3, a__8[3] = "def"; +#line 24903 "" i__11[4] = 1, a__8[4] = sq; +#line 24903 "" i__11[5] = 12, a__8[5] = "xnumt#1#2#3{"; +#line 24903 "" i__11[6] = 1, a__8[6] = sq; +#line 24903 "" i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}"; +#line 24903 "" i__11[8] = 1, a__8[8] = sq; +#line 24903 "" i__11[9] = 3, a__8[9] = "def"; +#line 24903 "" i__11[10] = 1, a__8[10] = sq; +#line 24903 "" i__11[11] = 10, a__8[11] = "tuplettxt{"; +#line 24903 "" i__11[12] = 1, a__8[12] = sq; +#line 24903 "" i__11[13] = 9, a__8[13] = "smalltype"; +#line 24903 "" i__11[14] = 1, a__8[14] = sq; +#line 24903 "" i__11[15] = 6, a__8[15] = "it{#3}"; +#line 24903 "" i__11[16] = 1, a__8[16] = sq; +#line 24903 "" i__11[17] = 1, a__8[17] = "/"; +#line 24903 "" i__11[18] = 1, a__8[18] = sq; +#line 24903 "" i__11[19] = 4, a__8[19] = "/}}%"; +#line 24903 "" s_cat(ch__32, a__8, i__11, &c__20, (ftnlen)86); +#line 24903 "" do_fio(&c__1, ch__32, (ftnlen)86); +#line 24903 "" e_wsfe(); - s_wsfe(&io___1760); +#line 24907 "" + s_wsfe(&io___1806); /* Writing concatenation */ +#line 24907 "" i__12[0] = 1, a__9[0] = sq; +#line 24907 "" i__12[1] = 3, a__9[1] = "let"; +#line 24907 "" i__12[2] = 1, a__9[2] = sq; +#line 24907 "" i__12[3] = 5, a__9[3] = "ovbkt"; +#line 24907 "" i__12[4] = 1, a__9[4] = sq; +#line 24907 "" i__12[5] = 8, a__9[5] = "uptuplet"; +#line 24907 "" i__12[6] = 1, a__9[6] = sq; +#line 24907 "" i__12[7] = 3, a__9[7] = "let"; +#line 24907 "" i__12[8] = 1, a__9[8] = sq; +#line 24907 "" i__12[9] = 5, a__9[9] = "unbkt"; +#line 24907 "" i__12[10] = 1, a__9[10] = sq; +#line 24907 "" i__12[11] = 11, a__9[11] = "downtuplet%"; +#line 24907 "" s_cat(ch__33, a__9, i__12, &c__12, (ftnlen)41); +#line 24907 "" do_fio(&c__1, ch__33, (ftnlen)41); +#line 24907 "" e_wsfe(); +#line 24909 "" } - s_wsfe(&io___1761); +#line 24910 "" + s_wsfe(&io___1807); /* Writing concatenation */ +#line 24910 "" i__13[0] = 1, a__10[0] = sq; +#line 24910 "" i__13[1] = 11, a__10[1] = "startmuflex"; +#line 24910 "" i__13[2] = 1, a__10[2] = sq; +#line 24910 "" i__13[3] = 10, a__10[3] = "startpiece"; +#line 24910 "" i__13[4] = 1, a__10[4] = sq; +#line 24910 "" i__13[5] = 8, a__10[5] = "addspace"; +#line 24910 "" i__13[6] = 1, a__10[6] = sq; +#line 24910 "" i__13[7] = 14, a__10[7] = "afterruleskip%"; +#line 24910 "" s_cat(ch__34, a__10, i__13, &c__8, (ftnlen)47); +#line 24910 "" do_fio(&c__1, ch__34, (ftnlen)47); +#line 24910 "" e_wsfe(); +#line 24912 "" return 0; } /* topfile_ */ @@ -38244,12 +61968,19 @@ L4: /* Slur directions */ +#line 24920 "" ntest = *nolev - *ncm; +#line 24921 "" if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) { +#line 24923 "" *(unsigned char *)ret_val = 'd'; +#line 24924 "" } else { +#line 24925 "" *(unsigned char *)ret_val = 'u'; +#line 24926 "" } +#line 24927 "" return ; } /* udfq_ */ @@ -38267,33 +61998,52 @@ L4: /* Stem direction for single notes */ +#line 24936 "" if (bit_test(*isl,30)) { /* Absolute override */ +#line 24940 "" if (bit_test(*isl,17)) { +#line 24941 "" *(unsigned char *)udqqq = 'u'; +#line 24942 "" } else { +#line 24943 "" *(unsigned char *)udqqq = 'l'; +#line 24944 "" } +#line 24945 "" } else if (*nvmx == 1) { /* Single voice per staff, default */ +#line 24949 "" r__1 = *nole * 1.f; +#line 24949 "" ulfq_(ch__2, (ftnlen)1, &r__1, ncm); +#line 24949 "" *(unsigned char *)udqqq = *(unsigned char *)&ch__2[0]; +#line 24950 "" } else { /* Multi-voice per staff, 1st is lower, 2nd upper */ +#line 24954 "" if (*ivx <= *nv) { +#line 24955 "" *(unsigned char *)udqqq = 'l'; +#line 24956 "" } else { +#line 24957 "" *(unsigned char *)udqqq = 'u'; +#line 24958 "" } +#line 24959 "" } +#line 24960 "" *(unsigned char *)ret_val = *(unsigned char *)udqqq; +#line 24961 "" return ; } /* udqq_ */ @@ -38305,12 +62055,19 @@ L4: /* Stem directions */ +#line 24969 "" test = *xnolev - *ncm; +#line 24970 "" if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) { +#line 24972 "" *(unsigned char *)ret_val = 'u'; +#line 24973 "" } else { +#line 24974 "" *(unsigned char *)ret_val = 'l'; +#line 24975 "" } +#line 24976 "" return ; } /* ulfq_ */ @@ -38332,25 +62089,40 @@ L4: extern /* Character */ VOID chax_(char *, ftnlen, integer *); /* Fortran I/O blocks */ - static cilist io___1765 = { 0, 6, 0, 0, 0 }; + static cilist io___1811 = { 0, 6, 0, 0, 0 }; +#line 24980 "" if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) { +#line 24981 "" i__1 = *(unsigned char *)chq - 32; +#line 24981 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 24981 "" *(unsigned char *)ret_val = *(unsigned char *)&ch__2[0]; +#line 24982 "" } else { +#line 24983 "" *(unsigned char *)ret_val = *(unsigned char *)chq; - s_wsle(&io___1765); +#line 24984 "" + s_wsle(&io___1811); /* Writing concatenation */ - i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a" +#line 24984 "" + i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"\ "rgument: "; +#line 24984 "" i__2[1] = 1, a__1[1] = chq; +#line 24984 "" s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53); +#line 24984 "" do_lio(&c__9, &c__1, ch__3, (ftnlen)53); +#line 24984 "" e_wsle(); +#line 24986 "" s_stop("", (ftnlen)0); +#line 24987 "" } +#line 24988 "" return ; } /* upcaseq_ */ @@ -38371,143 +62143,258 @@ L4: extern /* Character */ VOID chax_(char *, ftnlen, integer *); /* Fortran I/O blocks */ - static cilist io___1767 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 }; - static cilist io___1768 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 }; - static cilist io___1769 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 }; - static cilist io___1770 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 }; - static cilist io___1771 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 }; - static cilist io___1772 = { 0, 11, 0, "(a21,i1,a2)", 0 }; - static cilist io___1773 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1774 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1775 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1813 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 }; + static cilist io___1814 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 }; + static cilist io___1815 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 }; + static cilist io___1816 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 }; + static cilist io___1817 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 }; + static cilist io___1818 = { 0, 11, 0, "(a21,i1,a2)", 0 }; + static cilist io___1819 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1820 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1821 = { 0, 11, 0, "(a)", 0 }; /* Writes meter stuff to file 11, so only called if islast=.true. */ +#line 24995 "" if (*mtrdnp == 0) { +#line 24995 "" return 0; +#line 24995 "" } +#line 24996 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 24996 "" *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 24997 "" if (*mtrnmp > 0 && *mtrnmp <= 9) { +#line 24998 "" if (*mtrdnp < 10) { - s_wsfe(&io___1767); +#line 24999 "" + s_wsfe(&io___1813); /* Writing concatenation */ +#line 24999 "" i__1[0] = 1, a__1[0] = sq; +#line 24999 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24999 "" i__1[2] = 1, a__1[2] = sq; +#line 24999 "" i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 24999 "" s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 24999 "" do_fio(&c__1, ch__2, (ftnlen)25); +#line 24999 "" do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 24999 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 24999 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24999 "" do_fio(&c__1, "}}%", (ftnlen)3); +#line 24999 "" e_wsfe(); +#line 25002 "" } else { - s_wsfe(&io___1768); +#line 25003 "" + s_wsfe(&io___1814); /* Writing concatenation */ +#line 25003 "" i__1[0] = 1, a__1[0] = sq; +#line 25003 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25003 "" i__1[2] = 1, a__1[2] = sq; +#line 25003 "" i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 25003 "" s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 25003 "" do_fio(&c__1, ch__2, (ftnlen)25); +#line 25003 "" do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 25003 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 25003 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25003 "" do_fio(&c__1, "}}%", (ftnlen)3); +#line 25003 "" e_wsfe(); +#line 25006 "" } +#line 25007 "" } else if (*mtrnmp >= 10) { +#line 25008 "" if (*mtrdnp < 10) { - s_wsfe(&io___1769); +#line 25009 "" + s_wsfe(&io___1815); /* Writing concatenation */ +#line 25009 "" i__1[0] = 1, a__1[0] = sq; +#line 25009 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25009 "" i__1[2] = 1, a__1[2] = sq; +#line 25009 "" i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 25009 "" s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 25009 "" do_fio(&c__1, ch__2, (ftnlen)25); +#line 25009 "" do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 25009 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 25009 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25009 "" do_fio(&c__1, "}}%", (ftnlen)3); +#line 25009 "" e_wsfe(); +#line 25012 "" } else { - s_wsfe(&io___1770); +#line 25013 "" + s_wsfe(&io___1816); /* Writing concatenation */ +#line 25013 "" i__1[0] = 1, a__1[0] = sq; +#line 25013 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25013 "" i__1[2] = 1, a__1[2] = sq; +#line 25013 "" i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 25013 "" s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 25013 "" do_fio(&c__1, ch__2, (ftnlen)25); +#line 25013 "" do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 25013 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 25013 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25013 "" do_fio(&c__1, "}}%", (ftnlen)3); +#line 25013 "" e_wsfe(); +#line 25016 "" } +#line 25017 "" } else if (*mtrnmp < 0) { - s_wsfe(&io___1771); +#line 25018 "" + s_wsfe(&io___1817); /* Writing concatenation */ +#line 25018 "" i__1[0] = 1, a__1[0] = sq; +#line 25018 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25018 "" i__1[2] = 1, a__1[2] = sq; +#line 25018 "" i__1[3] = 11, a__1[3] = "meterfracS{"; +#line 25018 "" s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26); +#line 25018 "" do_fio(&c__1, ch__3, (ftnlen)26); +#line 25018 "" i__2 = -(*mtrnmp); +#line 25018 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 25018 "" do_fio(&c__1, "}{", (ftnlen)2); +#line 25018 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25018 "" do_fio(&c__1, "}}%", (ftnlen)3); +#line 25018 "" e_wsfe(); +#line 25021 "" } else if (*mtrdnp <= 4) { - s_wsfe(&io___1772); +#line 25022 "" + s_wsfe(&io___1818); /* Writing concatenation */ +#line 25022 "" i__1[0] = 1, a__1[0] = sq; +#line 25022 "" i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 25022 "" i__1[2] = 1, a__1[2] = sq; +#line 25022 "" i__1[3] = 6, a__1[3] = "meterN"; +#line 25022 "" s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); +#line 25022 "" do_fio(&c__1, ch__4, (ftnlen)21); +#line 25022 "" do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 25022 "" do_fio(&c__1, "}%", (ftnlen)2); +#line 25022 "" e_wsfe(); +#line 25024 "" } else if (*mtrdnp == 5) { - s_wsfe(&io___1773); +#line 25025 "" + s_wsfe(&io___1819); /* Writing concatenation */ +#line 25025 "" i__1[0] = 1, a__1[0] = sq; +#line 25025 "" i__1[1] = 12, a__1[1] = "generalmeter"; +#line 25025 "" i__1[2] = 1, a__1[2] = sq; +#line 25025 "" i__1[3] = 10, a__1[3] = "allabreve%"; +#line 25025 "" s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); +#line 25025 "" do_fio(&c__1, ch__5, (ftnlen)24); +#line 25025 "" e_wsfe(); +#line 25026 "" } else if (*mtrdnp == 6) { - s_wsfe(&io___1774); +#line 25027 "" + s_wsfe(&io___1820); /* Writing concatenation */ +#line 25027 "" i__1[0] = 1, a__1[0] = sq; +#line 25027 "" i__1[1] = 12, a__1[1] = "generalmeter"; +#line 25027 "" i__1[2] = 1, a__1[2] = sq; +#line 25027 "" i__1[3] = 7, a__1[3] = "meterC%"; +#line 25027 "" s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); +#line 25027 "" do_fio(&c__1, ch__4, (ftnlen)21); +#line 25027 "" e_wsfe(); +#line 25028 "" } else if (*mtrdnp == 7) { - s_wsfe(&io___1775); +#line 25029 "" + s_wsfe(&io___1821); /* Writing concatenation */ +#line 25029 "" i__1[0] = 1, a__1[0] = sq; +#line 25029 "" i__1[1] = 12, a__1[1] = "generalmeter"; +#line 25029 "" i__1[2] = 1, a__1[2] = sq; +#line 25029 "" i__1[3] = 10, a__1[3] = "meterIIIS%"; +#line 25029 "" s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); +#line 25029 "" do_fio(&c__1, ch__5, (ftnlen)24); +#line 25029 "" e_wsfe(); +#line 25030 "" } +#line 25031 "" return 0; } /* wgmeter_ */ @@ -38542,32 +62429,32 @@ L4: extern /* Subroutine */ int printl_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1777 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1778 = { 0, 52, 0, "(a6,10Z4)", 0 }; - static cilist io___1783 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1784 = { 0, 52, 0, "(a6,8z4)", 0 }; - static cilist io___1785 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1786 = { 0, 52, 0, "(a)", 0 }; - static cilist io___1787 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1788 = { 0, 52, 0, "(a)", 0 }; - static cilist io___1791 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1792 = { 0, 52, 0, "(z4)", 0 }; - static cilist io___1793 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1794 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1799 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1800 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 }; - static cilist io___1801 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1802 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1803 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1804 = { 0, 52, 0, "(a)", 0 }; - static icilist io___1806 = { 0, tempoq, 0, "(i2)", 10, 1 }; - static icilist io___1808 = { 0, instq, 0, "(i3)", 10, 1 }; - static cilist io___1809 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1810 = { 0, 52, 0, "(z4)", 0 }; - static cilist io___1811 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1812 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1813 = { 0, 6, 0, "(1x,a12,(10i6))", 0 }; - static cilist io___1814 = { 0, 15, 0, "(1x,a12,(10i6))", 0 }; + static cilist io___1823 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1824 = { 0, 52, 0, "(a6,10Z4)", 0 }; + static cilist io___1829 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1830 = { 0, 52, 0, "(a6,8z4)", 0 }; + static cilist io___1831 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1832 = { 0, 52, 0, "(a)", 0 }; + static cilist io___1833 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1834 = { 0, 52, 0, "(a)", 0 }; + static cilist io___1837 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1838 = { 0, 52, 0, "(z4)", 0 }; + static cilist io___1839 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1840 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1845 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1846 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 }; + static cilist io___1847 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1848 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1849 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1850 = { 0, 52, 0, "(a)", 0 }; + static icilist io___1852 = { 0, tempoq, 0, "(i2)", 10, 1 }; + static icilist io___1854 = { 0, instq, 0, "(i3)", 10, 1 }; + static cilist io___1855 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1856 = { 0, 52, 0, "(z4)", 0 }; + static cilist io___1857 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1858 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1859 = { 0, 6, 0, "(1x,a12,(10i6))", 0 }; + static cilist io___1860 = { 0, 15, 0, "(1x,a12,(10i6))", 0 }; @@ -38579,418 +62466,707 @@ L4: /* Write Header */ - s_wsfe(&io___1777); +#line 25084 "" + s_wsfe(&io___1823); /* Writing concatenation */ +#line 25084 "" i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000"; +#line 25084 "" *(unsigned char *)&ch__2[0] = commidi_1.numchan + 1; +#line 25084 "" i__1[1] = 1, a__1[1] = ch__2; +#line 25084 "" i__1[2] = 1, a__1[2] = "\000"; +#line 25084 "" i__1[3] = 1, a__1[3] = "\360"; +#line 25084 "" s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14); +#line 25084 "" do_fio(&c__1, ch__1, (ftnlen)14); +#line 25084 "" e_wsfe(); +#line 25086 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1778); +#line 25086 "" + s_wsfe(&io___1824); +#line 25086 "" do_fio(&c__1, "\"MThd\"", (ftnlen)6); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" i__2 = commidi_1.numchan + 1; +#line 25086 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25086 "" do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer)); +#line 25086 "" e_wsfe(); +#line 25086 "" } /* Write the "conductor" track, for keys, meter, and tempos */ /* Get the number of bytes in the conductor event stream */ +#line 25093 "" ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[ commidi_1.numchan + commmac_1.nmidsec * 25 - 25]; +#line 25094 "" i__2 = commmac_1.nmidsec - 1; +#line 25094 "" for (isec = 1; isec <= i__2; ++isec) { +#line 25095 "" ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 - 25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; +#line 25096 "" /* L15: */ +#line 25096 "" } /* ib1 = (4+ljob+26+ndata+4)/256 */ /* ib0 = 4+ljob+26+ndata+4-256*ib1 */ +#line 25099 "" ib1 = (*ljob + 31 + ndata + 4) / 256; +#line 25100 "" ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8); - s_wsfe(&io___1783); +#line 25101 "" + s_wsfe(&io___1829); /* Writing concatenation */ +#line 25101 "" i__3[0] = 6, a__2[0] = "MTrk\000\000"; +#line 25101 "" *(unsigned char *)&ch__2[0] = ib1; +#line 25101 "" i__3[1] = 1, a__2[1] = ch__2; +#line 25101 "" *(unsigned char *)&ch__4[0] = ib0; +#line 25101 "" i__3[2] = 1, a__2[2] = ch__4; +#line 25101 "" i__3[3] = 1, a__2[3] = "\000"; +#line 25101 "" i__3[4] = 1, a__2[4] = "\377"; +#line 25101 "" i__3[5] = 1, a__2[5] = "\001"; +#line 25101 "" *(unsigned char *)&ch__5[0] = *ljob + 27; +#line 25101 "" i__3[6] = 1, a__2[6] = ch__5; +#line 25101 "" s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12); +#line 25101 "" do_fio(&c__1, ch__3, (ftnlen)12); +#line 25101 "" e_wsfe(); /* Text header */ /* * //char(0)//char(255)//char(1)//char(ljob+26) */ +#line 25107 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1784); +#line 25107 "" + s_wsfe(&io___1830); +#line 25107 "" do_fio(&c__1, "\"MTrk\"", (ftnlen)6); +#line 25107 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 25107 "" do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); +#line 25107 "" i__2 = *ljob + 27; +#line 25107 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 25107 "" e_wsfe(); +#line 25107 "" } - s_wsfe(&io___1785); +#line 25110 "" + s_wsfe(&io___1831); +#line 25110 "" do_fio(&c__1, jobname, (*ljob)); +#line 25110 "" e_wsfe(); +#line 25111 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1786); +#line 25111 "" + s_wsfe(&io___1832); /* Writing concatenation */ +#line 25111 "" i__4[0] = 1, a__3[0] = "\""; +#line 25111 "" i__4[1] = *ljob, a__3[1] = jobname; +#line 25111 "" i__4[2] = 1, a__3[2] = "\""; +#line 25111 "" s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46); +#line 25111 "" do_fio(&c__1, ch__6, *ljob + 2); +#line 25111 "" e_wsfe(); +#line 25111 "" } /* (separate writes are needed to defeat compiler BUG!!!) */ /* write(51,'(a,$)')'.mid, produced by PMX 2.30' */ - s_wsfe(&io___1787); +#line 25116 "" + s_wsfe(&io___1833); /* Writing concatenation */ +#line 25116 "" i__5[0] = 22, a__4[0] = ".mid, produced by PMX "; +#line 25116 "" i__5[1] = 5, a__4[1] = comver_1.versionc; +#line 25116 "" s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27); +#line 25116 "" do_fio(&c__1, ch__7, (ftnlen)27); +#line 25116 "" e_wsfe(); +#line 25117 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1788); +#line 25117 "" + s_wsfe(&io___1834); /* Writing concatenation */ +#line 25117 "" i__4[0] = 23, a__3[0] = "\".mid, produced by PMX "; +#line 25117 "" i__4[1] = 5, a__3[1] = comver_1.versionc; +#line 25117 "" i__4[2] = 1, a__3[2] = "\""; +#line 25117 "" s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29); +#line 25117 "" do_fio(&c__1, ch__8, (ftnlen)29); +#line 25117 "" e_wsfe(); +#line 25117 "" } /* Conductor event data: Loop over sections. */ +#line 25122 "" i__2 = commmac_1.nmidsec; +#line 25122 "" for (isec = 1; isec <= i__2; ++isec) { +#line 25123 "" if (isec < commmac_1.nmidsec) { +#line 25124 "" mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25]; +#line 25125 "" } else { +#line 25126 "" mend = commidi_1.imidi[commidi_1.numchan]; +#line 25127 "" } +#line 25128 "" i__6 = mend; +#line 25128 "" for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; i__ <= i__6; ++i__) { - s_wsfe(&io___1791); +#line 25129 "" + s_wsfe(&io___1837); +#line 25129 "" *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[ commidi_1.numchan + i__ * 25 - 25]; +#line 25129 "" do_fio(&c__1, ch__2, (ftnlen)1); +#line 25129 "" e_wsfe(); +#line 25130 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1792); +#line 25130 "" + s_wsfe(&io___1838); +#line 25130 "" do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan + i__ * 25 - 25], (ftnlen)sizeof(shortint)); +#line 25130 "" e_wsfe(); +#line 25130 "" } +#line 25131 "" /* L17: */ +#line 25131 "" } +#line 25132 "" /* L16: */ +#line 25132 "" } /* And close out the time sig / tempo track. */ - s_wsfe(&io___1793); +#line 25136 "" + s_wsfe(&io___1839); +#line 25136 "" do_fio(&c__1, "\000\377/\000", (ftnlen)4); +#line 25136 "" e_wsfe(); +#line 25137 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1794); +#line 25137 "" + s_wsfe(&io___1840); +#line 25137 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25137 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 25137 "" do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); +#line 25137 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25137 "" e_wsfe(); +#line 25137 "" } /* Loop over track for each voice: The following sets up iv. */ +#line 25141 "" all_1.iv = all_1.nv; +#line 25142 "" if (commidi_1.twoline[all_1.nv - 1]) { +#line 25143 "" kv = 2; +#line 25144 "" } else { +#line 25145 "" kv = 1; +#line 25146 "" } -/* Moved to pmxab to allow midivel, bal, tran as functions of instrument */ -/* rather than staff (iv) */ -/* c */ -/* c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */ -/* c */ -/* nstaves = 0 */ -/* ivt = 0 */ -/* do 12 iinst = 1 , nm */ -/* nstaves = nstaves+nsperi(iinst) */ -/* do 13 ivtt = 1 , nsperi(iinst) */ -/* ivt = ivt+1 */ -/* iinsiv(ivt) = iinst */ -/* 13 continue */ -/* if (nstaves .eq. nv) go to 14 */ -/* 12 continue */ -/* print*,'Screwup!' */ -/* call stop1() */ -/* 14 continue */ - +#line 25148 "" i__2 = commidi_1.numchan - 1; +#line 25148 "" for (icm = 0; icm <= i__2; ++icm) { /* Get the number of bytes in the data stream */ +#line 25152 "" ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm + commmac_1.nmidsec * 25 - 25]; +#line 25153 "" i__6 = commmac_1.nmidsec - 1; +#line 25153 "" for (isec = 1; isec <= i__6; ++isec) { +#line 25154 "" ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] - commmac_1.msecstrt[icm + isec * 25 - 25]; +#line 25155 "" /* L11: */ +#line 25155 "" } -/* c Add 3 (for instrum) plus 4 (for closing) to byte count, */ /* Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, */ -/* ndata = ndata+7 */ +#line 25159 "" ndata += 11; /* Add 4+lnam(iinsiv(iv)) if lnam>0 , */ +#line 25163 "" if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { +#line 25163 "" ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1]; +#line 25163 "" } /* Separate total byte counts into 4 bytes */ +#line 25167 "" for (ibyte = 1; ibyte <= 4; ++ibyte) { +#line 25168 "" if (ndata > 0) { +#line 25169 "" *(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256); +#line 25170 "" ndata = lbit_shift(ndata, (ftnlen)-8); +#line 25171 "" } else { +#line 25172 "" *(unsigned char *)&byteq[ibyte - 1] = '\0'; +#line 25173 "" } +#line 25174 "" /* L2: */ +#line 25174 "" } /* Now write front stuff for this track */ - s_wsfe(&io___1799); +#line 25178 "" + s_wsfe(&io___1845); /* Writing concatenation */ +#line 25178 "" i__7[0] = 4, a__5[0] = "MTrk"; +#line 25178 "" i__7[1] = 1, a__5[1] = byteq + 3; +#line 25178 "" i__7[2] = 1, a__5[2] = byteq + 2; +#line 25178 "" i__7[3] = 1, a__5[3] = byteq + 1; +#line 25178 "" i__7[4] = 1, a__5[4] = byteq; +#line 25178 "" i__7[5] = 1, a__5[5] = "\000"; +#line 25178 "" *(unsigned char *)&ch__2[0] = icmm[icm] + 192; +#line 25178 "" i__7[6] = 1, a__5[6] = ch__2; +#line 25178 "" *(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[ all_1.iv - 1] - 1]; +#line 25178 "" i__7[7] = 1, a__5[7] = ch__4; +#line 25178 "" i__7[8] = 1, a__5[8] = "\000"; +#line 25178 "" *(unsigned char *)&ch__5[0] = icmm[icm] + 176; +#line 25178 "" i__7[9] = 1, a__5[9] = ch__5; +#line 25178 "" i__7[10] = 1, a__5[10] = "\n"; +#line 25178 "" *(unsigned char *)&ch__10[0] = commvel_1.midbc[icm]; +#line 25178 "" i__7[11] = 1, a__5[11] = ch__10; +#line 25178 "" s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15); +#line 25178 "" do_fio(&c__1, ch__9, (ftnlen)15); +#line 25178 "" e_wsfe(); /* * //char(0)//char(12*16+icmm(icm))//char(midinst(iv)) */ +#line 25182 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1800); +#line 25182 "" + s_wsfe(&io___1846); +#line 25182 "" do_fio(&c__1, "icm=", (ftnlen)4); +#line 25182 "" do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, " \"MTrk\"", (ftnlen)7); +#line 25182 "" i__6 = *(unsigned char *)&byteq[3]; +#line 25182 "" do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer)); +#line 25182 "" i__8 = *(unsigned char *)&byteq[2]; +#line 25182 "" do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer)); +#line 25182 "" i__9 = *(unsigned char *)&byteq[1]; +#line 25182 "" do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer)); +#line 25182 "" i__10 = *(unsigned char *)&byteq[0]; +#line 25182 "" do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25182 "" i__11 = icmm[icm] + 192; +#line 25182 "" do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[ all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25182 "" i__12 = icmm[icm] + 176; +#line 25182 "" do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer)); +#line 25182 "" do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof( integer)); +#line 25182 "" e_wsfe(); +#line 25182 "" } /* * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iv), */ +#line 25187 "" if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { /* Add instrument name as sequence name */ - s_wsfe(&io___1801); +#line 25191 "" + s_wsfe(&io___1847); /* Writing concatenation */ +#line 25191 "" i__5[0] = 3, a__4[0] = "\000\377\003"; +#line 25191 "" *(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[ all_1.iv - 1] - 1]; +#line 25191 "" i__5[1] = 1, a__4[1] = ch__2; +#line 25191 "" s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4); +#line 25191 "" do_fio(&c__1, ch__11, (ftnlen)4); +#line 25191 "" e_wsfe(); +#line 25193 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1802); +#line 25193 "" + s_wsfe(&io___1848); +#line 25193 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25193 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 25193 "" do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer)); +#line 25193 "" do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[ all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); +#line 25193 "" e_wsfe(); +#line 25193 "" } - s_wsfe(&io___1803); +#line 25194 "" + s_wsfe(&io___1849); +#line 25194 "" do_fio(&c__1, comtop_1.inameq + (commvel_1.iinsiv[all_1.iv - 1] - 1) * 79, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] ); +#line 25194 "" e_wsfe(); +#line 25196 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1804); +#line 25196 "" + s_wsfe(&io___1850); /* Writing concatenation */ +#line 25196 "" i__4[0] = 1, a__3[0] = "\""; +#line 25196 "" i__4[1] = comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1], a__3[1] = comtop_1.inameq + (commvel_1.iinsiv[ all_1.iv - 1] - 1) * 79; +#line 25196 "" i__4[2] = 1, a__3[2] = "\""; +#line 25196 "" s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81); +#line 25196 "" do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] + 2); +#line 25196 "" e_wsfe(); +#line 25196 "" } +#line 25198 "" } - s_wsfi(&io___1806); +#line 25199 "" + s_wsfi(&io___1852); +#line 25199 "" do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); +#line 25199 "" e_wsfi(); - s_wsfi(&io___1808); +#line 25200 "" + s_wsfi(&io___1854); +#line 25200 "" do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); +#line 25200 "" e_wsfi(); /* Writing concatenation */ +#line 25201 "" i__1[0] = 16, a__1[0] = "MIDI instrument "; +#line 25201 "" i__1[1] = 2, a__1[1] = tempoq; +#line 25201 "" i__1[2] = 4, a__1[2] = " is "; +#line 25201 "" i__1[3] = 3, a__1[3] = instq; +#line 25201 "" s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25); +#line 25201 "" printl_(ch__13, (ftnlen)25); /* Notes: Loop over sections. */ +#line 25205 "" i__6 = commmac_1.nmidsec; +#line 25205 "" for (isec = 1; isec <= i__6; ++isec) { +#line 25206 "" if (isec < commmac_1.nmidsec) { +#line 25207 "" mend = commmac_1.msecend[icm + isec * 25 - 25]; +#line 25208 "" } else { +#line 25209 "" mend = commidi_1.imidi[icm]; +#line 25210 "" } +#line 25211 "" i__8 = mend; +#line 25211 "" for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8; ++i__) { - s_wsfe(&io___1809); +#line 25212 "" + s_wsfe(&io___1855); +#line 25212 "" *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm + i__ * 25 - 25]; +#line 25212 "" do_fio(&c__1, ch__2, (ftnlen)1); +#line 25212 "" e_wsfe(); +#line 25213 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1810); +#line 25213 "" + s_wsfe(&io___1856); +#line 25213 "" do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 - 25], (ftnlen)sizeof(shortint)); +#line 25213 "" e_wsfe(); +#line 25213 "" } +#line 25214 "" /* L10: */ +#line 25214 "" } +#line 25215 "" /* L9: */ +#line 25215 "" } /* Closing 4 bytes */ - s_wsfe(&io___1811); +#line 25219 "" + s_wsfe(&io___1857); /* Writing concatenation */ +#line 25219 "" chax_(ch__2, (ftnlen)1, &c__0); +#line 25219 "" i__1[0] = 1, a__1[0] = ch__2; +#line 25219 "" i__1[1] = 1, a__1[1] = "\377"; +#line 25219 "" i__1[2] = 1, a__1[2] = "/"; +#line 25219 "" i__1[3] = 1, a__1[3] = "\000"; +#line 25219 "" s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4); +#line 25219 "" do_fio(&c__1, ch__11, (ftnlen)4); +#line 25219 "" e_wsfe(); +#line 25220 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1812); +#line 25220 "" + s_wsfe(&io___1858); +#line 25220 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25220 "" do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 25220 "" do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); +#line 25220 "" do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 25220 "" e_wsfe(); +#line 25220 "" } +#line 25221 "" if (kv == 2) { +#line 25222 "" kv = 1; +#line 25223 "" } else if (all_1.iv == 1) { +#line 25224 "" goto L5; +#line 25225 "" } else { +#line 25226 "" --all_1.iv; +#line 25227 "" if (commidi_1.twoline[all_1.iv - 1]) { +#line 25227 "" kv = 2; +#line 25227 "" } +#line 25228 "" } +#line 25229 "" L5: +#line 25229 "" ; +#line 25229 "" } - s_wsfe(&io___1813); +#line 25230 "" + s_wsfe(&io___1859); +#line 25230 "" do_fio(&c__1, "Bytes used:", (ftnlen)11); +#line 25230 "" i__2 = commidi_1.numchan; +#line 25230 "" for (icm = 0; icm <= i__2; ++icm) { +#line 25230 "" do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); +#line 25230 "" } +#line 25230 "" e_wsfe(); - s_wsfe(&io___1814); +#line 25231 "" + s_wsfe(&io___1860); +#line 25231 "" do_fio(&c__1, "Bytes used:", (ftnlen)11); +#line 25231 "" i__2 = commidi_1.numchan; +#line 25231 "" for (icm = 0; icm <= i__2; ++icm) { +#line 25231 "" do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); +#line 25231 "" } +#line 25231 "" e_wsfe(); +#line 25233 "" cl__1.cerr = 0; +#line 25233 "" cl__1.cunit = 51; +#line 25233 "" cl__1.csta = 0; +#line 25233 "" f_clos(&cl__1); +#line 25234 "" if (commidi_1.debugmidi) { +#line 25234 "" cl__1.cerr = 0; +#line 25234 "" cl__1.cunit = 52; +#line 25234 "" cl__1.csta = 0; +#line 25234 "" f_clos(&cl__1); +#line 25234 "" } +#line 25235 "" return 0; } /* writemidi_ */ @@ -39015,79 +63191,143 @@ L5: static char notexq[79]; /* Fortran I/O blocks */ - static cilist io___1818 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1864 = { 0, 11, 0, "(a)", 0 }; /* Assumes notexq is blank */ +#line 25246 "" /* Parameter adjustments */ +#line 25246 "" --itranskey; +#line 25246 "" --iinsttrans; +#line 25246 "" +#line 25246 "" /* Function Body */ +#line 25246 "" i__1 = *ninsttrans; +#line 25246 "" for (i__ = 1; i__ <= i__1; ++i__) { /* Writing concatenation */ +#line 25247 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 25247 "" i__2[0] = 1, a__1[0] = ch__1; +#line 25247 "" i__2[1] = 7, a__1[1] = "setsign"; +#line 25247 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 25248 "" lnote = 8; +#line 25249 "" if (iinsttrans[i__] < 10) { /* Writing concatenation */ +#line 25250 "" i__2[0] = lnote, a__1[0] = notexq; +#line 25250 "" i__3 = iinsttrans[i__] + 48; +#line 25250 "" chax_(ch__1, (ftnlen)1, &i__3); +#line 25250 "" i__2[1] = 1, a__1[1] = ch__1; +#line 25250 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 25251 "" ++lnote; +#line 25252 "" } else { +#line 25253 "" i__3 = lnote; +#line 25253 "" ici__1.icierr = 0; +#line 25253 "" ici__1.icirnum = 1; +#line 25253 "" ici__1.icirlen = lnote + 4 - i__3; +#line 25253 "" ici__1.iciunit = notexq + i__3; +#line 25253 "" ici__1.icifmt = "(a1,i2,a1)"; +#line 25253 "" s_wsfi(&ici__1); +#line 25253 "" do_fio(&c__1, "{", (ftnlen)1); +#line 25253 "" do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer)); +#line 25253 "" do_fio(&c__1, "}", (ftnlen)1); +#line 25253 "" e_wsfi(); +#line 25255 "" lnote += 4; +#line 25256 "" } +#line 25257 "" if (itranskey[i__] < 0) { +#line 25258 "" i__3 = lnote; +#line 25258 "" ici__1.icierr = 0; +#line 25258 "" ici__1.icirnum = 1; +#line 25258 "" ici__1.icirlen = lnote + 4 - i__3; +#line 25258 "" ici__1.iciunit = notexq + i__3; +#line 25258 "" ici__1.icifmt = "(a1,i2,a1)"; +#line 25258 "" s_wsfi(&ici__1); +#line 25258 "" do_fio(&c__1, "{", (ftnlen)1); +#line 25258 "" do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer)); +#line 25258 "" do_fio(&c__1, "}", (ftnlen)1); +#line 25258 "" e_wsfi(); +#line 25260 "" lnote += 4; +#line 25261 "" } else { /* Writing concatenation */ +#line 25262 "" i__2[0] = lnote, a__1[0] = notexq; +#line 25262 "" i__3 = itranskey[i__] + 48; +#line 25262 "" chax_(ch__1, (ftnlen)1, &i__3); +#line 25262 "" i__2[1] = 1, a__1[1] = ch__1; +#line 25262 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 25263 "" ++lnote; +#line 25264 "" } - s_wsfe(&io___1818); +#line 25265 "" + s_wsfe(&io___1864); /* Writing concatenation */ +#line 25265 "" i__2[0] = lnote, a__1[0] = notexq; +#line 25265 "" i__2[1] = 1, a__1[1] = "%"; +#line 25265 "" s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80); +#line 25265 "" do_fio(&c__1, ch__2, lnote + 1); +#line 25265 "" e_wsfe(); +#line 25266 "" /* L1: */ +#line 25266 "" } +#line 25267 "" *flag__ = FALSE_; +#line 25268 "" return 0; } /* writesetsign_ */ @@ -39102,40 +63342,75 @@ L5: integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) ; +#line 25272 "" if (*x < .95f) { +#line 25273 "" i__1 = *lenline; +#line 25273 "" ici__1.icierr = 0; +#line 25273 "" ici__1.icirnum = 1; +#line 25273 "" ici__1.icirlen = *lenline + 2 - i__1; +#line 25273 "" ici__1.iciunit = notexq + i__1; +#line 25273 "" ici__1.icifmt = "(f2.1)"; +#line 25273 "" s_wsfi(&ici__1); +#line 25273 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 25273 "" e_wsfi(); +#line 25274 "" *lenline += 2; +#line 25275 "" } else if (*x < 9.95f) { +#line 25276 "" i__1 = *lenline; +#line 25276 "" ici__1.icierr = 0; +#line 25276 "" ici__1.icirnum = 1; +#line 25276 "" ici__1.icirlen = *lenline + 3 - i__1; +#line 25276 "" ici__1.iciunit = notexq + i__1; +#line 25276 "" ici__1.icifmt = "(f3.1)"; +#line 25276 "" s_wsfi(&ici__1); +#line 25276 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 25276 "" e_wsfi(); +#line 25277 "" *lenline += 3; +#line 25278 "" } else { +#line 25279 "" i__1 = *lenline; +#line 25279 "" ici__1.icierr = 0; +#line 25279 "" ici__1.icirnum = 1; +#line 25279 "" ici__1.icirlen = *lenline + 4 - i__1; +#line 25279 "" ici__1.iciunit = notexq + i__1; +#line 25279 "" ici__1.icifmt = "(f4.1)"; +#line 25279 "" s_wsfi(&ici__1); +#line 25279 "" do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 25279 "" e_wsfi(); +#line 25280 "" *lenline += 4; +#line 25281 "" } +#line 25282 "" return 0; } /* writflot_ */ @@ -39163,11 +63438,11 @@ L5: extern integer numclef_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1821 = { 0, 6, 0, 0, 0 }; - static cilist io___1822 = { 0, 6, 0, 0, 0 }; - static icilist io___1826 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 }; - static cilist io___1827 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1829 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1867 = { 0, 6, 0, 0, 0 }; + static cilist io___1868 = { 0, 6, 0, 0, 0 }; + static icilist io___1872 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 }; + static cilist io___1873 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1875 = { 0, 11, 0, "(a)", 0 }; /* subroutine wsclef(iv,ninow,clefq,nclef) */ @@ -39178,100 +63453,179 @@ L5: /* In pmx271, had removed clefq, so with 2 or more staves in */ /* an instrument, had problems. So replace in 272 */ +#line 25301 "" if (*nclef < 7) { +#line 25302 "" i__1 = *nclef + 48; +#line 25302 "" chax_(ch__1, (ftnlen)1, &i__1); +#line 25302 "" *(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)& ch__1[0]; +#line 25303 "" } else { +#line 25304 "" *(unsigned char *)&comclefq_1.clefq[*iv - 1] = '9'; +#line 25305 "" } +#line 25306 "" if (! comlast_1.islast) { +#line 25306 "" return 0; +#line 25306 "" } +#line 25307 "" iv1 = 1; +#line 25308 "" i__1 = *ninow; +#line 25308 "" for (iinst = 1; iinst <= i__1; ++iinst) { +#line 25309 "" if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) { +#line 25309 "" goto L2; +#line 25309 "" } +#line 25310 "" iv1 += comnvi_1.nspern[iinst - 1]; +#line 25311 "" /* L1: */ +#line 25311 "" } - s_wsle(&io___1821); +#line 25312 "" + s_wsle(&io___1867); +#line 25312 "" e_wsle(); - s_wsle(&io___1822); +#line 25313 "" + s_wsle(&io___1868); +#line 25313 "" do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29); +#line 25313 "" e_wsle(); +#line 25314 "" stop1_(); +#line 25315 "" L2: /* Here, iinst is the instrument number with staff of clef change */ +#line 25319 "" iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1; +#line 25320 "" if (iinst < 10) { /* Writing concatenation */ +#line 25321 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 25321 "" i__2[0] = 1, a__1[0] = ch__1; +#line 25321 "" i__2[1] = 7, a__1[1] = "setclef"; +#line 25321 "" i__1 = iinst + 48; +#line 25321 "" chax_(ch__2, (ftnlen)1, &i__1); +#line 25321 "" i__2[2] = 1, a__1[2] = ch__2; +#line 25321 "" s_cat(temq, a__1, i__2, &c__3, (ftnlen)20); +#line 25322 "" ltem = 9; +#line 25323 "" } else { - s_wsfi(&io___1826); +#line 25324 "" + s_wsfi(&io___1872); /* Writing concatenation */ +#line 25324 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 25324 "" i__3[0] = 1, a__2[0] = ch__1; +#line 25324 "" i__3[1] = 8, a__2[1] = "setclef{"; +#line 25324 "" s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9); +#line 25324 "" do_fio(&c__1, ch__3, (ftnlen)9); +#line 25324 "" do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +#line 25324 "" do_fio(&c__1, "}", (ftnlen)1); +#line 25324 "" e_wsfi(); +#line 25325 "" ltem = 12; +#line 25326 "" } +#line 25327 "" if (iv1 == iv2) { /* Only one staff (iv) in instrument with clef change */ - s_wsfe(&io___1827); +#line 25331 "" + s_wsfe(&io___1873); /* Writing concatenation */ +#line 25331 "" i__2[0] = ltem, a__1[0] = temq; +#line 25331 "" i__2[1] = 1, a__1[1] = comclefq_1.clefq + (*iv - 1); +#line 25331 "" i__2[2] = 1, a__1[2] = "%"; +#line 25331 "" s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)22); +#line 25331 "" do_fio(&c__1, ch__4, ltem + 2); +#line 25331 "" e_wsfe(); +#line 25332 "" } else { /* Writing concatenation */ +#line 25333 "" i__3[0] = ltem, a__2[0] = temq; +#line 25333 "" i__3[1] = 1, a__2[1] = "{"; +#line 25333 "" s_cat(temq, a__2, i__3, &c__2, (ftnlen)20); +#line 25334 "" ++ltem; /* Loop over staves, but clefq has only changed for one of them */ +#line 25338 "" i__1 = iv2; +#line 25338 "" for (iiv = iv1; iiv <= i__1; ++iiv) { /* Writing concatenation */ +#line 25339 "" i__3[0] = ltem, a__2[0] = temq; +#line 25339 "" i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (ftnlen)1) + 48; +#line 25339 "" chax_(ch__1, (ftnlen)1, &i__4); +#line 25339 "" i__3[1] = 1, a__2[1] = ch__1; +#line 25339 "" s_cat(temq, a__2, i__3, &c__2, (ftnlen)20); +#line 25340 "" ++ltem; +#line 25341 "" /* L3: */ +#line 25341 "" } - s_wsfe(&io___1829); +#line 25342 "" + s_wsfe(&io___1875); /* Writing concatenation */ +#line 25342 "" i__3[0] = ltem, a__2[0] = temq; +#line 25342 "" i__3[1] = 2, a__2[1] = "}%"; +#line 25342 "" s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)22); +#line 25342 "" do_fio(&c__1, ch__4, ltem + 2); +#line 25342 "" e_wsfe(); +#line 25343 "" } +#line 25344 "" return 0; } /* wsclef_ */ @@ -39290,65 +63644,95 @@ L2: extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, ftnlen); +#line 25349 "" *lyrerr = 0; /* On entry, last char was " */ +#line 25353 "" L18: +#line 25353 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 25354 "" if (*iccount == 121) { +#line 25355 "" *lyrerr = 2; +#line 25356 "" return 0; /* else if (charq.eq.'"') then */ +#line 25358 "" } else /* if(complicated condition) */ { +#line 25358 "" i__1 = *iccount - 2; +#line 25358 "" if (*(unsigned char *)charq == '"' && ! (s_cmp(lineq + i__1, "\\", * iccount - 1 - i__1, (ftnlen)1) == 0)) { +#line 25360 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); /* Check for raise/lower command */ +#line 25364 "" if (*(unsigned char *)charq == '@') { /* @ positions lyrics vertically for current voice */ /* [a,b] above or below of the staff */ /* +/- i offset, \internotes */ +#line 25370 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 25371 "" if (i_indx("ab", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 25372 "" *lyrerr = 3; +#line 25373 "" return 0; +#line 25374 "" } +#line 25375 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 25376 "" if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 25377 "" *lyrerr = 4; +#line 25378 "" return 0; +#line 25379 "" } +#line 25380 "" g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 25381 "" if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) == 0) { +#line 25382 "" *lyrerr = 5; +#line 25383 "" return 0; +#line 25384 "" } +#line 25385 "" } else if (*(unsigned char *)charq != ' ') { /* 2nd " must be followed by ' ' */ +#line 25389 "" *lyrerr = 1; +#line 25390 "" return 0; +#line 25391 "" } +#line 25392 "" return 0; +#line 25393 "" } +#line 25393 "" } +#line 25394 "" goto L18; } /* chkpmxlyr_ */ /* Subroutine */ int dopmxlyr_(char *lineq, integer *iccount, ftnlen lineq_len) { - /* Initialized data */ - - static char sq[1] = "\\"; - /* System generated locals */ address a__1[4], a__2[6], a__3[7]; integer i__1, i__2[4], i__3[6], i__4, i__5[7]; @@ -39361,6 +63745,7 @@ L18: s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ + static char sq[1]; static integer i2nd, iend; extern /* Subroutine */ int stop1_(void); static integer itilde; @@ -39369,7 +63754,7 @@ L18: extern integer lenstr_(char *, integer *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1836 = { 0, 6, 0, 0, 0 }; + static cilist io___1882 = { 0, 6, 0, 0, 0 }; @@ -39377,92 +63762,169 @@ L18: /* with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', */ /* (unless preceded with '\'), check length */ +#line 25404 "" + *(unsigned char *)sq = '\\'; +#line 25405 "" iend = lenstr_(lineq, &c__128, (ftnlen)128); /* i2nd = iccount+index(lineq(iccount+1:128),'"') */ /* Find position of closing '"'; must bypass any \" which is used for umlaut */ +#line 25410 "" i__1 = *iccount; +#line 25410 "" i2nd = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 25411 "" L2: +#line 25412 "" i__1 = i2nd - 2; +#line 25412 "" if (s_cmp(lineq + i__1, "\\", i2nd - 1 - i__1, (ftnlen)1) == 0) { +#line 25413 "" i__1 = i2nd; +#line 25413 "" i2nd += i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 25414 "" goto L2; +#line 25415 "" } +#line 25416 "" istart = *iccount; +#line 25417 "" L1: +#line 25417 "" i__1 = istart; +#line 25417 "" itilde = istart + i_indx(lineq + i__1, "~", i2nd - 1 - i__1, (ftnlen)1); +#line 25418 "" if (itilde > istart && itilde < i2nd) { /* Replace tilde if not preceded by \ */ +#line 25422 "" if (iend >= 117) { - s_wsle(&io___1836); +#line 25423 "" + s_wsle(&io___1882); +#line 25423 "" do_lio(&c__9, &c__1, "Sorry, lyric string is too long, stopping", (ftnlen)41); +#line 25423 "" e_wsle(); +#line 25424 "" stop1_(); +#line 25425 "" } else /* if(complicated condition) */ { +#line 25425 "" i__1 = itilde - 2; +#line 25425 "" if (s_cmp(lineq + i__1, sq, itilde - 1 - i__1, (ftnlen)1) == 0) { +#line 25426 "" istart = itilde; +#line 25427 "" goto L1; +#line 25428 "" } +#line 25428 "" } +#line 25429 "" i__1 = itilde; /* Writing concatenation */ +#line 25429 "" i__2[0] = itilde - 1, a__1[0] = lineq; +#line 25429 "" i__2[1] = 1, a__1[1] = sq; +#line 25429 "" i__2[2] = 3, a__1[2] = "lk "; +#line 25429 "" i__2[3] = iend - i__1, a__1[3] = lineq + i__1; +#line 25429 "" s_cat(lineqt, a__1, i__2, &c__4, (ftnlen)128); +#line 25431 "" iend = lenstr_(lineqt, &c__128, (ftnlen)128); +#line 25432 "" i2nd += 3; +#line 25433 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 25434 "" goto L1; +#line 25435 "" } +#line 25436 "" if (*iccount == 1) { +#line 25437 "" i__1 = i2nd; /* Writing concatenation */ +#line 25437 "" i__3[0] = 1, a__2[0] = sq; +#line 25437 "" i__3[1] = 7, a__2[1] = "pmxlyr{"; +#line 25437 "" i__3[2] = i2nd - 2, a__2[2] = lineq + 1; +#line 25437 "" i__3[3] = 1, a__2[3] = "}"; +#line 25437 "" i__3[4] = 1, a__2[4] = sq; +#line 25437 "" i__3[5] = 128 - i__1, a__2[5] = lineq + i__1; +#line 25437 "" s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); +#line 25439 "" } else { +#line 25440 "" i__1 = *iccount; +#line 25440 "" i__4 = i2nd; /* Writing concatenation */ +#line 25440 "" i__5[0] = *iccount - 1, a__3[0] = lineq; +#line 25440 "" i__5[1] = 1, a__3[1] = sq; +#line 25440 "" i__5[2] = 7, a__3[2] = "pmxlyr{"; +#line 25440 "" i__5[3] = i2nd - 1 - i__1, a__3[3] = lineq + i__1; +#line 25440 "" i__5[4] = 1, a__3[4] = "}"; +#line 25440 "" i__5[5] = 1, a__3[5] = sq; +#line 25440 "" i__5[6] = 128 - i__4, a__3[6] = lineq + i__4; +#line 25440 "" s_cat(lineqt, a__3, i__5, &c__7, (ftnlen)128); +#line 25443 "" } +#line 25444 "" i2nd += 8; +#line 25445 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 25446 "" i__1 = i2nd; +#line 25446 "" if (s_cmp(lineq + i__1, "@", i2nd + 1 - i__1, (ftnlen)1) == 0) { +#line 25447 "" i__1 = i2nd + 1; +#line 25447 "" i__4 = i2nd + 4; /* Writing concatenation */ +#line 25447 "" i__3[0] = i2nd, a__2[0] = lineq; +#line 25447 "" i__3[1] = 3, a__2[1] = "at{"; +#line 25447 "" i__3[2] = i2nd + 4 - i__1, a__2[2] = lineq + i__1; +#line 25447 "" i__3[3] = 1, a__2[3] = "}"; +#line 25447 "" i__3[4] = 1, a__2[4] = sq; +#line 25447 "" i__3[5] = 128 - i__4, a__2[5] = lineq + i__4; +#line 25447 "" s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); +#line 25449 "" s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 25450 "" } +#line 25451 "" return 0; } /* dopmxlyr_ */ diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.mid b/Build/source/utils/pmx/pmx-src/tests/barsant.mid Binary files differindex cd8b9c33ee8..81ed8ffbd26 100644 --- a/Build/source/utils/pmx/pmx-src/tests/barsant.mid +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.mid diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.pml b/Build/source/utils/pmx/pmx-src/tests/barsant.pml index 36a0b59989c..86c10b3ca4b 100644 --- a/Build/source/utils/pmx/pmx-src/tests/barsant.pml +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.pml @@ -1,4 +1,4 @@ -This is PMX, Version 2.76 , 24 Nov 16 +This is PMX, Version 2.84 , 10 Feb 18 Opening barsant.pmx Starting first PMX pass diff --git a/Build/source/utils/pmx/pmx-src/version.ac b/Build/source/utils/pmx/pmx-src/version.ac index 5ec24b2cc5d..922c5f9c51e 100644 --- a/Build/source/utils/pmx/pmx-src/version.ac +++ b/Build/source/utils/pmx/pmx-src/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.7.6]) +m4_define([pmx_version], [2.8.4]) diff --git a/Build/source/utils/pmx/pmxab.1 b/Build/source/utils/pmx/pmxab.1 index 381324e5641..348517f4aee 100644 --- a/Build/source/utils/pmx/pmxab.1 +++ b/Build/source/utils/pmx/pmxab.1 @@ -1,4 +1,4 @@ -.TH pmxab 1 "2 Feb 2016" "Version 2.7.3" "PMX Manual Page" +.TH pmxab 1 "12 Feb 2018" "Version 2.8.4" "PMX Manual Page" .SH NAME pmxab \- a MusiXTeX preprocessor .SH SYNOPSIS diff --git a/Build/source/utils/pmx/version.ac b/Build/source/utils/pmx/version.ac index dc2fa993f6d..dc5334bd99d 100644 --- a/Build/source/utils/pmx/version.ac +++ b/Build/source/utils/pmx/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.7.6]) +m4_define([pmx_version], [2.8.4]) |