diff options
Diffstat (limited to 'Build/source/utils/pmx/pmx-2.6.18/scor2prt.c')
-rw-r--r-- | Build/source/utils/pmx/pmx-2.6.18/scor2prt.c | 2775 |
1 files changed, 2775 insertions, 0 deletions
diff --git a/Build/source/utils/pmx/pmx-2.6.18/scor2prt.c b/Build/source/utils/pmx/pmx-2.6.18/scor2prt.c new file mode 100644 index 00000000000..9dd04f65961 --- /dev/null +++ b/Build/source/utils/pmx/pmx-2.6.18/scor2prt.c @@ -0,0 +1,2775 @@ +/* -- translated by f2c (version 20031025). + You must link the resulting object file with libf2c: + on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm + or, if you install libf2c.a in a standard place, with -lf2c -lm + -- in that order, at the end of the command line, as in + cc *.o -lf2c -lm + Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., + + http://www.netlib.org/f2c/libf2c.zip +*/ + +#include "f2c.h" + +/* Common Block Declarations */ + +struct all_1_ { + integer noinow, iorig[24], noinst; + logical insetup, replacing; + integer instnum[24]; + logical botv[24]; + integer nvi[24], nsyst, nvnow; +}; + +#define all_1 (*(struct all_1_ *) &all_) + +/* Initialized data */ + +struct { + integer e_1; + integer fill_2[24]; + integer e_3; + integer fill_4[26]; + logical e_5[24]; + integer e_6[24]; + integer fill_7[2]; + } all_ = { 24, {0}, 24, {0}, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, + FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, + FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, FALSE_, + FALSE_, FALSE_, FALSE_, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }; + + +/* Table of constant values */ + +static integer c__9 = 9; +static integer c__1 = 1; +static integer c__27 = 27; +static integer c__2 = 2; +static integer c__128 = 128; +static integer c_n1 = -1; +static integer c__0 = 0; +static integer c__3 = 3; +static integer c__4 = 4; +static integer c__5 = 5; +static integer c__79 = 79; +static integer c__125 = 125; + +/* ccccccccccccccccccccccccc */ +/* c */ +/* c scor2prt 7/24/11 for PMX 2.615 */ +/* ccccccccccccccccccccccccc */ +/* This program, developed by Don Simons (dsimons@roadrunner.com), is */ +/* part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert */ +/* with MusiXTeX and TeX, the purpose of PMX is to allow the user to create */ +/* high-quality typeset musical scores by including a sequence of PMX commands */ +/* in an ASCII input file. Scor2prt is an auxiliary program that creates PMX */ +/* input files for individual parts from the PMX input file for the score. */ + +/* This program is free software: you can redistribute it and/or modify */ +/* it under the terms of the GNU General Public License as published by */ +/* the Free Software Foundation, either version 3 of the License, or */ +/* (at your option) any later version. */ + +/* This program is distributed in the hope that it will be useful, */ +/* but WITHOUT ANY WARRANTY; without even the implied warranty of */ +/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ +/* GNU General Public License for more details. */ + +/* You should have received a copy of the GNU General Public License */ +/* along with this program. If not, see <http://www.gnu.org/licenses/>. */ + + +/* 7/18/11 */ +/* Start to fix up for AS..., also Ki was done a little earlier. */ +/* 7/5/10 */ +/* Modify Manual to explain extended hex numbering for part-specific comments */ +/* 5/16/10 */ +/* Extend part-specific comments for up to 24 parts (subroutine chkcom) */ +/* Allow files 11-34 for parts */ +/* Change file 30 to 40 */ +/* 6/1/08 es2p */ +/* noimax = 24 */ + +/* To do */ +/* Override fracindent, musicsize? */ +/* Deal with midbar R? */ +/* 2/29/04 */ +/* Check for special character being in quoted string. */ +/* 10/20/02 PMX 2.407 */ +/* Interpret AN[n]"[used-defined-part-file-name]" */ +/* 1/21/02 */ +/* Deals with rm in multiple parts. */ +/* s2p15 */ +/* Get right non-tex index even if there's "\" inside D"..." */ +/* s2p14 */ +/* 10/29/00 fix transfer to parts of negative mtrdnp */ +/* 4/29/00 screen for "%%" followed by "T" */ +/* Restore change from "Version 2.1a, 21 Dec" */ +/* s2p13 */ +/* Allow whole-bar double-whole rests. */ +/* Bypass MIDI commands "I..." achar(10)="I" */ +/* s2p12 */ +/* Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla */ +/* only taken as such if ? represents a hex digit .le. noinst, otherwise it's */ +/* a simple comment. This lessens incompatibility. */ +/* In subroutine mbrest, properly open parts 10-12 if needed */ +/* s2p11 */ +/* Ignore leading blanks */ +/* Fix undefined linelength in mbrest at very end of comments. */ +/* s2p10 */ +/* Fix non-transfer of P..c" " */ +/* Allow "%%" and "%"n anywhere */ +/* Version 1.43 */ +/* Fix bug with P in TeX string. */ +/* Ignore shifted whole-bar rests when consolidating whole-bar rests */ +/* Copy type 4 TeX into all parts. */ +/* Deal with XB and XP. */ +/* Permit transfer of blank line into parts */ +/* Change staves/inst in 'M' command. */ +/* Arbitrary staves/inst. */ +/* Recognize m1/2/3/4 syntax. */ +/* Enable comment and one-voice syntax in instrument names */ + +/* Changes since 1.1 */ +/* Deal with saved macros. */ +/* Revise setup readin, to admit comments. */ +/* Do not copy 'X' into parts */ + +/* ccccccccccccccccccccccccccccccccccccccccccccccc */ +/* Main program */ int MAIN__(void) +{ + /* Initialized data */ + + static char achar[1*10] = "P" "m" "V" "R" "A" "h" "w" "K" "M" "I"; + + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1, i__2, i__3[2], i__4[3]; + char ch__1[44], ch__2[31], ch__3[4], ch__4[1], ch__5[2], ch__6[131]; + cilist ci__1; + icilist ici__1; + olist o__1; + cllist cl__1; + alist al__1; + inlist ioin__1; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_rsfe(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer i_indx(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer f_inqu(inlist *), f_open(olist *), s_cmp(char *, char *, ftnlen, + ftnlen), f_back(alist *), s_wsfe(cilist *), e_wsfe(void), s_rsfi( + icilist *), e_rsfi(void), f_clos(cllist *); + + /* Local variables */ + extern /* Subroutine */ int oddquotesbefore_(char *, integer *, logical *, + ftnlen); + static logical clefpend; + static real xmtrnum0; + static char templine[128]; + extern /* Subroutine */ int allparts_(char *, integer *, ftnlen); + static integer musicsize, ia, ib, ic, iv; + static char sq[1]; + static integer nv, idxendname; + static real fracindent; + static integer ibb, len, ivq, iend, nchk, idxa, ljob; + static char line[128]; + static integer isig, locp, idxq, ndxm, idxs, inst, idxq2, idxstartname; + extern integer iargc_(void); + static integer kvend; + extern /* Subroutine */ int zapbl_(char *, integer *, ftnlen); + static integer itemp, iinst, ntinx; + static logical oneof2; + extern doublereal readin_(char *, integer *, integer *, ftnlen); + extern /* Subroutine */ int chkcom_(char *, ftnlen), getarg_(integer *, + char *, ftnlen); + static integer npages; + static char holdln[128]; + static integer iudpfn; + static logical yesodd; + static integer ludpfn[24]; + static char udpfnq[128*24]; + static integer iiinst; + static logical fexist; + static integer ivlast, mtrdnp; + extern integer lenstr_(char *, integer *, ftnlen); + static logical frstln; + static integer insnow, ndxpmx, mtrnmp; + static logical isachar; + static char jobname[27]; + static integer lenhold, lenline; + static char infileq[27]; + static logical gotname; + static integer iccount, mtrdenl; + extern integer ntindex_(char *, char *, ftnlen, ftnlen); + static integer numargs; + extern /* Subroutine */ int mbrests_(integer *, char *, integer *, + integer *, char *, ftnlen, ftnlen); + static logical termrpt; + static integer mtrnuml; + static char termsym[2], instrum[128*24]; + static integer kvstart; + + /* Fortran I/O blocks */ + static cilist io___6 = { 0, 6, 0, 0, 0 }; + static cilist io___8 = { 0, 6, 0, 0, 0 }; + static cilist io___9 = { 0, 6, 0, 0, 0 }; + static cilist io___10 = { 0, 5, 0, "(a)", 0 }; + static cilist io___13 = { 0, 6, 0, 0, 0 }; + static cilist io___17 = { 0, 6, 0, 0, 0 }; + static cilist io___20 = { 0, 10, 0, "(a)", 0 }; + static cilist io___22 = { 0, 10, 0, "(a)", 0 }; + static cilist io___23 = { 0, 10, 0, "(a)", 0 }; + static cilist io___38 = { 0, 6, 0, 0, 0 }; + static cilist io___39 = { 0, 6, 0, 0, 0 }; + static cilist io___40 = { 0, 6, 0, 0, 0 }; + static cilist io___41 = { 0, 10, 0, "(a)", 0 }; + static cilist io___42 = { 0, 10, 0, "(a)", 0 }; + static cilist io___44 = { 0, 10, 0, "(a)", 0 }; + static cilist io___46 = { 0, 10, 0, "(a)", 0 }; + static cilist io___48 = { 0, 6, 0, 0, 0 }; + static cilist io___49 = { 0, 0, 0, "(a)", 0 }; + static cilist io___50 = { 0, 10, 0, "(a)", 0 }; + static cilist io___51 = { 0, 10, 0, "(a)", 0 }; + static cilist io___55 = { 0, 10, 0, "(a)", 0 }; + static cilist io___57 = { 0, 0, 0, "(a2/a)", 0 }; + static cilist io___59 = { 0, 10, 1, "(a)", 0 }; + static cilist io___61 = { 0, 10, 0, "(a)", 0 }; + static cilist io___62 = { 0, 10, 0, "(a)", 0 }; + static cilist io___68 = { 0, 6, 0, 0, 0 }; + static cilist io___69 = { 0, 6, 0, 0, 0 }; + static cilist io___72 = { 0, 10, 0, "(a)", 0 }; + static cilist io___76 = { 0, 6, 0, 0, 0 }; + static cilist io___77 = { 0, 6, 0, 0, 0 }; + static cilist io___78 = { 0, 6, 0, 0, 0 }; + static cilist io___81 = { 0, 10, 0, "(a)", 0 }; + static cilist io___83 = { 0, 6, 0, 0, 0 }; + static cilist io___84 = { 0, 6, 0, 0, 0 }; + static icilist io___85 = { 0, line+2, 0, "(i1)", 1, 1 }; + static icilist io___88 = { 0, line+2, 0, "(i2)", 2, 1 }; + static cilist io___89 = { 0, 6, 0, 0, 0 }; + static cilist io___90 = { 0, 6, 0, 0, 0 }; + static cilist io___97 = { 0, 0, 0, "(a)", 0 }; + static cilist io___102 = { 0, 0, 0, "(a)", 0 }; + static cilist io___103 = { 0, 0, 0, "(a)", 0 }; + + + clefpend = FALSE_; + all_1.insetup = TRUE_; + all_1.replacing = FALSE_; + frstln = TRUE_; + lenhold = 0; + *(unsigned char *)sq = '\\'; + s_wsle(&io___6); + do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.615, 24 July 2011", ( + ftnlen)44); + e_wsle(); + numargs = iargc_(); + if (numargs == 0) { + s_wsle(&io___8); + do_lio(&c__9, &c__1, "You could have entered a jobname on the comman" + "d line,", (ftnlen)53); + e_wsle(); + s_wsle(&io___9); + do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); + e_wsle(); + s_rsfe(&io___10); + do_fio(&c__1, jobname, (ftnlen)27); + e_rsfe(); + numargs = 1; + } else { +/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ + getarg_(&c__1, jobname, (ftnlen)27); + } + ljob = lenstr_(jobname, &c__27, (ftnlen)27); + if (ljob == 0) { + s_wsle(&io___13); + do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.", + (ftnlen)46); + e_wsle(); + s_stop("", (ftnlen)0); + } + +/* Strip ".pmx" if necessary */ + +/* Computing MAX */ + i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx( + jobname, ".PMX", (ftnlen)27, (ftnlen)4); + ndxpmx = max(i__1,i__2); + if (ndxpmx > 0) { + s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1); + ljob += -4; + } + +/* Check for existence of input file */ + +/* Writing concatenation */ + i__3[0] = ljob, a__1[0] = jobname; + i__3[1] = 4, a__1[1] = ".pmx"; + s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27); + ioin__1.inerr = 0; + ioin__1.infilen = 27; + ioin__1.infile = infileq; + ioin__1.inex = &fexist; + ioin__1.inopen = 0; + ioin__1.innum = 0; + ioin__1.innamed = 0; + ioin__1.inname = 0; + ioin__1.inacc = 0; + ioin__1.inseq = 0; + ioin__1.indir = 0; + ioin__1.infmt = 0; + ioin__1.inform = 0; + ioin__1.inunf = 0; + ioin__1.inrecl = 0; + ioin__1.innrec = 0; + ioin__1.inblank = 0; + f_inqu(&ioin__1); + if (! fexist) { + s_wsle(&io___17); +/* Writing concatenation */ + i__3[0] = 17, a__1[0] = "Cannot find file "; + i__3[1] = 27, a__1[1] = infileq; + s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44); + do_lio(&c__9, &c__1, ch__1, (ftnlen)44); + e_wsle(); + s_stop("", (ftnlen)0); + } + o__1.oerr = 0; + o__1.ounit = 10; + o__1.ofnmlen = ljob + 4; +/* Writing concatenation */ + i__3[0] = ljob, a__1[0] = jobname; + i__3[1] = 4, a__1[1] = ".pmx"; + s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31); + o__1.ofnm = ch__2; + o__1.orl = 0; + o__1.osta = 0; + o__1.oacc = 0; + o__1.ofm = 0; + o__1.oblnk = 0; + f_open(&o__1); + +/* Open all instrument files now for allparts stuff. Later disgard those >nv */ + + for (iv = 1; iv <= 24; ++iv) { + all_1.iorig[iv - 1] = iv; + o__1.oerr = 0; + o__1.ounit = iv + 10; + o__1.ofnm = 0; + o__1.orl = 0; + o__1.osta = "SCRATCH"; + o__1.oacc = 0; + o__1.ofm = 0; + o__1.oblnk = 0; + f_open(&o__1); + ludpfn[iv - 1] = 0; +/* L19: */ + } + s_rsfe(&io___20); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + chkcom_(line, (ftnlen)128); + if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { + allparts_(line, &c__128, (ftnlen)128); +L31: + s_rsfe(&io___22); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) { + allparts_(line, &c__128, (ftnlen)128); + goto L31; + } + allparts_(line, &c__128, (ftnlen)128); + s_rsfe(&io___23); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + chkcom_(line, (ftnlen)128); + } + iccount = 0; + nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f; + all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f; + if (all_1.noinst > 0) { + all_1.nvi[0] = nv - all_1.noinst + 1; + } else { + all_1.noinst = 1 - all_1.noinst; + i__1 = all_1.noinst; + for (iinst = 1; iinst <= i__1; ++iinst) { + all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128) + + .1f; +/* L21: */ + } + } + all_1.noinow = all_1.noinst; + insnow = 1; + +/* ivlast is last iv in current inst. instnum(iv) is iinst for current voice. */ + + ivlast = all_1.nvi[0]; + i__1 = nv; + for (iv = 1; iv <= i__1; ++iv) { + all_1.instnum[iv - 1] = insnow; + if (iv == ivlast) { + if (iv < nv) { + all_1.botv[iv] = TRUE_; + } + +/* The previous stmt will set botv true only for bot voice of iinst>1. It is */ +/* used when writing termrpts, but the one in voice one is handled differently, */ +/* so botv(1) is left .false. */ + + if (insnow < all_1.noinst) { + ++insnow; + ivlast += all_1.nvi[insnow - 1]; + } + } +/* L22: */ + } + mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128); + isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f; + all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; + musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f; + fracindent = readin_(line, &iccount, &c__5, (ftnlen)128); + if (npages == 0) { + s_wsle(&io___38); + do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not" + " the total number", (ftnlen)63); + e_wsle(); + s_wsle(&io___39); + do_lio(&c__9, &c__1, "of systems. Scor2prt has to know the total nu" + "mber of systems.", (ftnlen)62); + e_wsle(); + s_wsle(&io___40); + do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu" + "es.", (ftnlen)49); + e_wsle(); + s_stop("", (ftnlen)0); + } + +/* Must leave insetup=.true. else could bypass ALL instrument names. */ + + s_rsfe(&io___41); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + chkcom_(line, (ftnlen)128); + al__1.aerr = 0; + al__1.aunit = 10; + f_back(&al__1); + +/* Normally this puts pointer at start of line with 1st inst name */ +/* Check if prior line was "%%" */ + + al__1.aerr = 0; + al__1.aunit = 10; + f_back(&al__1); + s_rsfe(&io___42); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) { + al__1.aerr = 0; + al__1.aunit = 10; + f_back(&al__1); + } + i__1 = all_1.noinst; + for (iv = 1; iv <= i__1; ++iv) { + gotname = FALSE_; +L16: + s_rsfe(&io___44); + do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128); + e_rsfe(); + if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) { + s_rsfe(&io___46); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + goto L16; + } else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') { + ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48; + if (ivq != iv) { + +/* It's really a comment. Copy to parts, then get another trial name. */ + + allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128); + goto L16; + } else { + s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, ( + ftnlen)126); + s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen) + 128); + gotname = TRUE_; + } + } else { + gotname = TRUE_; + } +/* c */ +/* c The following checks for macro that write original C-clef as part of */ +/* c instrument name. See pmx.tex */ +/* c */ +/* if (index(instrum(iv),'namewpc') .eq. 0) then */ +/* write(10+iv,'(a)')' ' */ +/* else */ +/* inm1 = index(instrum(iv),'{')+1 */ +/* inm2 = index(instrum(iv),'}')-1 */ +/* read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2 */ +/* write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'// */ +/* * char(iy1+49)//char(iy2+49) */ +/* instrum(iv) = instrum(iv)(inm1:inm2) */ +/* end if */ + if (! gotname) { + s_wsle(&io___48); + do_lio(&c__9, &c__1, "You must provide a replacement instrument " + "name", (ftnlen)46); + e_wsle(); + s_stop("", (ftnlen)0); + } + io___49.ciunit = iv + 10; + s_wsfe(&io___49); + do_fio(&c__1, " ", (ftnlen)1); + e_wsfe(); +/* L14: */ + } + all_1.replacing = FALSE_; + all_1.nvnow = nv; + +/* Clef string: Note insetup is still T, so "%%" will be treated specially */ + + s_rsfe(&io___50); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + chkcom_(line, (ftnlen)128); + if (all_1.replacing) { + +/* If here, we have next line after "%%", containing score's clef string */ +/* Assume all clefs are handled with instrument comments. */ + + s_rsfe(&io___51); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + chkcom_(line, (ftnlen)128); + al__1.aerr = 0; + al__1.aunit = 10; + f_back(&al__1); + } else { + +/* If here, line has the clef string in it. Handle the old way */ + + kvstart = 1; + kvend = all_1.nvi[0]; + i__1 = all_1.noinst; + for (inst = 1; inst <= i__1; ++inst) { + ci__1.cierr = 0; + ci__1.ciunit = inst + 10; +/* Writing concatenation */ + i__4[0] = 2, a__2[0] = "(a"; + *(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48; + i__4[1] = 1, a__2[1] = ch__4; + i__4[2] = 1, a__2[2] = ")"; + ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3); + s_wsfe(&ci__1); + do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1)); + e_wsfe(); + if (inst < all_1.noinst) { + kvstart = kvend + 1; + kvend = kvstart + all_1.nvi[inst] - 1; + } +/* L2: */ + } + } + all_1.replacing = FALSE_; + all_1.insetup = FALSE_; + +/* *****NOTE*****This comment applies to stuff done earlier! */ +/* Before starting the big loop, copy initial instnum and staffnum stuff */ +/* into working values. Latter may change if noinst changes. Also make */ +/* list of current inst nums relative to original ones. In addition to those */ +/* below, must redo instnum(iv) and botv(iv) when we change noinst. */ + +/* Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */ + +L18: + s_rsfe(&io___55); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (*(unsigned char *)line == '%') { + allparts_(line, &c__128, (ftnlen)128); + goto L18; + } + allparts_(line, &c__128, (ftnlen)128); + +/* Write instrument names. Will be blank if later part of a score. */ + + if (*(unsigned char *)&instrum[0] != ' ') { + i__1 = all_1.noinst; + for (iv = 1; iv <= i__1; ++iv) { + len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128); + io___57.ciunit = iv + 10; + s_wsfe(&io___57); + do_fio(&c__1, "Ti", (ftnlen)2); + do_fio(&c__1, instrum + (iv - 1 << 7), len); + e_wsfe(); +/* L3: */ + } + } + +/* The big loop. Except for '%%', put all comment lines in all parts. */ +/* Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts */ +/* If a line starts with %!, put the rest of it in each part. */ +/* If a line starts with %[n], put the rest of it in part [n]. */ +/* Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes. */ +/* Assume they only come at top of block, except terminal repeat needs */ +/* special handling. */ +/* Check for "P"; ignore in parts. */ +/* Check for consecutive full-bar rests; if found, replace with rm[nn] */ + + iv = 1; + iinst = 1; + termrpt = FALSE_; +L4: + i__1 = s_rsfe(&io___59); + if (i__1 != 0) { + goto L999; + } + i__1 = do_fio(&c__1, line, (ftnlen)128); + if (i__1 != 0) { + goto L999; + } + i__1 = e_rsfe(); + if (i__1 != 0) { + goto L999; + } + lenline = lenstr_(line, &c__128, (ftnlen)128); + if (lenline == 0) { + goto L4; + } + zapbl_(line, &c__128, (ftnlen)128); + chkcom_(line, (ftnlen)128); + lenline = lenstr_(line, &c__128, (ftnlen)128); + if (lenline == 0) { + goto L4; + } + if (*(unsigned char *)line == 'T') { + allparts_(line, &c__128, (ftnlen)128); + s_rsfe(&io___61); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + allparts_(line, &c__128, (ftnlen)128); + goto L4; + } else /* if(complicated condition) */ { +/* Writing concatenation */ + i__3[0] = 1, a__1[0] = sq; + i__3[1] = 1, a__1[1] = sq; + s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2); + if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) { + allparts_(line, &c__128, (ftnlen)128); + goto L4; + } else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx( + " +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) { + allparts_(line, &c__128, (ftnlen)128); + s_rsfe(&io___62); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + allparts_(line, &c__128, (ftnlen)128); + goto L4; + } else if (iv == 1) { + for (ia = 1; ia <= 10; ++ia) { +L24: + idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen) + 1); + isachar = idxa > 0; + if (idxa > 1) { + i__1 = idxa - 2; + isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, ( + ftnlen)1) == 0; + } + +/* 1 2 3 4 5 6 7 8 9 10 */ +/* data achar /'P','m','V','R','A','h','w','K','M','I'/ */ + + if (ia == 9) { + i__1 = idxa; + isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 - + i__1, (ftnlen)1) == 0; + } + if (isachar) { + +/* Check whether character is inside a quoted string by counting */ +/* how many quotes precede it in the line */ + + oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128); + if (yesodd) { + isachar = FALSE_; + } + } + if (isachar) { + +/* Find next blank */ + + for (ib = idxa + 1; ib <= 128; ++ib) { + if (*(unsigned char *)&line[ib - 1] == ' ') { + goto L7; + } +/* L6: */ + } + s_wsle(&io___68); + do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o" + "r w\"", (ftnlen)35); + e_wsle(); + s_wsle(&io___69); + do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a" + "t roadrunner dot com", (ftnlen)54); + e_wsle(); + s_stop("1", (ftnlen)1); +L7: + +/* Next blank is at position ib. Later, if ia=1, must check for Pc" " ; */ +/* i.e., look for '"' between P and blank */ + + if (ia == 4) { + +/* Check for terminal repeat. Note if there's a term rpt, there can't be any */ +/* others. Also, must process repeats LAST, after m's and 'V's */ + + for (ic = ib + 1; ic <= 128; ++ic) { + +/* If any subsequent character on this line is neither blank nor "/", get out */ + + if (i_indx(" /", line + (ic - 1), (ftnlen)2, ( + ftnlen)1) == 0) { + goto L9; + } + if (*(unsigned char *)&line[ic - 1] == '/') { + termrpt = TRUE_; + i__1 = ib - 3; + s_copy(termsym, line + i__1, (ftnlen)2, ib - + 1 - i__1); + +/* Process the line as if there were no "R" */ + + goto L10; + } +/* L8: */ + } + +/* +++ 060812 */ +/* If here, all chars after "R" symbol are blanks, so process the line normally, */ +/* but only IF next line is not the M-Tx line " /" */ + + s_rsfe(&io___72); + do_fio(&c__1, templine, (ftnlen)128); + e_rsfe(); + if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0) + { + al__1.aerr = 0; + al__1.aunit = 10; + f_back(&al__1); +/* and flow out */ + } else { + +/* We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, */ +/* and proceed as above */ + +/* Writing concatenation */ + i__3[0] = ib, a__1[0] = line; + i__3[1] = 1, a__1[1] = "/"; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + lenline += 2; + termrpt = TRUE_; + i__1 = ib - 3; + s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - + i__1); + goto L10; + } +/* +++ 060812 */ + + } else if (ia == 1) { + idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1); + if (idxq > idxa && idxq < ib) { + +/* Quote is between P and next blank. Find 2nd quote, starting at the blank. */ + + idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128, + (ftnlen)1); + i__1 = idxq2; + if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 + + 1 - i__1, (ftnlen)1) != 0) { + s_wsle(&io___76); + e_wsle(); + s_wsle(&io___77); + do_lio(&c__9, &c__1, "Error copying P with q" + "uotes, idxq2:", (ftnlen)35); + do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen) + sizeof(integer)); + e_wsle(); + s_wsle(&io___78); + do_lio(&c__9, &c__1, line, (ftnlen)60); + e_wsle(); + s_stop("1", (ftnlen)1); + } + ib = idxq2 + 1; + } + +/* Do not transfer P into parts. */ + + goto L12; + } else if (ia == 9) { + +/* Start Saving a macro. After leaving here, a symbol will be sent to all parts, */ +/* If all on this line, set ib to end and exit normally. */ + + i__1 = ib; + ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1) + ; + i__1 = ib + ndxm - 2; + if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1 + - i__1, (ftnlen)1) == 0) { + +/* Macro ends on this line */ + + ib = ib + ndxm + 1; + } else { + +/* Save leading part of current line */ + + lenhold = idxa - 1; + if (lenhold > 0) { + s_copy(holdln, line, (ftnlen)128, lenhold); + } + +/* Transfer rest of line */ + + i__1 = 129 - idxa; + allparts_(line + (idxa - 1), &i__1, 128 - (idxa - + 1)); + +/* Read next line */ + +L20: + s_rsfe(&io___81); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + +/* Check for comment, transfer and loop if so */ + +/* if (line(1:1) .eq.'%') then */ +L23: + if (*(unsigned char *)line == '%') { +/* call allparts(line,128) */ +/* go to 20 */ + chkcom_(line, (ftnlen)128); + goto L23; + } + +/* Look for terminal ' M' */ + + if (*(unsigned char *)line == 'M') { + ndxm = 1; + } else { + ndxm = i_indx(line, " M", (ftnlen)128, ( + ftnlen)2); + if (ndxm > 0) { + ++ndxm; + } + } + if (ndxm > 0) { + +/* Set parameters, exit normally (but later check for leading part of 1st line */ + + idxa = 1; + ib = ndxm + 1; + } else { + +/* No "M", transfer entire line, loop */ + + allparts_(line, &c__128, (ftnlen)128); + goto L20; + } + } + } else if (ia == 10) { + +/* Do not transfer MIDI command into parts */ + + goto L12; + } else if (ia == 5) { + +/* First check for "AS", but S may come after other "A" options */ + + i__1 = idxa; + idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1); + if (idxs > 0) { + +/* Get rid of the string. First check if that's all there is in A. */ + + if (ib - idxa == nv + 2) { + goto L12; + } + i__1 = idxa + idxs + nv; +/* Writing concatenation */ + i__3[0] = idxa + idxs - 1, a__1[0] = line; + i__3[1] = ib - i__1, a__1[1] = line + i__1; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + } + +/* Check for user-defined part file name. Must start in column 1 and have */ +/* AN[n]"userfilename". */ +/* idxa is position of "A" */ +/* ib is position of the next blank after "A" */ +/* Don't allow any blanks in user */ + + i__1 = idxa; + if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen) + 1) != 0) { + goto L9; + } +/* bail out */ + if (idxa != 1) { + s_wsle(&io___83); + e_wsle(); + s_wsle(&io___84); + do_lio(&c__9, &c__1, "You entered \"AN...\" some" + "where beyond first column; stopping.", ( + ftnlen)60); + e_wsle(); + s_stop("1", (ftnlen)1); + } + +/* pmxa already checked for valid one- or 2-digit number, so get it */ + + if (*(unsigned char *)&line[3] == '"') { + +/* Single digit instrument number */ + + s_rsfi(&io___85); + do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( + integer)); + e_rsfi(); + idxstartname = 5; + } else { + s_rsfi(&io___88); + do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( + integer)); + e_rsfi(); + idxstartname = 6; + } + ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1), + "\"", 128 - (idxstartname - 1), (ftnlen)1) - + 1; + if (ludpfn[iudpfn - 1] < 0) { + s_wsle(&io___89); + e_wsle(); + s_wsle(&io___90); + do_lio(&c__9, &c__1, "User-defined part file nam" + "e must be in quotes", (ftnlen)45); + e_wsle(); + s_stop("1", (ftnlen)1); + } + idxendname = idxstartname + ludpfn[iudpfn - 1] - 1; + s_copy(udpfnq + (iudpfn - 1 << 7), line + ( + idxstartname - 1), (ftnlen)128, idxendname - ( + idxstartname - 1)); + +/* Get a new line! */ + + goto L4; + } else if (ia == 8) { + +/* Key change/transposition. */ +/* If not instrument specific, copy to all parts */ + + i__1 = idxa; + if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen) + 1) != 0) { + goto L9; + } + +/* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */ + + ibb = idxa + 2; +/* Starts on digit after 'i' */ +L40: + ici__1.icierr = 0; + ici__1.iciend = 0; + ici__1.icirnum = 1; + ici__1.icirlen = 1; + ici__1.iciunit = line + (ibb - 1); + ici__1.icifmt = "(i1)"; + s_rsfi(&ici__1); + do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer) + ); + e_rsfi(); +/* 1st digit of iinst */ + i__1 = ibb; + itemp = i_indx("01234567890", line + i__1, (ftnlen)11, + ibb + 1 - i__1); + if (itemp > 0) { + ++ibb; + iiinst = iiinst * 10 + itemp - 1; + } + ++ibb; +/* now at first +/-. Need end of 2nd number */ + i__1 = ibb; + itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1) + ; +/* Rel pos'n of next 'i' */ + if (itemp > 0) { + iend = ibb + itemp - 1; + } else { + iend = ib - 1; + } + io___97.ciunit = all_1.iorig[iiinst - 1] + 10; + s_wsfe(&io___97); +/* Writing concatenation */ + i__3[0] = 3, a__1[0] = "Ki1"; + i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1) + ; + s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131); + do_fio(&c__1, ch__6, iend - (ibb - 1) + 3); + e_wsfe(); + if (itemp > 0) { + ibb = iend + 2; + goto L40; + } + goto L12; +/* Remove K command from string, go to next ia */ + } +L9: + i__1 = ib - idxa; + allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1)); +L12: + +/* Remove the string from line */ + + if (idxa == 1) { + s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib + - 1)); + } else { +/* Writing concatenation */ + i__3[0] = idxa - 1, a__1[0] = line; + i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1); + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + } + lenline = lenstr_(line, &c__128, (ftnlen)128); + +/* Loop if only blanks are left */ + + if (lenline == 0) { + goto L4; + } + +/* Must check for multiple "I" commands, so go to just after start of ia loop */ + + if (ia == 10) { + goto L24; + } + +/* Tack on front part from 1st line of saved macro */ + + if (lenhold > 0) { +/* Writing concatenation */ + i__4[0] = lenhold, a__2[0] = holdln; + i__4[1] = 1, a__2[1] = " "; + i__4[2] = lenline, a__2[2] = line; + s_cat(line, a__2, i__4, &c__3, (ftnlen)128); + lenhold = 0; + } + } +/* L5: */ + } + } + } + +/* Now a special loop to deal with 'X'. If it was %[n]X..., will have been */ +/* copied into part [n] already. If no "B" or "P", remove. If "P", just */ +/* remove the "P" so pmxa/b will process. If "B". do nothing. */ + +L10: + nchk = 1; +L13: + ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), ( + ftnlen)1); + if (ntinx > nchk - 1) { + +/* There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. */ + + if (ntinx > 1) { + i__1 = ntinx - 2; + if (s_cmp(line + i__1, " ", ntinx - 1 - i__1, (ftnlen)1) != 0) { + +/* The X is not 1st char of PMX command. Advance starting point, loop. */ + + nchk = ntinx + 1; + goto L13; + } + } + +/* We now know the X at ntinx starts a PMX command. Find next blank */ + + i__1 = ntinx; + ib = ntinx + i_indx(line + i__1, " ", 128 - i__1, (ftnlen)1); + +/* There must be a blank to right of "X", so ib>ntinx */ + +/* locp = nchk-1+index(line(nchk:ib),'P') */ + i__1 = ntinx; + locp = ntinx + i_indx(line + i__1, "P", ib - i__1, (ftnlen)1); + +/* Did not need to use ntindex because we already know bounds of PMX command. */ + +/* if (locp .gt. nchk-1) then */ + if (locp > ntinx) { + +/* Strip out the 'P' */ + + s_copy(templine, line, (ftnlen)128, locp - 1); + i__1 = locp; +/* Writing concatenation */ + i__3[0] = locp - 1, a__1[0] = templine; + i__3[1] = lenline - i__1, a__1[1] = line + i__1; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + --lenline; + --ib; + } + if (i_indx(line + (ntinx - 1), ":", ib - (ntinx - 1), (ftnlen)1) > 0 + || i_indx(line + (ntinx - 1), "S", ib - (ntinx - 1), (ftnlen) + 1) > 0 || i_indx(line + (ntinx - 1), "B", ib - (ntinx - 1), ( + ftnlen)1) > 0 || locp > ntinx) { + +/* The X command is a shift, "Both", or "Part". Do not remove. */ + + nchk = ib + 1; + goto L13; + } + +/* Remove the X command. */ + + if (ntinx == 1) { + if (ib < lenline) { + i__1 = ib; + s_copy(line, line + i__1, (ftnlen)128, lenline - i__1); + } else { + +/* line contains ONLY the "X" command, so get a new line */ + + goto L4; + } + } else { + s_copy(templine, line, (ftnlen)128, ntinx - 1); + if (ib < lenline) { + i__1 = ib; +/* Writing concatenation */ + i__3[0] = ntinx - 1, a__1[0] = templine; + i__3[1] = lenline - i__1, a__1[1] = line + i__1; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + } else { + s_copy(line, templine, (ftnlen)128, ntinx - 1); + } + } + +/* Recompute lenline */ + + lenline = lenstr_(line, &c__128, (ftnlen)128); + +/* Resume checking after location of removed command. */ + + nchk = ntinx; + goto L13; + } + +/* End of loop for X-checks */ + + oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0; + if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[ + lenline - 1] == '/') { + +/* Must add a terminal repeat before the slash */ + + if (oneof2) { + --lenline; + } + if (lenline > 1) { + io___102.ciunit = all_1.iorig[iinst - 1] + 10; + s_wsfe(&io___102); + do_fio(&c__1, line, lenline - 1); + e_wsfe(); + } + if (! oneof2) { +/* Writing concatenation */ + i__3[0] = 2, a__1[0] = termsym; + i__3[1] = 2, a__1[1] = " /"; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + lenline = 4; + } else { +/* Writing concatenation */ + i__3[0] = 2, a__1[0] = termsym; + i__3[1] = 3, a__1[1] = " //"; + s_cat(line, a__1, i__3, &c__2, (ftnlen)128); + lenline = 5; + } + } + if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' && + iv == all_1.nvnow) { + termrpt = FALSE_; + } + io___103.ciunit = all_1.iorig[iinst - 1] + 10; + s_wsfe(&io___103); + do_fio(&c__1, line, lenline); + e_wsfe(); + if (oneof2) { + frstln = FALSE_; + } else if (! frstln) { + frstln = TRUE_; + } +/* if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */ + if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line, + "//", (ftnlen)128, (ftnlen)2) == 0) { + iv = iv % all_1.nvnow + 1; + iinst = all_1.instnum[iv - 1]; + } + goto L4; +L999: + cl__1.cerr = 0; + cl__1.cunit = 10; + cl__1.csta = 0; + f_clos(&cl__1); + +/* In the mbrest checks, must run through ALL noinst files (not just noinow) */ + + i__1 = all_1.noinst; + for (iinst = 1; iinst <= i__1; ++iinst) { +/* cc+++ */ +/* c */ +/* c Temporarily transfer entire scratch file to real file */ +/* c */ +/* rewind(10+iinst) */ +/* open(40,file='s2pout'//char(48+iinst)//'.pmx') */ +/* do 50 m = 1 , 10000 */ +/* read(10+iinst,'(a)',end=51)line */ +/* lenline = lenstr(line,128) */ +/* if (lenline .ge. 1) then */ +/* write(40,'(a)')line(1:lenline) */ +/* else */ +/* write(40,'(a)')' ' */ +/* end if */ +/* 50 continue */ +/* 51 continue */ +/* close(40) */ +/* cc+++ */ + if (all_1.nvi[iinst - 1] == 1) { + mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + ( + iinst - 1 << 7), (ftnlen)27, (ftnlen)128); + } else { + +/* Send a signal with ljob to bypass most mbrest processing */ + + i__2 = -ljob; + mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + ( + iinst - 1 << 7), (ftnlen)27, (ftnlen)128); + } +/* L11: */ + } + return 0; +} /* MAIN__ */ + +integer lenstr_(char *string, integer *n, ftnlen string_len) +{ + /* System generated locals */ + integer ret_val; + + for (ret_val = *n; ret_val >= 1; --ret_val) { + if (*(unsigned char *)&string[ret_val - 1] != ' ') { + return ret_val; + } +/* L1: */ + } + ret_val = 0; + return ret_val; +} /* lenstr_ */ + +/* Subroutine */ int allparts_(char *string, integer *n, ftnlen string_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Local variables */ + static integer len, iinst; + extern integer lenstr_(char *, integer *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___106 = { 0, 0, 0, "(a)", 0 }; + + + len = lenstr_(string, n, string_len); + if (len == 0) { + len = 1; + s_copy(string, " ", string_len, (ftnlen)1); + } + i__1 = all_1.noinow; + for (iinst = 1; iinst <= i__1; ++iinst) { + io___106.ciunit = all_1.iorig[iinst - 1] + 10; + s_wsfe(&io___106); + do_fio(&c__1, string, len); + e_wsfe(); +/* L1: */ + } + return 0; +} /* allparts_ */ + +/* Subroutine */ int mbrests_(integer *iv, char *jobname, integer *ljob, + integer *ludpfn, char *udpfnq, ftnlen jobname_len, ftnlen udpfnq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1[2], i__2[3], i__3, i__4; + real r__1; + char ch__1[1], ch__2[18], ch__3[4], ch__4[2], ch__5[10]; + cilist ci__1; + icilist ici__1; + olist o__1; + cllist cl__1; + alist al__1; + + /* Builtin functions */ + integer f_rew(alist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer f_open(olist *), s_rsfe(cilist *), do_fio(integer *, char *, + ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), + s_wsfe(cilist *), e_wsfe(void), s_wsle(cilist *), do_lio(integer * + , integer *, char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer i_indx(char *, char *, ftnlen, ftnlen), s_rsfi(icilist *), e_rsfi( + void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + double r_lg10(real *); + integer f_clos(cllist *); + + /* Local variables */ + static integer i__, il, iw; + static char sq[1]; + static integer ip1, ipc, ipe, len, idx; + static char sym[80]; + static integer ndig; + static char line[128*50]; + static integer idxb, nmbr, idxs, lsym; + static char line1[128]; + static logical type4; + static integer icden, iline, lpart; + static char partq[2]; + static integer lwbrs, nwbrs, lenbar, ipenew, mtrden; + static logical wbrest; + extern integer lenstr_(char *, integer *, ftnlen); + static logical newmtr; + static integer lwbrsx, mtrnum; + static char wbrsym[3*2]; + static integer lenbeat; + static logical alldone; + extern integer ifnodur_(integer *, char *, ftnlen), ntindex_(char *, char + *, ftnlen, ftnlen); + static integer lenmult; + extern /* Subroutine */ int dosetup_(integer *, char *, integer *, + integer *, ftnlen); + static logical rpfirst; + extern /* Subroutine */ int fwbrsym_(integer *, integer *, char *, + integer *, ftnlen), nextsym_(char *, integer *, integer *, + integer *, char *, integer *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___113 = { 0, 0, 0, "(a)", 0 }; + static cilist io___116 = { 0, 40, 0, "(a)", 0 }; + static cilist io___117 = { 0, 40, 0, "(a)", 0 }; + static cilist io___118 = { 0, 6, 0, 0, 0 }; + static cilist io___121 = { 0, 0, 1, "(a)", 0 }; + static cilist io___122 = { 0, 40, 0, "(a)", 0 }; + static cilist io___123 = { 0, 0, 0, "(a)", 0 }; + static cilist io___124 = { 0, 40, 0, "(a)", 0 }; + static cilist io___144 = { 0, 0, 1, "(a)", 0 }; + static cilist io___145 = { 0, 40, 0, "(a)", 0 }; + static cilist io___146 = { 0, 40, 0, "(a)", 0 }; + static cilist io___147 = { 0, 6, 0, 0, 0 }; + static cilist io___152 = { 0, 40, 0, "(a)", 0 }; + static cilist io___154 = { 0, 6, 0, 0, 0 }; + static cilist io___156 = { 0, 40, 0, "(a)", 0 }; + static cilist io___158 = { 0, 40, 0, "(a)", 0 }; + static cilist io___159 = { 0, 40, 0, "(a)", 0 }; + static cilist io___160 = { 0, 40, 0, "(a)", 0 }; + static cilist io___161 = { 0, 40, 0, "(a)", 0 }; + + + type4 = FALSE_; + *(unsigned char *)sq = '\\'; + alldone = FALSE_; + al__1.aerr = 0; + al__1.aunit = *iv + 10; + f_rew(&al__1); +/* open(20,file=jobname(1:abs(ljob))//char(48+iv)//'.pmx') */ + if (*iv < 10) { + *(unsigned char *)partq = (char) (*iv + 48); + lpart = 1; + +/* 5/16/10 Fix for >20 parts */ + +/* else */ +/* partq = '1'//char(38+iv) */ +/* lpart = 2 */ + } else { + lpart = 2; + if (*iv < 20) { +/* Writing concatenation */ + i__1[0] = 1, a__1[0] = "1"; + *(unsigned char *)&ch__1[0] = *iv + 38; + i__1[1] = 1, a__1[1] = ch__1; + s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); + } else { +/* Writing concatenation */ + i__1[0] = 1, a__1[0] = "2"; + *(unsigned char *)&ch__1[0] = *iv + 28; + i__1[1] = 1, a__1[1] = ch__1; + s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); + } + } +/* if (ludpfn .eq. 0) then */ + o__1.oerr = 0; + o__1.ounit = 40; + o__1.ofnmlen = abs(*ljob) + lpart + 4; +/* Writing concatenation */ + i__2[0] = abs(*ljob), a__2[0] = jobname; + i__2[1] = lpart, a__2[1] = partq; + i__2[2] = 4, a__2[2] = ".pmx"; + s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18); + o__1.ofnm = ch__2; + o__1.orl = 0; + o__1.osta = 0; + o__1.oacc = 0; + o__1.ofm = 0; + o__1.oblnk = 0; + f_open(&o__1); +/* else */ +/* open(30,file=udpfnq(1:ludpfn)//'.pmx') */ +/* end if */ + for (i__ = 1; i__ <= 10000; ++i__) { + io___113.ciunit = *iv + 10; + s_rsfe(&io___113); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3, + (ftnlen)3) == 0 || type4) { + len = lenstr_(line, &c__128, (ftnlen)128); + if (len > 0) { + s_wsfe(&io___116); + do_fio(&c__1, line, len); + e_wsfe(); + } else { + s_wsfe(&io___117); + do_fio(&c__1, " ", (ftnlen)1); + e_wsfe(); + } + if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { + type4 = ! type4; + } + } else { + goto L11; + } +/* L10: */ + } + s_wsle(&io___118); + do_lio(&c__9, &c__1, "You should not be here in scor2prt. Call Dr. Don", + (ftnlen)49); + e_wsle(); + s_stop("", (ftnlen)0); +L11: + +/* Finished reading opening type4 TeX and comments. Next line to be read */ +/* will contain the first of the input numbers */ + + dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128); + for (i__ = 1; i__ <= 10000; ++i__) { +L13: + io___121.ciunit = *iv + 10; + i__3 = s_rsfe(&io___121); + if (i__3 != 0) { + goto L999; + } + i__3 = do_fio(&c__1, line, (ftnlen)128); + if (i__3 != 0) { + goto L999; + } + i__3 = e_rsfe(); + if (i__3 != 0) { + goto L999; + } +L7: + len = lenstr_(line, &c__128, (ftnlen)128); + +/* Pass-through if instrumnet has >1 voice. */ + + if (*ljob < 0) { + goto L2; + } + if (i_indx("TtTiTch+h-h l ", line, (ftnlen)14, (ftnlen)2) > 0) { + +/* Traps titles, instruments, composers, headers, lower strings. Read 2 lines. */ + + s_wsfe(&io___122); + do_fio(&c__1, line, len); + e_wsfe(); + io___123.ciunit = *iv + 10; + s_rsfe(&io___123); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + len = lenstr_(line, &c__128, (ftnlen)128); + goto L2; + } + if (i__ == 1 || i__ > 5 && *(unsigned char *)&line[0] == 'm') { + +/* NOTE! The above test is truly bogus. */ + + if (*(unsigned char *)&line[0] == '%') { + s_wsfe(&io___124); + do_fio(&c__1, line, len); + e_wsfe(); + goto L13; + } + if (i__ == 1) { +/* read(line(1),'(10x,2i5)')mtrnum,mtrden */ + } else { + +/* Check for slashes (new meter change syntax) */ + + idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1); + idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); + newmtr = idxs > 0 && (idxb == 0 || idxs < idxb); + if (! newmtr) { + +/* Old way, no slashes, uses 'o' for lonesome '1' */ + + icden = 3; + if (*(unsigned char *)&line[1] == 'o') { + mtrnum = 1; + } else { + mtrnum = *(unsigned char *)&line[1] - 48; + if (mtrnum == 1) { + icden = 4; + mtrnum = *(unsigned char *)&line[2] - 38; + } + } + mtrden = *(unsigned char *)&line[icden - 1] - 48; + } else { + +/* New way with slashes: idxs is index of 1st slash! */ + + ici__1.icierr = 0; + ici__1.iciend = 0; + ici__1.icirnum = 1; + ici__1.icirlen = idxs - 2; + ici__1.iciunit = line + 1; +/* Writing concatenation */ + i__2[0] = 2, a__2[0] = "(i"; + *(unsigned char *)&ch__1[0] = idxs + 46; + i__2[1] = 1, a__2[1] = ch__1; + i__2[2] = 1, a__2[2] = ")"; + ici__1.icifmt = (s_cat(ch__3, a__2, i__2, &c__3, (ftnlen) + 4), ch__3); + s_rsfi(&ici__1); + do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer)); + e_rsfi(); + i__3 = idxs; + idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1); + i__3 = idxs; + ici__1.icierr = 0; + ici__1.iciend = 0; + ici__1.icirnum = 1; + ici__1.icirlen = idxs + idxb - 1 - i__3; + ici__1.iciunit = line + i__3; +/* Writing concatenation */ + i__2[0] = 2, a__2[0] = "(i"; + *(unsigned char *)&ch__1[0] = idxb + 47; + i__2[1] = 1, a__2[1] = ch__1; + i__2[2] = 1, a__2[2] = ")"; + ici__1.icifmt = (s_cat(ch__3, a__2, i__2, &c__3, (ftnlen) + 4), ch__3); + s_rsfi(&ici__1); + do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer)); + e_rsfi(); + } + } + lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1); + lenmult = 1; + if (mtrden == 2) { + lenbeat = 16; + lenmult = 2; + } + lenbar = lenmult * mtrnum * lenbeat; + fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3); + } + ip1 = 0; + s_copy(line1, line, (ftnlen)128, (ftnlen)128); + i__3 = nwbrs; + for (iw = 0; iw <= i__3; ++iw) { + if (iw > 0) { + idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128, + lwbrs); + if (idx > 0) { + +/* Check for blank or shifted rest, discount it if it's there */ + + i__4 = idx + lwbrs - 1; + if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen) + 1) != 0) { + idx = 0; + } + } + } else { + idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2); + +/* Check for raised rest */ + + if (idx > 0) { + i__4 = idx + 1; + if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) != + 0) { + idx = 0; + } + } + } + if (idx > 0) { + if (ip1 == 0) { + ip1 = idx; + } else { + ip1 = min(ip1,idx); + } + } +/* L3: */ + } +/* Writing concatenation */ + i__1[0] = 1, a__1[0] = sq; + i__1[1] = 1, a__1[1] = sq; + s_cat(ch__4, a__1, i__1, &c__2, (ftnlen)2); + if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__4, + (ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) { + goto L2; + } + +/* Switch to multibar rest search mode!!! Start forward in line(1) */ + + rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0; + iline = 1; + nmbr = 1; + if (rpfirst) { + lwbrsx = 2; + } else { + lwbrsx = lwbrs; + } + ipe = ip1 + lwbrsx - 1; +L4: + if (ipe == len) { + +/* Need a new line */ + + ++iline; +L6: + io___144.ciunit = *iv + 10; + i__3 = s_rsfe(&io___144); + if (i__3 != 0) { + goto L998; + } + i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128); + if (i__3 != 0) { + goto L998; + } + i__3 = e_rsfe(); + if (i__3 != 0) { + goto L998; + } + len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); + if (*(unsigned char *)&line[(iline - 1) * 128] == '%') { + s_wsfe(&io___145); + do_fio(&c__1, "% Following comment has been moved forward", ( + ftnlen)42); + e_wsfe(); + s_wsfe(&io___146); + do_fio(&c__1, line + (iline - 1 << 7), len); + e_wsfe(); + goto L6; + } + ipe = 0; + goto L4; +L998: + +/* No more input left */ + + s_wsle(&io___147); + do_lio(&c__9, &c__1, "All done!", (ftnlen)9); + e_wsle(); + alldone = TRUE_; + ipe = 0; + --iline; + len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); + goto L4; + } else { + if (alldone) { + *(unsigned char *)sym = ' '; + } else { + +/* ipe<len here, so it's ok to get a symbol */ + + nextsym_(line + (iline - 1 << 7), &len, &ipe, &ipenew, sym, & + lsym, (ftnlen)128, (ftnlen)80); + } + +/* Check for end of block or bar line symbol */ + + if (i_indx("/|", sym, (ftnlen)2, (ftnlen)1) > 0) { + ipe = ipenew; + goto L4; + } else { + wbrest = FALSE_; + if (alldone) { + goto L12; + } + i__3 = nwbrs; + for (iw = 1; iw <= i__3; ++iw) { + wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym, + lwbrs) == 0; +/* L5: */ + } + wbrest = wbrest || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && + lwbrs == 2 || s_cmp(sym, "rd", lsym, (ftnlen)2) == 0 + && lwbrs == 3 || s_cmp(sym, "rp", lsym, (ftnlen)2) == + 0 || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && rpfirst; +L12: + if (wbrest) { + ipe = ipenew; + ++nmbr; + goto L4; + } else { + +/* AHA! Failed prev. test, so last symbol was *not* mbr. */ +/* It must be saved, and its starting position is ipenew-lsym+1 */ + + if (nmbr > 1) { + +/* Write stuff up to start of mbr */ + + if (ip1 > 1) { + s_wsfe(&io___152); + do_fio(&c__1, line, ip1 - 1); + e_wsfe(); + } + +/* Insert mbr symbol. Always end with a slash just in case next sym must be */ +/* at start of block. May think this causes undefined octaves, but */ +/* probably not since it's a single voice. */ + + r__1 = nmbr + .01f; + ndig = (integer) r_lg10(&r__1) + 1; + s_wsle(&io___154); + do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", ( + ftnlen)22); + do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof( + integer)); + do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof( + integer)); + e_wsle(); + ci__1.cierr = 0; + ci__1.ciunit = 40; +/* Writing concatenation */ + i__2[0] = 5, a__2[0] = "(a2,i"; + *(unsigned char *)&ch__1[0] = ndig + 48; + i__2[1] = 1, a__2[1] = ch__1; + i__2[2] = 4, a__2[2] = ",a2)"; + ci__1.cifmt = (s_cat(ch__5, a__2, i__2, &c__3, ( + ftnlen)10), ch__5); + s_wsfe(&ci__1); + do_fio(&c__1, "rm", (ftnlen)2); + do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer)); + do_fio(&c__1, " /", (ftnlen)2); + e_wsfe(); + if (alldone) { + goto L999; + } + ipc = ipenew - lsym + 1; + s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), ( + ftnlen)128, len - (ipc - 1)); + } else { + +/* Write old stuff up to end of original lonesome wbr, save the rest. */ +/* 4 cases: (wbr /) , (wbr line-end) , (wbr followed by other non-/ symbols) , */ +/* alldone. */ +/* In 1st 2 will have gotten some other lines, so write all up to one b4 last */ +/* non-comment line; then revert to normal mode on that. In 3rd case must */ +/* split line. */ + + if (alldone) { + s_wsfe(&io___156); + do_fio(&c__1, line, len); + e_wsfe(); + goto L999; + } else if (iline > 1) { + i__3 = iline - 1; + for (il = 1; il <= i__3; ++il) { + len = lenstr_(line + (il - 1 << 7), &c__128, ( + ftnlen)128); + s_wsfe(&io___158); + do_fio(&c__1, line + (il - 1 << 7), len); + e_wsfe(); +/* L9: */ + } + s_copy(line, line + (iline - 1 << 7), (ftnlen)128, + (ftnlen)128); + } else { + +/* Since iline = 1 the wbr is not the last sym, so must split */ + + s_wsfe(&io___159); + do_fio(&c__1, line, ip1 + lwbrsx - 1); + e_wsfe(); + i__3 = ip1 + lwbrsx; + s_copy(line, line + i__3, (ftnlen)128, len - i__3) + ; + } + } + +/* Exit multibar mode */ + + goto L7; + } + } + } +L2: + if (len > 0) { + s_wsfe(&io___160); + do_fio(&c__1, line, len); + e_wsfe(); + } else { + s_wsfe(&io___161); + do_fio(&c__1, " ", (ftnlen)1); + e_wsfe(); + } +/* L1: */ + } +L999: + cl__1.cerr = 0; + cl__1.cunit = *iv + 10; + cl__1.csta = 0; + f_clos(&cl__1); + cl__1.cerr = 0; + cl__1.cunit = 40; + cl__1.csta = 0; + f_clos(&cl__1); + return 0; +} /* mbrests_ */ + +integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___162 = { 0, 6, 0, 0, 0 }; + + + if (*idur == 6) { + ret_val = 1; + } else if (*idur == 3) { + ret_val = 2; + } else if (*idur == 1 || *idur == 16) { + ret_val = 4; + } else if (*idur == 8) { + ret_val = 8; + } else if (*idur == 4) { + ret_val = 16; + } else if (*idur == 2) { + ret_val = 32; + } else if (*idur == 0) { + ret_val = 64; + } else { + s_wsle(&io___162); + do_lio(&c__9, &c__1, "You entered an invalid note-length value", ( + ftnlen)40); + e_wsle(); + s_stop("", (ftnlen)0); + } + if (*(unsigned char *)dotq == 'd') { + ret_val = ret_val * 3 / 2; + } + return ret_val; +} /* ifnodur_ */ + +/* Subroutine */ int fwbrsym_(integer *lenbar, integer *nwbrs, char *wbrsym, + integer *lwbrs, ftnlen wbrsym_len) +{ + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Fortran I/O blocks */ + static cilist io___163 = { 0, 6, 0, "(33H Any whole-bar rests of duratio" + "n ,i3, 26H/64 will not be recognized)", 0 }; + + + /* Parameter adjustments */ + wbrsym -= 3; + + /* Function Body */ + *nwbrs = 1; + *lwbrs = 2; + if (*lenbar == 16) { + s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2); + } else if (*lenbar == 32) { + s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2); + } else if (*lenbar == 64) { + s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2); + } else if (*lenbar == 8) { + s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2); + } else if (*lenbar == 128) { + s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2); + } else { + *nwbrs = 2; + *lwbrs = 3; + if (*lenbar == 24) { + s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3); + s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3); + } else if (*lenbar == 48) { + s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3); + s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3); + } else if (*lenbar == 96) { + s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3); + s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3); + } else { + s_wsfe(&io___163); + do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer)); + e_wsfe(); + } + } + return 0; +} /* fwbrsym_ */ + +/* Subroutine */ int nextsym_(char *line, integer *len, integer *ipeold, + integer *ipenew, char *sym, integer *lsym, ftnlen line_len, ftnlen + sym_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen), s_copy(char *, char *, + ftnlen, ftnlen); + + /* Local variables */ + static integer ip, iip; + + /* Fortran I/O blocks */ + static cilist io___164 = { 0, 6, 0, 0, 0 }; + static cilist io___165 = { 0, 6, 0, 0, 0 }; + static cilist io___168 = { 0, 6, 0, 0, 0 }; + + + +/* Know its the last symbol if on return ipenew = len!. So should never */ +/* be called when ipstart=len. */ + + if (*ipeold >= *len) { + s_wsle(&io___164); + do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33); + e_wsle(); + s_wsle(&io___165); + do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons@logicon.com", ( + ftnlen)44); + e_wsle(); + s_stop("", (ftnlen)0); + } + i__1 = *len; + for (ip = *ipeold + 1; ip <= i__1; ++ip) { + if (*(unsigned char *)&line[ip - 1] != ' ') { + +/* symbol starts here (ip). We're committed to exit the loop. */ + + if (ip < *len) { + i__2 = *len; + for (iip = ip + 1; iip <= i__2; ++iip) { + if (*(unsigned char *)&line[iip - 1] != ' ') { + goto L2; + } + +/* iip is the space after the symbol */ + + *ipenew = iip - 1; + *lsym = *ipenew - ip + 1; + s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - + 1)); + return 0; +L2: + ; + } + +/* Have len>=2 and ends on len */ + + *ipenew = *len; + *lsym = *ipenew - ip + 1; + s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1)); + return 0; + } else { + +/* ip = len */ + + *ipenew = *len; + *lsym = 1; + s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1); + return 0; + } + } +/* L1: */ + } + s_wsle(&io___168); + do_lio(&c__9, &c__1, "Error #3. Send files to Dr. Don at dsimons@logico" + "n.com", (ftnlen)55); + e_wsle(); + return 0; +} /* nextsym_ */ + +integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len) +{ + /* System generated locals */ + address a__1[2]; + integer ret_val, i__1, i__2[2], i__3; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio( + integer *, integer *, char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen), s_cat(char *, char **, + integer *, integer *, ftnlen); + integer s_cmp(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer ic, len, ndxs2; + static char tline[128]; + static integer ndxbs; + static logical intex; + static integer ndxdq1, ndxdq2; + extern integer lenstr_(char *, integer *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___174 = { 0, 6, 0, 0, 0 }; + + + +/* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */ + + +/* print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below' */ +/* print*,line(1:79) */ + + +/* Use a temporary string to store the input and test, so can zap D"..." */ + + s_copy(tline, line, (ftnlen)128, (ftnlen)128); + ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len); + +/* Return point below for rechecks after zapping D" " */ + +L2: + ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1); + if (ndxbs > 0) { + +/* Special check in case \ is inside D"..." */ + + ndxdq1 = i_indx(tline, "D\"", (ftnlen)128, (ftnlen)2); + +/* If the following test fails, flow out of if block; else loop up to 2. */ + + if (ndxdq1 > 0) { + +/* Find end of D"..." */ + + i__1 = ndxdq1 + 1; + ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, ( + ftnlen)1); + if (ndxdq2 == ndxdq1 + 1) { + s_wsle(&io___174); + do_lio(&c__9, &c__1, "Something is really wierd here", ( + ftnlen)30); + e_wsle(); + s_stop("", (ftnlen)0); + } + s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1); + i__1 = ndxdq2; + for (ic = ndxdq1; ic <= i__1; ++ic) { +/* Writing concatenation */ + i__2[0] = ic - 1, a__1[0] = tline; + i__2[1] = 1, a__1[1] = " "; + s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); +/* L3: */ + } + i__1 = ndxdq2; +/* Writing concatenation */ + i__2[0] = ndxdq2, a__1[0] = tline; + i__2[1] = 128 - i__1, a__1[1] = line + i__1; + s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); + goto L2; + } + } + if (ndxbs == 0 || ndxs2 < ndxbs) { + ret_val = ndxs2; +/* print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */ + } 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 ' \' */ + + len = lenstr_(tline, &c__128, (ftnlen)128); + intex = TRUE_; +/* print*,'intex+>',intex */ + i__1 = len; + for (ic = ndxbs + 1; ic <= i__1; ++ic) { + if (ic == ndxs2) { + if (intex) { + ret_val = 0; + i__3 = ic; + ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) + + ic; +/* print*,'ndxs2 =>',ndxs2 */ + } else { + ret_val = ndxs2; + return ret_val; + } +/* print*,'Internal exit, intex, ntindex:',intex,ntindex */ + } else /* if(complicated condition) */ { + i__3 = ic; + if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, ( + ftnlen)2) == 0) { + intex = FALSE_; +/* print*,'intex+>',intex */ + } else /* if(complicated condition) */ { + i__3 = ic; + if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, ( + ftnlen)2) == 0) { + intex = TRUE_; +/* print*,'intex+>',intex */ + } + } + } +/* L1: */ + } +/* print*,'Out end of loop 1' */ + } +/* print*,'Exiting ntindex at the end???' */ + return ret_val; +} /* ntindex_ */ + +/* Subroutine */ int getchar_(char *line, integer *iccount, char *charq, + ftnlen line_len, ftnlen charq_len) +{ + /* Builtin functions */ + integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void); + + /* Fortran I/O blocks */ + static cilist io___178 = { 0, 10, 0, "(a)", 0 }; + + + +/* Gets the next character out of line*128. If pointer iccount=128 on entry, */ +/* then reads in a new line. Resets iccount to position of the new character. */ + + if (*iccount == 128) { + s_rsfe(&io___178); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + *iccount = 0; + } + ++(*iccount); + *(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1]; + return 0; +} /* getchar_ */ + +doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen + line_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1[3], i__2; + real ret_val; + char ch__1[27], ch__2[6], ch__3[1]; + icilist ici__1; + + /* Builtin functions */ + integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), + i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer s_rsfi(icilist *), e_rsfi(void); + + /* Local variables */ + extern /* Subroutine */ int allparts_(char *, integer *, ftnlen); + static integer i1, i2, icf; + static char durq[1]; + extern /* Subroutine */ int chkcom_(char *, ftnlen), getchar_(char *, + integer *, char *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___179 = { 0, 10, 0, "(a)", 0 }; + static cilist io___183 = { 0, 6, 0, 0, 0 }; + static cilist io___185 = { 0, 6, 0, 0, 0 }; + + + +/* Reads a piece of setup data from line, gets a new line from */ +/* file 10 (jobname.pmx) if needed, Transfers comment lines into all parts. */ + +/* iread controls copying of values into scratch files for parts, but only */ +/* if not replacing. */ + +/* iread input value written */ +/* -1 nvi nothing (only used when noinst<0 initially) */ +/* 0 various value read */ +/* 1 nv -1 , replace later with nvi(i) */ +/* 2 noinst 1 */ +/* 3 np -2 , replace later with (nsyst-1)/12+1 */ +/* 4 musicsize 20 */ +/* 5 fracondent 0.05 */ + +L4: + if (*iccount == 128) { + s_rsfe(&io___179); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (all_1.replacing) { + all_1.replacing = FALSE_; + } + chkcom_(line, (ftnlen)128); + *iccount = 0; + } + ++(*iccount); + +/* Find next non-blank or end of line */ + + for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { + if (*(unsigned char *)&line[*iccount - 1] != ' ') { + goto L3; + } +/* L2: */ + } + +/* If here, need to get a new line */ + + *iccount = 128; + goto L4; +L3: + +/* iccount now points to start of number to read */ + + i1 = *iccount; +L5: + getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Remember that getchar first increments iccount, *then* reads a character. */ + + if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { + goto L5; + } + i2 = *iccount - 1; + if (i2 < i1) { + s_wsle(&io___183); +/* Writing concatenation */ + i__1[0] = 7, a__1[0] = "Found \""; + i__1[1] = 1, a__1[1] = durq; + i__1[2] = 19, a__1[2] = "\" instead of number"; + s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); + do_lio(&c__9, &c__1, ch__1, (ftnlen)27); + e_wsle(); + s_stop("1", (ftnlen)1); + } + icf = i2 - i1 + 49; + ici__1.icierr = 0; + ici__1.iciend = 0; + ici__1.icirnum = 1; + ici__1.icirlen = i2 - (i1 - 1); + ici__1.iciunit = line + (i1 - 1); +/* Writing concatenation */ + i__1[0] = 2, a__1[0] = "(f"; + *(unsigned char *)&ch__3[0] = icf; + i__1[1] = 1, a__1[1] = ch__3; + i__1[2] = 3, a__1[2] = ".0)"; + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); + s_rsfi(&ici__1); + do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); + e_rsfi(); + if (! all_1.replacing) { + if (*iread == 0) { + i__2 = i2 - i1 + 1; + allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1)); + } else if (*iread == 1) { + allparts_("-999", &c__4, (ftnlen)4); + } else if (*iread == 2) { + allparts_("1", &c__1, (ftnlen)1); + } else if (*iread == 3) { + allparts_("-998", &c__4, (ftnlen)4); + } else if (*iread == 4) { + allparts_("20", &c__2, (ftnlen)2); + } else if (*iread == 5) { + allparts_(".05", &c__3, (ftnlen)3); + } else if (*iread != -1) { + s_wsle(&io___185); + do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26); + e_wsle(); + s_stop("", (ftnlen)0); + } + } + return ret_val; +} /* readin_ */ + +/* Subroutine */ int chkcom_(char *line, ftnlen line_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), + i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, + ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + static logical clefpend; + extern /* Subroutine */ int allparts_(char *, integer *, ftnlen); + static integer j, k, ivq, idxb, idxl, idxm, idxn; + extern /* Subroutine */ int zapbl_(char *, integer *, ftnlen); + static integer iposc0; + extern integer lenstr_(char *, integer *, ftnlen); + static integer lenline; + + /* Fortran I/O blocks */ + static cilist io___186 = { 0, 10, 0, "(a)", 0 }; + static cilist io___195 = { 0, 10, 0, "(a)", 0 }; + static cilist io___198 = { 0, 0, 0, "(a)", 0 }; + static cilist io___199 = { 0, 0, 0, "(a)", 0 }; + static cilist io___200 = { 0, 10, 1, "(a)", 0 }; + + + +/* Assume that line has just been read. No need to change iccount since we only */ +/* process full lines. */ + +L1: + if (*(unsigned char *)line != '%') { + return 0; + } + +/* If here, line has some sort of comment */ + + if (*(unsigned char *)&line[1] == '%') { + if (! all_1.insetup) { + +/* Suck up a line, then flow out of "if" block to get another and loop */ + + s_rsfe(&io___186); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); +/* ++VV */ + +/* UNLESS (a) it has a score-only "M" and changes # of inst's. */ + + if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) { + idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1); + idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1); + idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1); + idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); + if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb)) + { + i__1 = idxn; + all_1.noinow = *(unsigned char *)&line[i__1] - 48; + clefpend = TRUE_; + +/* Next noinow digits are original inst. #'s of new inst. set. Next noinow */ +/* char's after that are clefs */ + + all_1.nvnow = 0; + i__1 = all_1.noinow; + for (j = 1; j <= i__1; ++j) { + i__2 = idxn + 1 + j - 1; + all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] - + 48; + iposc0 = idxn + 1 + all_1.noinow; + i__2 = all_1.nvi[all_1.iorig[j - 1] - 1]; + for (k = 1; k <= i__2; ++k) { + ++all_1.nvnow; +/* clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */ + all_1.instnum[all_1.nvnow - 1] = j; + all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1; +/* L25: */ + } +/* L24: */ + } + } + } + +/* or if it's "h" or "l", need to suck up one more line */ + + if (*(unsigned char *)line == 'h' && i_indx("+- ", line + 1, ( + ftnlen)3, (ftnlen)1) > 0 || *(unsigned char *)line == 'T' + || s_cmp(line, "l ", (ftnlen)2, (ftnlen)2) == 0) { + s_rsfe(&io___195); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + } + +/* 4/29/00 check for T string also */ + + } else { + +/* In setup mode. Set flag, flow out and do use following line */ + + all_1.replacing = TRUE_; + } + } else if (*(unsigned char *)&line[1] == '!') { + +/* Copy to all parts */ + + allparts_(line + 2, &c__125, (ftnlen)126); + } else { + +/* Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise */ +/* c Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise */ + + ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, ( + ftnlen)1); + +/* Only treat as part-specific pmx line if number .le. noinst */ + + if (ivq < 1 || ivq > all_1.noinst) { + +/* Simple comment. */ + + allparts_(line, &c__128, (ftnlen)128); + } else { + +/* Instrument comment, copy only to part */ + + lenline = lenstr_(line, &c__128, (ftnlen)128); + if (lenline > 2) { + io___198.ciunit = ivq + 10; + s_wsfe(&io___198); + do_fio(&c__1, line + 2, lenline - 2); + e_wsfe(); + } else { + +/* Transferring blank line */ + + io___199.ciunit = ivq + 10; + s_wsfe(&io___199); + do_fio(&c__1, " ", (ftnlen)1); + e_wsfe(); + } + } + } + i__1 = s_rsfe(&io___200); + if (i__1 != 0) { + goto L2; + } + i__1 = do_fio(&c__1, line, (ftnlen)128); + if (i__1 != 0) { + goto L2; + } + i__1 = e_rsfe(); + if (i__1 != 0) { + goto L2; + } + zapbl_(line, &c__128, (ftnlen)128); + goto L1; +L2: + return 0; +} /* chkcom_ */ + +/* Subroutine */ int dosetup_(integer *iv, char *line, integer *mtrnum, + integer *mtrden, ftnlen line_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), + i_nint(real *); + + /* Local variables */ + static integer ioi, noi, iset; + static real xdata; + static integer iccount; + extern /* Subroutine */ int partnum_(integer *, integer *, char *, real *, + ftnlen); + + /* Fortran I/O blocks */ + static cilist io___204 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___206 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___208 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___209 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___210 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___211 = { 0, 40, 0, "(i5)", 0 }; + static cilist io___212 = { 0, 40, 0, "(f5.2)", 0 }; + + + +/* Transfers setup data from scratch file to real one for one instrument */ +/* Data may be mixed with comments, but on entry 1st item is a number. */ +/* Write a comment when encountered, as it comes. */ +/* Write numbers one per line. */ +/* Three input data require special handling: */ +/* If not already replaced, i.e., if negative, then */ +/* iset(1) (nv) will be replaced with nvi(i) */ +/* iset(9) (npages) will be replaced with (nsyst-1)/12+1 */ +/* iset(2), if negative, will be followed by extra numbers to be transf. */ + + iccount = 0; + for (iset = 1; iset <= 12; ++iset) { + partnum_(iv, &iccount, line, &xdata, (ftnlen)128); + if (iset == 2) { + if (xdata > 0.f) { + s_wsfe(&io___204); + i__1 = (integer) (xdata + .1f); + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); + e_wsfe(); + } else { + noi = -xdata + .1f; + s_wsfe(&io___206); + do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer)); + e_wsfe(); + i__1 = noi; + for (ioi = 1; ioi <= i__1; ++ioi) { + partnum_(iv, &iccount, line, &xdata, (ftnlen)128); + s_wsfe(&io___208); + i__2 = (integer) (xdata + .1f); + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); + e_wsfe(); +/* L2: */ + } + } +/* else if (iset.ne.8 .and. xdata.lt.0) then */ + } else if (iset != 8 && iset != 5 && xdata < 0.f) { + +/* Must be either nv or npages */ + + if ((integer) (-xdata + .1f) == 999) { + +/* It's nv */ + + s_wsfe(&io___209); + do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof( + integer)); + e_wsfe(); + } else { + +/* npages must be computed */ + + s_wsfe(&io___210); + i__1 = (all_1.nsyst - 1) / 12 + 1; + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else if (iset != 7 && iset != 12) { + +/* write integer */ + + s_wsfe(&io___211); + i__1 = i_nint(&xdata); + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); + e_wsfe(); + } else { + +/* write floating number */ + + s_wsfe(&io___212); + do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (iset == 3) { + *mtrnum = i_nint(&xdata); + } else if (iset == 4) { + *mtrden = i_nint(&xdata); + } +/* L1: */ + } + return 0; +} /* dosetup_ */ + +/* Subroutine */ int partnum_(integer *iv, integer *iccount, char *line, real + *xdata, ftnlen line_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1[3]; + char ch__1[27], ch__2[6], ch__3[1]; + icilist ici__1; + + /* Builtin functions */ + integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), + s_wsfe(cilist *), e_wsfe(void), i_indx(char *, char *, ftnlen, + ftnlen), s_wsle(cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer s_rsfi(icilist *), e_rsfi(void); + + /* Local variables */ + static integer i1, i2, icf, len; + static char durq[1]; + extern integer lenstr_(char *, integer *, ftnlen); + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen); + + /* Fortran I/O blocks */ + static cilist io___213 = { 0, 0, 0, "(a)", 0 }; + static cilist io___215 = { 0, 40, 0, "(a)", 0 }; + static cilist io___219 = { 0, 6, 0, 0, 0 }; + + + +/* Simplified number parsing. Only looks for comment lines and numbers. */ + +L2: + if (*iccount == 128) { + io___213.ciunit = *iv + 10; + s_rsfe(&io___213); + do_fio(&c__1, line, (ftnlen)128); + e_rsfe(); + if (*(unsigned char *)line == '%') { + len = lenstr_(line, &c__128, (ftnlen)128); + s_wsfe(&io___215); + do_fio(&c__1, line, len); + e_wsfe(); + goto L2; + } + *iccount = 0; + } + ++(*iccount); + +/* Find next non-blank or end of line */ + + for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { + if (*(unsigned char *)&line[*iccount - 1] != ' ') { + goto L3; + } +/* L4: */ + } + +/* If here, iccount=128 and need to get a new line */ + + goto L2; +L3: + +/* iccount now points to start of number to read */ + + i1 = *iccount; +L5: + getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Remember that getchar first increments iccount, *then* reads a character. */ + + if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { + goto L5; + } + i2 = *iccount - 1; + if (i2 < i1) { + s_wsle(&io___219); +/* Writing concatenation */ + i__1[0] = 7, a__1[0] = "Found \""; + i__1[1] = 1, a__1[1] = durq; + i__1[2] = 19, a__1[2] = "\" instead of number"; + s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); + do_lio(&c__9, &c__1, ch__1, (ftnlen)27); + e_wsle(); + s_stop("1", (ftnlen)1); + } + icf = i2 - i1 + 49; + ici__1.icierr = 0; + ici__1.iciend = 0; + ici__1.icirnum = 1; + ici__1.icirlen = i2 - (i1 - 1); + ici__1.iciunit = line + (i1 - 1); +/* Writing concatenation */ + i__1[0] = 2, a__1[0] = "(f"; + *(unsigned char *)&ch__3[0] = icf; + i__1[1] = 1, a__1[1] = ch__3; + i__1[2] = 3, a__1[2] = ".0)"; + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); + s_rsfi(&ici__1); + do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real)); + e_rsfi(); + return 0; +} /* partnum_ */ + + +/* Subroutine */ int zapbl_(char *string, integer *len, ftnlen string_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer i__; + + i__1 = *len; + for (i__ = 1; i__ <= i__1; ++i__) { + if (*(unsigned char *)&string[i__ - 1] == ' ') { + goto L1; + } + if (i__ == 1) { + return 0; + } + goto L2; +L1: + ; + } + +/* If line is all blank, leave it alone */ + + return 0; +L2: + s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1)); + return 0; +} /* zapbl_ */ + +/* Subroutine */ int oddquotesbefore_(char *lineq, integer *indx, logical * + yesodd, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1; + + /* Local variables */ + static integer i__, numdqs; + + +/* This counts number of double quotes in lineq up to position indx-1, then */ +/* sets yesodd according to whether number is odd or even */ + + numdqs = 0; + i__1 = *indx - 1; + for (i__ = 1; i__ <= i__1; ++i__) { + if (*(unsigned char *)&lineq[i__ - 1] == '"') { + ++numdqs; + } +/* L1: */ + } + *yesodd = numdqs % 2 == 1; + return 0; +} /* oddquotesbefore_ */ + |