diff options
author | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2016-02-10 05:31:26 +0000 |
---|---|---|
committer | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2016-02-10 05:31:26 +0000 |
commit | c4cbbb4b4c32ca5e900cf1d276fa70595c34c5bd (patch) | |
tree | 1c9f00b9002b03bcf863e93a761d252b4cc0487f /Build/source/utils/pmx/pmx-src/pmxab.c | |
parent | ea9c1a801bdfb30bf6cec9b9261d37c52441e27b (diff) |
pmx 2.7.3
git-svn-id: svn://tug.org/texlive/trunk@39654 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/utils/pmx/pmx-src/pmxab.c')
-rw-r--r-- | Build/source/utils/pmx/pmx-src/pmxab.c | 61111 |
1 files changed, 61111 insertions, 0 deletions
diff --git a/Build/source/utils/pmx/pmx-src/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c new file mode 100644 index 00000000000..66a62200a33 --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/pmxab.c @@ -0,0 +1,61111 @@ +#line 1 "" +/* -- translated by f2c (version 20100827). + 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" + +#line 1 "" +/* Common Block Declarations */ + +struct { + char versionc[5]; +} comver_; + +#define comver_1 comver_ + +struct { + integer miditime, lasttime; +} comevent_; + +#define comevent_1 comevent_ + +struct { + integer levson[25], levsoff[25], imidso[25], naccbl[25], laccbl[250] + /* was [25][10] */, jaccbl[250] /* was [25][10] */, nusebl; + logical slmon[25], dbltie; +} comslm_; + +#define comslm_1 comslm_ + +struct { + integer imidi[25]; + real trest[25]; + integer mcpitch[20], mgap, iacclo[150] /* was [25][6] */, iacchi[150] + /* was [25][6] */, midinst[24], nmidcrd, midchan[48] /* + was [24][2] */, numchan, naccim[25], laccim[250] /* was [25][ + 10] */, jaccim[250] /* was [25][10] */; + logical crdacc, notmain, restpend[25], relacc, twoline[24], ismidi; + shortint mmidi[614400] /* was [25][24576] */; + logical debugmidi; +} commidi_; + +#define commidi_1 commidi_ + +struct { + integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24], + midtc[25], noinst; + shortint iinsiv[24]; +} commvel_; + +#define commvel_1 commvel_ + +struct { + integer ipbuf, ilbuf, nlbuf; + shortint lbuf[4000]; + char bufq[65536]; +} inbuff_; + +#define inbuff_1 inbuff_ + +struct { + integer musize; + real whead20; +} commus_; + +#define commus_1 commus_ + +union { + struct { + integer iv, ivxo[600], ipo[600]; + real to[600], tno[600]; + integer nnl[24], nv, ibar, mtrnuml, nodur[4800] /* was [24][200] */, + lenbar, iccount, idum, itsofar[24], nib[360] /* was [24][ + 15] */, nn[24]; + logical rest[4800] /* was [24][200] */; + integer lenbr0, lenbr1; + logical firstline, newmeter; + } _1; + struct { + integer iv, ivxo[600], ipo[600]; + real to[600], tno[600]; + integer nnl[24], nv, ibar, mtrnuml, nodur[4800] /* was [24][200] */, + lenbar, iccount, nbars, itsofar[24], nib[360] /* was [24][ + 15] */, nn[24]; + logical rest[4800] /* was [24][200] */; + integer lenbr0, lenbr1; + logical firstline, newmeter; + } _2; +} a1ll_; + +#define a1ll_1 (a1ll_._1) +#define a1ll_2 (a1ll_._2) + +struct { + integer n69[25], n34[25]; +} comdiag_; + +#define comdiag_1 comdiag_ + +struct { + integer mmacstrt[500] /* was [25][20] */, mmacend[500] /* + was [25][20] */, immac, mmactime[20], nmidsec, msecstrt[1500] + /* was [25][60] */, msecend[1500] /* was [25][60] */; + logical mmacrec, gottempo; +} commmac_; + +#define commmac_1 commmac_ + +struct { + integer linewcom[20000]; +} truelinecount_; + +#define truelinecount_1 truelinecount_ + +struct { + logical lastchar, fbon, issegno; + integer ihead; + logical isheadr; + integer nline; + logical isvolt; + real fracindent; + integer nsperi[24], linesinpmxmod, line1pmxmod, lenbuf0; +} c1omget_; + +#define c1omget_1 c1omget_ + +struct { + integer naskb; + real task[40], wask[40], elask[40]; +} comas1_; + +#define comas1_1 comas1_ + +struct { + real udsp[50], tudsp[50]; + integer nudsp; + real udoff[480] /* was [24][20] */; + integer nudoff[24]; +} comudsp_; + +#define comudsp_1 comudsp_ + +struct comtol_1_ { + real tol; +}; + +#define comtol_1 (*(struct comtol_1_ *) &comtol_) + +struct { + shortint ipslon[25], lusebl[10], jusebl[10]; +} comips_; + +#define comips_1 comips_ + +struct { + logical islast, usevshrink; +} comlast_; + +#define comlast_1 comlast_ + +union { + struct { + real space[80]; + integer nb; + real prevtn[24], flgndv[24], flgndb, eskgnd, ptsgnd; + integer ivmxsav[48] /* was [24][2] */, nvmxsav[24]; + } _1; + struct { + real space[80]; + integer nb; + real prevtn[24], flgndv[24]; + logical flgndb; + real eskgnd, ptsgnd; + integer ivmxsav[48] /* was [24][2] */, nvmxsav[24]; + } _2; +} comnsp_; + +#define comnsp_1 (comnsp_._1) +#define comnsp_2 (comnsp_._2) + +union { + struct { + integer mult[4800] /* was [24][200] */, iv, nnl[24], nv, ibar, + ivxo[600], ipo[600]; + real to[600], tno[600], tnote[600], eskz[4800] /* was [24][200] */; + integer ipl[4800] /* was [24][200] */, ibm1[216] /* was [24][9] + */, ibm2[216] /* was [24][9] */, nolev[4800] /* was [24][ + 200] */, ibmcnt[24], nodur[4800] /* was [24][200] */, + jn, lenbar, iccount, nbars, itsofar[24], nacc[4800] /* + was [24][200] */, nib[360] /* was [24][15] */, nn[24], + lenb0, lenb1; + real slfac; + integer musicsize; + real stemmax, stemmin, stemlen; + integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800] /* was [24][ + 200] */, ifigdr[250] /* was [2][125] */, iline; + logical figbass, figchk[2], firstgulp; + integer irest[4800] /* was [24][200] */, iornq[4824] /* + was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202] + , isdat4[202]; + logical beamon[24], isfig[400] /* was [2][200] */; + char sepsymq[24], sq[1], ulq[216] /* was [24][9] */; + } _1; + struct { + integer mult[4800] /* was [24][200] */, jv, nnl[24], nv, ibar, + ivxo[600], ipo[600]; + real to[600], tno[600], tnote[600], eskz[4800] /* was [24][200] */; + integer ipl[4800] /* was [24][200] */, ibm1[216] /* was [24][9] + */, ibm2[216] /* was [24][9] */, nolev[4800] /* was [24][ + 200] */, ibmcnt[24], nodur[4800] /* was [24][200] */, + jn, lenbar, iccount, nbars, itsofar[24], nacc[4800] /* + was [24][200] */, nib[360] /* was [24][15] */, nn[24], + lenb0, lenb1; + real slfac; + integer musicsize; + real stemmax, stemmin, stemlen; + integer mtrnuml, mtrdenl, mtrnmp, mtrdnp, islur[4800] /* was [24][ + 200] */, ifigdr[250] /* was [2][125] */, iline; + logical figbass, figchk[2], firstgulp; + integer irest[4800] /* was [24][200] */, iornq[4824] /* + was [24][201] */, isdat1[202], isdat2[202], nsdat, isdat3[202] + , isdat4[202]; + logical beamon[24], isfig[400] /* was [2][200] */; + char sepsymq[24], sq[1], ulq[216] /* was [24][9] */; + } _2; +} all_; + +#define all_1 (all_._1) +#define all_2 (all_._2) + +struct { + real eskz2[4800] /* was [24][200] */; +} comeskz2_; + +#define comeskz2_1 comeskz2_ + +struct { + integer ntot; +} comntot_; + +#define comntot_1 comntot_ + +struct { + real hpttot[176]; +} comhsp_; + +#define comhsp_1 comhsp_ + +struct { + logical ispoi; +} compoi_; + +#define compoi_1 compoi_ + +struct { + logical isbbm; +} combbm_; + +#define combbm_1 combbm_ + +struct { + real ask[2500]; + integer iask; + logical topmods; +} comas3_; + +#define comas3_1 comas3_ + +struct { + integer ivbj1, ivbj2; + logical isbjmp, isbj2; +} combjmp_; + +#define combjmp_1 combjmp_ + +struct { + integer noctup; +} comoct_; + +#define comoct_1 comoct_ + +union { + struct { + integer ixtup; + logical vxtup[24]; + integer ntupv[216] /* was [24][9] */, nolev1[24], mtupv[216] + /* was [24][9] */, nxtinbm[24], islope[24]; + real xelsk[24], eloff[216] /* was [24][9] */; + integer nssb[24], issb[24], lev1ssb[480] /* was [24][20] */; + } _1; + struct { + integer ixtup; + logical vxtup[24]; + integer ntupv[216] /* was [24][9] */, nolev1[24], mtupv[216] + /* was [24][9] */, nxtinbm[24], islope[24]; + real xels11[24], eloff[216] /* was [24][9] */; + integer nssb[24], issb[24], lev1ssb[480] /* was [24][20] */; + } _2; +} comxtup_; + +#define comxtup_1 (comxtup_._1) +#define comxtup_2 (comxtup_._2) + +struct { + logical drawbm[24]; +} comdraw_; + +#define comdraw_1 comdraw_ + +struct { + integer nvmx[24], ivmx[48] /* was [24][2] */, ivx; +} commvl_; + +#define commvl_1 commvl_ + +struct { + integer ihnum3; + logical flipend[24]; + integer ixrest[24]; +} strtmid_; + +#define strtmid_1 strtmid_ + +struct { + logical bar1syst; + real fixednew, scaldold, wheadpt, fbar, poenom; +} comask_; + +#define comask_1 comask_ + +struct { + integer itopfacteur, ibotfacteur, interfacteur, isig0, isig, lastisig; + real fracindent, widthpt, height, hoffpt, voffpt; + integer idsig, lnam[24]; + char inameq[1896]; +} comtop_; + +#define comtop_1 comtop_ + +struct { + integer ntrill, ivtrill[24], iptrill[24]; + real xnsktr[24]; + integer ncrd, icrdat[193], icrdot[193], icrdorn[193], nudorn, kudorn[63]; + real ornhshft[63]; + integer minlev, maxlev, icrd1, icrd2; +} comtrill_; + +#define comtrill_1 comtrill_ + +struct { + integer nnb; + real sumx, sumy; + integer ipb[24]; + real smed; +} comipb_; + +#define comipb_1 comipb_ + +union { + struct { + logical novshrinktop, cstuplet; + } _1; + struct { + logical novshrinktop; + real cstuplte; + } _2; +} comnvst_; + +#define comnvst_1 (comnvst_._1) +#define comnvst_2 (comnvst_._2) + +union { + struct { + integer itfig[148] /* was [2][74] */; + char figq[1480] /* was [2][74] */; + integer ivupfig[148] /* was [2][74] */, nfigs[2]; + real fullsize[24]; + integer ivxfig2, ivvfig[148] /* was [2][74] */; + } _1; + struct { + integer itfig[148] /* was [2][74] */; + char figqq[1480] /* was [2][74] */; + integer ivupfig[148] /* was [2][74] */, nfigs[2]; + real fullsize[24]; + integer ivxfig2, ivvfig[148] /* was [2][74] */; + } _2; +} comfig_; + +#define comfig_1 (comfig_._1) +#define comfig_2 (comfig_._2) + +struct comtrans_1_ { + char cheadq[60]; +}; + +#define comtrans_1 (*(struct comtrans_1_ *) &comtrans_) + +struct compage_1_ { + real widthpt, ptheight, hoffpt, voffpt; + integer nsyst, nflb, ibarflb[41], isysflb[41], npages, nfpb, ipagfpb[19], + isysfpb[19]; + logical usefig; + real fintstf, gintstf, fracsys[30]; + integer nmovbrk, isysmb[31], nistaff[41]; +}; + +#define compage_1 (*(struct compage_1_ *) &compage_) + +struct cblock_1_ { + real etatop, etabot, etait, etatc, etacs1, hgtin, hgtti, hgtco, xilbn, + xilbtc, xilhdr, xilfig, a, b; + integer inhnoh; +}; + +#define cblock_1 (*(struct cblock_1_ *) &cblock_) + +struct cominbot_1_ { + integer inbothd; +}; + +#define cominbot_1 (*(struct cominbot_1_ *) &cominbot_) + +struct comstart_1_ { + real facmtr; +}; + +#define comstart_1 (*(struct comstart_1_ *) &comstart_) + +struct comtitl_1_ { + char instrq[120], titleq[120], compoq[120]; + logical headlog; + integer inskip, ncskip, inhead; +}; + +#define comtitl_1 (*(struct comtitl_1_ *) &comtitl_) + +struct spfacs_1_ { + real grafac, acgfac, accfac, xspfac, xb4fac, clefac, emgfac, flagfac, + dotfac, bacfac, agc1fac, gslfac, arpfac, rptfac; + integer lrrptfac; + real dbarfac, ddbarfac, dotsfac, upstmfac, rtshfac; +}; + +#define spfacs_1 (*(struct spfacs_1_ *) &spfacs_) + +struct combmh_1_ { + real bmhgt, clefend; +}; + +#define combmh_1 (*(struct combmh_1_ *) &combmh_) + +struct comdyn_1_ { + integer ndyn, idyndat[99], levdsav[24], ivowg[12]; + real hoh1[12], hoh2[12], hoh2h1[2]; + integer ntxtdyn, ivxiptxt[41]; + char txtdynq[5248]; + integer idynda2[99], levhssav[24], listcresc, listdecresc; +}; + +#define comdyn_1 (*(struct comdyn_1_ *) &comdyn_) + +struct comkbdrests_1_ { + integer levbotr[8], levtopr[8]; + logical kbdrests; +}; + +#define comkbdrests_1 (*(struct comkbdrests_1_ *) &comkbdrests_) + +struct cominsttrans_1_ { + integer iinsttrans[24], itranskey[24], itransamt[24], instno[24], + ninsttrans; + logical earlytranson, laterinsttrans; +}; + +#define cominsttrans_1 (*(struct cominsttrans_1_ *) &cominsttrans_) + +struct comsize_1_ { + integer isize[24]; +}; + +#define comsize_1 (*(struct comsize_1_ *) &comsize_) + +struct { + integer nnodur; + real wminnh[3999]; + integer nnpd[4000]; + real durb[4000]; + integer iddot, nptr[3999], ibarcnt, mbrest, ibarmbr, ibaroff; + real udsp[3999], wheadpt, sqzb[4000]; +} c1omnotes_; + +#define c1omnotes_1 c1omnotes_ + +struct { + integer narp; + real tar[8]; + integer ivar1[8], ipar1[8], levar1[8], ncmar1[8]; + real xinsnow; + logical lowdot; +} comarp_; + +#define comarp_1 comarp_ + +struct { + integer midisig; +} commidisig_; + +#define commidisig_1 commidisig_ + +struct { + integer listslur; + logical upslur[48] /* was [24][2] */; + integer ndxslur; + logical fontslur, wrotepsslurdefaults; + real slurcurve; +} comslur_; + +#define comslur_1 comslur_ + +struct { + integer ivg[37], ipg[37], nolevg[74], itoff[148] /* was [2][74] */; + real aftshft; + integer nng[37], ngstrt[37], ibarmbr, mbrest; + real xb4mbr; + integer noffseg, ngrace, nvolt, ivlit[83], iplit[83], nlit; + real graspace[37]; + integer lenlit[83], multg[37]; + logical upg[37], slurg[37], slashg[37]; + integer naccg[74]; + char voltxtq[120], litq[10624]; +} comgrace_; + +#define comgrace_1 comgrace_ + +struct { + integer is1n1, is2n1, irzbnd, isnx; +} comsln_; + +#define comsln_1 comsln_ + +struct { + real eonk, ewmxk; +} comeon_; + +#define comeon_1 comeon_ + +struct { + integer ipl2[4800] /* was [24][200] */; +} comipl2_; + +#define comipl2_1 comipl2_ + +struct { + integer ibmtyp; +} combeam_; + +#define combeam_1 combeam_ + +struct { + integer macnum; + logical mrecord, mplay; + integer macuse, icchold; + char lnholdq[128]; + logical endmac; +} commac_; + +#define commac_1 commac_ + +struct { + integer nvmx[24], ivmx[48] /* was [24][2] */, ivx; + real fbar; + integer nacc[4800] /* was [24][200] */; +} c1ommvl_; + +#define c1ommvl_1 c1ommvl_ + +union { + struct { + integer nkeys, ibrkch[18], newkey[18]; + logical iskchb; + integer idsig, isig1, mbrestsav; + logical kchmid[18], ornrpt, shifton, barend; + integer noinst; + logical stickys; + } _1; + struct { + integer nkeys, ibrkch[18], newkey[18]; + logical iskchb; + integer idumm1, isig1, mbrestsav; + logical kchmid[18], logdumm1, logdumm2, barend; + integer noinst; + logical logdumm3; + } _2; +} comkeys_; + +#define comkeys_1 (comkeys_._1) +#define comkeys_2 (comkeys_._2) + +struct { + logical isligfont; +} comligfont_; + +#define comligfont_1 comligfont_ + +struct { + logical lastchar, rptnd1, sluron[48] /* was [24][2] */, fbon, + ornrpt, stickys; + integer movbrk, movnmp, movdnp, movgap; + real parmov, fintstf, gintstf; + logical rptprev, equalize; + char rptfq1[1], rptfq2[1]; +} comget_; + +#define comget_1 comget_ + +struct { + logical ignorenats; +} comignorenats_; + +#define comignorenats_1 comignorenats_ + +struct { + integer nnodur, lastlev, ndlev[48] /* was [24][2] */; + logical shifton, setis, notcrd; + integer npreslur; + logical was2[24]; + integer ninow; + logical nobar1; + integer nsystp[40], ipage; + logical optlinebreakties, headerspecial; +} comnotes_; + +#define comnotes_1 comnotes_ + +struct { + integer ihdht; + logical lower; + char headrq[80], lowerq[80]; + integer ihdvrt; +} comhead_; + +#define comhead_1 comhead_ + +struct { + integer nfb[24]; + real t1fb[960] /* was [24][40] */, t2fb[960] /* was [24][40] */; + char ulfbq[960] /* was [24][40] */; + integer ifb; + real tautofb; + logical autofbon; + real t1autofb; +} comfb_; + +#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_; + +#define combc_1 combc_ + +struct { + integer nsperi[24], nspern[24]; + logical rename; + integer iiorig[24]; +} comnvi_; + +#define comnvi_1 comnvi_ + +struct { + integer ip1mac[20], il1mac[20], ip2mac[20], il2mac[20], ic1mac[20], ilmac, + iplmac; +} c1ommac_; + +#define c1ommac_1 c1ommac_ + +struct { + char clefq[24]; +} comclefq_; + +#define comclefq_1 comclefq_ + +struct { + integer numarpshift, ivarpshift[20], iparpshift[20]; + real arpshift[20]; +} comarpshift_; + +#define comarpshift_1 comarpshift_ + +struct { + integer ibarcnt; +} combibarcnt_; + +#define combibarcnt_1 combibarcnt_ + +struct comlyr_1_ { + logical inputmlyr; +}; + +#define comlyr_1 (*(struct comlyr_1_ *) &comlyr_) + +struct { + integer ivxudorn[63]; +} comivxudorn_; + +#define comivxudorn_1 comivxudorn_ + +struct { + integer nbc, ibcdata[36]; +} comcb_; + +#define comcb_1 comcb_ + +struct { + integer nasksys; + real wasksys[800], elasksys[800]; +} comas2_; + +#define comas2_1 comas2_ + +struct { + logical cwrferm[24]; +} comcwrf_; + +#define comcwrf_1 comcwrf_ + +struct { + logical centrests; +} comclefrests_; + +#define comclefrests_1 comclefrests_ + +struct { + real elskb, tnminb[3999]; +} linecom_; + +#define linecom_1 linecom_ + +/* Initialized data */ + +struct { + char e_1[60]; + } comtrans_ = { " " + " " }; + +struct { + real e_1[4]; + integer fill_2[127]; + real e_3[30]; + integer fill_4[73]; + } compage_ = { 524.f, 740.f, 0.f, 0.f, {0}, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, + 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, + 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f, 0.f }; + +struct { + real e_1[14]; + integer e_2; + } cblock_ = { .5f, .25f, .4f, .4f, .2f, 12.f, 21.f, 12.f, 4.f, 1.6f, 5.f, + 5.7f, 1.071f, 2.714f, 16 }; + +struct { + integer e_1; + } cominbot_ = { 16 }; + +struct { + real e_1; + } comstart_ = { .55f }; + +struct { + char e_1[360]; + logical e_2; + integer fill_3[3]; + } comtitl_ = { " " + " " + " " + " " + " " + " ", FALSE_ }; + +struct { + real e_1[14]; + integer e_2; + real e_3[5]; + } spfacs_ = { 1.3333f, .4f, .7f, .3f, .2f, 2.f, 1.f, .7f, .7f, .9f, .5f, + 9.f, 1.7f, 1.32f, 2, .47f, .83f, .17f, .5f, 1.f }; + +struct { + real e_1[2]; + } combmh_ = { 1.1f, 2.3f }; + +struct { + integer fill_1[124]; + integer e_2[12]; + real e_3[26]; + integer fill_4[1479]; + } comdyn_ = { {0}, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2.2f, 1.7f, 1.2f, + .7f, 1.3f, 1.3f, .4f, .8f, 1.2f, .8f, 1.2f, 1.6f, -2.7f, -2.2f, + -1.7f, -1.2f, -2.3f, -2.1f, -1.f, -1.7f, -2.1f, -1.6f, -1.9f, + -2.3f, -.3f, .3f }; + +struct { + integer e_1[16]; + logical e_2; + } comkbdrests_ = { 0, 0, 0, 2, 1, 4, 5, 4, 9, 7, 5, 5, 7, 5, 6, 6, FALSE_ + }; + +struct { + integer e_1[24]; + integer fill_2[24]; + integer e_3[24]; + integer fill_4[25]; + logical e_5[2]; + } cominsttrans_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, {0}, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0}, FALSE_, FALSE_ }; + +struct { + integer e_1[24]; + } comsize_ = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0 }; + +struct { + logical e_1; + } comlyr_ = { FALSE_ }; + +struct { + real e_1; + } comtol_ = { .001f }; + + +/* Table of constant values */ + +static integer c__9 = 9; +static integer c__1 = 1; +static integer c__44 = 44; +static integer c__2 = 2; +static integer c__4 = 4; +static integer c__128 = 128; +static integer c__3 = 3; +static logical c_true = TRUE_; +static logical c_false = FALSE_; +static integer c__92 = 92; +static integer c__11 = 11; +static integer c__12 = 12; +static integer c__17 = 17; +static integer c__14 = 14; +static integer c__129 = 129; +static integer c__5 = 5; +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_b761 = -2.f; +static real c_b762 = 0.f; +static real c_b814 = 1.f; +static integer c__8 = 8; +static integer c__16 = 16; +static integer c__23 = 23; +static integer c__39 = 39; +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_b1670 = 2.f; +static integer c__30 = 30; +static integer c__60 = 60; +static integer c__80 = 80; +static integer c__256 = 256; +static integer c__34 = 34; +static integer c__120 = 120; +static integer c__240 = 240; +static integer c__255 = 255; +static integer c__47 = 47; + +/* Main program */ int MAIN__(void) +{ + /* Initialized data */ + + static char date[9] = "2 Feb 16 "; + static char version[5] = "2.73 "; + static integer maxit = 200; + static integer ncalls = 0; + static logical isfirst = TRUE_; + + /* System generated locals */ + address a__1[2], a__2[4], a__3[3]; + integer i__1, i__2, i__3[2], i__4[4], i__5[3], i__6; + real r__1; + char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[56]; + olist o__1; + cllist cl__1; + inlist ioin__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char + *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer f_inqu(inlist *), f_open(olist *), f_clos(cllist *); + /* Subroutine */ int s_stop(char *, ftnlen); + integer s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + static real devnorm0; + static logical optimize; + extern /* Subroutine */ int poestats_(integer *, real *, real *, real *), + writemidi_(char *, integer *, ftnlen); + static integer ncomments, ip1, ilb, icm; + static real poe[125]; + static integer ivt, ivx; + static real poe0[125]; + static integer ljob, ipoe[125]; + extern /* Subroutine */ int pmxa_(char *, integer *, logical *, integer *, + integer *, logical *, ftnlen), pmxb_(logical *, real *, integer * + , logical *); + static integer ivtt, isys, ljob4; + extern /* Subroutine */ int stop1_(void); + extern integer iargc_(void); + static integer nbari[125], nbars[125], iinst, isysd, numit, isyst, isysu, + nsyst, nbars0[125]; + static real poebar; + extern /* Subroutine */ int getarg_(integer *, char *, ftnlen); + static integer idnord, iplast; + static logical fexist; + static real devpmx; + static integer iupord; + extern integer lenstr_(char *, integer *, ftnlen); + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer ndxpmx; + static real poebar0; + static char jobname[44], infileq[47], lnholdq[128]; + static real devnorm; + static integer numargs, nstaves; + extern /* Subroutine */ int sortpoe_(integer *, real *, integer *); + + /* Fortran I/O blocks */ + static cilist io___10 = { 0, 6, 0, 0, 0 }; + static cilist io___11 = { 0, 6, 0, 0, 0 }; + static cilist io___12 = { 0, 5, 0, "(a)", 0 }; + static cilist io___15 = { 0, 6, 0, 0, 0 }; + static cilist io___16 = { 0, 6, 0, 0, 0 }; + static cilist io___17 = { 0, 6, 0, 0, 0 }; + static cilist io___21 = { 0, 6, 0, 0, 0 }; + static cilist io___24 = { 0, 18, 1, "(a)", 0 }; + static cilist io___26 = { 0, 6, 0, 0, 0 }; + static cilist io___34 = { 0, 6, 0, 0, 0 }; + static cilist io___35 = { 0, 15, 0, 0, 0 }; + static cilist io___39 = { 0, 6, 0, 0, 0 }; + static cilist io___40 = { 0, 15, 0, 0, 0 }; + static cilist io___42 = { 0, 15, 0, 0, 0 }; + static cilist io___51 = { 0, 6, 0, 0, 0 }; + static cilist io___52 = { 0, 15, 0, 0, 0 }; + static cilist io___60 = { 0, 6, 0, 0, 0 }; + static cilist io___61 = { 0, 15, 0, 0, 0 }; + static cilist io___62 = { 0, 6, 0, "(5x,20i3)", 0 }; + static cilist io___63 = { 0, 15, 0, "(5x,20i3)", 0 }; + static cilist io___64 = { 0, 6, 0, 0, 0 }; + static cilist io___65 = { 0, 15, 0, 0, 0 }; + static cilist io___66 = { 0, 6, 0, 0, 0 }; + static cilist io___67 = { 0, 15, 0, 0, 0 }; + static cilist io___68 = { 0, 6, 0, 0, 0 }; + static cilist io___69 = { 0, 15, 0, 0, 0 }; + static cilist io___70 = { 0, 6, 0, "(5x,20i3)", 0 }; + static cilist io___71 = { 0, 15, 0, "(5x,20i3)", 0 }; + static cilist io___72 = { 0, 6, 0, "(5x,20i3)", 0 }; + static cilist io___73 = { 0, 15, 0, "(5x,20i3)", 0 }; + + + +/* This program, PMX, developed by Don Simons */ +/* (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with */ +/* MusiXTeX and TeX, its purpose is to allow the user to create high-quality */ +/* typeset musical scores by including a sequence of PMX commands in an ASCII */ +/* input file. */ + +/* 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/>. */ + + + +/* To compile with gfortran: */ +/* 1. Merge all files using copy *.for epmx[nnnn].for */ +/* 2. Search and replace all character*65536 with character*131072 */ +/* 3. Comment/uncomment getarg lines */ +/* 4. gfortran -O pmx[nnnn].for -o pmxab.exe */ + +/* To do */ +/* Correct Rainer's email address in manual */ +/* Linesplit (\\) in h */ +/* Tt at start of a movement. */ +/* Toggle midi on or off; allow midi only. */ +/* Page number printed on 1st page even if 1 system. */ +/* Still need inserted space for chordal accidentals */ +/* Voicewise transposition. */ +/* better segno */ +/* coda */ +/* duevolte */ +/* Fix xtup bracket direction in 2-line staves?? (maybe leave as is) */ +/* Sticky ornaments with shifts. */ +/* Deal with Werner's vertical spacing thing associated with title. */ +/* Multiple ties in midi */ +/* Werner's missing c in MIDI due to start/stop ties on same note. */ +/* Beams with single 64ths */ +/* 128ths and/or dotted 64ths */ +/* Close out MIDI with integral # of beats? */ +/* Increase ast dimensions or redo logic. */ +/* Does slur direction get set for user-defined single-note stem dir'ns? */ +/* Transpose by sections. */ +/* Optimization loop over sections only */ +/* Command-line option to read nbarss in. Write out nbarss when optimizing. */ +/* (or just read from .plg?) */ +/* Beams over bar lines. */ +/* 2-digit figures */ +/* A real coule (slanted line between notes in a chord) */ +/* Dotted slurs for grace notes. */ +/* Undotted chord notes with dotted main note. */ +/* Forced line break without line number */ +/* Fix dot moving when 2nds in chord get flipped */ +/* To do: increase length on notexq in dodyn */ +/* 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 */ +/* 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 */ + +/* cccccc */ + +/* Added 130302 only to get nsperi from g1etnote, for use in midi setup */ + + +/* immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing */ +/* nmidsec section starts and stops based on PLAYING macros (not recording). */ + +/* cccccccccccccccccccccccc */ + + +/* cccccccccccccccccccccccc */ +/* itstart = mytime() */ +#line 764 "" + s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5); + +/* Initialize midi parameters */ + +#line 768 "" + commmac_1.gottempo = FALSE_; +#line 769 "" + commidi_1.ismidi = FALSE_; +#line 770 "" + commidi_1.debugmidi = FALSE_; +#line 771 "" + commidi_1.relacc = FALSE_; +#line 772 "" + commmac_1.mmacrec = FALSE_; +#line 773 "" + commmac_1.nmidsec = 1; +#line 774 "" + commidi_1.mgap = 10; +#line 775 "" + comevent_1.miditime = 0; +#line 776 "" + comevent_1.lasttime = 0; +#line 777 "" + commidi_1.nmidcrd = 0; +#line 778 "" + comslm_1.nusebl = 0; +#line 779 "" + commidi_1.notmain = FALSE_; +#line 780 "" + for (ivx = 1; ivx <= 24; ++ivx) { +#line 781 "" + commidi_1.twoline[ivx - 1] = FALSE_; +#line 782 "" + commidi_1.midinst[ivx - 1] = 6; +#line 783 "" + commvel_1.midivel[ivx - 1] = 127; +#line 784 "" + commvel_1.midibal[ivx - 1] = 64; +#line 785 "" + commvel_1.miditran[ivx - 1] = 0; +#line 786 "" +/* L3: */ +#line 786 "" + } +#line 787 "" + for (icm = 0; icm <= 24; ++icm) { +#line 788 "" + commidi_1.imidi[icm] = 0; +#line 789 "" + commidi_1.restpend[icm] = FALSE_; +#line 790 "" + commidi_1.trest[icm] = 0.f; +#line 791 "" + comslm_1.levson[icm] = 0; +#line 792 "" + comslm_1.levsoff[icm] = 0; +#line 793 "" + comslm_1.slmon[icm] = FALSE_; +#line 794 "" + comslm_1.naccbl[icm] = 0; +#line 795 "" + comdiag_1.n69[icm] = 0; +#line 796 "" + comdiag_1.n34[icm] = 0; +#line 797 "" + commmac_1.msecstrt[icm] = 1; +#line 798 "" +/* L12: */ +#line 798 "" + } + +/* End of midi parameter initialization */ + +#line 802 "" + commus_1.musize = 0; +#line 803 "" + optimize = FALSE_; +#line 804 "" + numargs = iargc_(); +#line 805 "" + if (numargs == 0) { +#line 806 "" + s_wsle(&io___10); +#line 806 "" + do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\ + "d line,", (ftnlen)53); +#line 806 "" + e_wsle(); +#line 807 "" + s_wsle(&io___11); +#line 807 "" + do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); +#line 807 "" + e_wsle(); +#line 808 "" + s_rsfe(&io___12); +#line 808 "" + do_fio(&c__1, jobname, (ftnlen)44); +#line 808 "" + e_rsfe(); +#line 809 "" + numargs = 1; +#line 810 "" + } else { +/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ +#line 812 "" + getarg_(&c__1, jobname, (ftnlen)44); +#line 813 "" + } +#line 814 "" +L10: +#line 814 "" + ljob = lenstr_(jobname, &c__44, (ftnlen)44); +#line 815 "" + if (ljob > 44) { +#line 816 "" + s_wsle(&io___15); +#line 816 "" + do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31); +#line 816 "" + e_wsle(); +#line 817 "" + stop1_(); +#line 818 "" + } else if (ljob == 0) { +#line 819 "" + s_wsle(&io___16); +#line 819 "" + do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34) + ; +#line 819 "" + e_wsle(); +#line 820 "" + stop1_(); +#line 821 "" + } else if (numargs == 2) { +#line 822 "" + if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) { +#line 823 "" + optimize = TRUE_; +/* call getarg(2,jobname,idum) ! May need to replace this w/ next line */ +#line 825 "" + getarg_(&c__2, jobname, (ftnlen)44); +#line 826 "" + numargs = 1; +#line 827 "" + goto L10; +#line 828 "" + } else { +#line 829 "" + s_wsle(&io___17); +#line 829 "" + do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30) + ; +#line 829 "" + e_wsle(); +#line 830 "" + stop1_(); +#line 831 "" + } +#line 832 "" + } + +/* Strip ".pmx" if necessary */ + +/* Computing MAX */ +#line 836 "" + i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx( + jobname, ".PMX", (ftnlen)44, (ftnlen)4); +#line 836 "" + ndxpmx = max(i__1,i__2); +#line 837 "" + if (ndxpmx > 0) { +#line 838 "" + s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1); +#line 839 "" + ljob += -4; +#line 840 "" + } + +/* Check for existence of input file */ + +/* Writing concatenation */ +#line 844 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 844 "" + i__3[1] = 4, a__1[1] = ".pmx"; +#line 844 "" + s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 845 "" + ioin__1.inerr = 0; +#line 845 "" + ioin__1.infilen = 47; +#line 845 "" + ioin__1.infile = infileq; +#line 845 "" + ioin__1.inex = &fexist; +#line 845 "" + ioin__1.inopen = 0; +#line 845 "" + ioin__1.innum = 0; +#line 845 "" + ioin__1.innamed = 0; +#line 845 "" + ioin__1.inname = 0; +#line 845 "" + ioin__1.inacc = 0; +#line 845 "" + ioin__1.inseq = 0; +#line 845 "" + ioin__1.indir = 0; +#line 845 "" + ioin__1.infmt = 0; +#line 845 "" + ioin__1.inform = 0; +#line 845 "" + ioin__1.inunf = 0; +#line 845 "" + ioin__1.inrecl = 0; +#line 845 "" + ioin__1.innrec = 0; +#line 845 "" + ioin__1.inblank = 0; +#line 845 "" + f_inqu(&ioin__1); +#line 846 "" + if (! fexist) { +#line 847 "" + ioin__1.inerr = 0; +#line 847 "" + ioin__1.infilen = ljob + 4; +/* Writing concatenation */ +#line 847 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 847 "" + i__3[1] = 4, a__1[1] = ".PMX"; +#line 847 "" + s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 847 "" + ioin__1.infile = ch__1; +#line 847 "" + ioin__1.inex = &fexist; +#line 847 "" + ioin__1.inopen = 0; +#line 847 "" + ioin__1.innum = 0; +#line 847 "" + ioin__1.innamed = 0; +#line 847 "" + ioin__1.inname = 0; +#line 847 "" + ioin__1.inacc = 0; +#line 847 "" + ioin__1.inseq = 0; +#line 847 "" + ioin__1.indir = 0; +#line 847 "" + ioin__1.infmt = 0; +#line 847 "" + ioin__1.inform = 0; +#line 847 "" + ioin__1.inunf = 0; +#line 847 "" + ioin__1.inrecl = 0; +#line 847 "" + ioin__1.innrec = 0; +#line 847 "" + ioin__1.inblank = 0; +#line 847 "" + f_inqu(&ioin__1); +#line 848 "" + if (! fexist) { +#line 849 "" + s_wsle(&io___21); +/* Writing concatenation */ +#line 849 "" + i__3[0] = 17, a__1[0] = "Cannot find file "; +#line 849 "" + i__3[1] = 47, a__1[1] = infileq; +#line 849 "" + s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64); +#line 849 "" + do_lio(&c__9, &c__1, ch__2, (ftnlen)64); +#line 849 "" + e_wsle(); +#line 850 "" + stop1_(); +#line 851 "" + } else { +/* Writing concatenation */ +#line 852 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 852 "" + i__3[1] = 4, a__1[1] = ".PMX"; +#line 852 "" + s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 853 "" + } +#line 854 "" + } + +/* Open a log file */ + +#line 858 "" + o__1.oerr = 0; +#line 858 "" + o__1.ounit = 15; +#line 858 "" + o__1.ofnmlen = ljob + 4; +/* Writing concatenation */ +#line 858 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 858 "" + i__3[1] = 4, a__1[1] = ".pml"; +#line 858 "" + s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 858 "" + o__1.ofnm = ch__1; +#line 858 "" + o__1.orl = 0; +#line 858 "" + o__1.osta = 0; +#line 858 "" + o__1.oacc = 0; +#line 858 "" + o__1.ofm = 0; +#line 858 "" + o__1.oblnk = 0; +#line 858 "" + f_open(&o__1); +/* Writing concatenation */ +#line 859 "" + i__4[0] = 21, a__2[0] = "This is PMX, Version "; +#line 859 "" + i__4[1] = 5, a__2[1] = version; +#line 859 "" + i__4[2] = 2, a__2[2] = ", "; +#line 859 "" + i__4[3] = 9, a__2[3] = date; +#line 859 "" + s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37); +#line 859 "" + printl_(ch__3, (ftnlen)37); +#line 860 "" + ljob4 = ljob; +/* Writing concatenation */ +#line 861 "" + i__3[0] = 8, a__1[0] = "Opening "; +#line 861 "" + i__3[1] = 47, a__1[1] = infileq; +#line 861 "" + s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55); +#line 861 "" + printl_(ch__4, (ftnlen)55); +#line 862 "" + o__1.oerr = 0; +#line 862 "" + o__1.ounit = 18; +#line 862 "" + o__1.ofnmlen = 47; +#line 862 "" + o__1.ofnm = infileq; +#line 862 "" + o__1.orl = 0; +#line 862 "" + o__1.osta = 0; +#line 862 "" + o__1.oacc = 0; +#line 862 "" + o__1.ofm = 0; +#line 862 "" + o__1.oblnk = 0; +#line 862 "" + f_open(&o__1); + +/* Copy input file into common buffer */ + +#line 866 "" + inbuff_1.ipbuf = 0; +#line 867 "" + truelinecount_1.linewcom[0] = 1; +#line 868 "" + for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 4000; ++inbuff_1.ilbuf) { +#line 869 "" + ncomments = 0; +#line 870 "" +L14: +#line 870 "" + i__1 = s_rsfe(&io___24); +#line 870 "" + if (i__1 != 0) { +#line 870 "" + goto L9; +#line 870 "" + } +#line 870 "" + i__1 = do_fio(&c__1, lnholdq, (ftnlen)128); +#line 870 "" + if (i__1 != 0) { +#line 870 "" + goto L9; +#line 870 "" + } +#line 870 "" + i__1 = e_rsfe(); +#line 870 "" + if (i__1 != 0) { +#line 870 "" + goto L9; +#line 870 "" + } +#line 871 "" + inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, & + c__128, (ftnlen)128); +#line 872 "" + if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) { + +/* Blank line. Make it a single blank with length 1 */ + +#line 876 "" + inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1; +#line 877 "" + s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); +#line 878 "" + } + +/* 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 884 "" + if (*(unsigned char *)lnholdq == '%') { +#line 885 "" + ++ncomments; +#line 886 "" + goto L14; +#line 887 "" + } + +/* When here, have counted all preceding comments and have a real line */ + +#line 891 "" + if (inbuff_1.ilbuf > 1) { +#line 892 "" + truelinecount_1.linewcom[inbuff_1.ilbuf - 1] = + truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 + + ncomments; +#line 893 "" + } else { +#line 894 "" + truelinecount_1.linewcom[0] = ncomments + 1; +#line 895 "" + } +#line 896 "" + if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 65536) { +#line 897 "" + s_wsle(&io___26); +#line 897 "" + do_lio(&c__9, &c__1, "Too many characters in file, stopping", ( + ftnlen)37); +#line 897 "" + e_wsle(); +#line 898 "" + stop1_(); +#line 899 "" + } +#line 900 "" + i__1 = inbuff_1.ipbuf; +#line 900 "" + s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[ + inbuff_1.ilbuf - 1] - i__1, (ftnlen)128); +#line 901 "" + inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; +#line 902 "" +/* L8: */ +#line 902 "" + } +#line 903 "" + printl_("Too many lines in input file", (ftnlen)28); +#line 904 "" + stop1_(); +#line 905 "" +L9: + +/* Insert dummy line to handle input files w/o CR-LF at end. */ + +#line 909 "" + inbuff_1.nlbuf = inbuff_1.ilbuf - 1; +/* nlbuf = ilbuf */ +/* bufq(ipbuf+1:ipbuf+3) = ' / ' */ +/* lbuf(nlbuf) = 3 */ +#line 913 "" + cl__1.cerr = 0; +#line 913 "" + cl__1.cunit = 18; +#line 913 "" + cl__1.csta = 0; +#line 913 "" + f_clos(&cl__1); +#line 914 "" + i__1 = maxit; +#line 914 "" + for (numit = 1; numit <= i__1; ++numit) { +#line 915 "" + if (optimize) { +#line 915 "" + printl_("Starting an iteration", (ftnlen)21); +#line 915 "" + } + +/* 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 921 "" + pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen) + 44); +#line 922 "" + if (! optimize) { +#line 923 "" + 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 929 "" + nstaves = 0; +#line 930 "" + ivt = 0; +#line 931 "" + for (iinst = 1; iinst <= 24; ++iinst) { +#line 932 "" + nstaves += c1omget_1.nsperi[iinst - 1]; +#line 933 "" + i__2 = c1omget_1.nsperi[iinst - 1]; +#line 933 "" + for (ivtt = 1; ivtt <= i__2; ++ivtt) { +#line 934 "" + ++ivt; +#line 935 "" + commvel_1.iinsiv[ivt - 1] = (shortint) iinst; +#line 936 "" +/* L17: */ +#line 936 "" + } +#line 937 "" + if (nstaves == a1ll_1.nv) { +#line 937 "" + goto L18; +#line 937 "" + } +#line 938 "" +/* L16: */ +#line 938 "" + } +#line 939 "" + s_wsle(&io___34); +#line 939 "" + do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8); +#line 939 "" + e_wsle(); +#line 940 "" + stop1_(); +#line 941 "" +L18: + +/* Set up channel numbers for midi. */ + +#line 945 "" + commidi_1.numchan = 0; +#line 946 "" + for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 947 "" + if (commidi_1.twoline[a1ll_1.iv - 1]) { +#line 948 "" + commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan; +#line 949 "" + ++commidi_1.numchan; +#line 950 "" + } +#line 951 "" + commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan; +#line 952 "" + ++commidi_1.numchan; +#line 953 "" +/* L11: */ +#line 953 "" + } + +/* numchan will now be the number of channels, but max channel # is numchan-1 */ + +/* Set up velocities, balances, and midi-transpositions */ + +#line 959 "" + for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 960 "" + 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 965 "" + commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] = + commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv + - 1] - 1]; +#line 966 "" + commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] = + commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv + - 1] - 1]; +#line 967 "" + commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] = + commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv + - 1] - 1]; +#line 968 "" + } +/* midvelc(midchan(iv,1)) = midivel(iv) */ +/* midbc(midchan(iv,1)) = midibal(iv) */ +/* midtc(midchan(iv,1)) = miditran(iv) */ +#line 972 "" + commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] = + commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] + - 1]; +#line 973 "" + commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] = + commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] + - 1]; +#line 974 "" + commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] = + commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] + - 1]; +#line 975 "" +/* L13: */ +#line 975 "" + } +#line 976 "" + } + +/* TEMPORARY!!! */ + +#line 980 "" + s_wsle(&io___35); +#line 980 "" + do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 980 "" + do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof( + integer)); +#line 980 "" + e_wsle(); +#line 981 "" + ip1 = 1; +#line 982 "" + i__2 = inbuff_1.nlbuf; +#line 982 "" + 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 987 "" + ip1 += inbuff_1.lbuf[ilb - 1]; +#line 988 "" +/* L10000: */ +#line 988 "" + } +#line 989 "" + 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 999 "" + i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; +#line 999 "" + if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3) + == 0) { +#line 1000 "" + i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1; +#line 1000 "" + if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[ + inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) { +#line 1001 "" + s_wsle(&io___39); +#line 1001 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ + "ank>/\"", (ftnlen)39); +#line 1001 "" + e_wsle(); +#line 1002 "" + s_wsle(&io___40); +#line 1002 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ + "ank>/\"", (ftnlen)39); +#line 1002 "" + e_wsle(); +#line 1003 "" + --inbuff_1.nlbuf; +#line 1004 "" + } +#line 1005 "" + } + +#line 1007 "" + pmxb_(&c_true, poe0, &ncalls, &optimize); +#line 1008 "" + if (commidi_1.ismidi) { + +/* Write midi file */ + +#line 1012 "" + o__1.oerr = 0; +#line 1012 "" + o__1.ounit = 51; +#line 1012 "" + o__1.ofnmlen = ljob + 4; +/* Writing concatenation */ +#line 1012 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 1012 "" + i__3[1] = 4, a__1[1] = ".mid"; +#line 1012 "" + s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1012 "" + o__1.ofnm = ch__1; +#line 1012 "" + o__1.orl = 0; +#line 1012 "" + o__1.osta = 0; +#line 1012 "" + o__1.oacc = 0; +#line 1012 "" + o__1.ofm = 0; +#line 1012 "" + o__1.oblnk = 0; +#line 1012 "" + f_open(&o__1); +#line 1013 "" + if (commidi_1.debugmidi) { +#line 1013 "" + o__1.oerr = 0; +#line 1013 "" + o__1.ounit = 52; +#line 1013 "" + o__1.ofnmlen = ljob + 4; +/* Writing concatenation */ +#line 1013 "" + i__3[0] = ljob, a__1[0] = jobname; +#line 1013 "" + i__3[1] = 4, a__1[1] = ".dbm"; +#line 1013 "" + s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1013 "" + o__1.ofnm = ch__1; +#line 1013 "" + o__1.orl = 0; +#line 1013 "" + o__1.osta = 0; +#line 1013 "" + o__1.oacc = 0; +#line 1013 "" + o__1.ofm = 0; +#line 1013 "" + o__1.oblnk = 0; +#line 1013 "" + f_open(&o__1); +#line 1013 "" + } +#line 1014 "" + printl_(" ", (ftnlen)1); +/* Writing concatenation */ +#line 1015 "" + i__5[0] = 8, a__3[0] = "Writing "; +#line 1015 "" + i__5[1] = ljob, a__3[1] = jobname; +#line 1015 "" + i__5[2] = 4, a__3[2] = ".mid"; +#line 1015 "" + s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56); +#line 1015 "" + printl_(ch__5, ljob + 12); +#line 1016 "" + writemidi_(jobname, &ljob, (ftnlen)44); +#line 1017 "" + } +#line 1018 "" + cl__1.cerr = 0; +#line 1018 "" + cl__1.cunit = 15; +#line 1018 "" + cl__1.csta = 0; +#line 1018 "" + f_clos(&cl__1); +#line 1019 "" + s_stop("", (ftnlen)0); +#line 1020 "" + } +#line 1021 "" + s_wsle(&io___42); +#line 1021 "" + do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 1021 "" + do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer)) + ; +#line 1021 "" + e_wsle(); +#line 1022 "" + ip1 = 1; +#line 1023 "" + pmxb_(&c_false, poe0, &ncalls, &optimize); +#line 1024 "" + poestats_(&nsyst, poe0, &poebar0, &devnorm0); + +/* Save initial deviation and line breaks for later comparison */ + +#line 1028 "" + if (numit == 1) { +#line 1029 "" + devpmx = devnorm0; +#line 1030 "" + i__2 = nsyst; +#line 1030 "" + for (isys = 1; isys <= i__2; ++isys) { +#line 1031 "" + nbari[isys - 1] = nbars0[isys - 1]; +#line 1032 "" +/* L20: */ +#line 1032 "" + } +#line 1033 "" + } +#line 1034 "" + sortpoe_(&nsyst, poe0, ipoe); +#line 1035 "" + for (iupord = nsyst; iupord >= 1; --iupord) { +#line 1036 "" + isysu = ipoe[iupord - 1]; +#line 1037 "" + s_wsle(&io___51); +#line 1037 "" + do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1037 "" + do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1037 "" + e_wsle(); +#line 1038 "" + s_wsle(&io___52); +#line 1038 "" + do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1038 "" + do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1038 "" + e_wsle(); + +/* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */ + +#line 1042 "" + if (poe0[isysu - 1] < poebar0) { +#line 1042 "" + goto L1; +#line 1042 "" + } +#line 1043 "" + i__2 = nsyst; +#line 1043 "" + for (idnord = 1; idnord <= i__2; ++idnord) { +#line 1044 "" + isysd = ipoe[idnord - 1]; +#line 1045 "" + if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd - + 1] > poebar0) { +#line 1045 "" + goto L5; +#line 1045 "" + } +#line 1047 "" + i__6 = nsyst; +#line 1047 "" + for (isyst = 1; isyst <= i__6; ++isyst) { +#line 1048 "" + nbars[isyst - 1] = nbars0[isyst - 1]; +#line 1049 "" + if (isyst == isysu) { +#line 1050 "" + ++nbars[isyst - 1]; +#line 1051 "" + } else if (isyst == isysd) { +#line 1052 "" + --nbars[isyst - 1]; +#line 1053 "" + } +#line 1054 "" +/* L2: */ +#line 1054 "" + } +#line 1055 "" + pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, ( + ftnlen)44); +#line 1056 "" + pmxb_(&c_false, poe, &ncalls, &optimize); +#line 1057 "" + poestats_(&nsyst, poe, &poebar, &devnorm); +#line 1058 "" + if (devnorm < devnorm0) { +#line 1059 "" + devnorm0 = devnorm; +#line 1060 "" + poebar0 = poebar; +#line 1061 "" + i__6 = nsyst; +#line 1061 "" + for (isys = 1; isys <= i__6; ++isys) { +#line 1062 "" + nbars0[isys - 1] = nbars[isys - 1]; +#line 1063 "" + poe0[isys - 1] = poe[isys - 1]; +#line 1064 "" +/* L4: */ +#line 1064 "" + } +#line 1065 "" + s_wsle(&io___60); +#line 1065 "" + do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( + ftnlen)32); +#line 1065 "" + do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( + integer)); +#line 1065 "" + do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( + integer)); +#line 1065 "" + do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( + real)); +#line 1065 "" + e_wsle(); +#line 1067 "" + s_wsle(&io___61); +#line 1067 "" + do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( + ftnlen)32); +#line 1067 "" + do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( + integer)); +#line 1067 "" + do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( + integer)); +#line 1067 "" + do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( + real)); +#line 1067 "" + e_wsle(); +#line 1069 "" + s_wsfe(&io___62); +#line 1069 "" + i__6 = nsyst; +#line 1069 "" + for (isys = 1; isys <= i__6; ++isys) { +#line 1069 "" + do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) + sizeof(integer)); +#line 1069 "" + } +#line 1069 "" + e_wsfe(); +#line 1070 "" + s_wsfe(&io___63); +#line 1070 "" + i__6 = nsyst; +#line 1070 "" + for (isys = 1; isys <= i__6; ++isys) { +#line 1070 "" + do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) + sizeof(integer)); +#line 1070 "" + } +#line 1070 "" + e_wsfe(); +#line 1071 "" + sortpoe_(&nsyst, poe0, ipoe); +#line 1072 "" + goto L6; +#line 1073 "" + } +#line 1074 "" +L5: +#line 1074 "" + ; +#line 1074 "" + } +#line 1075 "" +L1: +#line 1075 "" + ; +#line 1075 "" + } + +/* If we get here, must have gone thru all switches and found nothing better, */ +/* so done! */ + +#line 1080 "" + goto L7; +#line 1081 "" +L6: +#line 1081 "" + ; +#line 1081 "" + } +#line 1082 "" +L7: +#line 1083 "" + s_wsle(&io___64); +#line 1083 "" + do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1083 "" + do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1083 "" + do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1083 "" + do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1083 "" + e_wsle(); +#line 1084 "" + s_wsle(&io___65); +#line 1084 "" + do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1084 "" + do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1084 "" + do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1084 "" + do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1084 "" + e_wsle(); +#line 1085 "" + s_wsle(&io___66); +#line 1085 "" + do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1085 "" + do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1085 "" + do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1085 "" + do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1085 "" + e_wsle(); +#line 1086 "" + s_wsle(&io___67); +#line 1086 "" + do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1086 "" + do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1086 "" + do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1086 "" + do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1086 "" + e_wsle(); +#line 1087 "" + s_wsle(&io___68); +#line 1087 "" + do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1087 "" + r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1087 "" + do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1087 "" + e_wsle(); +#line 1088 "" + s_wsle(&io___69); +#line 1088 "" + do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1088 "" + r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1088 "" + do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1088 "" + e_wsle(); +#line 1089 "" + printl_("Initial bars/system:", (ftnlen)20); +#line 1090 "" + s_wsfe(&io___70); +#line 1090 "" + i__1 = nsyst; +#line 1090 "" + for (isys = 1; isys <= i__1; ++isys) { +#line 1090 "" + do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1090 "" + } +#line 1090 "" + e_wsfe(); +#line 1091 "" + s_wsfe(&io___71); +#line 1091 "" + i__1 = nsyst; +#line 1091 "" + for (isys = 1; isys <= i__1; ++isys) { +#line 1091 "" + do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1091 "" + } +#line 1091 "" + e_wsfe(); +#line 1092 "" + printl_("Final bars/system:", (ftnlen)18); +#line 1093 "" + s_wsfe(&io___72); +#line 1093 "" + i__1 = nsyst; +#line 1093 "" + for (isys = 1; isys <= i__1; ++isys) { +#line 1093 "" + do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1093 "" + } +#line 1093 "" + e_wsfe(); +#line 1094 "" + s_wsfe(&io___73); +#line 1094 "" + i__1 = nsyst; +#line 1094 "" + for (isys = 1; isys <= i__1; ++isys) { +#line 1094 "" + do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1094 "" + } +#line 1094 "" + e_wsfe(); +#line 1095 "" + pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44); +#line 1096 "" + pmxb_(&c_true, poe0, &ncalls, &optimize); +/* itend = mytime() */ +/* print*,'Elapsed time in ms:',itend-itstart */ +/* write(15,*)'Elapsed time in ms:',itend-itstart */ +#line 1100 "" + cl__1.cerr = 0; +#line 1100 "" + cl__1.cunit = 15; +#line 1100 "" + cl__1.csta = 0; +#line 1100 "" + f_clos(&cl__1); +#line 1101 "" + return 0; +} /* MAIN__ */ + +/* Subroutine */ int accsym_(integer *nacc, char *acsymq, integer *lacc, + ftnlen acsymq_len) +{ + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + static integer iacc; + + /* Fortran I/O blocks */ + static cilist io___75 = { 0, 6, 0, 0, 0 }; + + +#line 1104 "" + iacc = *nacc & 7; +#line 1105 "" + if (iacc == 1) { +#line 1106 "" + s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2); +#line 1107 "" + *lacc = 2; +#line 1108 "" + } else if (iacc == 2) { +#line 1109 "" + s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2); +#line 1110 "" + *lacc = 2; +#line 1111 "" + } else if (iacc == 3) { +#line 1112 "" + s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2); +#line 1113 "" + *lacc = 2; +#line 1114 "" + } else if (iacc == 5) { +#line 1115 "" + s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3); +#line 1116 "" + *lacc = 3; +#line 1117 "" + } else if (iacc == 6) { +#line 1118 "" + s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3); +#line 1119 "" + *lacc = 3; +#line 1120 "" + } else { +#line 1121 "" + s_wsle(&io___75); +#line 1121 "" + do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16); +#line 1121 "" + do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer)); +#line 1121 "" + e_wsle(); +#line 1122 "" + } +#line 1123 "" + return 0; +} /* accsym_ */ + +/* Subroutine */ int addask_(real *taskn, real *waskn, real *elaskn, real * + fixednew, real *scaldold, real *tglp1, logical *isudsp) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + static real oldelask; + extern /* Subroutine */ int stop1_(void); + static integer iudsp; + static real oldwask; + + /* Fortran I/O blocks */ + static cilist io___77 = { 0, 6, 0, 0, 0 }; + + +#line 1132 "" + if (*isudsp) { + +/* Find which udsp we're dealing with */ + +#line 1136 "" + i__1 = comudsp_1.nudsp; +#line 1136 "" + for (iudsp = 1; iudsp <= i__1; ++iudsp) { +#line 1137 "" + if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs( + r__1)) < comtol_1.tol) { +#line 1137 "" + goto L2; +#line 1137 "" + } +#line 1138 "" +/* L1: */ +#line 1138 "" + } +#line 1139 "" + s_wsle(&io___77); +#line 1139 "" + do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen) + 36); +#line 1139 "" + e_wsle(); +#line 1140 "" + stop1_(); +#line 1141 "" +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 1146 "" + 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 1150 "" + comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1]; +#line 1151 "" + } else { + +/* This place has no other space. */ + +#line 1155 "" + ++comas1_1.naskb; +#line 1156 "" + comas1_1.task[comas1_1.naskb - 1] = *taskn; +#line 1157 "" + comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1]; +#line 1158 "" + comas1_1.elask[comas1_1.naskb - 1] = 0.f; +#line 1159 "" + } +#line 1160 "" + } else { +/* 130330 start */ +#line 1162 "" + oldwask = 0.f; +#line 1163 "" + oldelask = 0.f; +/* 130330 end */ + +/* This is a normal space, no effect if smaller than existing space */ + +#line 1168 "" + 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 1173 "" + 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 1179 "" + oldwask = comas1_1.wask[comas1_1.naskb - 1]; +#line 1180 "" + oldelask = comas1_1.elask[comas1_1.naskb - 1]; +/* End of 130330 insertions */ +#line 1182 "" + --comas1_1.naskb; +#line 1183 "" + } else { +#line 1184 "" + return 0; +#line 1185 "" + } +#line 1186 "" + } +#line 1187 "" + ++comas1_1.naskb; +#line 1188 "" + comas1_1.task[comas1_1.naskb - 1] = *taskn; +#line 1189 "" + comas1_1.wask[comas1_1.naskb - 1] = *waskn; +#line 1190 "" + comas1_1.elask[comas1_1.naskb - 1] = *elaskn; +/* 130330 start */ +/* fixednew = fixednew+waskn */ +/* scaldold = scaldold+elaskn */ +#line 1194 "" + *fixednew = *fixednew + *waskn - oldwask; +#line 1195 "" + *scaldold = *scaldold + *elaskn - oldelask; +/* 130330 end */ +#line 1197 "" + } +#line 1198 "" + return 0; +} /* addask_ */ + +/* Subroutine */ int addblank_(char *noteq, integer *lnoten, ftnlen noteq_len) +{ + /* System generated locals */ + address a__1[2]; + integer i__1[2]; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + static char tchar[1]; + +#line 1203 "" + *(unsigned char *)tchar = *(unsigned char *)noteq; +/* Writing concatenation */ +#line 1204 "" + i__1[0] = 1, a__1[0] = " "; +#line 1204 "" + i__1[1] = 1, a__1[1] = tchar; +#line 1204 "" + s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8); +#line 1205 "" + *lnoten = 2; +#line 1206 "" + return 0; +} /* addblank_ */ + +/* Subroutine */ int addfb_(integer *nfb, integer *iv, real *tnew, real *t1fb, + real *t2fb, char *ulfbq, integer *ifbadd, ftnlen ulfbq_len) +{ + static integer ifb; + +#line 1214 "" + /* Parameter adjustments */ +#line 1214 "" + ulfbq -= 25; +#line 1214 "" + t2fb -= 25; +#line 1214 "" + t1fb -= 25; +#line 1214 "" + --nfb; +#line 1214 "" + +#line 1214 "" + /* Function Body */ +#line 1214 "" + *ifbadd = 1; +#line 1215 "" + ++nfb[*iv]; +#line 1216 "" + for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) { +#line 1217 "" + if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) { +#line 1218 "" + t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24]; +#line 1219 "" + t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24]; +#line 1220 "" + *(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char * + )&ulfbq[*iv + ifb * 24]; +#line 1221 "" + } else { +#line 1222 "" + *ifbadd = ifb + 1; +#line 1223 "" + goto L2; +#line 1224 "" + } +#line 1225 "" +/* L1: */ +#line 1225 "" + } +#line 1226 "" +L2: +#line 1227 "" + t1fb[*iv + *ifbadd * 24] = *tnew; +#line 1228 "" + *(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x'; +#line 1229 "" + return 0; +} /* addfb_ */ + +/* Subroutine */ int addmidi_(integer *icm, integer *nolev, integer *iacc, + integer *midisig, real *time, logical *rest, logical *endrest) +{ + /* Initialized data */ + + static shortint icmm[16] = { 0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16 }; + + /* System generated locals */ + integer i__1, i__2, i__3; + real r__1; + + /* Builtin functions */ + integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *, + char *, ftnlen), e_wsle(void), i_indx(char *, char *, ftnlen, + ftnlen); + + /* Local variables */ + static logical it1found; + static integer nsav4tie; + extern /* Subroutine */ int chkimidi_(integer *); + static char notenumq[1]; + static integer i__, j, it1; + extern integer igetvarlen_(shortint *, integer *, integer *, integer *); + static integer it2; + extern integer isetvarlen_(integer *, integer *); + static integer ion; + static shortint itk[25]; + static integer jacc, kacc, macc, ioff, isav, idur, jsav, idur1; + extern /* Subroutine */ int stop1_(void); + static integer imidt, ipsav, ipsav0, nby2on; + extern integer iashft_(integer *); + static integer nbytes; + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer nby2off; + static logical eximacc; + static integer itiesav[500] /* was [5][100] */, idurvar; + + /* Fortran I/O blocks */ + static cilist io___87 = { 0, 6, 0, 0, 0 }; + static cilist io___99 = { 0, 6, 0, 0, 0 }; + + +/* subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest) */ +/* common /commidisig/ midisig(nm) */ + +/* Following variables are local but must be saved. I hope they are. */ +/* (3/18/00) With g77 they are not, so add a common block here. */ + +/* integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12) */ +/* data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/ */ + +/* Cancel out barline accidentals if there's a rest. */ + +#line 1269 "" + if (*rest) { +#line 1269 "" + comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0; +#line 1269 "" + } + +/* Special path to insert dummy rest at end of a section */ + +#line 1273 "" + if (*endrest) { +#line 1273 "" + goto L20; +#line 1273 "" + } + +#line 1275 "" + i__1 = commidi_1.nmidcrd; +#line 1275 "" + for (ion = 0; ion <= i__1; ++ion) { + +/* check if this is only to get pitch of a chord note */ + +#line 1279 "" + if (commidi_1.notmain) { +#line 1279 "" + goto L6; +#line 1279 "" + } + +/* check for rest */ + +#line 1283 "" + if (*rest) { + +/* Will not put in a note, but must update timing */ + +#line 1287 "" + if (! commidi_1.restpend[*icm]) { + +/* First rest in sequence, save the time */ + +#line 1291 "" + commidi_1.restpend[*icm] = TRUE_; +#line 1292 "" + commidi_1.trest[*icm] = *time; +#line 1293 "" + } else { +#line 1294 "" + commidi_1.trest[*icm] += *time; +#line 1295 "" + } + +/* 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 1301 "" + chkimidi_(icm); +#line 1302 "" + return 0; +#line 1303 "" + } + +/* time tics */ + +#line 1307 "" + if (commidi_1.imidi[*icm] > 0 && ion == 0) { +#line 1308 "" + idur = commidi_1.mgap; +#line 1309 "" + } else { +#line 1310 "" + idur = 0; +#line 1311 "" + } +#line 1312 "" + if (commidi_1.restpend[*icm]) { +#line 1313 "" + commidi_1.restpend[*icm] = FALSE_; +#line 1314 "" + r__1 = commidi_1.trest[*icm] * 15; +#line 1314 "" + idur += i_nint(&r__1); +#line 1315 "" + } + +/* time to start of note */ + +#line 1319 "" + idurvar = isetvarlen_(&idur, &nby2on); +#line 1320 "" + if (nby2on > 4) { +#line 1321 "" + s_wsle(&io___87); +#line 1321 "" + do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", ( + ftnlen)37); +#line 1321 "" + e_wsle(); +#line 1322 "" + stop1_(); +#line 1323 "" + } +#line 1324 "" + ++commidi_1.imidi[*icm]; +#line 1325 "" + i__2 = nby2on; +#line 1325 "" + 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 1330 "" + commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) * + 25 - 25] = (shortint) (idurvar % 256); +#line 1331 "" + if (nby2on > 1) { +#line 1331 "" + idurvar /= 256; +#line 1331 "" + } +#line 1332 "" +/* L2: */ +#line 1332 "" + } +#line 1333 "" + commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1; + +/* Note-on signal */ + +#line 1337 "" + ++commidi_1.imidi[*icm]; +/* mmidi(icm,imidi(icm)) = 9*16+icm */ +#line 1339 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( + icmm[*icm] + 144); + +/* Entry point for chord note pitch determination */ + +#line 1343 "" +L6: + +/* Get midi pitch. On chord iteration, only do this first time (main note), */ +/* since pitch was already computed for nonmain chord notes. */ + +#line 1348 "" + if (ion == 0) { +#line 1349 "" + ipsav = *nolev * 12.f / 7 + 11; +#line 1350 "" + ipsav0 = ipsav; +#line 1351 "" + if (*midisig != 0) { + +/* Adjust for signature */ + +#line 1355 "" + *(unsigned char *)notenumq = (char) (*nolev % 7 + 48); +#line 1356 "" + if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, ( + ftnlen)1)) { +#line 1357 "" + ++ipsav; +#line 1358 "" + } else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen) + 7, (ftnlen)1)) { +#line 1359 "" + --ipsav; +#line 1360 "" + } +#line 1361 "" + } + +/* Deal with accidentals. */ + +/* iacc 0 1 2 3 4 5 6 7 */ +/* effect X fl sh na X dfl dsh X */ +/* iashft X -1 1 0 X -2 2 X */ + +#line 1369 "" + jacc = 0; +#line 1370 "" + eximacc = FALSE_; +#line 1371 "" + if (*iacc > 0) { + +/* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */ + +#line 1375 "" + jacc = iashft_(iacc); +#line 1376 "" + eximacc = TRUE_; +#line 1377 "" + if (! commidi_1.relacc) { +#line 1377 "" + jacc = jacc + ipsav0 - ipsav; +#line 1377 "" + } + +/* (Above) Shift applies to diatonic pitch but will be added to adjusted one */ + +#line 1381 "" + } 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 1386 "" + i__2 = commidi_1.naccim[*icm]; +#line 1386 "" + for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1387 "" + if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { +#line 1388 "" + jacc = commidi_1.jaccim[*icm + kacc * 25 - 25]; +#line 1389 "" + eximacc = TRUE_; +#line 1390 "" + if (! commidi_1.relacc) { +#line 1390 "" + jacc = jacc + ipsav0 - ipsav; +#line 1390 "" + } +#line 1391 "" + goto L4; +#line 1392 "" + } +#line 1393 "" +/* L3: */ +#line 1393 "" + } +#line 1394 "" +L4: +#line 1395 "" + ; +#line 1395 "" + } + +/* 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 1401 "" + if (comslm_1.naccbl[*icm] > 0 && ! eximacc) { + +/* Possible carryover accid from prior bar (or prior same-pitch note). */ + +#line 1405 "" + i__2 = comslm_1.naccbl[*icm]; +#line 1405 "" + for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1406 "" + if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) { +#line 1407 "" + 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 1411 "" + ++comslm_1.nusebl; +#line 1412 "" + comips_1.jusebl[comslm_1.nusebl - 1] = (shortint) + jacc; +#line 1413 "" + comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (* + nolev); +#line 1414 "" + if (! commidi_1.relacc) { +#line 1414 "" + jacc = jacc + ipsav0 - ipsav; +#line 1414 "" + } +#line 1415 "" + goto L22; +#line 1416 "" + } +#line 1417 "" +/* L21: */ +#line 1417 "" + } +#line 1418 "" +L22: +#line 1419 "" + ; +#line 1419 "" + } +#line 1420 "" + ipsav += jacc; +#line 1421 "" + } +#line 1422 "" + if (commidi_1.notmain) { +#line 1423 "" + commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav; + +/* Save pitch for tie checks */ + +#line 1427 "" + if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) { +#line 1427 "" + comips_1.ipslon[*icm] = (shortint) ipsav; +#line 1427 "" + } +#line 1429 "" + } else { +#line 1430 "" + ++commidi_1.imidi[*icm]; +#line 1431 "" + if (ion == 0) { +#line 1432 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( + shortint) ipsav; +#line 1433 "" + if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) + { +#line 1433 "" + comips_1.ipslon[*icm] = (shortint) ipsav; +#line 1433 "" + } +#line 1435 "" + } else { +#line 1436 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( + shortint) commidi_1.mcpitch[ion - 1]; +#line 1437 "" + } +#line 1438 "" + } +#line 1439 "" + 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 1444 "" + if (*iacc > 0) { + +/* Set marker for accidental for possible continuations later this bar */ +/* but first check and clear earlier ones on same note. */ + +#line 1449 "" + i__2 = commidi_1.naccim[*icm]; +#line 1449 "" + for (kacc = 1; kacc <= i__2; ++kacc) { +#line 1450 "" + if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) { +#line 1451 "" + i__3 = commidi_1.naccim[*icm] - 1; +#line 1451 "" + for (macc = kacc; macc <= i__3; ++macc) { +#line 1452 "" + commidi_1.laccim[*icm + macc * 25 - 25] = + commidi_1.laccim[*icm + (macc + 1) * 25 - + 25]; +#line 1453 "" + commidi_1.jaccim[*icm + macc * 25 - 25] = + commidi_1.jaccim[*icm + (macc + 1) * 25 - + 25]; +#line 1454 "" +/* L24: */ +#line 1454 "" + } +#line 1455 "" + goto L25; +#line 1456 "" + } +#line 1457 "" +/* L23: */ +#line 1457 "" + } +#line 1458 "" + goto L26; +#line 1459 "" +L25: +#line 1460 "" + --commidi_1.naccim[*icm]; +#line 1461 "" +L26: + +/* Flag new accidental */ + +#line 1465 "" + ++commidi_1.naccim[*icm]; +#line 1466 "" + commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = * + nolev; +#line 1467 "" + commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = + iashft_(iacc); +#line 1468 "" + } + +/* Bail if this is a chord note on the first call (from docrd) */ + +#line 1472 "" + if (commidi_1.notmain) { +#line 1473 "" + chkimidi_(icm); +#line 1474 "" + return 0; +#line 1475 "" + } +#line 1476 "" + } + +/* Vel */ + +#line 1480 "" + ++commidi_1.imidi[*icm]; +/* mmidi(icm,imidi(icm)) = 127 */ +#line 1482 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) + commvel_1.midvelc[*icm]; +#line 1483 "" + chkimidi_(icm); +#line 1484 "" +/* L7: */ +#line 1484 "" + } + +/* For tie checks */ + +#line 1488 "" + if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) { +#line 1488 "" + comslm_1.imidso[*icm] = commidi_1.imidi[*icm]; +#line 1488 "" + } + +/* Entry point for special rests at section ends (endrest=T) */ + +#line 1492 "" +L20: + +/* Now insert all the ends */ + +#line 1496 "" + i__1 = commidi_1.nmidcrd; +#line 1496 "" + for (ioff = 0; ioff <= i__1; ++ioff) { +#line 1497 "" + if (ioff == 0) { + +/* time to end */ + +#line 1501 "" + r__1 = *time * 15; +#line 1501 "" + idur1 = i_nint(&r__1); +#line 1502 "" + r__1 = commidi_1.trest[*icm] * 15; +#line 1502 "" + if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) { +#line 1503 "" + idur = idur1 - commidi_1.mgap; +#line 1504 "" + } else { +#line 1505 "" + idur = idur1; +#line 1506 "" + } + +/* Deal with roundoff problems with 7-tuplets on half or quarters */ + +#line 1510 "" + if (idur1 == 69) { +#line 1511 "" + ++comdiag_1.n69[*icm]; +/* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */ +#line 1513 "" + if ((comdiag_1.n69[*icm] + 6) % 7 > 3) { +#line 1513 "" + idur = idur1 - commidi_1.mgap - 1; +#line 1513 "" + } +#line 1514 "" + } else if (idur1 == 34) { +#line 1515 "" + ++comdiag_1.n34[*icm]; +#line 1516 "" + if ((comdiag_1.n34[*icm] + 6) % 7 > 4) { +#line 1516 "" + idur = idur1 - commidi_1.mgap + 1; +#line 1516 "" + } +#line 1517 "" + } +#line 1518 "" + idurvar = isetvarlen_(&idur, &nby2off); +#line 1519 "" + if (nby2off > 4) { +#line 1520 "" + s_wsle(&io___99); +#line 1520 "" + do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", + (ftnlen)37); +#line 1520 "" + e_wsle(); +#line 1521 "" + stop1_(); +#line 1522 "" + } +#line 1523 "" + ++commidi_1.imidi[*icm]; +#line 1524 "" + chkimidi_(icm); +#line 1525 "" + i__2 = nby2off; +#line 1525 "" + for (i__ = 1; i__ <= i__2; ++i__) { +#line 1526 "" + commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__) + * 25 - 25] = (shortint) (idurvar % 256); +#line 1527 "" + if (nby2off > 1) { +#line 1527 "" + idurvar /= 256; +#line 1527 "" + } +#line 1528 "" +/* L1: */ +#line 1528 "" + } +#line 1529 "" + commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1; +#line 1530 "" + } else { + +/* Inserting end of chord note, delta time is 0 */ + +#line 1534 "" + ++commidi_1.imidi[*icm]; +#line 1535 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; +#line 1536 "" + } + +/* Note off */ + +#line 1540 "" + ++commidi_1.imidi[*icm]; +/* mmidi(icm,imidi(icm)) = 8*16+icm */ +#line 1542 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) ( + icmm[*icm] + 128); + +/* Pitch */ + +#line 1546 "" + ++commidi_1.imidi[*icm]; +#line 1547 "" + if (ioff == 0) { +#line 1548 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( + shortint) ipsav; +#line 1549 "" + } else { +#line 1550 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = ( + shortint) commidi_1.mcpitch[ioff - 1]; +#line 1551 "" + } + +/* Vel */ + +#line 1555 "" + ++commidi_1.imidi[*icm]; +#line 1556 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0; +#line 1557 "" + chkimidi_(icm); +#line 1558 "" + if (*endrest) { +#line 1559 "" + return 0; +#line 1560 "" + } + +/* print*,'Off, icm,imidi,ipsav,idur:',icm,imidi(icm),ipsav,time */ + +#line 1564 "" +/* L8: */ +#line 1564 "" + } +#line 1565 "" + comslm_1.naccbl[*icm] = comslm_1.nusebl; +#line 1566 "" + if (comslm_1.nusebl > 0) { + +/* Fix tables of "bar-line" accids that are saved due to consecutive notes. */ + +#line 1570 "" + i__1 = comslm_1.nusebl; +#line 1570 "" + for (kacc = 1; kacc <= i__1; ++kacc) { +#line 1571 "" + comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1] + ; +#line 1572 "" + comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1] + ; +#line 1573 "" +/* L30: */ +#line 1573 "" + } +#line 1574 "" + comslm_1.nusebl = 0; +#line 1575 "" + } + +/* Begin tie checks */ + +#line 1579 "" + if (comslm_1.slmon[*icm]) { + +/* Prior note had a slur start */ + +#line 1583 "" + 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) */ +/* Make a list of times of all events back to the one starting at imidso+1, */ +/* which is at or before where the tie started. Ident tie start and stop by */ +/* 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 1591 "" + nsav4tie = 0; +#line 1592 "" + imidt = comslm_1.imidso[*icm]; +#line 1593 "" +L10: +#line 1593 "" + ++nsav4tie; +#line 1594 "" + itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, & + imidt, &nbytes); +#line 1595 "" + imidt += nbytes; +#line 1596 "" + for (j = 1; j <= 3; ++j) { +#line 1597 "" + itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + ( + imidt + j) * 25 - 25]; +#line 1598 "" +/* L11: */ +#line 1598 "" + } +#line 1599 "" + imidt += 3; +#line 1600 "" + if (nsav4tie == 1) { +#line 1601 "" + itiesav[4] = itiesav[0]; +#line 1602 "" + } else { +#line 1603 "" + itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] + + itiesav[(nsav4tie - 1) * 5 - 1]; +#line 1605 "" + } +#line 1606 "" + if (imidt != commidi_1.imidi[*icm]) { +#line 1606 "" + goto L10; +#line 1606 "" + } + +/* Find which two pitches agree with saved slur pitch. */ + +#line 1610 "" + it1found = FALSE_; +#line 1611 "" + i__1 = nsav4tie; +#line 1611 "" + for (it2 = 1; it2 <= i__1; ++it2) { +#line 1612 "" + if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) { +#line 1613 "" + if (it1found) { +#line 1613 "" + goto L13; +#line 1613 "" + } +#line 1614 "" + it1 = it2; +#line 1615 "" + it1found = TRUE_; +#line 1616 "" + } +#line 1617 "" +/* L12: */ +#line 1617 "" + } +#line 1618 "" + printl_("Program error, tied notes, send source to Dr. Don", ( + ftnlen)49); +#line 1620 "" + it1 = nsav4tie + 1; +#line 1621 "" + it2 = nsav4tie + 1; +#line 1622 "" +L13: + +/* List the positions we want to keep */ + +#line 1626 "" + jsav = 0; +#line 1627 "" + i__1 = nsav4tie; +#line 1627 "" + for (isav = 1; isav <= i__1; ++isav) { +#line 1628 "" + if (isav == it1 || isav == it2) { +#line 1628 "" + goto L14; +#line 1628 "" + } +#line 1629 "" + ++jsav; +#line 1630 "" + itk[jsav - 1] = (shortint) isav; +#line 1631 "" +L14: +#line 1631 "" + ; +#line 1631 "" + } +#line 1632 "" + nsav4tie += -2; + +/* Now dump events it1 & it2, recompute times, restack mmidi. */ + +#line 1636 "" + commidi_1.imidi[*icm] = comslm_1.imidso[*icm]; +#line 1637 "" + i__1 = nsav4tie; +#line 1637 "" + for (isav = 1; isav <= i__1; ++isav) { +#line 1638 "" + if (isav == 1) { +#line 1639 "" + idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], & + nbytes); +#line 1640 "" + } else { +#line 1641 "" + i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav + - 2] * 5 - 1]; +#line 1641 "" + idurvar = isetvarlen_(&i__2, &nbytes); +#line 1643 "" + } +#line 1644 "" + ++commidi_1.imidi[*icm]; +#line 1645 "" + i__2 = nbytes; +#line 1645 "" + for (i__ = 1; i__ <= i__2; ++i__) { +#line 1646 "" + commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes - + i__) * 25 - 25] = (shortint) (idurvar % 256); +#line 1647 "" + if (nbytes > 1) { +#line 1647 "" + idurvar /= 256; +#line 1647 "" + } +#line 1648 "" +/* L16: */ +#line 1648 "" + } +#line 1649 "" + commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1; +#line 1650 "" + for (i__ = 2; i__ <= 4; ++i__) { +#line 1651 "" + ++commidi_1.imidi[*icm]; +#line 1652 "" + commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = + (shortint) itiesav[i__ + itk[isav - 1] * 5 - 6]; +#line 1653 "" +/* L17: */ +#line 1653 "" + } +#line 1654 "" +/* L15: */ +#line 1654 "" + } +#line 1655 "" + } +#line 1656 "" + comslm_1.slmon[*icm] = FALSE_; +#line 1657 "" + comslm_1.levsoff[*icm] = 0; +#line 1658 "" + if (! comslm_1.dbltie) { +#line 1658 "" + comslm_1.levson[*icm] = 0; +#line 1658 "" + } +#line 1659 "" + } +#line 1660 "" + if (comslm_1.levson[*icm] > 0) { +#line 1660 "" + comslm_1.slmon[*icm] = TRUE_; +#line 1660 "" + } +#line 1661 "" + if (commidi_1.nmidcrd > 0) { +#line 1661 "" + commidi_1.nmidcrd = 0; +#line 1661 "" + } +#line 1662 "" + chkimidi_(icm); +#line 1663 "" + return 0; +} /* addmidi_ */ + +/* Subroutine */ int addstr_(char *notexq, integer *lnote, char *soutq, + integer *lsout, ftnlen notexq_len, ftnlen soutq_len) +{ + /* System generated locals */ + address a__1[2]; + integer i__1[2]; + char ch__1[81]; + + /* Builtin functions */ + integer s_wsfe(cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_fio(integer *, char *, ftnlen), e_wsfe(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___111 = { 0, 11, 0, "(a)", 0 }; + + +#line 1670 "" + if (*lsout + *lnote > 72) { +#line 1671 "" + if (comlast_1.islast) { +#line 1671 "" + s_wsfe(&io___111); +/* Writing concatenation */ +#line 1671 "" + i__1[0] = *lsout, a__1[0] = soutq; +#line 1671 "" + i__1[1] = 1, a__1[1] = "%"; +#line 1671 "" + s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81); +#line 1671 "" + do_fio(&c__1, ch__1, *lsout + 1); +#line 1671 "" + e_wsfe(); +#line 1671 "" + } +#line 1672 "" + *lsout = 0; +#line 1673 "" + } +#line 1674 "" + if (*lsout > 0) { +/* Writing concatenation */ +#line 1675 "" + i__1[0] = *lsout, a__1[0] = soutq; +#line 1675 "" + i__1[1] = *lnote, a__1[1] = notexq; +#line 1675 "" + s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80); +#line 1676 "" + } else { +#line 1677 "" + s_copy(soutq, notexq, (ftnlen)80, (*lnote)); +#line 1678 "" + } +#line 1679 "" + *lsout += *lnote; +#line 1680 "" + return 0; +} /* addstr_ */ + +/* Subroutine */ int adjusteskz_(integer *ib, integer *istart, real *poenom) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1; + + /* Local variables */ + static integer in, iaskb, inmin; + static real eskadd; + + +/* For block ib, this adds accidental spaces to eskz, for use in getting */ +/* length of xtup bracket and slopes of brackets and beams. */ + +#line 1706 "" + /* Parameter adjustments */ +#line 1706 "" + --istart; +#line 1706 "" + +#line 1706 "" + /* Function Body */ +#line 1706 "" + inmin = istart[*ib] + 1; +#line 1707 "" + i__1 = comas1_1.naskb; +#line 1707 "" + for (iaskb = 1; iaskb <= i__1; ++iaskb) { +#line 1708 "" + if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] - + comtol_1.tol) { +#line 1708 "" + goto L10; +#line 1708 "" + } +#line 1709 "" + eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb - + 1]; +#line 1710 "" + i__2 = comntot_1.ntot; +#line 1710 "" + for (in = inmin; in <= i__2; ++in) { +#line 1711 "" + if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) { +#line 1712 "" + comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 + - 25] += eskadd; +#line 1713 "" + if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs( + r__1)) < comtol_1.tol) { +#line 1713 "" + --inmin; +#line 1713 "" + } +#line 1714 "" + } else { +#line 1715 "" + ++inmin; +#line 1716 "" + } +#line 1717 "" +/* L11: */ +#line 1717 "" + } +#line 1718 "" +L10: +#line 1718 "" + ; +#line 1718 "" + } +#line 1719 "" + return 0; +} /* adjusteskz_ */ + +/* Subroutine */ int askfig_(char *pathnameq, integer *lpath, char *basenameq, + integer *lbase, logical *figbass, logical *istype0, ftnlen + pathnameq_len, ftnlen basenameq_len) +{ + /* System generated locals */ + address a__1[3], a__2[2]; + integer i__1[3], i__2[2], i__3; + char ch__1[1], ch__2[88], ch__3[15], ch__4[5], ch__5[4]; + olist o__1; + cllist cl__1; + alist al__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer f_open(olist *), f_rew(alist *), f_clos(cllist *), s_wsfe(cilist * + ), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_rsfe(cilist + *), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), s_wsfi( + icilist *), e_wsfi(void), i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer il; + static char sq[1]; + static integer ihs; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static logical done; + extern integer llen_(char *, integer *, ftnlen); + static char outq[129]; + extern /* Subroutine */ int moveln_(integer *, integer *, logical *); + static integer lenout; + extern /* Subroutine */ int putast_(real *, integer *, char *, ftnlen); + static integer indxask; + + /* Fortran I/O blocks */ + static cilist io___119 = { 0, 12, 0, "(a)", 0 }; + static cilist io___120 = { 0, 12, 0, "(a)", 0 }; + static cilist io___122 = { 0, 11, 1, "(a129)", 0 }; + static icilist io___124 = { 0, outq+11, 0, "(f4.1)", 4, 1 }; + static cilist io___127 = { 0, 12, 0, "(a)", 0 }; + static cilist io___128 = { 0, 16, 1, "(a129)", 0 }; + static cilist io___129 = { 0, 12, 0, "(a)", 0 }; + + +#line 1731 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 1731 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 1732 "" + o__1.oerr = 0; +#line 1732 "" + o__1.ounit = 12; +#line 1732 "" + o__1.ofnmlen = *lpath + *lbase + 4; +/* Writing concatenation */ +#line 1732 "" + i__1[0] = *lpath, a__1[0] = pathnameq; +#line 1732 "" + i__1[1] = *lbase, a__1[1] = basenameq; +#line 1732 "" + i__1[2] = 4, a__1[2] = ".tex"; +#line 1732 "" + s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88); +#line 1732 "" + o__1.ofnm = ch__2; +#line 1732 "" + o__1.orl = 0; +#line 1732 "" + o__1.osta = 0; +#line 1732 "" + o__1.oacc = 0; +#line 1732 "" + o__1.ofm = 0; +#line 1732 "" + o__1.oblnk = 0; +#line 1732 "" + f_open(&o__1); + +/* Transfer first 5 lines of main internal TeX file */ + +#line 1736 "" + for (il = 1; il <= 5; ++il) { +#line 1737 "" + moveln_(&c__11, &c__12, &done); +#line 1738 "" +/* L11: */ +#line 1738 "" + } +#line 1739 "" + if (*istype0) { + +/* Transfer literal TeX stuff from special scratch file */ + +#line 1743 "" + al__1.aerr = 0; +#line 1743 "" + al__1.aunit = 17; +#line 1743 "" + f_rew(&al__1); +#line 1744 "" +L10: +#line 1744 "" + moveln_(&c__17, &c__12, &done); +#line 1745 "" + if (! done) { +#line 1745 "" + goto L10; +#line 1745 "" + } +#line 1746 "" + cl__1.cerr = 0; +#line 1746 "" + cl__1.cunit = 17; +#line 1746 "" + cl__1.csta = 0; +#line 1746 "" + f_clos(&cl__1); +#line 1747 "" + } + +/* Transfer next 2 lines from main scratch file */ + +#line 1751 "" + for (il = 1; il <= 2; ++il) { +#line 1752 "" + moveln_(&c__11, &c__12, &done); +#line 1753 "" +/* L3: */ +#line 1753 "" + } +#line 1754 "" + if (compoi_1.ispoi) { +#line 1754 "" + s_wsfe(&io___119); +/* Writing concatenation */ +#line 1754 "" + i__2[0] = 1, a__2[0] = sq; +#line 1754 "" + i__2[1] = 14, a__2[1] = "input musixpoi"; +#line 1754 "" + s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 1754 "" + do_fio(&c__1, ch__3, (ftnlen)15); +#line 1754 "" + e_wsfe(); +#line 1754 "" + } +#line 1755 "" + if (combbm_1.isbbm) { +#line 1755 "" + s_wsfe(&io___120); +/* Writing concatenation */ +#line 1755 "" + i__2[0] = 1, a__2[0] = sq; +#line 1755 "" + i__2[1] = 14, a__2[1] = "input musixbbm"; +#line 1755 "" + s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 1755 "" + do_fio(&c__1, ch__3, (ftnlen)15); +#line 1755 "" + e_wsfe(); +#line 1755 "" + } +#line 1756 "" + if (*figbass) { + +/* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */ + +#line 1760 "" +L4: +#line 1760 "" + moveln_(&c__14, &c__12, &done); +#line 1761 "" + if (! done) { +#line 1761 "" + goto L4; +#line 1761 "" + } +#line 1762 "" + cl__1.cerr = 0; +#line 1762 "" + cl__1.cunit = 14; +#line 1762 "" + cl__1.csta = 0; +#line 1762 "" + f_clos(&cl__1); +#line 1763 "" + } +#line 1764 "" + comas3_1.iask = 0; +#line 1765 "" + ihs = 0; +#line 1766 "" +L1: +#line 1766 "" + i__3 = s_rsfe(&io___122); +#line 1766 "" + if (i__3 != 0) { +#line 1766 "" + goto L999; +#line 1766 "" + } +#line 1766 "" + i__3 = do_fio(&c__1, outq, (ftnlen)129); +#line 1766 "" + if (i__3 != 0) { +#line 1766 "" + goto L999; +#line 1766 "" + } +#line 1766 "" + i__3 = e_rsfe(); +#line 1766 "" + if (i__3 != 0) { +#line 1766 "" + goto L999; +#line 1766 "" + } + +/* Hardspaces. */ + +/* Writing concatenation */ +#line 1770 "" + i__2[0] = 1, a__2[0] = sq; +#line 1770 "" + i__2[1] = 4, a__2[1] = "xard"; +#line 1770 "" + s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5); +#line 1770 "" + if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) { +#line 1771 "" + ++ihs; +#line 1772 "" + *(unsigned char *)&outq[1] = 'h'; +#line 1773 "" + s_wsfi(&io___124); +#line 1773 "" + do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real)) + ; +#line 1773 "" + e_wsfi(); +#line 1774 "" + lenout = 19; +#line 1775 "" + goto L9; +#line 1776 "" + } + +/* This part hard-wires ask's into new .tex file as ast's */ + +#line 1780 "" +L2: +/* Writing concatenation */ +#line 1780 "" + i__2[0] = 1, a__2[0] = sq; +#line 1780 "" + i__2[1] = 3, a__2[1] = "ask"; +#line 1780 "" + s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4); +#line 1780 "" + indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4); +#line 1781 "" + if (indxask != 0) { +#line 1782 "" + ++comas3_1.iask; +#line 1783 "" + putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129) + ; +#line 1784 "" + goto L2; +#line 1785 "" + } +#line 1786 "" + lenout = llen_(outq, &c__129, (ftnlen)129); +#line 1787 "" +L9: +#line 1788 "" + s_wsfe(&io___127); +#line 1788 "" + do_fio(&c__1, outq, lenout); +#line 1788 "" + e_wsfe(); + +/* If this is the line with "readmod", check for topmods. */ + +#line 1792 "" + if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7) + == 0) { +#line 1793 "" + comas3_1.topmods = FALSE_; +#line 1794 "" + al__1.aerr = 0; +#line 1794 "" + al__1.aunit = 16; +#line 1794 "" + f_rew(&al__1); +#line 1795 "" + for (il = 1; il <= 1000; ++il) { +#line 1796 "" + i__3 = s_rsfe(&io___128); +#line 1796 "" + if (i__3 != 0) { +#line 1796 "" + goto L8; +#line 1796 "" + } +#line 1796 "" + i__3 = do_fio(&c__1, outq, (ftnlen)129); +#line 1796 "" + if (i__3 != 0) { +#line 1796 "" + goto L8; +#line 1796 "" + } +#line 1796 "" + i__3 = e_rsfe(); +#line 1796 "" + if (i__3 != 0) { +#line 1796 "" + goto L8; +#line 1796 "" + } +#line 1797 "" + lenout = llen_(outq, &c__129, (ftnlen)129); + +/* We inserted the '%' in subroutine littex, to guarantee including blank. */ + +#line 1801 "" + s_wsfe(&io___129); +#line 1801 "" + do_fio(&c__1, outq, lenout); +#line 1801 "" + e_wsfe(); +#line 1802 "" +/* L7: */ +#line 1802 "" + } +#line 1803 "" +L8: +#line 1804 "" + cl__1.cerr = 0; +#line 1804 "" + cl__1.cunit = 16; +#line 1804 "" + cl__1.csta = 0; +#line 1804 "" + f_clos(&cl__1); +#line 1805 "" + } +#line 1806 "" + goto L1; +#line 1807 "" +L999: +#line 1807 "" + cl__1.cerr = 0; +#line 1807 "" + cl__1.cunit = 11; +#line 1807 "" + cl__1.csta = 0; +#line 1807 "" + f_clos(&cl__1); +#line 1808 "" + cl__1.cerr = 0; +#line 1808 "" + cl__1.cunit = 12; +#line 1808 "" + cl__1.csta = 0; +#line 1808 "" + f_clos(&cl__1); +#line 1809 "" + return 0; +} /* askfig_ */ + +/* Subroutine */ int backfill_(integer *iunit, char *oldq, integer *lenold, + char *newq, integer *lennew, ftnlen oldq_len, ftnlen newq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1, i__2[3]; + alist al__1; + + /* Builtin functions */ + integer f_back(alist *), s_rsfe(cilist *), do_fio(integer *, char *, + ftnlen), e_rsfe(void), i_indx(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + static integer linesback, ndx, line; + static char nowq[128], lineq[128*200]; + + /* Fortran I/O blocks */ + static cilist io___131 = { 0, 0, 0, "(a)", 0 }; + static cilist io___136 = { 0, 0, 0, "(a128)", 0 }; + + + +/* In iunit, looks backward for oldq, overwrites newq */ +/* Safest if both are same length! */ + +#line 1818 "" + linesback = 0; +#line 1819 "" +L1: +#line 1820 "" + al__1.aerr = 0; +#line 1820 "" + al__1.aunit = *iunit; +#line 1820 "" + f_back(&al__1); +#line 1821 "" + io___131.ciunit = *iunit; +#line 1821 "" + s_rsfe(&io___131); +#line 1821 "" + do_fio(&c__1, nowq, (ftnlen)128); +#line 1821 "" + e_rsfe(); +#line 1822 "" + ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold)); + +/* Save the line just read */ + +#line 1826 "" + ++linesback; +#line 1827 "" + s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128); +#line 1828 "" + if (ndx == 0) { +#line 1829 "" + al__1.aerr = 0; +#line 1829 "" + al__1.aunit = *iunit; +#line 1829 "" + f_back(&al__1); +#line 1830 "" + goto L1; +#line 1831 "" + } + +/* If here, it's replacement time. */ + +#line 1835 "" + i__1 = ndx + *lenold - 1; +/* Writing concatenation */ +#line 1835 "" + i__2[0] = ndx - 1, a__1[0] = nowq; +#line 1835 "" + i__2[1] = *lennew, a__1[1] = newq; +#line 1835 "" + i__2[2] = 128 - i__1, a__1[2] = nowq + i__1; +#line 1835 "" + s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128); +#line 1837 "" + al__1.aerr = 0; +#line 1837 "" + al__1.aunit = *iunit; +#line 1837 "" + f_back(&al__1); +#line 1838 "" + for (line = linesback; line >= 1; --line) { +#line 1839 "" + io___136.ciunit = *iunit; +#line 1839 "" + s_wsfe(&io___136); +#line 1839 "" + do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128); +#line 1839 "" + e_wsfe(); +#line 1840 "" +/* L2: */ +#line 1840 "" + } +#line 1841 "" + 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]; + char ch__1[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); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static integer ip, mp, len, imp; + extern integer log2_(integer *); + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nole; + 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); + static logical isdotm; + static integer lnoten, multip; + 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 }; + + +#line 1869 "" + ip = all_1.ipo[all_1.jn - 1]; +#line 1870 "" + multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; +#line 1871 "" + 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 1875 "" + i__1 = 4 - multip; +#line 1875 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 1876 "" + notex_(notexq, lnote, (ftnlen)79); +#line 1877 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 1878 "" + return 0; +#line 1879 "" + } +#line 1880 "" + nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; + +/* Check for special situations with 2nds (see precrd) */ + +#line 1884 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 1885 "" + --nole; +#line 1886 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 1887 "" + ++nole; +#line 1888 "" + } +#line 1889 "" + if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { + +/* Xtuplet with no beam, just put in the right kind of note */ + +#line 1893 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { + +/* Forced stem direction */ + +#line 1897 "" + ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 1898 "" + i__1 = 4 - multip; +#line 1898 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 1899 "" + if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { +#line 1899 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; +#line 1899 "" + } +#line 1901 "" + notex_(notexq, lnote, (ftnlen)79); +#line 1902 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; +#line 1903 "" + } else { +#line 1904 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 1904 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 1905 "" + if (lnoten == 1) { +#line 1905 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 1905 "" + } +#line 1906 "" + *lnote = lnoten + 3; +#line 1907 "" + if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) + { + +/* Prior note is not regular-dotted */ + +#line 1912 "" + if (multip == 0) { +/* Writing concatenation */ +#line 1913 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1913 "" + i__2[1] = 1, a__1[1] = "q"; +#line 1913 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1913 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1913 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1914 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 1915 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1915 "" + i__2[1] = 1, a__1[1] = "h"; +#line 1915 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1915 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1915 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1916 "" + } else if (multip == 1) { +/* Writing concatenation */ +#line 1917 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1917 "" + i__2[1] = 1, a__1[1] = "c"; +#line 1917 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1917 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1917 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1918 "" + } else if (multip == 2) { +/* Writing concatenation */ +#line 1919 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1919 "" + i__2[1] = 2, a__1[1] = "cc"; +#line 1919 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1919 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1919 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1920 "" + ++(*lnote); +#line 1921 "" + } else if (multip == 3) { +/* Writing concatenation */ +#line 1922 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1922 "" + i__2[1] = 3, a__1[1] = "ccc"; +#line 1922 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1922 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1922 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1923 "" + *lnote += 2; +#line 1924 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 1925 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1925 "" + i__3[1] = 2, a__2[1] = "wh"; +#line 1925 "" + i__3[2] = 8, a__2[2] = noteq; +#line 1925 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 1926 "" + } else if (multip == -3) { +/* Writing concatenation */ +#line 1927 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 1927 "" + i__3[1] = 5, a__2[1] = "breve"; +#line 1927 "" + i__3[2] = 8, a__2[2] = noteq; +#line 1927 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 1928 "" + *lnote += 3; +#line 1929 "" + } else { +#line 1930 "" + s_wsle(&io___143); +#line 1930 "" + e_wsle(); +#line 1931 "" + s_wsle(&io___144); +#line 1931 "" + do_lio(&c__9, &c__1, "(Error in beamend, send source to "\ + "Dr. Don)", (ftnlen)42); +#line 1931 "" + e_wsle(); +#line 1932 "" + stop1_(); +#line 1933 "" + } +#line 1934 "" + } else { + +/* Prior note is regular-dotted so this one is halved */ + +#line 1938 "" + if (multip == 0) { +/* Writing concatenation */ +#line 1939 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1939 "" + i__2[1] = 1, a__1[1] = "c"; +#line 1939 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1939 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1939 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1940 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 1941 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1941 "" + i__2[1] = 1, a__1[1] = "q"; +#line 1941 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1941 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1941 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1942 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 1943 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 1943 "" + i__2[1] = 1, a__1[1] = "h"; +#line 1943 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 1943 "" + i__2[3] = 8, a__1[3] = noteq; +#line 1943 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 1944 "" + } +#line 1945 "" + } +#line 1946 "" + } +#line 1947 "" + return 0; +#line 1948 "" + } +#line 1949 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 1949 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 1950 "" + *lnote = 0; + +/* New way, with flipend, which was computed in beamstrt. */ + +#line 1954 "" + if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[ + commvl_1.ivx + ip * 24 - 25],30)) { +#line 1954 "" + i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25]; +#line 1954 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 1954 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx + - 1] * 24 - 25] = *(unsigned char *)&ch__1[0]; +#line 1954 "" + } +#line 1956 "" + 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 1960 "" + if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) { + +/* Prior note is a rest, check one before that */ + +#line 1964 "" + mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8; +#line 1965 "" + } else { +#line 1966 "" + mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8; +#line 1967 "" + } +#line 1968 "" + if (multip > mp) { + +/* Assume 1-3, 2-3, or 1-2 */ + +#line 1972 "" + i__1 = mp + 1; +#line 1972 "" + for (imp = multip; imp >= i__1; --imp) { +#line 1973 "" + 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 1974 "" +/* L2: */ +#line 1974 "" + } +#line 1975 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) + { + +/* 2nd member of dotted xtup */ + +#line 1979 "" + i__1 = multip + 1; +#line 1979 "" + 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 1981 "" + } +#line 1982 "" + } + +/* Beam termination and direction analysis */ + +#line 1986 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && ! + combjmp_1.isbjmp) { + +/* This is the end of the first segment in a jump-beam. ivbj1=ivx will be number */ +/* of the jump-beam. ivbj2 will be tested along with isbjmp to see if in the */ +/* voice of the 2nd part of jumped beam. (May need special treatment for */ +/* multi-segment jump-beams */ + +#line 1993 "" + combjmp_1.isbjmp = TRUE_; +#line 1994 "" + combjmp_1.ivbj1 = commvl_1.ivx; +#line 1995 "" + combjmp_1.ivbj2 = 0; +#line 1996 "" + } +#line 1997 "" + 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, */ +/* so some sort of termination is required */ + +#line 2002 "" + *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2003 "" + if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) { + +/* Normal termination */ + +#line 2007 "" + i__1 = commvl_1.ivx % 24; +#line 2007 "" + ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2008 "" + } else { + +/* Terminate a sequence of jump-beam segments. */ + +#line 2012 "" + i__1 = 225 - *(unsigned char *)ulqq; +#line 2012 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 2012 "" + *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; +#line 2013 "" + i__1 = combjmp_1.ivbj1 % 24; +#line 2013 "" + ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2014 "" + } +#line 2015 "" + } + +/* And now the note */ + +#line 2019 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2020 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2020 "" + i__3[1] = 1, a__2[1] = all_1.sq; +#line 2020 "" + i__3[2] = 2, a__2[2] = "qb"; +#line 2020 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 2021 "" + } else { +/* Writing concatenation */ +#line 2022 "" + i__4[0] = 1, a__3[0] = all_1.sq; +#line 2022 "" + i__4[1] = 2, a__3[1] = "qb"; +#line 2022 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2023 "" + } +#line 2024 "" + *lnote += 3; +#line 2025 "" + isdotm = FALSE_; +#line 2026 "" + if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { +#line 2027 "" + i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); +#line 2027 "" + if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25]) + { +#line 2028 "" + if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { +/* Writing concatenation */ +#line 2029 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2029 "" + i__4[1] = 1, a__3[1] = "p"; +#line 2029 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2030 "" + } else { +/* Writing concatenation */ +#line 2031 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2031 "" + i__4[1] = 1, a__3[1] = "m"; +#line 2031 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2032 "" + isdotm = TRUE_; +#line 2033 "" + } +#line 2034 "" + ++(*lnote); +#line 2035 "" + } +#line 2036 "" + } + +/* 5/25/08 Allow >12 */ +/* 5/9/10 Up to 24; replace 24 with 0 */ + +#line 2041 "" + if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { +/* call istring(mod(ivx,12),tempq,len) */ +#line 2043 "" + i__1 = commvl_1.ivx % 24; +#line 2043 "" + istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2044 "" + } else { +/* call istring(mod(ivbj1,12),tempq,len) */ +#line 2046 "" + i__1 = combjmp_1.ivbj1 % 24; +#line 2046 "" + istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2047 "" + } +#line 2048 "" + if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test( + all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) { +#line 2048 "" + combjmp_1.isbjmp = FALSE_; +#line 2048 "" + } +/* Writing concatenation */ +#line 2050 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2050 "" + i__4[1] = len, a__3[1] = tempq; +#line 2050 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2051 "" + *lnote += len; +/* Writing concatenation */ +#line 2052 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2052 "" + i__4[1] = lnoten, a__3[1] = noteq; +#line 2052 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2053 "" + *lnote += lnoten; +#line 2054 "" + if (isdotm) { +#line 2055 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2056 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 2056 "" + i__2[1] = 1, a__1[1] = "{"; +#line 2056 "" + i__2[2] = 1, a__1[2] = noteq; +#line 2056 "" + i__2[3] = 1, a__1[3] = "}"; +#line 2056 "" + s_cat(notexq, a__1, i__2, &c__4, (ftnlen)79); +#line 2057 "" + *lnote += 3; +#line 2058 "" + } else { +#line 2059 "" + i__1 = lnoten - 2; +/* Writing concatenation */ +#line 2059 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2059 "" + i__4[1] = lnoten - 1 - i__1, a__3[1] = noteq + i__1; +#line 2059 "" + s_cat(notexq, a__3, i__4, &c__2, (ftnlen)79); +#line 2060 "" + ++(*lnote); +#line 2061 "" + } +#line 2062 "" + } +#line 2063 "" + return 0; +} /* beamend_ */ + +/* Subroutine */ int beamid_(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, i__5, i__6[4]; + real r__1; + char ch__1[1]; + + /* Builtin functions */ + integer pow_ii(integer *, integer *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + extern integer igetbits_(integer *, integer *, integer *); + extern logical isdotted_(integer *, integer *, integer *); + static integer im, ip, len, ivb, iud, mua, mub, iup; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nole; + static char ulqq[1]; + extern integer ncmid_(integer *, integer *); + static integer ipmid, iflop, ndsav; + static char noteq[8], tempq[4]; + extern /* Subroutine */ int notex_(char *, integer *, ftnlen); + extern integer levrn_(integer *, integer *, integer *, integer *, integer + *); + static integer nlnum, multl, multr; + extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, + char *, integer *, ftnlen, ftnlen, ftnlen); + static integer ipleft; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static real xnlmid; + static logical isdotm; + static integer lnoten, mprint, multip; + extern /* Subroutine */ int putxtn_(integer *, integer *, integer *, + integer *, real *, real *, integer *, integer *, real *, real *, + integer *, integer *, char *, integer *, integer *, real *, + integer *, integer *, logical *, ftnlen); + static integer ipright; + extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) + ; + +#line 2093 "" + *lnote = 0; +#line 2094 "" + ip = all_1.ipo[all_1.jn - 1]; +#line 2095 "" + nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; + +/* Check for special situations with 2nds (see precrd) */ + +#line 2099 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 2100 "" + --nole; +#line 2101 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 2102 "" + ++nole; +#line 2103 "" + } +#line 2104 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 2105 "" + multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8; +/* if (btest(islur(ivx,ip-1),3)) multip = multip+1 */ + +/* (Above test OK since must have ip>1). Double dotted note preceding */ + +/* Move the following, because can't ask for note until after checking for */ +/* embedded xtup with number, due to ordering/octave feature. */ + +/* call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */ +#line 2114 "" + } +#line 2115 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) { +#line 2115 "" + comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 2115 "" + } +#line 2116 "" + if (comxtup_1.vxtup[commvl_1.ivx - 1]) { + +/* In an xtup */ + +#line 2120 "" + 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 2124 "" + i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8); +#line 2124 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2125 "" + notex_(notexq, lnote, (ftnlen)79); + +/* Re-zero so next note does not get confused */ + +#line 2129 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0; +#line 2130 "" + return 0; +#line 2131 "" + } +/* if (multip.le.0) then */ +/* if (multip.le.0 .or. */ +/* * (multip.eq.1.and.btest(nacc(ivx,ip-1),18))) then */ +#line 2135 "" + if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { + +/* Xtuplet with no beam, just put in the right kind of note */ + +#line 2139 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) { + +/* Forced stem direction */ + +#line 2143 "" + ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 2144 "" + i__1 = 4 - multip; +#line 2144 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, & + i__1); +#line 2145 "" + 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 2147 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[ + commvl_1.ivx + ip * 24 - 25] * 3 / 2; +#line 2148 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - + 25],27)) { +#line 2149 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2; +#line 2150 "" + } +#line 2151 "" + notex_(notexq, lnote, (ftnlen)79); +#line 2152 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav; +#line 2153 "" + } else { + +/* Use ulq for stem direction */ + +#line 2157 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2157 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2158 "" + if (lnoten == 1) { +#line 2158 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 2158 "" + } +#line 2159 "" + *lnote = 3; +#line 2160 "" + if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25], + 27)) { + +/* Prior note is not regular-dotted */ + +#line 2164 "" + if (multip == 0) { +/* Writing concatenation */ +#line 2165 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2165 "" + i__2[1] = 1, a__1[1] = "q"; +#line 2165 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2165 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2166 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 2167 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2167 "" + i__2[1] = 1, a__1[1] = "h"; +#line 2167 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2167 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2168 "" + } else if (multip == 1) { +/* Writing concatenation */ +#line 2169 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2169 "" + i__2[1] = 1, a__1[1] = "c"; +#line 2169 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2169 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2170 "" + } else if (multip == 2) { +/* Writing concatenation */ +#line 2171 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2171 "" + i__2[1] = 2, a__1[1] = "cc"; +#line 2171 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2171 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2172 "" + *lnote = 4; +#line 2173 "" + } else if (multip == 3) { +/* Writing concatenation */ +#line 2174 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2174 "" + i__2[1] = 3, a__1[1] = "ccc"; +#line 2174 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2174 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2175 "" + *lnote = 5; +#line 2176 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 2177 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2177 "" + i__3[1] = 2, a__2[1] = "wh"; +#line 2177 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2178 "" + } +#line 2179 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) + { + +/* This note is regular dotted non-beamed xtup */ + +/* Writing concatenation */ +#line 2183 "" + i__3[0] = 3, a__2[0] = notexq; +#line 2183 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2183 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2184 "" + *lnote = 4; +#line 2185 "" + } +#line 2186 "" + } else { + +/* Prior note is regular-dotted so this one is halved */ + +#line 2190 "" + if (multip == 0) { +/* Writing concatenation */ +#line 2191 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2191 "" + i__2[1] = 1, a__1[1] = "c"; +#line 2191 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2191 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2192 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 2193 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2193 "" + i__2[1] = 1, a__1[1] = "q"; +#line 2193 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2193 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2194 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 2195 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2195 "" + i__2[1] = 1, a__1[1] = "h"; +#line 2195 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2195 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2196 "" + } +#line 2197 "" + } +/* Writing concatenation */ +#line 2198 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2198 "" + i__3[1] = 8, a__2[1] = noteq; +#line 2198 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2199 "" + *lnote += lnoten; +#line 2200 "" + } +#line 2201 "" + return 0; +#line 2202 "" + } else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { + +/* In the beamed xtup but not the last note */ + +#line 2206 "" + if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) { + +/* Embedded Xtup, mult>0, starts here. Put in number if needed */ + +#line 2210 "" + ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; +#line 2211 "" + iud = 1; +#line 2212 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 2212 "" + iud = -1; +#line 2212 "" + } + +/* Get ip#, notelevel of middle note (or gap) in xtup */ + +#line 2216 "" + ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ + commvl_1.ivx - 1] * 24 - 25] / 2; +#line 2217 "" + i__1 = ncmid_(&all_1.iv, &ipmid); +#line 2217 "" + i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; +#line 2217 "" + 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 2219 "" + if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[ + commvl_1.ivx - 1] * 24 - 25] % 2 == 0) { +#line 2219 "" + i__4 = ipmid - 1; +#line 2219 "" + i__1 = ncmid_(&all_1.iv, &i__4); +#line 2219 "" + i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - + 25]) - 8; +#line 2219 "" + 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 2219 "" + } +#line 2222 "" + iflop = 0; +#line 2223 "" + if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) < + 3.f) { +#line 2223 "" + iflop = -iud; +#line 2223 "" + } +#line 2224 "" + iup = iud + (iflop << 1); +#line 2225 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) { +#line 2226 "" + iup = -iup; +#line 2227 "" + iflop = 0; +#line 2228 "" + if (iud * iup < 0) { +#line 2228 "" + iflop = iup; +#line 2228 "" + } +#line 2229 "" + } + +/* Place number if needed */ + +#line 2233 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) { +#line 2234 "" + mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - + 25], &c__5, &c__22); +#line 2235 "" + if (mprint == 0) { +#line 2235 "" + mprint = comxtup_1.mtupv[commvl_1.ivx + + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25] + ; +#line 2235 "" + } +#line 2236 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2236 "" + 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], & + all_1.slfac, &xnlmid, &all_1.islur[commvl_1.ivx + + ip * 24 - 25], lnote, notexq, &i__1, &nlnum, & + comxtup_1.eloff[commvl_1.ivx + comxtup_1.nxtinbm[ + commvl_1.ivx - 1] * 24 - 25], &iup, &all_1.irest[ + commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen) + 79); +#line 2240 "" + } +#line 2241 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2241 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2242 "" + } else { + +/* Intermediate note of xtup */ + +#line 2246 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2246 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2247 "" + } +#line 2248 "" + } else { + +/* Last note of xtup (but not last note of beam!) */ + +#line 2252 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2252 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2253 "" + } +#line 2254 "" + } else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 2255 "" + notex_(notexq, lnote, (ftnlen)79); +#line 2256 "" + return 0; +#line 2257 "" + } else { +#line 2258 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 2258 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2259 "" + } + +/* Check if multiplicity changes in a way requiring action */ + +#line 2263 "" + ipleft = ip - 1; +#line 2264 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) { +#line 2264 "" + --ipleft; +#line 2264 "" + } +#line 2265 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) { +#line 2266 "" + multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8; +#line 2267 "" + } else { +#line 2268 "" + multl = 1; +#line 2269 "" + } +#line 2270 "" + mub = multip - multl; +#line 2271 "" + ipright = ip + 1; +#line 2272 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) { +#line 2272 "" + ++ipright; +#line 2272 "" + } +#line 2273 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) { +#line 2274 "" + multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8; +#line 2275 "" + } else { +#line 2276 "" + multr = 1; +#line 2277 "" + } +#line 2278 "" + mua = multr - multip; +#line 2279 "" + if (mub > 0 || mua < 0) { + +/* Multiplicity has increased from left or will decrease to right. Need action. */ + +#line 2283 "" + if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) { +#line 2284 "" + ivb = combjmp_1.ivbj1; +#line 2285 "" + i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2285 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 2285 "" + *(unsigned char *)ulqq = *(unsigned char *)&ch__1[0]; +#line 2286 "" + } else { +#line 2287 "" + ivb = commvl_1.ivx; +#line 2288 "" + *(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[ + commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]; +#line 2289 "" + } +#line 2290 "" + if (mua >= 0) { +#line 2291 "" + ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2292 "" + } else if (multl >= multr) { +#line 2293 "" + i__1 = multr + 1; +#line 2293 "" + for (im = multip; im >= i__1; --im) { +#line 2294 "" + ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2295 "" +/* L1: */ +#line 2295 "" + } +#line 2296 "" + } else { +#line 2297 "" + i__1 = multip; +#line 2297 "" + for (im = multr + 1; im <= i__1; ++im) { +#line 2298 "" + ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2299 "" +/* L2: */ +#line 2299 "" + } +#line 2300 "" + ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, ( + ftnlen)1, (ftnlen)79); +#line 2301 "" + } +#line 2302 "" + } else if (ip > 1) { + +/* Check for 2nd member of dotted xtup */ + +#line 2306 "" + if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) { +#line 2306 "" + i__1 = multip + 1; +#line 2306 "" + 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 2306 "" + } +#line 2308 "" + } + +/* Now put in the note */ + +#line 2312 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2313 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 2313 "" + i__2[1] = 1, a__1[1] = all_1.sq; +#line 2313 "" + i__2[2] = 2, a__1[2] = "qb"; +#line 2313 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2314 "" + } else { +/* Writing concatenation */ +#line 2315 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2315 "" + i__3[1] = 2, a__2[1] = "qb"; +#line 2315 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2316 "" + } +#line 2317 "" + *lnote += 3; +#line 2318 "" + isdotm = FALSE_; +#line 2319 "" + if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { + +/* rule out ')' */ + +#line 2323 "" + if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { +#line 2324 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { +/* Writing concatenation */ +#line 2325 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2325 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2325 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2326 "" + } else { + +/* Double dot */ + +/* Writing concatenation */ +#line 2330 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2330 "" + i__3[1] = 2, a__2[1] = "pp"; +#line 2330 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2331 "" + ++(*lnote); +#line 2332 "" + } +#line 2333 "" + } else { +/* Writing concatenation */ +#line 2334 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2334 "" + i__3[1] = 1, a__2[1] = "m"; +#line 2334 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2335 "" + isdotm = TRUE_; +#line 2336 "" + } +#line 2337 "" + ++(*lnote); +#line 2338 "" + } 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 2343 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2343 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2343 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2344 "" + ++(*lnote); +#line 2345 "" + } + +/* 5/25/08 Allow >12 */ + +#line 2349 "" + if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) { +/* call istring(mod(ivx,12),tempq,len) */ +#line 2351 "" + i__1 = commvl_1.ivx % 24; +#line 2351 "" + istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2352 "" + } else { +/* call istring(mod(ivbj1,12),tempq,len) */ +#line 2354 "" + i__1 = combjmp_1.ivbj1 % 24; +#line 2354 "" + istring_(&i__1, tempq, &len, (ftnlen)4); +#line 2355 "" + } +/* Writing concatenation */ +#line 2356 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2356 "" + i__3[1] = len, a__2[1] = tempq; +#line 2356 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2357 "" + *lnote += len; +/* Writing concatenation */ +#line 2358 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2358 "" + i__3[1] = lnoten, a__2[1] = noteq; +#line 2358 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2359 "" + *lnote += lnoten; +#line 2360 "" + if (isdotm) { +#line 2361 "" + if (lnoten == 2) { +/* Writing concatenation */ +#line 2362 "" + i__6[0] = *lnote, a__3[0] = notexq; +#line 2362 "" + i__6[1] = 1, a__3[1] = "{"; +#line 2362 "" + i__6[2] = 1, a__3[2] = noteq + 1; +#line 2362 "" + i__6[3] = 1, a__3[3] = "}"; +#line 2362 "" + s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79); +#line 2363 "" + *lnote += 3; +#line 2364 "" + } else { +#line 2365 "" + i__1 = lnoten - 2; +/* Writing concatenation */ +#line 2365 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2365 "" + i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; +#line 2365 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2366 "" + ++(*lnote); +#line 2367 "" + } +#line 2368 "" + } +#line 2369 "" + 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]; + + /* 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); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static integer nd, im, ip1, len; + extern integer log2_(integer *); + static integer nole; + extern /* Subroutine */ int stop1_(void); + extern integer ncmid_(integer *, integer *); + static integer ndsav; + static char noteq[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; + 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 }; + + +#line 2395 "" + ip1 = all_1.ipo[all_1.jn - 1]; +#line 2396 "" + multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8; +/* if (multip.le.0 .and. btest(irest(ivx,ip1),0)) then */ +#line 2398 "" + if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[ + commvl_1.ivx + ip1 * 24 - 25],0)) { +#line 2399 "" + *lnote = 0; + +/* The rest was already written in beamstrt, so just get out of here */ + +#line 2403 "" + return 0; +#line 2404 "" + } +#line 2405 "" + 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 2409 "" + if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25], + 30)) { +#line 2410 "" + --nole; +#line 2411 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * + 24 - 25],31)) { +#line 2412 "" + ++nole; +#line 2413 "" + } +#line 2414 "" + 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 2418 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) { + +/* Forced stem direction */ + +#line 2422 "" + ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25]; +#line 2423 "" + i__1 = 4 - multip; +#line 2423 "" + all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2424 "" + 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 2424 "" + all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[ + commvl_1.ivx + ip1 * 24 - 25] * 3 / 2; +#line 2424 "" + } +#line 2426 "" + notex_(notexq, lnote, (ftnlen)79); +#line 2427 "" + all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav; +#line 2428 "" + } else { +#line 2429 "" + i__1 = ncmid_(&all_1.iv, &ip1); +#line 2429 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 2430 "" + if (lnoten == 1) { +#line 2430 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 2430 "" + } +#line 2431 "" + *lnote = 3; +#line 2432 "" + if (multip == 0) { +/* Writing concatenation */ +#line 2433 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2433 "" + i__2[1] = 1, a__1[1] = "q"; +#line 2433 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2433 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2434 "" + } else if (multip == -1) { +/* Writing concatenation */ +#line 2435 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2435 "" + i__2[1] = 1, a__1[1] = "h"; +#line 2435 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2435 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2436 "" + } else if (multip == 1) { +/* Writing concatenation */ +#line 2437 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2437 "" + i__2[1] = 1, a__1[1] = "c"; +#line 2437 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2437 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2438 "" + } else if (multip == 2) { +/* Writing concatenation */ +#line 2439 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2439 "" + i__2[1] = 2, a__1[1] = "cc"; +#line 2439 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2439 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2440 "" + *lnote = 4; +#line 2441 "" + } else if (multip == 3) { +/* Writing concatenation */ +#line 2442 "" + i__2[0] = 1, a__1[0] = all_1.sq; +#line 2442 "" + i__2[1] = 3, a__1[1] = "ccc"; +#line 2442 "" + i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25); +#line 2442 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2443 "" + *lnote = 5; +#line 2444 "" + } else if (multip == -2) { +/* Writing concatenation */ +#line 2445 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2445 "" + i__3[1] = 2, a__2[1] = "wh"; +#line 2445 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2446 "" + } else if (multip == -3) { +/* Writing concatenation */ +#line 2447 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2447 "" + i__3[1] = 5, a__2[1] = "breve"; +#line 2447 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2448 "" + *lnote = 6; +#line 2449 "" + } else { +#line 2450 "" + s_wsle(&io___182); +#line 2450 "" + e_wsle(); +#line 2451 "" + s_wsle(&io___183); +#line 2451 "" + do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"\ + "on)", (ftnlen)41); +#line 2451 "" + e_wsle(); +#line 2452 "" + stop1_(); +#line 2453 "" + } +#line 2454 "" + 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)) { +/* Writing concatenation */ +#line 2455 "" + i__3[0] = 3, a__2[0] = notexq; +#line 2455 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2455 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2456 "" + *lnote = 4; +#line 2457 "" + } +/* Writing concatenation */ +#line 2458 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2458 "" + i__3[1] = 8, a__2[1] = noteq; +#line 2458 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2459 "" + *lnote += lnoten; +#line 2460 "" + } +#line 2461 "" + return 0; +#line 2462 "" + } + +/* Check if mult. decreases from 1st note to 2nd */ + +#line 2466 "" + 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 2471 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) { +#line 2472 "" + multr = 1; +#line 2473 "" + } else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25], + 0)) { +#line 2474 "" + multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8; +#line 2475 "" + } else { +#line 2476 "" + multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8; +#line 2477 "" + } +#line 2478 "" + *lnote = 0; +#line 2479 "" + if (multr < multip) { +#line 2480 "" + i__1 = multr + 1; +#line 2480 "" + for (im = multip; im >= i__1; --im) { +#line 2481 "" + 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 2482 "" +/* L1: */ +#line 2482 "" + } +#line 2483 "" + } +#line 2484 "" + } + +/* Put in the note */ + +#line 2488 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2489 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 2489 "" + i__2[1] = 1, a__1[1] = all_1.sq; +#line 2489 "" + i__2[2] = 2, a__1[2] = "qb"; +#line 2489 "" + s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79); +#line 2490 "" + } else { +/* Writing concatenation */ +#line 2491 "" + i__3[0] = 1, a__2[0] = all_1.sq; +#line 2491 "" + i__3[1] = 2, a__2[1] = "qb"; +#line 2491 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2492 "" + } +#line 2493 "" + *lnote += 3; + +/* Check for dot */ + +#line 2497 "" + isdotm = FALSE_; +#line 2498 "" + if (! comxtup_1.vxtup[commvl_1.ivx - 1]) { +#line 2499 "" + nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25]; +#line 2500 "" + if (nd != 0) { +#line 2501 "" + i__1 = log2_(&nd); +#line 2501 "" + if (pow_ii(&c__2, &i__1) != nd) { +#line 2502 "" + if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) { +#line 2503 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25], + 3)) { +/* Writing concatenation */ +#line 2504 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2504 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2504 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2505 "" + } else { + +/* Double dot */ + +/* Writing concatenation */ +#line 2509 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2509 "" + i__3[1] = 2, a__2[1] = "pp"; +#line 2509 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2510 "" + ++(*lnote); +#line 2511 "" + } +#line 2512 "" + } else { +/* Writing concatenation */ +#line 2513 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2513 "" + i__3[1] = 1, a__2[1] = "m"; +#line 2513 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2514 "" + isdotm = TRUE_; +#line 2515 "" + } +#line 2516 "" + ++(*lnote); +#line 2517 "" + } +#line 2518 "" + } +#line 2519 "" + } 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 2524 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2524 "" + i__3[1] = 1, a__2[1] = "p"; +#line 2524 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2525 "" + ++(*lnote); +#line 2526 "" + } + +/* Do the number; 0 if 12 */ + +/* 5/25/08 allow >12 */ + +#line 2532 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) { +/* call istring(mod(ivx,12),noteq,len) */ +#line 2534 "" + i__1 = commvl_1.ivx % 24; +#line 2534 "" + istring_(&i__1, noteq, &len, (ftnlen)8); +#line 2535 "" + } else { +/* call istring(mod(ivbj1,12),noteq,len) */ +#line 2537 "" + i__1 = combjmp_1.ivbj1 % 24; +#line 2537 "" + istring_(&i__1, noteq, &len, (ftnlen)8); +#line 2538 "" + } +/* Writing concatenation */ +#line 2539 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2539 "" + i__3[1] = len, a__2[1] = noteq; +#line 2539 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2540 "" + *lnote += len; +#line 2541 "" + i__1 = ncmid_(&all_1.iv, &ip1); +#line 2541 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +/* Writing concatenation */ +#line 2542 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2542 "" + i__3[1] = lnoten, a__2[1] = noteq; +#line 2542 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2543 "" + *lnote += lnoten; +#line 2544 "" + if (isdotm) { +#line 2545 "" + if (lnoten == 1) { +/* Writing concatenation */ +#line 2546 "" + i__4[0] = *lnote, a__3[0] = notexq; +#line 2546 "" + i__4[1] = 1, a__3[1] = "{"; +#line 2546 "" + i__4[2] = 1, a__3[2] = noteq; +#line 2546 "" + i__4[3] = 1, a__3[3] = "}"; +#line 2546 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 2547 "" + *lnote += 3; +#line 2548 "" + } else { +#line 2549 "" + i__1 = lnoten - 2; +/* Writing concatenation */ +#line 2549 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 2549 "" + i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1; +#line 2549 "" + s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79); +#line 2550 "" + ++(*lnote); +#line 2551 "" + } +#line 2552 "" + } +#line 2553 "" + return 0; +} /* beamn1_ */ + +/* Subroutine */ int beamstrt_(char *notexq, integer *lnote, integer *nornb, + integer *ihornb, real *space, real *squez, integer *ib, ftnlen + 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]; + 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); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer pow_ii(integer *, integer *), i_sign(integer *, integer *), + lbit_shift(integer, integer); + + /* Local variables */ + static logical addbrack; + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + extern integer igetbits_(integer *, integer *, integer *); + static logical usexnumt; + static integer nomornlev, ip, levbracket, ibc, inb, iud, imp, ivf, ipp, + iup; + static logical xto; + static integer ipb1, iadj, icrd; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern doublereal feon_(real *); + static integer levc, nole, iorn; + static real ymin, ybot; + static integer levx; + static real xnsk; + extern integer ncmid_(integer *, integer *); + static real ybeam; + static integer ipmid, iflop; + static real bmlev; + static integer icrdx, multb, ltemp; + static char noteq[8], tempq[79]; + extern integer levrn_(integer *, integer *, integer *, integer *, integer + *); + static char restq[40]; + static integer nlnum, lrest; + extern /* Subroutine */ int notex_(char *, integer *, ftnlen); + static integer isssb; + static real zmult; + extern /* Subroutine */ int ntrbbb_(integer *, char *, char *, integer *, + char *, integer *, ftnlen, ftnlen, ftnlen); + 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 *); + static integer mprint; + static real xslope; + extern /* Subroutine */ int putxtn_(integer *, integer *, integer *, + integer *, real *, real *, integer *, integer *, real *, real *, + integer *, integer *, char *, integer *, integer *, real *, + integer *, integer *, logical *, ftnlen); + static integer maxdrop; + + /* Fortran I/O blocks */ + static icilist io___212 = { 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 2604 "" + /* Parameter adjustments */ +#line 2604 "" + --squez; +#line 2604 "" + --space; +#line 2604 "" + ihornb -= 25; +#line 2604 "" + --nornb; +#line 2604 "" + +#line 2604 "" + /* Function Body */ +#line 2604 "" + ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 2605 "" + ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; +#line 2606 "" + multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8; +#line 2607 "" + ip = all_1.ipo[all_1.jn - 1]; + +/* 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. */ + +#line 2612 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[ + commvl_1.ivx + ip * 24 - 25],21)) { +#line 2612 "" + 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 2612 "" + } +#line 2614 "" + 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 2619 "" + ++comxtup_1.issb[commvl_1.ivx - 1]; +#line 2620 "" + comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx + + comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25]; +#line 2621 "" + } +#line 2622 "" + *lnote = 0; +#line 2623 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 2624 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) && + strtmid_1.ixrest[commvl_1.ivx - 1] != 2) { +#line 2625 "" + comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 2626 "" + ++comxtup_1.nxtinbm[commvl_1.ivx - 1]; + +/* irest(28)=>Xtup starts on this note. Set up for xtuplet. */ +/* Number goes on notehead side at middle note (or gap) of xtup, unless that */ +/* puts it in staff, then it flops to stem (or beam) side. */ +/* __ __ */ +/* | | | O | | */ +/* O | | O */ +/* |___| O |__| | */ + +/* iud -1 -1 1 1 ...stem direction */ +/* iflop 0 1 -1 0 ...direction of flop */ +/* iup -1 1 -1 1 ...direction of number and bracket */ + +#line 2640 "" + iud = 1; +#line 2641 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') + { +#line 2641 "" + iud = -1; +#line 2641 "" + } + +/* Get ip#, note level of middle note (or gap) in xtup */ + +#line 2645 "" + 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 2650 "" +L14: +#line 2651 "" + if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) { +#line 2652 "" + ++ipmid; +#line 2653 "" + goto L14; +#line 2654 "" + } +#line 2655 "" + i__1 = ncmid_(&all_1.iv, &ipmid); +#line 2655 "" + i__2 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8; +#line 2655 "" + 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); +#line 2657 "" + if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1] + * 24 - 25] % 2 == 0) { +#line 2657 "" + i__2 = ipmid - 1; +#line 2657 "" + i__1 = ncmid_(&all_1.iv, &i__2); +#line 2657 "" + i__3 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) - + 8; +#line 2657 "" + 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; +#line 2657 "" + } +#line 2660 "" + iflop = 0; +#line 2661 "" + if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) { +#line 2661 "" + iflop = -iud; +#line 2661 "" + } +#line 2662 "" + iup = iud + (iflop << 1); +#line 2663 "" + 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 2667 "" + iup = -iup; +#line 2668 "" + iflop = 0; +#line 2669 "" + if (iud * iup < 0) { +#line 2669 "" + iflop = iup; +#line 2669 "" + } +#line 2670 "" + } + +/* Determine if a beam is to be drawn */ + +#line 2674 "" + i__1 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; +#line 2674 "" + for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__1; + ++ipp) { +#line 2675 "" + if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) { +#line 2676 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_; +#line 2677 "" + goto L6; +#line 2678 "" + } +#line 2679 "" +/* L5: */ +#line 2679 "" + } +#line 2680 "" + 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 2681 "" +L6: + +/* Are we using tuplet.tex? */ + +#line 2685 "" + usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1]; + +/* Place xtup number if needed */ + +#line 2689 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) || + multb <= 0) { +#line 2690 "" + mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], & + c__5, &c__22); +#line 2691 "" + if (mprint == 0) { +#line 2691 "" + mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[ + commvl_1.ivx - 1] * 24 - 25]; +#line 2691 "" + } +#line 2692 "" + i__1 = ncmid_(&all_1.iv, &ipb1); +#line 2692 "" + 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 + + comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25], &iup, & + all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &usexnumt, ( + ftnlen)79); +#line 2696 "" + } +#line 2697 "" + if (! comdraw_1.drawbm[commvl_1.ivx - 1]) { + +/* Xtuplet with no beam */ + +#line 2701 "" + 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 2707 "" + r__1 = space[*ib] / squez[*ib]; +#line 2707 "" + 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 2709 "" + if (iup == 1) { +#line 2710 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2711 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2711 "" + i__4[1] = 1, a__1[1] = all_1.sq; +#line 2711 "" + i__4[2] = 5, a__1[2] = "ovbkt"; +#line 2711 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2712 "" + } else { +/* Writing concatenation */ +#line 2713 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2713 "" + i__5[1] = 5, a__2[1] = "ovbkt"; +#line 2713 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2714 "" + } +#line 2715 "" + } else { +#line 2716 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2717 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2717 "" + i__4[1] = 1, a__1[1] = all_1.sq; +#line 2717 "" + i__4[2] = 5, a__1[2] = "unbkt"; +#line 2717 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2718 "" + } else { + +/* Introduced 12/5/98, req'd due to possible presence of in-line TeX */ + +/* Writing concatenation */ +#line 2722 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2722 "" + i__5[1] = 5, a__2[1] = "unbkt"; +#line 2722 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2723 "" + } +#line 2724 "" + } +#line 2725 "" + *lnote += 6; +#line 2726 "" + if (all_1.iline == 1) { +#line 2727 "" + comipb_1.smed /= 1.f - comtop_1.fracindent; +#line 2728 "" + } +#line 2729 "" + xslope = comipb_1.smed * 1.8f * all_1.slfac; +#line 2730 "" + comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope); +#line 2731 "" + r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1]; +#line 2731 "" + comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1); +#line 2732 "" + if (comxtup_1.islope[commvl_1.ivx - 1] == 0) { +#line 2732 "" + --comxtup_1.nolev1[commvl_1.ivx - 1]; +#line 2732 "" + } +#line 2733 "" + if (iup == 1) { +#line 2733 "" + comxtup_1.nolev1[commvl_1.ivx - 1] += 4; +#line 2733 "" + } +#line 2734 "" + levbracket = comxtup_1.nolev1[commvl_1.ivx - 1]; +#line 2735 "" + if (iup == 1 && comnvst_1.cstuplet) { +#line 2735 "" + --levbracket; +#line 2735 "" + } +#line 2736 "" + i__1 = ncmid_(&all_1.iv, &ipb1); +#line 2736 "" + notefq_(noteq, &lnoten, &levbracket, &i__1, (ftnlen)8); +#line 2737 "" + if (lnoten == 1) { +#line 2737 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 2737 "" + } +/* Writing concatenation */ +#line 2738 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2738 "" + i__4[1] = lnoten, a__1[1] = noteq; +#line 2738 "" + i__4[2] = 1, a__1[2] = "{"; +#line 2738 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2739 "" + *lnote = *lnote + lnoten + 1; +#line 2740 "" + if (xnsk < .995f) { +#line 2741 "" + i__1 = *lnote; +#line 2741 "" + ici__1.icierr = 0; +#line 2741 "" + ici__1.icirnum = 1; +#line 2741 "" + ici__1.icirlen = *lnote + 4 - i__1; +#line 2741 "" + ici__1.iciunit = notexq + i__1; +#line 2741 "" + ici__1.icifmt = "(i1,f3.2)"; +#line 2741 "" + s_wsfi(&ici__1); +#line 2741 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 2741 "" + do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 2741 "" + e_wsfi(); +#line 2742 "" + *lnote += 4; +#line 2743 "" + } else if (xnsk < 9.995f) { +#line 2744 "" + i__1 = *lnote; +#line 2744 "" + ici__1.icierr = 0; +#line 2744 "" + ici__1.icirnum = 1; +#line 2744 "" + ici__1.icirlen = *lnote + 4 - i__1; +#line 2744 "" + ici__1.iciunit = notexq + i__1; +#line 2744 "" + ici__1.icifmt = "(f4.2)"; +#line 2744 "" + s_wsfi(&ici__1); +#line 2744 "" + do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 2744 "" + e_wsfi(); +#line 2745 "" + *lnote += 4; +#line 2746 "" + } else { +#line 2747 "" + i__1 = *lnote; +#line 2747 "" + ici__1.icierr = 0; +#line 2747 "" + ici__1.icirnum = 1; +#line 2747 "" + ici__1.icirlen = *lnote + 5 - i__1; +#line 2747 "" + ici__1.iciunit = notexq + i__1; +#line 2747 "" + ici__1.icifmt = "(f5.2)"; +#line 2747 "" + s_wsfi(&ici__1); +#line 2747 "" + do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real)); +#line 2747 "" + e_wsfi(); +#line 2748 "" + *lnote += 5; +#line 2749 "" + } +/* Writing concatenation */ +#line 2750 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2750 "" + i__5[1] = 1, a__2[1] = "}"; +#line 2750 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2751 "" + ++(*lnote); +#line 2752 "" + if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) { + +/* Tweak slope of bracket */ + +#line 2756 "" + 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 2757 "" + } +#line 2758 "" + if (comxtup_1.islope[commvl_1.ivx - 1] < 0 || + comxtup_1.islope[commvl_1.ivx - 1] >= 10) { +/* Writing concatenation */ +#line 2759 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2759 "" + i__5[1] = 1, a__2[1] = "{"; +#line 2759 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2760 "" + ++(*lnote); +#line 2761 "" + if (comxtup_1.islope[commvl_1.ivx - 1] < -9) { +#line 2762 "" + i__1 = *lnote; +#line 2762 "" + ici__1.icierr = 0; +#line 2762 "" + ici__1.icirnum = 1; +#line 2762 "" + ici__1.icirlen = *lnote + 3 - i__1; +#line 2762 "" + ici__1.iciunit = notexq + i__1; +#line 2762 "" + ici__1.icifmt = "(i3)"; +#line 2762 "" + s_wsfi(&ici__1); +#line 2762 "" + do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx + - 1], (ftnlen)sizeof(integer)); +#line 2762 "" + e_wsfi(); +#line 2763 "" + *lnote += 3; +#line 2764 "" + } else { +#line 2765 "" + i__1 = *lnote; +#line 2765 "" + ici__1.icierr = 0; +#line 2765 "" + ici__1.icirnum = 1; +#line 2765 "" + ici__1.icirlen = *lnote + 2 - i__1; +#line 2765 "" + ici__1.iciunit = notexq + i__1; +#line 2765 "" + ici__1.icifmt = "(i2)"; +#line 2765 "" + s_wsfi(&ici__1); +#line 2765 "" + do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx + - 1], (ftnlen)sizeof(integer)); +#line 2765 "" + e_wsfi(); +#line 2766 "" + *lnote += 2; +#line 2767 "" + } +/* Writing concatenation */ +#line 2768 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2768 "" + i__5[1] = 1, a__2[1] = "}"; +#line 2768 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2769 "" + ++(*lnote); +#line 2770 "" + } else { +#line 2771 "" + i__1 = *lnote; +#line 2771 "" + ici__1.icierr = 0; +#line 2771 "" + ici__1.icirnum = 1; +#line 2771 "" + ici__1.icirlen = *lnote + 1 - i__1; +#line 2771 "" + ici__1.iciunit = notexq + i__1; +#line 2771 "" + ici__1.icifmt = "(i1)"; +#line 2771 "" + s_wsfi(&ici__1); +#line 2771 "" + do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], + (ftnlen)sizeof(integer)); +#line 2771 "" + e_wsfi(); +#line 2772 "" + ++(*lnote); +#line 2773 "" + } + +/* Done with bracket */ + +#line 2777 "" + } +#line 2778 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { + +/* Put in the rest. Possible problem: Rest is a spacing char, but between */ +/* beamstrt and beamn1 some non-spacing chars. are inserted. */ + +/* 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 2802 "" + lrest = 3; +#line 2803 "" + if (multb == 0) { +/* Writing concatenation */ +#line 2804 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2804 "" + i__5[1] = 2, a__2[1] = "qp"; +#line 2804 "" + s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 2805 "" + } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1) + { +/* Writing concatenation */ +#line 2806 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2806 "" + i__5[1] = 2, a__2[1] = "ds"; +#line 2806 "" + s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 2807 "" + } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2) + { +/* Writing concatenation */ +#line 2808 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2808 "" + i__5[1] = 2, a__2[1] = "qs"; +#line 2808 "" + s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 2809 "" + } else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3) + { +/* Writing concatenation */ +#line 2810 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2810 "" + i__5[1] = 2, a__2[1] = "hs"; +#line 2810 "" + s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 2811 "" + } else { +/* Writing concatenation */ +#line 2812 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2812 "" + i__5[1] = 6, a__2[1] = "hpause"; +#line 2812 "" + s_cat(restq, a__2, i__5, &c__2, (ftnlen)40); +#line 2813 "" + lrest = 7; +#line 2814 "" + } +#line 2815 "" + nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100 + - 20; +#line 2816 "" + if (nole == 0) { + +/* Rest is not raised */ + +/* Writing concatenation */ +#line 2820 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2820 "" + i__5[1] = 40, a__2[1] = restq; +#line 2820 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2821 "" + *lnote += lrest; +#line 2822 "" + } else { +#line 2823 "" + if (abs(nole) < 10) { +#line 2824 "" + i__1 = abs(nole) + 48; +#line 2824 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 2824 "" + s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1); +#line 2825 "" + ltemp = 1; +#line 2826 "" + } else { +#line 2827 "" + s_wsfi(&io___212); +#line 2827 "" + i__1 = abs(nole); +#line 2827 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 2827 "" + e_wsfi(); +#line 2828 "" + ltemp = 2; +#line 2829 "" + } +#line 2830 "" + if (nole > 0) { +/* Writing concatenation */ +#line 2831 "" + i__6[0] = 1, a__3[0] = all_1.sq; +#line 2831 "" + i__6[1] = 5, a__3[1] = "raise"; +#line 2831 "" + i__6[2] = ltemp, a__3[2] = tempq; +#line 2831 "" + i__6[3] = 1, a__3[3] = all_1.sq; +#line 2831 "" + i__6[4] = 9, a__3[4] = "internote"; +#line 2831 "" + s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79); +#line 2832 "" + } else { +/* Writing concatenation */ +#line 2833 "" + i__6[0] = 1, a__3[0] = all_1.sq; +#line 2833 "" + i__6[1] = 5, a__3[1] = "lower"; +#line 2833 "" + i__6[2] = ltemp, a__3[2] = tempq; +#line 2833 "" + i__6[3] = 1, a__3[3] = all_1.sq; +#line 2833 "" + i__6[4] = 9, a__3[4] = "internote"; +#line 2833 "" + s_cat(tempq, a__3, i__6, &c__5, (ftnlen)79); +#line 2834 "" + } +#line 2835 "" + ltemp += 16; +/* Writing concatenation */ +#line 2836 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2836 "" + i__4[1] = ltemp, a__1[1] = tempq; +#line 2836 "" + i__4[2] = lrest, a__1[2] = restq; +#line 2836 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2837 "" + *lnote = *lnote + ltemp + lrest; +#line 2838 "" + } + +/* 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 2843 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 2844 "" + } +#line 2845 "" + return 0; +#line 2846 "" + } + +/* End if block for non-beamed xtup start...note we returned */ + +#line 2850 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) { + +/* Insert rest at start of beamed xtup. See above note for possible problem. */ + +#line 2854 "" + i__1 = 4 - multb; +#line 2854 "" + all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, &i__1); +#line 2855 "" + notex_(tempq, <emp, (ftnlen)79); +#line 2856 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 2857 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2857 "" + i__5[1] = ltemp, a__2[1] = tempq; +#line 2857 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2858 "" + } else { +#line 2859 "" + s_copy(notexq, tempq, (ftnlen)79, ltemp); +#line 2860 "" + } +#line 2861 "" + *lnote += ltemp; + +/* Re-zero just in case! */ + +#line 2865 "" + all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0; +#line 2866 "" + ++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; + +/* See if next note is a non-rest */ + +#line 2870 "" + if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0) + ) { +#line 2871 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 2; +#line 2872 "" + } else { + +/* Suppress reprinting xtup number next time through beamstrt */ + +#line 2876 "" + 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 2880 "" + all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set( + all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28); +#line 2881 "" + } +#line 2882 "" + return 0; +#line 2883 "" + } +#line 2884 "" + } + +/* Just ended if block for xtups */ + +#line 2888 "" + 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 2892 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 4; +#line 2893 "" + return 0; +#line 2894 "" + } +#line 2895 "" + 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 2899 "" + iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & + c__11) - 30; +#line 2900 "" + if (iadj != -30) { +#line 2901 "" + comxtup_1.nolev1[commvl_1.ivx - 1] += iadj; +#line 2902 "" + i__1 = comxtup_1.nssb[commvl_1.ivx - 1]; +#line 2902 "" + for (isssb = 1; isssb <= i__1; ++isssb) { +#line 2903 "" + comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj; +#line 2904 "" +/* L2: */ +#line 2904 "" + } +#line 2905 "" + } +#line 2906 "" + iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, & + c__17) - 30; +#line 2907 "" + if (iadj != -30) { +#line 2908 "" + comxtup_1.islope[commvl_1.ivx - 1] += iadj; +#line 2909 "" + if ((i__1 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__1)) > 9) { +#line 2909 "" + comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, & + comxtup_1.islope[commvl_1.ivx - 1]); +#line 2909 "" + } +#line 2910 "" + if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) { + +/* Cycle thru non-rest notes in SSBG, looking for bmstrts. */ + +#line 2914 "" + isssb = 0; +#line 2915 "" + i__1 = comipb_1.nnb; +#line 2915 "" + for (inb = 2; inb <= i__1; ++inb) { +#line 2916 "" + if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb - + 1] * 24 - 25],21)) { + +/* Beam segment start. New start level */ +#line 2919 "" + ++isssb; +#line 2920 "" + 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 2922 "" + } +#line 2923 "" +/* L4: */ +#line 2923 "" + } +#line 2924 "" + } +#line 2925 "" + } +#line 2926 "" + } +#line 2927 "" + iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, & + c__27); +#line 2928 "" + addbrack = FALSE_; +#line 2929 "" + 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 2934 "" + 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 2936 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2937 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2937 "" + i__5[1] = 5, a__2[1] = "loff{"; +#line 2937 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2938 "" + } else { +/* Writing concatenation */ +#line 2939 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2939 "" + i__4[1] = 1, a__1[1] = all_1.sq; +#line 2939 "" + i__4[2] = 5, a__1[2] = "loff{"; +#line 2939 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2940 "" + } +#line 2941 "" + *lnote += 6; +#line 2942 "" + addbrack = TRUE_; +#line 2943 "" + } 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 2945 "" + if (*lnote == 0) { +/* Writing concatenation */ +#line 2946 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 2946 "" + i__5[1] = 5, a__2[1] = "roff{"; +#line 2946 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2947 "" + } else { +/* Writing concatenation */ +#line 2948 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2948 "" + i__4[1] = 1, a__1[1] = all_1.sq; +#line 2948 "" + i__4[2] = 5, a__1[2] = "roff{"; +#line 2948 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2949 "" + } +#line 2950 "" + *lnote += 6; +#line 2951 "" + addbrack = TRUE_; +#line 2952 "" + } + +/* Check end level for possible flipping in forced beam. Have to do it */ +/* here since with multiple voices, xelsk will not be preserved. */ + +#line 2957 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] == 'u') { +#line 2958 "" + 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 2959 "" + 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 2960 "" + } else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] == 'l') { +#line 2961 "" + 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 2962 "" + 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 2963 "" + } +#line 2964 "" + } +#line 2965 "" + i__1 = multb + iadj; +#line 2965 "" + ntrbbb_(&i__1, "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 2970 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { +#line 2970 "" + r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] * + comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac; +#line 2970 "" + comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 2970 "" + } +#line 2972 "" + i__1 = ncmid_(&all_1.iv, &ipb1); +#line 2972 "" + notefq_(noteq, &lnoten, &comxtup_1.nolev1[commvl_1.ivx - 1], &i__1, ( + ftnlen)8); +#line 2973 "" + if (comxtup_1.islope[commvl_1.ivx - 1] < 0) { +/* Writing concatenation */ +#line 2974 "" + i__4[0] = *lnote, a__1[0] = notexq; +#line 2974 "" + i__4[1] = lnoten, a__1[1] = noteq; +#line 2974 "" + i__4[2] = 1, a__1[2] = "{"; +#line 2974 "" + s_cat(notexq, a__1, i__4, &c__3, (ftnlen)79); +#line 2975 "" + *lnote = *lnote + 4 + lnoten; +#line 2976 "" + i__1 = *lnote - 3; +#line 2976 "" + ici__1.icierr = 0; +#line 2976 "" + ici__1.icirnum = 1; +#line 2976 "" + ici__1.icirlen = *lnote - i__1; +#line 2976 "" + ici__1.iciunit = notexq + i__1; +#line 2976 "" + ici__1.icifmt = "(i2,a1)"; +#line 2976 "" + s_wsfi(&ici__1); +#line 2976 "" + do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) + sizeof(integer)); +#line 2976 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 2976 "" + e_wsfi(); +#line 2977 "" + } else { +/* Writing concatenation */ +#line 2978 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2978 "" + i__5[1] = lnoten, a__2[1] = noteq; +#line 2978 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2979 "" + *lnote = *lnote + 1 + lnoten; +#line 2980 "" + ici__1.icierr = 0; +#line 2980 "" + ici__1.icirnum = 1; +#line 2980 "" + ici__1.icirlen = 1; +#line 2980 "" + ici__1.iciunit = notexq + (*lnote - 1); +#line 2980 "" + ici__1.icifmt = "(i1)"; +#line 2980 "" + s_wsfi(&ici__1); +#line 2980 "" + do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen) + sizeof(integer)); +#line 2980 "" + e_wsfi(); +#line 2981 "" + } + +/* Check for beam-thk fine-tuning */ + +#line 2985 "" + if (iadj > 0) { +#line 2986 "" + i__1 = multb + 1; +#line 2986 "" + for (imp = multb + iadj; imp >= i__1; --imp) { +#line 2987 "" + ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), & + commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, ( + ftnlen)79); +#line 2988 "" +/* L1: */ +#line 2988 "" + } +#line 2989 "" + } + +/* If we shifted, must close with right bracket */ + +#line 2993 "" + if (addbrack) { +/* Writing concatenation */ +#line 2994 "" + i__5[0] = *lnote, a__2[0] = notexq; +#line 2994 "" + i__5[1] = 1, a__2[1] = "}"; +#line 2994 "" + s_cat(notexq, a__2, i__5, &c__2, (ftnlen)79); +#line 2995 "" + ++(*lnote); +#line 2996 "" + } + +/* Get 'floor' zmin for figures */ +/* Note: Will not come thru here on 1st note of unbeamed xtup, so figure height */ +/* won't be adjusted. If anyone ever needs that, need to duplicate this */ +/* functionality up above, before exiting. */ + +#line 3003 "" + if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx == + comfig_1.ivxfig2)) { +#line 3004 "" + if (commvl_1.ivx == 1) { +#line 3005 "" + ivf = 1; +#line 3006 "" + } else { +#line 3007 "" + ivf = comfig_1.ivxfig2; +#line 3008 "" + } +#line 3009 "" + zmult = (multb - 1) * 1.2f; +#line 3010 "" + ymin = 100.f; +#line 3011 "" + i__1 = comipb_1.nnb; +#line 3011 "" + for (inb = 1; inb <= i__1; ++inb) { +#line 3012 "" + if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) { +#line 3013 "" + if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] == + 'u') { +#line 3014 "" + ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1] + * 24 - 25]; +#line 3015 "" + } else { +#line 3016 "" + 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 3018 "" + } +#line 3019 "" + ymin = dmin(ymin,ybot); +#line 3020 "" + } +#line 3021 "" +/* L3: */ +#line 3021 "" + } +#line 3022 "" + maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f; +/* Computing MAX */ +#line 3023 "" + i__1 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3]; +#line 3023 "" + all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__1,maxdrop); +#line 3024 "" + } + +/* Compute ornament levels if needed */ + +#line 3028 "" + nomornlev = ncmid_(&all_1.iv, &ipb1) + 5; +#line 3029 "" + iorn = 0; +#line 3030 "" + i__1 = comipb_1.nnb; +#line 3030 "" + for (inb = 1; inb <= i__1; ++inb) { +#line 3031 "" + ip = comipb_1.ipb[inb - 1]; +#line 3032 "" + if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) { +#line 3032 "" + goto L8; +#line 3032 "" + } +#line 3033 "" + 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 3037 "" + ++iorn; +#line 3038 "" + 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 3040 "" + r__1 = ybeam - 3.f; +#line 3040 "" + i__2 = i_nint(&r__1), i__3 = nomornlev - 10; +#line 3040 "" + ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3); +#line 3041 "" + } else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { + +/* Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */ +/* 15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD */ + +/* 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 3049 "" + 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 3051 "" + ++iorn; +#line 3052 "" + all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[ + commvl_1.ivx + ip * 24 - 1],22); +#line 3053 "" + 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 3055 "" + r__1 = ybeam + 3.f; +#line 3055 "" + i__2 = i_nint(&r__1); +#line 3055 "" + ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev); +#line 3056 "" + } +#line 3057 "" + } else { + +/* In a chord. Orn may be on main note or non-main or both. Set ihornb if */ +/* upbeam and highest note has orn, or down beam and lowest. Find 1st chord note */ + +#line 3062 "" + i__2 = comtrill_1.ncrd; +#line 3062 "" + for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__2; + ++comtrill_1.icrd1) { +#line 3063 "" + 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 3063 "" + goto L11; +#line 3063 "" + } +#line 3065 "" +/* L10: */ +#line 3065 "" + } +#line 3066 "" +L11: + +/* Find outermost note, min or max depending on beam direction ulq. xto is true */ +/* if there's an ornament on that note. Expand orn list to include ._, since if */ +/* on extreme chord note in beam, will move. */ +/* So ornaments are all except 0,4,13 (,g,) */ + +#line 3073 "" + levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; +#line 3074 "" + xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1] + & 4186094) > 0; +#line 3075 "" + icrdx = 0; +#line 3076 "" + i__2 = comtrill_1.ncrd; +#line 3076 "" + for (icrd = comtrill_1.icrd1; icrd <= i__2; ++icrd) { +#line 3077 "" + if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 & + lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8)) + != commvl_1.ivx) { +#line 3077 "" + goto L13; +#line 3077 "" + } +#line 3079 "" + levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen) + -12); +#line 3080 "" + 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 3082 "" + levx = levc; +#line 3083 "" + icrdx = icrd; +#line 3084 "" + xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0; +#line 3085 "" + } +#line 3086 "" +/* L12: */ +#line 3086 "" + } +#line 3087 "" +L13: + +/* If there's orn on extreme note, do stuff */ + +#line 3091 "" + if (xto) { +#line 3092 "" + ++iorn; +#line 3093 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] + == 'u') { +#line 3094 "" + 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 3096 "" + r__1 = ybeam + 3.f; +#line 3096 "" + i__2 = i_nint(&r__1); +#line 3096 "" + ihornb[commvl_1.ivx + iorn * 24] = max(i__2,nomornlev); +#line 3097 "" + } else { +#line 3098 "" + 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 3100 "" + r__1 = ybeam - 3.f; +#line 3100 "" + i__2 = i_nint(&r__1), i__3 = nomornlev - 10; +#line 3100 "" + ihornb[commvl_1.ivx + iorn * 24] = min(i__2,i__3); +#line 3101 "" + } +#line 3102 "" + if (icrdx == 0) { + +/* Affected ornament is on main note */ + +#line 3106 "" + all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( + all_1.iornq[commvl_1.ivx + ip * 24 - 1],22); +#line 3107 "" + } else { +#line 3108 "" + comtrill_1.icrdorn[icrdx - 1] = bit_set( + comtrill_1.icrdorn[icrdx - 1],22); +#line 3109 "" + } +#line 3110 "" + } +#line 3111 "" + } +#line 3112 "" +L8: +#line 3112 "" + ; +#line 3112 "" + } + +/* Henceforth nornb will be a counter. */ + +#line 3116 "" + if (iorn > 0) { +#line 3116 "" + nornb[commvl_1.ivx] = 1; +#line 3116 "" + } +#line 3117 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) { +#line 3117 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 3117 "" + } +#line 3118 "" + return 0; +} /* beamstrt_ */ + + + +/* meter space (pts) = xb4mbr = musicsize*facmtr */ + + +/* From other */ + +/* * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, */ + +/* Subroutine */ int catspace_(real *space, real *squez, integer *nnsk) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Local variables */ + static integer iptr; + +/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +/* logical gotclef */ +#line 3202 "" + i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1; +#line 3202 "" + for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1; + ++iptr) { +#line 3203 "" + if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) < + comtol_1.tol) { +#line 3204 "" + if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) < + comtol_1.tol) { + +/* Increment pre-existing entry */ + +#line 3208 "" + c1omnotes_1.nnpd[iptr - 1] += *nnsk; +#line 3209 "" + return 0; +#line 3210 "" + } +#line 3211 "" + } +#line 3212 "" +/* L16: */ +#line 3212 "" + } + +/* Didn't find current duration & squez, so add a new entry. */ +/* No particular reason to keep in order, so add at the end. */ + +#line 3217 "" + c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk; +#line 3218 "" + c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space; +#line 3219 "" + c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez; +#line 3220 "" + ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; +#line 3221 "" + return 0; +} /* catspace_ */ + +/* Character */ VOID chax_(char *ret_val, ftnlen ret_val_len, integer *n) +{ + +/* 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 3228 "" + *(unsigned char *)ret_val = (char) (*n); +#line 3229 "" + return ; +} /* chax_ */ + +/* Subroutine */ int checkdyn_(char *lineq, integer *iccount, integer *ibar, + ftnlen lineq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1, i__2[3], i__3; + real r__1; + char ch__1[4], ch__2[1]; + icilist ici__1; + + /* Builtin functions */ + integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, + ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + , i_nint(real *); + + /* Local variables */ + static integer ipm, iend; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer idno; + static real fnum; + static char durq[1]; + extern /* Subroutine */ int stop1_(void), errmsg_(char *, integer *, + integer *, char *, ftnlen, ftnlen); + static logical txtdyn; + extern /* Subroutine */ int readnum_(char *, integer *, char *, real *, + ftnlen, ftnlen); + static char dynsymq[4]; + +#line 3236 "" + txtdyn = FALSE_; + +/* On entry, iccount is on "D" */ + +#line 3240 "" + i__1 = *iccount; +#line 3240 "" + if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { + +/* Dynamic text */ + +#line 3244 "" + i__1 = *iccount + 1; +#line 3244 "" + iend = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 3245 "" + if (iend == 0) { +#line 3246 "" + i__1 = *iccount + 1; +#line 3246 "" + errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"\ + "h double quote!", (ftnlen)128, (ftnlen)50); +#line 3248 "" + stop1_(); +#line 3249 "" + } + +/* Set iccount to character after 2nd ", and set ipm */ + +#line 3253 "" + *iccount = *iccount + iend + 2; +#line 3254 "" + ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1); +#line 3255 "" + if (ipm == 0) { +#line 3256 "" + errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"\ + "ere!", (ftnlen)128, (ftnlen)33); +#line 3258 "" + stop1_(); +#line 3259 "" + } +#line 3260 "" + } else { + +/* Expect ordinary dynamic */ + +#line 3264 "" + for (iend = *iccount + 2; iend <= 128; ++iend) { +#line 3265 "" + ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); +#line 3266 "" + if (ipm > 0) { +#line 3266 "" + goto L2; +#line 3266 "" + } +#line 3267 "" +/* L1: */ +#line 3267 "" + } +#line 3268 "" +L2: +#line 3269 "" + if (iend - *iccount > 5 || iend - *iccount < 2) { +#line 3270 "" + i__1 = iend - 1; +#line 3270 "" + errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", ( + ftnlen)128, (ftnlen)30); +#line 3272 "" + stop1_(); +#line 3273 "" + } +#line 3274 "" + i__1 = *iccount; +#line 3274 "" + ici__1.icierr = 0; +#line 3274 "" + ici__1.iciend = 0; +#line 3274 "" + ici__1.icirnum = 1; +#line 3274 "" + ici__1.icirlen = iend - 1 - i__1; +#line 3274 "" + ici__1.iciunit = lineq + i__1; +/* Writing concatenation */ +#line 3274 "" + i__2[0] = 2, a__1[0] = "(a"; +#line 3274 "" + i__3 = iend + 47 - *iccount; +#line 3274 "" + chax_(ch__2, (ftnlen)1, &i__3); +#line 3274 "" + i__2[1] = 1, a__1[1] = ch__2; +#line 3274 "" + i__2[2] = 1, a__1[2] = ")"; +#line 3274 "" + ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 3274 "" + s_rsfi(&ici__1); +#line 3274 "" + do_fio(&c__1, dynsymq, (ftnlen)4); +#line 3274 "" + e_rsfi(); +#line 3276 "" + idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "\ + "> ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4; +#line 3279 "" + if (idno == 0) { +#line 3280 "" + i__1 = *iccount + 1; +#line 3280 "" + errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128, + (ftnlen)21); +#line 3281 "" + stop1_(); +#line 3282 "" + } +#line 3283 "" + *iccount = iend; +#line 3284 "" + } +#line 3285 "" + if (ipm != 2) { + +/* There is a vertical shift, have "+" or "-" */ + +#line 3289 "" + ++(*iccount); +#line 3290 "" + if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen) + 1) == 0) { +#line 3291 "" + errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"\ + "l offset!", (ftnlen)128, (ftnlen)42); +#line 3293 "" + stop1_(); +#line 3294 "" + } +#line 3295 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3296 "" + idno = i_nint(&fnum); +#line 3297 "" + if (idno > 63) { +#line 3298 "" + i__1 = *iccount - 1; +#line 3298 "" + errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"\ + "st be (-63,63)!", (ftnlen)128, (ftnlen)50); +#line 3300 "" + stop1_(); +#line 3301 "" + } +#line 3302 "" + ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); +#line 3303 "" + if (ipm == 0) { +#line 3304 "" + errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"\ + "ere!", (ftnlen)128, (ftnlen)33); +#line 3306 "" + stop1_(); +#line 3307 "" + } +#line 3308 "" + if (ipm != 2) { + +/* There is a horizontal shift */ + +#line 3312 "" + ++(*iccount); +#line 3313 "" + if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, ( + ftnlen)1) == 0) { +#line 3314 "" + errmsg_(lineq, iccount, ibar, "Expected number here for hori"\ + "zontal offset!", (ftnlen)128, (ftnlen)43); +#line 3316 "" + stop1_(); +#line 3317 "" + } +#line 3318 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3319 "" + r__1 = fnum * 10; +#line 3319 "" + idno = i_nint(&r__1); +#line 3320 "" + if (idno > 255) { +#line 3321 "" + i__1 = *iccount - 1; +#line 3321 "" + errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"\ + "ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56); +#line 3323 "" + stop1_(); +#line 3324 "" + } else if (*(unsigned char *)durq != ' ') { +#line 3325 "" + errmsg_(lineq, iccount, ibar, "There should be a blank here!", + (ftnlen)128, (ftnlen)29); +#line 3327 "" + stop1_(); +#line 3328 "" + } +#line 3329 "" + } + +/* iccount should be on the blank at the end of the entire symbol */ + +#line 3333 "" + } +#line 3334 "" + return 0; +} /* checkdyn_ */ + +/* Subroutine */ int chkarp_(integer *ncrd, integer *icrdat, integer *ivx, + integer *ip, logical *iscacc, logical *isarp) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + integer lbit_shift(integer, integer); + + /* Local variables */ + static integer icrd; + static logical found1; + +/* subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */ +/* * icashft) */ +#line 3341 "" + /* Parameter adjustments */ +#line 3341 "" + --icrdat; +#line 3341 "" + +#line 3341 "" + /* Function Body */ +#line 3341 "" + found1 = FALSE_; + +/* icashft will be max left shift of accid's in chord notes. */ +/* Used only for spacing checks. */ +/* Will include left shift of chord note itself. */ +/* Rezero after use. */ + +#line 3348 "" + i__1 = *ncrd; +#line 3348 "" + for (icrd = 1; icrd <= i__1; ++icrd) { + +/* This if block cycles thru all chord notes on ivx,ip; then returns. */ + +#line 3352 "" + if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], ( + ftnlen)-8)) == *ivx) { +#line 3354 "" + found1 = TRUE_; +#line 3355 "" + *iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test( + icrdat[icrd],27); + +/* Accid on this chord note, and it's not midi-only. */ + +/* irshft = igetbits(icrdot(icrd),7,20) */ +/* c */ +/* c Include increment for notehead shift */ +/* c */ +/* if (btest(icrdat(icrd),23)) then */ +/* if (irshft .eq. 0) then */ +/* irshft = 44 */ +/* else */ +/* irshft=irshft-20 */ +/* end if */ +/* end if */ +/* if (irshft .ne. 0) then */ +/* c */ +/* c Accid on chord note is shifted. Include only left shift, in 20ths. */ +/* c */ +/* if (irshft .lt. 64) icashft = max(icashft,64-irshft) */ +/* end if */ +/* end if */ +#line 3378 "" + *isarp = *isarp || bit_test(icrdat[icrd],25); +#line 3379 "" + } else if (found1) { +#line 3380 "" + return 0; +#line 3381 "" + } +#line 3382 "" +/* L18: */ +#line 3382 "" + } +#line 3383 "" + return 0; +} /* chkarp_ */ + +/* Subroutine */ int chkimidi_(integer *icm) +{ + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void); + + /* Fortran I/O blocks */ + static cilist io___242 = { 0, 6, 0, 0, 0 }; + static cilist io___243 = { 0, 6, 0, 0, 0 }; + static cilist io___244 = { 0, 6, 0, "(a6,2x,4i8)", 0 }; + + +#line 3396 "" + if (commidi_1.imidi[*icm] >= 24576) { +#line 3397 "" + s_wsle(&io___242); +#line 3397 "" + e_wsle(); +#line 3398 "" + s_wsle(&io___243); +#line 3398 "" + do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"\ + " worse", (ftnlen)52); +#line 3398 "" + e_wsle(); +#line 3399 "" + s_wsfe(&io___244); +#line 3399 "" + do_fio(&c__1, "imidi:", (ftnlen)6); +#line 3399 "" + do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer)); +#line 3399 "" + do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer)); +#line 3399 "" + do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer)); +#line 3399 "" + do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer)); +#line 3399 "" + e_wsfe(); +#line 3401 "" + } +#line 3402 "" + return 0; +} /* chkimidi_ */ + +/* Subroutine */ int chkkbdrests_(integer *ip, integer *iv, integer *ivx, + integer *nn, integer *islur, integer *irest, integer *nolev, integer * + ivmx, integer *nib, integer *nv, integer *ibar, real *tnow, real *tol, + integer *nodur, integer *mode, integer *levtopr, integer *levbotr, + integer *mult, integer *ipl) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Builtin functions */ + integer i_sign(integer *, integer *); + + /* Local variables */ + static integer levother, kkp; + extern integer log2_(integer *), ncmid_(integer *, integer *); + static integer indxr, iraise, levbot; + static real tother; + static integer levtop, iraise1, iraise2, ivother, levnext, iupdown; + +/* * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) */ + +/* On 130127 put this code, formerly in make2bar right before calling notex for */ +/* a single note/rest, into this subroutine, so the same logic could also be */ +/* with the calls to beamstrt/mid/end to adjust height of rests in xtups if the */ +/* keyboard rest option is selected */ + +/* mode=1 if called as before, 2 if for an xtup. Only affects check for */ +/* quarter rests, which will fix later. */ + +/* Get reference level: next following note if no intervening blank rests, */ +/* otherwise next prior note. Relative to bottom line. */ + +/* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */ +#line 3424 "" + /* Parameter adjustments */ +#line 3424 "" + ipl -= 25; +#line 3424 "" + mult -= 25; +#line 3424 "" + --levbotr; +#line 3424 "" + --levtopr; +#line 3424 "" + nodur -= 25; +#line 3424 "" + nib -= 25; +#line 3424 "" + ivmx -= 25; +#line 3424 "" + nolev -= 25; +#line 3424 "" + irest -= 25; +#line 3424 "" + islur -= 25; +#line 3424 "" + --nn; +#line 3424 "" + +#line 3424 "" + /* Function Body */ +#line 3424 "" + if (*ip != nn[*ivx] && ! bit_test(ipl[*ivx + *ip * 24],1)) { + +/* Not the last note and not "look-left" for level */ + +#line 3428 "" + i__1 = nn[*ivx]; +#line 3428 "" + for (kkp = *ip + 1; kkp <= i__1; ++kkp) { +#line 3429 "" + if (bit_test(islur[*ivx + kkp * 24],29)) { +#line 3429 "" + goto L4; +#line 3429 "" + } +#line 3430 "" + if (! bit_test(irest[*ivx + kkp * 24],0)) { +#line 3431 "" + levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; +/* Relative to botto */ +#line 3432 "" + goto L9; +#line 3433 "" + } +#line 3434 "" +/* L8: */ +#line 3434 "" + } +#line 3435 "" + } +#line 3436 "" +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 3442 "" + if (*ip == 1) { +#line 3442 "" + return 0; +#line 3442 "" + } +/* Get out if this is the first note. */ +#line 3443 "" + for (kkp = *ip - 1; kkp >= 1; --kkp) { +#line 3444 "" + if (! bit_test(irest[*ivx + kkp * 24],0)) { +#line 3445 "" + levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4; +/* Relative to bottom */ +#line 3446 "" + goto L9; +#line 3447 "" + } +#line 3448 "" +/* L3: */ +#line 3448 "" + } +/* go to 2 ! Pretty odd, should never be here, but get out if so. */ +#line 3450 "" + return 0; +/* Pretty odd, should never be here, but get out if so. */ +#line 3451 "" +L9: + +/* Find note in other voice at same time */ + +#line 3455 "" + i__1 = *ivx - *nv - 1; +#line 3455 "" + iupdown = i_sign(&c__1, &i__1); +#line 3456 "" + ivother = ivmx[*iv + (3 - iupdown) / 2 * 24]; +#line 3457 "" + tother = 0.f; +#line 3458 "" + i__1 = nib[ivother + *ibar * 24]; +#line 3458 "" + for (kkp = 1; kkp <= i__1; ++kkp) { +#line 3459 "" + if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) { +#line 3459 "" + goto L6; +#line 3459 "" + } +#line 3460 "" + tother += nodur[ivother + kkp * 24]; +#line 3461 "" +/* L5: */ +#line 3461 "" + } + +/* If here, then no note starts in other voice at same time, so set default */ + +#line 3465 "" + levother = -iupdown * 50; +#line 3466 "" + goto L7; +#line 3467 "" +L6: + +/* If here, have just identified a simultaneous note or rest in other voice */ + +#line 3471 "" + if (! bit_test(irest[ivother + kkp * 24],0)) { +/* Not a rest, use it */ +#line 3472 "" + levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4; +#line 3473 "" + } else { +#line 3474 "" + 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 3479 "" + return 0; +#line 3480 "" + } +#line 3481 "" + levother = -iupdown * 50; +#line 3482 "" + } +#line 3483 "" +L7: +#line 3484 "" + if (*mode == 1) { +#line 3485 "" + indxr = log2_(&nodur[*ivx + *ip * 24]) + 1; +#line 3486 "" + } else { +/* nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */ +#line 3488 "" + indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1; +#line 3489 "" + } +#line 3490 "" + if (iupdown < 0) { +#line 3491 "" + levtop = levtopr[indxr]; +#line 3492 "" + iraise1 = levother - levtop - 3; +/* Based on other note */ +#line 3493 "" + iraise2 = levnext - levtop; +/* Based on following note */ +#line 3494 "" + if (indxr == 5 && levnext < 1) { +#line 3494 "" + iraise2 += 2; +#line 3494 "" + } +#line 3495 "" + iraise = min(iraise1,iraise2); +#line 3496 "" + if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) { +#line 3496 "" + --iraise; +#line 3496 "" + } +#line 3498 "" + } else { +#line 3499 "" + levbot = levbotr[indxr]; +#line 3500 "" + iraise1 = levother - levbot + 3; +#line 3501 "" + iraise2 = levnext - levbot; +#line 3502 "" + if (indxr == 5 && levnext > 8) { +#line 3502 "" + --iraise2; +#line 3502 "" + } +#line 3503 "" + iraise = max(iraise1,iraise2); +#line 3504 "" + if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) { +#line 3504 "" + --iraise; +#line 3504 "" + } +#line 3506 "" + } +#line 3507 "" + nolev[*ivx + *ip * 24] = iraise + 100; +#line 3508 "" + return 0; +} /* chkkbdrests_ */ + +/* Subroutine */ int chklit_(char *lineq, integer *iccount, integer *literr, + ftnlen lineq_len) +{ + /* System generated locals */ + char ch__1[1]; + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char charq[1]; + static integer itype, lenlit; + extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, + ftnlen); + +#line 3513 "" + *literr = 0; +#line 3514 "" + itype = 1; +#line 3515 "" +L17: +#line 3515 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 3516 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 3516 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { +#line 3517 "" + ++itype; +#line 3518 "" + if (itype > 3) { +#line 3519 "" + *literr = 1; +#line 3520 "" + return 0; +#line 3521 "" + } +#line 3522 "" + goto L17; +#line 3523 "" + } +#line 3524 "" + lenlit = itype; +#line 3525 "" +L18: +#line 3525 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 3526 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 3526 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) { +#line 3527 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 3528 "" + if (*(unsigned char *)charq != ' ') { + +/* Starting a new tex command withing the string */ + +#line 3532 "" + lenlit += 2; +#line 3533 "" + if (lenlit > 128) { +#line 3534 "" + *literr = 2; +#line 3535 "" + return 0; +#line 3536 "" + } +#line 3537 "" + goto L18; +#line 3538 "" + } +#line 3539 "" + } else { +#line 3540 "" + ++lenlit; +#line 3541 "" + if (lenlit > 128) { +#line 3542 "" + *literr = 2; +#line 3543 "" + return 0; +#line 3544 "" + } +#line 3545 "" + goto L18; +#line 3546 "" + } +#line 3547 "" + return 0; +} /* chklit_ */ + +/* Subroutine */ int chkpm4ac_(char *lineq, integer *iccount, integer *nacc, + logical *moved, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, + ftnlen, ftnlen), i_nint(real *); + + /* Local variables */ + static integer ipm; + static real fnum; + static char durq[1]; + static integer icsav; + static logical ishorz; + extern /* Subroutine */ int readnum_(char *, integer *, char *, real *, + ftnlen, ftnlen), setbits_(integer *, integer *, integer *, + integer *); + + +/* Called after getting +/-/</> in a note (not rest). iccount is on the +-<>. */ +/* Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits */ +/* 10-16) if < or >, horiz and vert (bits 4-9) if two consecutive signed */ +/* numbers. If moved=.true., iccount on exit is on end of last number. */ +/* If moved=.false., iccount still on +/- */ + +#line 3560 "" + i__1 = *iccount - 2; +#line 3560 "" + i__2 = *iccount; +#line 3560 "" + 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) { + +/* Prior char was accid & next is #; this may be start of accidental shift. */ +/* Must test for "." above in case we get "<" or ">" */ + +#line 3566 "" + ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1) + - 2; +#line 3567 "" + i__1 = *iccount + 1; +#line 3567 "" + i__2 = *iccount; +#line 3567 "" + 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 3572 "" + *moved = FALSE_; +#line 3573 "" + return 0; +#line 3574 "" + } +#line 3575 "" + ishorz = ipm > 1; + +/* Save iccount in case it's not accid shift and we have to reset. */ + +#line 3579 "" + icsav = *iccount; +#line 3580 "" + ++(*iccount); +#line 3581 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3582 "" + if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* This has to be accidental shift. Set vert. shift. */ + +#line 3586 "" + if (! ishorz) { + +/* +/- syntax, both shifts set, vertical first */ + +#line 3590 "" + i__1 = (integer) (ipm * fnum + 32.5f); +#line 3590 "" + setbits_(nacc, &c__6, &c__4, &i__1); +#line 3591 "" + ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 3592 "" + ++(*iccount); +#line 3593 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 3594 "" + } else { + +/* </> syntax, only horiz set */ + +#line 3598 "" + ipm += -3; +#line 3599 "" + } + +/* Set horiz. shift */ + +#line 3603 "" + r__1 = (ipm * fnum + 5.35f) * 20; +#line 3603 "" + i__1 = i_nint(&r__1); +#line 3603 "" + setbits_(nacc, &c__7, &c__10, &i__1); +#line 3604 "" + --(*iccount); +#line 3605 "" + *moved = TRUE_; +#line 3606 "" + } else { + +/* False alarm. Reset everything and flow onward */ + +#line 3610 "" + *moved = FALSE_; +#line 3611 "" + *iccount = icsav; +#line 3612 "" + } +#line 3613 "" + } else { + +/* Either prior char was not 'sfn' or next was not digit, so take no action */ + +#line 3617 "" + *moved = FALSE_; +#line 3618 "" + } +#line 3619 "" + return 0; +} /* chkpm4ac_ */ + +/* Subroutine */ int clefsym_(integer *isl, char *notexq, integer *lnote, + integer *nclef, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[4]; + integer i__1[4], i__2, i__3; + char ch__1[1], ch__2[1], ch__3[1]; + + /* Builtin functions */ + integer lbit_shift(integer, integer); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nlev; + + +/* Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */ + +#line 3627 "" + *nclef = lbit_shift(*isl, (ftnlen)-12) & 7; +#line 3628 "" + if (*nclef == 0) { + +/* treble */ + +#line 3632 "" + nlev = 2; +#line 3633 "" + } else if (*nclef > 6) { + +/* French violin */ + +#line 3637 "" + nlev = 0; +#line 3638 "" + } else if (*nclef < 5) { + +/* C-clef */ + +#line 3642 "" + nlev = (*nclef << 1) - 2; +#line 3643 "" + } else { + +/* F-clef */ + +#line 3647 "" + nlev = (*nclef << 1) - 6; +#line 3648 "" + } +/* Writing concatenation */ +#line 3649 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 3649 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 3649 "" + i__1[1] = 7, a__1[1] = "pmxclef"; +#line 3649 "" + i__2 = min(*nclef,7) + 48; +#line 3649 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 3649 "" + i__1[2] = 1, a__1[2] = ch__2; +#line 3649 "" + i__3 = nlev + 48; +#line 3649 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 3649 "" + i__1[3] = 1, a__1[3] = ch__3; +#line 3649 "" + s_cat(notexq, a__1, i__1, &c__4, notexq_len); +#line 3651 "" + *lnote = 10; +#line 3652 "" + return 0; +} /* clefsym_ */ + +/* Subroutine */ int crdacc_(integer *nacc, integer *naccid, integer *micrd, + integer *nolevm, real *rmsshift, logical *lasttime, integer * + levmaxacc, integer *icrdot0, real *segrb0, integer *ksegrb0, integer * + nsegrb0, logical *twooftwo, integer *icashft) +{ + /* Initialized data */ + + static integer nsegar[5] = { 3,4,3,3,2 }; + static integer nsegal[5] = { 2,4,3,3,2 }; + static real segar[60] /* was [5][2][6] */ = { -.05f,-.38f,-.34f, + -.05f,-.15f,-1.4f,-2.9f,-3.f,-1.4f,-1.2f,-.75f,-.2f,-.8f,-.75f, + 0.f,.96f,-1.04f,1.48f,.96f,1.2f,0.f,-.38f,0.f,0.f,0.f,3.15f,1.64f, + 3.f,3.15f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,2.9f,0.f,0.f,0.f,0.f,0.f, + 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f, + 0.f,0.f }; + static real segal[60] /* was [5][2][6] */ = { -1.f,-1.02f,-.6f, + -1.65f,-1.2f,-1.4f,-2.9f,-3.f,-1.4f,-1.2f,0.f,-1.2f,-1.04f,0.f, + 0.f,3.15f,-1.64f,-1.48f,3.15f,1.2f,0.f,-1.02f,0.f,0.f,0.f,0.f, + 1.04f,3.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,2.9f,0.f,0.f,0.f,0.f, + 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f, + 0.f,0.f,0.f }; + static integer iacctbl[6] = { 1,2,3,0,4,5 }; + + /* System generated locals */ + integer i__1, i__2, i__3; + real r__1; + + /* Builtin functions */ + integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *, + char *, ftnlen), e_wsle(void); + + /* Local variables */ + static integer iacctype; + static logical mainnote; + extern integer igetbits_(integer *, integer *, integer *); + static real ybotaseg, shiftmin; + static integer isetshft[10]; + static real ytopaseg; + static integer ibelowbot, ibelowtop, iwa, iranksetter, iseg; + extern /* Subroutine */ int stop1_(void); + static integer isega; + static real segrb[100] /* was [2][50] */; + static integer irank; + static real shift; + static integer nolev, isegrb, ksegrb[50], nsegrb, ishift; + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer netgain; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + + /* Fortran I/O blocks */ + static cilist io___291 = { 0, 6, 0, 0, 0 }; + static cilist io___292 = { 0, 6, 0, 0, 0 }; + + + +/* nacc = accidental bitmap for main note */ +/* naccid = # of accid's in chord */ +/* micrd = array with icrd #'s for notes w/ acc's, 0=>main note */ +/* nolevm = level of main note */ +/* segrb(1|2,.) x|y-coord of right-bdry segment */ +/* ksegrb(.) internal use; tells what defined this segment */ +/* -2: Left-shifted notehead */ +/* -1: Original right boundary */ +/* 0: Main note accidental */ +/* icrd: Chord-note accidental */ +/* isetshft(i),i=1,naccid: what set shift for this accid, same codes */ +/* icrdot0 = top-down level-rank of main note among accid-notes */ +/* 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 3679 "" + /* Parameter adjustments */ +#line 3679 "" + --ksegrb0; +#line 3679 "" + segrb0 -= 3; +#line 3679 "" + --micrd; +#line 3679 "" + +#line 3679 "" + /* Function Body */ + +/* Fancy sharp boundary. fl,sh,na,dfl,dsh */ + +/* * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. , */ +/* meas value for y, natural is 1.6 */ +/* * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , */ +/* c (meas. value is 3.08) ^^^^ */ +/* c Raise top of flat so it interferes with bottom of sharp */ + +/* iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6) */ + + +/* Set up barrier segrb(iseg,ipoint) to define coords of corner points */ +/* on stem+notes */ + +#line 3710 "" + i__1 = *nsegrb0; +#line 3710 "" + for (iseg = 1; iseg <= i__1; ++iseg) { +#line 3711 "" + segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1]; +#line 3712 "" + segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2]; +#line 3713 "" + ksegrb[iseg - 1] = ksegrb0[iseg]; +#line 3714 "" +/* L11: */ +#line 3714 "" + } +#line 3715 "" + nsegrb = *nsegrb0; +#line 3716 "" + *rmsshift = 0.f; +#line 3717 "" + shiftmin = 1e3f; +#line 3718 "" + i__1 = *naccid; +#line 3718 "" + for (iwa = 1; iwa <= i__1; ++iwa) { + +/* Initialize shift for this note */ + +#line 3722 "" + shift = 0.f; +#line 3723 "" + mainnote = micrd[iwa] == 0; +#line 3724 "" + isetshft[iwa - 1] = -1; + +/* Get note level and accidental type */ + +#line 3728 "" + if (mainnote) { +#line 3729 "" + nolev = *nolevm; +#line 3730 "" + iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1]; +#line 3731 "" + } else { +#line 3732 "" + nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, & + c__12); +#line 3733 "" + iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], & + c__3, &c__20) - 1]; +#line 3734 "" + } + +/* Cycle thru segments on right edge of this accidental */ + +#line 3738 "" + i__2 = nsegar[iacctype - 1] - 1; +#line 3738 "" + for (isega = 1; isega <= i__2; ++isega) { +#line 3739 "" + ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16]; +#line 3740 "" + ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 - + 16]; + +/* Cycle thru segments of right-hand barrier */ + +#line 3744 "" + i__3 = nsegrb - 1; +#line 3744 "" + for (isegrb = 1; isegrb <= i__3; ++isegrb) { + +/* Must find all barrier segments that start below ytopseg & end above ybotseg */ + +#line 3748 "" + if (segrb[(isegrb << 1) - 1] < ytopaseg) { + +/* Barrier seg starts below top of accid */ +/* Check if barrier seg ends above bottom of accid */ + +#line 3753 "" + if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) { +#line 3754 "" + if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype + + ((isega << 1) + 1) * 5 - 16]) { +#line 3756 "" + shift = segrb[(isegrb << 1) - 2] - segar[iacctype + + ((isega << 1) + 1) * 5 - 16]; + +/* Record the cause of the shift */ + +#line 3760 "" + isetshft[iwa - 1] = ksegrb[isegrb - 1]; +#line 3761 "" + } +#line 3762 "" + } + +/* Does barrier segment end above top of accid seg? */ + +#line 3766 "" + if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) { +#line 3766 "" + goto L4; +#line 3766 "" + } +#line 3767 "" + } +#line 3768 "" +/* L3: */ +#line 3768 "" + } +#line 3769 "" +L4: +#line 3770 "" +/* L2: */ +#line 3770 "" + ; +#line 3770 "" + } +#line 3771 "" + if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) { +/* if (nolev .eq. levmaxacc) then */ +#line 3774 "" + if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) { +#line 3775 "" + *rmsshift = 1e3f; +#line 3776 "" + return 0; +#line 3777 "" + } + +/* Does the following properly account for left-shifted noteheads? */ + +/* Top-down rank of this note we just shifted */ + +#line 3783 "" + if (mainnote) { +#line 3784 "" + irank = *icrdot0; +#line 3785 "" + } else { +#line 3786 "" + irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, & + c__27); +#line 3787 "" + } + +/* Compare level-rank of this note vs. that of note that caused the shift. */ +/* This has effect of checking for basic interferences from top down. */ + +/* ksegrb(.) internal use; tells what defined this segment */ +/* -2: Left-shifted notehead */ +/* -1: Original right boundary */ +/* 0: Main note accidental */ +/* icrd: Chord-note accidental */ +/* isetshft(i),i=1,naccid: what set shift for this accid, same codes */ + +#line 3799 "" + if (isetshft[iwa - 1] < 0) { +#line 3800 "" + iranksetter = 0; +#line 3801 "" + } else if (isetshft[iwa - 1] == 0) { +#line 3802 "" + iranksetter = *icrdot0; +#line 3803 "" + } else { +#line 3804 "" + iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1] + - 1], &c__3, &c__27); +#line 3805 "" + } +#line 3806 "" + if (iranksetter != 0 && irank != iranksetter + 1) { +#line 3807 "" + *rmsshift = 1e3f; +#line 3808 "" + return 0; +#line 3809 "" + } +#line 3810 "" + } +/* Computing 2nd power */ +#line 3811 "" + r__1 = shift; +#line 3811 "" + *rmsshift += r__1 * r__1; +#line 3812 "" + if (*lasttime && dabs(shift) > 1e-4f) { +#line 3813 "" + if (mainnote) { +#line 3814 "" + if (! bit_test(*nacc,29)) { +#line 3814 "" + goto L10; +#line 3814 "" + } +#line 3815 "" + } else { +#line 3816 "" + if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) { +#line 3816 "" + goto L10; +#line 3816 "" + } +#line 3817 "" + } + +/* 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 3823 "" + if (mainnote) { +#line 3824 "" + shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f; +#line 3825 "" + } else { +#line 3826 "" + shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, + &c__20) - 107) * .05f; +#line 3827 "" + } +#line 3828 "" +L10: +#line 3829 "" + if (*twooftwo) { + +/* Record the shift for this accidental */ + +#line 3833 "" + if (shift < -5.35f) { +#line 3834 "" + printl_(" ", (ftnlen)1); +#line 3835 "" + printl_("WARNING: auto-generated accidental shift too bi"\ + "g for PMX, ignoring", (ftnlen)66); +#line 3837 "" + } else { +#line 3838 "" + r__1 = (shift + 5.35f) * 20; +#line 3838 "" + ishift = i_nint(&r__1); +#line 3839 "" + if (mainnote) { +#line 3840 "" + setbits_(nacc, &c__7, &c__10, &ishift); +#line 3841 "" + } else { +#line 3842 "" + setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, & + c__20, &ishift); +#line 3843 "" + } +#line 3844 "" + } +#line 3845 "" + } else { + +/* This is the earlier call to precrd, so need minimum shift */ + +#line 3849 "" + shiftmin = dmin(shiftmin,shift); +#line 3850 "" + } +#line 3851 "" + } + +/* Bail out if this is the last accidental to check */ + +#line 3855 "" + if (iwa == *naccid) { +#line 3855 "" + goto L1; +#line 3855 "" + } + +/* 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 3860 "" + for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) { +#line 3861 "" + if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + (( + nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) { +#line 3863 "" + for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) { +#line 3864 "" + if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype + + 4]) { +#line 3864 "" + goto L6; +#line 3864 "" + } +#line 3866 "" +/* L9: */ +#line 3866 "" + } +#line 3867 "" + s_wsle(&io___291); +#line 3867 "" + do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6); +#line 3867 "" + e_wsle(); +#line 3868 "" + stop1_(); +#line 3869 "" + } +#line 3870 "" +/* L5: */ +#line 3870 "" + } +#line 3871 "" + s_wsle(&io___292); +#line 3871 "" + do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16); +#line 3871 "" + e_wsle(); +#line 3872 "" + stop1_(); +#line 3873 "" +L6: +#line 3874 "" + netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot; + +/* Shift high segments up */ + +#line 3878 "" + if (netgain >= 0) { +#line 3879 "" + i__2 = ibelowtop + 1; +#line 3879 "" + for (isegrb = nsegrb; isegrb >= i__2; --isegrb) { +#line 3880 "" + segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; +#line 3881 "" + segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; +#line 3882 "" + ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; +#line 3883 "" +/* L7: */ +#line 3883 "" + } + +/* Set up 1st segment above accid */ + +#line 3887 "" + segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - + 2]; +#line 3888 "" + segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( + (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; +#line 3890 "" + ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; +#line 3891 "" + } else { + +/* netgain<0, must remove segments. Use same coding but reverse order, */ +/* work from bottom up */ + +#line 3896 "" + segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) - + 2]; +#line 3897 "" + segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + ( + (nsegal[iacctype - 1] << 1) + 2) * 5 - 16]; +#line 3899 "" + ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1]; +#line 3900 "" + i__2 = nsegrb; +#line 3900 "" + for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) { +#line 3901 "" + segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2]; +#line 3902 "" + segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1]; +#line 3903 "" + ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1]; +#line 3904 "" +/* L12: */ +#line 3904 "" + } +#line 3905 "" + } + +/* Insert new segments */ + +#line 3909 "" + i__2 = nsegal[iacctype - 1] - 1; +#line 3909 "" + for (isega = 1; isega <= i__2; ++isega) { +#line 3910 "" + segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + (( + isega << 1) + 1) * 5 - 16]; +#line 3911 "" + segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + (( + isega << 1) + 2) * 5 - 16]; +#line 3912 "" + if (mainnote) { +#line 3913 "" + ksegrb[ibelowbot + isega - 1] = 0; +#line 3914 "" + } else { +#line 3915 "" + ksegrb[ibelowbot + isega - 1] = micrd[iwa]; +#line 3916 "" + } +#line 3917 "" +/* L8: */ +#line 3917 "" + } + +/* Update number of barrier segments */ + +#line 3921 "" + nsegrb += netgain; +/* c */ +/* c Temporary printout for boundary segments as built up */ +/* c */ +/* write(15,'()') */ +/* write(15,'(a/(2f8.2,i5))')' y x kseg', */ +/* * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) */ +/* write(15,'(a/(2i5))')' micrd isetshft', */ +/* * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */ +/* c */ +#line 3931 "" +L1: +#line 3931 "" + ; +#line 3931 "" + } +/* next accidental */ +#line 3932 "" + if (*lasttime && ! (*twooftwo)) { + +/* This is the final call on the pre-ask pass, so compute left-shift rqmt. */ + +#line 3936 "" + r__1 = shiftmin * -20; +#line 3936 "" + *icashft = i_nint(&r__1); +#line 3937 "" + } +/* c */ +/* c Temporary printout for boundary segments */ +/* c */ +/* if (twooftwo) then */ +/* write(15,'()') */ +/* write(15,'(a/(2f8.2,i5))')' y x kseg', */ +/* * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb) */ +/* write(15,'(a/(2i5))')' micrd isetshft', */ +/* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */ +/* end if */ +/* c */ +#line 3949 "" + return 0; +} /* crdacc_ */ + +/* Subroutine */ int crdaccs_(integer *nacc, integer *ipl, integer *irest, + integer *naccid, integer *kicrd, integer *nolevm, integer *levmaxacc, + integer *levminacc, integer *icrdot0, logical *twooftwo, integer * + icashft) +{ + /* System generated locals */ + integer i__1, i__2, i__3; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static integer ipermsav[7]; + static real rmsshift; + static integer i__, j, k, levmidacc, ip, ir, is, it, maxmanshft, icrd; + extern /* Subroutine */ int stop1_(void); + static integer micrd[10], iiseg, irank, iperm[7], nolev; + static real segrb0[100] /* was [2][50] */; + extern /* Subroutine */ int crdacc_(integer *, integer *, integer *, + integer *, real *, logical *, integer *, integer *, real *, + integer *, integer *, logical *, integer *); + static logical tagged; + static integer isegrb; + static logical manual, lshift; + static integer idummy; + static real rmsmin; + static integer ksegrb0[50], nsegrb0, manshft; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + + /* Fortran I/O blocks */ + static cilist io___321 = { 0, 6, 0, 0, 0 }; + + + +/* nacc = accidental bitmap for main note */ +/* naccid = # of accid's in chord */ +/* kicrd = array with icrd #'s for notes w/ acc's, 0=>main note */ +/* nolevm = level of main note */ + +/* This is called once per multi-accidental chord. In here, loop over all */ +/* permutations of the order of accidental as stored in kicrd. Each time thru */ +/* loop, call crdacc once, get rms shift. Only save permutation and rms value */ +/* if it is less than old value. */ + + +/* Make consistent? 120106 */ +/* integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50) */ +/* c */ +/* c Temporary printout of level-rankings */ +/* c */ +/* write(15,'()') */ +/* do 98 iacc = 1 , naccid */ +/* if (kicrd(iacc) .eq. 0) then */ +/* write(15,'(3i5)')nolevm,icrdot0 */ +/* else */ +/* write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12), */ +/* * igetbits(icrdot(kicrd(iacc)),3,27) */ +/* end if */ +/* 98 continue */ +/* c */ + +/* Initialize right-barrier */ + +#line 3989 "" + /* Parameter adjustments */ +#line 3989 "" + --kicrd; +#line 3989 "" + +#line 3989 "" + /* Function Body */ +#line 3989 "" + segrb0[0] = 0.f; +#line 3990 "" + segrb0[1] = -1e3f; +#line 3991 "" + segrb0[2] = 0.f; +#line 3992 "" + segrb0[3] = 1e3f; +#line 3993 "" + nsegrb0 = 2; +#line 3994 "" + ksegrb0[0] = -1; +#line 3995 "" + ksegrb0[1] = -1; + +/* Search for left-shifted notes, Make up the initial right-barrier, which */ +/* will be good for all permutations. */ +/* irest()(27) is set if any notes are left-shifted */ +/* Must use ALL chord notes, not just ones w/ accid's. */ + +#line 4002 "" + if (bit_test(*irest,27)) { +#line 4003 "" + i__1 = comtrill_1.icrd2; +#line 4003 "" + for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) { +#line 4004 "" + if (icrd == comtrill_1.icrd1 - 1) { + +/* Main note */ + +/* lshift = btest(ipl,8) */ +#line 4009 "" + lshift = bit_test(*ipl,8) || bit_test(*nacc,31); +#line 4010 "" + if (lshift) { +#line 4010 "" + nolev = *nolevm; +#line 4010 "" + } +#line 4011 "" + } else { + +/* Chord note */ + +#line 4015 "" + lshift = bit_test(comtrill_1.icrdat[icrd - 1],23); +/* if (lshift) nolev = igetbits(icrdat(icrd),7,12) */ +#line 4017 "" + if (lshift) { +#line 4018 "" + nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, & + c__12); +#line 4019 "" + 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 4025 "" + lshift = FALSE_; +#line 4026 "" + } +#line 4027 "" + } +#line 4028 "" + } +#line 4029 "" + if (lshift) { +#line 4030 "" + i__2 = nsegrb0 - 1; +#line 4030 "" + for (isegrb = 1; isegrb <= i__2; ++isegrb) { +#line 4031 "" + if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) { + +/* Add this notehead to the right boundary here. Move all higher segs up 2. */ + +#line 4035 "" + i__3 = isegrb + 1; +#line 4035 "" + for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) { +#line 4036 "" + segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1) + - 2]; +#line 4037 "" + segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1) + - 1]; +#line 4038 "" + ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1]; +#line 4039 "" +/* L17: */ +#line 4039 "" + } +#line 4040 "" + goto L18; +#line 4041 "" + } +#line 4042 "" +/* L16: */ +#line 4042 "" + } +#line 4043 "" +L18: + +/* Insert notehead into list. Set kseg=-2 to signal notehead shift. */ + +#line 4047 "" + iiseg = isegrb + 1; +#line 4048 "" + segrb0[(iiseg << 1) - 2] = -1.2f; +#line 4049 "" + segrb0[(iiseg << 1) - 1] = nolev - 1.f; +#line 4050 "" + ksegrb0[iiseg - 1] = -2; +#line 4051 "" + segrb0[(iiseg + 1 << 1) - 2] = 0.f; +#line 4052 "" + segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f; +#line 4053 "" + ksegrb0[iiseg] = -1; +#line 4054 "" + nsegrb0 += 2; +#line 4055 "" + } +#line 4056 "" +/* L15: */ +#line 4056 "" + } +#line 4057 "" + } + +/* Done setting right barrier for left-shifted noteheads */ + +#line 4061 "" + tagged = FALSE_; +#line 4062 "" + manual = FALSE_; + +/* Preprocess to check for manual shifts. */ +/* If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then */ +/* If any manual shift is preceded by "A" [nacc(29), icrdat(29)] 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, Observe all manual shifts. */ +/* End if */ +/* End if */ + +#line 4075 "" + maxmanshft = 0; +#line 4076 "" + i__1 = *naccid; +#line 4076 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4077 "" + if (kicrd[i__] == 0) { + +/* Main note */ + +#line 4081 "" + manshft = igetbits_(nacc, &c__7, &c__10); +#line 4082 "" + if (manshft != 0) { +#line 4083 "" + manual = TRUE_; +#line 4084 "" + if (bit_test(*nacc,29)) { +#line 4085 "" + tagged = TRUE_; +#line 4086 "" + } else { +/* maxmanshft = max(maxmanshft,64-manshft) */ +/* Computing MAX */ +#line 4088 "" + i__2 = maxmanshft, i__3 = 107 - manshft; +#line 4088 "" + maxmanshft = max(i__2,i__3); +#line 4089 "" + } +#line 4090 "" + } +#line 4091 "" + } else { + +/* Chord note */ + +#line 4095 "" + manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & + c__20); +#line 4096 "" + if (manshft != 0) { +#line 4097 "" + manual = TRUE_; +#line 4098 "" + if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { +#line 4099 "" + tagged = TRUE_; +#line 4100 "" + } else { +/* maxmanshft = max(maxmanshft,64-manshft) */ +/* Computing MAX */ +#line 4102 "" + i__2 = maxmanshft, i__3 = 107 - manshft; +#line 4102 "" + maxmanshft = max(i__2,i__3); +#line 4103 "" + } +#line 4104 "" + } +#line 4105 "" + } +#line 4106 "" +/* L13: */ +#line 4106 "" + } +#line 4107 "" + if (manual) { +#line 4108 "" + if (tagged) { + +/* zero out all untagged shifts */ + +#line 4112 "" + i__1 = *naccid; +#line 4112 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4113 "" + if (kicrd[i__] == 0) { +#line 4114 "" + if (! bit_test(*nacc,29)) { +#line 4114 "" + setbits_(nacc, &c__7, &c__10, &c__0); +#line 4114 "" + } +#line 4115 "" + } else { +#line 4116 "" + if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) { +#line 4116 "" + setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, & + c__20, &c__0); +#line 4116 "" + } +#line 4118 "" + } +#line 4119 "" +/* L14: */ +#line 4119 "" + } +#line 4120 "" + } else { + +/* There are manual shifts but none tagged. Only proceed if "Ao" was entered */ + +#line 4124 "" + if (! bit_test(*nacc,28)) { +#line 4125 "" + *icashft = maxmanshft; +#line 4126 "" + return 0; +#line 4127 "" + } +#line 4128 "" + } +#line 4129 "" + } +#line 4130 "" + if (bit_test(*nacc,28)) { + +/* Take the accidentals in order as originally input, then exit. */ + +#line 4134 "" + crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy, + &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4136 "" + return 0; +/* end if */ +#line 4138 "" + } 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 4143 "" + for (i__ = 1; i__ <= 3; ++i__) { +#line 4144 "" + if (kicrd[i__] == 0) { +#line 4145 "" + irank = *icrdot0; +#line 4146 "" + nolev = *nolevm; +#line 4147 "" + } else { +#line 4148 "" + irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, & + c__27); +#line 4149 "" + nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, & + c__12); +#line 4150 "" + } +#line 4151 "" + if (irank == 1) { +#line 4152 "" + micrd[0] = kicrd[i__]; +#line 4153 "" + } else { +#line 4154 "" + micrd[5 - irank - 1] = kicrd[i__]; +#line 4155 "" + } +#line 4156 "" + if (irank == 2) { +#line 4157 "" + levmidacc = nolev; +#line 4158 "" + } +#line 4159 "" +/* L20: */ +#line 4159 "" + } +#line 4160 "" + if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) { +#line 4162 "" + crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, + &idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4164 "" + return 0; +#line 4165 "" + } +#line 4166 "" + } +#line 4167 "" + rmsmin = 1e5f; + +/* Initialize permutation array */ + +#line 4171 "" + i__1 = *naccid; +#line 4171 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4172 "" + iperm[i__ - 1] = i__; +#line 4173 "" +/* L7: */ +#line 4173 "" + } + +/* Start looping over permutations */ + +#line 4177 "" + for (ip = 1; ip <= 5041; ++ip) { +#line 4178 "" + if (ip != 1) { + +/* Work the magic algorithm to get the next permutation */ + +#line 4182 "" + for (k = *naccid - 1; k >= 1; --k) { +#line 4183 "" + if (iperm[k - 1] <= iperm[k]) { +#line 4183 "" + goto L2; +#line 4183 "" + } +#line 4184 "" +/* L1: */ +#line 4184 "" + } + +/* If here, we just got the last permutation, so exit the loop over permutations */ + +#line 4188 "" + goto L10; +#line 4189 "" +L2: +#line 4190 "" + for (j = *naccid; j >= 1; --j) { +#line 4191 "" + if (iperm[k - 1] <= iperm[j - 1]) { +#line 4191 "" + goto L4; +#line 4191 "" + } +#line 4192 "" +/* L3: */ +#line 4192 "" + } +#line 4193 "" +L4: +#line 4194 "" + it = iperm[j - 1]; +#line 4195 "" + iperm[j - 1] = iperm[k - 1]; +#line 4196 "" + iperm[k - 1] = it; +#line 4197 "" + is = k + 1; +#line 4198 "" + for (ir = *naccid; ir >= 1; --ir) { +#line 4199 "" + if (ir <= is) { +#line 4199 "" + goto L6; +#line 4199 "" + } +#line 4200 "" + it = iperm[ir - 1]; +#line 4201 "" + iperm[ir - 1] = iperm[is - 1]; +#line 4202 "" + iperm[is - 1] = it; +#line 4203 "" + ++is; +#line 4204 "" +/* L5: */ +#line 4204 "" + } +#line 4205 "" +L6: +#line 4206 "" + ; +#line 4206 "" + } + +/* New we have a permutation. Take icrd values out of kicrd and put them into */ +/* micrd in the order of the permutation */ + +#line 4211 "" + i__1 = *naccid; +#line 4211 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4212 "" + micrd[i__ - 1] = kicrd[iperm[i__ - 1]]; +#line 4213 "" +/* L9: */ +#line 4213 "" + } +/* c */ +/* c Temporary printout */ +/* c */ +/* write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */ +/* c */ +#line 4219 "" + crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc, + icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +/* c */ +/* c Temporary printout */ +/* c */ +/* write(15,*)'perm done, rmsshift:',rmsshift */ +/* c */ +#line 4226 "" + if (rmsshift < rmsmin) { + +/* Save this permutation, reset minrms */ + +#line 4230 "" + i__1 = *naccid; +#line 4230 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4231 "" + ipermsav[i__ - 1] = iperm[i__ - 1]; +#line 4232 "" + rmsmin = rmsshift; +#line 4233 "" +/* L11: */ +#line 4233 "" + } +#line 4234 "" + } +#line 4235 "" +/* L8: */ +#line 4235 "" + } +#line 4236 "" + s_wsle(&io___321); +#line 4236 "" + do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24); +#line 4236 "" + e_wsle(); +#line 4237 "" + stop1_(); +#line 4238 "" +L10: + +/* Done looping, get info for the final choice */ + +#line 4242 "" + i__1 = *naccid; +#line 4242 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 4243 "" + micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]]; +#line 4244 "" +/* L12: */ +#line 4244 "" + } +/* c */ +/* c Temporary printout */ +/* c */ +/* write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */ +/* c */ +#line 4250 "" + crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy, + segrb0, ksegrb0, &nsegrb0, twooftwo, icashft); +#line 4252 "" + return 0; +} /* crdaccs_ */ + +/* Subroutine */ int doacc_(integer *ihshft, integer *ivshft, char *notexq, + integer *lnote, integer *nacc, integer *nolev, integer *ncm, logical * + caut, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1[2], i__2[3]; + char ch__1[1]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static char sq[1]; + static integer lacc; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static real hshft; + static char noteq[8]; + extern /* Subroutine */ int accsym_(integer *, char *, integer *, ftnlen); + static integer noleva; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static char acsymq[3]; + static integer lnoten; + +#line 4260 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4260 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 4261 "" + if (*ihshft == -107) { +#line 4261 "" + *ihshft = 0; +#line 4261 "" + } +/* c */ +/* c If main note shifted left, so shift accid. Terminate below, when acc. is done. */ +/* c */ +#line 4265 "" + if (*ihshft != 0) { + +/* Accid must be shifted horizontally */ + +#line 4269 "" + if (*ihshft < 0) { +/* Writing concatenation */ +#line 4270 "" + i__1[0] = 1, a__1[0] = sq; +#line 4270 "" + i__1[1] = 8, a__1[1] = "loffset{"; +#line 4270 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4271 "" + *ihshft = -(*ihshft); +#line 4272 "" + } else { +/* Writing concatenation */ +#line 4273 "" + i__1[0] = 1, a__1[0] = sq; +#line 4273 "" + i__1[1] = 8, a__1[1] = "roffset{"; +#line 4273 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4274 "" + } +#line 4275 "" + hshft = *ihshft * .05f; +#line 4276 "" + if (hshft < 1.f) { +#line 4277 "" + ici__1.icierr = 0; +#line 4277 "" + ici__1.icirnum = 1; +#line 4277 "" + ici__1.icirlen = 3; +#line 4277 "" + ici__1.iciunit = notexq + 9; +#line 4277 "" + ici__1.icifmt = "(f3.2)"; +#line 4277 "" + s_wsfi(&ici__1); +#line 4277 "" + do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 4277 "" + e_wsfi(); +#line 4278 "" + *lnote = 12; +#line 4279 "" + } else { +#line 4280 "" + ici__1.icierr = 0; +#line 4280 "" + ici__1.icirnum = 1; +#line 4280 "" + ici__1.icirlen = 4; +#line 4280 "" + ici__1.iciunit = notexq + 9; +#line 4280 "" + ici__1.icifmt = "(f4.2)"; +#line 4280 "" + s_wsfi(&ici__1); +#line 4280 "" + do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 4280 "" + e_wsfi(); +#line 4281 "" + *lnote = 13; +#line 4282 "" + } +/* Writing concatenation */ +#line 4283 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 4283 "" + i__2[1] = 2, a__2[1] = "}{"; +#line 4283 "" + i__2[2] = 1, a__2[2] = sq; +#line 4283 "" + s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); +#line 4284 "" + *lnote += 3; +#line 4285 "" + } else { +#line 4286 "" + s_copy(notexq, sq, (ftnlen)79, (ftnlen)1); +#line 4287 "" + *lnote = 1; +#line 4288 "" + } +#line 4289 "" + if (bit_test(*nacc,3)) { +/* Writing concatenation */ +#line 4290 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 4290 "" + i__1[1] = 3, a__1[1] = "big"; +#line 4290 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4291 "" + *lnote += 3; +#line 4292 "" + } +#line 4293 "" + if (*caut) { + +/* Cautionary accidental. Need to define bigcna,... in pmx.tex */ + +/* Writing concatenation */ +#line 4297 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 4297 "" + i__1[1] = 1, a__1[1] = "c"; +#line 4297 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4298 "" + ++(*lnote); +#line 4299 "" + } +#line 4300 "" + accsym_(nacc, acsymq, &lacc, (ftnlen)3); +/* Writing concatenation */ +#line 4301 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 4301 "" + i__1[1] = lacc, a__1[1] = acsymq; +#line 4301 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4302 "" + *lnote += lacc; +#line 4303 "" + noleva = *nolev; +#line 4304 "" + if (*ivshft != 0) { +#line 4304 "" + noleva = noleva + *ivshft - 32; +#line 4304 "" + } +#line 4305 "" + notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8); +#line 4306 "" + if (lnoten == 1) { +#line 4306 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 4306 "" + } +/* Writing concatenation */ +#line 4307 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 4307 "" + i__1[1] = lnoten, a__1[1] = noteq; +#line 4307 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4308 "" + *lnote += lnoten; +#line 4309 "" + if (*ihshft != 0) { + +/* Terminate horizontal shift */ + +/* Writing concatenation */ +#line 4313 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 4313 "" + i__1[1] = 1, a__1[1] = "}"; +#line 4313 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 4314 "" + ++(*lnote); +#line 4315 "" + } +#line 4316 "" + return 0; +} /* doacc_ */ + +/* Subroutine */ int docrd_(integer *ivx, integer *ip, integer *nodu, integer + *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) +{ + /* System generated locals */ + address a__1[2]; + integer i__1, i__2, i__3[2], i__4, i__5, i__6; + logical L__1; + char ch__1[1]; + + /* Builtin functions */ + integer pow_ii(integer *, integer *), lbit_shift(integer, integer); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + extern integer igetbits_(integer *, integer *, integer *); + static integer kv; + extern integer log2_(integer *); + static integer icrd; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer lout, lsym; + static char outq[79]; + extern /* Subroutine */ int stop1_(void), doacc_(integer *, integer *, + char *, integer *, integer *, integer *, integer *, logical *, + ftnlen); + extern integer ncmid_(integer *, integer *); + static integer lnote, nolev; + static char noteq[8]; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer nactmp; + static logical isleft; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static real updotc, rtdotc; + static integer nolevo, lnoten; + extern /* Subroutine */ int dotmov_(real *, real *, char *, integer *, + integer *, ftnlen), putarp_(real *, integer *, integer *, integer + *, integer *, char *, integer *, ftnlen); + static char notexq[79], nosymq[7]; + extern /* Subroutine */ int putorn_(integer *, integer *, integer *, + integer *, integer *, char *, integer *, integer *, integer *, + integer *, integer *, integer *, integer *, real *, char *, + integer *, integer *, integer *, logical *, logical *, ftnlen, + ftnlen), addmidi_(integer *, integer *, integer *, integer *, + real *, logical *, logical *); + static logical isright; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + + /* Fortran I/O blocks */ + static cilist io___345 = { 0, 6, 0, 0, 0 }; + static cilist io___347 = { 0, 6, 0, 0, 0 }; + static cilist io___348 = { 0, 6, 0, 0, 0 }; + + +/* 130316 */ + + +/* This subr. once produced notexq for entire chord. 10/18/97 altered to write */ +/* chord notes as we go. 10/22/97 find range of icrd first. */ +/* 2/25/98 moved rangefinding to precrd so done before slurs, so now */ +/* on entry, icrd1, icrd2 define range of icrd for this chord. */ + +/* 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 4369 "" + /* Parameter adjustments */ +#line 4369 "" + --nornb; +#line 4369 "" + ihornb -= 25; +#line 4369 "" + ulq -= 25; +#line 4369 "" + +#line 4369 "" + /* Function Body */ +#line 4369 "" + commidi_1.nmidcrd = 0; +#line 4370 "" + commidi_1.notmain = TRUE_; +#line 4371 "" + commidi_1.crdacc = FALSE_; +#line 4372 "" + i__1 = comtrill_1.icrd2; +#line 4372 "" + for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) { +#line 4373 "" + lnote = 0; +#line 4374 "" + 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 4378 "" + nolevo = nolev; + +/* Check for special situations with 2nds (see precrd). */ + +#line 4382 "" + if (bit_test(*nacc,30)) { +#line 4383 "" + if (nolev == *nolevm - 1) { +#line 4383 "" + nolev = *nolevm; +#line 4383 "" + } +#line 4384 "" + } else if (bit_test(*nacc,31)) { +#line 4385 "" + if (nolev == *nolevm + 1) { +#line 4385 "" + nolev = *nolevm; +#line 4385 "" + } +#line 4386 "" + } + +/* Lower dot for lower-voice notes?. Conditions are: */ +/* 1. Dotted time value */ +/* 2. Lower voice of two */ +/* 3. Note is on a line */ +/* 4. Not a rest (cannot be a rest in a chord!) */ +/* . 5. Flag (lowdot) is set to true */ + +#line 4395 "" + if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) { +#line 4396 "" + i__2 = log2_(nodu); +#line 4396 "" + if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) { +#line 4397 "" + if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { + +/* Note already in movdot list. Drop by 2. */ + +#line 4401 "" + i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, & + c__0) - 20; +#line 4401 "" + setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, & + i__2); +#line 4403 "" + } else { + +/* Not in list so just move it right now */ + +#line 4407 "" + i__2 = igetbits_(islur, &c__1, &c__3); +#line 4407 "" + dotmov_(&c_b761, &c_b762, soutq, lsout, &i__2, (ftnlen)80) + ; +#line 4408 "" + } +#line 4409 "" + } +#line 4410 "" + } +#line 4411 "" + if (bit_test(comtrill_1.icrdat[icrd - 1],26)) { + +/* Move the dot. */ + +#line 4415 "" + updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f; +#line 4416 "" + rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen) + -7)) - 64) * .1f; +#line 4417 "" + i__2 = igetbits_(islur, &c__1, &c__3); +#line 4417 "" + dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80); +#line 4418 "" + } +#line 4419 "" + isleft = bit_test(comtrill_1.icrdat[icrd - 1],23); +#line 4420 "" + isright = bit_test(comtrill_1.icrdat[icrd - 1],24); + +/* Check for ornament in chord. */ + +#line 4424 "" + if (comtrill_1.icrdorn[icrd - 1] > 0) { +#line 4425 "" + 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 4433 "" + addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 4434 "" + } + +/* Chord-note symbol. First check for breve */ + +#line 4438 "" + if (*nodu == 128) { +/* Writing concatenation */ +#line 4439 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4439 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4439 "" + i__3[1] = 6, a__1[1] = "zbreve"; +#line 4439 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4440 "" + lsym = 7; +#line 4441 "" + } else { + +/* Not a breve chord. Get first letters in chord-note symbol */ + +#line 4445 "" + if (isleft) { +/* Writing concatenation */ +#line 4446 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4446 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4446 "" + i__3[1] = 1, a__1[1] = "l"; +#line 4446 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4447 "" + } else if (isright) { +/* Writing concatenation */ +#line 4448 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4448 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4448 "" + i__3[1] = 1, a__1[1] = "r"; +#line 4448 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4449 "" + } else { +/* Writing concatenation */ +#line 4450 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4450 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4450 "" + i__3[1] = 1, a__1[1] = "z"; +#line 4450 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4451 "" + } +#line 4452 "" + if (*nodu >= 64) { +/* Writing concatenation */ +#line 4453 "" + i__3[0] = 2, a__1[0] = nosymq; +#line 4453 "" + i__3[1] = 1, a__1[1] = "w"; +#line 4453 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4454 "" + } else if (*nodu >= 32) { +/* Writing concatenation */ +#line 4455 "" + i__3[0] = 2, a__1[0] = nosymq; +#line 4455 "" + i__3[1] = 1, a__1[1] = "h"; +#line 4455 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4456 "" + } else { +/* Writing concatenation */ +#line 4457 "" + i__3[0] = 2, a__1[0] = nosymq; +#line 4457 "" + i__3[1] = 1, a__1[1] = "q"; +#line 4457 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4458 "" + } +#line 4459 "" + i__2 = log2_(nodu); +#line 4459 "" + if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) { +#line 4460 "" + lsym = 3; +#line 4461 "" + } else if (! bit_test(*islur,3) || *dotxtup) { + +/* Single dot */ + +/* Writing concatenation */ +#line 4465 "" + i__3[0] = 3, a__1[0] = nosymq; +#line 4465 "" + i__3[1] = 1, a__1[1] = "p"; +#line 4465 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4466 "" + lsym = 4; +#line 4467 "" + } else { + +/* Double dot */ + +/* Writing concatenation */ +#line 4471 "" + i__3[0] = 3, a__1[0] = nosymq; +#line 4471 "" + i__3[1] = 2, a__1[1] = "pp"; +#line 4471 "" + s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7); +#line 4472 "" + lsym = 5; +#line 4473 "" + } +#line 4474 "" + } +#line 4475 "" + 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 4479 "" + nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); + +/* Kluge for bigness. Only means 'As' has not been issued */ + +#line 4483 "" + if (spfacs_1.bacfac != 1e6f) { +#line 4483 "" + nactmp += 8; +#line 4483 "" + } +#line 4484 "" + i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) - + 107; +#line 4484 "" + i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14); +#line 4484 "" + i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12); +#line 4484 "" + i__6 = ncmid_(iv, ip); +#line 4484 "" + L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31); +#line 4484 "" + 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 4491 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4491 "" + i__3[1] = 7, a__1[1] = nosymq; +#line 4491 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4492 "" + commidi_1.crdacc = TRUE_; +#line 4493 "" + } else { +#line 4494 "" + s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7); +#line 4495 "" + } +#line 4496 "" + lnote += lsym; + +/* Get note name (again if accid, due to possible octave jump) */ + +#line 4500 "" + notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8); +#line 4501 "" + if (lnoten == 1) { +#line 4501 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 4501 "" + } + +/* Put in note name */ + +/* Writing concatenation */ +#line 4505 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4505 "" + i__3[1] = 8, a__1[1] = noteq; +#line 4505 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4506 "" + lnote += lnoten; +#line 4507 "" + if (bit_test(comtrill_1.icrdat[icrd - 1],25)) { + +/* Arpeggio signal */ + +/* call putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) */ +#line 4512 "" + s_wsle(&io___345); +#line 4512 "" + do_lio(&c__9, &c__1, "Calling putarp chord, iv,ivx:", (ftnlen)29); +#line 4512 "" + do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof(integer)); +#line 4512 "" + do_lio(&c__3, &c__1, (char *)&(*ivx), (ftnlen)sizeof(integer)); +#line 4512 "" + e_wsle(); +#line 4513 "" + putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80); +#line 4514 "" + } +#line 4515 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 4516 "" + if (commidi_1.ismidi) { + +/* Here is where we collect MIDI pitch info for the chord note. By checking */ +/* notmain, addmidi(...) knows to just compute the */ +/* 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 4523 "" + kv = 1; +#line 4524 "" + if (*ivx > *iv) { +#line 4524 "" + kv = 2; +#line 4524 "" + } +#line 4525 "" + ++commidi_1.nmidcrd; +#line 4526 "" + if (commidi_1.nmidcrd > 20) { +#line 4527 "" + s_wsle(&io___347); +#line 4527 "" + e_wsle(); +#line 4528 "" + s_wsle(&io___348); +#line 4528 "" + do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"\ + "ocessor", (ftnlen)45); +#line 4528 "" + e_wsle(); +#line 4529 "" + stop1_(); +#line 4530 "" + } + +/* Use original saved pitch level, unaltered by 2nds logic. */ + +/* 130316 */ +/* call addmidi(midchan(iv,kv),nolevo-iTransAmt(instno(iv)), */ +#line 4536 "" + i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1] + - 1]; +#line 4536 "" + i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20); +#line 4536 "" + addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, & + commidisig_1.midisig, &c_b814, &c_false, &c_false); +/* * igetbits(icrdat(icrd),3,20),isig,1.,.false.,.false.) */ +/* 130316 */ +/* * igetbits(icrdat(icrd),3,20),midisig(instno(iv)),1., */ +#line 4544 "" + } +#line 4545 "" +/* L5: */ +#line 4545 "" + } +#line 4546 "" + commidi_1.notmain = FALSE_; +#line 4547 "" + return 0; +} /* docrd_ */ + +/* Subroutine */ int dodyn_(integer *ivx, integer *ip, integer *nolev, + integer *ncm, integer *ipl, integer *islur, integer *irest, integer * + nvmx, integer *nv, logical *beamon, integer *ihornb, integer *nornb, + char *ulq, integer *ibmcnt, logical *nostem, char *soutq, integer * + lsout, ftnlen ulq_len, ftnlen soutq_len) +{ + /* Initialized data */ + + static char dyntablq[48] = "ppppppp pp p mp mf f fp sfz ff fff " + "ffff"; + + /* System generated locals */ + address a__1[2], a__2[4], a__3[3], a__4[6]; + integer i__1, i__2, i__3[2], i__4[4], i__5, i__6[3], i__7[6]; + char ch__1[1], ch__2[6], ch__3[81], ch__4[53]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + extern /* Subroutine */ int backfill_(integer *, char *, integer *, char * + , integer *, ftnlen, ftnlen); + static integer jtxtdyn1; + extern integer igetbits_(integer *, integer *, integer *); + static integer lpretweak, id; + static real hoff; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer idno, lbot, idyn, jdyn; + extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *, + integer *, integer *, integer *, integer *); + static integer lbot1; + extern integer lfmt1_(real *); + extern /* Subroutine */ int stop1_(void); + static integer idynd, lform, idynn[10], lnote, ltemp; + static char tempq[48]; + static integer ivxip; + static char numpq[5]; + static integer idynd2; + static real hoffsd; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer iptent; + extern integer lenstr_(char *, integer *, ftnlen); + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer numdyn; + static logical upstem; + static char notexq[79]; + static integer lnumpq, icntdyn, ivxtent; + static char dynstrq[4]; + static integer jtxtdyn, ltxtdyn; + + /* Fortran I/O blocks */ + static icilist io___369 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___371 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___372 = { 0, numpq+1, 0, "(i3)", 3, 1 }; + static icilist io___379 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___380 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + static icilist io___381 = { 0, numpq+1, 0, "(i3)", 3, 1 }; + static cilist io___384 = { 0, 11, 0, "(a)", 0 }; + + + +/* Inputs are array *elements* except ihornb,nornb,ulq */ + +#line 4574 "" + /* Parameter adjustments */ +#line 4574 "" + ulq -= 25; +#line 4574 "" + --nornb; +#line 4574 "" + ihornb -= 25; +#line 4574 "" + +#line 4574 "" + /* Function Body */ +#line 4575 "" + numdyn = 0; + +/* Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values */ +/* in idynn(1...4) */ + +#line 4580 "" + i__1 = comdyn_1.ndyn; +#line 4580 "" + for (idyn = 1; idyn <= i__1; ++idyn) { +/* ivxtent = iand(idyndat(idyn),15) */ +#line 4582 "" + ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(& + comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4); +#line 4584 "" + if (ivxtent == *ivx) { +#line 4585 "" + iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4); +#line 4586 "" + if (iptent == *ip) { +#line 4587 "" + ++numdyn; +#line 4588 "" + idynn[numdyn - 1] = idyn; +#line 4589 "" + } else if (iptent > *ip) { + +/* I don't think there are any more possible for this ivx,ip, so exit loop */ + +#line 4593 "" + goto L2; +#line 4594 "" + } +/* else if (ivxtent .gt. ivx) then */ +/* go to 2 */ +#line 4597 "" + } +#line 4598 "" +/* L1: */ +#line 4598 "" + } +#line 4599 "" +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 4604 "" + hoffsd = 0.f; + +/* Set upstem to false as default */ + +#line 4608 "" + upstem = FALSE_; +#line 4609 "" + if (bit_test(*irest,0)) { + +/* It's a rest. Assume it doesn't go below the staff */ + +#line 4613 "" + lbot = *ncm - 4; +#line 4614 "" + } else if (! (*beamon)) { +#line 4615 "" + udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv); +#line 4615 "" + if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) { +#line 4616 "" + upstem = TRUE_; +#line 4617 "" + if (! bit_test(*ipl,10)) { +/* Computing MIN */ +#line 4618 "" + i__1 = *nolev - 1, i__2 = *ncm - 4; +#line 4618 "" + lbot = min(i__1,i__2); +#line 4619 "" + } else { +/* Computing MIN */ +#line 4620 "" + i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; +#line 4620 "" + lbot = min(i__1,i__2); +#line 4621 "" + } +#line 4622 "" + } else { +#line 4623 "" + hoffsd = -.5f; +#line 4624 "" + if (! bit_test(*ipl,10)) { +/* Computing MIN */ +#line 4625 "" + i__1 = *nolev - 7, i__2 = *ncm - 4; +#line 4625 "" + lbot = min(i__1,i__2); +#line 4626 "" + } else { +/* Computing MIN */ +#line 4627 "" + i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4; +#line 4627 "" + lbot = min(i__1,i__2); +#line 4628 "" + } +#line 4629 "" + } +#line 4630 "" + } else { +#line 4631 "" + if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { +#line 4632 "" + upstem = TRUE_; +#line 4633 "" + if (! bit_test(*ipl,10)) { +/* Computing MIN */ +#line 4634 "" + i__1 = *nolev - 1, i__2 = *ncm - 4; +#line 4634 "" + lbot = min(i__1,i__2); +#line 4635 "" + } else { +/* Computing MIN */ +#line 4636 "" + i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4; +#line 4636 "" + lbot = min(i__1,i__2); +#line 4637 "" + } +#line 4638 "" + } else { +#line 4639 "" + hoffsd = -.5f; +#line 4640 "" + lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1; +#line 4641 "" + if (lbot == 1) { + +/* Kluge for non-beamed, down xtup, for which ihorb was never set. */ +/* Assumes stem is shortened. */ + +#line 4646 "" + lbot = *nolev - 5; +#line 4647 "" + } +#line 4648 "" + ++nornb[*ivx]; +#line 4649 "" + } +#line 4650 "" + } +#line 4651 "" + lbot += -5; +#line 4652 "" + jtxtdyn1 = 1; + +/* Now ready to loop over current dyn's */ + +#line 4656 "" + i__1 = numdyn; +#line 4656 "" + for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) { +#line 4657 "" + idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1]; +#line 4658 "" + idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1]; +#line 4659 "" + idno = igetbits_(&idynd, &c__4, &c__12); +/* ivx = iand(15,idynd) */ +#line 4661 "" + *ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4); + +/* Build the command into notex in stages. Insert name & rq'd args in order: */ + +/* Command name */ +/* hpstrt, hpcend, hpdend, pmxdyn */ +/* ivx */ +/* X X X */ +/* level */ +/* X X X */ +/* hoff */ +/* X X X X */ +/* d-mark */ +/* X */ + +#line 4676 "" + if (idno == 0) { + +/* Text-dynamic */ + +/* Writing concatenation */ +#line 4680 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4680 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4680 "" + i__3[1] = 6, a__1[1] = "txtdyn"; +#line 4680 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4681 "" + lnote = 7; +#line 4682 "" + } else if (idno <= 12) { + +/* Letter-group */ + +/* Writing concatenation */ +#line 4686 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4686 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4686 "" + i__3[1] = 6, a__1[1] = "pmxdyn"; +#line 4686 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4687 "" + lnote = 7; +#line 4688 "" + } else if (comslur_1.fontslur) { +#line 4689 "" + lnote = 7; +#line 4690 "" + if (idno == 13) { + +/* Start a hairpin */ + +/* Writing concatenation */ +#line 4694 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4694 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4694 "" + i__3[1] = 6, a__1[1] = "hpstrt"; +#line 4694 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4695 "" + } else if (idno == 14) { + +/* End crescendo */ + +/* Writing concatenation */ +#line 4699 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4699 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4699 "" + i__3[1] = 6, a__1[1] = "hpcend"; +#line 4699 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4700 "" + } else { + +/* End decrescendo */ + +/* Writing concatenation */ +#line 4704 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4704 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4704 "" + i__3[1] = 6, a__1[1] = "hpdend"; +#line 4704 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4705 "" + } +#line 4706 "" + } else { + +/* Postscript hairpins */ + +#line 4710 "" + lnote = 7; +#line 4711 "" + if (idno == 13) { +/* Writing concatenation */ +#line 4712 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4712 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4712 "" + i__3[1] = 6, a__1[1] = "Icresc"; +#line 4712 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4713 "" + } else if (idno == 14) { +/* Writing concatenation */ +#line 4714 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4714 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4714 "" + i__3[1] = 8, a__1[1] = "Idecresc"; +#line 4714 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4715 "" + lnote = 9; +#line 4716 "" + } else { +/* Writing concatenation */ +#line 4717 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4717 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 4717 "" + i__3[1] = 6, a__1[1] = "Tcresc"; +#line 4717 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4718 "" + } +#line 4719 "" + } +#line 4720 "" + if (idno >= 13) { + +/* Put in voice number */ + +#line 4724 "" + if (*ivx <= 9) { +/* Writing concatenation */ +#line 4725 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4725 "" + *(unsigned char *)&ch__1[0] = *ivx + 48; +#line 4725 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 4725 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4726 "" + ++lnote; +#line 4727 "" + } else if (*ivx <= 19) { +/* Writing concatenation */ +#line 4728 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 4728 "" + i__4[1] = 2, a__2[1] = "{1"; +#line 4728 "" + *(unsigned char *)&ch__1[0] = *ivx + 38; +#line 4728 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 4728 "" + i__4[3] = 1, a__2[3] = "}"; +#line 4728 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 4729 "" + lnote += 4; +#line 4730 "" + } else { +/* Writing concatenation */ +#line 4731 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 4731 "" + i__4[1] = 2, a__2[1] = "{2"; +#line 4731 "" + *(unsigned char *)&ch__1[0] = *ivx + 28; +#line 4731 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 4731 "" + i__4[3] = 1, a__2[3] = "}"; +#line 4731 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 4732 "" + lnote += 4; +#line 4733 "" + } +#line 4734 "" + } + +/* Begin setting level */ + +#line 4738 "" + lbot1 = lbot; +#line 4739 "" + if (idno > 0 && idno <= 5) { + +/* All letters are short so raise a bit. */ + +#line 4743 "" + ++lbot1; +#line 4744 "" + } else if (idno >= 13) { +#line 4745 "" + lbot1 += 2; +#line 4746 "" + } + +/* Convert so reference is bottom line */ + +#line 4750 "" + lbot1 = lbot1 - *ncm + 4; +#line 4751 "" + 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 4756 "" + comdyn_1.levdsav[*ivx - 1] = lbot1; +#line 4757 "" + comdyn_1.levhssav[*ivx - 1] = 0; +#line 4758 "" + if (bit_test(idynd,16)) { +#line 4758 "" + comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17) + - 64; +#line 4758 "" + } +#line 4759 "" + } else if (comslur_1.fontslur && idno >= 14 || idno == 15) { + +/* Hairpin end; Compare level with saved start level before user-tweaks */ + +/* Computing MIN */ +#line 4763 "" + i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1]; +#line 4763 "" + lbot1 = min(i__2,i__5); + +/* Save pre-tweak level */ + +#line 4767 "" + lpretweak = lbot1; +#line 4768 "" + } + +/* Check for user-defined vertical tweak */ + +#line 4772 "" + if (bit_test(idynd,16)) { +#line 4772 "" + lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17); +#line 4772 "" + } + +/* Now horizontal stuff */ + +#line 4776 "" + hoff = hoffsd; + +/* Some special horizontal tweaks */ + +#line 4780 "" + if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) { +#line 4780 "" + hoff += .4f; +#line 4780 "" + } + +/* User-defined tweaks */ + +#line 4785 "" + if (bit_test(idynd2,0)) { +#line 4785 "" + hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f; +#line 4785 "" + } +#line 4787 "" + if (numdyn > 1) { + +/* Horizontal-interaction-based tweaks. */ + +/* Cases: */ +/* numdyn type1 type2 type3 data used */ +/* 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12) */ +/* 2 hrpnend wrd-grp - ivowg,hoh2 */ +/* 2 hrpnend hrpnstrt - hoh2h1(1...2) */ +/* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */ + +#line 4798 "" + if (idno > 0 && idno <= 12) { + +/* Word-group, may need vertical tweak to line up. */ + +#line 4802 "" + lbot1 += comdyn_1.ivowg[idno - 1]; + +/* Protecting against hp start-stop on same note */ + +#line 4806 "" + } else if ((comslur_1.fontslur && idno >= 14 || idno == 15) && + icntdyn < numdyn) { + +/* Hairpin ending, check next type */ + +#line 4811 "" + if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ + icntdyn] - 1], &c__4, &c__12) == 13 || ! + comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[ + idynn[icntdyn] - 1], &c__4, &c__12) == 13 || + igetbits_(&comdyn_1.idyndat[idynn[icntdyn] - 1], & + c__4, &c__12) == 14)) { + +/* Hairpin end then hairpin start, no words, (remember dealing with end now) */ + +#line 4821 "" + hoff += comdyn_1.hoh2h1[0]; +#line 4822 "" + } else { + +/* Hairpin end then word-group, need idno for w-g to set hp offset */ + +#line 4826 "" + hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[ + icntdyn] - 1], &c__4, &c__12) - 1]; +#line 4828 "" + } + +/* Protecting against hp start-stop on same note */ + +#line 4832 "" + } else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno + < 14 || ! comslur_1.fontslur && idno < 15)) { + +/* Hairpin start, check prior type */ + +#line 4838 "" + if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[ + icntdyn - 2] - 1], &c__4, &c__12) >= 14 || ! + comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[ + idynn[icntdyn - 2] - 1], &c__4, &c__12) == 15) { + +/* Hairpin end then hairpin start, (remember dealing with start now) */ + +#line 4847 "" + hoff += comdyn_1.hoh2h1[1]; +#line 4848 "" + } else { + +/* Hairpin start after word-group, need idno for w-g to set hp offset */ + +#line 4852 "" + hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[ + icntdyn - 2] - 1], &c__4, &c__12) - 1]; +#line 4854 "" + } +#line 4855 "" + } +#line 4856 "" + } + +/* End of if-block for 2- or 3-way interactions. */ + +#line 4860 "" + if (! comslur_1.fontslur && idno >= 13) { +#line 4860 "" + hoff = (hoff + .5f) * 6.f / 2.5f; +#line 4860 "" + } + +/* Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */ + + +/* Position corrections all done now. Put in the level. */ + +#line 4868 "" + if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno + == 13 || idno == 14)) { + +/* Hairpin start. */ + +#line 4873 "" + if (! comslur_1.fontslur) { + +/* Postscript hairpin start...inset placeholder for start level. */ +/* Writing concatenation */ +#line 4877 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4877 "" + i__3[1] = 5, a__1[1] = "{ }"; +#line 4877 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4878 "" + lnote += 5; +#line 4879 "" + } +#line 4880 "" + } else { + +/* Insert actual level in all cases except hairpin start */ +/* Create string with level in it */ + +#line 4885 "" + if (lbot1 > 9) { +#line 4886 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 4887 "" + s_wsfi(&io___369); +#line 4887 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 4887 "" + e_wsfi(); +/* Writing concatenation */ +#line 4888 "" + i__3[0] = 3, a__1[0] = numpq; +#line 4888 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4888 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 4889 "" + lnumpq = 4; +#line 4890 "" + } else if (lbot1 > -1) { +#line 4891 "" + *(unsigned char *)&ch__1[0] = lbot1 + 48; +#line 4891 "" + s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); +#line 4892 "" + lnumpq = 1; +#line 4893 "" + } else if (lbot1 > -10) { +#line 4894 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 4895 "" + s_wsfi(&io___371); +#line 4895 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 4895 "" + e_wsfi(); +/* Writing concatenation */ +#line 4896 "" + i__3[0] = 3, a__1[0] = numpq; +#line 4896 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4896 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 4897 "" + lnumpq = 4; +#line 4898 "" + } else { +#line 4899 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 4900 "" + s_wsfi(&io___372); +#line 4900 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 4900 "" + e_wsfi(); +/* Writing concatenation */ +#line 4901 "" + i__3[0] = 4, a__1[0] = numpq; +#line 4901 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4901 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 4902 "" + lnumpq = 5; +#line 4903 "" + } + +/* Level has now been computed and stored in numpq */ +/* Append the level */ + +/* Writing concatenation */ +#line 4908 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4908 "" + i__3[1] = lnumpq, a__1[1] = numpq; +#line 4908 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4909 "" + lnote += lnumpq; +#line 4910 "" + } +#line 4911 "" + if (dabs(hoff) < .001f) { + +/* No horiz offset */ + +/* Writing concatenation */ +#line 4915 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4915 "" + i__3[1] = 1, a__1[1] = "0"; +#line 4915 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4916 "" + ++lnote; +#line 4917 "" + } else { + +/* Horizontal tweak */ + +#line 4921 "" + lform = lfmt1_(&hoff); +/* Writing concatenation */ +#line 4922 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4922 "" + i__3[1] = 1, a__1[1] = "{"; +#line 4922 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4923 "" + ++lnote; +#line 4924 "" + i__2 = lnote; +#line 4924 "" + ici__1.icierr = 0; +#line 4924 "" + ici__1.icirnum = 1; +#line 4924 "" + ici__1.icirlen = lnote + lform - i__2; +#line 4924 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 4924 "" + i__6[0] = 2, a__3[0] = "(f"; +#line 4924 "" + i__5 = lform + 48; +#line 4924 "" + chax_(ch__1, (ftnlen)1, &i__5); +#line 4924 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 4924 "" + i__6[2] = 3, a__3[2] = ".1)"; +#line 4924 "" + ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6), + ch__2); +#line 4924 "" + s_wsfi(&ici__1); +#line 4924 "" + do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real)); +#line 4924 "" + e_wsfi(); +#line 4926 "" + lnote += lform; +/* Writing concatenation */ +#line 4927 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 4927 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4927 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 4928 "" + ++lnote; +#line 4929 "" + } +#line 4930 "" + if (idno == 0) { + +/* text-dynamic. Find the string and append it */ + +#line 4934 "" + i__2 = comdyn_1.ntxtdyn; +#line 4934 "" + for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) { +/* ivxip = ivx+16*ip */ +#line 4936 "" + ivxip = *ivx + (*ip << 5); +#line 4937 "" + if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) { +#line 4937 "" + goto L5; +#line 4937 "" + } +#line 4938 "" +/* L4: */ +#line 4938 "" + } +#line 4939 "" + printl_("Abnormal stop in putdyn", (ftnlen)23); +#line 4940 "" + stop1_(); +#line 4941 "" +L5: +#line 4942 "" + ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128, + (ftnlen)128); + +/* Font size based on musicsize */ + +#line 4946 "" + if (commus_1.musize == 20) { +/* Writing concatenation */ +#line 4947 "" + i__7[0] = lnote, a__4[0] = notexq; +#line 4947 "" + i__7[1] = 1, a__4[1] = "{"; +#line 4947 "" + i__7[2] = 1, a__4[2] = "\\"; +#line 4947 "" + i__7[3] = 7, a__4[3] = "medtype"; +#line 4947 "" + i__7[4] = 1, a__4[4] = "\\"; +#line 4947 "" + i__7[5] = 3, a__4[5] = "it "; +#line 4947 "" + s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79); +#line 4949 "" + lnote += 13; +#line 4950 "" + } else if (commus_1.musize == 16) { +/* Writing concatenation */ +#line 4951 "" + i__7[0] = lnote, a__4[0] = notexq; +#line 4951 "" + i__7[1] = 1, a__4[1] = "{"; +#line 4951 "" + i__7[2] = 1, a__4[2] = "\\"; +#line 4951 "" + i__7[3] = 8, a__4[3] = "normtype"; +#line 4951 "" + i__7[4] = 1, a__4[4] = "\\"; +#line 4951 "" + i__7[5] = 3, a__4[5] = "it "; +#line 4951 "" + s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79); +#line 4953 "" + lnote += 14; +#line 4954 "" + } else if (commus_1.musize == 24) { +/* Writing concatenation */ +#line 4955 "" + i__7[0] = lnote, a__4[0] = notexq; +#line 4955 "" + i__7[1] = 1, a__4[1] = "{"; +#line 4955 "" + i__7[2] = 1, a__4[2] = "\\"; +#line 4955 "" + i__7[3] = 7, a__4[3] = "bigtype"; +#line 4955 "" + i__7[4] = 1, a__4[4] = "\\"; +#line 4955 "" + i__7[5] = 3, a__4[5] = "it "; +#line 4955 "" + s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79); +#line 4957 "" + lnote += 13; +#line 4958 "" + } else if (commus_1.musize == 29) { +/* Writing concatenation */ +#line 4959 "" + i__7[0] = lnote, a__4[0] = notexq; +#line 4959 "" + i__7[1] = 1, a__4[1] = "{"; +#line 4959 "" + i__7[2] = 1, a__4[2] = "\\"; +#line 4959 "" + i__7[3] = 7, a__4[3] = "Bigtype"; +#line 4959 "" + i__7[4] = 1, a__4[4] = "\\"; +#line 4959 "" + i__7[5] = 3, a__4[5] = "it "; +#line 4959 "" + s_cat(notexq, a__4, i__7, &c__6, (ftnlen)79); +#line 4961 "" + lnote += 13; +#line 4962 "" + } +/* Writing concatenation */ +#line 4963 "" + i__6[0] = lnote, a__3[0] = notexq; +#line 4963 "" + i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7) + ; +#line 4963 "" + i__6[2] = 1, a__3[2] = "}"; +#line 4963 "" + s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); +#line 4965 "" + lnote = lnote + ltxtdyn + 1; + +/* Reset jtxtdyn1 just in case >1 txtdyn on same note. */ + +#line 4969 "" + jtxtdyn1 = jtxtdyn + 1; +#line 4970 "" + } else if (idno <= 12) { + +/* Letter-group dynamic. Append the letter-group command */ + +#line 4974 "" + id = idno << 2; +#line 4975 "" + i__2 = id - 4; +#line 4975 "" + s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2); +#line 4976 "" + id = lenstr_(dynstrq, &c__4, (ftnlen)4); +/* Writing concatenation */ +#line 4977 "" + i__6[0] = lnote, a__3[0] = notexq; +#line 4977 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 4977 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 4977 "" + i__6[2] = id, a__3[2] = dynstrq; +#line 4977 "" + s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79); +#line 4978 "" + lnote = lnote + 1 + id; +#line 4979 "" + } +#line 4980 "" + addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); +#line 4981 "" + 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 4986 "" + lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1]; +#line 4987 "" + if (lbot1 > 9) { +#line 4988 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 4989 "" + s_wsfi(&io___379); +#line 4989 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 4989 "" + e_wsfi(); +/* Writing concatenation */ +#line 4990 "" + i__3[0] = 3, a__1[0] = numpq; +#line 4990 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4990 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 4991 "" + lnumpq = 4; +#line 4992 "" + } else if (lbot1 > -1) { +#line 4993 "" + *(unsigned char *)&ch__1[0] = lbot1 + 48; +#line 4993 "" + s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1); +#line 4994 "" + lnumpq = 1; +#line 4995 "" + } else if (lbot1 > -10) { +#line 4996 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 4997 "" + s_wsfi(&io___380); +#line 4997 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 4997 "" + e_wsfi(); +/* Writing concatenation */ +#line 4998 "" + i__3[0] = 3, a__1[0] = numpq; +#line 4998 "" + i__3[1] = 1, a__1[1] = "}"; +#line 4998 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 4999 "" + lnumpq = 4; +#line 5000 "" + } else { +#line 5001 "" + s_copy(numpq, "{", (ftnlen)5, (ftnlen)1); +#line 5002 "" + s_wsfi(&io___381); +#line 5002 "" + do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer)); +#line 5002 "" + e_wsfi(); +/* Writing concatenation */ +#line 5003 "" + i__3[0] = 4, a__1[0] = numpq; +#line 5003 "" + i__3[1] = 1, a__1[1] = "}"; +#line 5003 "" + s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5); +#line 5004 "" + lnumpq = 5; +#line 5005 "" + } + +/* Construct string to search backwards for placeholder */ + +#line 5009 "" + if (*ivx <= 9) { +/* Writing concatenation */ +#line 5010 "" + i__6[0] = 5, a__3[0] = "cresc"; +#line 5010 "" + *(unsigned char *)&ch__1[0] = *ivx + 48; +#line 5010 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 5010 "" + i__6[2] = 5, a__3[2] = "{ }"; +#line 5010 "" + s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5011 "" + ltemp = 11; +#line 5012 "" + } else if (*ivx <= 19) { +/* Writing concatenation */ +#line 5013 "" + i__6[0] = 7, a__3[0] = "cresc{1"; +#line 5013 "" + *(unsigned char *)&ch__1[0] = *ivx + 38; +#line 5013 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 5013 "" + i__6[2] = 6, a__3[2] = "}{ }"; +#line 5013 "" + s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5014 "" + ltemp = 14; +#line 5015 "" + } else { +/* Writing concatenation */ +#line 5016 "" + i__6[0] = 7, a__3[0] = "cresc{2"; +#line 5016 "" + *(unsigned char *)&ch__1[0] = *ivx + 28; +#line 5016 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 5016 "" + i__6[2] = 6, a__3[2] = "}{ }"; +#line 5016 "" + s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48); +#line 5017 "" + ltemp = 14; +#line 5018 "" + } +#line 5019 "" + s_wsfe(&io___384); +/* Writing concatenation */ +#line 5019 "" + i__3[0] = *lsout, a__1[0] = soutq; +#line 5019 "" + i__3[1] = 1, a__1[1] = "%"; +#line 5019 "" + s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81); +#line 5019 "" + do_fio(&c__1, ch__3, *lsout + 1); +#line 5019 "" + e_wsfe(); +#line 5020 "" + *lsout = 0; +/* Writing concatenation */ +#line 5021 "" + i__3[0] = ltemp - 5, a__1[0] = tempq; +#line 5021 "" + i__3[1] = lnumpq, a__1[1] = numpq; +#line 5021 "" + s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53); +#line 5021 "" + i__2 = ltemp - 5 + lnumpq; +#line 5021 "" + backfill_(&c__11, tempq, <emp, ch__4, &i__2, (ftnlen)48, ltemp + - 5 + lnumpq); +#line 5023 "" + } +#line 5024 "" +/* L3: */ +#line 5024 "" + } + +/* Shrink arrays, decrease ndyn 111109 */ + +#line 5028 "" + for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) { +#line 5029 "" + i__1 = comdyn_1.ndyn - 1; +#line 5029 "" + for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) { +#line 5030 "" + comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn]; +#line 5031 "" + comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn]; +#line 5032 "" +/* L7: */ +#line 5032 "" + } +#line 5033 "" + --comdyn_1.ndyn; +#line 5034 "" +/* L6: */ +#line 5034 "" + } +#line 5035 "" + return 0; +} /* dodyn_ */ + +/* Subroutine */ int dograce_(integer *ivx, integer *ip, real *ptgr, char * + soutq, integer *lsout, integer *ncm, integer *nacc, integer *ig, + integer *ipl, logical *farend, logical *beamon, integer *nolev, + integer *ncmidx, integer *islur, integer *nvmx, integer *nv, integer * + ibmcnt, real *tnote, char *ulq, integer *instno, ftnlen soutq_len, + ftnlen ulq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3], a__3[4]; + integer i__1, i__2[2], i__3[3], i__4[4], i__5, i__6; + real r__1; + char ch__1[1], ch__2[6], ch__3[2], ch__4[5], ch__5[11], ch__6[7], ch__7[4] + , ch__8[87], ch__9[15], ch__10[16], ch__11[9], ch__12[12], ch__13[ + 21], ch__14[20], ch__15[19], ch__16[24], ch__17[13], ch__18[82], + ch__19[3], ch__20[10]; + icilist ici__1; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer i_nint(real *), s_wsfi(icilist *), e_wsfi(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer i_sign(integer *, integer *); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static integer lnotenga; + extern integer igetbits_(integer *, integer *, integer *); + static integer i__; + static real x, y, em; + static integer mg; + static char sq[1]; + static real finalshift; + static integer ing, ngs; + extern integer log2_(integer *); + static integer lacc; + static real beta; + extern /* Character */ VOID chax_(char *, ftnlen, integer *), udqq_(char * + , ftnlen, integer *, integer *, integer *, integer *, integer *, + integer *); + static real sumx, sumy; + extern /* Subroutine */ int stop1_(void); + static real delta, ptoff; + static integer lnote; + static char noteq[8]; + static real sumxx, sumxy, sumyy; + static integer nolev1; + static logical isgaft; + extern /* Subroutine */ int accsym_(integer *, char *, integer *, ftnlen), + addstr_(char *, integer *, char *, integer *, ftnlen, ftnlen); + static logical iswaft; + static char acsymq[3]; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten, itrans, niptgr, islope; + static logical stemup, normsp; + static char notexq[79], noteqga[8]; + static real wheadpt1; + + /* Fortran I/O blocks */ + static cilist io___390 = { 0, 6, 0, 0, 0 }; + static cilist io___394 = { 0, 6, 0, 0, 0 }; + static cilist io___395 = { 0, 6, 0, 0, 0 }; + static cilist io___396 = { 0, 15, 0, "(/,a)", 0 }; + static icilist io___399 = { 0, notexq, 0, "(i2)", 2, 1 }; + static cilist io___400 = { 0, 6, 0, 0, 0 }; + static icilist io___424 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 }; + static icilist io___426 = { 0, notexq+13, 0, "(f4.1)", 4, 1 }; + static icilist io___428 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; + + + +/* ip will be one LESS than current note, for way-after's before bar-end, */ +/* It is only used to find ig. */ +/* ig is returned to makeabar in case there's a slur that needs to be ended */ + +#line 5074 "" + /* Parameter adjustments */ +#line 5074 "" + ulq -= 25; +#line 5074 "" + --ptgr; +#line 5074 "" + +#line 5074 "" + /* Function Body */ +#line 5074 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5074 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 5075 "" + isgaft = bit_test(*ipl,29); +#line 5076 "" + iswaft = bit_test(*ipl,31); +#line 5077 "" + normsp = ! isgaft; + +/* Find ig. */ + +#line 5081 "" + i__1 = comgrace_1.ngrace; +#line 5081 "" + for (*ig = 1; *ig <= i__1; ++(*ig)) { +#line 5082 "" + if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx) + { +#line 5082 "" + goto L121; +#line 5082 "" + } +#line 5083 "" +/* L120: */ +#line 5083 "" + } +#line 5084 "" + s_wsle(&io___390); +#line 5084 "" + do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38) + ; +#line 5084 "" + e_wsle(); +#line 5085 "" + s_stop("", (ftnlen)0); +#line 5086 "" +L121: +#line 5087 "" + ngs = comgrace_1.ngstrt[*ig - 1]; +#line 5088 "" + mg = comgrace_1.multg[*ig - 1]; +/* wheadpt1 = wheadpt*fullsize(ivx) */ +#line 5090 "" + wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1]; + +/* For way-after-graces at end of bar, must set the octave. */ + +#line 5094 "" + if (*farend) { +#line 5095 "" + comoct_1.noctup = 0; +#line 5096 "" + if (*ncm == 23) { +#line 5096 "" + comoct_1.noctup = -2; +#line 5096 "" + } +#line 5097 "" + } +#line 5098 "" + if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) { +#line 5099 "" + if (comslur_1.listslur == 16777215) { +#line 5100 "" + s_wsle(&io___394); +#line 5100 "" + e_wsle(); +#line 5101 "" + s_wsle(&io___395); +#line 5101 "" + do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "\ + "many!", (ftnlen)47); +#line 5101 "" + e_wsle(); +#line 5102 "" + s_wsfe(&io___396); +#line 5102 "" + do_fio(&c__1, "You defined the twentyfifth slur, one too many!", ( + ftnlen)47); +#line 5102 "" + e_wsfe(); +#line 5104 "" + stop1_(); +#line 5105 "" + } + +/* Slur on fore-grace. Get index of next slur not in use, from 23 down. */ + +#line 5109 "" + i__1 = 16777215 - comslur_1.listslur; +#line 5109 "" + comslur_1.ndxslur = log2_(&i__1); +#line 5111 "" + } +#line 5112 "" + if (comgrace_1.nng[*ig - 1] == 1) { + +/* Single grace. */ + +#line 5116 "" + if (normsp) { + +/* Anything but GA */ + +/* Writing concatenation */ +#line 5120 "" + i__2[0] = 1, a__1[0] = sq; +#line 5120 "" + i__2[1] = 5, a__1[1] = "shlft"; +#line 5120 "" + s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 5120 "" + addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80); +#line 5121 "" + niptgr = i_nint(&ptgr[*ig]); + +/* Empirical tweak for postscript. */ + +/* if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */ +/* ++ */ +#line 5127 "" + if (niptgr < 10) { +/* Writing concatenation */ +#line 5128 "" + i__1 = niptgr + 48; +#line 5128 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5128 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 5128 "" + i__2[1] = 1, a__1[1] = "{"; +#line 5128 "" + s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2); +#line 5128 "" + addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); +#line 5129 "" + } else if (niptgr < 100) { +#line 5130 "" + s_wsfi(&io___399); +#line 5130 "" + do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer)); +#line 5130 "" + e_wsfi(); +/* Writing concatenation */ +#line 5131 "" + i__3[0] = 1, a__2[0] = "{"; +#line 5131 "" + i__3[1] = 2, a__2[1] = notexq; +#line 5131 "" + i__3[2] = 2, a__2[2] = "}{"; +#line 5131 "" + s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5); +#line 5131 "" + addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); +#line 5132 "" + } else { +#line 5133 "" + s_wsle(&io___400); +#line 5133 "" + do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "\ + "note group > 99 pt", (ftnlen)56); +#line 5133 "" + e_wsle(); +#line 5135 "" + s_stop("", (ftnlen)0); +#line 5136 "" + } +#line 5137 "" + } else { +/* Writing concatenation */ +#line 5138 "" + i__2[0] = 1, a__1[0] = sq; +#line 5138 "" + i__2[1] = 10, a__1[1] = "gaft{1.5}{"; +#line 5138 "" + s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); +#line 5138 "" + addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); + +/* GA. Compute aftshft, for later use. */ + +#line 5142 "" + comgrace_1.aftshft = spfacs_1.grafac; +#line 5143 "" + if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { +#line 5143 "" + comgrace_1.aftshft += spfacs_1.agc1fac; +#line 5143 "" + } +#line 5144 "" + comgrace_1.aftshft *= comask_1.wheadpt; +#line 5145 "" + } +#line 5146 "" + if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { + +/* Start slur on pre-grace. No accounting needed since will be ended very soon. */ + +#line 5150 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) + 8); +#line 5151 "" + if (comslur_1.fontslur) { +#line 5152 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5153 "" + i__2[0] = 1, a__1[0] = sq; +#line 5153 "" + i__2[1] = 6, a__1[1] = "islurd"; +#line 5153 "" + s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5153 "" + addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) + ; +#line 5154 "" + } else { +/* Writing concatenation */ +#line 5155 "" + i__2[0] = 1, a__1[0] = sq; +#line 5155 "" + i__2[1] = 6, a__1[1] = "isluru"; +#line 5155 "" + s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5155 "" + addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) + ; +#line 5156 "" + } +#line 5157 "" + } else { + +/* Start Postscript slur. */ + +#line 5161 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5162 "" + i__2[0] = 1, a__1[0] = sq; +#line 5162 "" + i__2[1] = 3, a__1[1] = "isd"; +#line 5162 "" + s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5162 "" + addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) + ; +#line 5163 "" + } else { +/* Writing concatenation */ +#line 5164 "" + i__2[0] = 1, a__1[0] = sq; +#line 5164 "" + i__2[1] = 3, a__1[1] = "isu"; +#line 5164 "" + s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5164 "" + addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) + ; +#line 5165 "" + } +#line 5166 "" + } + +/* Print slur number, 23-ndxslur */ + +#line 5170 "" + lnote = 0; +#line 5171 "" + if (23 - comslur_1.ndxslur < 10) { +/* notexq = notexq(1:lnote)//chax(59-ndxslur) */ +#line 5173 "" + i__1 = 71 - comslur_1.ndxslur; +#line 5173 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5173 "" + s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); +#line 5174 "" + lnote = 1; +#line 5175 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ +/* Writing concatenation */ +#line 5177 "" + i__3[0] = 2, a__2[0] = "{1"; +#line 5177 "" + i__1 = 61 - comslur_1.ndxslur; +#line 5177 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5177 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 5177 "" + i__3[2] = 1, a__2[2] = "}"; +#line 5177 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 5178 "" + lnote = 4; +#line 5179 "" + } else { +/* Writing concatenation */ +#line 5180 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 5180 "" + i__4[1] = 2, a__3[1] = "{2"; +#line 5180 "" + i__1 = 51 - comslur_1.ndxslur; +#line 5180 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5180 "" + i__4[2] = 1, a__3[2] = ch__1; +#line 5180 "" + i__4[3] = 1, a__3[3] = "}"; +#line 5180 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 5181 "" + lnote = 4; +#line 5182 "" + } +/* 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 5190 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 5190 "" + i__2[1] = lnoten, a__1[1] = noteq; +#line 5190 "" + s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); +#line 5190 "" + i__1 = lnote + lnoten; +#line 5190 "" + addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80); +#line 5192 "" + if (! comslur_1.fontslur) { + +/* Horizontal tweaks for postscript slur on single grace */ + +#line 5196 "" + stemup = TRUE_; +#line 5197 "" + if (comgrace_1.upg[*ig - 1]) { + +/* Check for up-grace + down stem. Get stem direction */ + +#line 5201 "" + if (! (*beamon)) { + +/* Separate note. Get stem direction. */ + +#line 5205 "" + udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx, + ivx, nv); +#line 5205 "" + stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 5207 "" + } else { + +/* In a beam */ + +#line 5211 "" + stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24] + == 'u'; +#line 5212 "" + } + +/* Stop the shift if whole note */ + +#line 5216 "" + stemup = stemup || *tnote > 63.f; +#line 5217 "" + } +#line 5218 "" + if (stemup) { +#line 5219 "" + addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) + 80); +#line 5220 "" + } else { +#line 5221 "" + addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen) + 80); +#line 5222 "" + } +#line 5223 "" + } +#line 5224 "" + } +#line 5225 "" + if (comgrace_1.naccg[ngs - 1] > 0) { +#line 5226 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) + 8); + +/* Save for checking octave shifts in GA */ + +#line 5230 "" + if (isgaft) { +#line 5231 "" + lnotenga = lnoten; +#line 5232 "" + s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); +#line 5233 "" + } + +#line 5235 "" + if (lnoten == 1) { +#line 5235 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 5235 "" + } +#line 5236 "" + accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); +/* Writing concatenation */ +#line 5237 "" + i__4[0] = 1, a__3[0] = sq; +#line 5237 "" + i__4[1] = 3, a__3[1] = "big"; +#line 5237 "" + i__4[2] = lacc, a__3[2] = acsymq; +#line 5237 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5237 "" + s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); +#line 5237 "" + i__1 = lacc + 4 + lnoten; +#line 5237 "" + addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80) + ; +#line 5239 "" + } +#line 5240 "" + if (comgrace_1.slashg[*ig - 1]) { +/* Writing concatenation */ +#line 5241 "" + i__2[0] = 1, a__1[0] = sq; +#line 5241 "" + i__2[1] = 3, a__1[1] = "grc"; +#line 5241 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5242 "" + lnote = 4; +#line 5243 "" + } else if (mg == 0) { +/* Writing concatenation */ +#line 5244 "" + i__2[0] = 1, a__1[0] = sq; +#line 5244 "" + i__2[1] = 2, a__1[1] = "zq"; +#line 5244 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5245 "" + lnote = 3; +#line 5246 "" + } else { +/* Writing concatenation */ +#line 5247 "" + i__2[0] = 1, a__1[0] = sq; +#line 5247 "" + i__2[1] = 2, a__1[1] = "zc"; +#line 5247 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5248 "" + i__1 = mg; +#line 5248 "" + for (i__ = 2; i__ <= i__1; ++i__) { +/* Writing concatenation */ +#line 5249 "" + i__2[0] = i__ + 1, a__1[0] = notexq; +#line 5249 "" + i__2[1] = 1, a__1[1] = "c"; +#line 5249 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5250 "" +/* L61: */ +#line 5250 "" + } +#line 5251 "" + lnote = mg + 2; +#line 5252 "" + } +#line 5253 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5254 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 5254 "" + i__2[1] = 1, a__1[1] = "u"; +#line 5254 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5255 "" + } else { +/* Writing concatenation */ +#line 5256 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 5256 "" + i__2[1] = 1, a__1[1] = "l"; +#line 5256 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5257 "" + } +#line 5258 "" + i__1 = lnote + 1; +#line 5258 "" + addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 5259 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); + +#line 5261 "" + if (isgaft && comgrace_1.naccg[ngs - 1] == 0) { +#line 5262 "" + lnotenga = lnoten; +#line 5263 "" + s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8); +#line 5264 "" + } + +#line 5266 "" + if (lnoten == 1) { +#line 5266 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 5266 "" + } +#line 5267 "" + addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80); +#line 5268 "" + if (comgrace_1.slashg[*ig - 1]) { +/* Writing concatenation */ +#line 5268 "" + i__4[0] = 1, a__3[0] = sq; +#line 5268 "" + i__4[1] = 5, a__3[1] = "off{-"; +#line 5268 "" + i__4[2] = 1, a__3[2] = sq; +#line 5268 "" + i__4[3] = 9, a__3[3] = "noteskip}"; +#line 5268 "" + s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16); +#line 5268 "" + addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80); +#line 5268 "" + } + +/* Above code needed since slashg causes spacing */ + +#line 5273 "" + if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) { + +/* Terminate slur on single after-grace */ + +/* ndxslur = igetbits(ipl,4,23) */ +#line 5278 "" + comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); +#line 5279 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) + 8); +/* Writing concatenation */ +#line 5280 "" + i__2[0] = 1, a__1[0] = sq; +#line 5280 "" + i__2[1] = 5, a__1[1] = "tslur"; +#line 5280 "" + s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 5280 "" + 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 5286 "" + if (23 - comslur_1.ndxslur < 10) { +/* call addstr(chax(59-ndxslur)//noteq(1:lnoten), */ +/* Writing concatenation */ +#line 5288 "" + i__1 = 71 - comslur_1.ndxslur; +#line 5288 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5288 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 5288 "" + i__2[1] = lnoten, a__1[1] = noteq; +#line 5288 "" + s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 5288 "" + i__5 = lnoten + 1; +#line 5288 "" + addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); +#line 5290 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* Writing concatenation */ +#line 5291 "" + i__4[0] = 2, a__3[0] = "{2"; +#line 5291 "" + i__1 = 61 - comslur_1.ndxslur; +#line 5291 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5291 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5291 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5291 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5291 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5291 "" + i__5 = lnoten + 4; +#line 5291 "" + addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 5293 "" + } else { +/* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */ +/* Writing concatenation */ +#line 5295 "" + i__4[0] = 2, a__3[0] = "{1"; +#line 5295 "" + i__1 = 51 - comslur_1.ndxslur; +#line 5295 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5295 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5295 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5295 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5295 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5295 "" + i__5 = lnoten + 4; +#line 5295 "" + addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 5297 "" + } +#line 5298 "" + comgrace_1.slurg[*ig - 1] = FALSE_; +#line 5299 "" + comslur_1.listslur = bit_clear(comslur_1.listslur, + comslur_1.ndxslur); +#line 5300 "" + } +#line 5301 "" + 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 5307 "" + if (isgaft) { +#line 5308 "" + itrans = 0; +#line 5309 "" + i__1 = lnotenga; +#line 5309 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 5310 "" + chax_(ch__1, (ftnlen)1, &c__39); +#line 5310 "" + if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned char *)& + ch__1[0]) { +#line 5311 "" + itrans += 7; +#line 5312 "" + } else /* if(complicated condition) */ { +#line 5312 "" + chax_(ch__1, (ftnlen)1, &c__96); +#line 5312 "" + if (*(unsigned char *)¬eqga[i__ - 1] == *(unsigned + char *)&ch__1[0]) { +#line 5313 "" + itrans += -7; +#line 5314 "" + } +#line 5314 "" + } +#line 5315 "" +/* L1: */ +#line 5315 "" + } +#line 5316 "" + if (itrans == -14) { +/* Writing concatenation */ +#line 5317 "" + i__4[0] = 1, a__3[0] = sq; +#line 5317 "" + i__4[1] = 7, a__3[1] = "advance"; +#line 5317 "" + i__4[2] = 1, a__3[2] = sq; +#line 5317 "" + i__4[3] = 12, a__3[3] = "transpose-14"; +#line 5317 "" + s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21); +#line 5317 "" + addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); +#line 5319 "" + } else if (itrans == -7) { +/* Writing concatenation */ +#line 5320 "" + i__4[0] = 1, a__3[0] = sq; +#line 5320 "" + i__4[1] = 7, a__3[1] = "advance"; +#line 5320 "" + i__4[2] = 1, a__3[2] = sq; +#line 5320 "" + i__4[3] = 11, a__3[3] = "transpose-7"; +#line 5320 "" + s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); +#line 5320 "" + addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); +#line 5322 "" + } else if (itrans == 7) { +/* Writing concatenation */ +#line 5323 "" + i__4[0] = 1, a__3[0] = sq; +#line 5323 "" + i__4[1] = 7, a__3[1] = "advance"; +#line 5323 "" + i__4[2] = 1, a__3[2] = sq; +#line 5323 "" + i__4[3] = 10, a__3[3] = "transpose7"; +#line 5323 "" + s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19); +#line 5323 "" + addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80); +#line 5325 "" + } else if (itrans == 14) { +/* Writing concatenation */ +#line 5326 "" + i__4[0] = 1, a__3[0] = sq; +#line 5326 "" + i__4[1] = 7, a__3[1] = "advance"; +#line 5326 "" + i__4[2] = 1, a__3[2] = sq; +#line 5326 "" + i__4[3] = 11, a__3[3] = "transpose14"; +#line 5326 "" + s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20); +#line 5326 "" + addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80); +#line 5328 "" + } +#line 5329 "" + } +#line 5330 "" + } else { + +/* Multiple grace. Put in literally. Compute beam stuff */ + +#line 5334 "" + sumx = 0.f; +#line 5335 "" + sumy = 0.f; +#line 5336 "" + sumxy = 0.f; +#line 5337 "" + sumxx = 0.f; +#line 5338 "" + sumyy = 0.f; +#line 5339 "" + x = 0.f; +#line 5340 "" + i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; +#line 5340 "" + for (ing = ngs; ing <= i__1; ++ing) { +#line 5341 "" + if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) { +#line 5341 "" + x += spfacs_1.acgfac; +#line 5341 "" + } +#line 5342 "" + y = (real) comgrace_1.nolevg[ing - 1]; +#line 5343 "" + sumx += x; +#line 5344 "" + sumy += y; +#line 5345 "" + sumxy += x * y; +#line 5346 "" + sumxx += x * x; +#line 5347 "" + sumyy += y * y; +#line 5348 "" + x += spfacs_1.emgfac; +#line 5349 "" +/* L118: */ +#line 5349 "" + } +#line 5350 "" + delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx; +#line 5351 "" + em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta; +#line 5352 "" + r__1 = em * .5f * spfacs_1.gslfac; +#line 5352 "" + islope = i_nint(&r__1); +#line 5353 "" + if (abs(islope) > 9) { +#line 5353 "" + islope = i_sign(&c__9, &islope); +#line 5353 "" + } +#line 5354 "" + beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig + - 1]; +#line 5355 "" + nolev1 = i_nint(&beta); + +/* Back up */ + +/* Writing concatenation */ +#line 5359 "" + i__4[0] = 1, a__3[0] = sq; +#line 5359 "" + i__4[1] = 7, a__3[1] = "settiny"; +#line 5359 "" + i__4[2] = 1, a__3[2] = sq; +#line 5359 "" + i__4[3] = 4, a__3[3] = "off{"; +#line 5359 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 5360 "" + if (normsp) { +#line 5361 "" + s_wsfi(&io___424); +#line 5361 "" + do_fio(&c__1, "-", (ftnlen)1); +#line 5361 "" + do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real)); +#line 5361 "" + e_wsfi(); +/* Writing concatenation */ +#line 5362 "" + i__2[0] = 18, a__1[0] = notexq; +#line 5362 "" + i__2[1] = 3, a__1[1] = "pt}"; +#line 5362 "" + s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21); +#line 5362 "" + addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80); +#line 5363 "" + finalshift = ptgr[*ig]; +#line 5364 "" + } else { +#line 5365 "" + comgrace_1.aftshft = comask_1.wheadpt * 1.33f; +#line 5366 "" + if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) { +#line 5366 "" + comgrace_1.aftshft += comask_1.wheadpt * .5f; +#line 5366 "" + } +#line 5367 "" + s_wsfi(&io___426); +#line 5367 "" + do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real)); +#line 5367 "" + e_wsfi(); +/* Writing concatenation */ +#line 5368 "" + i__4[0] = 17, a__3[0] = notexq; +#line 5368 "" + i__4[1] = 3, a__3[1] = "pt}"; +#line 5368 "" + i__4[2] = 1, a__3[2] = sq; +#line 5368 "" + i__4[3] = 3, a__3[3] = "bsk"; +#line 5368 "" + s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24); +#line 5368 "" + addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80); +#line 5369 "" + } + +/* Start the beam */ + +/* Writing concatenation */ +#line 5373 "" + i__2[0] = 1, a__1[0] = sq; +#line 5373 "" + i__2[1] = 2, a__1[1] = "ib"; +#line 5373 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5374 "" + i__1 = mg; +#line 5374 "" + for (ing = 2; ing <= i__1; ++ing) { +/* Writing concatenation */ +#line 5375 "" + i__2[0] = ing + 1, a__1[0] = notexq; +#line 5375 "" + i__2[1] = 1, a__1[1] = "b"; +#line 5375 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5376 "" +/* L119: */ +#line 5376 "" + } +#line 5377 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5378 "" + i__2[0] = mg + 2, a__1[0] = notexq; +#line 5378 "" + i__2[1] = 1, a__1[1] = "u"; +#line 5378 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5379 "" + } else { +/* Writing concatenation */ +#line 5380 "" + i__2[0] = mg + 2, a__1[0] = notexq; +#line 5380 "" + i__2[1] = 1, a__1[1] = "l"; +#line 5380 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5381 "" + } +/* Writing concatenation */ +#line 5382 "" + i__2[0] = mg + 3, a__1[0] = notexq; +#line 5382 "" + i__2[1] = 1, a__1[1] = "0"; +#line 5382 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); + +/* Get starting note for beam */ + +#line 5386 "" + notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8); +/* Writing concatenation */ +#line 5387 "" + i__2[0] = mg + 4, a__1[0] = notexq; +#line 5387 "" + i__2[1] = lnoten, a__1[1] = noteq; +#line 5387 "" + s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87); +#line 5387 "" + i__1 = mg + 4 + lnoten; +#line 5387 "" + addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80); + +/* Put in the slope */ + +#line 5392 "" + if (islope >= 0) { +#line 5393 "" + i__1 = islope + 48; +#line 5393 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5393 "" + addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80); +#line 5394 "" + } else { +/* Writing concatenation */ +#line 5395 "" + i__3[0] = 2, a__2[0] = "{-"; +#line 5395 "" + i__1 = 48 - islope; +#line 5395 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5395 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 5395 "" + i__3[2] = 1, a__2[2] = "}"; +#line 5395 "" + s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4); +#line 5395 "" + addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80); +#line 5396 "" + } + +/* Start a slur on multiple fore-grace */ + +#line 5400 "" + if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) { +#line 5401 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) + 8); +#line 5402 "" + if (comslur_1.fontslur) { +#line 5403 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5404 "" + i__2[0] = 1, a__1[0] = sq; +#line 5404 "" + i__2[1] = 6, a__1[1] = "islurd"; +#line 5404 "" + s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5404 "" + addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) + ; +#line 5405 "" + } else { +/* Writing concatenation */ +#line 5406 "" + i__2[0] = 1, a__1[0] = sq; +#line 5406 "" + i__2[1] = 6, a__1[1] = "isluru"; +#line 5406 "" + s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7); +#line 5406 "" + addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80) + ; +#line 5407 "" + } +#line 5408 "" + } else { + +/* Need a tweak for postscript slur */ + +#line 5412 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5413 "" + i__2[0] = 1, a__1[0] = sq; +#line 5413 "" + i__2[1] = 3, a__1[1] = "isd"; +#line 5413 "" + s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5413 "" + addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) + ; +#line 5414 "" + } else { +/* Writing concatenation */ +#line 5415 "" + i__2[0] = 1, a__1[0] = sq; +#line 5415 "" + i__2[1] = 3, a__1[1] = "isu"; +#line 5415 "" + s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4); +#line 5415 "" + addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80) + ; +#line 5416 "" + } +#line 5417 "" + } + +/* Print 11-ndxslur */ + +#line 5421 "" + if (23 - comslur_1.ndxslur < 10) { +/* Writing concatenation */ +#line 5422 "" + i__1 = 71 - comslur_1.ndxslur; +#line 5422 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5422 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 5422 "" + i__2[1] = lnoten, a__1[1] = noteq; +#line 5422 "" + s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 5422 "" + i__5 = lnoten + 1; +#line 5422 "" + addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80); +#line 5424 "" + } else if (23 - comslur_1.ndxslur < 2) { +/* Writing concatenation */ +#line 5425 "" + i__4[0] = 2, a__3[0] = "{1"; +#line 5425 "" + i__1 = 61 - comslur_1.ndxslur; +#line 5425 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5425 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5425 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5425 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5425 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5425 "" + i__5 = lnoten + 4; +#line 5425 "" + addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 5427 "" + } else { +/* Writing concatenation */ +#line 5428 "" + i__4[0] = 2, a__3[0] = "{1"; +#line 5428 "" + i__1 = 51 - comslur_1.ndxslur; +#line 5428 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 5428 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5428 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5428 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5428 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5428 "" + i__5 = lnoten + 4; +#line 5428 "" + addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80); +#line 5430 "" + } + +/* Put in tweak for postscript slur */ + +#line 5434 "" + if (! comslur_1.fontslur) { +#line 5434 "" + addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80); +#line 5434 "" + } +#line 5435 "" + } + +/* Put in first note. Call notefq again in case octave changed */ + +#line 5439 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8); +#line 5440 "" + if (comgrace_1.naccg[ngs - 1] == 0) { +/* Writing concatenation */ +#line 5441 "" + i__3[0] = 1, a__2[0] = sq; +#line 5441 "" + i__3[1] = 4, a__2[1] = "zqb0"; +#line 5441 "" + i__3[2] = lnoten, a__2[2] = noteq; +#line 5441 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 5442 "" + lnote = lnoten + 5; +#line 5443 "" + } else { +#line 5444 "" + if (lnoten == 1) { +#line 5444 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 5444 "" + } +#line 5445 "" + accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3); +/* Writing concatenation */ +#line 5446 "" + i__4[0] = 1, a__3[0] = sq; +#line 5446 "" + i__4[1] = 3, a__3[1] = "big"; +#line 5446 "" + i__4[2] = lacc, a__3[2] = acsymq; +#line 5446 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5446 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 5447 "" + lnote = lacc + 4 + lnoten; +#line 5448 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen) + 8); +/* Writing concatenation */ +#line 5449 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 5449 "" + i__4[1] = 1, a__3[1] = sq; +#line 5449 "" + i__4[2] = 4, a__3[2] = "zqb0"; +#line 5449 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5449 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 5450 "" + lnote = lnote + 5 + lnoten; +#line 5451 "" + } +#line 5452 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 5453 "" + i__1 = ngs + comgrace_1.nng[*ig - 1] - 1; +#line 5453 "" + for (ing = ngs + 1; ing <= i__1; ++ing) { + +/* Skip */ + +#line 5457 "" + ptoff = wheadpt1 * spfacs_1.emgfac; +#line 5458 "" + if (comgrace_1.naccg[ing - 1] > 0) { +#line 5458 "" + ptoff += wheadpt1 * spfacs_1.acgfac; +#line 5458 "" + } +#line 5459 "" + if (isgaft && ! iswaft) { +#line 5459 "" + comgrace_1.aftshft += ptoff; +#line 5459 "" + } +/* Writing concatenation */ +#line 5460 "" + i__2[0] = 1, a__1[0] = sq; +#line 5460 "" + i__2[1] = 4, a__1[1] = "off{"; +#line 5460 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5461 "" + s_wsfi(&io___428); +#line 5461 "" + do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 5461 "" + e_wsfi(); +#line 5462 "" + if (normsp) { +#line 5462 "" + finalshift -= ptoff; +#line 5462 "" + } +/* Writing concatenation */ +#line 5463 "" + i__2[0] = 8, a__1[0] = notexq; +#line 5463 "" + i__2[1] = 3, a__1[1] = "pt}"; +#line 5463 "" + s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11); +#line 5463 "" + addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80); +#line 5464 "" + if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) { + +/* Terminate beam if needed */ + +#line 5468 "" + if (comgrace_1.upg[*ig - 1]) { +/* Writing concatenation */ +#line 5469 "" + i__2[0] = 1, a__1[0] = sq; +#line 5469 "" + i__2[1] = 4, a__1[1] = "tbu0"; +#line 5469 "" + s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); +#line 5469 "" + addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) + ; +#line 5470 "" + } else { +/* Writing concatenation */ +#line 5471 "" + i__2[0] = 1, a__1[0] = sq; +#line 5471 "" + i__2[1] = 4, a__1[1] = "tbl0"; +#line 5471 "" + s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5); +#line 5471 "" + addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80) + ; +#line 5472 "" + } + +/* Terminate after slur if needed */ + +#line 5476 "" + if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) { +/* if (iswaft) ndxslur = igetbits(ipl,4,23) */ +#line 5478 "" + if (iswaft) { +#line 5478 "" + comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23); +#line 5478 "" + } +#line 5479 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, + (ftnlen)8); +/* Writing concatenation */ +#line 5480 "" + i__2[0] = 1, a__1[0] = sq; +#line 5480 "" + i__2[1] = 5, a__1[1] = "tslur"; +#line 5480 "" + s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6); +#line 5480 "" + addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80) + ; + +/* Print 11-ndxslur */ +/* c Print 23-ndxslur */ + +#line 5485 "" + if (23 - comslur_1.ndxslur < 10) { +/* Writing concatenation */ +#line 5486 "" + i__5 = 71 - comslur_1.ndxslur; +#line 5486 "" + chax_(ch__1, (ftnlen)1, &i__5); +#line 5486 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 5486 "" + i__2[1] = lnoten, a__1[1] = noteq; +#line 5486 "" + s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9); +#line 5486 "" + i__6 = lnoten + 1; +#line 5486 "" + addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, ( + ftnlen)80); +#line 5488 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* Writing concatenation */ +#line 5489 "" + i__4[0] = 2, a__3[0] = "{2"; +#line 5489 "" + i__5 = 61 - comslur_1.ndxslur; +#line 5489 "" + chax_(ch__1, (ftnlen)1, &i__5); +#line 5489 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5489 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5489 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5489 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5489 "" + i__6 = lnoten + 4; +#line 5489 "" + addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( + ftnlen)80); +#line 5491 "" + } else { +/* Writing concatenation */ +#line 5492 "" + i__4[0] = 2, a__3[0] = "{1"; +#line 5492 "" + i__5 = 51 - comslur_1.ndxslur; +#line 5492 "" + chax_(ch__1, (ftnlen)1, &i__5); +#line 5492 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 5492 "" + i__4[2] = 1, a__3[2] = "}"; +#line 5492 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5492 "" + s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12); +#line 5492 "" + i__6 = lnoten + 4; +#line 5492 "" + addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, ( + ftnlen)80); +#line 5494 "" + } + +/* Stop slur terminator after exit from this subroutine */ + +#line 5498 "" + comslur_1.listslur = bit_clear(comslur_1.listslur, + comslur_1.ndxslur); +#line 5499 "" + comgrace_1.slurg[*ig - 1] = FALSE_; +#line 5500 "" + } +#line 5501 "" + } + +/* Accidental if needed */ + +#line 5505 "" + if (comgrace_1.naccg[ing - 1] > 0) { +#line 5506 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, ( + ftnlen)8); +#line 5507 "" + if (lnoten == 1) { +#line 5507 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 5507 "" + } +#line 5508 "" + accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3); +/* Writing concatenation */ +#line 5509 "" + i__4[0] = 1, a__3[0] = sq; +#line 5509 "" + i__4[1] = 3, a__3[1] = "big"; +#line 5509 "" + i__4[2] = lacc, a__3[2] = acsymq; +#line 5509 "" + i__4[3] = lnoten, a__3[3] = noteq; +#line 5509 "" + s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15); +#line 5509 "" + i__5 = lacc + 4 + lnoten; +#line 5509 "" + addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, ( + ftnlen)80); +#line 5511 "" + } + +/* Put in the (beamed) grace note */ + +#line 5515 "" + notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen) + 8); +/* Writing concatenation */ +#line 5516 "" + i__3[0] = 1, a__2[0] = sq; +#line 5516 "" + i__3[1] = 4, a__2[1] = "zqb0"; +#line 5516 "" + i__3[2] = lnoten, a__2[2] = noteq; +#line 5516 "" + s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13); +#line 5516 "" + i__5 = lnoten + 5; +#line 5516 "" + addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80); +#line 5518 "" +/* L127: */ +#line 5518 "" + } + +/* Terminate the grace */ + +/* notexq = sq//'normalnotesize'//sq//'off{' */ +/* lnote = 20 */ +/* notexq = '}'//sq//'off{' */ +/* lnote = 6 */ +/* Writing concatenation */ +#line 5526 "" + i__2[0] = 1, a__1[0] = sq; +#line 5526 "" + i__2[1] = 4, a__1[1] = "off{"; +#line 5526 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5527 "" + lnote = 5; +#line 5528 "" + ptoff = comask_1.wheadpt * spfacs_1.emgfac; +#line 5529 "" + if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) { +#line 5529 "" + ptoff += comask_1.wheadpt * spfacs_1.accfac; +#line 5529 "" + } +#line 5531 "" + if (isgaft && ! iswaft) { +/* Writing concatenation */ +#line 5532 "" + i__2[0] = 5, a__1[0] = notexq; +#line 5532 "" + i__2[1] = 1, a__1[1] = "-"; +#line 5532 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 5533 "" + lnote = 6; +#line 5534 "" + ptoff = comgrace_1.aftshft; +#line 5535 "" + } +#line 5536 "" + if (normsp) { +#line 5536 "" + ptoff = finalshift; +#line 5536 "" + } +#line 5537 "" + if (ptoff < 9.95f) { +#line 5538 "" + i__1 = lnote; +#line 5538 "" + ici__1.icierr = 0; +#line 5538 "" + ici__1.icirnum = 1; +#line 5538 "" + ici__1.icirlen = lnote + 3 - i__1; +#line 5538 "" + ici__1.iciunit = notexq + i__1; +#line 5538 "" + ici__1.icifmt = "(f3.1)"; +#line 5538 "" + s_wsfi(&ici__1); +#line 5538 "" + do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 5538 "" + e_wsfi(); +#line 5539 "" + lnote += 3; +#line 5540 "" + } else if (ptoff < 99.95f) { +#line 5541 "" + i__1 = lnote; +#line 5541 "" + ici__1.icierr = 0; +#line 5541 "" + ici__1.icirnum = 1; +#line 5541 "" + ici__1.icirlen = lnote + 4 - i__1; +#line 5541 "" + ici__1.iciunit = notexq + i__1; +#line 5541 "" + ici__1.icifmt = "(f4.1)"; +#line 5541 "" + s_wsfi(&ici__1); +#line 5541 "" + do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 5541 "" + e_wsfi(); +#line 5542 "" + lnote += 4; +#line 5543 "" + } else { +#line 5544 "" + i__1 = lnote; +#line 5544 "" + ici__1.icierr = 0; +#line 5544 "" + ici__1.icirnum = 1; +#line 5544 "" + ici__1.icirlen = lnote + 5 - i__1; +#line 5544 "" + ici__1.iciunit = notexq + i__1; +#line 5544 "" + ici__1.icifmt = "(f5.1)"; +#line 5544 "" + s_wsfi(&ici__1); +#line 5544 "" + do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real)); +#line 5544 "" + e_wsfi(); +#line 5545 "" + lnote += 5; +#line 5546 "" + } +/* Writing concatenation */ +#line 5547 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 5547 "" + i__2[1] = 3, a__1[1] = "pt}"; +#line 5547 "" + s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82); +#line 5547 "" + i__1 = lnote + 3; +#line 5547 "" + addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80); +#line 5548 "" + if (isgaft && ! iswaft) { +/* Writing concatenation */ +#line 5548 "" + i__2[0] = 1, a__1[0] = sq; +#line 5548 "" + i__2[1] = 2, a__1[1] = "sk"; +#line 5548 "" + s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3); +#line 5548 "" + addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80); +#line 5548 "" + } +/* Writing concatenation */ +#line 5549 "" + i__2[0] = 1, a__1[0] = sq; +#line 5549 "" + i__2[1] = 9, a__1[1] = "resetsize"; +#line 5549 "" + s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10); +#line 5549 "" + addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80); +#line 5550 "" + } +#line 5551 "" + return 0; +} /* dograce_ */ + +/* Subroutine */ int dopsslur_(integer *nolev, integer *isdat1, integer * + isdat2, integer *isdat3, integer *isdat4, integer *nsdat, integer *ip, + integer *iv, integer *kv, integer *nv, logical *beamon, integer *ncm, + char *soutq, integer *lsout, char *ulq, integer *islur, integer *ipl, + integer *iornq, integer *islhgt, real *tno, integer *nacc, ftnlen + soutq_len, ftnlen ulq_len) +{ + /* System generated locals */ + address a__1[3], a__2[4], a__3[2]; + integer i__1, i__2, i__3[3], i__4[4], i__5[2], i__6; + char ch__1[1], ch__2[1], ch__3[6], ch__4[9]; + icilist ici__1; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), e_wsfi(void); + + /* Local variables */ + static integer ivoffinc; + extern integer igetbits_(integer *, integer *, integer *); + static integer j, icm; + extern integer log2_(integer *); + static integer imid; + extern /* Character */ VOID chax_(char *, ftnlen, integer *), udfq_(char * + , ftnlen, integer *, integer *), udqq_(char *, ftnlen, integer *, + integer *, integer *, integer *, integer *, integer *); + extern integer lfmt1_(real *); + extern /* Subroutine */ int stop1_(void); + static integer ihoff; + static logical iscrd; + static integer isdat, ivoff; + static real shift; + static integer iupdn, lform, lnote; + static logical pstie; + static char noteq[8]; + static integer idcode, isdata; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static logical settie; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten, nolevs; + static logical stemup; + static char notexq[79]; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + static integer numdrop; + static char slurudq[1]; + + /* Fortran I/O blocks */ + static cilist io___442 = { 0, 6, 0, 0, 0 }; + static cilist io___443 = { 0, 6, 0, 0, 0 }; + static cilist io___444 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___452 = { 0, 6, 0, 0, 0 }; + + + +/* Called once per main note. */ +/* 12 May 2002 Create this subroutine to isolate postscript slurs/ties. */ +/* Always set \Nosluradjust\Notieadjust */ + +/* 130316 */ + +/* Bits in isdat1: */ +/* 13-17 iv */ +/* 3-10 ip */ +/* 11 start/stop switch */ +/* 12 kv-1 */ +/* 19-25 ichar(code$) */ +/* 26 force direction? */ +/* 27 forced dir'n = up if on, set in sslur; also */ +/* final direction, set in doslur when beam is started, used on term. */ +/* 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 */ + +/* Bits in isdat2 */ +/* 0 Chord switch. Not set on main note. */ +/* 1-2 left/right notehead shift. Set only for chord note. */ +/* 3 tie positioning */ +/* 4 dotted flag */ +/* 6-11 voff1 1-63 => -31...+31 */ +/* 12-18 hoff1 1-127 => -6.3...+6.3 */ +/* 19-25 nolev */ +/* 26 \sluradjust (p+s) */ +/* 27 \nosluradjust (p-s) */ +/* 28 \tieadjust (p+t) */ +/* 29 \notieadjust (p-t) */ + +/* Bits in isdat3: Only used for slur endings */ +/* 0 set if midslur (at least one argument) */ +/* 1 set if curve (2 more args) */ +/* 2-7 32+first arg (height correction) (1st arg may be negative) */ +/* 8-10 second arg (initial slope) */ +/* 11-13 third arg (closing slope) */ +/* 14-21 tie level for use in LineBreakTies */ +/* 22-29 ncm for use in LineBreakTies */ + +/* Bits in isdat4 Only used for linebreak slurs */ +/* 0-5 Linebreak seg 1 voff 1-63 => -31...+31 */ +/* 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 */ +/* 16-21 Linebreak seg 2 voff 1-63 => -31...+31 */ +/* 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 */ + +/* In listslur bit ib is on if slur index ib is in use, ib=0-13. */ +/* ndxslur = slur index */ +/* Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, */ +/* s-slur is blank (idcode=32), t-slur is idcode=1. */ +/* ivoff is user-defined shift or shift due to . or _ , or chord adjustment. */ +/* Ivoff will be set for ./_ only if no user-defined shift is specified. */ +/* If highest note has upslur, save slur height in islhgt in case */ +/* ornament must be moved. */ + +#line 5646 "" + /* Parameter adjustments */ +#line 5646 "" + --isdat4; +#line 5646 "" + --isdat3; +#line 5646 "" + --isdat2; +#line 5646 "" + --isdat1; +#line 5646 "" + +#line 5646 "" + /* Function Body */ +#line 5646 "" + *islhgt = 0; +#line 5647 "" + if (*beamon) { +#line 5648 "" + stemup = *(unsigned char *)ulq == 'u'; +#line 5649 "" + } else if (commvl_1.nvmx[*iv - 1] == 2) { +#line 5650 "" + if (! bit_test(*islur,30)) { + +/* Single note, 2 lines of music, stem direction not forced */ + +#line 5654 "" + stemup = commvl_1.ivx > *nv; +#line 5655 "" + } else { +#line 5656 "" + stemup = bit_test(*islur,17); +#line 5657 "" + } +#line 5658 "" + } else { +#line 5659 "" + udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & + commvl_1.ivx, nv); +#line 5659 "" + stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 5660 "" + } +#line 5661 "" + iscrd = bit_test(*ipl,10); +#line 5662 "" + if (commidi_1.ismidi) { +#line 5663 "" + settie = FALSE_; +#line 5664 "" + comslm_1.dbltie = FALSE_; +#line 5665 "" + } +#line 5666 "" + i__1 = *nsdat; +#line 5666 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +#line 5667 "" + isdata = isdat1[isdat]; +#line 5668 "" + 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 5674 "" + idcode = igetbits_(&isdata, &c__7, &c__19); +#line 5675 "" + ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; +#line 5676 "" + ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; +#line 5677 "" + iupdn = 0; +#line 5678 "" + *(unsigned char *)slurudq = 'd'; +#line 5679 "" + nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 5680 "" + pstie = bit_test(isdat2[isdat],3) || idcode == 1; +#line 5681 "" + if (bit_test(isdata,11)) { + +/* Turnon */ +/* Get slur direction */ + +#line 5686 "" + if (bit_test(isdata,26)) { + +/* Force slur direction */ + +#line 5690 "" + if (bit_test(isdata,27)) { +#line 5690 "" + *(unsigned char *)slurudq = 'u'; +#line 5690 "" + } +#line 5691 "" + } else if (commvl_1.nvmx[*iv - 1] == 1) { + +/* Only one voice per line */ + +#line 5695 "" + if (! (*beamon)) { + +/* Separate note. */ + +#line 5699 "" + udfq_(ch__1, (ftnlen)1, nolev, ncm); +#line 5699 "" + *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ + 0]; +#line 5700 "" + } else { + +/* In a beam */ + +#line 5704 "" + if (*(unsigned char *)ulq != 'u') { +#line 5704 "" + *(unsigned char *)slurudq = 'u'; +#line 5704 "" + } +#line 5705 "" + } +#line 5706 "" + if (iscrd) { +#line 5707 "" + if (nolevs > *ncm) { +#line 5708 "" + *(unsigned char *)slurudq = 'u'; +#line 5709 "" + } else { +#line 5710 "" + *(unsigned char *)slurudq = 'd'; +#line 5711 "" + } +#line 5712 "" + } +#line 5713 "" + } else { + +/* Two voices per line. Get default */ + +#line 5717 "" + if (commvl_1.ivx > *nv) { +#line 5717 "" + *(unsigned char *)slurudq = 'u'; +#line 5717 "" + } + +/* Upper voice of the two, so up slur */ + +#line 5721 "" + } +#line 5722 "" + if (bit_test(isdata,2)) { + +/* ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. */ + +#line 5726 "" + if (stemup) { +#line 5727 "" + *(unsigned char *)slurudq = 'u'; +#line 5728 "" + ivoff += 4; +#line 5729 "" + } else { +#line 5730 "" + *(unsigned char *)slurudq = 'd'; +#line 5731 "" + ivoff += -4; +#line 5732 "" + } +#line 5733 "" + } + +/* Set level for slur starting on rest */ + +#line 5737 "" + if (nolevs == 0 || nolevs > 60) { +#line 5738 "" + if (*(unsigned char *)slurudq == 'u') { +#line 5739 "" + nolevs = *ncm + 2; +#line 5740 "" + } else { +#line 5741 "" + nolevs = *ncm - 2; +#line 5742 "" + } +#line 5743 "" + } + +/* Save up/down-ness for use at termination */ + +#line 5747 "" + if (*(unsigned char *)slurudq == 'u') { +#line 5747 "" + isdata = bit_set(isdata,27); +#line 5747 "" + } + +/* End of section for setting slur direction, still in "Turnon" if-block. */ + +#line 5751 "" + 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 5755 "" + ivoffinc = 0; +#line 5756 "" + if (stemup && *(unsigned char *)slurudq == 'd' || ! + stemup && *(unsigned char *)slurudq == 'u') { + +/* Must move the slur for _ or . */ + +#line 5761 "" + if (stemup) { +#line 5762 "" + ivoffinc = -1; +#line 5763 "" + } else { +#line 5764 "" + ivoffinc = 1; +#line 5765 "" + } +#line 5766 "" + if ((stemup && *nolev >= *ncm - 2 || ! stemup && * + nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, + abs(i__2)) % 2 == 0) { +#line 5766 "" + ivoffinc <<= 1; +#line 5766 "" + } +#line 5769 "" + ivoff += ivoffinc; +#line 5770 "" + } +#line 5771 "" + } +#line 5772 "" + if (comslur_1.listslur == 16777215) { +#line 5773 "" + s_wsle(&io___442); +#line 5773 "" + e_wsle(); +#line 5774 "" + s_wsle(&io___443); +#line 5774 "" + do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"\ + " one too many!", (ftnlen)48); +#line 5774 "" + e_wsle(); +#line 5775 "" + s_wsfe(&io___444); +#line 5775 "" + do_fio(&c__1, "You defined the twentyfifth slur, one too"\ + " many!", (ftnlen)47); +#line 5775 "" + e_wsfe(); +#line 5777 "" + stop1_(); +#line 5778 "" + } + +/* Get index of next slur not in use, starting from 12 down */ + +#line 5782 "" + i__2 = 16777215 - comslur_1.listslur; +#line 5782 "" + comslur_1.ndxslur = log2_(&i__2); +/* write(*,'()') */ +/* write(*,'(2i4,2x,B24)')ivx,ndxslur,listslur */ + +/* Record slur index */ + +#line 5788 "" + 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 5795 "" + i__2 = comslur_1.ndxslur % 16; +#line 5795 "" + setbits_(&isdata, &c__4, &c__28, &i__2); +#line 5796 "" + i__2 = comslur_1.ndxslur / 16; +#line 5796 "" + setbits_(&isdata, &c__1, &c__18, &i__2); + +/* Shift for stem? */ + +#line 5800 "" + if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) + { +#line 5801 "" + if (! pstie) { +#line 5802 "" + ihoff += 8; +#line 5803 "" + } else { +#line 5804 "" + ihoff += 2; +#line 5805 "" + } +#line 5806 "" + } +#line 5807 "" + if (iscrd) { + +/* Additional horiz shifts for h-shifted noteheads? */ + +#line 5811 "" + if (bit_test(isdat2[isdat],1)) { + +/* Slur start on left-shifted chord notehead. ASSUME downstem. */ + +#line 5815 "" + if (nolevs == comtrill_1.minlev && *(unsigned char *) + slurudq == 'd') { +#line 5816 "" + ihoff += -2; +#line 5817 "" + } else { +#line 5818 "" + ihoff += -10; +#line 5819 "" + } +#line 5820 "" + } else if (bit_test(isdat2[isdat],2)) { + +/* Right shifted chord notehead. ASSUME upstem. */ + +#line 5824 "" + if (nolevs == comtrill_1.maxlev && *(unsigned char *) + slurudq == 'u') { +#line 5825 "" + ihoff += 2; +#line 5826 "" + } else { +#line 5827 "" + ihoff += 10; +#line 5828 "" + } +#line 5829 "" + } +#line 5830 "" + } +#line 5831 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5831 "" + s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1); +#line 5832 "" + lnote = 1; + +/* Check for local adjustment default changes */ + +#line 5836 "" + if (bit_test(isdat2[isdat],26)) { +/* Writing concatenation */ +#line 5837 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5837 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 5837 "" + i__3[1] = 10, a__1[1] = "sluradjust"; +#line 5837 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 5837 "" + i__3[2] = 1, a__1[2] = ch__2; +#line 5837 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5838 "" + lnote = 12; +#line 5839 "" + } else if (bit_test(isdat2[isdat],27)) { +/* Writing concatenation */ +#line 5840 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5840 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 5840 "" + i__3[1] = 12, a__1[1] = "nosluradjust"; +#line 5840 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 5840 "" + i__3[2] = 1, a__1[2] = ch__2; +#line 5840 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5841 "" + lnote = 14; +#line 5842 "" + } else if (bit_test(isdat2[isdat],28)) { +/* Writing concatenation */ +#line 5843 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5843 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 5843 "" + i__3[1] = 9, a__1[1] = "tieadjust"; +#line 5843 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 5843 "" + i__3[2] = 1, a__1[2] = ch__2; +#line 5843 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5844 "" + lnote = 11; +#line 5845 "" + } else if (bit_test(isdat2[isdat],29)) { +/* Writing concatenation */ +#line 5846 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5846 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 5846 "" + i__3[1] = 11, a__1[1] = "notieadjust"; +#line 5846 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 5846 "" + i__3[2] = 1, a__1[2] = ch__2; +#line 5846 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5847 "" + lnote = 13; +#line 5848 "" + } +#line 5849 "" + if (ihoff == 0) { + +/* Write stuff for non-shifted start */ + +/* Writing concatenation */ +#line 5853 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 5853 "" + i__3[1] = 5, a__1[1] = "islur"; +#line 5853 "" + i__3[2] = 1, a__1[2] = slurudq; +#line 5853 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5854 "" + lnote += 6; +#line 5855 "" + } else { +/* Writing concatenation */ +#line 5856 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 5856 "" + i__3[1] = 2, a__1[1] = "is"; +#line 5856 "" + i__3[2] = 1, a__1[2] = slurudq; +#line 5856 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5857 "" + lnote += 3; +#line 5858 "" + } + +/* Prepend postscript tie switch */ + +#line 5862 "" + if (pstie) { +/* Writing concatenation */ +#line 5863 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5863 "" + i__4[0] = 1, a__2[0] = ch__1; +#line 5863 "" + i__4[1] = 8, a__2[1] = "tieforis"; +#line 5863 "" + i__4[2] = 1, a__2[2] = slurudq; +#line 5863 "" + i__4[3] = lnote, a__2[3] = notexq; +#line 5863 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5864 "" + lnote += 10; +#line 5865 "" + } +#line 5866 "" + if (bit_test(isdat2[isdat],4)) { + +/* Dotted slur */ + +/* noteq = notexq */ +/* notexq = chax(92)//'dotted'//noteq */ +/* Writing concatenation */ +#line 5872 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 5872 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 5872 "" + i__3[1] = 6, a__1[1] = "dotted"; +#line 5872 "" + i__3[2] = lnote, a__1[2] = notexq; +#line 5872 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 5873 "" + lnote += 7; +#line 5874 "" + } + +/* Add slur index to string */ +/* c Print 11-ndxslur */ +/* Print 23-ndxslur */ + +/* if (11-ndxslur .lt. 10) then */ +#line 5881 "" + if (23 - comslur_1.ndxslur < 10) { + +/* 5/25/08 Allow 24 slurs */ + +/* notexq = notexq(1:lnote)//chax(59-ndxslur) */ +/* Writing concatenation */ +#line 5886 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 5886 "" + i__2 = 71 - comslur_1.ndxslur; +#line 5886 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 5886 "" + i__5[1] = 1, a__3[1] = ch__1; +#line 5886 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 5887 "" + ++lnote; +#line 5888 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ +/* Writing concatenation */ +#line 5890 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 5890 "" + i__4[1] = 2, a__2[1] = "{1"; +#line 5890 "" + i__2 = 61 - comslur_1.ndxslur; +#line 5890 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 5890 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 5890 "" + i__4[3] = 1, a__2[3] = "}"; +#line 5890 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5891 "" + lnote += 4; +#line 5892 "" + } else { +/* Writing concatenation */ +#line 5893 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 5893 "" + i__4[1] = 2, a__2[1] = "{2"; +#line 5893 "" + i__2 = 51 - comslur_1.ndxslur; +#line 5893 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 5893 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 5893 "" + i__4[3] = 1, a__2[3] = "}"; +#line 5893 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 5894 "" + lnote += 4; +#line 5895 "" + } + +/* Add note name to string */ + +/* call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm) */ +#line 5900 "" + *islhgt = nolevs + iupdn + ivoff; +#line 5901 "" + notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8); +/* Writing concatenation */ +#line 5902 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 5902 "" + i__5[1] = lnoten, a__3[1] = noteq; +#line 5902 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 5903 "" + lnote += lnoten; + +/* Store height and staff mid level for use with LineBreakTies */ + +#line 5907 "" + setbits_(&isdat3[isdat], &c__8, &c__14, islhgt); +#line 5908 "" + setbits_(&isdat3[isdat], &c__8, &c__22, ncm); + +/* Save height (for ornament and barnobox interference) if topmost slur is up */ + +#line 5912 "" + if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ + isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 5914 "" + *islhgt = nolevs + iupdn + ivoff; + +/* Save height & idcode if top voice and slur start */ + +#line 5918 "" + if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv + - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { +#line 5919 "" + comsln_1.is1n1 = *islhgt; +#line 5920 "" + comsln_1.is2n1 = idcode; +#line 5921 "" + } +#line 5922 "" + } +#line 5923 "" + if ((real) ihoff != 0.f) { +#line 5924 "" + shift = ihoff * .1f; +/* Writing concatenation */ +#line 5925 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 5925 "" + i__5[1] = 1, a__3[1] = "{"; +#line 5925 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 5926 "" + ++lnote; +#line 5927 "" + lform = lfmt1_(&shift); +#line 5928 "" + i__2 = lnote; +#line 5928 "" + ici__1.icierr = 0; +#line 5928 "" + ici__1.icirnum = 1; +#line 5928 "" + ici__1.icirlen = lnote + lform - i__2; +#line 5928 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 5928 "" + i__3[0] = 2, a__1[0] = "(f"; +#line 5928 "" + i__6 = lform + 48; +#line 5928 "" + chax_(ch__1, (ftnlen)1, &i__6); +#line 5928 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 5928 "" + i__3[2] = 3, a__1[2] = ".1)"; +#line 5928 "" + ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) + 6), ch__3); +#line 5928 "" + s_wsfi(&ici__1); +#line 5928 "" + do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 5928 "" + e_wsfi(); +#line 5930 "" + lnote += lform; +/* Writing concatenation */ +#line 5931 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 5931 "" + i__5[1] = 1, a__3[1] = "}"; +#line 5931 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 5932 "" + ++lnote; +#line 5933 "" + } +#line 5934 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); + +/* Zero out ip1 to avoid problems if slur goes to next input blk. */ + +#line 5938 "" + 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 5942 "" + if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { +/* levson(midchan(iv,kv)) = nolevs */ +/* 130316 */ +/* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */ +#line 5946 "" + comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = + nolevs + commvel_1.miditran[cominsttrans_1.instno[ + *iv - 1] - 1]; +#line 5947 "" + if (settie) { +#line 5947 "" + comslm_1.dbltie = TRUE_; +#line 5947 "" + } + +/* 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 5952 "" + } +#line 5953 "" + } else { + +/* Slur is ending. Back thru list to find starting slur */ + +#line 5957 "" + for (j = isdat - 1; j >= 1; --j) { +#line 5958 "" + if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv == + igetbits_(&isdat1[j], &c__1, &c__12) + 1) { +#line 5960 "" + if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { +#line 5961 "" + comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & + c__28) + (igetbits_(&isdat1[j], &c__1, & + c__18) << 4); + +/* 080531 Allow >16 slurs */ + +#line 5966 "" + if (bit_test(isdat1[j],27)) { +#line 5966 "" + *(unsigned char *)slurudq = 'u'; +#line 5966 "" + } +#line 5967 "" + goto L4; +#line 5968 "" + } +#line 5969 "" + } +#line 5970 "" +/* L3: */ +#line 5970 "" + } +#line 5971 "" + s_wsle(&io___452); +#line 5971 "" + do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); +#line 5971 "" + e_wsle(); +#line 5972 "" + stop1_(); +#line 5973 "" +L4: + +/* Bugfix 070901 for slur ending on rest in 2-voice staff */ + +/* if (nolevs.eq.0 .or. nolevs.gt.60) then */ +#line 5978 "" + if (nolevs <= 2 || nolevs > 60) { + +/* Ending is on a rest, reset nolevs to default starting height */ + +#line 5982 "" + nolevs = igetbits_(&isdat2[j], &c__7, &c__19); +#line 5983 "" + } +#line 5984 "" + if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) { + +/* Deal with \curve or \midslur. isdat is ending, j is start. */ + +#line 5988 "" + if (bit_test(isdat3[isdat],0)) { +#line 5989 "" + imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; +#line 5990 "" + } else { +#line 5991 "" + imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32; +#line 5992 "" + } + +/* Postscript slurs, and \midslur adjustment is needed. Invoke macro */ +/* (from pmx.tex) that redefines \tslur as r'qd. Tentative mapping: */ +/* Abs(imid) Postscript slur type */ +/* 1 f */ +/* 2-3 default */ +/* 4 h */ +/* 5 H */ +/* 6+ HH */ + +/* Writing concatenation */ +#line 6003 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6003 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 6003 "" + i__3[1] = 7, a__1[1] = "psforts"; +/* Computing MIN */ +#line 6003 "" + i__6 = abs(imid); +#line 6003 "" + i__2 = min(i__6,6) + 48; +#line 6003 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 6003 "" + i__3[2] = 1, a__1[2] = ch__2; +#line 6003 "" + s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9); +#line 6003 "" + addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80) + ; +#line 6005 "" + } +#line 6006 "" + if (bit_test(isdata,2)) { + +/* ADjust for stem slur. */ + +#line 6010 "" + if (stemup) { +#line 6011 "" + *(unsigned char *)slurudq = 'u'; +#line 6012 "" + ivoff += 4; +#line 6013 "" + } else { +#line 6014 "" + *(unsigned char *)slurudq = 'd'; +#line 6015 "" + ivoff += -4; +#line 6016 "" + } +#line 6017 "" + } + +/* Shift slur ending for stem on any note? */ + +#line 6021 "" + if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < + 63.f) { +#line 6022 "" + if (! pstie) { +#line 6023 "" + ihoff += -8; +#line 6024 "" + } else { +#line 6025 "" + ihoff += -3; +#line 6026 "" + } +#line 6027 "" + } +#line 6028 "" + if (iscrd) { + +/* Shift termination for shifted notehead? */ + +#line 6032 "" + if (bit_test(isdat2[isdat],1)) { + +/* Left-shifted chord notehead. ASSUME downstem. */ + +#line 6036 "" + if (nolevs == comtrill_1.minlev && *(unsigned char *) + slurudq == 'd') { +#line 6037 "" + ihoff += -2; +#line 6038 "" + } else { +#line 6039 "" + ihoff += -10; +#line 6040 "" + } +#line 6041 "" + } else if (bit_test(isdat2[isdat],2)) { + +/* Right shifted chord notehead. ASSUME upstem. */ + +#line 6045 "" + if (nolevs == comtrill_1.maxlev && *(unsigned char *) + slurudq == 'u') { +#line 6046 "" + ihoff += 2; +#line 6047 "" + } else { +#line 6048 "" + ihoff += 10; +#line 6049 "" + } +#line 6050 "" + } +#line 6051 "" + } +#line 6052 "" + if (ihoff == 0) { +/* Writing concatenation */ +#line 6053 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6053 "" + i__5[0] = 1, a__3[0] = ch__1; +#line 6053 "" + i__5[1] = 5, a__3[1] = "tslur"; +#line 6053 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6054 "" + lnote = 6; +#line 6055 "" + } else { + +/* Shift needed */ + +/* Writing concatenation */ +#line 6059 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6059 "" + i__5[0] = 1, a__3[0] = ch__1; +#line 6059 "" + i__5[1] = 2, a__3[1] = "ts"; +#line 6059 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6060 "" + lnote = 3; +#line 6061 "" + } + +/* Switch to postscript tie */ + +#line 6065 "" + if (pstie) { +/* Writing concatenation */ +#line 6066 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6066 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 6066 "" + i__3[1] = 8, a__1[1] = "tieforts"; +#line 6066 "" + i__3[2] = lnote, a__1[2] = notexq; +#line 6066 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6067 "" + lnote += 9; +#line 6068 "" + } + +/* Print 13-ndxslur */ +/* 5/25/08 Allow 14 slurs */ + +#line 6073 "" + if (23 - comslur_1.ndxslur < 10) { +/* Writing concatenation */ +#line 6074 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6074 "" + i__2 = 71 - comslur_1.ndxslur; +#line 6074 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6074 "" + i__5[1] = 1, a__3[1] = ch__1; +#line 6074 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6075 "" + ++lnote; +#line 6076 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* Writing concatenation */ +#line 6077 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6077 "" + i__4[1] = 2, a__2[1] = "{1"; +#line 6077 "" + i__2 = 61 - comslur_1.ndxslur; +#line 6077 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6077 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 6077 "" + i__4[3] = 1, a__2[3] = "}"; +#line 6077 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6078 "" + lnote += 4; +#line 6079 "" + } else { +/* Writing concatenation */ +#line 6080 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6080 "" + i__4[1] = 2, a__2[1] = "{2"; +#line 6080 "" + i__2 = 51 - comslur_1.ndxslur; +#line 6080 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6080 "" + i__4[2] = 1, a__2[2] = ch__1; +#line 6080 "" + i__4[3] = 1, a__2[3] = "}"; +#line 6080 "" + s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79); +#line 6081 "" + lnote += 4; +#line 6082 "" + } +#line 6083 "" + 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 6087 "" + ivoffinc = 0; +#line 6088 "" + if (stemup && *(unsigned char *)slurudq == 'd' || ! + stemup && *(unsigned char *)slurudq == 'u') { +#line 6090 "" + if (stemup) { +#line 6091 "" + ivoffinc = -1; +#line 6092 "" + } else { +#line 6093 "" + ivoffinc = 1; +#line 6094 "" + } +#line 6095 "" + if ((stemup && *nolev >= *ncm - 2 || ! stemup && * + nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, + abs(i__2)) % 2 == 0) { +#line 6095 "" + ivoffinc <<= 1; +#line 6095 "" + } +#line 6098 "" + } +#line 6099 "" + ivoff += ivoffinc; +#line 6100 "" + } +#line 6101 "" + i__2 = nolevs + iupdn + ivoff; +#line 6101 "" + notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +#line 6102 "" + if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ + isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6104 "" + *islhgt = nolevs + iupdn + ivoff; + +/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ + +#line 6108 "" + if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv + - 1] * 24 - 25] && comsln_1.is1n1 > 0) { +#line 6109 "" + if (idcode == comsln_1.is2n1) { +#line 6109 "" + comsln_1.is1n1 = 0; +#line 6109 "" + } +#line 6110 "" + } +#line 6111 "" + } +/* Writing concatenation */ +#line 6112 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6112 "" + i__5[1] = lnoten, a__3[1] = noteq; +#line 6112 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6113 "" + lnote += lnoten; +#line 6114 "" + if (ihoff != 0) { +#line 6115 "" + shift = ihoff * .1f; +/* Writing concatenation */ +#line 6116 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6116 "" + i__5[1] = 1, a__3[1] = "{"; +#line 6116 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6117 "" + ++lnote; +#line 6118 "" + lform = lfmt1_(&shift); +#line 6119 "" + i__2 = lnote; +#line 6119 "" + ici__1.icierr = 0; +#line 6119 "" + ici__1.icirnum = 1; +#line 6119 "" + ici__1.icirlen = lnote + lform - i__2; +#line 6119 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 6119 "" + i__3[0] = 2, a__1[0] = "(f"; +#line 6119 "" + i__6 = lform + 48; +#line 6119 "" + chax_(ch__1, (ftnlen)1, &i__6); +#line 6119 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 6119 "" + i__3[2] = 3, a__1[2] = ".1)"; +#line 6119 "" + ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen) + 6), ch__3); +#line 6119 "" + s_wsfi(&ici__1); +#line 6119 "" + do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6119 "" + e_wsfi(); +#line 6121 "" + lnote += lform; +/* Writing concatenation */ +#line 6122 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6122 "" + i__5[1] = 1, a__3[1] = "}"; +#line 6122 "" + s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79); +#line 6123 "" + ++lnote; +#line 6124 "" + } +#line 6125 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); + +/* Clear the bit from list of slurs in use */ + +#line 6129 "" + comslur_1.listslur = bit_clear(comslur_1.listslur, + comslur_1.ndxslur); + +/* Zero out the entire strings for start and stop */ + +#line 6133 "" + isdata = 0; +#line 6134 "" + isdat2[isdat] = 0; +#line 6135 "" + isdat3[isdat] = 0; +#line 6136 "" + isdat4[isdat] = 0; +#line 6137 "" + isdat1[j] = 0; +#line 6138 "" + isdat2[j] = 0; +#line 6139 "" + isdat3[j] = 0; +#line 6140 "" + isdat4[j] = 0; + +/* Set midi info for slur ending */ + +#line 6144 "" + if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) { +#line 6145 "" + icm = commidi_1.midchan[*iv + *kv * 24 - 25]; +#line 6146 "" + 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 6150 "" + if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ + *iv - 1] - 1] == comslm_1.levson[icm] && (7 & + *nacc) == 0) { + +/* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */ + +/* levsoff(icm) = nolevs */ +/* 130316 */ +/* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */ +#line 6158 "" + comslm_1.levsoff[icm] = nolevs + + commvel_1.miditran[cominsttrans_1.instno[* + iv - 1] - 1]; +#line 6159 "" + settie = TRUE_; +#line 6160 "" + } else { +#line 6161 "" + comslm_1.levsoff[icm] = 0; +#line 6162 "" + comslm_1.levson[icm] = 0; +#line 6163 "" + comslm_1.slmon[icm] = FALSE_; +#line 6164 "" + } +#line 6165 "" + } +#line 6166 "" + } +#line 6167 "" + } +#line 6168 "" + isdat1[isdat] = isdata; +#line 6169 "" + } +#line 6170 "" +/* L1: */ +#line 6170 "" + } + +/* Clear and collapse the slur data list */ + +#line 6174 "" + numdrop = 0; +#line 6175 "" + i__1 = *nsdat; +#line 6175 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6176 "" + if (isdat1[isdat] == 0) { +#line 6177 "" + ++numdrop; +#line 6178 "" + } else if (numdrop > 0) { +#line 6179 "" + isdat1[isdat - numdrop] = isdat1[isdat]; +#line 6180 "" + isdat2[isdat - numdrop] = isdat2[isdat]; +#line 6181 "" + isdat3[isdat - numdrop] = isdat3[isdat]; +#line 6182 "" + isdat4[isdat - numdrop] = isdat4[isdat]; +#line 6183 "" + isdat1[isdat] = 0; +#line 6184 "" + isdat2[isdat] = 0; +#line 6185 "" + isdat3[isdat] = 0; +#line 6186 "" + isdat4[isdat] = 0; +#line 6187 "" + } +#line 6188 "" +/* L2: */ +#line 6188 "" + } +#line 6189 "" + *nsdat -= numdrop; +/* call report(nsdat,isdat1,isdat2) */ +#line 6191 "" + return 0; +} /* dopsslur_ */ + +/* Subroutine */ int doslur_(integer *nolev, integer *isdat1, integer *isdat2, + integer *isdat3, integer *nsdat, integer *ip, integer *iv, integer * + kv, integer *nv, logical *beamon, integer *ncm, char *soutq, integer * + lsout, char *ulq, integer *islur, integer *ipl, integer *iornq, + integer *islhgt, real *tno, integer *nacc, ftnlen soutq_len, ftnlen + ulq_len) +{ + /* System generated locals */ + address a__1[3], a__2[2], a__3[4]; + integer i__1, i__2, i__3[3], i__4[2], i__5[4], i__6; + char ch__1[1], ch__2[6]; + icilist ici__1; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), e_wsfi(void); + + /* Local variables */ + static integer ivoffinc; + extern integer igetbits_(integer *, integer *, integer *); + static integer j, icm; + extern integer log2_(integer *); + static integer imid; + extern /* Character */ VOID chax_(char *, ftnlen, integer *), udfq_(char * + , ftnlen, integer *, integer *), udqq_(char *, ftnlen, integer *, + integer *, integer *, integer *, integer *, integer *); + extern integer lfmt1_(real *); + extern /* Subroutine */ int stop1_(void); + static integer ihoff; + static logical iscrd; + static integer isdat, ivoff; + static real shift; + static integer iupdn, lform, lnote; + static char noteq[8]; + static logical tmove; + static integer idcode, isdata; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer isdats; + static logical settie, sfound, tfound; + static integer isdatt; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer nolevt, nolevs; + extern /* Subroutine */ int printl_(char *, ftnlen); + static logical stemup; + static char notexq[79]; + static integer lnoten; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + static integer numdrop; + static char slurudq[1]; + + /* Fortran I/O blocks */ + static cilist io___473 = { 0, 6, 0, 0, 0 }; + static cilist io___475 = { 0, 6, 0, 0, 0 }; + static cilist io___476 = { 0, 6, 0, 0, 0 }; + static cilist io___477 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___485 = { 0, 6, 0, 0, 0 }; + + + +/* Called once per main note. (5/26/02) for non-ps slurs only */ + +/* 130316 */ + +/* Bits in isdat1: */ +/* 13-17 iv */ +/* 3-10 ip */ +/* 11 start/stop switch */ +/* 12 kv-1 */ +/* 19-25 ichar(code$) */ +/* 26 force direction? */ +/* 27 forced dir'n = up if on, set in sslur; also */ +/* final direction, set in doslur when beam is started, used on term. */ +/* 28-31 ndxslur, set in doslur when beam is started, used on term. */ + +/* Bits in isdat2 */ +/* 0 Chord switch. Not set on main note. */ +/* 1-2 left/right notehead shift. Set only for chord note. */ +/* 3 tie positioning */ +/* 4 dotted flag */ +/* 6-11 voff1 1-63 => -31...+31 */ +/* 12-18 hoff1 1-127 => -6.3...+6.3 */ +/* 19-25 nolev */ + +/* Bits in isdat3: Only used for slur endings */ +/* 0 set if midslur (at least one argument) */ +/* 1 set if curve (2 more args) */ +/* 2-7 32+first arg (height correction) (1st arg may be negative) */ +/* 8-10 second arg (initial slope) */ +/* 11-13 third arg (closing slope) */ + +/* In listslur bit ib is on if slur index ib is in use, ib=0-23. */ +/* ndxslur = slur index */ +/* Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note, */ +/* s-slur is blank (idcode=32), t-slur is idcode=1. */ +/* ivoff is user-defined shift or shift due to . or _ , or chord adjustment. */ +/* Ivoff will be set for ./_ only if no user-defined shift is specified. */ +/* If highest note has upslur, save slur height in islhgt in case */ +/* ornament must be moved. */ + +#line 6269 "" + /* Parameter adjustments */ +#line 6269 "" + --isdat3; +#line 6269 "" + --isdat2; +#line 6269 "" + --isdat1; +#line 6269 "" + +#line 6269 "" + /* Function Body */ +#line 6269 "" + *islhgt = 0; +#line 6270 "" + if (*beamon) { +#line 6271 "" + stemup = *(unsigned char *)ulq == 'u'; +#line 6272 "" + } else if (commvl_1.nvmx[*iv - 1] == 2) { +#line 6273 "" + if (! bit_test(*islur,30)) { + +/* Single note, 2 lines of music, stem direction not forced */ + +#line 6277 "" + stemup = commvl_1.ivx > *nv; +#line 6278 "" + } else { +#line 6279 "" + stemup = bit_test(*islur,17); +#line 6280 "" + } +#line 6281 "" + } else { +#line 6282 "" + udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], & + commvl_1.ivx, nv); +#line 6282 "" + stemup = *(unsigned char *)&ch__1[0] == 'u'; +#line 6283 "" + } +#line 6284 "" + iscrd = bit_test(*ipl,10); +#line 6285 "" + if (bit_test(*islur,1)) { + +/* 't'-slur (idcode=1) somewhere on this note. Find it, check height against */ +/* 's'-slur (idcode=32) */ + +#line 6290 "" + sfound = FALSE_; +#line 6291 "" + tfound = FALSE_; +#line 6292 "" + tmove = FALSE_; +#line 6293 "" + i__1 = *nsdat; +#line 6293 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6294 "" + 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 6297 "" + if (! tfound) { +#line 6298 "" + tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1; +#line 6299 "" + if (tfound) { +#line 6300 "" + nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 6301 "" + isdatt = isdat; +#line 6302 "" + if (sfound) { +#line 6302 "" + goto L6; +#line 6302 "" + } +#line 6303 "" + } +#line 6304 "" + } +#line 6305 "" + if (! sfound) { +#line 6306 "" + sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32; +#line 6307 "" + if (sfound) { +#line 6308 "" + nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 6309 "" + isdats = isdat; +#line 6310 "" + if (tfound) { +#line 6310 "" + goto L6; +#line 6310 "" + } +#line 6311 "" + } +#line 6312 "" + } +#line 6313 "" + } +#line 6314 "" +/* L5: */ +#line 6314 "" + } + +/* 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 6319 "" +L6: +#line 6320 "" + if (sfound && tfound) { +#line 6320 "" + tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) && + bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats], + 11) && ! bit_test(isdat1[isdatt],11)); +#line 6320 "" + } + +/* Check if 2 starts or two stops */ + + +/* This is a flag for later changing slur level, after we know slur dir'n. */ + +#line 6331 "" + } +#line 6332 "" + if (commidi_1.ismidi) { +#line 6333 "" + settie = FALSE_; +#line 6334 "" + comslm_1.dbltie = FALSE_; +#line 6335 "" + } +#line 6336 "" + i__1 = *nsdat; +#line 6336 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6337 "" + isdata = isdat1[isdat]; +#line 6338 "" + 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 6344 "" + idcode = igetbits_(&isdata, &c__7, &c__19); +#line 6345 "" + ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32; +#line 6346 "" + ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64; +#line 6347 "" + iupdn = 0; +#line 6348 "" + *(unsigned char *)slurudq = 'd'; +#line 6349 "" + nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19); +#line 6350 "" + if (bit_test(isdata,11)) { + +/* Turnon, */ + +#line 6354 "" + if (nolevs == 0 || nolevs > 60) { + +/* Note was a rest, cannot start slur on rest. */ + +#line 6358 "" + s_wsle(&io___473); +#line 6358 "" + e_wsle(); +#line 6359 "" + printl_("Cannot start slur on a rest", (ftnlen)27); +#line 6360 "" + stop1_(); +#line 6361 "" + } + +/* Get slur direction */ + +#line 6365 "" + if (bit_test(isdata,26)) { + +/* Force slur direction */ + +#line 6369 "" + if (bit_test(isdata,27)) { +#line 6369 "" + *(unsigned char *)slurudq = 'u'; +#line 6369 "" + } +#line 6370 "" + } else if (commvl_1.nvmx[*iv - 1] == 1) { + +/* Only one voice per line */ + +#line 6374 "" + if (! (*beamon)) { + +/* Separate note. */ + +#line 6378 "" + udfq_(ch__1, (ftnlen)1, nolev, ncm); +#line 6378 "" + *(unsigned char *)slurudq = *(unsigned char *)&ch__1[ + 0]; +#line 6379 "" + } else { + +/* In a beam */ + +#line 6383 "" + if (*(unsigned char *)ulq != 'u') { +#line 6383 "" + *(unsigned char *)slurudq = 'u'; +#line 6383 "" + } +#line 6384 "" + } +#line 6385 "" + if (iscrd) { +#line 6386 "" + if (nolevs > *ncm) { +#line 6387 "" + *(unsigned char *)slurudq = 'u'; +#line 6388 "" + } else { +#line 6389 "" + *(unsigned char *)slurudq = 'd'; +#line 6390 "" + } +#line 6391 "" + } +#line 6392 "" + } else { + +/* Two voices per line. Get default */ + +#line 6396 "" + if (commvl_1.ivx > *nv) { +#line 6396 "" + *(unsigned char *)slurudq = 'u'; +#line 6396 "" + } + +/* Upper voice of the two, so up slur */ + +#line 6400 "" + } + +/* Save up/down-ness for use at termination */ + +#line 6404 "" + if (*(unsigned char *)slurudq == 'u') { +#line 6404 "" + isdata = bit_set(isdata,27); +#line 6404 "" + } + +/* End of section for setting slur direction, still in "Turnon" if-block. */ + +#line 6408 "" + if (idcode == 1 && tmove) { +#line 6409 "" + iupdn = 1; +#line 6410 "" + if (*(unsigned char *)slurudq == 'd') { +#line 6410 "" + iupdn = -1; +#line 6410 "" + } +#line 6411 "" + } +#line 6412 "" + 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 6416 "" + ivoffinc = 0; +#line 6417 "" + if (stemup && *(unsigned char *)slurudq == 'd' || ! + stemup && *(unsigned char *)slurudq == 'u') { + +/* Must move the slur for _ or . */ + +#line 6422 "" + if (stemup) { +#line 6423 "" + ivoffinc = -1; +#line 6424 "" + } else { +#line 6425 "" + ivoffinc = 1; +#line 6426 "" + } +#line 6427 "" + if ((stemup && *nolev >= *ncm - 2 || ! stemup && * + nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, + abs(i__2)) % 2 == 0) { +#line 6427 "" + ivoffinc <<= 1; +#line 6427 "" + } +#line 6430 "" + ivoff += ivoffinc; +#line 6431 "" + } +#line 6432 "" + } +#line 6433 "" + if (comslur_1.listslur == 16777215) { +#line 6434 "" + s_wsle(&io___475); +#line 6434 "" + e_wsle(); +#line 6435 "" + s_wsle(&io___476); +#line 6435 "" + do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"\ + ", one too many!", (ftnlen)49); +#line 6435 "" + e_wsle(); +#line 6436 "" + s_wsfe(&io___477); +#line 6436 "" + do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"\ + "oo many!", (ftnlen)49); +#line 6436 "" + e_wsfe(); +#line 6438 "" + stop1_(); +#line 6439 "" + } + +/* Get index of next slur not in use, starting from ? down */ + +#line 6443 "" + i__2 = 16777215 - comslur_1.listslur; +#line 6443 "" + comslur_1.ndxslur = log2_(&i__2); + +/* Record slur index */ + +#line 6447 "" + comslur_1.listslur = bit_set(comslur_1.listslur, + comslur_1.ndxslur); + +/* Save for use on termination */ + +/* call setbits(isdata,4,28,ndxslur) */ +/* 080531 Allow >16 slurs */ +#line 6453 "" + i__2 = comslur_1.ndxslur % 16; +#line 6453 "" + setbits_(&isdata, &c__4, &c__28, &i__2); +#line 6454 "" + i__2 = comslur_1.ndxslur / 16; +#line 6454 "" + setbits_(&isdata, &c__1, &c__18, &i__2); + +/* Shift for stem? */ + +#line 6458 "" + if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f) + { +#line 6458 "" + ihoff += 8; +#line 6458 "" + } +#line 6460 "" + if (bit_test(isdat2[isdat],3)) { + +/* Tie spacing, (slur start) */ + +#line 6464 "" + if (*(unsigned char *)slurudq == 'd') { +#line 6465 "" + ++ivoff; +#line 6466 "" + ihoff += 8; +#line 6467 "" + } else if (*(unsigned char *)slurudq == 'u') { +#line 6468 "" + --ivoff; +#line 6469 "" + if (! (stemup && *tno < 63.f)) { +#line 6469 "" + ihoff += 8; +#line 6469 "" + } + +/* (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */ + +#line 6473 "" + } +#line 6474 "" + } +#line 6475 "" + if (iscrd) { + +/* Additional horiz shifts for h-shifted noteheads? */ + +#line 6479 "" + if (bit_test(isdat2[isdat],1)) { + +/* Slur start on left-shifted chord notehead. ASSUME downstem. */ + +#line 6483 "" + if (nolevs == comtrill_1.minlev && *(unsigned char *) + slurudq == 'd') { +#line 6484 "" + ihoff += -2; +#line 6485 "" + } else { +#line 6486 "" + ihoff += -10; +#line 6487 "" + } +#line 6488 "" + } else if (bit_test(isdat2[isdat],2)) { + +/* Right shifted chord notehead. ASSUME upstem. */ + +#line 6492 "" + if (nolevs == comtrill_1.maxlev && *(unsigned char *) + slurudq == 'u') { +#line 6493 "" + ihoff += 2; +#line 6494 "" + } else { +#line 6495 "" + ihoff += 10; +#line 6496 "" + } +#line 6497 "" + } +#line 6498 "" + } +#line 6499 "" + if (ihoff == 0) { + +/* Write stuff for non-shifted start */ + +/* Writing concatenation */ +#line 6503 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6503 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 6503 "" + i__3[1] = 5, a__1[1] = "islur"; +#line 6503 "" + i__3[2] = 1, a__1[2] = slurudq; +#line 6503 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6504 "" + lnote = 7; +#line 6505 "" + } else { +/* Writing concatenation */ +#line 6506 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6506 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 6506 "" + i__3[1] = 2, a__1[1] = "is"; +#line 6506 "" + i__3[2] = 1, a__1[2] = slurudq; +#line 6506 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6507 "" + lnote = 4; +#line 6508 "" + } +#line 6509 "" + if (bit_test(isdat2[isdat],4)) { + +/* Dotted slur */ + +#line 6513 "" + s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79); +/* Writing concatenation */ +#line 6514 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6514 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 6514 "" + i__3[1] = 6, a__1[1] = "dotted"; +#line 6514 "" + i__3[2] = 8, a__1[2] = noteq; +#line 6514 "" + s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79); +#line 6515 "" + lnote += 7; +#line 6516 "" + } + +/* Add slur index to string */ +/* c Print 11-ndxslur */ +/* Print 23-ndxslur */ + +/* if (11-ndxslur .lt. 10) then */ +#line 6523 "" + if (23 - comslur_1.ndxslur < 10) { + +/* 5/25/08 Allow 24 slurs */ + +/* notexq = notexq(1:lnote)//chax(59-ndxslur) */ +/* Writing concatenation */ +#line 6528 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6528 "" + i__2 = 71 - comslur_1.ndxslur; +#line 6528 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6528 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 6528 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6529 "" + ++lnote; +#line 6530 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ +/* Writing concatenation */ +#line 6532 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6532 "" + i__5[1] = 2, a__3[1] = "{1"; +#line 6532 "" + i__2 = 61 - comslur_1.ndxslur; +#line 6532 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6532 "" + i__5[2] = 1, a__3[2] = ch__1; +#line 6532 "" + i__5[3] = 1, a__3[3] = "}"; +#line 6532 "" + s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6533 "" + lnote += 4; +#line 6534 "" + } else { +/* Writing concatenation */ +#line 6535 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6535 "" + i__5[1] = 2, a__3[1] = "{2"; +#line 6535 "" + i__2 = 51 - comslur_1.ndxslur; +#line 6535 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6535 "" + i__5[2] = 1, a__3[2] = ch__1; +#line 6535 "" + i__5[3] = 1, a__3[3] = "}"; +#line 6535 "" + s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6536 "" + lnote += 4; +#line 6537 "" + } + +/* Add note name to string */ + +#line 6541 "" + i__2 = nolevs + iupdn + ivoff; +#line 6541 "" + notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +/* Writing concatenation */ +#line 6542 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6542 "" + i__4[1] = lnoten, a__2[1] = noteq; +#line 6542 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6543 "" + lnote += lnoten; + +/* Save height (for ornament and barnobox interference) if topmost slur is up */ + +#line 6547 "" + if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ + isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6549 "" + *islhgt = nolevs + iupdn + ivoff; + +/* Save height & idcode if top voice and slur start */ + +#line 6553 "" + if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv + - 1] * 24 - 25] && *islhgt > comsln_1.is1n1) { +#line 6554 "" + comsln_1.is1n1 = *islhgt; +#line 6555 "" + comsln_1.is2n1 = idcode; +#line 6556 "" + } +#line 6557 "" + } +#line 6558 "" + if ((real) ihoff != 0.f) { +#line 6559 "" + shift = ihoff * .1f; +/* Writing concatenation */ +#line 6560 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6560 "" + i__4[1] = 1, a__2[1] = "{"; +#line 6560 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6561 "" + ++lnote; +#line 6562 "" + lform = lfmt1_(&shift); +#line 6563 "" + i__2 = lnote; +#line 6563 "" + ici__1.icierr = 0; +#line 6563 "" + ici__1.icirnum = 1; +#line 6563 "" + ici__1.icirlen = lnote + lform - i__2; +#line 6563 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 6563 "" + i__3[0] = 2, a__1[0] = "(f"; +#line 6563 "" + i__6 = lform + 48; +#line 6563 "" + chax_(ch__1, (ftnlen)1, &i__6); +#line 6563 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 6563 "" + i__3[2] = 3, a__1[2] = ".1)"; +#line 6563 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) + 6), ch__2); +#line 6563 "" + s_wsfi(&ici__1); +#line 6563 "" + do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6563 "" + e_wsfi(); +#line 6565 "" + lnote += lform; +/* Writing concatenation */ +#line 6566 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6566 "" + i__4[1] = 1, a__2[1] = "}"; +#line 6566 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6567 "" + ++lnote; +#line 6568 "" + } +#line 6569 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); + +/* Zero out ip1 to avoid problems if slur goes to next input blk. */ + +#line 6573 "" + 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 6577 "" + if (commidi_1.ismidi && idcode == 32) { +/* levson(midchan(iv,kv)) = nolevs */ +/* 130316 */ +/* levson(midchan(iv,kv)) = nolevs-iTransAmt(instno(iv)) */ +#line 6581 "" + comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] = + nolevs + commvel_1.miditran[cominsttrans_1.instno[ + *iv - 1] - 1]; +#line 6582 "" + if (settie) { +#line 6582 "" + comslm_1.dbltie = TRUE_; +#line 6582 "" + } + +/* 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 6587 "" + } +#line 6588 "" + } else { + +/* Slur is ending. Back thru list to find starting slur */ + +#line 6592 "" + for (j = isdat - 1; j >= 1; --j) { +#line 6593 "" + if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv == + igetbits_(&isdat1[j], &c__1, &c__12) + 1) { +#line 6595 "" + if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) { +#line 6596 "" + comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, & + c__28) + (igetbits_(&isdat1[j], &c__1, & + c__18) << 4); + +/* 080531 Allow >16 slurs */ + +#line 6601 "" + if (bit_test(isdat1[j],27)) { +#line 6601 "" + *(unsigned char *)slurudq = 'u'; +#line 6601 "" + } +#line 6602 "" + goto L4; +#line 6603 "" + } +#line 6604 "" + } +#line 6605 "" +/* L3: */ +#line 6605 "" + } +#line 6606 "" + s_wsle(&io___485); +#line 6606 "" + do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19); +#line 6606 "" + e_wsle(); +#line 6607 "" + stop1_(); +#line 6608 "" +L4: +#line 6609 "" + if (nolevs == 0 || nolevs > 60) { + +/* Ending is on a rest, reset nolevs to default starting height */ + +#line 6613 "" + nolevs = igetbits_(&isdat2[j], &c__7, &c__19); +#line 6614 "" + } +#line 6615 "" + if (bit_test(isdat3[isdat],0)) { + +/* Deal with \curve or \midslur */ + +#line 6619 "" + imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; + +/* Remember, only dealing with non-ps slurs */ + +/* Who knows where the following line came from. Removed it 6/30/02 to */ +/* restore behavior of non-ps slurs to old way */ +/* if (slurudq .eq. 'd') imid = -imid */ +/* 3/8/03 added the following */ + +#line 6628 "" + if (*(unsigned char *)slurudq == 'd') { +#line 6628 "" + imid = -abs(imid); +#line 6628 "" + } + +#line 6630 "" + if (bit_test(isdat3[isdat],1)) { +/* Writing concatenation */ +#line 6631 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6631 "" + i__4[0] = 1, a__2[0] = ch__1; +#line 6631 "" + i__4[1] = 5, a__2[1] = "curve"; +#line 6631 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6632 "" + lnote = 6; +#line 6633 "" + } else { +/* Writing concatenation */ +#line 6634 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6634 "" + i__4[0] = 1, a__2[0] = ch__1; +#line 6634 "" + i__4[1] = 7, a__2[1] = "midslur"; +#line 6634 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6635 "" + lnote = 8; +#line 6636 "" + } +#line 6637 "" + if (imid < 0 || imid > 9) { + +/* Need brackets */ + +/* Writing concatenation */ +#line 6641 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6641 "" + i__4[1] = 1, a__2[1] = "{"; +#line 6641 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6642 "" + ++lnote; +#line 6643 "" + if (imid < -9) { +#line 6644 "" + i__2 = lnote; +#line 6644 "" + ici__1.icierr = 0; +#line 6644 "" + ici__1.icirnum = 1; +#line 6644 "" + ici__1.icirlen = lnote + 3 - i__2; +#line 6644 "" + ici__1.iciunit = notexq + i__2; +#line 6644 "" + ici__1.icifmt = "(i3)"; +#line 6644 "" + s_wsfi(&ici__1); +#line 6644 "" + do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( + integer)); +#line 6644 "" + e_wsfi(); +#line 6645 "" + lnote += 3; +#line 6646 "" + } else if (imid < 0 || imid > 9) { +#line 6647 "" + i__2 = lnote; +#line 6647 "" + ici__1.icierr = 0; +#line 6647 "" + ici__1.icirnum = 1; +#line 6647 "" + ici__1.icirlen = lnote + 2 - i__2; +#line 6647 "" + ici__1.iciunit = notexq + i__2; +#line 6647 "" + ici__1.icifmt = "(i2)"; +#line 6647 "" + s_wsfi(&ici__1); +#line 6647 "" + do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( + integer)); +#line 6647 "" + e_wsfi(); +#line 6648 "" + lnote += 2; +#line 6649 "" + } else { +#line 6650 "" + i__2 = lnote; +#line 6650 "" + ici__1.icierr = 0; +#line 6650 "" + ici__1.icirnum = 1; +#line 6650 "" + ici__1.icirlen = lnote + 1 - i__2; +#line 6650 "" + ici__1.iciunit = notexq + i__2; +#line 6650 "" + ici__1.icifmt = "(i1)"; +#line 6650 "" + s_wsfi(&ici__1); +#line 6650 "" + do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( + integer)); +#line 6650 "" + e_wsfi(); +#line 6651 "" + ++lnote; +#line 6652 "" + } +/* Writing concatenation */ +#line 6653 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6653 "" + i__4[1] = 1, a__2[1] = "}"; +#line 6653 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6654 "" + ++lnote; +#line 6655 "" + } else { + +/* 1=<imid=<9, no brackets */ + +/* Writing concatenation */ +#line 6659 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6659 "" + *(unsigned char *)&ch__1[0] = imid + 48; +#line 6659 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 6659 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6660 "" + ++lnote; +#line 6661 "" + } +#line 6662 "" + if (bit_test(isdat3[isdat],1)) { + +/* \curve; 3 args */ + +/* Writing concatenation */ +#line 6666 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6666 "" + *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] + , &c__3, &c__8) + 48; +#line 6666 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 6666 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +/* Writing concatenation */ +#line 6668 "" + i__4[0] = lnote + 1, a__2[0] = notexq; +#line 6668 "" + *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] + , &c__3, &c__11) + 48; +#line 6668 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 6668 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6670 "" + lnote += 2; +#line 6671 "" + } +#line 6672 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen) + 80); +#line 6673 "" + } + +/* Shift slur ending for stem on any note? */ + +#line 6677 "" + if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < + 63.f) { +#line 6677 "" + ihoff += -8; +#line 6677 "" + } +#line 6679 "" + if (bit_test(isdat2[isdat],3)) { + +/* Shift ending for tie spacing */ + +#line 6683 "" + if (*(unsigned char *)slurudq == 'u') { +#line 6684 "" + ihoff += -8; +#line 6685 "" + --ivoff; +#line 6686 "" + } else if (*(unsigned char *)slurudq == 'd') { +#line 6687 "" + ++ivoff; +#line 6688 "" + if (stemup || *tno > 63.f) { +#line 6688 "" + ihoff += -8; +#line 6688 "" + } +#line 6689 "" + } +#line 6690 "" + } +#line 6691 "" + if (iscrd) { + +/* Shift termination for shifted notehead? */ + +#line 6695 "" + if (bit_test(isdat2[isdat],1)) { + +/* Left-shifted chord notehead. ASSUME downstem. */ + +#line 6699 "" + if (nolevs == comtrill_1.minlev && *(unsigned char *) + slurudq == 'd') { +#line 6700 "" + ihoff += -2; +#line 6701 "" + } else { +#line 6702 "" + ihoff += -10; +#line 6703 "" + } +#line 6704 "" + } else if (bit_test(isdat2[isdat],2)) { + +/* Right shifted chord notehead. ASSUME upstem. */ + +#line 6708 "" + if (nolevs == comtrill_1.maxlev && *(unsigned char *) + slurudq == 'u') { +#line 6709 "" + ihoff += 2; +#line 6710 "" + } else { +#line 6711 "" + ihoff += 10; +#line 6712 "" + } +#line 6713 "" + } +#line 6714 "" + } +#line 6715 "" + if (ihoff == 0) { +/* Writing concatenation */ +#line 6716 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6716 "" + i__4[0] = 1, a__2[0] = ch__1; +#line 6716 "" + i__4[1] = 5, a__2[1] = "tslur"; +#line 6716 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6717 "" + lnote = 6; +#line 6718 "" + } else { + +/* Shift needed */ + +/* Writing concatenation */ +#line 6722 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6722 "" + i__4[0] = 1, a__2[0] = ch__1; +#line 6722 "" + i__4[1] = 2, a__2[1] = "ts"; +#line 6722 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6723 "" + lnote = 3; +#line 6724 "" + } + +/* Print 23-ndxslur */ +/* 5/25/08 Allow 14 slurs (???????????) */ + +#line 6729 "" + if (23 - comslur_1.ndxslur < 10) { +/* Writing concatenation */ +#line 6730 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6730 "" + i__2 = 71 - comslur_1.ndxslur; +#line 6730 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6730 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 6730 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6731 "" + ++lnote; +#line 6732 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* Writing concatenation */ +#line 6733 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6733 "" + i__5[1] = 2, a__3[1] = "{1"; +#line 6733 "" + i__2 = 61 - comslur_1.ndxslur; +#line 6733 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6733 "" + i__5[2] = 1, a__3[2] = ch__1; +#line 6733 "" + i__5[3] = 1, a__3[3] = "}"; +#line 6733 "" + s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6734 "" + lnote += 4; +#line 6735 "" + } else { +/* Writing concatenation */ +#line 6736 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 6736 "" + i__5[1] = 2, a__3[1] = "{2"; +#line 6736 "" + i__2 = 51 - comslur_1.ndxslur; +#line 6736 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6736 "" + i__5[2] = 1, a__3[2] = ch__1; +#line 6736 "" + i__5[3] = 1, a__3[3] = "}"; +#line 6736 "" + s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6737 "" + lnote += 4; +#line 6738 "" + } +#line 6739 "" + 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 6743 "" + ivoffinc = 0; +#line 6744 "" + if (stemup && *(unsigned char *)slurudq == 'd' || ! + stemup && *(unsigned char *)slurudq == 'u') { +#line 6746 "" + if (stemup) { +#line 6747 "" + ivoffinc = -1; +#line 6748 "" + } else { +#line 6749 "" + ivoffinc = 1; +#line 6750 "" + } +#line 6751 "" + if ((stemup && *nolev >= *ncm - 2 || ! stemup && * + nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, + abs(i__2)) % 2 == 0) { +#line 6751 "" + ivoffinc <<= 1; +#line 6751 "" + } +#line 6754 "" + } +#line 6755 "" + ivoff += ivoffinc; +#line 6756 "" + } +#line 6757 "" + if (idcode == 1 && tmove) { + +/* t-slur height adjustment */ + +#line 6761 "" + iupdn = 1; +#line 6762 "" + if (*(unsigned char *)slurudq == 'd') { +#line 6762 "" + iupdn = -1; +#line 6762 "" + } +#line 6763 "" + } +#line 6764 "" + i__2 = nolevs + iupdn + ivoff; +#line 6764 "" + notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +#line 6765 "" + if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ + isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6767 "" + *islhgt = nolevs + iupdn + ivoff; + +/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ + +#line 6771 "" + if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv + - 1] * 24 - 25] && comsln_1.is1n1 > 0) { +#line 6772 "" + if (idcode == comsln_1.is2n1) { +#line 6772 "" + comsln_1.is1n1 = 0; +#line 6772 "" + } +#line 6773 "" + } +#line 6774 "" + } +/* Writing concatenation */ +#line 6775 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6775 "" + i__4[1] = lnoten, a__2[1] = noteq; +#line 6775 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6776 "" + lnote += lnoten; +#line 6777 "" + if (ihoff != 0) { +#line 6778 "" + shift = ihoff * .1f; +/* Writing concatenation */ +#line 6779 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6779 "" + i__4[1] = 1, a__2[1] = "{"; +#line 6779 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6780 "" + ++lnote; +#line 6781 "" + lform = lfmt1_(&shift); +#line 6782 "" + i__2 = lnote; +#line 6782 "" + ici__1.icierr = 0; +#line 6782 "" + ici__1.icirnum = 1; +#line 6782 "" + ici__1.icirlen = lnote + lform - i__2; +#line 6782 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 6782 "" + i__3[0] = 2, a__1[0] = "(f"; +#line 6782 "" + i__6 = lform + 48; +#line 6782 "" + chax_(ch__1, (ftnlen)1, &i__6); +#line 6782 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 6782 "" + i__3[2] = 3, a__1[2] = ".1)"; +#line 6782 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) + 6), ch__2); +#line 6782 "" + s_wsfi(&ici__1); +#line 6782 "" + do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6782 "" + e_wsfi(); +#line 6784 "" + lnote += lform; +/* Writing concatenation */ +#line 6785 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 6785 "" + i__4[1] = 1, a__2[1] = "}"; +#line 6785 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6786 "" + ++lnote; +#line 6787 "" + } +#line 6788 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); + +/* Clear the bit from list of slurs in use */ + +#line 6792 "" + comslur_1.listslur = bit_clear(comslur_1.listslur, + comslur_1.ndxslur); + +/* Zero out the entire strings for start and stop */ + +#line 6796 "" + isdata = 0; +#line 6797 "" + isdat2[isdat] = 0; +#line 6798 "" + isdat1[j] = 0; +#line 6799 "" + isdat2[j] = 0; +#line 6800 "" + isdat3[isdat] = 0; + +/* Set midi info for slur ending */ + +#line 6804 "" + if (commidi_1.ismidi && idcode == 32) { +#line 6805 "" + icm = commidi_1.midchan[*iv + *kv * 24 - 25]; +#line 6806 "" + 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 6810 "" + if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ + *iv - 1] - 1] == comslm_1.levson[icm] && (7 & + *nacc) == 0) { + +/* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */ + +/* levsoff(icm) = nolevs */ +/* 130316 */ +/* levsoff(icm) = nolevs-iTransAmt(instno(iv)) */ +#line 6818 "" + comslm_1.levsoff[icm] = nolevs + + commvel_1.miditran[cominsttrans_1.instno[* + iv - 1] - 1]; +#line 6819 "" + settie = TRUE_; +#line 6820 "" + } else { +#line 6821 "" + comslm_1.levsoff[icm] = 0; +#line 6822 "" + comslm_1.levson[icm] = 0; +#line 6823 "" + comslm_1.slmon[icm] = FALSE_; +#line 6824 "" + } +#line 6825 "" + } +#line 6826 "" + } +#line 6827 "" + } +#line 6828 "" + isdat1[isdat] = isdata; +#line 6829 "" + } +#line 6830 "" +/* L1: */ +#line 6830 "" + } + +/* Clear and collapse the slur data list */ + +#line 6834 "" + numdrop = 0; +#line 6835 "" + i__1 = *nsdat; +#line 6835 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +#line 6836 "" + if (isdat1[isdat] == 0) { +#line 6837 "" + ++numdrop; +#line 6838 "" + } else if (numdrop > 0) { +#line 6839 "" + isdat1[isdat - numdrop] = isdat1[isdat]; +#line 6840 "" + isdat2[isdat - numdrop] = isdat2[isdat]; +#line 6841 "" + isdat3[isdat - numdrop] = isdat3[isdat]; +#line 6842 "" + isdat1[isdat] = 0; +#line 6843 "" + isdat2[isdat] = 0; +#line 6844 "" + isdat3[isdat] = 0; +#line 6845 "" + } +#line 6846 "" +/* L2: */ +#line 6846 "" + } +#line 6847 "" + *nsdat -= numdrop; +/* call report(nsdat,isdat1,isdat2) */ +#line 6849 "" + return 0; +} /* doslur_ */ + +/* Subroutine */ int dotmov_(real *updot, real *rtdot, char *soutq, integer * + lsout, integer *iddot, ftnlen soutq_len) +{ + /* System generated locals */ + address a__1[5], a__2[8], a__3[5]; + integer i__1[5], i__2, i__3, i__4[8], i__5[5], i__6; + char ch__1[1], ch__2[22], ch__3[1], ch__4[37], ch__5[15], ch__6[1]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + static char sq[1]; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern integer lfmt1_(real *); + static integer lnote; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer lfmtup, lfmtrt; + static char notexq[80]; + + +/* iddot = 0 for single dot, 1 for double */ + +#line 6857 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6857 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 6858 "" + lfmtup = lfmt1_(updot); +#line 6859 "" + lfmtrt = lfmt1_(rtdot); +#line 6860 "" + ici__1.icierr = 0; +#line 6860 "" + ici__1.icirnum = 1; +#line 6860 "" + ici__1.icirlen = 80; +#line 6860 "" + ici__1.iciunit = notexq; +/* Writing concatenation */ +#line 6860 "" + i__1[0] = 6, a__1[0] = "(a37,f"; +#line 6860 "" + i__2 = lfmtup + 48; +#line 6860 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6860 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 6860 "" + i__1[2] = 7, a__1[2] = ".1,a2,f"; +#line 6860 "" + i__3 = lfmtrt + 48; +#line 6860 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 6860 "" + i__1[3] = 1, a__1[3] = ch__3; +#line 6860 "" + i__1[4] = 7, a__1[4] = ".1,a15)"; +#line 6860 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2); +#line 6860 "" + s_wsfi(&ici__1); +/* Writing concatenation */ +#line 6860 "" + i__4[0] = 1, a__2[0] = sq; +#line 6860 "" + i__4[1] = 12, a__2[1] = "makeatletter"; +#line 6860 "" + i__4[2] = 1, a__2[2] = sq; +#line 6860 "" + i__4[3] = 3, a__2[3] = "def"; +#line 6860 "" + i__4[4] = 1, a__2[4] = sq; +#line 6860 "" + i__4[5] = 12, a__2[5] = "C@Point#1#2{"; +#line 6860 "" + i__4[6] = 1, a__2[6] = sq; +#line 6860 "" + i__4[7] = 6, a__2[7] = "PMXpt{"; +#line 6860 "" + s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37); +#line 6860 "" + do_fio(&c__1, ch__4, (ftnlen)37); +#line 6860 "" + do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real)); +#line 6860 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 6860 "" + do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 6860 "" + i__5[0] = 1, a__3[0] = "}"; +#line 6860 "" + i__6 = *iddot + 48; +#line 6860 "" + chax_(ch__6, (ftnlen)1, &i__6); +#line 6860 "" + i__5[1] = 1, a__3[1] = ch__6; +#line 6860 "" + i__5[2] = 1, a__3[2] = "}"; +#line 6860 "" + i__5[3] = 1, a__3[3] = sq; +#line 6860 "" + i__5[4] = 11, a__3[4] = "makeatother"; +#line 6860 "" + s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15); +#line 6860 "" + do_fio(&c__1, ch__5, (ftnlen)15); +#line 6860 "" + e_wsfi(); + +/* Example of string just created: */ +/* \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */ + +#line 6869 "" + lnote = lfmtup + 54 + lfmtrt; +#line 6870 "" + addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); +#line 6871 "" + return 0; +} /* dotmov_ */ + +/* Subroutine */ int dotrill_(integer *iv, integer *ip, integer *iornq, char * + noteq, integer *lnoten, char *notexq, integer *lnote, ftnlen + noteq_len, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1, i__2[2], i__3[3], i__4; + char ch__1[1], ch__2[6]; + icilist ici__1; + + /* Builtin functions */ + integer 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_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + static integer itr; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nfmt; + static logical tronly; + + /* Fortran I/O blocks */ + static cilist io___495 = { 0, 6, 0, 0, 0 }; + + +#line 6881 "" + i__1 = comtrill_1.ntrill; +#line 6881 "" + for (itr = 1; itr <= i__1; ++itr) { +#line 6882 "" + if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[ + itr - 1]) { +#line 6882 "" + goto L2; +#line 6882 "" + } +#line 6883 "" +/* L1: */ +#line 6883 "" + } +#line 6884 "" + s_wsle(&io___495); +#line 6884 "" + do_lio(&c__9, &c__1, "Problem in dotrill. Call Dr. Don", (ftnlen)33); +#line 6884 "" + e_wsle(); +#line 6885 "" + s_stop("", (ftnlen)0); +#line 6886 "" +L2: +#line 6887 "" + tronly = comtrill_1.xnsktr[itr - 1] < .01f; +#line 6888 "" + if (tronly) { +/* Writing concatenation */ +#line 6889 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6889 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 6889 "" + i__2[1] = 9, a__1[1] = "zcharnote"; +#line 6889 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6890 "" + *lnote = 10; +#line 6891 "" + } else if (bit_test(*iornq,7)) { +/* Writing concatenation */ +#line 6892 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6892 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 6892 "" + i__2[1] = 6, a__1[1] = "Trille"; +#line 6892 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6893 "" + *lnote = 7; +#line 6894 "" + } else { +/* Writing concatenation */ +#line 6895 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6895 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 6895 "" + i__2[1] = 6, a__1[1] = "trille"; +#line 6895 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6896 "" + *lnote = 7; +#line 6897 "" + } +/* Writing concatenation */ +#line 6898 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 6898 "" + i__3[1] = *lnoten, a__2[1] = noteq; +#line 6898 "" + i__3[2] = 1, a__2[2] = "{"; +#line 6898 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 6899 "" + *lnote = *lnote + *lnoten + 1; + +/* Write trill duration to nearest tenth of a noteskip */ + +#line 6903 "" + if (tronly) { +/* Writing concatenation */ +#line 6904 "" + i__3[0] = *lnote, a__2[0] = notexq; +#line 6904 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6904 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 6904 "" + i__3[2] = 6, a__2[2] = "it tr}"; +#line 6904 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 6905 "" + *lnote += 7; +#line 6906 "" + return 0; +#line 6907 "" + } +#line 6908 "" + if (comtrill_1.xnsktr[itr - 1] < .95f) { +#line 6909 "" + nfmt = 2; +#line 6910 "" + } else if (comtrill_1.xnsktr[itr - 1] < 9.95f) { +#line 6911 "" + nfmt = 3; +#line 6912 "" + } else { +#line 6913 "" + nfmt = 4; +#line 6914 "" + } +#line 6915 "" + i__1 = *lnote; +#line 6915 "" + ici__1.icierr = 0; +#line 6915 "" + ici__1.icirnum = 1; +#line 6915 "" + ici__1.icirlen = *lnote + nfmt - i__1; +#line 6915 "" + ici__1.iciunit = notexq + i__1; +/* Writing concatenation */ +#line 6915 "" + i__3[0] = 2, a__2[0] = "(f"; +#line 6915 "" + i__4 = nfmt + 48; +#line 6915 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 6915 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 6915 "" + i__3[2] = 3, a__2[2] = ".1)"; +#line 6915 "" + ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2); +#line 6915 "" + s_wsfi(&ici__1); +#line 6915 "" + do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real)); +#line 6915 "" + e_wsfi(); +#line 6917 "" + *lnote += nfmt; +/* Writing concatenation */ +#line 6918 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 6918 "" + i__2[1] = 1, a__1[1] = "}"; +#line 6918 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 6919 "" + ++(*lnote); +#line 6920 "" + return 0; +} /* dotrill_ */ + +/* Subroutine */ int endslur_(logical *stemup, logical *upslur, integer * + nolev, integer *iupdn, integer *ndxslur, integer *ivoff, integer *ncm, + char *soutq, integer *lsout, logical *fontslur, ftnlen soutq_len) +{ + /* System generated locals */ + address a__1[2], a__2[4]; + integer i__1[2], i__2, i__3[4]; + char ch__1[1]; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static logical shift; + static integer lnote; + static char noteq[8]; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen), notefq_(char *, integer *, integer *, integer *, + ftnlen); + static integer lnoten; + static char notexq[79]; + + +/* Only called to end slur started in dograce. */ + +#line 6932 "" + shift = ! (*stemup) && ! (*upslur); +#line 6933 "" + if (! shift) { + +/* No shift needed */ + +/* Writing concatenation */ +#line 6937 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6937 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 6937 "" + i__1[1] = 5, a__1[1] = "tslur"; +#line 6937 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6938 "" + lnote = 6; +#line 6939 "" + } else { + +/* Shift needed */ + +/* Writing concatenation */ +#line 6943 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 6943 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 6943 "" + i__1[1] = 2, a__1[1] = "ts"; +#line 6943 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6944 "" + lnote = 3; +#line 6945 "" + } +/* if (ndxslur .lt. 10) then */ +/* notexq = notexq(1:lnote)//chax(48+ndxslur) */ +/* lnote = lnote+1 */ +/* else */ +/* notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}' */ +/* lnote = lnote+4 */ +/* end if */ + +/* c Print 11-ndxslur */ +/* Print 23-ndxslur */ + +/* if (11-ndxslur .lt. 10) then */ +#line 6958 "" + if (23 - *ndxslur < 10) { +/* notexq = notexq(1:lnote)//chax(59-ndxslur) */ +/* Writing concatenation */ +#line 6960 "" + i__1[0] = lnote, a__1[0] = notexq; +#line 6960 "" + i__2 = 71 - *ndxslur; +#line 6960 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6960 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 6960 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6961 "" + ++lnote; +#line 6962 "" + } else if (23 - *ndxslur < 20) { +/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */ +/* Writing concatenation */ +#line 6964 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 6964 "" + i__3[1] = 2, a__2[1] = "{1"; +#line 6964 "" + i__2 = 61 - *ndxslur; +#line 6964 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6964 "" + i__3[2] = 1, a__2[2] = ch__1; +#line 6964 "" + i__3[3] = 1, a__2[3] = "}"; +#line 6964 "" + s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); +#line 6965 "" + lnote += 4; +#line 6966 "" + } else { +/* Writing concatenation */ +#line 6967 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 6967 "" + i__3[1] = 2, a__2[1] = "{2"; +#line 6967 "" + i__2 = 51 - *ndxslur; +#line 6967 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 6967 "" + i__3[2] = 1, a__2[2] = ch__1; +#line 6967 "" + i__3[3] = 1, a__2[3] = "}"; +#line 6967 "" + s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79); +#line 6968 "" + lnote += 4; +#line 6969 "" + } +#line 6970 "" + i__2 = *nolev + *iupdn + *ivoff; +#line 6970 "" + notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +/* Writing concatenation */ +#line 6971 "" + i__1[0] = lnote, a__1[0] = notexq; +#line 6971 "" + i__1[1] = lnoten, a__1[1] = noteq; +#line 6971 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6972 "" + lnote += lnoten; +#line 6973 "" + if (shift) { +#line 6974 "" + if (*fontslur) { +/* Writing concatenation */ +#line 6975 "" + i__1[0] = lnote, a__1[0] = notexq; +#line 6975 "" + i__1[1] = 5, a__1[1] = "{-.6}"; +#line 6975 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6976 "" + } else { +/* Writing concatenation */ +#line 6977 "" + i__1[0] = lnote, a__1[0] = notexq; +#line 6977 "" + i__1[1] = 5, a__1[1] = "{-.8}"; +#line 6977 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 6978 "" + } +#line 6979 "" + lnote += 5; +#line 6980 "" + } +#line 6981 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); +#line 6982 "" + return 0; +} /* endslur_ */ + +/* Subroutine */ int errmsg_(char *lineq, integer *iccount, integer *ibarno, + char *msgq, ftnlen lineq_len, ftnlen msgq_len) +{ + /* System generated locals */ + address a__1[2], a__2[5], a__3[4]; + integer i__1[2], i__2, i__3, i__4[5], i__5[4]; + real r__1; + char ch__1[18], ch__2[1], ch__3[1], ch__4[7], ch__5[79]; + cilist ci__1; + olist o__1; + cllist cl__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_wsle(cilist *), e_wsle(void), f_open(olist *), s_wsfe(cilist *), + do_fio(integer *, char *, ftnlen), e_wsfe(void), f_clos(cllist *) + ; + double r_lg10(real *); + integer i_indx(char *, char *, ftnlen, ftnlen), do_lio(integer *, integer + *, char *, ftnlen); + + /* Local variables */ + static integer i1, i10; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char outq[78]; + static integer iposn, ndigbn, ndignl, nlinep, lenmsg; + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer ibarnop; + + /* Fortran I/O blocks */ + static cilist io___505 = { 0, 6, 0, 0, 0 }; + static cilist io___508 = { 0, 19, 0, "(i6)", 0 }; + static cilist io___512 = { 0, 6, 0, "(1x,a)", 0 }; + static cilist io___513 = { 0, 15, 0, "(a)", 0 }; + static cilist io___516 = { 0, 6, 0, 0, 0 }; + static cilist io___517 = { 0, 15, 0, "(a)", 0 }; + + +#line 6994 "" + if (*iccount <= 78) { +#line 6995 "" + s_copy(outq, lineq, (ftnlen)78, (ftnlen)78); +#line 6996 "" + iposn = *iccount; +#line 6997 "" + } else { +/* Writing concatenation */ +#line 6998 "" + i__1[0] = 4, a__1[0] = "... "; +#line 6998 "" + i__1[1] = 74, a__1[1] = lineq + 54; +#line 6998 "" + s_cat(outq, a__1, i__1, &c__2, (ftnlen)78); +#line 6999 "" + iposn = *iccount - 50; +#line 7000 "" + } +#line 7001 "" + s_wsle(&io___505); +#line 7001 "" + e_wsle(); +#line 7002 "" + ibarnop = *ibarno; +#line 7003 "" + if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline > + c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) { + +/* Error is in main .pmx file */ + +/* nlinep = nline-linesinpmxmod */ +/* Correct for comments not copied into buffer */ +#line 7010 "" + nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] - + c1omget_1.linesinpmxmod; +#line 7011 "" + } else { + +/* Error is in include file */ + +#line 7015 "" + ibarnop = 0; +#line 7016 "" + nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1; +#line 7017 "" + printl_("ERROR in include file named above, description given below", + (ftnlen)58); +#line 7019 "" + } +#line 7020 "" + o__1.oerr = 0; +#line 7020 "" + o__1.ounit = 19; +#line 7020 "" + o__1.ofnmlen = 11; +#line 7020 "" + o__1.ofnm = "pmxaerr.dat"; +#line 7020 "" + o__1.orl = 0; +#line 7020 "" + o__1.osta = 0; +#line 7020 "" + o__1.oacc = 0; +#line 7020 "" + o__1.ofm = 0; +#line 7020 "" + o__1.oblnk = 0; +#line 7020 "" + f_open(&o__1); +#line 7021 "" + s_wsfe(&io___508); +#line 7021 "" + do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7021 "" + e_wsfe(); +#line 7022 "" + cl__1.cerr = 0; +#line 7022 "" + cl__1.cunit = 19; +#line 7022 "" + cl__1.csta = 0; +#line 7022 "" + f_clos(&cl__1); +/* Computing MAX */ +#line 7023 "" + r__1 = ibarnop + .1f; +#line 7023 "" + i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1); +#line 7023 "" + ndigbn = max(i__2,i__3); +#line 7024 "" + r__1 = nlinep + .1f; +#line 7024 "" + ndignl = (integer) (r_lg10(&r__1) + 1); +#line 7025 "" + lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1; + +/* Split off msgq(..) since UNIX compilers don't allow concat substring!!! */ + +#line 7029 "" + ci__1.cierr = 0; +#line 7029 "" + ci__1.ciunit = 6; +/* Writing concatenation */ +#line 7029 "" + i__4[0] = 8, a__2[0] = "(/,a15,i"; +#line 7029 "" + i__2 = ndignl + 48; +#line 7029 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7029 "" + i__4[1] = 1, a__2[1] = ch__2; +#line 7029 "" + i__4[2] = 5, a__2[2] = ",a6,i"; +#line 7029 "" + i__3 = ndigbn + 48; +#line 7029 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7029 "" + i__4[3] = 1, a__2[3] = ch__3; +#line 7029 "" + i__4[4] = 3, a__2[4] = ",$)"; +#line 7029 "" + ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); +#line 7029 "" + s_wsfe(&ci__1); +#line 7029 "" + do_fio(&c__1, " ERROR in line ", (ftnlen)15); +#line 7029 "" + do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7029 "" + do_fio(&c__1, ", bar ", (ftnlen)6); +#line 7029 "" + do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); +#line 7029 "" + e_wsfe(); +#line 7031 "" + s_wsfe(&io___512); +#line 7031 "" + do_fio(&c__1, msgq, lenmsg); +#line 7031 "" + e_wsfe(); +#line 7032 "" + ci__1.cierr = 0; +#line 7032 "" + ci__1.ciunit = 15; +/* Writing concatenation */ +#line 7032 "" + i__4[0] = 8, a__2[0] = "(/,a15,i"; +#line 7032 "" + i__2 = ndignl + 48; +#line 7032 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7032 "" + i__4[1] = 1, a__2[1] = ch__2; +#line 7032 "" + i__4[2] = 5, a__2[2] = ",a6,i"; +#line 7032 "" + i__3 = ndigbn + 48; +#line 7032 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7032 "" + i__4[3] = 1, a__2[3] = ch__3; +#line 7032 "" + i__4[4] = 3, a__2[4] = ",$)"; +#line 7032 "" + ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1); +#line 7032 "" + s_wsfe(&ci__1); +#line 7032 "" + do_fio(&c__1, " ERROR in line ", (ftnlen)15); +#line 7032 "" + do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer)); +#line 7032 "" + do_fio(&c__1, ", bar ", (ftnlen)6); +#line 7032 "" + do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer)); +#line 7032 "" + e_wsfe(); +#line 7034 "" + s_wsfe(&io___513); +#line 7034 "" + do_fio(&c__1, msgq, lenmsg); +#line 7034 "" + e_wsfe(); +#line 7035 "" + i10 = iposn / 10; +#line 7036 "" + i1 = iposn - i10 * 10; +#line 7037 "" + ci__1.cierr = 0; +#line 7037 "" + ci__1.ciunit = 6; +/* Writing concatenation */ +#line 7037 "" + i__5[0] = 1, a__3[0] = "("; +#line 7037 "" + i__2 = i10 + 48; +#line 7037 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7037 "" + i__5[1] = 1, a__3[1] = ch__2; +#line 7037 "" + i__3 = i1 + 48; +#line 7037 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7037 "" + i__5[2] = 1, a__3[2] = ch__3; +#line 7037 "" + i__5[3] = 4, a__3[3] = "x,a)"; +#line 7037 "" + ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7037 "" + s_wsfe(&ci__1); +#line 7037 "" + do_fio(&c__1, "v", (ftnlen)1); +#line 7037 "" + e_wsfe(); +#line 7038 "" + ci__1.cierr = 0; +#line 7038 "" + ci__1.ciunit = 15; +/* Writing concatenation */ +#line 7038 "" + i__5[0] = 1, a__3[0] = "("; +#line 7038 "" + i__2 = i10 + 48; +#line 7038 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7038 "" + i__5[1] = 1, a__3[1] = ch__2; +#line 7038 "" + i__3 = i1 + 48; +#line 7038 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7038 "" + i__5[2] = 1, a__3[2] = ch__3; +#line 7038 "" + i__5[3] = 4, a__3[3] = "x,a)"; +#line 7038 "" + ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7038 "" + s_wsfe(&ci__1); +#line 7038 "" + do_fio(&c__1, "v", (ftnlen)1); +#line 7038 "" + e_wsfe(); +#line 7039 "" + s_wsle(&io___516); +#line 7039 "" + do_lio(&c__9, &c__1, outq, (ftnlen)78); +#line 7039 "" + e_wsle(); +#line 7040 "" + s_wsfe(&io___517); +/* Writing concatenation */ +#line 7040 "" + i__1[0] = 1, a__1[0] = " "; +#line 7040 "" + i__1[1] = 78, a__1[1] = outq; +#line 7040 "" + s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79); +#line 7040 "" + do_fio(&c__1, ch__5, (ftnlen)79); +#line 7040 "" + e_wsfe(); +#line 7041 "" + ci__1.cierr = 0; +#line 7041 "" + ci__1.ciunit = 6; +/* Writing concatenation */ +#line 7041 "" + i__5[0] = 1, a__3[0] = "("; +#line 7041 "" + i__2 = i10 + 48; +#line 7041 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7041 "" + i__5[1] = 1, a__3[1] = ch__2; +#line 7041 "" + i__3 = i1 + 48; +#line 7041 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7041 "" + i__5[2] = 1, a__3[2] = ch__3; +#line 7041 "" + i__5[3] = 4, a__3[3] = "x,a)"; +#line 7041 "" + ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7041 "" + s_wsfe(&ci__1); +#line 7041 "" + do_fio(&c__1, "^", (ftnlen)1); +#line 7041 "" + e_wsfe(); +#line 7042 "" + ci__1.cierr = 0; +#line 7042 "" + ci__1.ciunit = 15; +/* Writing concatenation */ +#line 7042 "" + i__5[0] = 1, a__3[0] = "("; +#line 7042 "" + i__2 = i10 + 48; +#line 7042 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 7042 "" + i__5[1] = 1, a__3[1] = ch__2; +#line 7042 "" + i__3 = i1 + 48; +#line 7042 "" + chax_(ch__3, (ftnlen)1, &i__3); +#line 7042 "" + i__5[2] = 1, a__3[2] = ch__3; +#line 7042 "" + i__5[3] = 4, a__3[3] = "x,a)"; +#line 7042 "" + ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4); +#line 7042 "" + s_wsfe(&ci__1); +#line 7042 "" + do_fio(&c__1, "^", (ftnlen)1); +#line 7042 "" + e_wsfe(); +#line 7043 "" + return 0; +} /* errmsg_ */ + +/* Subroutine */ int eskb4_(integer *ip, integer *ivx, integer *in, integer * + ib, real *space, real *tstart, real *fbar, integer *itrpt, real *esk) +{ + /* System generated locals */ + real r__1; + + /* Builtin functions */ + integer i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *, + char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + + /* Local variables */ + static integer iib; + extern doublereal feon_(real *); + static integer itnd, nnsk, itprev; + + /* Fortran I/O blocks */ + static cilist io___522 = { 0, 6, 0, 0, 0 }; + + + +/* Get elemskips to previous note. Called only for graces, no xtups involved. */ + +#line 7063 "" + /* Parameter adjustments */ +#line 7063 "" + --tstart; +#line 7063 "" + --space; +#line 7063 "" + +#line 7063 "" + /* Function Body */ +#line 7063 "" + itnd = i_nint(&all_1.to[*in - 1]); +#line 7064 "" + if (*ip == 1 || itnd == *itrpt) { + +/* Start of bar or after rpt. */ + +#line 7068 "" + *esk = *fbar; +#line 7069 "" + return 0; +#line 7070 "" + } else { +#line 7071 "" + *esk = 0.f; +#line 7072 "" + itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25]; +#line 7073 "" + for (iib = *ib; iib >= 1; --iib) { +#line 7074 "" + if (tstart[iib] < itprev + comtol_1.tol) { + +/* This is the block */ + +#line 7078 "" + r__1 = (real) (itnd - itprev) / space[iib]; +#line 7078 "" + nnsk = i_nint(&r__1); +#line 7079 "" + *esk += nnsk * feon_(&space[iib]); +#line 7080 "" + return 0; +#line 7081 "" + } else { +#line 7082 "" + r__1 = (itnd - tstart[iib]) / space[iib]; +#line 7082 "" + nnsk = i_nint(&r__1); +#line 7083 "" + *esk += nnsk * feon_(&space[iib]); +#line 7084 "" + itnd = i_nint(&tstart[iib]); +#line 7085 "" + } +#line 7086 "" +/* L1: */ +#line 7086 "" + } +#line 7087 "" + } +#line 7088 "" + s_wsle(&io___522); +#line 7088 "" + do_lio(&c__9, &c__1, "Problem in eskb4. Send files to Dr. Don", (ftnlen) + 40); +#line 7088 "" + e_wsle(); +#line 7089 "" + s_stop("", (ftnlen)0); +#line 7090 "" + return 0; +} /* eskb4_ */ + +doublereal f1eon_(real *time) +{ + /* System generated locals */ + real ret_val; + + /* Builtin functions */ + double sqrt(doublereal); + +#line 7092 "" + ret_val = sqrt(*time / 2); +#line 7093 "" + return ret_val; +} /* f1eon_ */ + +doublereal feon_(real *time) +{ + /* System generated locals */ + real ret_val; + doublereal d__1, d__2; + + /* Builtin functions */ + double sqrt(doublereal), pow_dd(doublereal *, doublereal *); + +#line 7097 "" + d__1 = (doublereal) sqrt(*time / 2); +#line 7097 "" + d__2 = (doublereal) (1.f - comeon_1.eonk); +#line 7097 "" + ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk; +#line 7098 "" + return ret_val; +} /* feon_ */ + +/* Subroutine */ int findbeam_(integer *ibmrep, integer *numbms, integer * + mapfb) +{ + /* Initialized data */ + + static integer nip1[248] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; + static integer nip2[248] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; + static integer nummask[3] = { 29,49,12 }; + static integer mask[147] /* was [49][3] */ = { 65535,4095,65520,255, + 65280,63,252,16128,64512,15,240,3840,61440,7,14,112,224,1792,3584, + 28672,57344,3,12,48,192,768,3072,12288,49152,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,16777215,65535,16776960,4095,65520,1048320, + 16773120,255,65280,16711680,63,252,16128,64512,4128768,16515072, + 15,60,240,3840,15360,61440,983040,3932160,15728640,7,14,112,224, + 1792,3584,28672,57344,458752,917504,7340032,14680064,3,12,48,192, + 768,3072,12288,49152,196608,786432,3145728,12582912,4095,255,4080, + 15,240,3840,3,12,48,192,768,3072,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; + static logical eqonly[147] /* was [49][3] */ = { TRUE_,TRUE_,TRUE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,TRUE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, + FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ }; + + /* System generated locals */ + integer i__1, i__2, i__3, i__4; + real r__1, r__2; + + /* Builtin functions */ + integer lbit_shift(integer, integer), s_wsle(cilist *), do_lio(integer *, + integer *, char *, ftnlen), e_wsle(void); + double r_mod(real *, real *); + + /* Local variables */ + static integer ib, ip, ir, it, is, ib1, ib2, ir1, is1, is2, it2, iip, ipr[ + 248], itr[248], mape, mapm, irep, maps, nreal, itend, itoff, + maskm, nodue[248], itseg, mtemp; + static logical short__[248]; + static integer itnow, ithalf, numnew; + extern /* Subroutine */ int logbeam_(integer *, integer *, integer *); + static integer masknow; + + /* Fortran I/O blocks */ + static cilist io___556 = { 0, 6, 0, 0, 0 }; + + + +/* Called once per voice per bar, after setting forced beams. */ + +/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */ +/* * itr(48),nodue(48) */ +/* logical short(48),eqonly */ +#line 7128 "" + /* Parameter adjustments */ +#line 7128 "" + --mapfb; +#line 7128 "" + --numbms; +#line 7128 "" + +#line 7128 "" + /* Function Body */ +#line 7149 "" + ip = 0; +#line 7150 "" + nreal = 0; +#line 7151 "" + itnow = 0; +#line 7152 "" +L1: +#line 7153 "" + ++ip; +#line 7154 "" + if (ip > all_1.nn[commvl_1.ivx - 1]) { +#line 7154 "" + goto L9; +#line 7154 "" + } +#line 7155 "" +L11: +#line 7155 "" + 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 7161 "" + ++ip; +#line 7162 "" + goto L11; +#line 7163 "" + } +#line 7164 "" + ++nreal; +#line 7165 "" + nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 7166 "" + 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 7172 "" + ipr[nreal - 1] = ip; +#line 7173 "" + itr[nreal - 1] = itnow; +#line 7174 "" + if (nodue[nreal - 1] == 1) { + +/* 64th gap */ + +#line 7178 "" + if (itnow % 2 == 0) { + +/* Start of 32nd gap, lump with following note */ + +#line 7182 "" + ++ip; +#line 7183 "" + nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1; +#line 7184 "" + itnow += nodue[nreal - 1]; +#line 7185 "" + } else { + +/* End of 32nd gap, lump with preceeding note */ + +#line 7189 "" + --nreal; +#line 7190 "" + ++nodue[nreal - 1]; +#line 7191 "" + ++itnow; +#line 7192 "" + } +#line 7193 "" + } else { +#line 7194 "" + itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 7195 "" + } +#line 7196 "" + goto L1; +#line 7197 "" +L9: +#line 7198 "" + ir1 = 1; +#line 7199 "" + itseg = all_1.lenbar / *ibmrep; +#line 7200 "" + i__1 = *ibmrep; +#line 7200 "" + 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 7206 "" + maps = 0; +#line 7207 "" + mapm = 0; +#line 7208 "" + mape = 0; +#line 7209 "" + itend = itseg * irep; +#line 7210 "" + itoff = itend - itseg; +#line 7211 "" + i__2 = nreal; +#line 7211 "" + for (ir = ir1; ir <= i__2; ++ir) { +#line 7212 "" + it2 = itr[ir - 1] + nodue[ir - 1] - 2; +#line 7213 "" + if (it2 >= itend) { +#line 7214 "" + ir1 = ir; +#line 7215 "" + goto L14; +#line 7216 "" + } +/* if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */ +/* Computing MAX */ +#line 7218 "" + i__3 = ir - 1; +#line 7218 "" + if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir < + nreal && short__[ir])) { +#line 7220 "" + ib1 = (itr[ir - 1] - itoff) / 2; +#line 7221 "" + ib2 = (it2 - itoff) / 2; +#line 7222 "" + if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) { +#line 7222 "" + return 0; +#line 7222 "" + } + +/* Must have an odd number obe beats in a long bar. Auto-beam won't work */ + +#line 7227 "" + nip1[ib1] = ipr[ir - 1]; +#line 7228 "" + nip2[ib2] = ipr[ir - 1]; + +/* nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */ + +#line 7232 "" + maps = bit_set(maps,ib1); +#line 7233 "" + mape = bit_set(mape,ib2); +#line 7234 "" + i__3 = ib2; +#line 7234 "" + for (ib = ib1; ib <= i__3; ++ib) { +#line 7235 "" + mapm = bit_set(mapm,ib); +#line 7236 "" +/* L3: */ +#line 7236 "" + } +#line 7237 "" + } +#line 7238 "" +/* L2: */ +#line 7238 "" + } +#line 7239 "" +L14: +#line 7240 "" + if (mapm == 0) { +#line 7240 "" + goto L13; +#line 7240 "" + } + +/* Zero out bits from forced beams */ + +#line 7244 "" + maps &= ~ mapfb[irep]; +#line 7245 "" + mapm &= ~ mapfb[irep]; +#line 7246 "" + mape &= ~ mapfb[irep]; + +/* Compare map with template. */ + +#line 7250 "" + i__2 = nummask[combeam_1.ibmtyp - 1]; +#line 7250 "" + for (it = 1; it <= i__2; ++it) { +#line 7251 "" + masknow = mask[it + combeam_1.ibmtyp * 49 - 50]; +#line 7252 "" + if ((masknow & mapm) == masknow) { + +/* Find least significant bit in the mask to check start time */ + +#line 7256 "" + mtemp = masknow; +#line 7257 "" + maskm = masknow; +#line 7258 "" + for (is1 = 0; is1 <= 47; ++is1) { +#line 7259 "" + if ((1 & mtemp) == 1) { +#line 7259 "" + goto L6; +#line 7259 "" + } +#line 7260 "" + mtemp = lbit_shift(mtemp, (ftnlen)-1); +#line 7261 "" +/* L5: */ +#line 7261 "" + } +#line 7262 "" +L6: +#line 7263 "" + if ((lbit_shift((ftnlen)1, is1) & maps) == 0) { +#line 7263 "" + goto L4; +#line 7263 "" + } + +/* is1 is the bit where the beam starts. Continue shifting to */ +/* find most significant bit in the mask to check ending time */ + +#line 7268 "" + for (is2 = is1; is2 <= 47; ++is2) { +#line 7269 "" + mtemp = lbit_shift(mtemp, (ftnlen)-1); +#line 7270 "" + if ((1 & ~ mtemp) == 1) { +#line 7270 "" + goto L8; +#line 7270 "" + } +#line 7271 "" +/* L7: */ +#line 7271 "" + } +#line 7272 "" +L8: + +/* is2 is now the bit on which the beam ends. */ + +#line 7276 "" + if ((lbit_shift((ftnlen)1, is2) & mape) == 0) { +#line 7276 "" + goto L4; +#line 7276 "" + } + +/* Did we pick out a single note from the middle of a longer sequence? */ + +#line 7280 "" + if (nip1[is1] == nip2[is2]) { +#line 7280 "" + goto L4; +#line 7280 "" + } + +/* We almost have a beam. Check equality of notes if needed. */ + +#line 7284 "" + if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) { +#line 7285 "" + i__3 = nip2[is2]; +#line 7285 "" + for (ip = nip1[is1]; ip <= i__3; ++ip) { +#line 7286 "" + 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 7290 "" + if (is2 - is1 != 15) { +#line 7290 "" + goto L4; +#line 7290 "" + } + +/* Beam is 2 quarters long. Check if can split in half. */ + +#line 7294 "" + ithalf = 0; +#line 7295 "" + i__4 = nip2[is2]; +#line 7295 "" + for (iip = nip1[is1]; iip <= i__4; ++iip) { +#line 7296 "" + ithalf += all_1.nodur[commvl_1.ivx + iip * 24 + - 25]; +#line 7297 "" + if (ithalf > 16) { +#line 7297 "" + goto L4; +#line 7297 "" + } +#line 7298 "" + if (ithalf == 16) { +#line 7298 "" + goto L21; +#line 7298 "" + } +#line 7299 "" +/* L20: */ +#line 7299 "" + } +#line 7300 "" + s_wsle(&io___556); +#line 7300 "" + do_lio(&c__9, &c__1, "Problem in findbeam, pleas"\ + "e call Dr. Don", (ftnlen)40); +#line 7300 "" + e_wsle(); +#line 7301 "" + goto L4; +#line 7302 "" +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 7307 "" + is2 = is1 + 7; + +/* Reset maskm (since only used part of mask), used later to zero out */ +/* bits that contain beams */ + +#line 7312 "" + maskm = 0; +#line 7313 "" + i__4 = is2; +#line 7313 "" + for (is = is1; is <= i__4; ++is) { +#line 7314 "" + maskm = bit_set(maskm,is); +#line 7315 "" +/* L15: */ +#line 7315 "" + } +#line 7316 "" + goto L16; +#line 7317 "" + } +#line 7318 "" +/* L10: */ +#line 7318 "" + } +#line 7319 "" + } +#line 7320 "" +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 7326 "" + r__2 = all_1.to[comipl2_1.ipl2[commvl_1.ivx + nip2[is2] * 24 + - 25] - 1] + all_1.nodur[commvl_1.ivx + nip2[is2] * + 24 - 25] + comtol_1.tol * .5f; +#line 7326 "" + if ((r__1 = r_mod(&r__2, &c_b1670), dabs(r__1)) > + comtol_1.tol) { +#line 7328 "" + ++nip2[is2]; +#line 7329 "" + } +#line 7330 "" + ++numbms[commvl_1.ivx]; +#line 7331 "" + numnew = numbms[commvl_1.ivx]; +#line 7332 "" + logbeam_(&numnew, &nip1[is1], &nip2[is2]); + +/* Zero out the appropriate bits so these notes don't get used again */ + +#line 7336 "" + mapm &= ~ maskm; +#line 7337 "" + if (mapm == 0) { +#line 7337 "" + goto L13; +#line 7337 "" + } +#line 7338 "" + maps &= ~ maskm; +#line 7339 "" + mape &= ~ maskm; +#line 7340 "" + } +#line 7341 "" +L4: +#line 7341 "" + ; +#line 7341 "" + } +#line 7342 "" +L13: +#line 7342 "" + ; +#line 7342 "" + } +#line 7343 "" + return 0; +} /* findbeam_ */ + +/* Subroutine */ int findeonk_(integer *nptr1, integer *nptr2, real *wovera, + real *xelsk, real *dtmin, real *dtmax, real *eonk0) +{ + /* System generated locals */ + integer i__1; + real r__1; + doublereal d__1, d__2; + + /* Builtin functions */ + double pow_dd(doublereal *, doublereal *), sqrt(doublereal), log( + doublereal); + + /* Local variables */ + static real f, fp; + extern doublereal feon_(real *); + static real targ, esum; + static integer iptr; + extern doublereal f1eon_(real *); + static real desum, dsoln; + static integer niter; + static real detarg; + extern /* Subroutine */ int printl_(char *, ftnlen); + + +/* Compute an exponent eonk for use in the "flattened" formula for elemskips */ +/* vs time. We must solve the eqution f = 0. Initial quess is eonk0. */ + +/* logical gotclef */ +/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +#line 7358 "" + comeon_1.eonk = *eonk0; +#line 7359 "" + niter = 0; +#line 7360 "" +L1: +#line 7361 "" + d__1 = (doublereal) f1eon_(dtmax); +#line 7361 "" + d__2 = (doublereal) comeon_1.eonk; +#line 7361 "" + comeon_1.ewmxk = pow_dd(&d__1, &d__2); +#line 7362 "" + ++niter; +#line 7363 "" + esum = 0.f; +#line 7364 "" + desum = 0.f; +#line 7365 "" + i__1 = *nptr2; +#line 7365 "" + for (iptr = *nptr1; iptr <= i__1; ++iptr) { +#line 7366 "" + targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]; +#line 7367 "" + esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * + feon_(&targ); +#line 7368 "" + d__1 = (doublereal) (*dtmax / targ); +#line 7368 "" + d__2 = (doublereal) comeon_1.eonk; +#line 7368 "" + detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ); +#line 7369 "" + desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] * + detarg; +#line 7370 "" +/* L2: */ +#line 7370 "" + } +#line 7371 "" + f = *wovera * feon_(dtmin) - *xelsk - esum; +#line 7372 "" + d__1 = (doublereal) (*dtmax / *dtmin); +#line 7372 "" + d__2 = (doublereal) comeon_1.eonk; +#line 7372 "" + fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / * + dtmin) - desum; +#line 7374 "" + if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) > + .5f || niter > 100) { +#line 7375 "" + printl_("Error in findeonk. Please send source to Dr. Don", (ftnlen) + 49); +#line 7377 "" + comeon_1.eonk = 0.f; +#line 7378 "" + comeon_1.ewmxk = 1.f; +#line 7379 "" + return 0; +#line 7380 "" + } +#line 7381 "" + dsoln = -f / fp; +#line 7382 "" + if (dabs(dsoln) < comtol_1.tol * .1f) { +#line 7382 "" + return 0; +#line 7382 "" + } + +/* Not converged yet, try again */ + +#line 7386 "" + comeon_1.eonk += dsoln; +#line 7387 "" + goto L1; +} /* findeonk_ */ + +doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc) +{ + /* System generated locals */ + real ret_val; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + static integer iip, ip1m1; + extern /* Subroutine */ int stop1_(void); + static integer ndoub, ipback; + extern /* Subroutine */ int printl_(char *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___572 = { 0, 6, 0, 0, 0 }; + + + +/* This return the real duration of a note */ + +#line 7396 "" + /* Parameter adjustments */ +#line 7396 "" + nacc -= 25; +#line 7396 "" + nodur -= 25; +#line 7396 "" + +#line 7396 "" + /* Function Body */ +#line 7396 "" + ipback = *ip; +#line 7397 "" + if (nodur[*ivx + *ip * 24] > 0) { +#line 7398 "" + if (*ip > 1) { + +/* Check if this is last note of xtup */ + +#line 7402 "" + if (nodur[*ivx + (*ip - 1) * 24] == 0) { +#line 7403 "" + ipback = *ip - 1; +#line 7404 "" + goto L2; +#line 7405 "" + } +#line 7406 "" + } +#line 7407 "" + ret_val = (real) nodur[*ivx + *ip * 24]; +#line 7408 "" + return ret_val; +#line 7409 "" + } +#line 7410 "" +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 7415 "" + ndoub = 0; +#line 7416 "" + for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) { +#line 7417 "" + if (nodur[*ivx + ip1m1 * 24] > 0) { +#line 7417 "" + goto L4; +#line 7417 "" + } +#line 7418 "" + if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) { +#line 7418 "" + ++ndoub; +#line 7418 "" + } +#line 7419 "" +/* L1: */ +#line 7419 "" + } +#line 7420 "" +L4: + +/* count forward to next non-0 nodur. Start at ip in case last note of xtup. */ + +#line 7424 "" + for (iip = *ip; iip <= 200; ++iip) { + +/* Count doubled xtup notes from ip to end. */ + +#line 7428 "" + if (bit_test(nacc[*ivx + iip * 24],18)) { +#line 7428 "" + ++ndoub; +#line 7428 "" + } +#line 7429 "" + if (nodur[*ivx + iip * 24] > 0) { +/* fnote = nodur(ivx,iip)/float(iip-ip1m1) */ +#line 7431 "" + ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub); +#line 7432 "" + if (bit_test(nacc[*ivx + *ip * 24],18)) { +#line 7433 "" + ret_val *= 2; +#line 7434 "" + } else if (bit_test(nacc[*ivx + *ip * 24],27)) { +#line 7435 "" + ret_val *= 1.5f; +#line 7436 "" + } else if (*ip > 1) { +#line 7437 "" + if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) { +#line 7437 "" + ret_val *= .5f; +#line 7437 "" + } +#line 7438 "" + } +#line 7439 "" + return ret_val; +#line 7440 "" + } +#line 7441 "" +/* L3: */ +#line 7441 "" + } +#line 7442 "" + s_wsle(&io___572); +#line 7442 "" + do_lio(&c__9, &c__1, " ", (ftnlen)1); +#line 7442 "" + e_wsle(); +#line 7443 "" + printl_("Probable misplaced barline or incorrect meter, stopping", ( + ftnlen)55); +/* call printl('Program error in fnote, send source to Dr. Don') */ +#line 7446 "" + stop1_(); +#line 7447 "" + return ret_val; +} /* fnote_ */ + +/* Subroutine */ int g1etchar_(char *lineq, integer *iccount, char *charq, + ftnlen lineq_len, ftnlen charq_len) +{ + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer ndxm; + extern /* Subroutine */ int read10_(char *, logical *, ftnlen), m1rec1_( + char *, integer *, integer *, integer *, integer *, integer *, + ftnlen); + static integer nbars, ibaroff, ibarcnt; + + +/* 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 7461 "" + if (*iccount == 128) { +#line 7462 "" + read10_(lineq, &c1omget_1.lastchar, (ftnlen)128); +#line 7463 "" + if (c1omget_1.lastchar) { +#line 7463 "" + return 0; +#line 7463 "" + } +#line 7464 "" + if (! commac_1.endmac) { +#line 7465 "" + *iccount = 0; +#line 7466 "" + if (! commac_1.mplay) { +#line 7466 "" + ++c1omget_1.nline; +#line 7466 "" + } +#line 7467 "" + } else { +#line 7468 "" + commac_1.endmac = FALSE_; +#line 7469 "" + *iccount = commac_1.icchold; +#line 7470 "" + s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); +#line 7471 "" + } +#line 7472 "" + if (commac_1.mrecord) { +#line 7473 "" + m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, ( + ftnlen)128); +#line 7474 "" + } +#line 7475 "" + } +#line 7476 "" + ++(*iccount); +#line 7477 "" + *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; +#line 7478 "" + return 0; +} /* g1etchar_ */ + +/* Subroutine */ int g1etnote_(logical *loop, integer *ifig, logical * + optimize, logical *fulltrans) +{ + /* Initialized data */ + + static char literq[51*3] = "Literal TeX string cannot start with 4 backs" + "lashes!" "TeX string must have <129 char, end with backslash!" + "Type 2 or 3 TeX string can only start in column 1! "; + static char lyrerq[51*5] = "pmxlyr string must end with \" followed by b" + "lank! " "pmxlyr string cannot extend past position 120! " + "There must be \"a\" or \"b\" here! " "There" + " must be \"+\" or \"-\" here! " "There must " + "be an integer here! "; + + /* System generated locals */ + 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]; + icilist ici__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), e_wsle( + void), do_lio(integer *, integer *, char *, ftnlen), s_wsfe( + cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_fio(integer *, char *, ftnlen), e_wsfe(void), s_cmp(char *, + char *, ftnlen, ftnlen), i_nint(real *); + double log(doublereal); + integer pow_ii(integer *, integer *), s_rsfe(cilist *), e_rsfe(void), + s_rsfi(icilist *), e_rsfi(void); + + /* Local variables */ + extern integer i1fnodur_(integer *, char *, ftnlen); + extern /* Subroutine */ int checkdyn_(char *, integer *, integer *, + ftnlen); + static integer idotform, ndxquote, i__, j; + extern /* Subroutine */ int readmeter_(char *, integer *, integer *, + integer *, ftnlen), getpmxmod_(logical *, char *, ftnlen), + chkpmxlyr_(char *, integer *, integer *, ftnlen); + static integer ic, igr, ipm; + static real dum; + static integer ngr, iiv, nbb4, num1, num2; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static logical cdot; + static real fnum; + static char dumq[1], dotq[1], durq[1]; + static integer itup; + static real snum; + static integer ntup; + extern /* Subroutine */ int g1etx_(char *, integer *, logical *, integer * + , real *, real *, ftnlen), stop1_(void), read10_(char *, logical * + , ftnlen); + static real dimen; + static char charq[1]; + static integer indxb; + static char lineq[128]; + static integer icsav, ndoub, iorig, iinow, iposn, ninow; + extern /* Subroutine */ int getitransinfo_(logical *, integer *, char *, + integer *, integer *, integer *, integer *, ftnlen); + static integer icclhw; + static char charlq[1]; + extern /* Subroutine */ int setmac_(char *, integer *, integer *, integer + *, integer *, char *, char *, integer *, integer *, ftnlen, + ftnlen, ftnlen), chklit_(char *, integer *, integer *, ftnlen); + static logical fulbrp; + extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *, + ftnlen, ftnlen); + static integer literr, mtrdnp; + static real sysflb; + static integer numint, numnum; + static logical ztrans; + static integer lyrerr, mtrnmp; + static real fnsyst; + static integer lenbeat; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), getmidi_(integer *, char *, integer *, integer *, + integer *, integer *, integer *, integer *, logical *, ftnlen), + readnum_(char *, integer *, char *, real *, ftnlen, ftnlen); + static integer mtrdenl, lenmult, numshft; + static logical plusmin; + static real tintstf; + extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, + ftnlen); + static integer lvoltxt; + + /* Fortran I/O blocks */ + static cilist io___583 = { 0, 6, 0, 0, 0 }; + static cilist io___584 = { 0, 6, 0, 0, 0 }; + static cilist io___585 = { 0, 6, 0, 0, 0 }; + static cilist io___586 = { 0, 6, 0, 0, 0 }; + static cilist io___587 = { 0, 15, 0, "(/a)", 0 }; + static cilist io___588 = { 0, 15, 0, "(a11,2x,i3)", 0 }; + static cilist io___589 = { 0, 15, 0, 0, 0 }; + static cilist io___590 = { 0, 6, 0, 0, 0 }; + static cilist io___598 = { 0, 6, 0, 0, 0 }; + static cilist io___599 = { 0, 6, 0, 0, 0 }; + static cilist io___600 = { 0, 6, 0, 0, 0 }; + static cilist io___605 = { 0, 6, 0, 0, 0 }; + static cilist io___606 = { 0, 6, 0, 0, 0 }; + static cilist io___607 = { 0, 6, 0, 0, 0 }; + static cilist io___621 = { 0, 6, 0, 0, 0 }; + static cilist io___624 = { 0, 6, 0, 0, 0 }; + static cilist io___625 = { 0, 6, 0, 0, 0 }; + static cilist io___626 = { 0, 6, 0, 0, 0 }; + static cilist io___629 = { 0, 6, 0, 0, 0 }; + static cilist io___635 = { 0, 6, 0, 0, 0 }; + static cilist io___636 = { 0, 6, 0, 0, 0 }; + static cilist io___637 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___638 = { 0, 6, 0, 0, 0 }; + static cilist io___639 = { 0, 6, 0, 0, 0 }; + static cilist io___640 = { 0, 15, 0, "(a)", 0 }; + static cilist io___641 = { 0, 15, 0, "(a)", 0 }; + static cilist io___646 = { 0, 6, 0, 0, 0 }; + static cilist io___647 = { 0, 15, 0, "(a)", 0 }; + static cilist io___651 = { 0, 6, 0, 0, 0 }; + static cilist io___652 = { 0, 6, 0, 0, 0 }; + static cilist io___653 = { 0, 6, 0, 0, 0 }; + static cilist io___654 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 }; + static cilist io___658 = { 0, 6, 0, 0, 0 }; + static cilist io___659 = { 0, 6, 0, 0, 0 }; + static cilist io___660 = { 0, 5, 0, "(a)", 0 }; + static cilist io___664 = { 0, 6, 0, 0, 0 }; + static cilist io___665 = { 0, 6, 0, 0, 0 }; + + +/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +#line 7545 "" + cdot = FALSE_; +#line 7546 "" +L1: +#line 7546 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 7547 "" + if (*(unsigned char *)charq != ' ') { +#line 7547 "" + *(unsigned char *)charlq = *(unsigned char *)charq; +#line 7547 "" + } +#line 7548 "" + if (c1omget_1.lastchar) { +#line 7549 "" + if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) { +#line 7550 "" + s_wsle(&io___583); +#line 7550 "" + e_wsle(); +#line 7551 "" + s_wsle(&io___584); +#line 7551 "" + do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8); +#line 7551 "" + e_wsle(); +#line 7552 "" + s_wsle(&io___585); +#line 7552 "" + do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29) + ; +#line 7552 "" + do_lio(&c__9, &c__1, charlq, (ftnlen)1); +#line 7552 "" + do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12); +#line 7552 "" + e_wsle(); +#line 7553 "" + s_wsle(&io___586); +#line 7553 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 7553 "" + i__1 = *(unsigned char *)charlq; +#line 7553 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 7553 "" + e_wsle(); +#line 7554 "" + s_wsfe(&io___587); +/* Writing concatenation */ +#line 7554 "" + i__2[0] = 29, a__1[0] = "Last non-blank character is \""; +#line 7554 "" + i__2[1] = 1, a__1[1] = charlq; +#line 7554 "" + i__2[2] = 12, a__1[2] = "\", not \"/,%\""; +#line 7554 "" + s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42); +#line 7554 "" + do_fio(&c__1, ch__1, (ftnlen)42); +#line 7554 "" + e_wsfe(); +#line 7556 "" + s_wsfe(&io___588); +#line 7556 "" + do_fio(&c__1, "ASCII code:", (ftnlen)11); +#line 7556 "" + i__1 = *(unsigned char *)charlq; +#line 7556 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 7556 "" + e_wsfe(); + +/* Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. */ + +#line 7560 "" + --inbuff_1.ilbuf; +#line 7561 "" + inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[ + inbuff_1.ilbuf - 1] + 2); +/* Writing concatenation */ +#line 7562 "" + i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq; +#line 7562 "" + i__3[1] = 2, a__2[1] = " /"; +#line 7562 "" + s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)65536); +#line 7563 "" + s_wsle(&io___589); +#line 7563 "" + do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 7563 "" + e_wsle(); +#line 7564 "" + s_wsle(&io___590); +#line 7564 "" + do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 7564 "" + e_wsle(); +/* Writing concatenation */ +#line 7565 "" + i__3[0] = a1ll_2.iccount, a__2[0] = lineq; +#line 7565 "" + i__3[1] = 2, a__2[1] = " /"; +#line 7565 "" + s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128); +#line 7566 "" + c1omget_1.lastchar = FALSE_; +#line 7567 "" + goto L1; +#line 7568 "" + } +#line 7569 "" + return 0; +#line 7570 "" + } +#line 7571 "" + if (*(unsigned char *)charq == ' ') { +#line 7572 "" + goto L1; +#line 7573 "" + } else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) { +#line 7574 "" + a1ll_2.iccount = 128; +#line 7575 "" + 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 7580 "" + } 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 7585 "" + if (cdot) { +#line 7585 "" + goto L28; +#line 7585 "" + } +/* if (gotclef) gotclef=.false. */ +#line 7587 "" + idotform = 0; +#line 7588 "" + numnum = 0; +#line 7589 "" + plusmin = FALSE_; +#line 7590 "" +L28: +#line 7590 "" + ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; +#line 7591 "" + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) { +#line 7592 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 7592 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"\ + "sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48); +#line 7594 "" + stop1_(); +#line 7595 "" + } +#line 7596 "" + *(unsigned char *)dotq = 'x'; + +/* Check if this is 'r ' and previous note was full-bar-pause */ + +#line 7600 "" + i__1 = a1ll_2.iccount; +/* Computing MAX */ +#line 7600 "" + i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; +/* Computing MAX */ +#line 7600 "" + i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1; +#line 7600 "" + 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 7603 "" +L2: +#line 7603 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 7604 "" + ic = *(unsigned char *)durq; +#line 7605 "" + if (ic <= 57 && ic >= 48) { + +/* Digit */ + +#line 7609 "" + if (numnum == 0) { +#line 7610 "" + c1omnotes_1.nnodur = ic - 48; +#line 7611 "" + numnum = 1; +#line 7612 "" + goto L2; +#line 7613 "" + } else if (numnum == 1) { +#line 7614 "" + if (*(unsigned char *)charq == 'r') { +#line 7615 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7615 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"\ + "llowed after rest symbol \"r\"!", (ftnlen)128, ( + ftnlen)45); +#line 7617 "" + stop1_(); +#line 7618 "" + } +#line 7619 "" + numnum = 2; +#line 7620 "" + if (plusmin) { +#line 7621 "" + s_wsle(&io___598); +#line 7621 "" + e_wsle(); +#line 7622 "" + s_wsle(&io___599); +#line 7622 "" + do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) + 25); +#line 7622 "" + e_wsle(); +#line 7623 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7623 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ + ".2, +/- was ignored if octave was!", (ftnlen)128, + (ftnlen)50); +#line 7625 "" + s_wsle(&io___600); +#line 7625 "" + do_lio(&c__9, &c__1, "explicitly specified. May need to"\ + " edit old editions", (ftnlen)52); +#line 7625 "" + e_wsle(); +#line 7627 "" + } +#line 7628 "" + goto L2; +#line 7629 "" + } else { +#line 7630 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7630 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"\ + "mbol!", (ftnlen)128, (ftnlen)25); +#line 7632 "" + stop1_(); +#line 7633 "" + } +#line 7634 "" + } else if (*(unsigned char *)durq == 'd') { +#line 7635 "" + *(unsigned char *)dotq = *(unsigned char *)durq; +#line 7636 "" + i__1 = a1ll_2.iccount; +#line 7636 "" + if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1) + == 0) { +#line 7637 "" + c1omnotes_1.iddot = 1; +#line 7638 "" + ++a1ll_2.iccount; + +/* Since we flow out, double dots won't work with other dot options */ + +#line 7642 "" + } +#line 7643 "" + i__1 = a1ll_2.iccount; +#line 7643 "" + if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 - + i__1) > 0) { + +/* move a dot, provided a number follows. */ + +#line 7647 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7648 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7649 "" + if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0) + { + +/* Backup, exit the loop normally */ + +#line 7653 "" + a1ll_2.iccount += -2; +#line 7654 "" + goto L2; +#line 7655 "" + } +#line 7656 "" + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 7657 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Vertical shift also */ + +#line 7661 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 7662 "" + if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == + 0) { +#line 7663 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7663 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"\ + "ber after 2nd +/- (shift dot)!", (ftnlen)128, + (ftnlen)42); +#line 7665 "" + stop1_(); +#line 7666 "" + } +#line 7667 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 7668 "" + } +#line 7669 "" + --a1ll_2.iccount; +#line 7670 "" + } +#line 7671 "" + goto L2; +#line 7672 "" + } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Accidental shift */ + +/* if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */ +#line 7677 "" + i__1 = a1ll_2.iccount - 2; +#line 7677 "" + if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 - + i__1) == 0) { +#line 7678 "" + i__1 = a1ll_2.iccount - 1; +#line 7678 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7678 "" + 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 7681 "" + stop1_(); +#line 7682 "" + } +#line 7683 "" + ipm = 1; +#line 7684 "" + if (*(unsigned char *)durq == '<') { +#line 7684 "" + ipm = -1; +#line 7684 "" + } +#line 7685 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 7686 "" + if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 7687 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7687 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"\ + "r </> (accidental shift)!", (ftnlen)128, (ftnlen)45); +#line 7689 "" + stop1_(); +#line 7690 "" + } +#line 7691 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 7692 "" + fnum = ipm * fnum; +#line 7693 "" + if (fnum < -5.35f || fnum > 1.f) { +#line 7694 "" + i__1 = a1ll_2.iccount - 1; +#line 7694 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7694 "" + errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"\ + "st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52); +#line 7696 "" + stop1_(); +#line 7697 "" + } +#line 7698 "" + --a1ll_2.iccount; +#line 7699 "" + goto L2; +#line 7700 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 7701 "" + if (*(unsigned char *)charq != 'r') { +#line 7702 "" + i__1 = a1ll_2.iccount - 2; +#line 7702 "" + if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - + 1 - i__1) > 0) { +#line 7703 "" + ipm = 1; +#line 7704 "" + if (*(unsigned char *)durq == '-') { +#line 7704 "" + ipm = -1; +#line 7704 "" + } +#line 7705 "" + i__1 = a1ll_2.iccount; +#line 7705 "" + 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 7710 "" + icsav = a1ll_2.iccount; +#line 7711 "" + ++a1ll_2.iccount; +#line 7712 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 7713 "" + 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 7718 "" + if (fnum > 30.5f) { +#line 7719 "" + i__1 = a1ll_2.iccount - 1; +#line 7719 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 7719 "" + errmsg_(lineq, &i__1, &i__4, "Vertical accid"\ + "ental shift must be less than 31!", ( + ftnlen)128, (ftnlen)47); +#line 7721 "" + stop1_(); +#line 7722 "" + } +#line 7723 "" + ipm = 1; +#line 7724 "" + if (*(unsigned char *)durq == '-') { +#line 7724 "" + ipm = -1; +#line 7724 "" + } +#line 7725 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); +#line 7726 "" + if (i_indx("1234567890.", durq, (ftnlen)11, ( + ftnlen)1) == 0) { +#line 7727 "" + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 7727 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"\ + "cted 2nd number of accidental shift)!" + , (ftnlen)128, (ftnlen)41); +#line 7729 "" + stop1_(); +#line 7730 "" + } +#line 7731 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 7732 "" + fnum = ipm * fnum; +#line 7733 "" + if (fnum < -5.35f || fnum > 1.f) { +#line 7734 "" + i__1 = a1ll_2.iccount - 1; +#line 7734 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 7734 "" + errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"\ + "tal shift must be >-5.35 and <1.0!", ( + ftnlen)128, (ftnlen)48); +#line 7736 "" + stop1_(); +#line 7737 "" + } +#line 7738 "" + --a1ll_2.iccount; +#line 7739 "" + goto L2; +#line 7740 "" + } else { + +/* Not accid shift, reset, then flow out */ + +#line 7744 "" + a1ll_2.iccount = icsav; +#line 7745 "" + } +#line 7746 "" + } +#line 7747 "" + } +#line 7748 "" + plusmin = TRUE_; +#line 7749 "" + if (numnum == 2) { +#line 7750 "" + s_wsle(&io___605); +#line 7750 "" + e_wsle(); +#line 7751 "" + s_wsle(&io___606); +#line 7751 "" + do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen) + 25); +#line 7751 "" + e_wsle(); +#line 7752 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7752 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ + ".2, +/- was ignored if octave was!", (ftnlen)128, + (ftnlen)50); +#line 7754 "" + s_wsle(&io___607); +#line 7754 "" + do_lio(&c__9, &c__1, "explicitly specified. May need to"\ + " edit old editions", (ftnlen)52); +#line 7754 "" + e_wsle(); +#line 7756 "" + } +#line 7757 "" + goto L2; + +/* It's a rest containing +|- . Must refer to a vertical shift. Read past. */ + +#line 7761 "" + } else { +#line 7762 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7763 "" + readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, ( + ftnlen)1); +#line 7764 "" + --a1ll_2.iccount; +#line 7765 "" + goto L2; +#line 7766 "" + } +/* else if (index('ulare',durq) .gt. 0) then */ +#line 7768 "" + } else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) { +#line 7769 "" + goto L2; +#line 7770 "" + } else if (*(unsigned char *)durq == 'S') { + +/* Stemlength change */ + +#line 7774 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 7775 "" + if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) { +#line 7776 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7776 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"\ + "er or colon here!", (ftnlen)128, (ftnlen)37); +#line 7778 "" + stop1_(); +#line 7779 "" + } +#line 7780 "" + if (*(unsigned char *)durq == ':') { +#line 7781 "" + if (! comkeys_1.stickys) { +#line 7782 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7782 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"\ + "y stemshrinks without turning on!", (ftnlen)128, ( + ftnlen)49); +#line 7784 "" + stop1_(); +#line 7785 "" + } +#line 7786 "" + comkeys_1.stickys = FALSE_; +#line 7787 "" + goto L2; +#line 7788 "" + } +#line 7789 "" + readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen) + 1); +#line 7790 "" + if (dum < .5f || dum > 4.f) { +#line 7791 "" + i__1 = a1ll_2.iccount - 1; +#line 7791 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7791 "" + errmsg_(lineq, &i__1, &i__4, "Stemlength shortening must be "\ + "from .5 to 4!", (ftnlen)128, (ftnlen)43); +#line 7793 "" + stop1_(); +#line 7794 "" + } +#line 7795 "" + if (*(unsigned char *)durq != ':') { +#line 7796 "" + --a1ll_2.iccount; +#line 7797 "" + } else { +#line 7798 "" + if (comkeys_1.stickys) { +#line 7799 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7799 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"\ + " stemshrinks when already on!", (ftnlen)128, ( + ftnlen)45); +#line 7801 "" + stop1_(); +#line 7802 "" + } +#line 7803 "" + comkeys_1.stickys = TRUE_; +#line 7804 "" + } +#line 7805 "" + goto L2; +#line 7806 "" + } 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 7811 "" + i__1 = a1ll_2.iccount; +#line 7811 "" + if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) + == 0) { +#line 7811 "" + ++a1ll_2.iccount; +#line 7811 "" + } +#line 7812 "" + goto L2; +#line 7813 "" + } else if (*(unsigned char *)durq == 'p') { +#line 7814 "" + fulbrp = *(unsigned char *)charq == 'r'; +#line 7815 "" + if (! fulbrp) { +#line 7816 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7816 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"\ + "y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42); +#line 7818 "" + stop1_(); +#line 7819 "" + } +#line 7820 "" + goto L2; +#line 7821 "" + } else if (*(unsigned char *)durq == 'b') { +#line 7822 "" + if (*(unsigned char *)charq != 'r') { +#line 7823 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7823 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"\ + " expected \"rb\"!", (ftnlen)128, (ftnlen)33); +#line 7825 "" + stop1_(); +#line 7826 "" + } else if (numnum == 2) { +#line 7827 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7827 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"\ + " \"b\" with two numbers!", (ftnlen)128, (ftnlen)39); +#line 7829 "" + } +#line 7830 "" + goto L2; +#line 7831 "" + } else if (*(unsigned char *)durq == 'x') { + +/* Xtuplet. Count number of doubled notes (for unequal xtups) */ + +#line 7835 "" + if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[ + c1ommvl_1.ivx - 1] * 24 - 25],18)) { +#line 7836 "" + ndoub = 1; +#line 7837 "" + } else { +#line 7838 "" + ndoub = 0; +#line 7839 "" + } + +/* Will set all durations to 0 except last one. */ + +#line 7843 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 7844 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 7845 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7845 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""\ + "x\" in xtuplet must be \"1\"-\"9\"!", (ftnlen)128, ( + ftnlen)48); +#line 7847 "" + stop1_(); +#line 7848 "" + } +#line 7849 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 7850 "" + if (fnum > 99.f) { +#line 7851 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7851 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot have "\ + "more than 99 notes!", (ftnlen)128, (ftnlen)39); +#line 7853 "" + stop1_(); +#line 7854 "" + } else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 7855 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7855 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal character"\ + "s here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)128, ( + ftnlen)47); +#line 7857 "" + stop1_(); +#line 7858 "" + } + +/* End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. */ + +#line 7862 "" + 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 7867 "" + 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 7868 "" + ndoub = 1; +#line 7869 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7870 "" + } else if (*(unsigned char *)durq == 'd') { +#line 7871 "" + 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 7872 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7873 "" + } +#line 7874 "" + if (*(unsigned char *)durq == 'n') { + +/* Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. */ + +#line 7878 "" + numshft = 0; +#line 7879 "" +L30: +#line 7879 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7880 "" + if (*(unsigned char *)durq == 'f') { +#line 7881 "" + goto L30; +#line 7882 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 7883 "" + ++numshft; +#line 7884 "" + if (numshft == 3) { +#line 7885 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7885 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"\ + "s are allowed after \"n\" in xtup!", (ftnlen) + 128, (ftnlen)44); +#line 7887 "" + stop1_(); +#line 7888 "" + } +#line 7889 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 7890 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == + 0) { +#line 7891 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7891 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ + "er should be a digit or \".\"!", (ftnlen)128, + (ftnlen)40); +#line 7893 "" + stop1_(); +#line 7894 "" + } +#line 7895 "" + readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, + (ftnlen)1); +#line 7896 "" + --a1ll_2.iccount; +#line 7897 "" + if (numshft == 1 && snum > 15.1f || numshft == 2 && snum + > 1.51f) { +#line 7899 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7899 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"\ + " after \"n\" in xtup is out of range!", ( + ftnlen)128, (ftnlen)47); +#line 7901 "" + stop1_(); +#line 7902 "" + } +#line 7903 "" + goto L30; +#line 7904 "" + } else if (*(unsigned char *)durq == 's') { + +/* Slope alteration for bracket */ + +#line 7908 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 7909 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 7910 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7910 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"\ + "justment, this character must be \"+\" or \"-"\ + "\"!", (ftnlen)128, (ftnlen)56); +#line 7912 "" + stop1_(); +#line 7913 "" + } +#line 7914 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 7915 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) + { +#line 7916 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7916 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\ + "er should be a digit!", (ftnlen)128, (ftnlen) + 33); +#line 7918 "" + stop1_(); +#line 7919 "" + } +#line 7920 "" + readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, + (ftnlen)1); +#line 7921 "" + --a1ll_2.iccount; +#line 7922 "" + if (i_nint(&snum) > 15) { +#line 7923 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7923 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"\ + "ment cannot exceed 15!", (ftnlen)128, (ftnlen) + 34); +#line 7925 "" + stop1_(); +#line 7926 "" + } +#line 7927 "" + goto L30; +#line 7928 "" + } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) > + 0) { + +/* Unsigned integer => alternate printed number */ + +#line 7932 "" + readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128, + (ftnlen)1); +#line 7933 "" + if (snum > 15.1f) { +#line 7934 "" + i__1 = a1ll_2.iccount - 1; +#line 7934 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7934 "" + errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "\ + "after \"n\" must be <16!", (ftnlen)128, ( + ftnlen)44); +#line 7936 "" + stop1_(); +#line 7937 "" + } +#line 7938 "" + --a1ll_2.iccount; +#line 7939 "" + goto L30; +#line 7940 "" + } else if (*(unsigned char *)durq != ' ') { +#line 7941 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7941 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36); +#line 7943 "" + stop1_(); +#line 7944 "" + } +#line 7945 "" + } +#line 7946 "" + ntup = i_nint(&fnum); +#line 7947 "" + i__1 = ntup; +#line 7947 "" + for (itup = 2; itup <= i__1; ++itup) { +#line 7948 "" + a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * + 24 - 25] = 0; +#line 7949 "" + ++a1ll_2.nnl[c1ommvl_1.ivx - 1]; +#line 7950 "" +L110: +#line 7950 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 7951 "" + if (*(unsigned char *)durq == ' ') { +#line 7952 "" + goto L110; +#line 7953 "" + } else if (*(unsigned char *)durq == 'o') { + +/* Ornament in xtup. "o" symbol must come AFTER the affected note */ + +#line 7957 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 7958 "" + if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, ( + ftnlen)1) == 0) { +#line 7959 "" + if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 7960 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7960 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "\ + "or segno not allowed in xtuplet!", ( + ftnlen)128, (ftnlen)40); +#line 7962 "" + } else { +#line 7963 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7963 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ + "ornament!", (ftnlen)128, (ftnlen)17); +#line 7965 "" + } +#line 7966 "" + stop1_(); +#line 7967 "" + } +#line 7968 "" + if (*(unsigned char *)dumq == 'T') { + +/* Trill. may be followed by 't' and/or number. read 'til blank */ + +#line 7972 "" +L29: +#line 7972 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 7973 "" + if (*(unsigned char *)dumq != ' ') { +#line 7973 "" + goto L29; +#line 7973 "" + } +#line 7974 "" + } else if (*(unsigned char *)dumq == 'e') { +#line 7975 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 7976 "" + if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 7977 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7977 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\ + "character after \"e\" in edit. accid. sy"\ + "mbol!", (ftnlen)128, (ftnlen)51); +#line 7979 "" + stop1_(); +#line 7980 "" + } +#line 7981 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 7982 "" + if (*(unsigned char *)dumq == '?') { +#line 7982 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) + 128, (ftnlen)1); +#line 7982 "" + } +#line 7983 "" + } else if (*(unsigned char *)dumq == ':') { +#line 7984 "" + i__4 = a1ll_2.iccount; +#line 7984 "" + if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - + i__4, (ftnlen)1) != 0) { +#line 7985 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7985 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ + "st be followed by blank in \"o: \"!", ( + ftnlen)128, (ftnlen)39); +#line 7987 "" + stop1_(); +#line 7988 "" + } else if (! comkeys_1.ornrpt) { +#line 7989 "" + i__4 = a1ll_2.iccount - 1; +#line 7989 "" + i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7989 "" + errmsg_(lineq, &i__4, &i__5, "Turned off repeate"\ + "d ornaments before they were on!", ( + ftnlen)128, (ftnlen)50); +#line 7991 "" + stop1_(); +#line 7992 "" + } +#line 7993 "" + comkeys_1.ornrpt = FALSE_; +#line 7994 "" + } else { +#line 7995 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 7996 "" + } +#line 7997 "" + if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 7998 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 7998 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ + "acter in ornament symbol!", (ftnlen)128, ( + ftnlen)37); +#line 8000 "" + stop1_(); +#line 8001 "" + } +#line 8002 "" + if (*(unsigned char *)dumq == ':') { +#line 8003 "" + i__4 = a1ll_2.iccount; +#line 8003 "" + if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 - + i__4, (ftnlen)1) != 0) { +#line 8004 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8004 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\ + "st be followed by blank in \"o: \"!", ( + ftnlen)128, (ftnlen)39); +#line 8006 "" + stop1_(); +#line 8007 "" + } else if (comkeys_1.ornrpt) { +#line 8008 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8008 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"\ + "n repeated ornaments but already on!", ( + ftnlen)128, (ftnlen)44); +#line 8010 "" + stop1_(); +#line 8011 "" + } +#line 8012 "" + comkeys_1.ornrpt = TRUE_; +#line 8013 "" + } +#line 8014 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8015 "" + i__4 = a1ll_2.iccount; +#line 8015 "" + if (i_indx("0123456789", lineq + i__4, (ftnlen)10, + a1ll_2.iccount + 1 - i__4) == 0) { +#line 8017 "" + i__4 = a1ll_2.iccount + 1; +#line 8017 "" + i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8017 "" + errmsg_(lineq, &i__4, &i__5, "There should be an"\ + " integer here!", (ftnlen)128, (ftnlen)32); +#line 8019 "" + stop1_(); +#line 8020 "" + } +#line 8021 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8022 "" + if (*(unsigned char *)durq == ':') { +#line 8023 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8023 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"\ + "hift AND repeat an ornament!", (ftnlen) + 128, (ftnlen)36); +#line 8025 "" + stop1_(); +#line 8026 "" + } + +/* 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */ + +#line 8030 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8031 "" + i__4 = a1ll_2.iccount; +#line 8031 "" + if (i_indx(".0123456789", lineq + i__4, (ftnlen) + 11, a1ll_2.iccount + 1 - i__4) == 0) { +#line 8033 "" + i__4 = a1ll_2.iccount + 1; +#line 8033 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8033 "" + errmsg_(lineq, &i__4, &i__5, "There should b"\ + "e a number here!", (ftnlen)128, ( + ftnlen)30); +#line 8036 "" + stop1_(); +#line 8037 "" + } +#line 8038 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 8039 "" + } +#line 8040 "" + } +#line 8041 "" + goto L110; +#line 8042 "" + } else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) { + +/* Slur in xtup */ + +#line 8046 "" + iposn = 0; +#line 8047 "" + numint = 0; +#line 8048 "" +L15: +#line 8048 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8049 "" + ++iposn; +#line 8050 "" + if (i_indx("udlbfnhtv", dumq, (ftnlen)9, (ftnlen)1) > 0) { +#line 8051 "" + if (*(unsigned char *)dumq == 't' && *(unsigned char * + )durq == 't') { +#line 8052 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8052 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"\ + "se \"t\" as an option on a tie!", (ftnlen) + 128, (ftnlen)37); +#line 8054 "" + stop1_(); +#line 8055 "" + } +#line 8056 "" + goto L15; +#line 8057 "" + } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8058 "" + ++numint; +#line 8059 "" + ++a1ll_2.iccount; +#line 8060 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8061 "" + if (numint == 1) { +#line 8062 "" + if (i_nint(&fnum) > 30) { +#line 8063 "" + i__4 = a1ll_2.iccount - 1; +#line 8063 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8063 "" + errmsg_(lineq, &i__4, &i__5, "Magnitude of s"\ + "lur height adjustment cannot exceed "\ + "30!", (ftnlen)128, (ftnlen)53); +#line 8065 "" + stop1_(); +#line 8066 "" + } +#line 8067 "" + } else if (numint == 2) { +#line 8068 "" + if (dabs(fnum) > 6.3f) { +#line 8069 "" + i__4 = a1ll_2.iccount - 1; +#line 8069 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8069 "" + errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ + "ft must be in the range (-6.3,6.3)!", + (ftnlen)128, (ftnlen)49); +#line 8071 "" + stop1_(); +#line 8072 "" + } +#line 8073 "" + } else { + +/* Third signed integer, must be a midslur or curve spec. */ + +#line 8077 "" + if (dabs(fnum) > 31.f) { +#line 8078 "" + i__4 = a1ll_2.iccount - 1; +#line 8078 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8078 "" + errmsg_(lineq, &i__4, &i__5, "Slur midheight"\ + " must be in the range (-31,31)!", ( + ftnlen)128, (ftnlen)45); +#line 8080 "" + stop1_(); +#line 8081 "" + } +#line 8082 "" + if (*(unsigned char *)durq == ':') { + +/* Expecting curve parameters. Get two numbers */ + +#line 8086 "" + for (i__ = 1; i__ <= 2; ++i__) { +#line 8087 "" + ++a1ll_2.iccount; +#line 8088 "" + fnum = (real) (*(unsigned char *)&lineq[ + a1ll_2.iccount - 1] - 48); +#line 8089 "" + if ((r__1 = fnum - 3.5f, dabs(r__1)) > + 3.6f) { +#line 8090 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8090 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, + "Slur curve parameter must "\ + "be in range (0,7)!", (ftnlen) + 128, (ftnlen)44); +#line 8093 "" + stop1_(); +#line 8094 "" + } +#line 8095 "" +/* L40: */ +#line 8095 "" + } +#line 8096 "" + ++a1ll_2.iccount; +#line 8097 "" + } +#line 8098 "" + } +#line 8099 "" + --a1ll_2.iccount; +#line 8100 "" + goto L15; +#line 8102 "" + } 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 8107 "" + if (comslur_1.fontslur) { +#line 8108 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8108 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "\ + "use linebreak slur options with font-bas"\ + "ed slurs!", (ftnlen)128, (ftnlen)57); +#line 8110 "" + stop1_(); +#line 8111 "" + } +#line 8112 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8113 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8114 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8114 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"\ + "racter must be \"+\" or \"-\"!", (ftnlen) + 128, (ftnlen)34); +#line 8116 "" + stop1_(); +#line 8117 "" + } +#line 8118 "" + ++a1ll_2.iccount; +#line 8119 "" + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8120 "" + if (i_nint(&fnum) > 30) { +#line 8121 "" + i__4 = a1ll_2.iccount - 1; +#line 8121 "" + i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8121 "" + errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "\ + "height adjustment cannot exceed 30!", ( + ftnlen)128, (ftnlen)53); +#line 8123 "" + stop1_(); +#line 8124 "" + } +#line 8125 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8126 "" + ++a1ll_2.iccount; +#line 8127 "" + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 8128 "" + if (dabs(fnum) > 6.3f) { +#line 8129 "" + i__4 = a1ll_2.iccount - 1; +#line 8129 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8129 "" + errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\ + "ft must be in range (-6.3,6.3)!", ( + ftnlen)128, (ftnlen)45); +#line 8131 "" + stop1_(); +#line 8132 "" + } +#line 8133 "" + } +#line 8134 "" + --a1ll_2.iccount; +#line 8135 "" + goto L15; +#line 8136 "" + } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { +#line 8137 "" + i__4 = a1ll_2.iccount; +#line 8137 "" + if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 - + i__4, (ftnlen)1) == 0) { +#line 8137 "" + ++a1ll_2.iccount; +#line 8137 "" + } +#line 8139 "" + goto L15; +#line 8140 "" + } else if (*(unsigned char *)dumq == 'p') { + +/* local change in postscript slur/tie adjustment default */ + +#line 8144 "" + if (comslur_1.fontslur) { +#line 8145 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8145 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"\ + " postscript slurs (\"Ap\") to use this o"\ + "ption!", (ftnlen)128, (ftnlen)52); +#line 8147 "" + stop1_(); +#line 8148 "" + } +#line 8149 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8150 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8151 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8151 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ + "ed \"+\" or \"-\" here!", (ftnlen)128, ( + ftnlen)25); +#line 8153 "" + stop1_(); +#line 8154 "" + } +#line 8155 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8156 "" + if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8157 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8157 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\ + "ed \"s\" or \"t\" here!", (ftnlen)128, ( + ftnlen)25); +#line 8159 "" + stop1_(); +#line 8160 "" + } +#line 8161 "" + goto L15; +#line 8162 "" + } else if (*(unsigned char *)dumq != ' ') { +#line 8163 "" + ic = *(unsigned char *)dumq; +#line 8164 "" + if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) { +#line 8166 "" + if (iposn == 1) { +#line 8167 "" + if (*(unsigned char *)durq == 't' && + comslur_1.fontslur) { +#line 8168 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8168 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, + "Slur ID not allowed on non-post"\ + "script tie!", (ftnlen)128, ( + ftnlen)42); +#line 8170 "" + stop1_(); +#line 8171 "" + } +#line 8172 "" + goto L15; +#line 8173 "" + } +#line 8174 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8174 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "\ + "must be 2nd character in slur symbol!", ( + ftnlen)128, (ftnlen)45); +#line 8176 "" + stop1_(); +#line 8177 "" + } +#line 8178 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8178 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ + "acter in slur symbol!", (ftnlen)128, (ftnlen) + 33); +#line 8180 "" + stop1_(); +#line 8181 "" + } +#line 8182 "" + goto L110; +#line 8183 "" + } else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, ( + ftnlen)1) > 0) { + +/* We have a figure. Only allow on 1st note of xtup */ + +#line 8187 "" + if (itup != 2) { +#line 8188 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8188 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"\ + "up only allowed on 1st note!", (ftnlen)128, ( + ftnlen)40); +#line 8190 "" + stop1_(); +#line 8191 "" + } else if (*(unsigned char *)durq == 'x') { +#line 8192 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8192 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "\ + "figures in xtuplets!", (ftnlen)128, (ftnlen) + 32); +#line 8194 "" + stop1_(); +#line 8195 "" + } +#line 8196 "" + if (compage_1.usefig && c1ommvl_1.ivx == 1) { +#line 8196 "" + *ifig = 1; +#line 8196 "" + } +#line 8197 "" +L26: +#line 8197 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +/* if (index('0123456789#-n_.:',durq) .gt. 0) then */ +#line 8199 "" + if (i_indx("0123456789#-n_.:v", durq, (ftnlen)17, (ftnlen) + 1) > 0) { +#line 8200 "" + goto L26; +#line 8201 "" + } else if (*(unsigned char *)durq == 's') { +#line 8202 "" + comligfont_1.isligfont = TRUE_; +#line 8203 "" + goto L26; +#line 8204 "" + } else if (*(unsigned char *)durq == '+') { + +/* vertical offset, must be integer then blank */ + +#line 8208 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8209 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) != + 0) { +#line 8210 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8210 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "\ + "for vertical offset expected here!", ( + ftnlen)128, (ftnlen)42); +#line 8212 "" + stop1_(); +#line 8213 "" + } +#line 8214 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8215 "" + if (*(unsigned char *)durq != ' ') { +#line 8216 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8216 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"\ + " offset must terminate figure!", (ftnlen) + 128, (ftnlen)38); +#line 8218 "" + stop1_(); +#line 8219 "" + } +#line 8220 "" + --a1ll_2.iccount; +#line 8221 "" + goto L26; +#line 8222 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8223 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8223 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\ + "acter in figure in xtuplet!", (ftnlen)128, ( + ftnlen)39); +#line 8225 "" + stop1_(); +#line 8226 "" + } +#line 8227 "" + goto L110; +#line 8228 "" + } else if (*(unsigned char *)durq == 'G') { +#line 8229 "" + ngr = 1; +#line 8230 "" +L79: +#line 8230 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, ( + ftnlen)1); +#line 8231 "" + if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) + { +#line 8232 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8233 "" + ngr = i_nint(&fnum); +#line 8234 "" + --a1ll_2.iccount; +#line 8235 "" + goto L79; +#line 8236 "" + } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) + > 0) { +#line 8237 "" + goto L79; +#line 8238 "" + } else if (*(unsigned char *)charq == 'm') { +#line 8239 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, + (ftnlen)1); +#line 8240 "" + if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) + { +#line 8241 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8241 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "\ + "less than 5 must follow \"m\" in a grace"\ + " note!", (ftnlen)128, (ftnlen)52); +#line 8243 "" + stop1_(); +#line 8244 "" + } +#line 8245 "" + goto L79; +#line 8246 "" + } else if (*(unsigned char *)charq == 'X') { + +/* Space before main note */ + +#line 8250 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, + (ftnlen)1); +#line 8251 "" + if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen) + 1) > 0) { +#line 8252 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 8253 "" + --a1ll_2.iccount; +#line 8254 "" + goto L79; +#line 8255 "" + } else { +#line 8256 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8256 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"\ + " must follow \"X\" in a grace note!", ( + ftnlen)128, (ftnlen)41); +#line 8258 "" + stop1_(); +#line 8259 "" + } +#line 8260 "" + } + +/* At this point, charq is first note name in rest (grace?) */ + +#line 8264 "" + i__4 = ngr; +#line 8264 "" + for (igr = 1; igr <= i__4; ++igr) { +#line 8265 "" + numnum = 0; +#line 8266 "" + if (igr > 1) { +#line 8267 "" +L75: +#line 8267 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen) + 128, (ftnlen)1); +#line 8268 "" + if (*(unsigned char *)charq == ' ') { +#line 8268 "" + goto L75; +#line 8268 "" + } +#line 8269 "" + } +#line 8270 "" + if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == + 0) { +#line 8271 "" + i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8271 "" + errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"\ + ", expected \"a\"-\"g\"!", (ftnlen)128, ( + ftnlen)27); +#line 8273 "" + stop1_(); +#line 8274 "" + } +#line 8275 "" +L78: +#line 8275 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, + (ftnlen)1); +#line 8276 "" + if (*(unsigned char *)charq != ' ') { +#line 8277 "" + if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) + > 0) { +#line 8278 "" + if (numnum == 1) { +#line 8279 "" + i__5 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8279 "" + errmsg_(lineq, &a1ll_2.iccount, &i__5, + "Only one of \"+-1234567\" allow"\ + "ed here in grace!", (ftnlen)128, ( + ftnlen)46); +#line 8281 "" + stop1_(); +#line 8282 "" + } +#line 8283 "" + numnum = 1; +#line 8284 "" + goto L78; +#line 8285 "" + } else if (i_indx("+-nfs", charq, (ftnlen)5, ( + ftnlen)1) > 0) { +#line 8286 "" + goto L78; +#line 8287 "" + } + +/* Digits are possible octave numbers */ + +#line 8291 "" + i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8291 "" + errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "\ + "character after note name in grace!", ( + ftnlen)128, (ftnlen)43); +#line 8293 "" + stop1_(); +#line 8294 "" + } +#line 8295 "" +/* L71: */ +#line 8295 "" + } +#line 8296 "" + goto L110; +#line 8297 "" + } else /* if(complicated condition) */ { +#line 8297 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 8297 "" + if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0]) + { +#line 8298 "" + chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); +#line 8299 "" + if (literr > 0) { +#line 8300 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8300 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + ( + literr - 1) * 51, (ftnlen)128, (ftnlen)51) + ; +#line 8302 "" + stop1_(); +#line 8303 "" + } +#line 8304 "" + goto L110; +#line 8305 "" + } else if (*(unsigned char *)durq == '"') { + +/* pmx lyric */ + +#line 8309 "" + chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen) + 128); +#line 8310 "" + if (lyrerr > 0) { +#line 8311 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8311 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + ( + lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51) + ; +#line 8313 "" + stop1_(); +#line 8314 "" + } +#line 8315 "" + goto L110; +#line 8316 "" + } else if (*(unsigned char *)durq == 'M') { + +/* Temporary trap until I get around putting this in pmxb */ + +#line 8320 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8320 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"\ + "et allowed in xtuplets!", (ftnlen)128, ( + ftnlen)35); +#line 8322 "" + stop1_(); +#line 8323 "" + } else if (*(unsigned char *)durq == 'X') { +#line 8324 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8324 "" + 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 8326 "" + goto L110; +#line 8327 "" + } else if (*(unsigned char *)durq == 'z') { + +/* Chord note in xtup. Read past for now. */ + +#line 8331 "" +L33: +#line 8331 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8332 "" + if (*(unsigned char *)durq != ' ') { +#line 8332 "" + goto L33; +#line 8332 "" + } +#line 8333 "" + goto L110; +#line 8334 "" + } else if (*(unsigned char *)durq == 'D') { + +/* Dynamic mark */ + +#line 8338 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8338 "" + checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128); +#line 8339 "" + goto L110; +#line 8340 "" + } else if (*(unsigned char *)durq == '%') { +#line 8341 "" + if (a1ll_2.iccount != 1) { +#line 8342 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8342 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "\ + "must have \"%\" in column 1!", (ftnlen) + 128, (ftnlen)34); +#line 8344 "" + stop1_(); +#line 8345 "" + } +#line 8346 "" + a1ll_2.iccount = 128; +#line 8347 "" + goto L110; +#line 8348 "" + } else if (*(unsigned char *)durq == '?') { +#line 8349 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8350 "" + if (*(unsigned char *)durq == ' ') { +#line 8351 "" + --a1ll_2.iccount; +#line 8352 "" + goto L110; +#line 8353 "" + } +#line 8354 "" + if (*(unsigned char *)durq != '-') { +#line 8355 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8355 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ + "g \"-\"", (ftnlen)128, (ftnlen)13); +#line 8357 "" + stop1_(); +#line 8358 "" + } +#line 8359 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8360 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) + == 0) { +#line 8361 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8361 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\ + "g number", (ftnlen)128, (ftnlen)16); +#line 8363 "" + stop1_(); +#line 8364 "" + } +#line 8365 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 8366 "" + --a1ll_2.iccount; +#line 8367 "" + goto L110; + +/* 140215 Allow clef change inside xtup */ + +#line 8371 "" + } else if (*(unsigned char *)durq == 'C') { +#line 8372 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 8373 "" + 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 8376 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8376 "" + 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 8378 "" + stop1_(); +#line 8379 "" + } +/* gotclef = .true. */ +#line 8381 "" + goto L110; +/* +++ */ +#line 8383 "" + } else /* if(complicated condition) */ { +#line 8383 "" + i__4 = a1ll_2.iccount; +#line 8383 "" + i__5 = a1ll_2.iccount + 1; +#line 8383 "" + 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 8385 "" + a1ll_2.iccount += 2; +#line 8386 "" + goto L110; +/* +++ */ +#line 8388 "" + } +#line 8388 "" + } +#line 8388 "" + } + +/* End of xtup options. At this point symbol can only be note or rest */ + +#line 8392 "" + if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) { +#line 8393 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8393 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"\ + "aracter is not allowed!", (ftnlen)128, (ftnlen)39) + ; +#line 8395 "" + stop1_(); +#line 8396 "" + } else if (*(unsigned char *)durq == 'r' && itup == ntup) { +#line 8397 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8397 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Sorry, PMX canno"\ + "t end an xtuplet with a rest!", (ftnlen)128, ( + ftnlen)45); +#line 8399 "" + stop1_(); +#line 8400 "" + } +#line 8401 "" +L7: +#line 8401 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 8402 "" + if (i_indx("2345678ulcb", durq, (ftnlen)11, (ftnlen)1) > 0) { +#line 8403 "" + goto L7; +#line 8404 "" + } else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */ + +#line 8408 "" + i__4 = a1ll_2.iccount; +#line 8408 "" + if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, ( + ftnlen)1) == 0) { +#line 8408 "" + ++a1ll_2.iccount; +#line 8408 "" + } +#line 8409 "" + goto L7; +#line 8410 "" + } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { + +/* May have either octave jump or shifted accid. on main xtup note */ + +#line 8414 "" + i__4 = a1ll_2.iccount; +#line 8414 "" + 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 8414 "" + goto L7; +#line 8414 "" + } +#line 8417 "" + ++a1ll_2.iccount; +#line 8418 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 8419 "" + --a1ll_2.iccount; +#line 8420 "" + goto L7; +#line 8421 "" + } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Double an xtup note to make an unequal xtup */ + +#line 8425 "" + 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 8426 "" + ++ndoub; +#line 8427 "" + goto L7; +#line 8428 "" + } else if (*(unsigned char *)durq == 'd') { +#line 8429 "" + 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 8430 "" + goto L7; +#line 8431 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8432 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8432 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"\ + "n xtuplet note!", (ftnlen)128, (ftnlen)31); +#line 8434 "" + stop1_(); +#line 8435 "" + } +#line 8436 "" + if (itup == ntup - ndoub) { +#line 8436 "" + goto L3; +#line 8436 "" + } +#line 8437 "" +/* L6: */ +#line 8437 "" + } +#line 8438 "" +L3: + +/* 6==End of loop for xtuplet input */ + +#line 8442 "" + ; +#line 8442 "" + } else if (*(unsigned char *)durq == 'm') { + +/* Multi-bar rest: next 1 or two digits are # of bars. */ + +#line 8446 "" + if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) { +#line 8447 "" + i__1 = a1ll_2.iccount - 1; +#line 8447 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8447 "" + errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"\ + "ginning of bar!", (ftnlen)128, (ftnlen)45); +#line 8449 "" + stop1_(); +#line 8450 "" + } else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) { +#line 8451 "" + i__1 = a1ll_2.iccount - 1; +#line 8451 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8451 "" + errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"\ + "ime per block!", (ftnlen)128, (ftnlen)44); +#line 8453 "" + stop1_(); +#line 8454 "" + } + +/* For some purposes, pretend its one bar only */ + +#line 8458 "" + a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] = + a1ll_2.lenbar; +#line 8459 "" + c1omnotes_1.ibarmbr = a1ll_2.nbars + 1; +#line 8460 "" + c1omnotes_1.mbrest = 0; +/* 20 call g1etchar(lineq,iccount,durq) */ +#line 8462 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8463 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 8464 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8464 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "\ + "after \"rm\"!", (ftnlen)128, (ftnlen)31); +#line 8466 "" + stop1_(); +#line 8467 "" + } +#line 8468 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8469 "" + c1omnotes_1.mbrest = i_nint(&fnum); +#line 8470 "" + --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 8475 "" + if (a1ll_2.nv > 1) { +#line 8476 "" + if (a1ll_2.iv == 1) { +#line 8477 "" + comkeys_1.mbrestsav = c1omnotes_1.mbrest; +#line 8478 "" + } else { +#line 8479 "" + if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) { +#line 8480 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8480 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"\ + "ame multi-bar rest in every voice!", (ftnlen) + 128, (ftnlen)46); +#line 8482 "" + stop1_(); +#line 8483 "" + } +#line 8484 "" + } + +/* Zero out mbrestsav so can check at end of input block whether */ +/* all voices have one */ + +#line 8489 "" + if (a1ll_2.iv == a1ll_2.nv) { +#line 8489 "" + comkeys_1.mbrestsav = 0; +#line 8489 "" + } +#line 8490 "" + } +#line 8491 "" + if (*(unsigned char *)durq != ' ') { +#line 8492 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8492 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ + "ter \"rm\"!", (ftnlen)128, (ftnlen)29); +#line 8494 "" + stop1_(); +#line 8495 "" + } +#line 8496 "" + } 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 8501 "" + idotform = 1; +#line 8502 "" + } else if (*(unsigned char *)durq == ',') { +#line 8503 "" + idotform = 3; + +/* Now flow to duration setting, as if durq=' ' */ + +#line 8507 "" + } else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Suppress full bar rest, or look left for height */ + +#line 8511 "" + if (*(unsigned char *)charq != 'r') { +#line 8512 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8512 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "\ + "only legal for rest, not note!", (ftnlen)128, (ftnlen) + 46); +#line 8514 "" + stop1_(); +#line 8515 "" + } +#line 8516 "" + goto L2; +#line 8517 "" + } 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 8522 "" + 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 8523 "" + goto L2; +#line 8524 "" + } else if (*(unsigned char *)durq == 'A') { + +/* Main note accidental option */ + +#line 8528 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8529 "" + if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8530 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8530 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""\ + "<\",\">\" are the only legal options here!", (ftnlen) + 128, (ftnlen)51); +#line 8532 "" + stop1_(); +#line 8533 "" + } + +/* Need more stuff here */ + +#line 8537 "" + 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 8542 "" + --a1ll_2.iccount; +#line 8543 "" + } +#line 8544 "" + goto L2; +#line 8545 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8546 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8546 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", ( + ftnlen)128, (ftnlen)18); +#line 8548 "" + s_wsle(&io___621); +#line 8548 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 8548 "" + i__1 = *(unsigned char *)durq; +#line 8548 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 8548 "" + e_wsle(); +#line 8549 "" + stop1_(); +#line 8550 "" + } + +/* End of block for note options. */ + +/* Set the duration */ + +#line 8556 "" + if (idotform > 0) { +#line 8557 "" + if (idotform == 1) { +#line 8558 "" + 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 8559 "" + } else if (idotform == 2) { +#line 8560 "" + 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 8561 "" + } else if (idotform == 3) { +#line 8562 "" + a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * + 24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, ( + ftnlen)1); +#line 8563 "" + } else if (idotform == 4) { +#line 8564 "" + 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 8565 "" + } +#line 8566 "" + } else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) { +#line 8567 "" + 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 8571 "" + if (c1omnotes_1.iddot == 1) { +#line 8572 "" + 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 8573 "" + c1omnotes_1.iddot = 0; +#line 8574 "" + } +#line 8575 "" + } else if (fulbrp) { +#line 8576 "" + 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 8580 "" + i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48; +#line 8580 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 8580 "" + c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, ( + ftnlen)1) - 1; +#line 8582 "" + fulbrp = FALSE_; +#line 8583 "" + } +#line 8584 "" + 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 8588 "" + if (c1omget_1.fbon) { +#line 8589 "" + if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * + 24 - 25] < 16) { +#line 8589 "" + goto L120; +#line 8589 "" + } +#line 8590 "" + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) { +#line 8591 "" + if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx - + 1] - 1) * 24 - 25] == 0) { +#line 8591 "" + goto L120; +#line 8591 "" + } +#line 8592 "" + } +#line 8593 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8593 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"\ + "ed beam!", (ftnlen)128, (ftnlen)32); +#line 8595 "" + stop1_(); +#line 8596 "" + } +#line 8597 "" +L120: + +/* Get number of prior bars for later check on whether note spans bar line */ + +#line 8601 "" + nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; +#line 8602 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx + + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25]; +#line 8603 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) { +#line 8604 "" + ++a1ll_2.nbars; +#line 8605 "" + if (comkeys_1.shifton) { +#line 8605 "" + comkeys_1.barend = TRUE_; +#line 8605 "" + } + +/* Will check barend when 1st note of next bar is entered. */ + +#line 8609 "" + if (a1ll_2.nbars > 15) { +#line 8610 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8610 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"\ + "n 15 bars in an input block!", (ftnlen)128, (ftnlen) + 48); +#line 8612 "" + stop1_(); +#line 8613 "" + } +#line 8614 "" + a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[ + c1ommvl_1.ivx - 1]; +#line 8615 "" + if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) { + +/* Just finished the pickup bar for this voice. */ + +#line 8619 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) { +#line 8620 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8620 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"\ + "h disagrees with mtrnum0!", (ftnlen)128, (ftnlen) + 41); +#line 8622 "" + stop1_(); +#line 8623 "" + } +#line 8624 "" + a1ll_2.lenbar = a1ll_2.lenbr1; +#line 8625 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; +#line 8626 "" + } +#line 8627 "" + } else if (comkeys_1.barend) { +#line 8628 "" + if (comkeys_1.shifton) { +#line 8629 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8629 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ + "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 8631 "" + stop1_(); +#line 8632 "" + } +#line 8633 "" + comkeys_1.barend = FALSE_; +#line 8634 "" + } else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) { +#line 8635 "" + i__1 = a1ll_2.iccount - 1; +#line 8635 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8635 "" + errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", ( + ftnlen)128, (ftnlen)27); +#line 8637 "" + stop1_(); +#line 8638 "" + } +#line 8639 "" + if (idotform == 1 || idotform == 3) { +#line 8640 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8641 "" + if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) { +#line 8642 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8642 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"\ + "r \"r\" here!", (ftnlen)128, (ftnlen)31); +#line 8644 "" + stop1_(); +#line 8645 "" + } +#line 8646 "" + ++idotform; +#line 8647 "" + numnum = 1; +#line 8648 "" + goto L28; +#line 8649 "" + } + +/* End of sub block for note-rest */ + +#line 8653 "" + } else if (*(unsigned char *)charq == 'z') { +#line 8654 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8655 "" + if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 8656 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8656 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"\ + " here!", (ftnlen)128, (ftnlen)30); +#line 8658 "" + stop1_(); +#line 8659 "" + } +#line 8660 "" +L25: +#line 8660 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +/* if (index('dre12345678',durq) .gt. 0) then */ +#line 8662 "" + if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 8663 "" + goto L25; +#line 8664 "" + } 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 8669 "" + i__1 = a1ll_2.iccount; +#line 8669 "" + if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1) + == 0) { +#line 8669 "" + ++a1ll_2.iccount; +#line 8669 "" + } +#line 8670 "" + goto L25; +#line 8671 "" + } else if (*(unsigned char *)durq == 'A') { +#line 8672 "" + i__1 = a1ll_2.iccount - 2; +#line 8672 "" + if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 - + i__1) == 0) { +#line 8673 "" + i__1 = a1ll_2.iccount - 1; +#line 8673 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8673 "" + errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""\ + "A\" in chord note!", (ftnlen)128, (ftnlen)43); +#line 8675 "" + stop1_(); +#line 8676 "" + } +#line 8677 "" + goto L25; +#line 8678 "" + } else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8679 "" + i__1 = a1ll_2.iccount - 2; +#line 8679 "" + 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 8681 "" + i__1 = a1ll_2.iccount - 1; +#line 8681 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8681 "" + errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"\ + " \"<\" or \">\"!", (ftnlen)128, (ftnlen)38); +#line 8683 "" + stop1_(); +#line 8684 "" + } +#line 8685 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8686 "" + if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 8687 "" + i__1 = a1ll_2.iccount - 1; +#line 8687 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8687 "" + errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"\ + "e for accidental shift!", (ftnlen)128, (ftnlen)53); +#line 8689 "" + stop1_(); +#line 8690 "" + } +#line 8691 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8692 "" + --a1ll_2.iccount; +#line 8693 "" + goto L25; +#line 8694 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8695 "" + i__1 = a1ll_2.iccount; +#line 8695 "" + if (i_indx("1234567890.", lineq + i__1, (ftnlen)11, + a1ll_2.iccount + 1 - i__1) == 0) { +#line 8695 "" + goto L25; +#line 8695 "" + } + +/* Number or '.' (durq) follows +/- . Get it. */ + +#line 8700 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8701 "" + i__1 = a1ll_2.iccount; +#line 8701 "" + if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq + + i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) { +#line 8703 "" + i__1 = a1ll_2.iccount - 1; +#line 8703 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8703 "" + errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"\ + " a digit!", (ftnlen)128, (ftnlen)37); +#line 8705 "" + stop1_(); +#line 8706 "" + } else /* if(complicated condition) */ { +#line 8706 "" + i__1 = a1ll_2.iccount - 3; +#line 8706 "" + if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount - + 2 - i__1) == 0) { +#line 8707 "" + i__1 = a1ll_2.iccount - 1; +#line 8707 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8707 "" + errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"\ + "ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41); +#line 8709 "" + stop1_(); +#line 8710 "" + } +#line 8710 "" + } +#line 8711 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8712 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 8713 "" + --a1ll_2.iccount; +#line 8714 "" + goto L25; +#line 8715 "" + } + +/* 2nd +/- */ + +#line 8719 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 8720 "" + if (*(unsigned char *)durq == '.') { +#line 8720 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 8720 "" + } +#line 8721 "" + if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 8722 "" + i__1 = a1ll_2.iccount - 1; +#line 8722 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8722 "" + errmsg_(lineq, &i__1, &i__4, "Expected a number here!", ( + ftnlen)128, (ftnlen)23); +#line 8724 "" + stop1_(); +#line 8725 "" + } +#line 8726 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8727 "" + --a1ll_2.iccount; +#line 8728 "" + goto L25; +#line 8729 "" + } else if (*(unsigned char *)durq != ' ') { +#line 8730 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 8730 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"\ + "rd note!", (ftnlen)128, (ftnlen)32); +#line 8732 "" + stop1_(); +#line 8733 "" + } +#line 8734 "" + } else if (*(unsigned char *)charq == 'G') { +#line 8735 "" + ngr = 1; +#line 8736 "" +L9: +#line 8736 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8737 "" + if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { +#line 8738 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8739 "" + ngr = i_nint(&fnum); +#line 8740 "" + --a1ll_2.iccount; +#line 8741 "" + goto L9; +#line 8742 "" + } else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 8743 "" + goto L9; +#line 8744 "" + } else if (*(unsigned char *)charq == 'm') { +#line 8745 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8746 "" + if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8747 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8747 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "\ + "must follow \"m\" in a grace note!", (ftnlen)128, ( + ftnlen)52); +#line 8749 "" + stop1_(); +#line 8750 "" + } +#line 8751 "" + goto L9; +#line 8752 "" + } else if (*(unsigned char *)charq == 'X') { + +/* Space before main note */ + +#line 8756 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8757 "" + if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) { +#line 8758 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8759 "" + --a1ll_2.iccount; +#line 8760 "" + goto L9; +#line 8761 "" + } else { +#line 8762 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8762 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"\ + "ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41); +#line 8764 "" + stop1_(); +#line 8765 "" + } +#line 8766 "" + } + +/* At this point, charq is first note name in rest (grace?) */ + +#line 8770 "" + i__1 = ngr; +#line 8770 "" + for (igr = 1; igr <= i__1; ++igr) { +#line 8771 "" + numnum = 0; +#line 8772 "" + if (igr > 1) { +#line 8773 "" +L55: +#line 8773 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); +#line 8774 "" + if (*(unsigned char *)charq == ' ') { +#line 8774 "" + goto L55; +#line 8774 "" + } +#line 8775 "" + } +#line 8776 "" + if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 8777 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8777 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"\ + " \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27); +#line 8779 "" + stop1_(); +#line 8780 "" + } +#line 8781 "" +L18: +#line 8781 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 8782 "" + if (*(unsigned char *)charq != ' ') { +#line 8783 "" + if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) { +#line 8784 "" + if (numnum == 1) { +#line 8785 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8785 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"\ + " \"+-1234567\" allowed here in grace!", ( + ftnlen)128, (ftnlen)46); +#line 8787 "" + stop1_(); +#line 8788 "" + } +#line 8789 "" + numnum = 1; +#line 8790 "" + goto L18; +/* else if (index('nfs',charq) .gt. 0) then */ +#line 8792 "" + } else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) { +#line 8793 "" + goto L18; +#line 8794 "" + } + +/* Digits are possible octave numbers */ + +#line 8798 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8798 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"\ + "ter note name in grace!", (ftnlen)128, (ftnlen)43); +#line 8800 "" + stop1_(); +#line 8801 "" + } +#line 8802 "" +/* L19: */ +#line 8802 "" + } +#line 8803 "" + } else /* if(complicated condition) */ { +#line 8803 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 8803 "" + if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) { +#line 8804 "" + chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128); +#line 8805 "" + if (literr > 0) { +#line 8806 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8806 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) * + 51, (ftnlen)128, (ftnlen)51); +#line 8808 "" + stop1_(); +#line 8809 "" + } +#line 8810 "" + } else if (*(unsigned char *)charq == '"') { + +/* pmx lyric */ + +#line 8814 "" + chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128); +#line 8815 "" + if (lyrerr > 0) { +#line 8816 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8816 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - 1) * + 51, (ftnlen)128, (ftnlen)51); +#line 8818 "" + stop1_(); +#line 8819 "" + } +#line 8820 "" + } else if (*(unsigned char *)charq == 'o') { + +/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */ + +#line 8824 "" + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { +#line 8825 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8825 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"\ + "e input block, after affected note!", (ftnlen)128, ( + ftnlen)53); +#line 8827 "" + stop1_(); +#line 8828 "" + } +#line 8829 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); +/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */ +#line 8831 "" + if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (ftnlen)1) + == 0) { +#line 8832 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8832 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", ( + ftnlen)128, (ftnlen)17); +#line 8834 "" + stop1_(); +#line 8835 "" + } +#line 8836 "" + if (*(unsigned char *)dumq == ':') { +#line 8837 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8838 "" + if (*(unsigned char *)dumq != ' ') { +#line 8839 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8839 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"\ + "fter \"o:\"!", (ftnlen)128, (ftnlen)26); +#line 8841 "" + stop1_(); +#line 8842 "" + } else if (! comkeys_1.ornrpt) { +#line 8843 "" + i__1 = a1ll_2.iccount - 1; +#line 8843 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8843 "" + errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"\ + "nts before they were on!", (ftnlen)128, (ftnlen) + 50); +#line 8845 "" + stop1_(); +#line 8846 "" + } +#line 8847 "" + comkeys_1.ornrpt = FALSE_; +#line 8848 "" + } else if (*(unsigned char *)dumq == 'g') { +#line 8849 "" + if (c1omget_1.issegno) { +#line 8850 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8850 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"\ + " \"segno\" per input block!", (ftnlen)128, ( + ftnlen)40); +#line 8852 "" + stop1_(); +#line 8853 "" + } else if (c1ommvl_1.ivx != 1) { +#line 8854 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8854 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"\ + "e in voice 1!", (ftnlen)128, (ftnlen)29); +#line 8856 "" + stop1_(); +#line 8857 "" + } +#line 8858 "" + c1omget_1.issegno = TRUE_; +#line 8859 "" +L12: +#line 8859 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8860 "" + if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >= + 48 && *(unsigned char *)dumq <= 58) { +#line 8860 "" + goto L12; +#line 8860 "" + } +#line 8862 "" + if (*(unsigned char *)dumq != ' ') { +#line 8863 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8863 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r in segno ornament symbol!", (ftnlen)128, ( + ftnlen)43); +#line 8865 "" + stop1_(); +#line 8866 "" + } +#line 8867 "" + } else if (*(unsigned char *)dumq == 'T') { + +/* Trill. may be followed by 't' and/or number. read 'til blank */ + +#line 8871 "" +L22: +#line 8871 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8872 "" + if (*(unsigned char *)dumq == ':') { +#line 8873 "" + i__1 = a1ll_2.iccount; +#line 8873 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 8874 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8874 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\ + "nk after \":\"!", (ftnlen)128, (ftnlen)25); +#line 8876 "" + stop1_(); +#line 8877 "" + } +#line 8878 "" + goto L32; +#line 8879 "" + } else if (*(unsigned char *)dumq != ' ') { +#line 8880 "" + goto L22; +#line 8881 "" + } +#line 8882 "" + } else if (*(unsigned char *)dumq == 'f') { +#line 8883 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8884 "" + if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) { +#line 8885 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8885 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after \"f\" in fermata ornament symbol!", ( + ftnlen)128, (ftnlen)55); +#line 8887 "" + stop1_(); +#line 8888 "" + } +#line 8889 "" + if (*(unsigned char *)dumq == 'd') { +#line 8889 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8889 "" + } +#line 8890 "" + if (*(unsigned char *)dumq == ':') { +#line 8890 "" + goto L32; +#line 8890 "" + } +#line 8891 "" + } else if (*(unsigned char *)dumq == 'e') { +#line 8892 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8893 "" + if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 8894 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8894 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after \"e\" in edit. accid. symbol!", (ftnlen) + 128, (ftnlen)51); +#line 8896 "" + stop1_(); +#line 8897 "" + } +#line 8898 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8899 "" + if (*(unsigned char *)dumq == '?') { +#line 8899 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 8899 "" + } +#line 8900 "" + } else { +#line 8901 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 8902 "" + } +#line 8903 "" + if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) { +#line 8904 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8904 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ + " ornament symbol!", (ftnlen)128, (ftnlen)37); +#line 8906 "" + stop1_(); +#line 8907 "" + } +#line 8908 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8909 "" + i__1 = a1ll_2.iccount; +#line 8909 "" + if (i_indx("0123456789", lineq + i__1, (ftnlen)10, + a1ll_2.iccount + 1 - i__1) == 0) { +#line 8910 "" + i__1 = a1ll_2.iccount + 1; +#line 8910 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8910 "" + errmsg_(lineq, &i__1, &i__4, "There should be an integer"\ + " here!", (ftnlen)128, (ftnlen)32); +#line 8912 "" + stop1_(); +#line 8913 "" + } +#line 8914 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 8915 "" + if (*(unsigned char *)durq == ':') { +#line 8916 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8916 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"\ + " repeat an ornament!", (ftnlen)128, (ftnlen)36); +#line 8918 "" + stop1_(); +#line 8919 "" + } + +/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */ + +#line 8923 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 8924 "" + i__1 = a1ll_2.iccount; +#line 8924 "" + if (i_indx(".0123456789", lineq + i__1, (ftnlen)11, + a1ll_2.iccount + 1 - i__1) == 0) { +#line 8926 "" + i__1 = a1ll_2.iccount + 1; +#line 8926 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8926 "" + errmsg_(lineq, &i__1, &i__4, "There should be a numb"\ + "er here!", (ftnlen)128, (ftnlen)30); +#line 8928 "" + stop1_(); +#line 8929 "" + } +#line 8930 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 8931 "" + } +#line 8932 "" + } +#line 8933 "" +L32: +#line 8934 "" + if (*(unsigned char *)dumq == ':') { +#line 8935 "" + i__1 = a1ll_2.iccount; +#line 8935 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 8936 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8936 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"\ + "llowed by blank in \"o: \"!", (ftnlen)128, ( + ftnlen)39); +#line 8938 "" + stop1_(); +#line 8939 "" + } else if (comkeys_1.ornrpt) { +#line 8940 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8940 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"\ + "ed ornaments but already on!", (ftnlen)128, ( + ftnlen)44); +#line 8942 "" + stop1_(); +#line 8943 "" + } +#line 8944 "" + comkeys_1.ornrpt = TRUE_; +#line 8945 "" + } +#line 8946 "" + } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 8947 "" + numint = 0; +#line 8948 "" + iposn = 0; +#line 8949 "" +L8: +#line 8949 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1); +#line 8950 "" + ++iposn; +#line 8951 "" + if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq == + 't') { +#line 8952 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8952 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "\ + "an option on a tie!", (ftnlen)128, (ftnlen)37); +#line 8954 "" + stop1_(); +#line 8955 "" + } +#line 8956 "" + if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == 0) { + +/* Check for explicit ID code. */ + +#line 8960 "" + ic = *(unsigned char *)dumq; +#line 8961 "" + if (ic < 48 || ic > 57 && ic < 65 || ic > 90) { + +/* Not 0-9 or A-Z, so exit */ + +#line 8966 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8966 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r in slur symbol!", (ftnlen)128, (ftnlen)33); +#line 8968 "" + stop1_(); +#line 8969 "" + } else { + +/* It is a possible ID code. Right place? */ + +#line 8973 "" + if (iposn != 1) { + +/* Slur ID is not 2nd! */ + +#line 8977 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8977 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"\ + " be second character in slur symbol!", ( + ftnlen)128, (ftnlen)48); +#line 8979 "" + stop1_(); +#line 8980 "" + } else if (*(unsigned char *)charq == 't' && + comslur_1.fontslur) { +#line 8981 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8981 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "\ + "allowed on non-postscript tie!", (ftnlen)128, + (ftnlen)42); +#line 8983 "" + stop1_(); +#line 8984 "" + } +#line 8985 "" + } + +/* Slur ID is OK. Note it cannot be "H" at this point.. */ + +#line 8989 "" + goto L8; +#line 8990 "" + } else if (*(unsigned char *)dumq == 'H') { +#line 8991 "" + if (iposn == 1) { +#line 8991 "" + goto L8; +#line 8991 "" + } + +/* "H" is NOT an ID code. */ + +#line 8995 "" + if (! comslur_1.fontslur && *(unsigned char *)charq == 't') { +#line 8996 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 8996 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"\ + "ostscript ties this way!", (ftnlen)128, (ftnlen) + 40); +#line 8998 "" + stop1_(); +#line 8999 "" + } +#line 9000 "" + i__1 = a1ll_2.iccount; +#line 9000 "" + if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) == 0) { +#line 9001 "" + ++a1ll_2.iccount; +#line 9002 "" + ++iposn; +#line 9003 "" + } +#line 9004 "" + goto L8; +#line 9005 "" + } 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 9010 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9010 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"\ + "cript ties this way!", (ftnlen)128, (ftnlen)40); +#line 9012 "" + stop1_(); +#line 9013 "" + } else if (*(unsigned char *)dumq == 'p') { + +/* local change in postscript slur/tie adjustment default */ + +#line 9017 "" + if (comslur_1.fontslur) { +#line 9018 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9018 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"\ + "ipt slurs (\"Ap\") to use this option!", (ftnlen) + 128, (ftnlen)52); +#line 9020 "" + stop1_(); +#line 9021 "" + } +#line 9022 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 9023 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9024 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9024 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"\ + "r \"-\" here!", (ftnlen)128, (ftnlen)25); +#line 9026 "" + stop1_(); +#line 9027 "" + } +#line 9028 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 9029 "" + if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9030 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9030 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"\ + "r \"t\" here!", (ftnlen)128, (ftnlen)25); +#line 9032 "" + stop1_(); +#line 9033 "" + } +#line 9034 "" + iposn += 2; +#line 9035 "" + goto L8; +#line 9036 "" + } +#line 9037 "" + if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) { +#line 9038 "" + goto L8; +#line 9039 "" + } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9040 "" + ++numint; +#line 9041 "" + if (comslur_1.fontslur && *(unsigned char *)charq == 't') { +#line 9042 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9042 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"\ + " height only allowed in \"s\"-slurs!", (ftnlen) + 128, (ftnlen)48); +#line 9044 "" + stop1_(); +#line 9045 "" + } +#line 9046 "" + ++a1ll_2.iccount; +#line 9047 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9048 "" + if (numint == 1) { +#line 9049 "" + if (i_nint(&fnum) > 30) { +#line 9050 "" + i__1 = a1ll_2.iccount - 1; +#line 9050 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9050 "" + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\ + "ht adjustment cannot exceed 30!", (ftnlen)128, + (ftnlen)53); +#line 9052 "" + stop1_(); +#line 9053 "" + } +#line 9054 "" + } else if (numint == 2) { +#line 9055 "" + if (dabs(fnum) > 6.3f) { +#line 9056 "" + i__1 = a1ll_2.iccount - 1; +#line 9056 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9056 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ + "be in range (-6.3,6.3)!", (ftnlen)128, ( + ftnlen)45); +#line 9058 "" + stop1_(); +#line 9059 "" + } +#line 9060 "" + } else { + +/* Third signed integer, must be a midslur or curve spec. */ + +#line 9064 "" + if (dabs(fnum) > 31.f) { +#line 9065 "" + i__1 = a1ll_2.iccount - 1; +#line 9065 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9065 "" + errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"\ + " in the range (-31,31)!", (ftnlen)128, ( + ftnlen)45); +#line 9067 "" + stop1_(); +#line 9068 "" + } +#line 9069 "" + if (*(unsigned char *)durq == ':') { + +/* Expecting curve parameters. Get two numbers */ + +#line 9073 "" + for (i__ = 1; i__ <= 2; ++i__) { +#line 9074 "" + ++a1ll_2.iccount; +#line 9075 "" + fnum = (real) (*(unsigned char *)&lineq[ + a1ll_2.iccount - 1] - 48); +#line 9076 "" + if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) { +#line 9077 "" + i__1 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9077 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"\ + " curve parameter must be in range (0"\ + ",7)!", (ftnlen)128, (ftnlen)44); +#line 9079 "" + stop1_(); +#line 9080 "" + } +#line 9081 "" +/* L41: */ +#line 9081 "" + } +#line 9082 "" + ++a1ll_2.iccount; +#line 9083 "" + } +#line 9084 "" + } +#line 9085 "" + --a1ll_2.iccount; +#line 9086 "" + goto L8; +#line 9087 "" + } 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 9092 "" + if (comslur_1.fontslur) { +#line 9093 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9093 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"\ + "break slur options with font-based slurs!", ( + ftnlen)128, (ftnlen)57); +#line 9095 "" + stop1_(); +#line 9096 "" + } +#line 9097 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen) + 1); +#line 9098 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9099 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9099 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"\ + "ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34); +#line 9101 "" + stop1_(); +#line 9102 "" + } +#line 9103 "" + ++a1ll_2.iccount; +#line 9104 "" + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9105 "" + if (i_nint(&fnum) > 30) { +#line 9106 "" + i__1 = a1ll_2.iccount - 1; +#line 9106 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9106 "" + errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"\ + "djustment cannot exceed 30!", (ftnlen)128, ( + ftnlen)53); +#line 9108 "" + stop1_(); +#line 9109 "" + } +#line 9110 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9111 "" + ++a1ll_2.iccount; +#line 9112 "" + readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 9113 "" + if (dabs(fnum) > 6.3f) { +#line 9114 "" + i__1 = a1ll_2.iccount - 1; +#line 9114 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9114 "" + errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\ + "be in range (-6.3,6.3)!", (ftnlen)128, ( + ftnlen)45); +#line 9116 "" + stop1_(); +#line 9117 "" + } +#line 9118 "" + } +#line 9119 "" + --a1ll_2.iccount; +#line 9120 "" + goto L8; +#line 9121 "" + } else if (*(unsigned char *)dumq == 'H' && iposn > 1) { +#line 9122 "" + i__1 = a1ll_2.iccount; +#line 9122 "" + if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) == 0) { +#line 9122 "" + ++a1ll_2.iccount; +#line 9122 "" + } +#line 9123 "" + goto L8; +#line 9124 "" + } +#line 9125 "" + } else if (*(unsigned char *)charq == '?') { +#line 9126 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9127 "" + if (*(unsigned char *)durq == ' ') { +#line 9128 "" + --a1ll_2.iccount; +#line 9129 "" + } else { +#line 9130 "" + if (*(unsigned char *)durq != '-') { +#line 9131 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9131 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!", + (ftnlen)128, (ftnlen)14); +#line 9133 "" + stop1_(); +#line 9134 "" + } +#line 9135 "" + getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1) + ; +#line 9136 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9137 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9137 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!" + , (ftnlen)128, (ftnlen)17); +#line 9139 "" + stop1_(); +#line 9140 "" + } +#line 9141 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9142 "" + --a1ll_2.iccount; +#line 9143 "" + } +#line 9144 "" + } 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 9149 "" + 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 9154 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9154 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"\ + "fore first note in block!", (ftnlen)128, (ftnlen)45); +#line 9156 "" + stop1_(); +#line 9157 "" + } +#line 9158 "" + if (*(unsigned char *)charq == 'x') { +#line 9159 "" + indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - ( + a1ll_2.iccount - 1), (ftnlen)1); +#line 9160 "" + if (indxb < 5) { +#line 9161 "" + i__1 = a1ll_2.iccount + indxb - 1; +#line 9161 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9161 "" + errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"\ + "n floating figure!", (ftnlen)128, (ftnlen)44); +#line 9163 "" + stop1_(); +#line 9164 "" + } +#line 9165 "" + } +#line 9166 "" + if (compage_1.usefig) { +#line 9166 "" + *ifig = 1; +#line 9166 "" + } +#line 9167 "" +L5: +#line 9167 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9168 "" + if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (ftnlen)1) + == 0) { +#line 9169 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9169 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ + " figure!", (ftnlen)128, (ftnlen)28); +#line 9171 "" + stop1_(); +#line 9172 "" + } else if (*(unsigned char *)charq == '+') { + +/* vertical offset, must be integer, then blank */ + +#line 9176 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); +#line 9177 "" + if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) { +#line 9178 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9178 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"\ + "ical offset expected here!", (ftnlen)128, (ftnlen) + 42); +#line 9180 "" + stop1_(); +#line 9181 "" + } +#line 9182 "" + readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9183 "" + if (*(unsigned char *)charq != ' ') { +#line 9184 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9184 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "\ + "must terminate figure!", (ftnlen)128, (ftnlen)38); +#line 9186 "" + stop1_(); +#line 9187 "" + } +#line 9188 "" + --a1ll_2.iccount; +#line 9189 "" + goto L5; +#line 9190 "" + } else if (*(unsigned char *)charq == 's') { +#line 9191 "" + comligfont_1.isligfont = TRUE_; +#line 9192 "" + } +#line 9193 "" + if (*(unsigned char *)charq != ' ') { +#line 9193 "" + goto L5; +#line 9193 "" + } +#line 9194 "" + } else if (*(unsigned char *)charq == '[') { +#line 9195 "" + if (c1omget_1.fbon) { +#line 9196 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9196 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "\ + "while another was open!", (ftnlen)128, (ftnlen)43); +#line 9198 "" + stop1_(); +#line 9199 "" + } +#line 9200 "" + c1omget_1.fbon = TRUE_; +#line 9201 "" +L17: +#line 9201 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9202 "" + if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9203 "" + goto L17; +#line 9204 "" + } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { +#line 9205 "" + ++a1ll_2.iccount; +#line 9206 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9207 "" + --a1ll_2.iccount; +#line 9208 "" + goto L17; +#line 9209 "" + } else if (*(unsigned char *)charq == 'm') { + +/* Forced multiplicity, next char should be 1-4 */ + +#line 9213 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen) + 1); +#line 9214 "" + if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9215 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9215 "" + 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 9217 "" + stop1_(); +#line 9218 "" + } +#line 9219 "" + goto L17; +#line 9220 "" + } else if (*(unsigned char *)charq != ' ') { +#line 9221 "" + if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) { +#line 9222 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9222 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\ + "its must now be preceeded by \"+\" or \"-\"!", ( + ftnlen)128, (ftnlen)54); +#line 9224 "" + s_wsle(&io___624); +#line 9224 "" + do_lio(&c__9, &c__1, "You will have to edit older source"\ + "s to meet this rqmt,", (ftnlen)54); +#line 9224 "" + e_wsle(); +#line 9225 "" + s_wsle(&io___625); +#line 9225 "" + do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"\ + " height adjustments.", (ftnlen)54); +#line 9225 "" + e_wsle(); +#line 9226 "" + s_wsle(&io___626); +#line 9226 "" + do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"\ + "e Management", (ftnlen)46); +#line 9226 "" + e_wsle(); +#line 9227 "" + } else { +#line 9228 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9228 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after [!", (ftnlen)128, (ftnlen)26); +#line 9230 "" + } +#line 9231 "" + stop1_(); +#line 9232 "" + } +#line 9233 "" + } else if (*(unsigned char *)charq == ']') { +#line 9234 "" + if (! c1omget_1.fbon) { +#line 9235 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9235 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"\ + "h no corresponding start!", (ftnlen)128, (ftnlen)45); +#line 9237 "" + stop1_(); +#line 9238 "" + } +#line 9239 "" + g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 9240 "" + if (*(unsigned char *)charq == '-') { +#line 9241 "" + i__1 = a1ll_2.iccount; +#line 9241 "" + if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, ( + ftnlen)2) != 0) { +#line 9242 "" + i__1 = a1ll_2.iccount + 1; +#line 9242 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9242 "" + errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"\ + " is \"[ \"!", (ftnlen)128, (ftnlen)35); +#line 9244 "" + stop1_(); +#line 9245 "" + } else { +#line 9246 "" + a1ll_2.iccount += 2; +#line 9247 "" + } +#line 9248 "" + } else if (*(unsigned char *)charq == '[') { +#line 9249 "" + i__1 = a1ll_2.iccount; +#line 9249 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 9250 "" + i__1 = a1ll_2.iccount + 1; +#line 9250 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9250 "" + errmsg_(lineq, &i__1, &i__4, "This character must be a b"\ + "lank!", (ftnlen)128, (ftnlen)31); +#line 9252 "" + stop1_(); +#line 9253 "" + } +#line 9254 "" + } else { + +/* Forced beam is really ending */ + +#line 9258 "" + c1omget_1.fbon = FALSE_; +#line 9259 "" + if (*(unsigned char *)charq == 'j') { +#line 9260 "" + i__1 = a1ll_2.iccount; +#line 9260 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 9261 "" + i__1 = a1ll_2.iccount + 1; +#line 9261 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9261 "" + errmsg_(lineq, &i__1, &i__4, "This character must be"\ + " a blank!", (ftnlen)128, (ftnlen)31); +#line 9263 "" + stop1_(); +#line 9264 "" + } +#line 9265 "" + } else if (*(unsigned char *)charq != ' ') { +#line 9266 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9266 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"\ + "llowed by blank, \"j\", \"-\", or \"[\"!", ( + ftnlen)128, (ftnlen)48); +#line 9268 "" + stop1_(); +#line 9269 "" + } +#line 9270 "" + } +#line 9271 "" + } else if (*(unsigned char *)charq == 'D') { + +/* Dynamic mark */ + +#line 9275 "" + if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) { +#line 9276 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9276 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "\ + "before any notes have been entered!", (ftnlen)128, ( + ftnlen)53); +#line 9278 "" + stop1_(); +#line 9279 "" + } +#line 9280 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 9280 "" + checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128); +#line 9281 "" + } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Save position for later check */ + +#line 9285 "" + icclhw = a1ll_2.iccount; +#line 9286 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9287 "" + if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) { +#line 9288 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9288 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ + "ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41) + ; +#line 9290 "" + stop1_(); +#line 9291 "" + } +#line 9292 "" + c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq + == 'h'; +#line 9293 "" + if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* There is a header (or lower string?) */ + +#line 9297 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* User-defined vert offset (\internote). */ + +#line 9301 "" + if (*(unsigned char *)charq != 'h') { +#line 9302 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9302 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""\ + "-\" not permitted here!", (ftnlen)128, ( + ftnlen)30); +#line 9304 "" + stop1_(); +#line 9305 "" + } + +/* Have "h" followed by +/- . Check for digit. */ +/* Can blow durq since not using fnum for now, but... */ + +#line 9310 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 9311 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) + { +#line 9312 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9312 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"\ + "e a digit here!", (ftnlen)128, (ftnlen)27); +#line 9314 "" + stop1_(); +#line 9315 "" + } + +/* Have "h" followed by +/- followed by a digit. No need to get the number. */ + +/* call readnum(lineq,iccount,durq,fnum) */ +#line 9320 "" + } +#line 9321 "" + if (*(unsigned char *)charq != 'w') { + +/* Header or lower string. */ + +#line 9325 "" + if (icclhw != 1) { +#line 9326 "" + i__1 = a1ll_2.iccount - 1; +#line 9326 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9326 "" + errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"\ + " first character in line!", (ftnlen)128, ( + ftnlen)43); +#line 9328 "" + stop1_(); +#line 9329 "" + } + +/* Read past the next line, which has the string. */ + +#line 9333 "" + read10_(charq, &c1omget_1.lastchar, (ftnlen)1); +#line 9334 "" + ++c1omget_1.nline; +#line 9335 "" + a1ll_2.iccount = 128; +#line 9336 "" + } else { +#line 9337 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9337 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"\ + "dth) must be followed by a digit!", (ftnlen)128, ( + ftnlen)47); +#line 9339 "" + stop1_(); +#line 9340 "" + } +#line 9341 "" + } else { + +/* Height or width change spec. Check if at start of piece. */ + +#line 9345 "" + if (c1omnotes_1.ibarcnt > 0) { +#line 9346 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9346 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"\ + "t top of first input block!", (ftnlen)128, ( + ftnlen)43); +#line 9348 "" + stop1_(); +#line 9349 "" + } +#line 9350 "" + readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, ( + ftnlen)1); + +/* Check units. Convert to points */ + +#line 9354 "" + if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq == + 'p') { +#line 9355 "" + dimen += .5f; +#line 9356 "" + } else if (*(unsigned char *)durq == 'i') { +#line 9357 "" + dimen = dimen * 72 + .5f; +#line 9358 "" + } else if (*(unsigned char *)durq == 'm') { +#line 9359 "" + dimen = dimen / 25.4f * 72 + .5f; +#line 9360 "" + } else { +#line 9361 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9361 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"\ + "st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen) + 36); +#line 9363 "" + stop1_(); +#line 9364 "" + } + +/* 151211 fix. May have extra character. */ + +#line 9368 "" + if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Get another character, see if it's blank */ + +#line 9372 "" + i__1 = a1ll_2.iccount; +#line 9372 "" + if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, ( + ftnlen)1) != 0) { +#line 9373 "" + i__1 = a1ll_2.iccount + 1; +#line 9373 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9373 "" + errmsg_(lineq, &i__1, &i__4, "This character should "\ + "be a blank!", (ftnlen)128, (ftnlen)33); +#line 9375 "" + stop1_(); +#line 9376 "" + } +#line 9377 "" + } +#line 9378 "" + if (*(unsigned char *)charq == 'h') { +#line 9379 "" + compage_1.ptheight = (real) ((integer) dimen); +#line 9380 "" + } else { +#line 9381 "" + compage_1.widthpt = (real) ((integer) dimen); +#line 9382 "" + } +#line 9383 "" + } +#line 9384 "" + } else if (*(unsigned char *)charq == 'm') { + +/* Time signature change. Only allow at beginning of block. */ +/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */ +/* mtrnuml=0 initially. (In common) */ + +/* Check whether at beginning of a block */ + +#line 9392 "" + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 9393 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9393 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\ + " in voice 1, at start of block!", (ftnlen)128, ( + ftnlen)51); +#line 9395 "" + s_wsle(&io___629); +#line 9395 "" + do_lio(&c__9, &c__1, "voice number is", (ftnlen)15); +#line 9395 "" + do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof( + integer)); +#line 9395 "" + e_wsle(); +#line 9396 "" + stop1_(); +#line 9397 "" + } +#line 9398 "" + a1ll_2.newmeter = TRUE_; +#line 9399 "" + readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, ( + ftnlen)128); +#line 9400 "" + if (a1ll_2.mtrnuml == 0) { +#line 9401 "" + i__1 = a1ll_2.iccount - 1; +#line 9401 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9401 "" + errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", ( + ftnlen)128, (ftnlen)25); +#line 9403 "" + stop1_(); +/* else if (mtrdenl .eq. 1) then */ +/* c */ +/* c Kluge!!! */ +/* c */ +/* mtrdenl = 2 */ +/* mtrnuml = 2*mtrnuml */ +#line 9410 "" + } +#line 9411 "" + readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128); + +/* Read past printed time signature; not used in pmxa. */ + +#line 9415 "" + lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); +#line 9416 "" + lenmult = 1; +#line 9417 "" + if (mtrdenl == 2) { +#line 9418 "" + lenbeat = 16; +#line 9419 "" + lenmult = 2; +#line 9420 "" + } +#line 9421 "" + a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat; +#line 9422 "" + a1ll_2.mtrnuml = 0; +#line 9423 "" + } else if (*(unsigned char *)charq == 'C') { +#line 9424 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9425 "" + 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 9429 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9429 "" + 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 9432 "" + stop1_(); +#line 9433 "" + } +/* gotclef = .true. */ +#line 9435 "" + } else if (*(unsigned char *)charq == 'R') { +#line 9436 "" + if (c1ommvl_1.ivx != 1) { +#line 9437 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9437 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "\ + "in voice 1!", (ftnlen)128, (ftnlen)31); +#line 9439 "" + stop1_(); +#line 9440 "" + } +#line 9441 "" +L10: +#line 9441 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9442 "" + if (i_indx("lrdDbz", durq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9442 "" + goto L10; +#line 9442 "" + } +#line 9443 "" + if (*(unsigned char *)durq != ' ') { +#line 9444 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9444 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\ + "ter \"R\" (repeat/double bar)!", (ftnlen)128, (ftnlen) + 48); +#line 9446 "" + stop1_(); +#line 9447 "" + } +#line 9448 "" + } else if (*(unsigned char *)charq == 'V') { + +/* Ending */ + +#line 9452 "" + if (a1ll_2.iv != 1) { +#line 9453 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9453 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"\ + "wed in voice #1!", (ftnlen)128, (ftnlen)36); +#line 9455 "" + stop1_(); +#line 9456 "" + } else if (c1omget_1.isvolt) { +#line 9457 "" + s_wsle(&io___635); +#line 9457 "" + e_wsle(); +#line 9458 "" + s_wsle(&io___636); +#line 9458 "" + do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22); +#line 9458 "" + e_wsle(); +#line 9459 "" + s_wsfe(&io___637); +#line 9459 "" + do_fio(&c__1, "*******WARNING********", (ftnlen)22); +#line 9459 "" + e_wsfe(); +#line 9460 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9460 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\ + "ne volta in this input block.!", (ftnlen)128, (ftnlen) + 50); +#line 9462 "" + s_wsle(&io___638); +#line 9462 "" + do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"\ + " work in parts.", (ftnlen)53); +#line 9462 "" + e_wsle(); +#line 9463 "" + s_wsle(&io___639); +#line 9463 "" + do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"\ + " at the start of the block", (ftnlen)64); +#line 9463 "" + e_wsle(); +#line 9465 "" + s_wsfe(&io___640); +#line 9465 "" + do_fio(&c__1, "This may work in a score, but WILL NOT work i"\ + "n parts.", (ftnlen)53); +#line 9465 "" + e_wsfe(); +#line 9467 "" + s_wsfe(&io___641); +#line 9467 "" + do_fio(&c__1, "Safest to have only 1 volta per block, at the"\ + " start of the block", (ftnlen)64); +#line 9467 "" + e_wsfe(); +#line 9469 "" + } +#line 9470 "" + c1omget_1.isvolt = TRUE_; +#line 9471 "" + lvoltxt = 0; +#line 9472 "" +L11: +#line 9472 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9473 "" + if (*(unsigned char *)durq != ' ') { +#line 9474 "" + goto L11; +#line 9475 "" + } +#line 9476 "" + } else if (*(unsigned char *)charq == 'B') { +#line 9478 "" + } else if (*(unsigned char *)charq == 'P') { +#line 9479 "" + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 9480 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9480 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"\ + "nning of block!", (ftnlen)128, (ftnlen)35); +#line 9482 "" + stop1_(); +#line 9483 "" + } +#line 9484 "" +L16: +#line 9484 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9485 "" + if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq == + 'r' || *(unsigned char *)durq >= 48 && *(unsigned char *) + durq <= 57) { +#line 9485 "" + goto L16; +#line 9485 "" + } +#line 9487 "" + if (*(unsigned char *)durq == 'c') { + +/* Expect a centered name, and it has to be last option */ + +#line 9491 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9492 "" + if (*(unsigned char *)durq == '"') { + +/* Quoted name, go to next quote mark */ + +#line 9496 "" + for (++a1ll_2.iccount; a1ll_2.iccount <= 127; + ++a1ll_2.iccount) { +#line 9497 "" + if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == + '"') { +#line 9497 "" + goto L36; +#line 9497 "" + } +#line 9498 "" +/* L35: */ +#line 9498 "" + } +#line 9499 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9499 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"\ + "ote after page number command (P)!", (ftnlen)128, + (ftnlen)50); +#line 9501 "" + stop1_(); +#line 9502 "" +L36: +#line 9503 "" + ; +#line 9503 "" + } else if (*(unsigned char *)durq != ' ') { + +/* Space-delimited name, look for next blank */ + +#line 9507 "" + for (++a1ll_2.iccount; a1ll_2.iccount <= 127; + ++a1ll_2.iccount) { +#line 9508 "" + if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] == + ' ') { +#line 9508 "" + goto L38; +#line 9508 "" + } +#line 9509 "" +/* L37: */ +#line 9509 "" + } +#line 9510 "" +L38: +#line 9511 "" + ; +#line 9511 "" + } +#line 9512 "" + } else if (*(unsigned char *)durq != ' ') { +#line 9513 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9513 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""\ + "c\" or digit allowed after \"P\"!", (ftnlen)128, ( + ftnlen)44); +#line 9515 "" + stop1_(); +#line 9516 "" + } +#line 9517 "" + } else if (*(unsigned char *)charq == 'W') { +#line 9518 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9519 "" + if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9520 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9520 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"\ + " start here!", (ftnlen)128, (ftnlen)32); +#line 9522 "" + stop1_(); +#line 9523 "" + } +#line 9524 "" + readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[ + c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen) + 1); +#line 9525 "" + } else if (*(unsigned char *)charq == 'T') { + +/* Titles */ + +#line 9529 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9530 "" + if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) { +#line 9531 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9531 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""\ + "t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36); +#line 9533 "" + stop1_(); +#line 9534 "" + } +#line 9535 "" + i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1; +#line 9535 "" + c1omget_1.ihead += pow_ii(&c__2, &i__1); + +/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */ + +#line 9539 "" + read10_(charq, &c1omget_1.lastchar, (ftnlen)1); +#line 9540 "" + ++c1omget_1.nline; +#line 9541 "" + a1ll_2.iccount = 128; +#line 9542 "" + } else if (*(unsigned char *)charq == 'A') { +#line 9543 "" +L27: +#line 9543 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9544 "" + if (i_indx("rbsdeK", durq, (ftnlen)6, (ftnlen)1) > 0) { +#line 9545 "" + goto L27; +#line 9546 "" + } else if (*(unsigned char *)durq == 'v') { +#line 9547 "" + if (c1omnotes_1.ibarcnt == 0) { +#line 9547 "" + comnvst_1.novshrinktop = TRUE_; +#line 9547 "" + } +#line 9548 "" + goto L27; +#line 9549 "" + } else if (*(unsigned char *)durq == 'a') { +#line 9550 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9551 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 9552 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9552 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"\ + "ed decimal number!", (ftnlen)128, (ftnlen)32); +#line 9554 "" + stop1_(); +#line 9555 "" + } +#line 9556 "" + readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, ( + ftnlen)128, (ftnlen)1); +#line 9557 "" + --a1ll_2.iccount; +#line 9558 "" + goto L27; +#line 9559 "" + } else if (*(unsigned char *)durq == 'i') { +#line 9560 "" + 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 9565 "" + readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128, + (ftnlen)1); +#line 9566 "" + if (c1omnotes_1.ibarcnt == 0) { +#line 9566 "" + compage_1.fintstf = tintstf; +#line 9566 "" + } +#line 9567 "" + --a1ll_2.iccount; +#line 9568 "" + goto L27; +#line 9569 "" + } else if (*(unsigned char *)durq == 'I') { + +/* Global interstaff correction. Use in place of fintstf if fintstf<0 */ + +#line 9573 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9574 "" + readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, ( + ftnlen)128, (ftnlen)1); +#line 9575 "" + --a1ll_2.iccount; +#line 9576 "" + goto L27; +#line 9577 "" + } else if (*(unsigned char *)durq == 'o') { +#line 9578 "" + *optimize = TRUE_; +#line 9579 "" + goto L27; +#line 9580 "" + } else if (*(unsigned char *)durq == 'S') { +/* 130324 */ +/* do 50 iiv = 1 , nv */ +#line 9583 "" + i__1 = comkeys_1.noinst; +#line 9583 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 9584 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 9585 "" + if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9586 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9586 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""\ + ", need nv instances of \"s,t,-,0\"!", (ftnlen) + 128, (ftnlen)43); +#line 9588 "" + stop1_(); +#line 9589 "" + } +#line 9590 "" + if (*(unsigned char *)durq == '-' || *(unsigned char *) + durq == 's') { +#line 9591 "" + comsize_1.isize[iiv - 1] = 1; +#line 9592 "" + } else if (*(unsigned char *)durq == 't') { +#line 9593 "" + comsize_1.isize[iiv - 1] = 2; +#line 9594 "" + } +#line 9595 "" +/* L50: */ +#line 9595 "" + } +#line 9596 "" + goto L27; +#line 9597 "" + } else if (*(unsigned char *)durq == 'p') { +#line 9598 "" + comslur_1.fontslur = FALSE_; +#line 9599 "" +L42: +#line 9600 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9601 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Characters to change defaults for ps slurs */ + +#line 9605 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 9606 "" + if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9607 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9607 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"\ + " allowed here are \"s\",\"h\",\"t\",\"c\"!", ( + ftnlen)128, (ftnlen)46); +#line 9609 "" + stop1_(); +#line 9610 "" + } + +/* Now check for another default modifier */ + +#line 9614 "" + goto L42; +#line 9615 "" + } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Flags for optional linebreak ties or header specials */ + +#line 9619 "" + goto L42; +#line 9620 "" + } else { +#line 9621 "" + --a1ll_2.iccount; +#line 9622 "" + } +#line 9623 "" + goto L27; +#line 9624 "" + } 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 9630 "" + if (a1ll_2.iccount != 2) { +#line 9631 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9631 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"\ + "t in column 1!", (ftnlen)128, (ftnlen)28); +#line 9633 "" + stop1_(); +#line 9634 "" + } +#line 9635 "" + ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1); +#line 9636 "" + 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 9639 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9639 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"\ + "ollowed by inst. #, then quote!", (ftnlen)128, ( + ftnlen)45); +#line 9641 "" + stop1_(); +#line 9642 "" + } +#line 9643 "" + i__1 = ndxquote; +#line 9643 "" + ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 9644 "" + if (ndxquote == 0) { +#line 9645 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9645 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "\ + "name must be in quotes!", (ftnlen)128, (ftnlen)37) + ; +#line 9647 "" + stop1_(); +#line 9648 "" + } +#line 9649 "" + a1ll_2.iccount = 128; +#line 9650 "" + } else if (*(unsigned char *)durq == 'T') { +#line 9651 "" + comnvst_1.cstuplet = TRUE_; +#line 9652 "" + } else if (*(unsigned char *)durq == 'R') { + +/* Get full name of normal include file; must occupy remainder of line */ + +#line 9656 "" + i__1 = a1ll_2.iccount; +#line 9656 "" + getpmxmod_(&c_false, lineq + i__1, 128 - i__1); +#line 9657 "" + a1ll_2.iccount = 128; +#line 9658 "" + } else if (*(unsigned char *)durq == 'c') { +#line 9659 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9660 "" + if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9661 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9661 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"\ + " \"4\" is allowed here!", (ftnlen)128, (ftnlen)32) + ; +#line 9663 "" + stop1_(); +#line 9664 "" + } +#line 9665 "" + if (*(unsigned char *)durq == 'l') { +#line 9666 "" + compage_1.hoffpt = -25.f; +#line 9667 "" + compage_1.voffpt = -45.f; +#line 9668 "" + } else if (*(unsigned char *)durq == '4') { +#line 9669 "" + compage_1.ptheight = 745.f; +#line 9670 "" + compage_1.widthpt = 499.f; +#line 9671 "" + compage_1.hoffpt = -24.f; +#line 9672 "" + compage_1.voffpt = -24.f; +#line 9673 "" + } +#line 9674 "" + goto L27; +#line 9675 "" + } else if (*(unsigned char *)durq != ' ') { +#line 9676 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9676 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"\ + "low one of the letters abcdeiILNprRsST!", (ftnlen)128, + (ftnlen)57); +/* * 'After "A" must follow one of the letters abcdeiINprRsST!') */ +#line 9679 "" + s_wsle(&io___646); +#line 9679 "" + do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"\ + " noinst args.", (ftnlen)51); +#line 9679 "" + e_wsle(); +#line 9680 "" + s_wsfe(&io___647); +#line 9680 "" + do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"\ + " args.", (ftnlen)51); +#line 9680 "" + e_wsfe(); +#line 9682 "" + stop1_(); +#line 9683 "" + } +#line 9684 "" + } else if (*(unsigned char *)charq == 'K') { + +/* Rules and function of K command */ + +/* Only 1 K +/-n +/-m allowed per block if n.ne.0 (transposition). isig1 is */ +/* initial sig, and must be passed to pmxb because it is needed when topfile */ +/* is called, which is before the K+n+m command is read in pmxb. Also, we */ +/* compute and save ibrkch and newkey for each syst, accounting for key changes, */ +/* 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 9695 "" +L77: +#line 9696 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +/* if (index('+-i',durq) .eq. 0) then */ +#line 9698 "" + if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 9699 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9699 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "\ + "key change) must be followed by \"+,-,i,n\"!", ( + ftnlen)128, (ftnlen)60); +#line 9701 "" + stop1_(); +#line 9702 "" + } +#line 9703 "" + if (*(unsigned char *)durq == 'n') { +#line 9703 "" + goto L77; +#line 9703 "" + } +#line 9704 "" + if (*(unsigned char *)durq != 'i') { + +/* Normal key change and/or transposition) */ + +/* iccount = iccount+1 */ +#line 9709 "" + num1 = 44 - *(unsigned char *)durq; + +/* num1= +1 or -1 */ + +#line 9713 "" + ztrans = num1 == -1; +#line 9714 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9715 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 9716 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9716 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "\ + "followed by a number!", (ftnlen)128, (ftnlen)37); +#line 9718 "" + stop1_(); +#line 9719 "" + } +/* iccount = iccount+1 */ +#line 9721 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9722 "" + num1 = i_nint(&fnum) * num1; +#line 9723 "" + ztrans = ztrans && num1 == 0; +#line 9724 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9725 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9725 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"\ + "er \"K\" must be followed by \"+,-\"!", (ftnlen) + 128, (ftnlen)47); +#line 9727 "" + stop1_(); +#line 9728 "" + } +#line 9729 "" + ++a1ll_2.iccount; +#line 9730 "" + num2 = 44 - *(unsigned char *)durq; +#line 9731 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9732 "" + num2 *= (integer) (fnum + .1f); +#line 9733 "" + if (num1 == 0 && ! ztrans) { + +/* Key change, only one per block allowed */ + +#line 9737 "" + if (comkeys_1.iskchb) { +#line 9738 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9738 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"\ + " change allowed per input block!", (ftnlen) + 128, (ftnlen)44); +#line 9740 "" + stop1_(); +#line 9741 "" + } +#line 9742 "" + comkeys_1.iskchb = TRUE_; +#line 9743 "" + ++comkeys_1.nkeys; +#line 9744 "" + 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 9748 "" + comkeys_1.ibrkch[comkeys_1.nkeys - 1] = + c1omnotes_1.ibarcnt + a1ll_2.nbars; +#line 9749 "" + if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) { +#line 9749 "" + ++comkeys_1.ibrkch[comkeys_1.nkeys - 1]; +#line 9749 "" + } +#line 9750 "" + comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 + + comkeys_1.idsig; +/* 130316 */ +/* do 43 iinst = 1 , noinst */ +#line 9753 "" + commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys - + 1]; +/* 43 continue */ +#line 9755 "" + } else { + +/* Transposition */ + +#line 9759 "" + *fulltrans = TRUE_; +#line 9760 "" + if (c1omnotes_1.ibarcnt > 0) { +#line 9761 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9761 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"\ + "n must be at top of first input block!", ( + ftnlen)128, (ftnlen)50); +#line 9763 "" + stop1_(); +#line 9764 "" + } +#line 9765 "" + comkeys_1.isig1 = num2; +#line 9766 "" + 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 9771 "" + } +#line 9772 "" + } else { + +/* 110522/110529 */ +/* Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */ +/* and repeat i[...] for multiple instruments. Store info here if ibarcnt=0 */ +/* so can pass to topfile (via comInstTrans), which is called before getnote. */ +/* Otherwise, will store info from getnote. Initialize EarlyTransOn and */ +/* LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here; */ +/* LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really */ +/* only needed for instrument-signatures, not transpositions. iTransAmt is */ +/* ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for */ +/* each staff. */ + +/* if (fulltrans) then */ +/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ +/* * 'Cannot yet combine full and instrument transposition!') */ +/* call stop1() */ +/* end if */ +/* durq='i' */ +#line 9790 "" + getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, & + a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, & + comkeys_1.noinst, (ftnlen)128); +#line 9792 "" + } +#line 9793 "" + } else if (*(unsigned char *)charq == '|') { + +/* Optional bar symbol */ + +#line 9797 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { +#line 9798 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9798 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "\ + "of place!", (ftnlen)128, (ftnlen)29); +#line 9800 "" + stop1_(); +#line 9801 "" + } else if (comkeys_1.shifton) { +#line 9802 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9802 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ + "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 9804 "" + stop1_(); +#line 9805 "" + } +#line 9806 "" + } else if (*(unsigned char *)charq == '/') { +#line 9807 "" + if (comkeys_1.ornrpt) { +#line 9808 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9808 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ + " with repeated ornament still on!", (ftnlen)128, ( + ftnlen)53); +#line 9810 "" + comkeys_1.ornrpt = FALSE_; +#line 9811 "" + } +#line 9812 "" + if (comkeys_1.stickys) { +#line 9813 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9813 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\ + " with sticky stemshrink still on!", (ftnlen)128, ( + ftnlen)53); +#line 9815 "" + comkeys_1.stickys = FALSE_; +#line 9816 "" + } +#line 9817 "" + if (c1omget_1.fbon) { +#line 9818 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9818 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"\ + "ced beam open!", (ftnlen)128, (ftnlen)34); +#line 9820 "" + stop1_(); +#line 9821 "" + } else if (comkeys_1.shifton) { +#line 9822 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9822 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ + "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 9824 "" + stop1_(); + +/* 140215 Temporary to allow clef change in stup */ + +/* else if (gotclef) then */ +/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ +/* * 'May not enter clef at end of input block!') */ +/* call stop1() */ +#line 9832 "" + } +#line 9833 "" + comkeys_1.barend = FALSE_; + +/* Perform time checks */ + +#line 9837 "" + if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) { +#line 9838 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9838 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\ + "ivisible by lenbar!", (ftnlen)128, (ftnlen)39); +#line 9840 "" + s_wsle(&io___651); +#line 9840 "" + do_lio(&c__9, &c__1, "lenbar is ", (ftnlen)10); +#line 9840 "" + do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof( + integer)); +#line 9840 "" + e_wsle(); +#line 9841 "" + stop1_(); +#line 9842 "" + } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1] + != a1ll_2.itsofar[0]) { +#line 9843 "" + s_wsle(&io___652); +#line 9843 "" + e_wsle(); +#line 9844 "" + s_wsle(&io___653); +#line 9844 "" + do_lio(&c__9, &c__1, "# of bars in voice 1, current voice:", ( + ftnlen)36); +#line 9844 "" + i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar; +#line 9844 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 9844 "" + i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar; +#line 9844 "" + do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer)); +#line 9844 "" + e_wsle(); +#line 9846 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9846 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"\ + "qual to voice 1!", (ftnlen)128, (ftnlen)36); +#line 9848 "" + stop1_(); +#line 9849 "" + } +#line 9850 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9851 "" + if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) { + +/* End of input block */ + +#line 9855 "" + *loop = FALSE_; +#line 9856 "" + } else { + +/* Start a new voice */ + +#line 9860 "" + if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) { +#line 9860 "" + a1ll_2.lenbar = a1ll_2.lenbr0; +#line 9860 "" + } +#line 9861 "" + a1ll_2.nbars = 0; +#line 9862 "" + if (*(unsigned char *)durq == ' ') { + +/* New voice is on next staff */ + +#line 9866 "" + ++a1ll_2.iv; +#line 9867 "" + c1ommvl_1.ivx = a1ll_2.iv; +#line 9868 "" + } else { + +/* New voice is on same staff. Set up for it */ + +#line 9872 "" + c1ommvl_1.ivx = a1ll_2.nv + 1; +#line 9873 "" + i__1 = a1ll_2.nv; +#line 9873 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 9874 "" + if (c1ommvl_1.nvmx[iiv - 1] == 2) { +#line 9874 "" + ++c1ommvl_1.ivx; +#line 9874 "" + } +#line 9875 "" +/* L23: */ +#line 9875 "" + } +#line 9876 "" + if (c1ommvl_1.ivx > 24) { +#line 9877 "" + s_wsfe(&io___654); +#line 9877 "" + do_fio(&c__1, "Cannot have more than", (ftnlen)21); +#line 9877 "" + do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)) + ; +#line 9877 "" + do_fio(&c__1, " lines of music at once", (ftnlen)23); +#line 9877 "" + e_wsfe(); +#line 9879 "" + stop1_(); +#line 9880 "" + } +#line 9881 "" + c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2; +#line 9882 "" + c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx; +#line 9883 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0; +#line 9884 "" + a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0; +#line 9885 "" + for (j = 1; j <= 200; ++j) { +#line 9886 "" + a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_; +#line 9887 "" + c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0; +#line 9888 "" +/* L24: */ +#line 9888 "" + } + +/* For midi stuff, record that there is a 2nd line of music in this voice */ + +#line 9892 "" + if (commidi_1.ismidi) { +#line 9892 "" + commidi_1.twoline[a1ll_2.iv - 1] = TRUE_; +#line 9892 "" + } +#line 9893 "" + } +#line 9894 "" + } +#line 9895 "" + a1ll_2.iccount = 128; +#line 9896 "" + } else if (*(unsigned char *)charq == 'S') { + +/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */ + +#line 9900 "" + if (c1omnotes_1.ibarcnt > 0) { +#line 9901 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9901 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"\ + " first input block!", (ftnlen)128, (ftnlen)37); +#line 9903 "" + stop1_(); +#line 9904 "" + } +#line 9905 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9906 "" + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 9907 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9907 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"\ + " \"S\"!", (ftnlen)128, (ftnlen)24); +#line 9909 "" + stop1_(); +#line 9910 "" + } +#line 9911 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( + ftnlen)1); +#line 9912 "" + compage_1.nsyst = i_nint(&fnsyst); +#line 9913 "" +L14: +#line 9914 "" + if (*(unsigned char *)durq == 'P') { + +/* New npages for parts. */ + +#line 9918 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9919 "" + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 9920 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9920 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ + "er here!", (ftnlen)128, (ftnlen)24); +#line 9922 "" + stop1_(); +#line 9923 "" + } +#line 9924 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( + ftnlen)1); +#line 9925 "" + compage_1.npages = i_nint(&fnsyst); +#line 9926 "" + goto L14; +#line 9927 "" + } else if (*(unsigned char *)durq == 'm') { + +/* Reset musize (musicsize). */ + +#line 9931 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9932 "" + if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 9933 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9933 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\ + "er here!", (ftnlen)128, (ftnlen)24); +#line 9935 "" + stop1_(); +#line 9936 "" + } +#line 9937 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, ( + ftnlen)1); +#line 9938 "" + commus_1.musize = i_nint(&fnsyst); +#line 9939 "" + c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; +#line 9940 "" + goto L14; +#line 9941 "" + } else if (*(unsigned char *)durq != ' ') { +#line 9942 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9942 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "\ + "in \"S\" symbol!", (ftnlen)128, (ftnlen)32); +#line 9944 "" + stop1_(); +#line 9945 "" + } +#line 9946 "" + } else if (*(unsigned char *)charq == 'L') { +#line 9947 "" + ++compage_1.nflb; +#line 9948 "" + compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + + a1ll_2.nbars + 1; +#line 9949 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 9950 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 9951 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9951 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"\ + "ne forced line break!", (ftnlen)128, (ftnlen)41); +#line 9953 "" + stop1_(); +#line 9954 "" + } +#line 9955 "" + readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, ( + ftnlen)1); +#line 9956 "" + compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb); +#line 9957 "" + if (compage_1.nflb > 1) { + +/* Check if new number is > prior one */ + +#line 9961 "" + if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[ + compage_1.nflb - 1]) { +#line 9962 "" + i__1 = a1ll_2.iccount - 1; +#line 9962 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9962 "" + errmsg_(lineq, &i__1, &i__4, "You already forced a line "\ + "break at a later line!", (ftnlen)128, (ftnlen)48); +#line 9964 "" + stop1_(); +#line 9965 "" + } +#line 9966 "" + } +#line 9967 "" + if (compage_1.npages == 0) { +#line 9968 "" + s_wsle(&io___658); +#line 9968 "" + e_wsle(); +#line 9969 "" + s_wsle(&io___659); +#line 9969 "" + do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"\ + "ne ", (ftnlen)41); +#line 9969 "" + do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[ + compage_1.nflb], (ftnlen)sizeof(integer)); +#line 9969 "" + do_lio(&c__9, &c__1, " but npage = 0. Continue?", (ftnlen)26) + ; +#line 9969 "" + e_wsle(); +#line 9971 "" + s_rsfe(&io___660); +#line 9971 "" + do_fio(&c__1, charq, (ftnlen)1); +#line 9971 "" + e_rsfe(); +#line 9972 "" + if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 9972 "" + stop1_(); +#line 9972 "" + } +#line 9973 "" + } else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) { +#line 9974 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9974 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"\ + " line num > nsyst!", (ftnlen)128, (ftnlen)38); +#line 9976 "" + stop1_(); +#line 9977 "" + } else if (i_indx(" PM", durq, (ftnlen)3, (ftnlen)1) == 0) { +#line 9978 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9978 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""\ + "P\", or \"M\" here!", (ftnlen)128, (ftnlen)32); +#line 9980 "" + stop1_(); +#line 9981 "" + } +#line 9982 "" + if (*(unsigned char *)durq == 'P') { + +/* Forced page break here, get page number. */ + +#line 9986 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 9987 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 9988 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9988 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "\ + "define forced page break!", (ftnlen)128, (ftnlen) + 41); +#line 9990 "" + stop1_(); +#line 9991 "" + } +#line 9992 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 9993 "" + ++compage_1.nfpb; +#line 9994 "" + compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum); +#line 9995 "" + compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[ + compage_1.nflb]; +#line 9996 "" + if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) { +#line 9997 "" + i__1 = a1ll_2.iccount - 1; +#line 9997 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 9997 "" + errmsg_(lineq, &i__1, &i__4, "Forced page break at page "\ + "num > npages!", (ftnlen)128, (ftnlen)39); +#line 9999 "" + stop1_(); +#line 10000 "" + } else if (compage_1.nfpb > 1) { +#line 10001 "" + if (compage_1.ipagfpb[compage_1.nfpb] <= + compage_1.ipagfpb[compage_1.nfpb - 1]) { +#line 10002 "" + i__1 = a1ll_2.iccount - 1; +#line 10002 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10002 "" + errmsg_(lineq, &i__1, &i__4, "Forced page break numb"\ + "ers must increase!", (ftnlen)128, (ftnlen)40); +#line 10004 "" + stop1_(); +#line 10005 "" + } +#line 10006 "" + } +#line 10007 "" + } +#line 10008 "" + if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10009 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10009 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\ + " linebreak symbol!", (ftnlen)128, (ftnlen)38); +#line 10011 "" + stop1_(); +#line 10012 "" + } else if (*(unsigned char *)durq == 'M') { +#line 10013 "" + ++compage_1.nmovbrk; +#line 10014 "" + compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[ + compage_1.nflb]; +#line 10015 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen) + 1); +#line 10016 "" +L31: +#line 10016 "" + if (*(unsigned char *)durq == '+') { + +/* Vertical spacing, read past number. */ + +#line 10020 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10021 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) + { +#line 10022 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10022 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"\ + "ired here!", (ftnlen)128, (ftnlen)22); +#line 10024 "" + stop1_(); +#line 10025 "" + } +#line 10026 "" + readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 10027 "" + goto L31; +#line 10028 "" + } else if (*(unsigned char *)durq == 'i') { + +/* Change indentation, */ + +#line 10032 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10033 "" + if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) == + 0) { +#line 10034 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10034 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"\ + "er required here!", (ftnlen)128, (ftnlen)29); +#line 10036 "" + stop1_(); +#line 10037 "" + } + +/* fracsys was initialized in block data to all 0.'s */ + +#line 10041 "" + readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[ + compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1); +#line 10042 "" + goto L31; +#line 10043 "" + } else if (*(unsigned char *)durq == 'c') { +#line 10044 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10045 "" + goto L31; +#line 10046 "" + } else if (*(unsigned char *)durq == 'r') { +#line 10047 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10048 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10049 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10049 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\ + " \"+\" or \"-\" after \"r\" as movement brea"\ + "k option!", (ftnlen)128, (ftnlen)56); +#line 10051 "" + stop1_(); +#line 10052 "" + } +#line 10053 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10054 "" + goto L31; +#line 10055 "" + } 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 10060 "" + a1ll_2.nv = 0; +#line 10061 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10062 "" + if (*(unsigned char *)durq == ':') { + +/* Signals a 2-digit number, get next two characters */ + +#line 10066 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10067 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, ( + ftnlen)1); +#line 10068 "" + if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 || + i_indx("0123456789", dumq, (ftnlen)10, ( + ftnlen)1) == 0) { +#line 10070 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +/* Writing concatenation */ +#line 10070 "" + i__8[0] = 34, a__3[0] = "Illegal new number of i"\ + "nstruments "; +#line 10070 "" + i__8[1] = 1, a__3[1] = durq; +#line 10070 "" + i__8[2] = 1, a__3[2] = dumq; +#line 10070 "" + i__8[3] = 19, a__3[3] = " at movement break!"; +#line 10070 "" + s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55); +#line 10070 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__3, ( + ftnlen)128, (ftnlen)55); +#line 10073 "" + stop1_(); +#line 10074 "" + } +#line 10075 "" + i__1 = a1ll_2.iccount - 2; +#line 10075 "" + ici__1.icierr = 0; +#line 10075 "" + ici__1.iciend = 0; +#line 10075 "" + ici__1.icirnum = 1; +#line 10075 "" + ici__1.icirlen = a1ll_2.iccount - i__1; +#line 10075 "" + ici__1.iciunit = lineq + i__1; +#line 10075 "" + ici__1.icifmt = "(i2)"; +#line 10075 "" + s_rsfi(&ici__1); +#line 10075 "" + do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer)) + ; +#line 10075 "" + e_rsfi(); +#line 10076 "" + } else { + +/* durq is a single digit number for noinow */ + +#line 10080 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == + 0) { +#line 10081 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +/* Writing concatenation */ +#line 10081 "" + i__2[0] = 34, a__1[0] = "Illegal new number of i"\ + "nstruments "; +#line 10081 "" + i__2[1] = 1, a__1[1] = durq; +#line 10081 "" + i__2[2] = 19, a__1[2] = " at movement break!"; +#line 10081 "" + s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)54); +#line 10081 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, ( + ftnlen)128, (ftnlen)54); +#line 10084 "" + stop1_(); +#line 10085 "" + } +#line 10086 "" + ninow = *(unsigned char *)durq - 48; +#line 10087 "" + } +#line 10088 "" + if (ninow > comkeys_1.noinst) { +#line 10089 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10089 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"\ + "f instruments must be <= original!", (ftnlen) + 128, (ftnlen)46); +#line 10091 "" + stop1_(); +#line 10092 "" + } +#line 10093 "" + i__1 = ninow; +#line 10093 "" + for (iinow = 1; iinow <= i__1; ++iinow) { +#line 10094 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10095 "" + if (*(unsigned char *)durq == ':') { + +/* Signals a 2-digit number */ + +#line 10099 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen) + 128, (ftnlen)1); +#line 10100 "" + g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen) + 128, (ftnlen)1); +#line 10101 "" + if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 + || i_indx("0123456789", dumq, (ftnlen)10, + (ftnlen)1) == 0) { +#line 10103 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +/* Writing concatenation */ +#line 10103 "" + i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"\ + "trument number "; +#line 10103 "" + i__8[1] = 1, a__3[1] = durq; +#line 10103 "" + i__8[2] = 1, a__3[2] = dumq; +#line 10103 "" + i__8[3] = 19, a__3[3] = " at movement break!"; +#line 10103 "" + s_cat(ch__3, a__3, i__8, &c__4, (ftnlen)55); +#line 10103 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__3, + (ftnlen)128, (ftnlen)55); +#line 10106 "" + stop1_(); +#line 10107 "" + } +#line 10108 "" + i__4 = a1ll_2.iccount - 2; +#line 10108 "" + ici__1.icierr = 0; +#line 10108 "" + ici__1.iciend = 0; +#line 10108 "" + ici__1.icirnum = 1; +#line 10108 "" + ici__1.icirlen = a1ll_2.iccount - i__4; +#line 10108 "" + ici__1.iciunit = lineq + i__4; +#line 10108 "" + ici__1.icifmt = "(i2)"; +#line 10108 "" + s_rsfi(&ici__1); +#line 10108 "" + do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof( + integer)); +#line 10108 "" + e_rsfi(); +#line 10109 "" + } else { + +/* durq is a single digit number for iorig */ + +#line 10113 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen) + 1) == 0) { +#line 10114 "" + i__4 = c1omnotes_1.ibarcnt - + c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +/* Writing concatenation */ +#line 10114 "" + i__2[0] = 26, a__1[0] = "Illegal instrument "\ + "number "; +#line 10114 "" + i__2[1] = 1, a__1[1] = durq; +#line 10114 "" + i__2[2] = 19, a__1[2] = " at movement break!"; +#line 10114 "" + s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)46); +#line 10114 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__5, + (ftnlen)128, (ftnlen)46); +#line 10117 "" + stop1_(); +#line 10118 "" + } +#line 10119 "" + iorig = *(unsigned char *)durq - 48; +#line 10120 "" + } +#line 10121 "" + if (iorig > comkeys_1.noinst) { +#line 10122 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10122 "" + errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"\ + "rument number must be <= original noinst!" + , (ftnlen)128, (ftnlen)49); +#line 10124 "" + stop1_(); +#line 10125 "" + } +#line 10126 "" + a1ll_2.nv += c1omget_1.nsperi[iorig - 1]; +#line 10127 "" +/* L63: */ +#line 10127 "" + } +#line 10128 "" + i__1 = a1ll_2.nv; +#line 10128 "" + for (iiv = 1; iiv <= i__1; ++iiv) { + +/* Get clef names */ + +#line 10132 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10133 "" + if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) + > 0 || *(unsigned char *)durq >= 48 && *( + unsigned char *)durq <= 55)) { +#line 10135 "" + i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10135 "" + 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 10137 "" + stop1_(); +#line 10138 "" + } + +/* Initialize new voices */ + +#line 10142 "" + c1ommvl_1.nvmx[iiv - 1] = 1; +#line 10143 "" + c1ommvl_1.ivmx[iiv - 1] = iiv; +#line 10144 "" + a1ll_2.itsofar[iiv - 1] = 0; +#line 10145 "" + a1ll_2.nnl[iiv - 1] = 0; +#line 10146 "" + for (j = 1; j <= 200; ++j) { +#line 10147 "" + a1ll_2.rest[iiv + j * 24 - 25] = FALSE_; +#line 10148 "" +/* L62: */ +#line 10148 "" + } +#line 10149 "" +/* L61: */ +#line 10149 "" + } + +/* Loop back up, this might not be last option in M */ + +#line 10153 "" + g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 10154 "" + goto L31; +#line 10155 "" + } else if (*(unsigned char *)durq != ' ') { +#line 10156 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10156 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\ + "r after Movement break symbol!", (ftnlen)128, ( + ftnlen)46); +#line 10158 "" + stop1_(); +#line 10159 "" + } +#line 10160 "" + if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) { + +/* Since fracsys was not explicitly set, set it to prior value. */ + +#line 10164 "" + if (compage_1.nmovbrk == 1) { +#line 10165 "" + compage_1.fracsys[compage_1.nmovbrk - 1] = + c1omget_1.fracindent; +#line 10166 "" + } else { +#line 10167 "" + compage_1.fracsys[compage_1.nmovbrk - 1] = + compage_1.fracsys[compage_1.nmovbrk - 2]; +#line 10168 "" + } +#line 10169 "" + } +#line 10170 "" + } + +/* Just before exiting if-block for forced line breaks, set counter to use when */ +/* dealing with vertical space calcs */ + +#line 10175 "" + compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1; +#line 10176 "" + } else if (*(unsigned char *)charq == 'F') { +#line 10177 "" + compage_1.usefig = FALSE_; +#line 10178 "" + } else if (*(unsigned char *)charq == 'X') { +#line 10179 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 10179 "" + 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 10181 "" + } else if (*(unsigned char *)charq == 'I') { + +/* MIDI settings. */ + +#line 10185 "" + if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) { +#line 10186 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10186 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"\ + "wed at start of block!", (ftnlen)128, (ftnlen)42); +#line 10188 "" + stop1_(); +#line 10189 "" + } +#line 10190 "" + if (a1ll_2.nv > 15) { +#line 10191 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + a1ll_2.nbars + 1; +#line 10191 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "\ + "not work with more than 15 voices!", (ftnlen)128, ( + ftnlen)54); +#line 10193 "" + stop1_(); +#line 10194 "" + } +#line 10195 "" + commidi_1.ismidi = TRUE_; +/* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ +#line 10197 "" + 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 10199 "" + } else if (*(unsigned char *)charq == 'M') { +#line 10200 "" + 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 10202 "" + } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Continued rhythmic shortcut */ + +#line 10206 "" + idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); +#line 10207 "" + if (idotform == 1) { + +/* Change duration of prior note */ + +#line 10211 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[ + c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - + 25]; +#line 10212 "" + 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 10213 "" + a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[ + c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - + 25]; +#line 10214 "" + } +#line 10215 "" + ++idotform; +#line 10216 "" + numnum = 1; +#line 10217 "" + cdot = TRUE_; +#line 10218 "" + goto L1; +#line 10219 "" + } else { +#line 10220 "" + s_wsle(&io___664); +#line 10220 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 10220 "" + i__1 = *(unsigned char *)charq; +#line 10220 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 10220 "" + e_wsle(); +#line 10221 "" + i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars + + 1; +#line 10221 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\ + "lowed here!", (ftnlen)128, (ftnlen)35); +#line 10223 "" + s_wsle(&io___665); +#line 10223 "" + do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11); +#line 10223 "" + i__1 = *(unsigned char *)charq; +#line 10223 "" + do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 10223 "" + e_wsle(); +#line 10224 "" + stop1_(); +#line 10225 "" + } +#line 10225 "" + } +#line 10226 "" + return 0; +} /* g1etnote_ */ + +/* Subroutine */ int g1etset_(integer *nv, integer *noinst, integer *mtrnuml, + integer *mtrdenl, integer *mtrnmp, integer *mtrdnp, real *xmtrnum0, + integer *newkey, integer *npages, integer *nsyst, integer *musize, + logical *bottreb) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1, i__2[2], i__3[3]; + real r__1; + char ch__1[3], ch__2[1], ch__3[50]; + + /* Builtin functions */ + integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio( + integer *, integer *, char *, ftnlen), e_wsle(void), i_nint(real * + ), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe( + void), i_indx(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + static integer i__, iv; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern /* Subroutine */ int stop1_(void); + static char lineq[128]; + static integer lpath, iinst; + extern doublereal readin_(char *, integer *, integer *, ftnlen); + extern /* Subroutine */ int getbuf_(char *, ftnlen), errmsg_(char *, + integer *, integer *, char *, ftnlen, ftnlen), printl_(char *, + ftnlen); + static logical newway; + static integer iccount; + + /* Fortran I/O blocks */ + static cilist io___668 = { 0, 6, 0, 0, 0 }; + static cilist io___669 = { 0, 6, 0, "(1x,a46,i3)", 0 }; + static cilist io___670 = { 0, 6, 0, "(a)", 0 }; + static cilist io___673 = { 0, 6, 0, "(a)", 0 }; + static cilist io___674 = { 0, 6, 0, "(a)", 0 }; + static cilist io___675 = { 0, 6, 0, 0, 0 }; + + + +/* Get the first line */ + +#line 10244 "" + iccount = 0; +#line 10245 "" + c1omget_1.nline = 1; +#line 10246 "" +L9: +#line 10246 "" + getbuf_(lineq, (ftnlen)128); +#line 10247 "" + if (*(unsigned char *)lineq == '%') { +#line 10248 "" + ++c1omget_1.nline; +#line 10249 "" + goto L9; +#line 10250 "" + } +#line 10251 "" + if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) { + +/* Have TeX input until next line that starts with '---' */ + +#line 10255 "" +L3: +#line 10255 "" + ++c1omget_1.nline; +#line 10256 "" + getbuf_(lineq, (ftnlen)128); +#line 10257 "" + if (inbuff_1.ilbuf > inbuff_1.nlbuf) { +#line 10257 "" + goto L1; +#line 10257 "" + } +#line 10258 "" + goto L2; +#line 10259 "" +L1: +#line 10259 "" + s_wsle(&io___668); +#line 10259 "" + do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""\ + "---\"", (ftnlen)49); +#line 10259 "" + e_wsle(); +#line 10260 "" + stop1_(); +#line 10261 "" +L2: +#line 10262 "" + if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { +#line 10262 "" + goto L3; +#line 10262 "" + } + +/* Force a new line read on first call to readin */ + +#line 10266 "" + iccount = 128; +#line 10267 "" + } + +/* Here, lineq and nline are first non-TeX lines. */ + +#line 10271 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10271 "" + *nv = i_nint(&r__1); +#line 10272 "" + if (*nv > 24) { +#line 10273 "" + s_wsfe(&io___669); +#line 10273 "" + do_fio(&c__1, "In setup data, number of voices cannot exceed", ( + ftnlen)45); +#line 10273 "" + do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer)); +#line 10273 "" + e_wsfe(); +#line 10275 "" + stop1_(); +#line 10276 "" + } +#line 10277 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10277 "" + *noinst = i_nint(&r__1); +#line 10278 "" + if (*noinst > *nv) { +#line 10279 "" + s_wsfe(&io___670); +#line 10279 "" + do_fio(&c__1, "In setup data, cannot have more instruments than stav"\ + "es", (ftnlen)55); +#line 10279 "" + e_wsfe(); +#line 10281 "" + stop1_(); +#line 10282 "" + } +#line 10283 "" + newway = *noinst <= 0; +#line 10284 "" + if (newway) { +#line 10284 "" + *noinst = -(*noinst); +#line 10284 "" + } +#line 10285 "" + i__1 = *noinst; +#line 10285 "" + for (iinst = 1; iinst <= i__1; ++iinst) { + +/* Seve # of staves per inst in case later drop some inst's. */ + +#line 10289 "" + if (newway) { +#line 10290 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10290 "" + c1omget_1.nsperi[iinst - 1] = i_nint(&r__1); +#line 10291 "" + } else if (iinst > 1) { +#line 10292 "" + c1omget_1.nsperi[iinst - 1] = 1; +#line 10293 "" + } else { +#line 10294 "" + c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1; +#line 10295 "" + } +#line 10296 "" +/* L10: */ +#line 10296 "" + } +#line 10297 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10297 "" + *mtrnuml = i_nint(&r__1); +#line 10298 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10298 "" + *mtrdenl = i_nint(&r__1); +/* c */ +/* c Kluge!!! */ +/* c */ +/* if (mtrdenl .eq. 1) then */ +/* mtrdenl = 2 */ +/* mtrnuml = mtrnuml*2 */ +/* end if */ +#line 10306 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10306 "" + *mtrnmp = i_nint(&r__1); +#line 10307 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10307 "" + *mtrdnp = i_nint(&r__1); +#line 10308 "" + if (*mtrnmp == 0 && *mtrdnp >= 8) { +#line 10309 "" + s_wsfe(&io___673); +#line 10309 "" + do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", ( + ftnlen)47); +#line 10309 "" + e_wsfe(); +#line 10310 "" + stop1_(); +#line 10311 "" + } +#line 10312 "" + *xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10313 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10313 "" + *newkey = i_nint(&r__1); +/* 130316 */ +/* do 11 iinst = 1 , noinst */ +#line 10316 "" + commidisig_1.midisig = *newkey; +/* 11 continue */ +#line 10318 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10318 "" + *npages = i_nint(&r__1); +#line 10319 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10319 "" + *nsyst = i_nint(&r__1); +#line 10320 "" + r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128); +#line 10320 "" + *musize = i_nint(&r__1); +#line 10321 "" + c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen) + 128); +#line 10322 "" + if (c1omget_1.fracindent >= 1.f) { +#line 10323 "" + s_wsfe(&io___674); +#line 10323 "" + do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36); +#line 10323 "" + e_wsfe(); +#line 10324 "" + stop1_(); +#line 10325 "" + } +#line 10326 "" + if (*npages > *nsyst) { +#line 10327 "" + s_wsle(&io___675); +#line 10327 "" + do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen) + 35); +#line 10327 "" + e_wsle(); +#line 10328 "" + stop1_(); +#line 10329 "" + } else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize - + 29) != 0) { +#line 10330 "" + printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35); +#line 10331 "" + stop1_(); +#line 10332 "" + } + +/* Next noinst non-comment lines are names of instruments. */ + +#line 10336 "" + i__1 = abs(*noinst); +#line 10336 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 10337 "" +L5: +#line 10337 "" + getbuf_(lineq, (ftnlen)128); +#line 10338 "" + ++c1omget_1.nline; +#line 10339 "" + if (*(unsigned char *)lineq == '%') { +#line 10339 "" + goto L5; +#line 10339 "" + } +#line 10340 "" +/* L4: */ +#line 10340 "" + } + +/* Mext non-comment line has nv clef names */ + +#line 10344 "" +L6: +#line 10344 "" + getbuf_(lineq, (ftnlen)128); +#line 10345 "" + ++c1omget_1.nline; +#line 10346 "" + if (*(unsigned char *)lineq == '%') { +#line 10346 "" + goto L6; +#line 10346 "" + } +#line 10347 "" + i__1 = *nv; +#line 10347 "" + for (iv = 1; iv <= i__1; ++iv) { +/* if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then */ +#line 10349 "" + if (i_indx("brnamstf012345678", lineq + (iv - 1), (ftnlen)17, (ftnlen) + 1) == 0) { +#line 10350 "" + errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!", + (ftnlen)128, (ftnlen)35); +#line 10352 "" + stop1_(); +#line 10353 "" + } +#line 10354 "" +/* L7: */ +#line 10354 "" + } +#line 10355 "" + i__1 = *nv; +#line 10355 "" + if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) { +#line 10356 "" + i__1 = *nv + 1; +#line 10356 "" + errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen) + 128, (ftnlen)29); +#line 10358 "" + stop1_(); +#line 10359 "" + } + +/* Set flag if voice 1 is treble, since it affects vertical spacing */ + +/* bottreb = lineq(1:1).eq.'t' */ +#line 10364 "" + *bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0; + +/* Next non-comment line has path name */ + +#line 10368 "" +L8: +#line 10368 "" + getbuf_(lineq, (ftnlen)128); +#line 10369 "" + ++c1omget_1.nline; +#line 10370 "" + if (*(unsigned char *)lineq == '%') { +#line 10370 "" + goto L8; +#line 10370 "" + } +#line 10371 "" + lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1; +/* Writing concatenation */ +#line 10372 "" + i__2[0] = 2, a__1[0] = "/:"; +#line 10372 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 10372 "" + i__2[1] = 1, a__1[1] = ch__2; +#line 10372 "" + s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3); +#line 10372 "" + if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) { +/* Writing concatenation */ +#line 10373 "" + i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""\ + ":\", or \""; +#line 10373 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 10373 "" + i__3[1] = 1, a__2[1] = ch__2; +#line 10373 "" + i__3[2] = 2, a__2[2] = "\"!"; +#line 10373 "" + s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50); +#line 10373 "" + errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50); +#line 10376 "" + stop1_(); +#line 10377 "" + } +#line 10378 "" + return 0; +} /* g1etset_ */ + +/* Subroutine */ int g1etx_(char *lineq, integer *iccount, logical *shifton, + integer *ibar, real *udsp, real *wheadpt, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static real fnum; + static char dumq[1]; + extern /* Subroutine */ int stop1_(void); + static char charq[1]; + static integer ipbsc, npbsc; + static logical number; + extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *, + ftnlen, ftnlen), readnum_(char *, integer *, char *, real *, + ftnlen, ftnlen), g1etchar_(char *, integer *, char *, ftnlen, + ftnlen); + + +/* 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 10388 "" + number = FALSE_; +#line 10389 "" + npbsc = 0; +#line 10390 "" +L1: +#line 10390 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10391 "" + if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) { + +/* Continue checking here even if "P". */ + +#line 10395 "" + ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1); +#line 10396 "" + if (bit_test(npbsc,ipbsc)) { +#line 10397 "" + errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", ( + ftnlen)128, (ftnlen)28); +#line 10398 "" + stop1_(); +#line 10399 "" + } +#line 10400 "" + npbsc = bit_set(npbsc,ipbsc); +#line 10401 "" + goto L1; +#line 10402 "" + } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { +#line 10403 "" + number = TRUE_; +#line 10404 "" + if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { +#line 10405 "" + g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1); +#line 10406 "" + if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) { +#line 10407 "" + errmsg_(lineq, iccount, ibar, "Expected a number here!", ( + ftnlen)128, (ftnlen)23); +#line 10408 "" + stop1_(); +#line 10409 "" + } +#line 10410 "" + } +#line 10411 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10412 "" + if (*(unsigned char *)charq == '-') { +#line 10412 "" + fnum = -fnum; +#line 10412 "" + } +#line 10413 "" + if (*(unsigned char *)dumq != 'p') { +#line 10414 "" + --(*iccount); +#line 10415 "" + fnum *= *wheadpt; +#line 10416 "" + } +#line 10417 "" + goto L1; +#line 10418 "" + } else if (*(unsigned char *)charq != ' ') { +#line 10419 "" + errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen) + 128, (ftnlen)26); +#line 10420 "" + stop1_(); +#line 10421 "" + } + +/* Done with parsing. Other checks */ + +#line 10425 "" + if ((6 & npbsc) == 6 || (24 & npbsc) == 24) { +#line 10426 "" + i__1 = *iccount - 1; +#line 10426 "" + errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""\ + "S\" and \":\"!", (ftnlen)128, (ftnlen)44); +#line 10428 "" + stop1_(); +#line 10429 "" + } +#line 10430 "" + if (bit_test(npbsc,4)) { +#line 10431 "" + if (number) { +#line 10432 "" + if (*shifton) { +#line 10433 "" + i__1 = *iccount - 1; +#line 10433 "" + errmsg_(lineq, &i__1, ibar, "Started a group shift without s"\ + "topping prior one!", (ftnlen)128, (ftnlen)49); +#line 10435 "" + stop1_(); +#line 10436 "" + } else { +#line 10437 "" + *shifton = TRUE_; +#line 10438 "" + } +#line 10439 "" + } else { +#line 10440 "" + if (! (*shifton)) { +#line 10441 "" + i__1 = *iccount - 1; +#line 10441 "" + errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"\ + "rting one!", (ftnlen)128, (ftnlen)41); +#line 10443 "" + stop1_(); +#line 10444 "" + } else { +#line 10445 "" + *shifton = FALSE_; +#line 10446 "" + } +#line 10447 "" + } +#line 10448 "" + } + +/* P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) */ + +#line 10452 "" + if ((npbsc & 26) == 0) { +#line 10452 "" + *udsp += fnum; +#line 10452 "" + } +#line 10453 "" + if (! number && ! bit_test(npbsc,4)) { +#line 10454 "" + i__1 = *iccount - 1; +#line 10454 "" + errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "\ + "in \"X\" symbol!", (ftnlen)128, (ftnlen)51); +#line 10456 "" + stop1_(); +#line 10457 "" + } +#line 10458 "" + return 0; +} /* g1etx_ */ + +/* integer*4 function mytime() */ +/* CHARACTER(10) tq */ +/* CALL DATE_AND_TIME(TIME=tq) */ +/* read(tq,'(2i2,f6.3)')ih,im,ts */ +/* mytime = 1000*(ts+60*(im+60*ih)) */ +/* return */ +/* end */ +/* Subroutine */ int getbuf_(char *lineq, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + +#line 10473 "" + i__1 = inbuff_1.ipbuf; +#line 10473 "" + s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf + + inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1); +#line 10474 "" + inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; +#line 10475 "" + ++inbuff_1.ilbuf; +#line 10476 "" + return 0; +} /* getbuf_ */ + +/* Subroutine */ int getchar_(char *lineq, integer *iccount, char *charq, + ftnlen lineq_len, ftnlen charq_len) +{ + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer ndxm; + extern /* Subroutine */ int mrec1_(char *, integer *, integer *, ftnlen), + read10_(char *, logical *, ftnlen); + + +/* 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 10492 "" + if (*iccount == 128) { +#line 10493 "" + read10_(lineq, &comget_1.lastchar, (ftnlen)128); +#line 10494 "" + if (comget_1.lastchar) { +#line 10494 "" + return 0; +#line 10494 "" + } +#line 10495 "" + if (! commac_1.endmac) { +#line 10496 "" + *iccount = 0; +#line 10497 "" + } else { +#line 10498 "" + commac_1.endmac = FALSE_; +#line 10499 "" + *iccount = commac_1.icchold; +#line 10500 "" + s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128); +#line 10501 "" + } +#line 10502 "" + if (commac_1.mrecord) { +#line 10503 "" + mrec1_(lineq, iccount, &ndxm, (ftnlen)128); +#line 10504 "" + } +#line 10505 "" + } +#line 10506 "" + ++(*iccount); +#line 10507 "" + *(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1]; +#line 10508 "" + return 0; +} /* getchar_ */ + +/* Subroutine */ int getdyn_(integer *ivx, integer *ip, integer *irest, + integer *iornq, char *lineq, integer *iccount, ftnlen lineq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1, i__2[3], i__3; + real r__1; + char ch__1[4], ch__2[1]; + icilist ici__1; + + /* Builtin functions */ + integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, + ftnlen, ftnlen); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + , i_nint(real *); + + /* Local variables */ + static integer ipm, iend; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer idno, idyn; + static real fnum; + static char durq[1]; + static integer idno1; + extern /* Subroutine */ int stop1_(void), printl_(char *, ftnlen), + readnum_(char *, integer *, char *, real *, ftnlen, ftnlen), + setbits_(integer *, integer *, integer *, integer *); + static char dynsymq[4]; + + +/* Get info for dynamic mark. Enter after getting "D", iccount sits on "D" */ +/* Bits in idyndat are as follows */ +/* 00-03 ivx */ +/* 04-11 ip */ +/* 12-15 code for type of mark */ +/* 0 => arbitrary text */ +/* 1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff */ +/* If (.not. fontslur) */ +/* 13 => hairpin start, 14,15 => <,> (ending) */ +/* else */ +/* 13 < start, 14 > start, 15 ending */ +/* end if */ +/* 16 flag for vertical offset */ +/* 17-23 vertical offset + 64 , \internote */ +/* 31 Hairpin start (0), stop (1) */ + +/* idynda2 */ + +/* 00 flag for horizontal offset */ +/* 01-09 (horizontal offset)/10 + 25.6 notehead widths */ +/* 10 5th bit for ivx (5/15/10) */ + +#line 10545 "" + *irest = bit_set(*irest,26); +#line 10546 "" + ++comdyn_1.ndyn; +#line 10547 "" + idyn = *ivx; +#line 10548 "" + comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0; +#line 10549 "" + if (*ivx >= 16) { +#line 10549 "" + setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1); +#line 10549 "" + } +#line 10550 "" + setbits_(&idyn, &c__8, &c__4, ip); +#line 10551 "" + i__1 = *iccount; +#line 10551 "" + if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) { + +/* text-dynamic */ + +#line 10555 "" + ++comdyn_1.ntxtdyn; +#line 10556 "" + i__1 = *iccount + 1; +#line 10556 "" + iend = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) + + 2; +#line 10557 "" + i__1 = *iccount + 1; +#line 10557 "" + s_copy(comdyn_1.txtdynq + (comdyn_1.ntxtdyn - 1 << 7), lineq + i__1, ( + ftnlen)128, iend - 2 - i__1); + +/* c Store ivx, ip in bits 0-11 */ +/* Store ivx, ip in bits 0-12 */ + +/* ivxiptxt(ntxtdyn) = idyn */ +#line 10563 "" + comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5); +#line 10564 "" + ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); +#line 10565 "" + idno = 0; +#line 10566 "" + } else { + +/* Word-group or hairpin */ + +#line 10570 "" + for (iend = *iccount + 2; iend <= 128; ++iend) { +#line 10571 "" + ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1); + +/* Exit the loop at first blank, "+", or "-" */ + +#line 10575 "" + if (ipm > 0) { +#line 10575 "" + goto L2; +#line 10575 "" + } +#line 10576 "" +/* L1: */ +#line 10576 "" + } +#line 10577 "" +L2: +#line 10578 "" + i__1 = *iccount; +#line 10578 "" + ici__1.icierr = 0; +#line 10578 "" + ici__1.iciend = 0; +#line 10578 "" + ici__1.icirnum = 1; +#line 10578 "" + ici__1.icirlen = iend - 1 - i__1; +#line 10578 "" + ici__1.iciunit = lineq + i__1; +/* Writing concatenation */ +#line 10578 "" + i__2[0] = 2, a__1[0] = "(a"; +#line 10578 "" + i__3 = iend + 47 - *iccount; +#line 10578 "" + chax_(ch__2, (ftnlen)1, &i__3); +#line 10578 "" + i__2[1] = 1, a__1[1] = ch__2; +#line 10578 "" + i__2[2] = 1, a__1[2] = ")"; +#line 10578 "" + ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 10578 "" + s_rsfi(&ici__1); +#line 10578 "" + do_fio(&c__1, dynsymq, (ftnlen)4); +#line 10578 "" + e_rsfi(); +#line 10580 "" + 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 10586 "" + idno1 = idno; +#line 10587 "" + } + +/* Set flag to check level later if in beam */ + +#line 10591 "" + *iornq = bit_set(*iornq,23); +#line 10592 "" + if (idno >= 14) { + +/* Hairpin here. Check if opposite type from one that's already on */ + +#line 10596 "" + if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 && + bit_test(comdyn_1.listcresc,*ivx)) { +#line 10598 "" + printl_(" ", (ftnlen)1); +#line 10599 "" + printl_("Started one kind of hairpin while other is on", (ftnlen) + 45); +#line 10600 "" + stop1_(); +#line 10601 "" + } + +/* Start or stop? */ + +#line 10605 "" + 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 10609 "" + if (! comslur_1.fontslur) { +#line 10609 "" + idno = 15; +#line 10609 "" + } +#line 10610 "" + } else if (comslur_1.fontslur) { + +/* Start of font slur */ + +#line 10614 "" + idno = 13; +#line 10615 "" + } else { + +/* Start of postscript slur */ + +#line 10619 "" + --idno; +#line 10620 "" + } +#line 10621 "" + } + +/* Now that we used list[de]cresc, update */ + +#line 10625 "" + if (idno >= 13) { +#line 10626 "" + if (idno == 15 || comslur_1.fontslur && idno == 14) { + +/* Something's ending */ + +#line 10630 "" + if (bit_test(comdyn_1.listcresc,*ivx)) { + +/* It's a cresc! */ + +#line 10634 "" + comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx); +#line 10635 "" + } else { +#line 10636 "" + comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx); +#line 10637 "" + } +#line 10638 "" + } else { + +/* Something's starting */ + +#line 10642 "" + if (idno1 == 14) { + +/* It's a cresc! */ + +#line 10646 "" + comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx); +#line 10647 "" + } else { +#line 10648 "" + comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx); +#line 10649 "" + } +#line 10650 "" + } +#line 10651 "" + } +#line 10652 "" + setbits_(&idyn, &c__4, &c__12, &idno); +#line 10653 "" + *iccount = iend; +#line 10654 "" + if (ipm != 2) { + +/* There is a vertical shift */ + +#line 10658 "" + idyn = bit_set(idyn,16); +#line 10659 "" + ++(*iccount); +#line 10660 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10661 "" + idno = i_nint(&fnum); +#line 10662 "" + i__1 = (ipm - 2) * idno + 64; +#line 10662 "" + setbits_(&idyn, &c__7, &c__17, &i__1); +#line 10663 "" + ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1); +#line 10664 "" + if (ipm != 2) { + +/* There is a horizontal shift */ + +/* idynda2(ndyn) = ibset(idyn,23) */ +#line 10669 "" + comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[ + comdyn_1.ndyn - 1],0); +#line 10670 "" + ++(*iccount); +#line 10671 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10672 "" + r__1 = fnum * 10; +#line 10672 "" + idno = i_nint(&r__1); +#line 10673 "" + i__1 = (ipm - 2) * idno + 256; +#line 10673 "" + setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, & + i__1); +#line 10674 "" + } + +/* iccount should be on the blank at the end of the entire symbol */ + +#line 10678 "" + } +#line 10679 "" + comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn; +#line 10680 "" + return 0; +} /* getdyn_ */ + +/* Subroutine */ int getfig_(integer *itoff, char *charq, char *lineq, + integer *iccount, logical *isfig, integer *itfig, integer *itsofar, + integer *nodur, char *figq, integer *ivupfig, integer *ivvfig, + integer *nfigs, ftnlen charq_len, ftnlen lineq_len, ftnlen figq_len) +{ + /* System generated locals */ + address a__1[2]; + integer i__1[2]; + icilist ici__1; + + /* Builtin functions */ + integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + ; + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer i_indx(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer i_nint(real *); + + /* Local variables */ + static integer lfig, loff, noff; + static real fnum; + static integer isign; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen); + extern integer ifnodur_(integer *, char *, ftnlen); + +/* * itsofar,nodur,figq,ivupfig,nfigs) */ +#line 10689 "" + ++(*nfigs); +#line 10690 "" + *ivupfig = 0; +#line 10691 "" + *ivvfig = 0; +#line 10692 "" + *itoff = 0; +#line 10693 "" + if (*(unsigned char *)charq == 'x') { + +/* Floating figure. */ + +#line 10697 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10698 "" + ici__1.icierr = 0; +#line 10698 "" + ici__1.iciend = 0; +#line 10698 "" + ici__1.icirnum = 1; +#line 10698 "" + ici__1.icirlen = 1; +#line 10698 "" + ici__1.iciunit = charq; +#line 10698 "" + ici__1.icifmt = "(i1)"; +#line 10698 "" + s_rsfi(&ici__1); +#line 10698 "" + do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer)); +#line 10698 "" + e_rsfi(); +#line 10699 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10700 "" + ici__1.icierr = 0; +#line 10700 "" + ici__1.iciend = 0; +#line 10700 "" + ici__1.icirnum = 1; +#line 10700 "" + ici__1.icirlen = 1; +#line 10700 "" + ici__1.iciunit = charq; +#line 10700 "" + ici__1.icifmt = "(i1)"; +#line 10700 "" + s_rsfi(&ici__1); +#line 10700 "" + do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer)); +#line 10700 "" + e_rsfi(); +#line 10701 "" + *itoff = noff * ifnodur_(&loff, "x", (ftnlen)1); +#line 10702 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10703 "" + } else { + +/* Figure on a note */ + +#line 10707 "" + *isfig = TRUE_; +#line 10708 "" + } +#line 10709 "" + *itfig = *itsofar + *itoff - *nodur; +#line 10710 "" + lfig = 1; +#line 10711 "" + s_copy(figq, charq, (ftnlen)10, (ftnlen)1); +#line 10712 "" +L5: +#line 10712 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +/* if (index(' +',charq) .eq. 0) then */ +#line 10714 "" + if (i_indx(" +v", charq, (ftnlen)3, (ftnlen)1) == 0) { +/* Writing concatenation */ +#line 10715 "" + i__1[0] = lfig, a__1[0] = figq; +#line 10715 "" + i__1[1] = 1, a__1[1] = charq; +#line 10715 "" + s_cat(figq, a__1, i__1, &c__2, (ftnlen)10); +#line 10716 "" + ++lfig; +#line 10717 "" + goto L5; +#line 10718 "" + } else if (*(unsigned char *)charq == '+') { + +/* Get vertical offset for figure. Next character after number has to be blank. */ + +#line 10722 "" + ++(*iccount); +#line 10723 "" + readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10724 "" + *ivupfig = i_nint(&fnum); +#line 10725 "" + } else if (*(unsigned char *)charq == 'v') { + +/* Get vertical change in figdrop. Must be last item in figure word. */ + +#line 10729 "" + isign = 1; +#line 10730 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10731 "" + if (*(unsigned char *)charq == '-') { +#line 10732 "" + isign = -1; +#line 10733 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10734 "" + } +#line 10735 "" + *ivvfig = isign * (*(unsigned char *)charq - 48); +#line 10736 "" + } +#line 10737 "" + return 0; +} /* getfig_ */ + +/* Subroutine */ int getgrace_(integer *ivx, integer *nnl, char *lineq, + integer *iccount, integer *islur, integer *iornq, integer *ipl, + integer *ndlev, integer *lastlev, integer *iv, integer *nv, ftnlen + lineq_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *); + + /* Local variables */ + static integer iclastlev, kv, ing, ioct; + static real fnum; + static char durq[1], charq[1]; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen); + extern integer ifnolev_(char *, integer *, integer *, ftnlen); + + +/* Grace, comes *before* main note: */ +/* UNLESS there's an 'A' or 'W' after the 'G' */ +/* ngrace = # of grace note groups so far in block */ +/* ivg(ngrace), ipg(ngrace) */ +/* nng(ngrace) = # of notes in this group: default = 1 */ +/* ngstrt(ngrace) = starting position in nolevg of levels for this grace */ +/* multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' */ +/* upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' */ +/* slurg(ngrace) = logical for slur; default F, input 's' */ +/* slashg(ngrace) = T if slash; default is F, input 'x' */ +/* These data MUST precede note name of first note */ +/* nolevg, naccg: lists of levels and accid's, indexed as described above. */ + +#line 10771 "" + /* Parameter adjustments */ +#line 10771 "" + ndlev -= 25; +#line 10771 "" + ipl -= 25; +#line 10771 "" + --iornq; +#line 10771 "" + islur -= 25; +#line 10771 "" + --nnl; +#line 10771 "" + +#line 10771 "" + /* Function Body */ +#line 10771 "" + ++comgrace_1.ngrace; +#line 10772 "" + comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx; +#line 10773 "" + comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1; +#line 10774 "" + if (comgrace_1.ngrace == 1) { +#line 10775 "" + comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1; +#line 10776 "" + } else { +#line 10777 "" + comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[ + comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2] + ; +#line 10778 "" + } +#line 10779 "" + islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1) + * 24],4); +#line 10780 "" + comgrace_1.nng[comgrace_1.ngrace - 1] = 1; +#line 10781 "" + comgrace_1.multg[comgrace_1.ngrace - 1] = 1; +#line 10782 "" + comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_; +#line 10783 "" + comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_; +#line 10784 "" + comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_; +#line 10785 "" +L18: +#line 10785 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10786 "" + 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 10791 "" + comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx]; +#line 10792 "" + islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx] + + 1) * 24],4); +#line 10793 "" + islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4) + ; +#line 10794 "" + if (comgrace_1.slurg[comgrace_1.ngrace - 1]) { +#line 10794 "" + iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] * + 24],24); +#line 10794 "" + } +#line 10796 "" + if (*(unsigned char *)charq == 'A') { + +/* close After, clear way-after bit, to ensure priority of most recent A/W */ + +#line 10800 "" + ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* + ivx] * 24],31),29); +#line 10801 "" + } else { + +/* Way after; later assign to following note, and position like normal grace. */ + +#line 10805 "" + ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[* + ivx] * 24],29),31); +#line 10806 "" + } +#line 10807 "" + } else if (*(unsigned char *)charq == 'm') { +#line 10808 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10809 "" + comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq - + 48; +#line 10810 "" + } else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) { +#line 10811 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10812 "" + --(*iccount); +#line 10813 "" + comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum); +#line 10814 "" + } else if (*(unsigned char *)charq == 'l') { +#line 10815 "" + comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_; +#line 10816 "" + } else if (*(unsigned char *)charq == 's') { +#line 10817 "" + comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_; +#line 10818 "" + if (nnl[*ivx] > 0) { + +/* If A- or W-grace, set signal to start slur on main note. */ + +#line 10822 "" + if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx + + nnl[*ivx] * 24],29)) { +#line 10822 "" + iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] + * 24],24); +#line 10822 "" + } +#line 10825 "" + } +#line 10826 "" + } else if (*(unsigned char *)charq == 'x') { +#line 10827 "" + comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_; +#line 10828 "" + } else if (*(unsigned char *)charq == 'u') { +#line 10829 "" + } else if (*(unsigned char *)charq == 'X') { + +/* Space before main note of grace. Number will come next. */ + +#line 10833 "" + ++(*iccount); +#line 10834 "" + readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace + - 1], (ftnlen)128, (ftnlen)1); +#line 10835 "" + --(*iccount); +#line 10836 "" + } +#line 10837 "" + if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) { +#line 10837 "" + goto L18; +#line 10837 "" + } + +/* At this point, charq is first note name in grace */ + +#line 10841 "" + i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[ + comgrace_1.ngrace - 1] - 1; +#line 10841 "" + for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) { +#line 10842 "" + comgrace_1.naccg[ing - 1] = 0; +#line 10843 "" + ioct = 0; +#line 10844 "" + if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) { +#line 10845 "" +L55: +#line 10845 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 10846 "" + if (*(unsigned char *)charq == ' ') { +#line 10846 "" + goto L55; +#line 10846 "" + } +#line 10847 "" + } +#line 10848 "" + iclastlev = 0; +#line 10849 "" +L9: +#line 10849 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10850 "" + if (*(unsigned char *)durq != ' ') { +#line 10851 "" + if (*(unsigned char *)durq == '+') { +#line 10852 "" + *lastlev += 7; +#line 10853 "" + iclastlev += 7; +#line 10854 "" + } else if (*(unsigned char *)durq == '-') { +#line 10855 "" + *lastlev += -7; +#line 10856 "" + iclastlev += -7; +#line 10857 "" + } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { +#line 10858 "" + if (comgrace_1.naccg[ing - 1] == 0) { +#line 10859 "" + comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3, + (ftnlen)1); +#line 10860 "" + } else { + +/* Double accidental */ + +#line 10864 "" + comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing + - 1],2); +#line 10865 "" + } +#line 10866 "" + } else { +#line 10867 "" + ioct = *(unsigned char *)durq - 48; +#line 10868 "" + } +#line 10869 "" + goto L9; +#line 10870 "" + } +#line 10871 "" + if (ioct > 0) { +#line 10872 "" + *lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[ + cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1); +#line 10873 "" + } else { +#line 10874 "" + if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace + - 1]) { +#line 10875 "" + if (*ivx <= *nv) { +#line 10876 "" + kv = 1; +#line 10877 "" + } else { +#line 10878 "" + kv = 2; +#line 10879 "" + } +#line 10880 "" + *lastlev = ndlev[*iv + kv * 24] + iclastlev; +#line 10881 "" + } +#line 10882 "" + *lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, & + cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] - + 1], (ftnlen)1) - *lastlev + 3) % 7; +#line 10884 "" + } +#line 10885 "" + comgrace_1.nolevg[ing - 1] = *lastlev; +#line 10886 "" +/* L19: */ +#line 10886 "" + } + +/* Grace could come before first note of block, so reset end level. */ + +#line 10890 "" + if (nnl[*ivx] == 0) { +#line 10891 "" + if (*ivx <= *nv) { +#line 10892 "" + kv = 1; +#line 10893 "" + } else { +#line 10894 "" + kv = 2; +#line 10895 "" + } +#line 10896 "" + ndlev[*iv + kv * 24] = *lastlev; +#line 10897 "" + } +#line 10898 "" + return 0; +} /* getgrace_ */ + +/* Subroutine */ int getitransinfo_(logical *from1, integer *ibarcnt, char * + lineq, integer *iccount, integer *ibaroff, integer *nbars, integer * + noinst, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *); + + /* Local variables */ + static integer ikey; + static real fnum; + static char durq[1]; + extern /* Subroutine */ int stop1_(void); + static integer instn; + static logical store; + extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *, + ftnlen, ftnlen); + static integer itramt; + extern /* Subroutine */ int readnum_(char *, integer *, char *, real *, + ftnlen, ftnlen), g1etchar_(char *, integer *, char *, ftnlen, + ftnlen); + +/* ccccccccccccccccccccccc */ +/* c */ +/* c GetiTransInfo.for */ +/* c */ +/* ccccccccccccccccccccccc */ + +/* Called from both g1etnote and getnote, after first 'i' in Ki[...] */ +/* On entry, iccount points to last char retrieved, which is 'i' */ + +/* From1: locgical, true if called from g1etnote */ +/* ibarcnt: tells whether to set EarlyTransOn to true. */ +/* EarlyTransOn set false in blkdata, true here, back to false in topfile. */ + +/* 110522/110529 */ +/* Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */ +/* and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0 */ +/* so can pass to topfile (via comInstTrans), which is called before getnote. */ +/* Otherwise, will store info from getnote. Initialize EarlyTransOn and */ +/* LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote; */ +/* LaterInstTrans from getnote. Zero both out after use. nInstTrans really */ +/* only needed for instrument-signatures, not transpositions. iTransAmt is */ +/* ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for */ +/* each staff. */ + +/* iTransAmt stored as fn of instrument #, not like iTransKey which is */ +/* fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */ +/* simplifies use of iTransAmt for all calls to ifnolev. */ + +#line 10937 "" + *(unsigned char *)durq = 'x'; +/* Can't initialize in declaration stmt, only works onc */ +#line 10938 "" + if (! cominsttrans_1.earlytranson) { +#line 10938 "" + cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0; +#line 10938 "" + } +#line 10939 "" + store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && ! + (*from1); +#line 10941 "" + cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0; +#line 10942 "" + if (store) { +#line 10942 "" + cominsttrans_1.ninsttrans = 0; +#line 10942 "" + } +#line 10943 "" +L1: +#line 10944 "" + if (*(unsigned char *)durq == ' ') { +#line 10944 "" + return 0; +#line 10944 "" + } +#line 10945 "" + g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10946 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 10947 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10947 "" + errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"\ + "ere!", (ftnlen)128, (ftnlen)40); +#line 10949 "" + stop1_(); +#line 10950 "" + } +#line 10951 "" + if (store) { +#line 10951 "" + ++cominsttrans_1.ninsttrans; +#line 10951 "" + } +#line 10952 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10953 "" + instn = i_nint(&fnum); +#line 10954 "" + if (instn > *noinst) { +#line 10955 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10955 "" + errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", ( + ftnlen)128, (ftnlen)31); +#line 10957 "" + stop1_(); +#line 10958 "" + } +#line 10959 "" + if (store) { +#line 10959 "" + cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn; +#line 10959 "" + } + +/* durq is +/- following inst # (for iTransAmt), iccount is on it. */ + +#line 10963 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10964 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10964 "" + errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"\ + "r must be \"+,-\"!", (ftnlen)128, (ftnlen)52); +#line 10966 "" + stop1_(); +#line 10967 "" + } +#line 10968 "" + itramt = 44 - *(unsigned char *)durq; +/* +1/-1 for itramt */ +#line 10969 "" + g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10970 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10971 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10971 "" + errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"\ + " here!", (ftnlen)128, (ftnlen)42); +#line 10973 "" + stop1_(); +#line 10974 "" + } +#line 10975 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10976 "" + if (store) { +#line 10976 "" + cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt; +#line 10976 "" + } + +/* durq is +/- following iTransAmt (for iTransKey), iccount is on it. */ + +#line 10980 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) { +#line 10981 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10981 "" + errmsg_(lineq, iccount, &i__1, "1st character after transposition am"\ + "ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55); +#line 10983 "" + stop1_(); +#line 10984 "" + } +#line 10985 "" + ikey = 44 - *(unsigned char *)durq; +/* +1/-1 */ +#line 10986 "" + g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 10987 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 10988 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10988 "" + errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!", + (ftnlen)128, (ftnlen)35); +#line 10990 "" + stop1_(); +#line 10991 "" + } +#line 10992 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 10993 "" + if (store) { +#line 10993 "" + cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(& + fnum) * ikey; +#line 10993 "" + } + +/* durq is now 1st character after iTransKey, should be either 'i' or ' ' */ + +#line 10997 "" + if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') { +#line 10998 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 10998 "" + errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", ( + ftnlen)128, (ftnlen)32); +#line 11000 "" + stop1_(); +#line 11001 "" + } +#line 11002 "" + goto L1; +} /* getitransinfo_ */ + +/* Subroutine */ int getmidi_(integer *noinstarg, char *lineq, integer * + iccount, integer *ibarcnt, integer *ibaroff, integer *nbars, integer * + lenbar, integer *mtrdenl, logical *first, ftnlen lineq_len) +{ + /* Initialized data */ + + static shortint midinum[26] = { 1,5,7,13,20,25,33,41,42,43,44,57,58,59,61, + 65,66,67,68,69,71,72,74,75,8,55 }; + + /* System generated locals */ + address a__1[2]; + integer i__1, i__2[2], i__3, i__4; + real r__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Local variables */ + static real pausemid; + extern /* Subroutine */ int midievent_(char *, integer *, integer *, + ftnlen); + static integer icm, ipm; + static real qpm; + static integer ivx; + static real fnum; + static char durq[1]; + extern /* Subroutine */ int stop1_(void); + static integer iname, numb16; + static char instq[2]; + extern /* Subroutine */ int errmsg_(char *, integer *, integer *, char *, + ftnlen, ftnlen), addmidi_(integer *, integer *, integer *, + integer *, real *, logical *, logical *), getchar_(char *, + integer *, char *, ftnlen, ftnlen), readnum_(char *, integer *, + char *, real *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___723 = { 0, 6, 0, "(a)", 0 }; + static cilist io___724 = { 0, 15, 0, "(a)", 0 }; + + +/* subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ + +/* Use this from both pmxa and pmxb to input and check midi data. "first" tells */ +/* whether pmxa or pmxb. If .not.first, then tempo and pause commands cause */ +/* things to be written immediately into the midi storage buffers. */ + + +/* immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing */ +/* nmidsec section starts and stops based on PLAYING macros (not recording). */ + + +/* Instrument codes */ + +/* XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX */ + +/* bsXobXbaXclXflXreXctXvo */ + +#line 11050 "" +L1: +#line 11050 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11051 "" + if (*(unsigned char *)durq == 't') { + +/* Tempo in beats ber minute */ + +#line 11055 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11056 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11057 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11057 "" + errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ + " pause!", (ftnlen)128, (ftnlen)39); +#line 11059 "" + stop1_(); +/* else if (mmacrec) then */ +/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */ +/* * 'Cannot change MIDI tempo while recording a MidiMacro!') */ +/* call stop1() */ +#line 11064 "" + } +#line 11065 "" + readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1); +#line 11066 "" + --(*iccount); +#line 11067 "" + if (! (*first)) { +#line 11068 "" + i__1 = i_nint(&qpm); +#line 11068 "" + midievent_("t", &i__1, &c__0, (ftnlen)1); +#line 11069 "" + commmac_1.gottempo = TRUE_; +#line 11070 "" + } +#line 11071 "" + goto L1; +#line 11072 "" + } else if (*(unsigned char *)durq == 'p') { + +/* Insert a pause. pausemid = pause in 1/4's */ + +#line 11076 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11077 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) { +#line 11078 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11078 "" + errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"\ + "ause!", (ftnlen)128, (ftnlen)37); +#line 11080 "" + stop1_(); +#line 11081 "" + } +#line 11082 "" + readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1); +#line 11083 "" + --(*iccount); +#line 11084 "" + 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 11089 "" + r__1 = pausemid * 4; +#line 11089 "" + numb16 = i_nint(&r__1); +#line 11090 "" + midievent_("m", &numb16, &c__16, (ftnlen)1); + +/* Put in pausemid beats of rest */ + +#line 11094 "" + i__1 = commidi_1.numchan - 1; +#line 11094 "" + for (icm = 0; icm <= i__1; ++icm) { +#line 11095 "" + r__1 = numb16 * 4.f; +#line 11095 "" + addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false); +#line 11096 "" +/* L3: */ +#line 11096 "" + } +#line 11097 "" + r__1 = pausemid * 240; +#line 11097 "" + comevent_1.miditime += i_nint(&r__1); + +/* Restore meter */ + +#line 11101 "" + i__1 = *mtrdenl * *lenbar / 64; +#line 11101 "" + midievent_("m", &i__1, mtrdenl, (ftnlen)1); +#line 11102 "" + } +#line 11103 "" + goto L1; +#line 11104 "" + } 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 11110 "" + i__1 = *noinstarg; +#line 11110 "" + for (ivx = 1; ivx <= i__1; ++ivx) { +#line 11111 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11112 "" + if (*(unsigned char *)durq > 96) { + +/* It's a lowercase letter. Get another, find corr. instrument #. */ + +#line 11116 "" + *(unsigned char *)instq = *(unsigned char *)durq; +#line 11117 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +/* Writing concatenation */ +#line 11118 "" + i__2[0] = 1, a__1[0] = instq; +#line 11118 "" + i__2[1] = 1, a__1[1] = durq; +#line 11118 "" + s_cat(instq, a__1, i__2, &c__2, (ftnlen)2); +#line 11119 "" + iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"\ + "frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen) + 79, (ftnlen)2) / 3; +#line 11121 "" + if (iname == 0) { +#line 11122 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11122 "" + errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"\ + "di instrument name!", (ftnlen)128, (ftnlen)43); +#line 11124 "" + stop1_(); +#line 11125 "" + } +#line 11126 "" + commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1; +#line 11127 "" + } 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 11133 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11134 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11134 "" + errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"\ + "nt number here!", (ftnlen)128, (ftnlen)39); +#line 11136 "" + stop1_(); +#line 11137 "" + } +#line 11138 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11139 "" + commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1; +#line 11140 "" + if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx - + 1] > 255) { +#line 11141 "" + i__3 = *iccount - 1; +#line 11141 "" + i__4 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11141 "" + errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"\ + "t be in range 1-128!", (ftnlen)128, (ftnlen)46); +#line 11143 "" + stop1_(); +#line 11144 "" + } +#line 11145 "" + if (*(unsigned char *)durq != ':') { +#line 11145 "" + --(*iccount); +#line 11145 "" + } +#line 11146 "" + } +#line 11147 "" +/* L2: */ +#line 11147 "" + } +#line 11148 "" + goto L1; +#line 11149 "" + } 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 11155 "" + i__1 = *noinstarg; +#line 11155 "" + for (ivx = 1; ivx <= i__1; ++ivx) { +#line 11156 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11157 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11158 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11158 "" + errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"\ + "ber here!", (ftnlen)128, (ftnlen)37); +#line 11160 "" + stop1_(); +#line 11161 "" + } +#line 11162 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11163 "" + commvel_1.midivel[ivx - 1] = i_nint(&fnum) - 1; +#line 11164 "" + if (commvel_1.midivel[ivx - 1] < 0 || commvel_1.midivel[ivx - 1] + > 127) { +#line 11165 "" + i__3 = *iccount - 1; +#line 11165 "" + i__4 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11165 "" + errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"\ + " 1-128!", (ftnlen)128, (ftnlen)37); +#line 11167 "" + stop1_(); +#line 11168 "" + } +#line 11169 "" + if (*(unsigned char *)durq != ':') { +#line 11169 "" + --(*iccount); +#line 11169 "" + } +#line 11170 "" +/* L7: */ +#line 11170 "" + } +#line 11171 "" + goto L1; +#line 11172 "" + } 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 11178 "" + i__1 = *noinstarg; +#line 11178 "" + for (ivx = 1; ivx <= i__1; ++ivx) { +#line 11179 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11180 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11181 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11181 "" + errmsg_(lineq, iccount, &i__3, "Expected a balance number he"\ + "re!", (ftnlen)128, (ftnlen)31); +#line 11183 "" + stop1_(); +#line 11184 "" + } +#line 11185 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11186 "" + commvel_1.midibal[ivx - 1] = i_nint(&fnum) - 1; +#line 11187 "" + if (commvel_1.midibal[ivx - 1] < 0 || commvel_1.midibal[ivx - 1] + > 127) { +#line 11188 "" + i__3 = *iccount - 1; +#line 11188 "" + i__4 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11188 "" + errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "\ + "1-128!", (ftnlen)128, (ftnlen)36); +#line 11190 "" + stop1_(); +#line 11191 "" + } +#line 11192 "" + if (*(unsigned char *)durq != ':') { +#line 11192 "" + --(*iccount); +#line 11192 "" + } +#line 11193 "" +/* L8: */ +#line 11193 "" + } +#line 11194 "" + goto L1; +#line 11195 "" + } 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 11201 "" + i__1 = *noinstarg; +#line 11201 "" + for (ivx = 1; ivx <= i__1; ++ivx) { +#line 11202 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11203 "" + ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1); +#line 11204 "" + if (ipm == 0) { +#line 11205 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11205 "" + errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "\ + "midi transposition here!", (ftnlen)128, (ftnlen)48); +#line 11207 "" + stop1_(); +#line 11208 "" + } +#line 11209 "" + ipm = (ipm << 1) - 3; +#line 11210 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11211 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11212 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11212 "" + errmsg_(lineq, iccount, &i__3, "Expected a number here!", ( + ftnlen)128, (ftnlen)23); +#line 11214 "" + stop1_(); +#line 11215 "" + } +#line 11216 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11217 "" + commvel_1.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 11223 "" + --(*iccount); +#line 11224 "" +/* L9: */ +#line 11224 "" + } +#line 11225 "" + goto L1; +#line 11226 "" + } else if (*(unsigned char *)durq == 'g') { +#line 11227 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11228 "" + if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) { +#line 11229 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11229 "" + errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\ + " midi gap!", (ftnlen)128, (ftnlen)42); +#line 11231 "" + stop1_(); +#line 11232 "" + } +#line 11233 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11234 "" + commidi_1.mgap = i_nint(&fnum); +#line 11235 "" + --(*iccount); +#line 11236 "" + goto L1; +#line 11237 "" + } else if (*(unsigned char *)durq == 'M') { + +/* MidiMacros */ + +#line 11241 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11242 "" + if (*(unsigned char *)durq == 'R') { + +/* Start recording */ + +#line 11246 "" + if (commmac_1.mmacrec) { +#line 11247 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11247 "" + errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"\ + "cro while already recording!", (ftnlen)128, (ftnlen) + 56); +#line 11249 "" + stop1_(); +#line 11250 "" + } +#line 11251 "" + commmac_1.mmacrec = TRUE_; +#line 11252 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11253 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11254 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11254 "" + errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ + " here!", (ftnlen)128, (ftnlen)34); +#line 11256 "" + stop1_(); +#line 11257 "" + } +#line 11258 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11259 "" + --(*iccount); +#line 11260 "" + if (! (*first)) { +#line 11261 "" + commmac_1.immac = i_nint(&fnum); +#line 11262 "" + if (commmac_1.immac > 20) { +#line 11263 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11263 "" + errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"\ + "ed 20!", (ftnlen)128, (ftnlen)30); +#line 11265 "" + stop1_(); +#line 11266 "" + } + +/* Save the start time */ + +#line 11270 "" + commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime; +#line 11271 "" + i__1 = commidi_1.numchan; +#line 11271 "" + for (icm = 0; icm <= i__1; ++icm) { +#line 11272 "" + if (icm < commidi_1.numchan) { +#line 11273 "" + if (commidi_1.restpend[icm]) { + +/* Adjust if there's a rest at end of prior section. Insert dummy turnoff. */ +/* (This causes two turn-offs in a row, which testmidi sees as an error). */ + +/* Before: section1 ------rest------- section2(to be recorded) */ +/* After: section1 rest1 now rest2 section2(recorded) */ + +#line 11281 "" + addmidi_(&icm, &c__30, &c__0, &c__0, & + commidi_1.trest[icm], &c_false, &c_true); +#line 11282 "" + commidi_1.trest[icm] = 0.f; +#line 11283 "" + commidi_1.restpend[icm] = FALSE_; +#line 11284 "" + } +#line 11285 "" + } else { +#line 11286 "" + if (comevent_1.miditime > comevent_1.lasttime) { + +/* Insert a dummy turnoff in conductor track */ + +#line 11290 "" + r__1 = (comevent_1.miditime - comevent_1.lasttime) + / 15.f; +#line 11290 "" + addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & + c_false, &c_true); +#line 11292 "" + comevent_1.lasttime = comevent_1.miditime; +#line 11293 "" + } +#line 11294 "" + } +#line 11295 "" + commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] = + commidi_1.imidi[icm] + 1; +#line 11296 "" +/* L4: */ +#line 11296 "" + } +#line 11297 "" + } +#line 11298 "" + goto L1; +#line 11299 "" + } else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) { + +/* End recording; close the open macro. Get immac from common. */ + +#line 11303 "" + if (! commmac_1.mmacrec) { +#line 11304 "" + i__1 = *iccount - 1; +#line 11304 "" + i__3 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11304 "" + errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"\ + "efore starting one!", (ftnlen)128, (ftnlen)49); +#line 11306 "" + stop1_(); +#line 11307 "" + } +#line 11308 "" + commmac_1.mmacrec = FALSE_; +#line 11309 "" + --(*iccount); +#line 11310 "" + if (! (*first)) { + +/* Save the macro duration */ + +#line 11314 "" + commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime + - commmac_1.mmactime[commmac_1.immac - 1]; +#line 11315 "" + i__1 = commidi_1.numchan; +#line 11315 "" + for (icm = 0; icm <= i__1; ++icm) { +#line 11316 "" + if (icm < commidi_1.numchan) { +#line 11317 "" + if (commidi_1.restpend[icm]) { +#line 11318 "" + addmidi_(&icm, &c__30, &c__0, &c__0, & + commidi_1.trest[icm], &c_false, &c_true); +#line 11319 "" + commidi_1.trest[icm] = 0.f; +#line 11320 "" + commidi_1.restpend[icm] = FALSE_; +#line 11321 "" + } +#line 11322 "" + } else { +#line 11323 "" + if (comevent_1.miditime > comevent_1.lasttime) { + +/* Insert a dummy turnoff in conductor track if needed. */ + +#line 11327 "" + r__1 = (comevent_1.miditime - comevent_1.lasttime) + / 15.f; +#line 11327 "" + addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & + c_false, &c_true); +#line 11329 "" + comevent_1.lasttime = comevent_1.miditime; +#line 11330 "" + } +#line 11331 "" + } +#line 11332 "" + commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] = + commidi_1.imidi[icm]; +#line 11333 "" +/* L5: */ +#line 11333 "" + } +#line 11334 "" + } +#line 11335 "" + if (*(unsigned char *)durq != ' ') { +#line 11335 "" + goto L1; +#line 11335 "" + } +#line 11336 "" + } else if (*(unsigned char *)durq == 'P') { + +/* Play Back a Macro */ + +#line 11340 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11341 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 11342 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11342 "" + errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\ + " here!", (ftnlen)128, (ftnlen)34); +#line 11344 "" + stop1_(); +#line 11345 "" + } +#line 11346 "" + if (commmac_1.mmacrec) { +#line 11347 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11347 "" + errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"\ + "o before ending recording!", (ftnlen)128, (ftnlen)54); +#line 11349 "" + stop1_(); +#line 11350 "" + } +#line 11351 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 11352 "" + --(*iccount); +#line 11353 "" + if (! (*first)) { +#line 11354 "" + commmac_1.immac = i_nint(&fnum); +#line 11355 "" + if (commmac_1.mmactime[commmac_1.immac - 1] == 0) { +#line 11356 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11356 "" + errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"\ + " before recording it!", (ftnlen)128, (ftnlen)45); +#line 11358 "" + stop1_(); +#line 11359 "" + } +#line 11360 "" + i__1 = commidi_1.numchan; +#line 11360 "" + for (icm = 0; icm <= i__1; ++icm) { +#line 11361 "" + if (icm < commidi_1.numchan) { +#line 11362 "" + if (commidi_1.restpend[icm]) { +#line 11363 "" + addmidi_(&icm, &c__30, &c__0, &c__0, & + commidi_1.trest[icm], &c_false, &c_true); +#line 11364 "" + commidi_1.trest[icm] = 0.f; +#line 11365 "" + commidi_1.restpend[icm] = FALSE_; +#line 11366 "" + } +#line 11367 "" + } else { +#line 11368 "" + if (comevent_1.miditime > comevent_1.lasttime) { + +/* Insert a dummy turnoff in conductor track */ + +#line 11372 "" + r__1 = (comevent_1.miditime - comevent_1.lasttime) + / 15.f; +#line 11372 "" + addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, & + c_false, &c_true); +#line 11374 "" + } +#line 11375 "" + } +#line 11376 "" + commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] = + commidi_1.imidi[icm]; +#line 11377 "" + commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 - + 25] = commmac_1.mmacstrt[icm + commmac_1.immac * + 25 - 25]; +#line 11378 "" + commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25] + = commmac_1.mmacend[icm + commmac_1.immac * 25 - + 25]; +#line 11379 "" + commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 - + 25] = commidi_1.imidi[icm] + 1; +#line 11380 "" +/* L6: */ +#line 11380 "" + } +#line 11381 "" + commmac_1.nmidsec += 2; + +/* Update running time */ + +#line 11385 "" + comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1] + ; +#line 11386 "" + comevent_1.lasttime = comevent_1.miditime; +#line 11387 "" + } +#line 11388 "" + goto L1; +#line 11389 "" + } else { +#line 11390 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11390 "" + errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"\ + "ub-command!", (ftnlen)128, (ftnlen)43); +#line 11392 "" + stop1_(); +#line 11393 "" + } +#line 11394 "" + } else if (*(unsigned char *)durq == 'd') { +#line 11395 "" + commidi_1.debugmidi = TRUE_; +#line 11396 "" + goto L1; +#line 11397 "" + } else if (*(unsigned char *)durq != ' ') { +#line 11398 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 11398 "" + errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!" + , (ftnlen)128, (ftnlen)37); +#line 11400 "" + s_wsfe(&io___723); +#line 11400 "" + 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 11400 "" + e_wsfe(); +#line 11403 "" + s_wsfe(&io___724); +#line 11403 "" + 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 11403 "" + e_wsfe(); +#line 11406 "" + stop1_(); +#line 11407 "" + } +#line 11408 "" + if (! commmac_1.gottempo && ! (*first)) { + +/* If no tempo is set on first call on the pmxb pass, then set it */ + +#line 11412 "" + midievent_("t", &c__96, &c__0, (ftnlen)1); +#line 11413 "" + commmac_1.gottempo = TRUE_; +#line 11414 "" + } +#line 11415 "" + return 0; +} /* getmidi_ */ + +/* Subroutine */ int getnote_(logical *loop) +{ + /* System generated locals */ + address a__1[5], a__2[2], a__3[3], a__4[6], a__5[8], a__6[13]; + integer i__1, i__2, i__3, i__4[5], i__5[2], i__6[3], i__7[6], i__8[8], + i__9[13]; + real r__1; + char ch__1[1], ch__2[12], ch__3[10], ch__4[13], ch__5[1], ch__6[69], + ch__7[22], ch__8[21], ch__9[20], ch__10[11], ch__11[3], ch__12[9], + ch__13[61], ch__14[8], ch__15[82], ch__16[83], ch__17[62], + ch__18[122], ch__19[15], ch__20[59], ch__21[70], ch__22[36]; + icilist ici__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio( + integer *, char *, ftnlen), e_wsfe(void); + double r_mod(real *, real *); + integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio( + integer *, integer *, char *, ftnlen), e_wsle(void), i_nint(real * + ), lbit_shift(integer, integer); + /* Subroutine */ int s_stop(char *, ftnlen); + double log(doublereal); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_rsfi(icilist *), e_rsfi(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), e_wsfi(void); + + /* Local variables */ + static integer lentemp; + extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, + ftnlen), getgrace_(integer *, integer *, char *, integer *, + integer *, integer *, integer *, integer *, integer *, integer *, + integer *, ftnlen); + extern integer igetbits_(integer *, integer *, integer *); + static integer idotform; + extern /* Subroutine */ int newvoice_(integer *, char *, logical *, + ftnlen), dopmxlyr_(char *, integer *, ftnlen); + static integer j; + 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 real dum; + static integer iis, npg1, num1, iadj, nadj, lclf; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static logical cdot; + static integer nole, ioct; + static real fnum; + static char dotq[1], durq[1], dumq[1]; + extern /* Subroutine */ int getx_(char *, integer *, integer *, logical *, + real *, integer *, integer *, integer *, integer *, integer *, + integer *, integer *, char *, integer *, ftnlen, ftnlen); + static integer itup, nnnl, ntup, ndxm, nfig1; + extern /* Subroutine */ int mrec1_(char *, integer *, integer *, ftnlen); + static integer ipg1r; + extern /* Subroutine */ int stop1_(void); + static integer lhead; + static char charq[1], lineq[128]; + static logical moved; + static integer ndoub; + static char tempq[24]; + extern /* Subroutine */ int sslur_(char *, integer *, integer *, integer * + , integer *, integer *, integer *, integer *, integer *, logical * + , integer *, char *, ftnlen, ftnlen); + static integer ifnum, nvold, iinow, iinst; + extern /* Subroutine */ int getitransinfo_(logical *, integer *, char *, + integer *, integer *, integer *, integer *, ftnlen); + static logical quoted; + static char lineqt[128], hdlndq[59]; + extern integer lenstr_(char *, integer *, ftnlen); + static integer numnum; + extern /* Subroutine */ int getorn_(char *, integer *, integer *, integer + *, logical *, integer *, integer *, integer *, logical *, logical + *, integer *, ftnlen); + static integer nnlivx; + extern /* Subroutine */ int littex_(integer *, integer *, integer *, + logical *, char *, integer *, ftnlen), getfig_(integer *, char *, + char *, integer *, logical *, integer *, integer *, integer *, + char *, integer *, integer *, integer *, ftnlen, ftnlen, ftnlen); + static integer nactmp; + extern /* Subroutine */ int getdyn_(integer *, integer *, integer *, + integer *, char *, integer *, ftnlen); + static integer nodurt; + extern integer ncmidf_(char *, ftnlen); + static integer nnliiv, ictemp; + extern /* Subroutine */ int getbuf_(char *, ftnlen), printl_(char *, + ftnlen); + static integer ibaroff, lenbeat; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), getmidi_(integer *, char *, integer *, integer *, + integer *, integer *, integer *, integer *, logical *, ftnlen), + readnum_(char *, integer *, char *, real *, ftnlen, ftnlen); + static integer iofforn; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *), chkpm4ac_(char *, integer *, integer *, logical *, + ftnlen); + static integer numshft; + static real xofforn; + extern integer ifnolev_(char *, integer *, integer *, ftnlen), ifnodur_( + integer *, char *, 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 integer lvoltxt, ltopnam, namstrt; + static real tintstf; + + /* Fortran I/O blocks */ + static cilist io___728 = { 0, 11, 0, "(a)", 0 }; + static cilist io___736 = { 0, 6, 0, 0, 0 }; + static cilist io___750 = { 0, 6, 0, 0, 0 }; + static cilist io___751 = { 0, 6, 0, 0, 0 }; + static cilist io___762 = { 0, 6, 0, 0, 0 }; + static cilist io___766 = { 0, 6, 0, 0, 0 }; + static cilist io___767 = { 0, 6, 0, 0, 0 }; + static cilist io___770 = { 0, 6, 0, 0, 0 }; + static cilist io___775 = { 0, 11, 0, "(a)", 0 }; + static cilist io___776 = { 0, 11, 0, "(a)", 0 }; + static cilist io___779 = { 0, 11, 0, "(a)", 0 }; + static cilist io___780 = { 0, 11, 0, "(a)", 0 }; + static cilist io___781 = { 0, 11, 0, "(a)", 0 }; + static cilist io___782 = { 0, 11, 0, "(a)", 0 }; + static cilist io___783 = { 0, 11, 0, "(a)", 0 }; + static cilist io___784 = { 0, 11, 0, "(a11,i2,a)", 0 }; + static cilist io___785 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___787 = { 0, 11, 0, "(a8,i1,a3)", 0 }; + static cilist io___788 = { 0, 11, 0, "(a9,i2,a4)", 0 }; + static cilist io___789 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___790 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___791 = { 0, 6, 0, 0, 0 }; + static cilist io___792 = { 0, 6, 0, 0, 0 }; + static cilist io___801 = { 0, 6, 0, 0, 0 }; + static cilist io___803 = { 0, 11, 0, "(a)", 0 }; + static cilist io___804 = { 0, 11, 0, "(a)", 0 }; + static cilist io___805 = { 0, 11, 0, "(a)", 0 }; + static cilist io___806 = { 0, 11, 0, "(a)", 0 }; + static cilist io___808 = { 0, 11, 0, "(a)", 0 }; + static cilist io___811 = { 0, 11, 0, "(a)", 0 }; + static cilist io___812 = { 0, 11, 0, "(a)", 0 }; + static cilist io___813 = { 0, 11, 0, "(a)", 0 }; + static cilist io___814 = { 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___818 = { 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 11534 "" + cdot = FALSE_; +#line 11535 "" +L1: +#line 11535 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 11536 "" + if (comget_1.lastchar) { +#line 11536 "" + return 0; +#line 11536 "" + } +#line 11537 "" + if (*(unsigned char *)charq == ' ') { +#line 11537 "" + goto L1; +#line 11537 "" + } +#line 11538 "" + if (*(unsigned char *)charq == '%') { + +/* Check for a bar number format: */ + +#line 11542 "" + if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' && + i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0) + { +#line 11544 "" + if (comlast_1.islast) { +#line 11544 "" + s_wsfe(&io___728); +#line 11544 "" + do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128)); +#line 11544 "" + e_wsfe(); +#line 11544 "" + } +#line 11545 "" + } +#line 11546 "" + all_1.iccount = 128; +#line 11547 "" + goto L1; +#line 11548 "" + } + +/* Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */ + +#line 11552 "" + if (comget_1.rptprev) { +#line 11553 "" + comget_1.rptnd1 = *(unsigned char *)charq == '/'; +#line 11554 "" + comget_1.rptprev = FALSE_; +#line 11555 "" + } + +/* Repeat at end of a piece */ + +#line 11559 "" + if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *( + unsigned char *)charq == 'r') { +#line 11561 "" + if (cdot) { +#line 11561 "" + goto L28; +#line 11561 "" + } + +/* This is a note/rest. */ + +#line 11565 "" + idotform = 0; +#line 11566 "" + numnum = 0; + +/* If start of line of music, set pitch from previous */ + +#line 11570 "" + if (commvl_1.ivx <= all_1.nv) { +#line 11571 "" + kv = 1; +#line 11572 "" + } else { +#line 11573 "" + kv = 2; +#line 11574 "" + } +#line 11575 "" + if (all_1.nnl[commvl_1.ivx - 1] == 0) { +#line 11575 "" + comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25]; +#line 11575 "" + } + +/* notcrd is used to tell if orn. goes on main note or chord note */ + +/* notcrd = .true. !Move dow. Was not observed if dotted shortcut. */ + +/* Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */ + +#line 11583 "" +L28: + +/* Moved this from just above, 2 Feb 02 */ + +#line 11587 "" + comnotes_1.notcrd = TRUE_; +#line 11588 "" + ++all_1.nnl[commvl_1.ivx - 1]; +#line 11589 "" + if (comget_1.ornrpt) { + +/* Replicate ornament bits, also bit 23 for beam handling if chord. */ + +#line 11593 "" + all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] + |= all_1.iornq[commvl_1.ivx - 1]; +#line 11594 "" + 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 11598 "" + ++comtrill_1.ntrill; +#line 11599 "" + comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; +#line 11600 "" + comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ + commvl_1.ivx - 1]; +#line 11601 "" + comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[ + comtrill_1.ntrill - 2]; +#line 11602 "" + } +#line 11603 "" + } +#line 11604 "" + if (comget_1.stickys) { + +/* Grab stemlength shortening parameters from prior note */ + +#line 11608 "" + 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 11609 "" + i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25], &c__3, &c__28); +#line 11609 "" + setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25], &c__3, &c__28, &i__1); +#line 11611 "" + } +#line 11612 "" + if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && ! + comget_1.fbon) { + +/* Doing auto forced beams, and period has been set, so check if this note */ +/* starts a period. */ + +/* if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */ +#line 11618 "" + r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; +#line 11618 "" + if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { + +/* Start a forced beam here */ + +#line 11622 "" + ++comfb_1.nfb[commvl_1.ivx - 1]; +#line 11623 "" + comget_1.fbon = TRUE_; +#line 11624 "" + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = 'x'; +#line 11625 "" + comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * + 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 11626 "" + } +#line 11627 "" + } +#line 11628 "" + if (comget_1.fbon) { +#line 11628 "" + 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 11628 "" + } +#line 11629 "" + *(unsigned char *)dotq = 'x'; +#line 11630 "" + if (*(unsigned char *)charq == 'r') { +#line 11630 "" + 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 11630 "" + } +#line 11632 "" + 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 11636 "" + i__1 = all_1.iccount; +#line 11636 "" + if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1) + == 0 && all_1.nnl[commvl_1.ivx - 1] > 1) { +#line 11638 "" + if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25],19)) { +#line 11638 "" + 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 11638 "" + } +#line 11640 "" + } + +/* 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 11646 "" + if (commvl_1.ivx <= all_1.nv) { +#line 11647 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = 0; +#line 11648 "" + } else { +#line 11649 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = 2; +#line 11650 "" + } +#line 11651 "" + } +#line 11652 "" +L2: +#line 11652 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11653 "" + ic = *(unsigned char *)durq; +#line 11654 "" + if (ic <= 57 && ic >= 48) { + +/* Digit */ + +#line 11658 "" + if (numnum == 0) { +#line 11659 "" + comnotes_1.nnodur = ic - 48; +#line 11660 "" + numnum = 1; +#line 11661 "" + goto L2; +#line 11662 "" + } else if (numnum == 1) { +#line 11663 "" + ioct = ic - 48; +#line 11664 "" + numnum = 2; +#line 11665 "" + goto L2; +#line 11666 "" + } else { +#line 11667 "" + s_wsle(&io___736); +#line 11667 "" + do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", ( + ftnlen)31); +#line 11667 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( + integer)); +#line 11667 "" + do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( + ftnlen)sizeof(integer)); +#line 11667 "" + e_wsle(); +#line 11668 "" + stop1_(); +#line 11669 "" + } +#line 11670 "" + } else if (*(unsigned char *)durq == 'd') { +#line 11671 "" + *(unsigned char *)dotq = *(unsigned char *)durq; +#line 11672 "" + i__1 = all_1.iccount; +#line 11672 "" + if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1) + == 0) { + +/* Double dot. */ + +#line 11676 "" + ++all_1.iccount; +#line 11677 "" + 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 11678 "" + } +#line 11679 "" + i__1 = all_1.iccount; +#line 11679 "" + 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 11683 "" + i__1 = all_1.iccount + 1; +#line 11683 "" + if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, + all_1.iccount + 2 - i__1) == 0) { +#line 11683 "" + goto L2; +#line 11683 "" + } +#line 11685 "" + 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 11686 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11687 "" + ++comcc_1.ndotmv[commvl_1.ivx - 1]; +#line 11688 "" + ++all_1.iccount; +#line 11689 "" + 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 11690 "" + if (*(unsigned char *)durq == '-') { +#line 11690 "" + 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 11690 "" + } +#line 11692 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Vertical shift also */ + +#line 11696 "" + ++all_1.iccount; +#line 11697 "" + 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 11698 "" + if (*(unsigned char *)dumq == '-') { +#line 11698 "" + 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 11698 "" + } +#line 11700 "" + } else { +#line 11701 "" + comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx + - 1] * 24 - 25] = 0.f; +#line 11702 "" + } +#line 11703 "" + --all_1.iccount; +#line 11704 "" + } +#line 11705 "" + goto L2; +#line 11706 "" + } else if (*(unsigned char *)durq == 'p') { + +/* Full-bar rest as pause */ + +#line 11710 "" + 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 11711 "" + goto L2; +#line 11712 "" + } else if (*(unsigned char *)durq == 'b') { + +/* Blank rest */ + +#line 11716 "" + 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 11717 "" + goto L2; +#line 11718 "" + } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Accidental */ + +#line 11722 "" + if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] == 0) { + +/* No accidental has been set yet */ + +#line 11726 "" + all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = i_indx("fsn", durq, (ftnlen)3, (ftnlen)1); +#line 11727 "" + } else { + +/* Repeated accid, so must be double */ + +#line 11731 "" + 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 11732 "" + } +#line 11733 "" + goto L2; +#line 11734 "" + } else if (*(unsigned char *)durq == 'i') { + +/* Set flag for MIDI-only accidental. */ + +#line 11738 "" + 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 11739 "" + goto L2; +#line 11740 "" + } else if (*(unsigned char *)durq == 'c') { + +/* Set flags for cautionary accidental */ + +#line 11744 "" + 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 11745 "" + 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 11746 "" + goto L2; +#line 11747 "" + } else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { +#line 11748 "" + ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2; +#line 11749 "" + 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 11753 "" + chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, ( + ftnlen)128); +#line 11754 "" + if (moved) { +#line 11754 "" + goto L2; +#line 11754 "" + } + +/* Octave jump with a note */ + +#line 11758 "" + if (numnum < 2) { +#line 11759 "" + comnotes_1.lastlev += ipm * 7; +#line 11760 "" + } else { +#line 11761 "" + ioct += ipm; +#line 11762 "" + } +#line 11763 "" + goto L2; +#line 11764 "" + } else { + +/* Override default height of a rest */ + +#line 11768 "" + ++all_1.iccount; +#line 11769 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 11770 "" + i__1 = all_1.iccount - 2; +#line 11770 "" + if (s_cmp(lineq + i__1, ".", all_1.iccount - 1 - i__1, ( + ftnlen)1) == 0) { + +/* Kluge in case there is a shortcut ".". It will have been sucked up by */ +/* readnum. (Same doesn't hold for ",") */ + +#line 11775 "" + all_1.iccount += -2; +#line 11776 "" + goto L2; +#line 11777 "" + } +#line 11778 "" + 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 11782 "" + --all_1.iccount; +#line 11783 "" + goto L2; +#line 11784 "" + } +#line 11785 "" + } else if (*(unsigned char *)durq == 'x') { + +/* Xtuplet. Count number of doubled notes (for unequal xtups) */ + +#line 11789 "" + if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25],18)) { +#line 11790 "" + ndoub = 1; +#line 11791 "" + } else { +#line 11792 "" + ndoub = 0; +#line 11793 "" + } + +/* Will set all durations to 0 except last one. Set flag on this note. */ + +#line 11797 "" + 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 */ + +#line 11801 "" + ++all_1.iccount; +#line 11802 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 11803 "" + ntup = i_nint(&fnum); +#line 11804 "" + 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 11809 "" + 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 11810 "" + if (*(unsigned char *)durq == 'F') { +#line 11810 "" + 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 11810 "" + } +#line 11812 "" + ndoub = 1; +#line 11813 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11814 "" + } else if (*(unsigned char *)durq == 'd') { +#line 11815 "" + 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 11816 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 11817 "" + } + +/* Only other possibilities here are ' ' or 'n' */ + +#line 11821 "" + if (*(unsigned char *)durq == 'n') { + +/* Alter xtup number */ + +#line 11825 "" + i__1 = all_1.iccount; +#line 11825 "" + 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 11829 "" + 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 11830 "" + } else { +#line 11831 "" + numshft = 0; +#line 11832 "" +L30: +#line 11832 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 11833 "" + if (*(unsigned char *)durq == 'f') { + +/* Flip up-down-ness */ + +#line 11837 "" + 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 11838 "" + goto L30; +#line 11839 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Vertical or horiz shift */ + +#line 11843 "" + ++numshft; +#line 11844 "" + iofforn = 1; +#line 11845 "" + if (*(unsigned char *)durq == '-') { +#line 11845 "" + iofforn = -1; +#line 11845 "" + } +#line 11846 "" + ++all_1.iccount; +#line 11847 "" + readnum_(lineq, &all_1.iccount, durq, &xofforn, ( + ftnlen)128, (ftnlen)1); +#line 11848 "" + --all_1.iccount; +#line 11849 "" + if (numshft == 1) { + +/* Vertical shift */ + +#line 11853 "" + iofforn = iofforn * i_nint(&xofforn) + 16; + +/* Turn on bit 1; set bits 2-6 to iofforn */ + +#line 11857 "" + all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25] |= (iofforn << 2) + 2; +#line 11859 "" + } else { + +/* Horizontal shift */ + +#line 11863 "" + r__1 = xofforn * 10; +#line 11863 "" + iofforn = iofforn * i_nint(&r__1) + 16; +#line 11864 "" + 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 11865 "" + setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25], &c__5, & + c__9, &iofforn); +#line 11866 "" + } +#line 11867 "" + goto L30; +#line 11868 "" + } else if (*(unsigned char *)durq == 's') { + +/* Slope adjustment for bracket */ + +#line 11872 "" + 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 11873 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 11874 "" + iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - + 2; +#line 11875 "" + ++all_1.iccount; +#line 11876 "" + readnum_(lineq, &all_1.iccount, durq, &xofforn, ( + ftnlen)128, (ftnlen)1); +#line 11877 "" + --all_1.iccount; +#line 11878 "" + r__1 = iofforn * xofforn + 16; +#line 11878 "" + iofforn = i_nint(&r__1); +#line 11879 "" + setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, & + iofforn); +#line 11880 "" + } else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) + > 0) { + +/* Replacement printed number */ + +#line 11884 "" + readnum_(lineq, &all_1.iccount, durq, &xofforn, ( + ftnlen)128, (ftnlen)1); +#line 11885 "" + i__1 = i_nint(&xofforn); +#line 11885 "" + setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, & + i__1); +#line 11886 "" + --all_1.iccount; +#line 11887 "" + goto L30; +#line 11888 "" + } +#line 11889 "" + } +#line 11890 "" + } + +/* Set note level of 1st note of xtup, provided not a rest */ + +#line 11894 "" + if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25],0)) { +#line 11895 "" + if (numnum == 2) { +#line 11896 "" + comnotes_1.lastlev = ifnolev_(charq, &ioct, & + cominsttrans_1.itransamt[cominsttrans_1.instno[ + all_1.iv - 1] - 1], (ftnlen)1); +#line 11897 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = comnotes_1.lastlev; +#line 11898 "" + } else { +#line 11899 "" + 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 11901 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = comnotes_1.lastlev; +#line 11902 "" + } +#line 11903 "" + } +#line 11904 "" + 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 11908 "" + setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & + c__7, &c__19, &comnotes_1.lastlev); +#line 11909 "" +/* L40: */ +#line 11909 "" + } +#line 11910 "" + numnum = 0; +#line 11911 "" + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] + = 0; +#line 11912 "" + i__1 = ntup; +#line 11912 "" + for (itup = 2; itup <= i__1; ++itup) { +#line 11913 "" + if (comget_1.ornrpt) { +#line 11914 "" + 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 11916 "" + 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 11920 "" + ++comtrill_1.ntrill; +#line 11921 "" + comtrill_1.ivtrill[comtrill_1.ntrill - 1] = + commvl_1.ivx; +#line 11922 "" + comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ + commvl_1.ivx - 1]; +#line 11923 "" + comtrill_1.xnsktr[comtrill_1.ntrill - 1] = + comtrill_1.xnsktr[comtrill_1.ntrill - 2]; +#line 11924 "" + } +#line 11925 "" + } +#line 11926 "" + ++all_1.nnl[commvl_1.ivx - 1]; +#line 11927 "" + if (comget_1.fbon) { +#line 11927 "" + 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 11927 "" + } +#line 11928 "" +L7: +#line 11928 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1) + ; +#line 11929 "" + if (*(unsigned char *)charq == ' ') { +#line 11930 "" + goto L7; +#line 11931 "" + } else if (*(unsigned char *)charq == '%') { +#line 11932 "" + all_1.iccount = 128; +#line 11933 "" + goto L7; +#line 11934 "" + } else if (*(unsigned char *)charq == 'o') { + +/* Ornament in xtuplet. "o" symbol must come AFTER the affected note */ + +#line 11938 "" + if (comnotes_1.notcrd) { +#line 11939 "" + nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25]; +#line 11940 "" + } else { +#line 11941 "" + nole = 127 & lbit_shift(comtrill_1.icrdat[ + comtrill_1.ncrd - 1], (ftnlen)-12); +#line 11942 "" + } +#line 11943 "" + i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 11943 "" + 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 11946 "" + goto L7; +#line 11947 "" + } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) + { +#line 11948 "" + nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 11949 "" + if (*(unsigned char *)charq == '(' || *(unsigned char *) + charq == '{') { + +/* Detected preslur in xtuplet loop, non-chord note */ + +#line 11953 "" + ++nnlivx; +#line 11954 "" + ++comnotes_1.npreslur; +#line 11955 "" + } +#line 11956 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0); +#line 11957 "" + if (*(unsigned char *)charq == 't') { +#line 11957 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = + bit_set(all_1.islur[commvl_1.ivx + nnlivx * + 24 - 25],1); +#line 11957 "" + } +#line 11959 "" + if (commvl_1.ivx <= all_1.nv) { +#line 11960 "" + kv = 1; +#line 11961 "" + } else { +#line 11962 "" + kv = 2; +#line 11963 "" + } +#line 11964 "" + if (comslur_1.fontslur) { +#line 11965 "" + 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 11967 "" + } else { +#line 11968 "" + 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 11970 "" + } +#line 11971 "" + goto L7; +#line 11972 "" + } else if (*(unsigned char *)charq == 'G') { + +/* Kluge to get grace in xtup at right location */ + +#line 11976 "" + --all_1.nnl[commvl_1.ivx - 1]; +#line 11977 "" + 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 11979 "" + ++all_1.nnl[commvl_1.ivx - 1]; +#line 11980 "" + goto L7; +#line 11981 "" + } else if (*(unsigned char *)charq == *(unsigned char *) + all_1.sq) { +#line 11982 "" + littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & + commvl_1.ivx, &comas3_1.topmods, lineq, & + all_1.iccount, (ftnlen)128); +#line 11983 "" + goto L7; +#line 11984 "" + } else if (*(unsigned char *)charq == '"') { +/* c */ +/* c pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ */ +/* c */ +/* do 90 i2nd = iccount+1 , 128 */ +/* if (lineq(i2nd:i2nd) .eq. '"') go to 91 */ +/* 90 continue */ +/* 91 continue */ +/* if (iccount .eq. 1) then */ +/* lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq */ +/* * //lineq(i2nd+1:128) */ +/* else */ +/* lineqt = lineq(1:iccount-1)//sq//'pmxlyr{' */ +/* * //lineq(iccount+1:i2nd-1)//'}'//sq */ +/* * //lineq(i2nd+1:128) */ +/* end if */ +/* lineq = lineqt */ +#line 12001 "" + dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 12002 "" + *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 12003 "" + littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], & + commvl_1.ivx, &comas3_1.topmods, lineq, & + all_1.iccount, (ftnlen)128); +#line 12004 "" + goto L7; +#line 12005 "" + } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, ( + ftnlen)1) > 0) { + +/* Figure. Must come AFTER the first note of xtup */ + +#line 12009 "" + ivf = 1; +#line 12010 "" + if (commvl_1.ivx > 1) { +#line 12011 "" + if (comfig_1.ivxfig2 == 0) { +#line 12012 "" + comfig_1.ivxfig2 = commvl_1.ivx; +#line 12013 "" + } else if (commvl_1.ivx != comfig_1.ivxfig2) { +#line 12014 "" + s_wsle(&io___750); +#line 12014 "" + e_wsle(); +#line 12015 "" + s_wsle(&io___751); +#line 12015 "" + do_lio(&c__9, &c__1, "Figures not allowed in >1 "\ + "voice above first", (ftnlen)43); +#line 12015 "" + e_wsle(); +#line 12016 "" + s_stop("", (ftnlen)0); +#line 12017 "" + } +#line 12018 "" + ivf = 2; +#line 12019 "" + } +#line 12020 "" + nfig1 = comfig_1.nfigs[ivf - 1] + 1; +#line 12021 "" + getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, + lineq, &all_1.iccount, &all_1.isfig[ivf + ( + all_1.nnl[commvl_1.ivx - 1] - 1 << 1) - 3], & + comfig_1.itfig[ivf + (nfig1 << 1) - 3], & + all_1.itsofar[commvl_1.ivx - 1], &c__0, + comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, & + comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], & + comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & + comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, ( + ftnlen)10); +/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 12026 "" + goto L7; +#line 12027 "" + } else if (*(unsigned char *)charq == 'X') { +/* Computing MAX */ +#line 12028 "" + i__2 = 1, i__3 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12028 "" + getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + + max(i__2,i__3) * 24 - 25], &comnotes_1.shifton, & + comask_1.wheadpt, &all_1.iornq[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 1], & + commvl_1.ivx, &all_1.irest[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], & + all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, & + comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, ( + ftnlen)1); +#line 12032 "" + goto L7; +#line 12033 "" + } else if (*(unsigned char *)charq == 'z') { + +/* Chord note in xtup. Goes with *prior* note. */ + +#line 12037 "" + comnotes_1.notcrd = FALSE_; +#line 12038 "" + ++comtrill_1.ncrd; +#line 12039 "" + 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 12040 "" + numnum = 0; +/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ +#line 12042 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[ + commvl_1.ivx - 1] - 1; +#line 12043 "" + i__2 = commvl_1.ivx % 16; +#line 12043 "" + setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, & + c__8, &i__2); +#line 12044 "" + if (commvl_1.ivx >= 16) { +#line 12044 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],28); +#line 12044 "" + } +#line 12045 "" + comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; + +/* Get note name */ + +#line 12049 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, ( + ftnlen)1); + +/* Get optional inputs */ + +#line 12053 "" +L34: +#line 12053 "" + 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 12057 "" + ndx = i_indx("fsn+-<>12345678reic", durq, (ftnlen)19, ( + ftnlen)1); +#line 12058 "" + if (ndx > 0) { +#line 12059 "" + if (ndx <= 3) { +#line 12060 "" + if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd + - 1],19)) { +#line 12061 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],19); +#line 12062 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx + << 20; +#line 12063 "" + } else { +#line 12064 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = + bit_set(comtrill_1.icrdat[ + comtrill_1.ncrd - 1],22); +#line 12065 "" + } +#line 12066 "" + } else if (ndx == 19) { + +/* Set flags for cautionary accidental */ + +#line 12070 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],31) + ; +#line 12071 "" + 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 12073 "" + } else if (ndx <= 7) { + +/* +/-/</> Check whether octave or accidental shift */ + +#line 12077 "" + nactmp = 0; +#line 12078 "" + chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, + (ftnlen)128); +#line 12079 "" + if (moved) { + +/* Transfer accidental shift values */ + +#line 12083 "" + i__2 = igetbits_(&nactmp, &c__6, &c__4); +#line 12083 "" + setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - + 1], &c__6, &c__14, &i__2); +#line 12085 "" + i__2 = igetbits_(&nactmp, &c__7, &c__10); +#line 12085 "" + setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - + 1], &c__7, &c__20, &i__2); +#line 12087 "" + } else { +#line 12088 "" + if (*(unsigned char *)durq == '+') { +#line 12089 "" + comnotes_1.lastlev += 7; +#line 12090 "" + } else if (*(unsigned char *)durq == '-') { +#line 12091 "" + comnotes_1.lastlev += -7; +#line 12092 "" + } +#line 12093 "" + } +#line 12094 "" + } else if (*(unsigned char *)durq == 'e') { +#line 12095 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],23) + ; +#line 12096 "" + 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 12097 "" + } else if (*(unsigned char *)durq == 'r') { +#line 12098 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],24) + ; +#line 12099 "" + 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 12101 "" + } else if (*(unsigned char *)durq == 'i') { + +/* Midi-only accidental */ + +#line 12105 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],27) + ; +#line 12106 "" + } else { + +/* must be a number, save it in ioct */ + +#line 12110 "" + numnum = 1; +#line 12111 "" + ioct = ndx - 7; +#line 12112 "" + } +#line 12113 "" + goto L34; +#line 12114 "" + } +#line 12115 "" + if (numnum == 1) { +#line 12116 "" + comnotes_1.lastlev = ifnolev_(charq, &ioct, & + cominsttrans_1.itransamt[ + cominsttrans_1.instno[all_1.iv - 1] - 1], ( + ftnlen)1); +#line 12117 "" + } else { +#line 12118 "" + 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 12120 "" + } +#line 12121 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= + comnotes_1.lastlev << 12; +#line 12122 "" + 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 12126 "" + setbits_(&all_1.isdat2[all_1.nsdat - + comnotes_1.npreslur], &c__7, &c__19, & + comnotes_1.lastlev); + +/* Following lines copied from loop for non-xtup, chord note, preslur */ +/* Initially I assigned the slur(s) to next note, so fix. */ + +#line 12131 "" + 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 12132 "" + 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 12133 "" + all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = + bit_set(all_1.isdat2[all_1.nsdat - + comnotes_1.npreslur],0); +#line 12135 "" + i__2 = igetbits_(&all_1.isdat1[all_1.nsdat - + comnotes_1.npreslur], &c__8, &c__3) - 1; +#line 12135 "" + setbits_(&all_1.isdat1[all_1.nsdat - + comnotes_1.npreslur], &c__8, &c__3, &i__2); +#line 12137 "" +/* L41: */ +#line 12137 "" + } +#line 12138 "" + goto L7; +#line 12139 "" + } else if (*(unsigned char *)charq == '?') { + +/* Arpeggio */ + +#line 12143 "" + 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 12148 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],25); +#line 12149 "" + } else { +#line 12150 "" + 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 12151 "" + } + +/* Check for shift */ + +#line 12155 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 12156 "" + if (*(unsigned char *)durq == ' ') { +#line 12157 "" + --all_1.iccount; +#line 12158 "" + } else { + +/* durq must be "-" */ + +#line 12162 "" + ++all_1.iccount; +#line 12163 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 12164 "" + --all_1.iccount; + +/* record the shift */ + +#line 12168 "" + ++comarpshift_1.numarpshift; +#line 12169 "" + comarpshift_1.ivarpshift[comarpshift_1.numarpshift - + 1] = commvl_1.ivx; +#line 12170 "" + comarpshift_1.iparpshift[comarpshift_1.numarpshift - + 1] = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12171 "" + comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] + = fnum; +#line 12172 "" + } +#line 12173 "" + goto L7; +#line 12174 "" + } else if (*(unsigned char *)charq == 'D') { +#line 12175 "" + i__2 = all_1.nnl[commvl_1.ivx - 1] - 1; +#line 12175 "" + 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 12177 "" + goto L7; + +/* 140215 Allow clef change inside xtuplet. With normal code, came out one */ +/* note too late, so try making it come earlier. */ + +#line 12182 "" + } 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 12187 "" + if (all_1.nnl[all_1.iv - 1] - 1 > 0) { +#line 12187 "" + ++comcc_1.ncc[all_1.iv - 1]; +#line 12187 "" + } + +/* 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 12193 "" + nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 12194 "" + 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 12198 "" + isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[all_1.iv - + 1] * 24 - 25],11); +#line 12199 "" + 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 12203 "" + i__2 = numclef_(durq, (ftnlen)1); +#line 12203 "" + isl |= min(i__2,7) << 12; +#line 12204 "" + comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 + - 25] = ncmidf_(durq, (ftnlen)1); +#line 12205 "" + if (*(unsigned char *)durq == '8') { +#line 12206 "" + 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 12207 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[ + all_1.iv - 1] - 1] = 7; +#line 12208 "" + } + +/* Set marker on note with lowest voice # starting at same time. */ + +#line 12212 "" + if (all_1.iv == 1) { +#line 12213 "" + isl = bit_set(isl,15); +#line 12214 "" + } else { +#line 12215 "" + i__2 = all_1.iv; +#line 12215 "" + for (iiv = 1; iiv <= i__2; ++iiv) { +/* nnliiv = nnl(iiv) */ +#line 12217 "" + nnliiv = all_1.nnl[iiv - 1] - 1; +#line 12218 "" + if (iiv == all_1.iv) { +#line 12218 "" + ++nnliiv; +#line 12218 "" + } +#line 12219 "" + itother = 0; +#line 12220 "" + i__3 = nnliiv; +#line 12220 "" + for (iip = 1; iip <= i__3; ++iip) { +#line 12221 "" + if (itother < all_1.itsofar[all_1.iv - 1]) { +#line 12222 "" + itother += all_1.nodur[iiv + iip * 24 - + 25]; +#line 12223 "" + goto L71; +#line 12224 "" + } else if (itother == all_1.itsofar[all_1.iv + - 1]) { +#line 12225 "" + all_1.islur[iiv + iip * 24 - 25] = + bit_set(all_1.islur[iiv + iip * + 24 - 25],15); +#line 12226 "" + goto L72; +#line 12227 "" + } +#line 12228 "" +L71: +#line 12228 "" + ; +#line 12228 "" + } +#line 12229 "" +/* L70: */ +#line 12229 "" + } +#line 12230 "" +L72: +#line 12231 "" + ; +#line 12231 "" + } + +/* 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 12236 "" + 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 12237 "" + goto L7; +/* +++ */ +#line 12239 "" + } else if (*(unsigned char *)charq == ']') { + +/* Multiplicity up-down, must have '][ ' */ + +#line 12243 "" + 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 12244 "" + all_1.iccount += 2; +#line 12245 "" + goto L7; +/* c+++ */ +#line 12247 "" + } + +/* End of loop for xtup options. If here, charq must be a (non-crd) note name. */ +/* or rest */ + +#line 12252 "" + if (*(unsigned char *)charq == 'r') { + +/* Rest in xtup */ + +#line 12256 "" + 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 12257 "" + i__2 = all_1.iccount; +#line 12257 "" + if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount + + 1 - i__2) > 0) { +#line 12258 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 12259 "" + if (*(unsigned char *)durq == 'b') { + +/* Blank rest in middle of xtup */ + +#line 12263 "" + 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 12264 "" + } else { + +/* Override height of embedded xtup rest */ + +#line 12268 "" + ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - + 2; +#line 12269 "" + ++all_1.iccount; +#line 12270 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, ( + ftnlen)128, (ftnlen)1); +#line 12271 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25] = ipm * i_nint(&fnum) + + 100; +#line 12272 "" + --all_1.iccount; +#line 12273 "" + } +#line 12274 "" + } else if (commvl_1.ivx <= all_1.nv) { +#line 12275 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25] = 0; +#line 12276 "" + } else { +#line 12277 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25] = 2; +#line 12278 "" + } +#line 12279 "" + } +#line 12280 "" + comnotes_1.notcrd = TRUE_; +#line 12281 "" +L8: +#line 12281 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12282 "" + if (*(unsigned char *)durq != ' ') { +#line 12283 "" + if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) { + +/* Accidental horizontal shift */ + +#line 12287 "" + chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[ + commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25], &moved, (ftnlen)128); +#line 12288 "" + if (! moved) { +#line 12289 "" + if (*(unsigned char *)durq == '+') { +#line 12290 "" + comnotes_1.lastlev += 7; +#line 12291 "" + } else if (*(unsigned char *)durq == '-') { +#line 12292 "" + comnotes_1.lastlev += -7; +#line 12293 "" + } +#line 12294 "" + } +#line 12295 "" + } else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) + { +#line 12296 "" + if (all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25] == 0) { + +/* No accid set yet */ + +#line 12300 "" + all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx + - 1] * 24 - 25] = i_indx("fsn", durq, ( + ftnlen)3, (ftnlen)1); +#line 12301 "" + } else { + +/* Symbol must be repeated, so it's a double */ + +#line 12305 "" + 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 12306 "" + } +#line 12307 "" + } else if (*(unsigned char *)durq == 'i') { + +/* Set flag for midi-only accidental */ + +#line 12311 "" + 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 12313 "" + } else if (*(unsigned char *)durq == 'c') { + +/* Set flags for cautionary accidental */ + +#line 12317 "" + 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 12318 "" + 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 12319 "" + } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Force stem direction for non-beamed xtup note */ + +#line 12323 "" + 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 12324 "" + if (*(unsigned char *)durq == 'u') { +#line 12324 "" + 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 12324 "" + } +#line 12326 "" + } else if (*(unsigned char *)durq == 'e') { + +/* Left-shift main xtup note */ + +#line 12330 "" + 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 12331 "" + 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 12332 "" + } else if (*(unsigned char *)durq == 'r') { + +/* Right-shift main xtup note */ + +#line 12336 "" + 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 12337 "" + 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 12338 "" + } else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Double an xtup note to make an unequal xtup */ + +#line 12342 "" + 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 12343 "" + if (*(unsigned char *)durq == 'F') { +#line 12343 "" + 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 12343 "" + } +#line 12345 "" + ++ndoub; +#line 12346 "" + } else if (*(unsigned char *)durq == 'd') { + +/* Dotted xtup note */ + +#line 12350 "" + 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 12351 "" + } else { + +/* Must be an octave number */ + +#line 12355 "" + i__2 = *(unsigned char *)durq - 48; +#line 12355 "" + comnotes_1.lastlev = ifnolev_(charq, &i__2, & + cominsttrans_1.itransamt[ + cominsttrans_1.instno[all_1.iv - 1] - 1], ( + ftnlen)1); +#line 12357 "" + } +#line 12358 "" + goto L8; +#line 12359 "" + } +#line 12360 "" + if (itup < ntup) { + +/* Last note is handled *after* flowing out of the xtup if block, but still */ +/* within block for a note-rest. Set note level now (rest already done). */ +/* 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 12367 "" + if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[ + commvl_1.ivx - 1] * 24 - 25],0)) { +#line 12368 "" + 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 12370 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25] = comnotes_1.lastlev; +#line 12371 "" + } +#line 12372 "" + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25] = 0; +#line 12373 "" + for (comnotes_1.npreslur = comnotes_1.npreslur; + comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { + +/* Set note level for preslur on internal xtup note */ + +#line 12377 "" + setbits_(&all_1.isdat2[all_1.nsdat - + comnotes_1.npreslur], &c__7, &c__19, & + comnotes_1.lastlev); +#line 12378 "" +/* L42: */ +#line 12378 "" + } +#line 12379 "" + } +#line 12380 "" + if (itup == ntup - ndoub) { +#line 12380 "" + goto L12; +#line 12380 "" + } +#line 12381 "" +/* L6: */ +#line 12381 "" + } +#line 12382 "" +L12: +#line 12383 "" + if (comget_1.ornrpt) { +#line 12384 "" + 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 12386 "" + 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 12390 "" + ++comtrill_1.ntrill; +#line 12391 "" + comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx; +#line 12392 "" + comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[ + commvl_1.ivx - 1]; +#line 12393 "" + comtrill_1.xnsktr[comtrill_1.ntrill - 1] = + comtrill_1.xnsktr[comtrill_1.ntrill - 2]; +#line 12394 "" + } +#line 12395 "" + } + +/* End of if-block for xtuplet input */ + +#line 12399 "" + } 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 12404 "" + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] + = all_1.lenbar; +#line 12405 "" + comgrace_1.ibarmbr = all_1.nbars + 1; +#line 12406 "" + comgrace_1.mbrest = 0; +#line 12407 "" + comgrace_1.xb4mbr = 0.f; +#line 12408 "" +L20: +#line 12408 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12409 "" + if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) + { +#line 12410 "" + comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char * + )durq - 48; +#line 12411 "" + goto L20; +#line 12412 "" + } +#line 12413 "" + } else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Set stem flipper */ + +#line 12417 "" + 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 12418 "" + if (*(unsigned char *)durq == 'u') { +#line 12418 "" + 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 12418 "" + } +#line 12420 "" + goto L2; +#line 12421 "" + } else if (*(unsigned char *)durq == 'a') { + +/* "Alone", i.e., prohibit beam */ + +#line 12425 "" + 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 12426 "" + goto L2; +#line 12427 "" + } else if (*(unsigned char *)durq == 'r') { + +/* Right offset by one notehead */ + +#line 12431 "" + 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 12432 "" + 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 12433 "" + goto L2; +#line 12434 "" + } else if (*(unsigned char *)durq == 'e') { + +/* Left offset by one notehead */ + +#line 12438 "" + 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 12439 "" + 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 12440 "" + goto L2; +#line 12441 "" + } else if (*(unsigned char *)durq == 'S') { + +/* Stemlength change. Get -dstemlen in \internotes. Allowable values are .5 to 4 */ +/* Set mult(27). Map value to 0 to 7, store in mult(28-30). Later convert to */ +/* interbeams = internotes*2/3. */ + +#line 12447 "" + 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 12448 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12449 "" + if (*(unsigned char *)durq == ':') { + +/* End stickyS. Grab data now from prior note, since we have to shut off stickyS. */ + +#line 12453 "" + i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] - 1) * 24 - 25], &c__3, &c__28); +#line 12453 "" + setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25], &c__3, &c__28, &i__1); +#line 12455 "" + comget_1.stickys = FALSE_; +#line 12456 "" + goto L2; +#line 12457 "" + } + +/* If durq .ne. ':' then iccount is now on the start of the number */ + +#line 12461 "" + readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen) + 1); +#line 12462 "" + r__1 = (dum - .5f) * 2; +#line 12462 "" + i__1 = i_nint(&r__1); +#line 12462 "" + setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25], &c__3, &c__28, &i__1); +#line 12463 "" + if (*(unsigned char *)durq == ':') { +#line 12464 "" + comget_1.stickys = TRUE_; +#line 12465 "" + } else { +#line 12466 "" + --all_1.iccount; +#line 12467 "" + } +#line 12468 "" + goto L2; +#line 12469 "" + } else if (*(unsigned char *)durq == ',') { + +/* 2:1 pattern */ + +#line 12473 "" + idotform = 3; + +/* Now flow to duration setting, as if durq=' ' */ + +#line 12477 "" + } 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 12482 "" + idotform = 1; +#line 12483 "" + } else if (*(unsigned char *)durq == 'o') { + +/* Suppress rest centering */ + +#line 12487 "" + 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 12488 "" + goto L2; +#line 12489 "" + } else if (*(unsigned char *)durq == 'L') { + +/* With keyboard rest option, look left */ + +/* iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) */ +#line 12494 "" + 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 12495 "" + goto L2; +#line 12496 "" + } 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 12501 "" + 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 12502 "" + if (*(unsigned char *)durq == 'F') { +#line 12502 "" + 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 12502 "" + } +#line 12504 "" + goto L2; +#line 12505 "" + } else if (*(unsigned char *)durq == 'A') { + +/* Accidental option */ + +#line 12509 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +#line 12511 "" + if (*(unsigned char *)durq == 'o') { + +/* Ordered accidentals in a chord. Mark the main note. */ + +#line 12515 "" + 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 12516 "" + } else { + +/* Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */ + +#line 12520 "" + 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 12521 "" + --all_1.iccount; +#line 12522 "" + } +#line 12523 "" + goto L2; +#line 12524 "" + } else if (*(unsigned char *)durq != ' ') { +#line 12525 "" + s_wsle(&io___762); +#line 12525 "" + do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27); +#line 12525 "" + do_lio(&c__9, &c__1, durq, (ftnlen)1); +#line 12525 "" + do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9); +#line 12525 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( + integer)); +#line 12525 "" + do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], ( + ftnlen)sizeof(integer)); +#line 12525 "" + e_wsle(); +#line 12527 "" + stop1_(); +#line 12528 "" + } + +/* Done with note/rest options. Set level and duration. */ + +#line 12532 "" + if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] + * 24 - 25],0)) { +#line 12533 "" + if (numnum == 2) { +#line 12534 "" + comnotes_1.lastlev = ifnolev_(charq, &ioct, & + cominsttrans_1.itransamt[cominsttrans_1.instno[ + all_1.iv - 1] - 1], (ftnlen)1); +#line 12535 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = comnotes_1.lastlev; +#line 12536 "" + } else { +#line 12537 "" + 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 12539 "" + all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = comnotes_1.lastlev; +#line 12540 "" + } +#line 12541 "" + for (comnotes_1.npreslur = comnotes_1.npreslur; + comnotes_1.npreslur >= 1; --comnotes_1.npreslur) { + +/* Set level for preslur on normal note, non-chord */ + +#line 12545 "" + setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], & + c__7, &c__19, &comnotes_1.lastlev); +#line 12546 "" +/* L43: */ +#line 12546 "" + } +#line 12547 "" + } +#line 12548 "" + if (idotform > 0) { +#line 12549 "" + if (idotform == 1) { +#line 12550 "" + 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 12551 "" + } else if (idotform == 2) { +#line 12552 "" + 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 12553 "" + } else if (idotform == 3) { +#line 12554 "" + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - + 25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 12555 "" + } else if (idotform == 4) { +#line 12556 "" + 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 12557 "" + } +#line 12558 "" + } 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 12562 "" + 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 12566 "" + i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48; +#line 12566 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 12566 "" + comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, ( + ftnlen)1) - 1; +#line 12568 "" + } else if (comgrace_1.ibarmbr != all_1.nbars + 1) { +#line 12569 "" + all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] + = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1); +#line 12570 "" + if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - + 1] * 24 - 25],3)) { +#line 12570 "" + 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 12570 "" + } +#line 12572 "" + } +#line 12573 "" + 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 12577 "" + 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 12581 "" + 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 12582 "" + 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 12583 "" + ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 12584 "" + 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 12585 "" + } +#line 12586 "" + } +#line 12587 "" + all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 12588 "" + if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && + comget_1.fbon) { + +/* Check to see if need to terminate auto forced beam */ + +#line 12592 "" + r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb; +#line 12592 "" + if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) { + +/* Terminate autofb */ + +#line 12596 "" + comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * + 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 12597 "" + comget_1.fbon = FALSE_; +#line 12598 "" + } +#line 12599 "" + } +#line 12600 "" + if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar == + 0) { + +/* Finished a bar */ + +#line 12604 "" + ++all_1.nbars; +#line 12605 "" + all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[ + commvl_1.ivx - 1]; +#line 12606 "" + if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) { + +/* Just finished the pickup bar for this voice. */ + +#line 12610 "" + all_1.lenbar = all_1.lenb1; +#line 12611 "" + } +#line 12612 "" + } +#line 12613 "" + if (idotform == 1) { +#line 12614 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 12615 "" + idotform = 2; +#line 12616 "" + numnum = 1; +#line 12617 "" + goto L28; +#line 12618 "" + } else if (idotform == 3) { +#line 12619 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 12620 "" + idotform = 4; +#line 12621 "" + numnum = 1; +#line 12622 "" + goto L28; +#line 12623 "" + } + +/* End of sub block for note-rest */ + +#line 12627 "" + } else if (*(unsigned char *)charq == 'z') { + +/* Chord note. Must have note name, may have octave#,+,-,s,f,n,d */ +/* Actually the 'd' is not used, since time value comes from */ +/* basic note. Unless dot is to be shifted! */ +/* Doesn't increase # of notes, so must handle separately */ +/* ncrd: index of crd */ +/* Set bit 10 of ipl on main note as flag */ +/* Bits in icrdat: */ +/* 0-7 ip within voice */ +/* 8-11 ivx */ +/* 12-18 note level */ +/* 19 accidental? */ +/* 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) */ +/* 23 shift left */ +/* 24 shift right */ +/* 25 arpeggio start or stop */ +/* 26 flag for moved dot (here, not icrdot, since this is always reset!) */ +/* 27 Midi-only accidental */ +/* 29 Tag for accidental shift...means add to autoshifts. */ +/* 31 Cautionary accidental */ + +/* Bits in icrdot: */ +/* 0-6 10*abs(vertical dot shift in \internote) + 64 */ +/* 7-13 10*abs(horizontal dot shift in \internote) + 64 */ +/* 14-19 vert accidental shift-32 */ +/* 20-26 20*(horiz accidental shift+3.2) */ +/* 27-29 top-down level rank of chord note w/accid. Set in crdaccs. */ + +/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ + +#line 12658 "" + ++comtrill_1.ncrd; +#line 12659 "" + 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 12660 "" + numnum = 0; +/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */ +#line 12662 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1]; +#line 12663 "" + i__1 = commvl_1.ivx % 16; +#line 12663 "" + setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1) + ; +#line 12664 "" + if (commvl_1.ivx >= 16) { +#line 12664 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],28); +#line 12664 "" + } +#line 12665 "" + comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0; +#line 12666 "" + comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0; + +/* Get note name */ + +#line 12670 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); + +/* Get optional inputs */ + +#line 12674 "" +L25: +#line 12674 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +/* ndx = index('fsn+-<>12345678rediA',durq) */ +#line 12676 "" + ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1); +#line 12677 "" + if (ndx == 20) { + +/* Expect +|-|<|> , set tag, loop */ + +#line 12681 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],29); +#line 12682 "" + goto L25; +#line 12683 "" + } else if (ndx > 0) { +#line 12684 "" + if (ndx <= 3) { +#line 12685 "" + if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) { +#line 12686 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],19); +#line 12687 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20; +#line 12688 "" + } else { +#line 12689 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],22); +#line 12690 "" + } +#line 12691 "" + } else if (ndx == 21) { + +/* Set flags for cautionary accidental */ + +#line 12695 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],31); +#line 12696 "" + 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 12697 "" + } else if (ndx <= 7) { + +/* +/-/</> Check whether octave or accidental shift */ + +#line 12701 "" + nactmp = 0; +#line 12702 "" + chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128) + ; +#line 12703 "" + if (moved) { + +/* Transfer accidental shift values */ + +#line 12707 "" + i__1 = igetbits_(&nactmp, &c__6, &c__4); +#line 12707 "" + setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, & + c__14, &i__1); +#line 12708 "" + i__1 = igetbits_(&nactmp, &c__7, &c__10); +#line 12708 "" + setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, & + c__20, &i__1); +#line 12709 "" + } else { +#line 12710 "" + if (*(unsigned char *)durq == '+') { +#line 12711 "" + comnotes_1.lastlev += 7; +#line 12712 "" + } else if (*(unsigned char *)durq == '-') { +#line 12713 "" + comnotes_1.lastlev += -7; +#line 12714 "" + } +#line 12715 "" + } +#line 12716 "" + } else if (*(unsigned char *)durq == 'e') { +#line 12717 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],23); +#line 12718 "" + 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 12719 "" + } else if (*(unsigned char *)durq == 'r') { +#line 12720 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],24); +#line 12721 "" + 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 12722 "" + } else if (*(unsigned char *)durq == 'i') { + +/* Midi-only accidental on chord note */ + +#line 12726 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],27); +#line 12727 "" + } else if (*(unsigned char *)durq == 'd') { + +/* Must keep 'd' optional (backward compatibility), unless it is moved! */ + +#line 12731 "" + i__1 = all_1.iccount; +#line 12731 "" + 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 12735 "" + i__1 = all_1.iccount + 1; +#line 12735 "" + if (i_indx("0123456789.", lineq + i__1, (ftnlen)11, + all_1.iccount + 2 - i__1) == 0) { +#line 12735 "" + goto L25; +#line 12735 "" + } +#line 12737 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],26); +#line 12738 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 12739 "" + ++all_1.iccount; +#line 12740 "" + readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128, + (ftnlen)1); +#line 12741 "" + if (*(unsigned char *)durq == '+') { +#line 12742 "" + r__1 = fnum * 10; +#line 12742 "" + comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(& + r__1) + 64; +#line 12743 "" + } else { +#line 12744 "" + r__1 = fnum * 10; +#line 12744 "" + comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(& + r__1) + 64; +#line 12745 "" + } +#line 12746 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Vertical shift specified also */ + +#line 12750 "" + ++all_1.iccount; +#line 12751 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen) + 128, (ftnlen)1); +#line 12752 "" + if (*(unsigned char *)dumq == '+') { +#line 12753 "" + r__1 = fnum * 10; +#line 12753 "" + ifnum = i_nint(&r__1) + 64; +#line 12754 "" + } else { +#line 12755 "" + r__1 = fnum * 10; +#line 12755 "" + ifnum = -i_nint(&r__1) + 64; +#line 12756 "" + } +#line 12757 "" + } else { +#line 12758 "" + ifnum = 64; +#line 12759 "" + } +#line 12760 "" + comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7; +#line 12761 "" + --all_1.iccount; +#line 12762 "" + } +#line 12763 "" + } else { + +/* must be a single digit, save it in ioct */ + +#line 12767 "" + numnum = 1; +#line 12768 "" + ioct = ndx - 7; +#line 12769 "" + } +#line 12770 "" + goto L25; +#line 12771 "" + } +#line 12772 "" + if (numnum == 1) { +#line 12773 "" + comnotes_1.lastlev = ifnolev_(charq, &ioct, & + cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - + 1] - 1], (ftnlen)1); +#line 12774 "" + } else { +#line 12775 "" + 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 12777 "" + } +#line 12778 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12; +#line 12779 "" + for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >= + 1; --comnotes_1.npreslur) { +#line 12780 "" + 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 12785 "" + 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 12786 "" + 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 12787 "" + all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set( + all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0); +#line 12788 "" + i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], + &c__8, &c__3) - 1; +#line 12788 "" + setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8, + &c__3, &i__1); +#line 12790 "" +/* L44: */ +#line 12790 "" + } +#line 12791 "" + if (comnotes_1.notcrd) { + +/* This is the first chord note in this chord. */ + +/* Computing MIN */ +#line 12795 "" + i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25]; +#line 12795 "" + comtrill_1.minlev = min(i__1,comnotes_1.lastlev); +/* Computing MAX */ +#line 12796 "" + i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25]; +#line 12796 "" + comtrill_1.maxlev = max(i__1,comnotes_1.lastlev); +#line 12797 "" + } else { +#line 12798 "" + comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev); +#line 12799 "" + comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev); +#line 12800 "" + } +#line 12801 "" + comnotes_1.notcrd = FALSE_; +#line 12802 "" + } else if (*(unsigned char *)charq == 'G') { +#line 12803 "" + 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); + +/* Grace, comes *before* main note: */ +/* UNLESS there's an 'A' or 'W' after the 'G' */ +/* ngrace = # of grace note groups so far in block */ +/* ivg(ngrace), ipg(ngrace) */ +/* nng(ngrace) = # of notes in this group: default = 1 */ +/* ngstrt(ngrace) = starting position in nolevg of levels for this grace */ +/* multg(ngrace) = multiplicity: default = 1; input as 'm(digit)' */ +/* upg(ngrace) = logical for beam or stem dirn: default T, input'u,l' */ +/* slurg(ngrace) = logical for slur; default F, input 's' */ +/* slashg(ngrace) = T if slash; default is F, input 'x' */ +/* These data MUST precede note name of first note */ +/* nolevg, naccg: lists of levels and accid's, indexed as described above. */ + +#line 12819 "" + } else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) { + +/* Literal TeX string */ + +#line 12823 "" + i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 12823 "" + littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & + all_1.iccount, (ftnlen)128); +#line 12824 "" + } else if (*(unsigned char *)charq == '"') { + +/* pmxlyr string. Expand "..." to \pmxlyr{...}\ */ + +#line 12828 "" + if (! comlyr_1.inputmlyr) { +#line 12829 "" + ictemp = 0; +/* Writing concatenation */ +#line 12830 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 12830 "" + i__4[1] = 1, a__1[1] = all_1.sq; +#line 12830 "" + i__4[2] = 1, a__1[2] = all_1.sq; +#line 12830 "" + i__4[3] = 15, a__1[3] = "input musixlyr "; +#line 12830 "" + i__4[4] = 1, a__1[4] = all_1.sq; +#line 12830 "" + s_cat(lineqt, a__1, i__4, &c__5, (ftnlen)128); +#line 12831 "" + i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 12831 "" + littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, + lineqt, &ictemp, (ftnlen)128); +#line 12832 "" + comlyr_1.inputmlyr = TRUE_; +#line 12833 "" + } +#line 12834 "" + dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128); +#line 12835 "" + *(unsigned char *)charq = *(unsigned char *)all_1.sq; +#line 12836 "" + i__1 = all_1.nnl[commvl_1.ivx - 1] + 1; +#line 12836 "" + littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, & + all_1.iccount, (ftnlen)128); +#line 12837 "" + } else if (*(unsigned char *)charq == 'o') { + +/* Ornament on non-xtup note. Symbol must come AFTER the affected note */ + +#line 12841 "" + if (comnotes_1.notcrd) { +#line 12842 "" + nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * + 24 - 25]; +#line 12843 "" + } else { +#line 12844 "" + nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], ( + ftnlen)-12); +#line 12845 "" + } +#line 12846 "" + 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 12849 "" + } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) { +#line 12850 "" + nnlivx = all_1.nnl[commvl_1.ivx - 1]; +#line 12851 "" + if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{') + { + +/* Detect preslur on normal non-chord note */ + +#line 12855 "" + ++nnlivx; +#line 12856 "" + ++comnotes_1.npreslur; +#line 12857 "" + } +#line 12858 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[ + commvl_1.ivx + nnlivx * 24 - 25],0); +#line 12859 "" + if (*(unsigned char *)charq == 't') { +#line 12859 "" + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set( + all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1); +#line 12859 "" + } +#line 12861 "" + if (commvl_1.ivx <= all_1.nv) { +#line 12862 "" + kv = 1; +#line 12863 "" + } else { +#line 12864 "" + kv = 2; +#line 12865 "" + } +#line 12866 "" + if (comslur_1.fontslur) { +#line 12867 "" + 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 12869 "" + } else { +#line 12870 "" + 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 12872 "" + } +#line 12873 "" + } else if (*(unsigned char *)charq == '?') { + +/* Arpeggio */ + +#line 12877 "" + 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 12882 "" + comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set( + comtrill_1.icrdat[comtrill_1.ncrd - 1],25); +#line 12883 "" + } else { +#line 12884 "" + 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 12885 "" + } + +/* Check for shift */ + +#line 12889 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 12890 "" + if (*(unsigned char *)durq == ' ') { +#line 12891 "" + --all_1.iccount; +#line 12892 "" + } else { + +/* durq must be "-" */ + +#line 12896 "" + ++all_1.iccount; +#line 12897 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 12898 "" + --all_1.iccount; + +/* record the shift */ + +#line 12902 "" + ++comarpshift_1.numarpshift; +#line 12903 "" + comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] = + commvl_1.ivx; +#line 12904 "" + comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] = + all_1.nnl[commvl_1.ivx - 1]; +#line 12905 "" + comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum; +#line 12906 "" + } +#line 12907 "" + } 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 12912 "" + ivf = 1; +#line 12913 "" + if (commvl_1.ivx > 1) { +#line 12914 "" + if (comfig_1.ivxfig2 == 0) { +#line 12915 "" + comfig_1.ivxfig2 = commvl_1.ivx; +#line 12916 "" + } else if (commvl_1.ivx != comfig_1.ivxfig2) { +#line 12917 "" + s_wsle(&io___766); +#line 12917 "" + e_wsle(); +#line 12918 "" + s_wsle(&io___767); +#line 12918 "" + do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "\ + "first", (ftnlen)43); +#line 12918 "" + e_wsle(); +#line 12919 "" + s_stop("", (ftnlen)0); +#line 12920 "" + } +#line 12921 "" + ivf = 2; +#line 12922 "" + } +#line 12923 "" + nfig1 = comfig_1.nfigs[ivf - 1] + 1; +#line 12924 "" + getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, & + all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx - 1] + << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], & + all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], comfig_1.figq + (ivf + + (nfig1 << 1) - 3) * 10, &comfig_1.ivupfig[ivf + (nfig1 << 1) + - 3], &comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], & + comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10); +/* * ivupfig(ivf,nfig1),nfigs(ivf)) */ +#line 12929 "" + } else if (*(unsigned char *)charq == '[') { + +/* Start forced beam. Record barno & time since start of inp. blk. Set signal */ + +#line 12933 "" + ++comfb_1.nfb[commvl_1.ivx - 1]; +#line 12934 "" + comget_1.fbon = TRUE_; +#line 12935 "" + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = 'x'; +#line 12936 "" + comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] = + (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 12937 "" + nadj = 0; +#line 12938 "" + if (comfb_1.autofbon) { +#line 12939 "" + comfb_1.autofbon = FALSE_; +#line 12940 "" + } +#line 12941 "" +L17: +#line 12941 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 12942 "" + if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) { +#line 12943 "" + *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[ + commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq; +#line 12944 "" + goto L17; +#line 12945 "" + } else if (*(unsigned char *)charq == 'j') { + +/* Continuing a jumped beam here */ + +#line 12949 "" + all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 + - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[ + commvl_1.ivx - 1] + 1) * 24 - 25],24); + +/* Set flag to watch for END of this forced beam, so can set flag rest(30) on */ +/* NEXT note as signal to start a new notes group there. */ + +#line 12954 "" + combjmp_1.isbj2 = TRUE_; +#line 12955 "" + goto L17; +#line 12956 "" + } else if (*(unsigned char *)charq == 'h') { +#line 12957 "" + 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 12958 "" + goto L17; +#line 12959 "" + } else if (*(unsigned char *)charq == 'm') { + +/* Force multiplicity. Next input is digit */ + +#line 12963 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 12964 "" + 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 12965 "" + i__1 = *(unsigned char *)charq - 48; +#line 12965 "" + setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + + 1) * 24 - 25], &c__3, &c__22, &i__1); +#line 12966 "" + goto L17; +#line 12967 "" + } else if (*(unsigned char *)charq == ':') { + +/* Start auto forced beam pattern */ + +#line 12971 "" + comfb_1.autofbon = TRUE_; + +/* When forced later beam ends, check whether tautofv <=0; if so set it. */ + +#line 12975 "" + comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]); +#line 12976 "" + comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 12977 "" + goto L17; +#line 12978 "" + } else if (*(unsigned char *)charq != ' ') { + +/* Must be '+/-' for height or slope shift */ + +#line 12982 "" + ++nadj; + +/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */ + +#line 12986 "" + ++all_1.iccount; +#line 12987 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 12988 "" + --all_1.iccount; +#line 12989 "" + iadj = i_nint(&fnum); +#line 12990 "" + if (*(unsigned char *)charq == '-') { +#line 12990 "" + iadj = -iadj; +#line 12990 "" + } +#line 12991 "" + if (nadj == 1) { + +/* This is a level shift. Note if 0 was entered, iadj = 30 */ + +#line 12995 "" + i__1 = iadj + 30; +#line 12995 "" + setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - + 1] + 1) * 24 - 25], &c__6, &c__11, &i__1); +#line 12996 "" + } else if (nadj == 2) { + +/* Must be a slope shift */ + +#line 13000 "" + i__1 = iadj + 30; +#line 13000 "" + setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - + 1] + 1) * 24 - 25], &c__6, &c__17, &i__1); +#line 13001 "" + } else { + +/* Beam-thk fine tune */ + +#line 13005 "" + setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx + - 1] + 1) * 24 - 25], &c__2, &c__27, &iadj); +#line 13006 "" + } +#line 13007 "" + goto L17; +#line 13008 "" + } +#line 13009 "" + } else if (*(unsigned char *)charq == ']') { +#line 13010 "" + if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) { +#line 13011 "" + comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] + + comfb_1.tautofb; +#line 13012 "" + } +#line 13013 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13014 "" + if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */ + +#line 13018 "" + comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - + 25] = (real) all_1.itsofar[commvl_1.ivx - 1]; +#line 13019 "" + comget_1.fbon = FALSE_; +#line 13020 "" + if (*(unsigned char *)charq == 'j') { +#line 13020 "" + 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 13020 "" + } +#line 13022 "" + 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 13027 "" + if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) { +#line 13027 "" + 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 13027 "" + } +#line 13029 "" + combjmp_1.isbj2 = FALSE_; +#line 13030 "" + } +#line 13031 "" + } else if (*(unsigned char *)charq == '[') { + +/* Multiplicity down-up signal */ + +#line 13035 "" + 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 13036 "" + } else if (*(unsigned char *)charq == '-') { + +/* Set signals for gap in single-slope beam [...]-[...] */ + +#line 13040 "" + 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 13041 "" + 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 13045 "" + all_1.iccount += 2; +#line 13046 "" + } +#line 13047 "" + } else if (*(unsigned char *)charq == 'D') { +#line 13048 "" + 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 13050 "" + } 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 13055 "" + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 13056 "" + s_wsle(&io___770); +#line 13056 "" + do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block" + , (ftnlen)41); +#line 13056 "" + e_wsle(); +#line 13057 "" + stop1_(); +#line 13058 "" + } +#line 13059 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13060 "" + comhead_1.ihdvrt = 0; +#line 13061 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Vertical offset */ + +#line 13065 "" + ++all_1.iccount; +#line 13066 "" + readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 13067 "" + comhead_1.ihdvrt = fnum + .1f; +#line 13068 "" + if (*(unsigned char *)durq == '-') { +#line 13068 "" + comhead_1.ihdvrt = -comhead_1.ihdvrt; +#line 13068 "" + } +#line 13069 "" + *(unsigned char *)durq = *(unsigned char *)charq; +#line 13070 "" + } +#line 13071 "" + if (*(unsigned char *)durq != ' ') { + +/* Height symbol. Read past (until next blank) */ + +#line 13075 "" +L3: +#line 13075 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13076 "" + if (*(unsigned char *)durq != ' ') { +#line 13076 "" + goto L3; +#line 13076 "" + } +#line 13077 "" + } else { + +/* Set flag for header & read it in */ + +#line 13081 "" + comhead_1.ihdht = 16; +#line 13082 "" + getbuf_(comhead_1.headrq, (ftnlen)80); +#line 13083 "" + all_1.iccount = 128; +#line 13084 "" + } +#line 13085 "" + } else if (*(unsigned char *)charq == 'L') { + +/* Linebreak, already handled in pmxa, but check for movement break */ + +#line 13089 "" + ++all_1.iccount; +#line 13090 "" + readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen) + 1); +#line 13091 "" + if (*(unsigned char *)durq == 'P') { +#line 13092 "" + ++all_1.iccount; +#line 13093 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 13094 "" + } +#line 13095 "" + if (*(unsigned char *)durq == 'M') { +#line 13096 "" + comget_1.movbrk = i_nint(&fmovbrk); +#line 13097 "" + comget_1.movgap = 0; +#line 13098 "" + comget_1.parmov = -1.f; +#line 13099 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13100 "" +L31: +#line 13100 "" + if (*(unsigned char *)durq == '+') { + +/* Get vertical space (\internotes) */ + +#line 13104 "" + ++all_1.iccount; +#line 13105 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 13106 "" + comget_1.movgap = i_nint(&fnum); +#line 13107 "" + goto L31; +#line 13108 "" + } else if (*(unsigned char *)durq == 'i') { +#line 13109 "" + ++all_1.iccount; +#line 13110 "" + readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, ( + ftnlen)128, (ftnlen)1); +#line 13111 "" + goto L31; +#line 13112 "" + } else if (*(unsigned char *)durq == 'c') { +#line 13113 "" + comnotes_1.nobar1 = TRUE_; +#line 13114 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13115 "" + goto L31; +#line 13116 "" + } else if (*(unsigned char *)durq == 'r') { + +/* "rename" can be set on or off. */ + +#line 13120 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13121 "" + comnvi_1.rename = *(unsigned char *)durq == '+'; +#line 13122 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13123 "" + goto L31; +#line 13124 "" + } 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 13129 "" + nvold = all_1.nv; +#line 13130 "" + all_1.nv = 0; +#line 13131 "" + comnvi_1.rename = TRUE_; +#line 13132 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13133 "" + if (*(unsigned char *)durq == ':') { +#line 13134 "" + all_1.iccount += 2; +#line 13135 "" + i__1 = all_1.iccount - 2; +#line 13135 "" + ici__1.icierr = 0; +#line 13135 "" + ici__1.iciend = 0; +#line 13135 "" + ici__1.icirnum = 1; +#line 13135 "" + ici__1.icirlen = all_1.iccount - i__1; +#line 13135 "" + ici__1.iciunit = lineq + i__1; +#line 13135 "" + ici__1.icifmt = "(i2)"; +#line 13135 "" + s_rsfi(&ici__1); +#line 13135 "" + do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof( + integer)); +#line 13135 "" + e_rsfi(); +#line 13136 "" + } else { +#line 13137 "" + comnotes_1.ninow = *(unsigned char *)durq - 48; +#line 13138 "" + } +#line 13139 "" + iiv = 0; +#line 13140 "" + i__1 = comnotes_1.ninow; +#line 13140 "" + for (iinow = 1; iinow <= i__1; ++iinow) { +#line 13141 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, ( + ftnlen)1); +#line 13142 "" + if (*(unsigned char *)durq == ':') { +#line 13143 "" + all_1.iccount += 2; +#line 13144 "" + i__2 = all_1.iccount - 2; +#line 13144 "" + ici__1.icierr = 0; +#line 13144 "" + ici__1.iciend = 0; +#line 13144 "" + ici__1.icirnum = 1; +#line 13144 "" + ici__1.icirlen = all_1.iccount - i__2; +#line 13144 "" + ici__1.iciunit = lineq + i__2; +#line 13144 "" + ici__1.icifmt = "(i2)"; +#line 13144 "" + s_rsfi(&ici__1); +#line 13144 "" + do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], ( + ftnlen)sizeof(integer)); +#line 13144 "" + e_rsfi(); +#line 13145 "" + } else { +#line 13146 "" + comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq - + 48; +#line 13147 "" + } +#line 13148 "" + comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[ + comnvi_1.iiorig[iinow - 1] - 1]; +#line 13149 "" + all_1.nv += comnvi_1.nspern[iinow - 1]; +#line 13150 "" + *(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[ + iinow - 1] - 1] = '&'; +#line 13151 "" + if (comnvi_1.nspern[iinow - 1] > 1) { +#line 13152 "" + i__2 = comnvi_1.nspern[iinow - 1] - 1; +#line 13152 "" + for (iis = 1; iis <= i__2; ++iis) { +#line 13153 "" + *(unsigned char *)&all_1.sepsymq[iiv + iis - 1] = + '|'; +#line 13154 "" +/* L64: */ +#line 13154 "" + } +#line 13155 "" + } +#line 13156 "" + iiv += comnvi_1.nspern[iinow - 1]; +#line 13157 "" +/* L63: */ +#line 13157 "" + } + +/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */ + +/* if (islast) then */ +/* if (ninow .lt. 10) then */ +/* write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */ +/* else */ +/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */ +/* end if */ +/* end if */ +#line 13168 "" + if (all_1.nv == 1 && nvold > 1) { +#line 13169 "" + if (comlast_1.islast) { +#line 13169 "" + s_wsfe(&io___775); +/* Writing concatenation */ +#line 13169 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13169 "" + i__5[1] = 11, a__2[1] = "nostartrule"; +#line 13169 "" + s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 13169 "" + do_fio(&c__1, ch__2, (ftnlen)12); +#line 13169 "" + e_wsfe(); +#line 13169 "" + } +#line 13170 "" + } else if (all_1.nv > 1 && nvold == 1) { +#line 13171 "" + if (comlast_1.islast) { +#line 13171 "" + s_wsfe(&io___776); +/* Writing concatenation */ +#line 13171 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13171 "" + i__5[1] = 9, a__2[1] = "startrule"; +#line 13171 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 13171 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 13171 "" + e_wsfe(); +#line 13171 "" + } +#line 13172 "" + } +#line 13173 "" + iiv = 0; +#line 13174 "" + i__1 = comnotes_1.ninow; +#line 13174 "" + for (iinow = 1; iinow <= i__1; ++iinow) { +#line 13175 "" + i__2 = comnvi_1.nspern[iinow - 1]; +#line 13175 "" + for (iis = 1; iis <= i__2; ++iis) { +#line 13176 "" + ++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 13181 "" + getchar_(lineq, &all_1.iccount, comclefq_1.clefq + ( + iiv - 1), (ftnlen)128, (ftnlen)1); +#line 13182 "" + newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true, + (ftnlen)1); +#line 13183 "" + if (comnvi_1.nspern[iinow - 1] == 1) { +#line 13184 "" + i__3 = numclef_(comclefq_1.clefq + (iiv - 1), ( + ftnlen)1) + 48; +#line 13184 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 13184 "" + s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1); +#line 13185 "" + lclf = 1; +#line 13186 "" + } else if (iis == 1) { +/* Writing concatenation */ +#line 13187 "" + i__5[0] = 1, a__2[0] = "{"; +#line 13187 "" + i__3 = numclef_(comclefq_1.clefq + (iiv - 1), ( + ftnlen)1) + 48; +#line 13187 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 13187 "" + i__5[1] = 1, a__2[1] = ch__1; +#line 13187 "" + s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); +#line 13188 "" + lclf = 2; +#line 13189 "" + } else if (iis < comnvi_1.nspern[iinow - 1]) { +/* Writing concatenation */ +#line 13190 "" + i__5[0] = lclf, a__2[0] = hdlndq; +#line 13190 "" + i__3 = numclef_(comclefq_1.clefq + (iiv - 1), ( + ftnlen)1) + 48; +#line 13190 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 13190 "" + i__5[1] = 1, a__2[1] = ch__1; +#line 13190 "" + s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59); +#line 13191 "" + ++lclf; +#line 13192 "" + } else { +/* Writing concatenation */ +#line 13193 "" + i__6[0] = lclf, a__3[0] = hdlndq; +#line 13193 "" + i__3 = numclef_(comclefq_1.clefq + (iiv - 1), ( + ftnlen)1) + 48; +#line 13193 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 13193 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 13193 "" + i__6[2] = 1, a__3[2] = "}"; +#line 13193 "" + s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); +#line 13195 "" + lclf += 2; +#line 13196 "" + } +#line 13197 "" +/* L61: */ +#line 13197 "" + } + +/* setstaffs & setclef go by instrument, not voice */ + +#line 13201 "" + if (comlast_1.islast) { +#line 13202 "" + if (iinow < 10) { +#line 13203 "" + s_wsfe(&io___779); +/* Writing concatenation */ +#line 13203 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 13203 "" + i__4[1] = 9, a__1[1] = "setstaffs"; +#line 13203 "" + i__2 = iinow + 48; +#line 13203 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13203 "" + i__4[2] = 1, a__1[2] = ch__1; +#line 13203 "" + i__3 = comnvi_1.nspern[iinow - 1] + 48; +#line 13203 "" + chax_(ch__5, (ftnlen)1, &i__3); +#line 13203 "" + i__4[3] = 1, a__1[3] = ch__5; +#line 13203 "" + i__4[4] = 1, a__1[4] = "%"; +#line 13203 "" + s_cat(ch__4, a__1, i__4, &c__5, (ftnlen)13); +#line 13203 "" + do_fio(&c__1, ch__4, (ftnlen)13); +#line 13203 "" + e_wsfe(); +#line 13205 "" + s_wsfe(&io___780); +/* Writing concatenation */ +#line 13205 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 13205 "" + i__4[1] = 7, a__1[1] = "setclef"; +#line 13205 "" + i__2 = iinow + 48; +#line 13205 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13205 "" + i__4[2] = 1, a__1[2] = ch__1; +#line 13205 "" + i__4[3] = lclf, a__1[3] = hdlndq; +#line 13205 "" + i__4[4] = 1, a__1[4] = "%"; +#line 13205 "" + s_cat(ch__6, a__1, i__4, &c__5, (ftnlen)69); +#line 13205 "" + do_fio(&c__1, ch__6, lclf + 10); +#line 13205 "" + e_wsfe(); +#line 13207 "" + if (comfig_1.fullsize[comnvi_1.iiorig[iinow - 1] + - 1] > .9f) { +#line 13208 "" + s_wsfe(&io___781); +/* Writing concatenation */ +#line 13208 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 13208 "" + i__4[1] = 7, a__1[1] = "setsize"; +#line 13208 "" + i__2 = iinow + 48; +#line 13208 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13208 "" + i__4[2] = 1, a__1[2] = ch__1; +#line 13208 "" + i__4[3] = 1, a__1[3] = all_1.sq; +#line 13208 "" + i__4[4] = 12, a__1[4] = "normalvalue%"; +#line 13208 "" + s_cat(ch__7, a__1, i__4, &c__5, (ftnlen)22); +#line 13208 "" + do_fio(&c__1, ch__7, (ftnlen)22); +#line 13208 "" + e_wsfe(); + +/* 140526 Account for staff size specs when noinst changes. May be confusion */ +/* here if more than one staff per instrument */ + +#line 13214 "" + } else if (comfig_1.fullsize[comnvi_1.iiorig[ + iinow - 1] - 1] > .7f) { +#line 13215 "" + s_wsfe(&io___782); +/* Writing concatenation */ +#line 13215 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 13215 "" + i__4[1] = 7, a__1[1] = "setsize"; +#line 13215 "" + i__2 = iinow + 48; +#line 13215 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13215 "" + i__4[2] = 1, a__1[2] = ch__1; +#line 13215 "" + i__4[3] = 1, a__1[3] = all_1.sq; +#line 13215 "" + i__4[4] = 11, a__1[4] = "smallvalue%"; +#line 13215 "" + s_cat(ch__8, a__1, i__4, &c__5, (ftnlen)21); +#line 13215 "" + do_fio(&c__1, ch__8, (ftnlen)21); +#line 13215 "" + e_wsfe(); +#line 13217 "" + } else { +#line 13218 "" + s_wsfe(&io___783); +/* Writing concatenation */ +#line 13218 "" + i__4[0] = 1, a__1[0] = all_1.sq; +#line 13218 "" + i__4[1] = 7, a__1[1] = "setsize"; +#line 13218 "" + i__2 = iinow + 48; +#line 13218 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13218 "" + i__4[2] = 1, a__1[2] = ch__1; +#line 13218 "" + i__4[3] = 1, a__1[3] = all_1.sq; +#line 13218 "" + i__4[4] = 10, a__1[4] = "tinyvalue%"; +#line 13218 "" + s_cat(ch__9, a__1, i__4, &c__5, (ftnlen)20); +#line 13218 "" + do_fio(&c__1, ch__9, (ftnlen)20); +#line 13218 "" + e_wsfe(); +#line 13220 "" + } +#line 13221 "" + } else { +#line 13222 "" + s_wsfe(&io___784); +/* Writing concatenation */ +#line 13222 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13222 "" + i__5[1] = 10, a__2[1] = "setstaffs{"; +#line 13222 "" + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 13222 "" + do_fio(&c__1, ch__10, (ftnlen)11); +#line 13222 "" + do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 13222 "" + i__6[0] = 1, a__3[0] = "}"; +#line 13222 "" + i__2 = comnvi_1.nspern[iinow - 1] + 48; +#line 13222 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 13222 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 13222 "" + i__6[2] = 1, a__3[2] = "%"; +#line 13222 "" + s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3); +#line 13222 "" + do_fio(&c__1, ch__11, (ftnlen)3); +#line 13222 "" + e_wsfe(); +#line 13224 "" + s_wsfe(&io___785); +/* Writing concatenation */ +#line 13224 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13224 "" + i__5[1] = 8, a__2[1] = "setclef{"; +#line 13224 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 13224 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 13224 "" + do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 13224 "" + i__6[0] = 1, a__3[0] = "}"; +#line 13224 "" + i__6[1] = lclf, a__3[1] = hdlndq; +#line 13224 "" + i__6[2] = 1, a__3[2] = "%"; +#line 13224 "" + s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61); +#line 13224 "" + do_fio(&c__1, ch__13, lclf + 2); +#line 13224 "" + e_wsfe(); +#line 13226 "" + } +#line 13227 "" + } +#line 13228 "" +/* L60: */ +#line 13228 "" + } + +/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */ + +#line 13232 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13233 "" + goto L31; +#line 13234 "" + } + +/* Write instrument names */ + +#line 13238 "" + if (! comnvi_1.rename) { +#line 13239 "" + i__1 = comnotes_1.ninow; +#line 13239 "" + for (iinst = 1; iinst <= i__1; ++iinst) { +#line 13240 "" + if (comlast_1.islast) { +#line 13241 "" + if (iinst < 10) { +#line 13242 "" + s_wsfe(&io___787); +/* Writing concatenation */ +#line 13242 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13242 "" + i__5[1] = 7, a__2[1] = "setname"; +#line 13242 "" + s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 13242 "" + do_fio(&c__1, ch__14, (ftnlen)8); +#line 13242 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +#line 13242 "" + do_fio(&c__1, "{}%", (ftnlen)3); +#line 13242 "" + e_wsfe(); +#line 13243 "" + } else { +#line 13244 "" + s_wsfe(&io___788); +/* Writing concatenation */ +#line 13244 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13244 "" + i__5[1] = 8, a__2[1] = "setname{"; +#line 13244 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 13244 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 13244 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +#line 13244 "" + do_fio(&c__1, "}{}%", (ftnlen)4); +#line 13244 "" + e_wsfe(); +#line 13245 "" + } +#line 13246 "" + } +#line 13247 "" +/* L62: */ +#line 13247 "" + } +#line 13248 "" + } else { +#line 13249 "" + i__1 = comnotes_1.ninow; +#line 13249 "" + for (iinst = 1; iinst <= i__1; ++iinst) { +#line 13250 "" + if (comlast_1.islast) { +#line 13251 "" + if (iinst < 10) { +#line 13252 "" + s_wsfe(&io___789); +/* Writing concatenation */ +#line 13252 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13252 "" + i__5[1] = 7, a__2[1] = "setname"; +#line 13252 "" + s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8); +#line 13252 "" + do_fio(&c__1, ch__14, (ftnlen)8); +#line 13252 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 13252 "" + i__6[0] = 1, a__3[0] = "{"; +#line 13252 "" + 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 13252 "" + i__6[2] = 2, a__3[2] = "}%"; +#line 13252 "" + s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82); +#line 13252 "" + do_fio(&c__1, ch__15, comtop_1.lnam[ + comnvi_1.iiorig[iinst - 1] - 1] + 3); +#line 13252 "" + e_wsfe(); +#line 13254 "" + } else { +#line 13255 "" + s_wsfe(&io___790); +/* Writing concatenation */ +#line 13255 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13255 "" + i__5[1] = 8, a__2[1] = "setname{"; +#line 13255 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 13255 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 13255 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 13255 "" + i__6[0] = 2, a__3[0] = "}{"; +#line 13255 "" + 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 13255 "" + i__6[2] = 2, a__3[2] = "}%"; +#line 13255 "" + s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83); +#line 13255 "" + do_fio(&c__1, ch__16, comtop_1.lnam[ + comnvi_1.iiorig[iinst - 1] - 1] + 4); +#line 13255 "" + e_wsfe(); +#line 13257 "" + } +#line 13258 "" + } +#line 13259 "" +/* L65: */ +#line 13259 "" + } +#line 13260 "" + comnvi_1.rename = FALSE_; +#line 13261 "" + } +#line 13262 "" + } +#line 13263 "" + } else if (*(unsigned char *)charq == '|') { + +/* End of bar symbol. Check about end of bar hardspace. */ + +#line 13267 "" + if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + + 1) * 24 - 1],26)) { + +/* There was a hardspace followed by a bar line. Remove it from the hardspace */ +/* list, store with shifts instead, set special bit. Need to repeat this code */ +/* at '/'. */ + +#line 13273 "" + 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 13274 "" + ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 13275 "" + comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] + * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; +#line 13276 "" + --comudsp_1.nudsp; +#line 13277 "" + 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 13278 "" + } +#line 13279 "" + } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Width symbol or new nsyst. Read past (until blank) */ + +#line 13283 "" +L4: +#line 13283 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13284 "" + if (*(unsigned char *)durq != ' ') { +#line 13284 "" + goto L4; +#line 13284 "" + } +#line 13285 "" + } else if (*(unsigned char *)charq == 'l') { + +/* Lower string. Only OK if at start of block */ +/* Check whether at beginning of a block */ + +#line 13290 "" + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 13291 "" + s_wsle(&io___791); +#line 13291 "" + do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block" + , (ftnlen)41); +#line 13291 "" + e_wsle(); +#line 13292 "" + stop1_(); +#line 13293 "" + } + +/* Set flag for lower string & read it in */ + +#line 13297 "" + comhead_1.lower = TRUE_; +#line 13298 "" + getbuf_(comhead_1.lowerq, (ftnlen)80); +#line 13299 "" + all_1.iccount = 128; +#line 13300 "" + } else if (*(unsigned char *)charq == 'm') { + +/* Meter change. Only allow at beginning of block. */ +/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */ +/* mtrnuml=0 initially. (In common) */ + +/* Check whether at beginning of a block */ + +#line 13308 "" + if (all_1.iv != 1 || all_1.nnl[0] != 0) { +#line 13309 "" + s_wsle(&io___792); +#line 13309 "" + do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block" + , (ftnlen)41); +#line 13309 "" + e_wsle(); +#line 13310 "" + stop1_(); +#line 13311 "" + } +#line 13312 "" + readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, ( + ftnlen)128); +#line 13313 "" + readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, ( + ftnlen)128); +#line 13314 "" + lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); +#line 13315 "" + if (all_1.mtrdenl == 2) { +#line 13315 "" + lenbeat = 16; +#line 13315 "" + } +#line 13316 "" + all_1.lenbar = all_1.mtrnuml * lenbeat; +#line 13317 "" + if (all_1.mtrdenl == 2) { +#line 13317 "" + all_1.lenbar <<= 1; +#line 13317 "" + } +#line 13318 "" + all_1.lenb1 = all_1.lenbar; +#line 13319 "" + all_1.lenb0 = 0; +#line 13320 "" + if (commidi_1.ismidi) { +#line 13320 "" + midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); +#line 13320 "" + } +#line 13321 "" + } else if (*(unsigned char *)charq == 'C') { + +/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */ + +#line 13325 "" + if (all_1.nnl[all_1.iv - 1] > 0) { +#line 13325 "" + ++comcc_1.ncc[all_1.iv - 1]; +#line 13325 "" + } +#line 13326 "" + comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real) + all_1.itsofar[all_1.iv - 1]; +#line 13327 "" + isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * + 24 - 25],11); +#line 13328 "" + 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 13332 "" + i__1 = numclef_(durq, (ftnlen)1); +#line 13332 "" + isl |= min(i__1,7) << 12; +#line 13333 "" + comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = + ncmidf_(durq, (ftnlen)1); +#line 13334 "" + if (*(unsigned char *)durq == '8') { +#line 13335 "" + 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 13336 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1] + = 7; +#line 13337 "" + } else { +#line 13338 "" + if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] + - 1] == 7) { +#line 13338 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] + - 1] = 0; +#line 13338 "" + } +#line 13339 "" + } + +/* Set marker on note with lowest voice # starting at same time. */ + +#line 13343 "" + if (all_1.iv == 1) { +#line 13344 "" + isl = bit_set(isl,15); +#line 13345 "" + } else { +#line 13346 "" + i__1 = all_1.iv; +#line 13346 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 13347 "" + nnliiv = all_1.nnl[iiv - 1]; +#line 13348 "" + if (iiv == all_1.iv) { +#line 13348 "" + ++nnliiv; +#line 13348 "" + } +#line 13349 "" + itother = 0; +#line 13350 "" + i__2 = nnliiv; +#line 13350 "" + for (iip = 1; iip <= i__2; ++iip) { +#line 13351 "" + if (itother < all_1.itsofar[all_1.iv - 1]) { +#line 13352 "" + itother += all_1.nodur[iiv + iip * 24 - 25]; +#line 13353 "" + goto L14; +#line 13354 "" + } else if (itother == all_1.itsofar[all_1.iv - 1]) { +#line 13355 "" + all_1.islur[iiv + iip * 24 - 25] = bit_set( + all_1.islur[iiv + iip * 24 - 25],15); +#line 13356 "" + goto L15; +#line 13357 "" + } +#line 13358 "" +L14: +#line 13358 "" + ; +#line 13358 "" + } +#line 13359 "" +/* L13: */ +#line 13359 "" + } +#line 13360 "" +L15: +#line 13361 "" + ; +#line 13361 "" + } + +/* Need 'or' since may have set bit 15 in the above loop */ + +#line 13365 "" + 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 13366 "" + } else if (*(unsigned char *)charq == 'R') { + +/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */ + +#line 13370 "" +L10: +#line 13370 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Save designator in case it's a terminal Rr or Rd */ + +#line 13374 "" + if (*(unsigned char *)durq == 'l') { +#line 13375 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[( + all_1.nnl[0] + 1) * 24 - 24],5); +#line 13376 "" + goto L10; +#line 13377 "" + } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) { +#line 13378 "" + if (*(unsigned char *)durq == 'r') { +#line 13379 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6); +#line 13380 "" + } else if (*(unsigned char *)durq == 'd') { +#line 13381 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8); +#line 13382 "" + } else if (*(unsigned char *)durq == 'D') { +#line 13383 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26); +#line 13384 "" + } else if (*(unsigned char *)durq == 'b') { +#line 13385 "" + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set( + all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25); +#line 13386 "" + } else if (*(unsigned char *)durq == 'z') { +/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */ +#line 13388 "" + all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.ipl[( + all_1.nnl[0] + 1) * 24 - 24],0); +#line 13389 "" + } +#line 13390 "" + comget_1.rptprev = TRUE_; +#line 13391 "" + *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq; +#line 13392 "" + goto L10; +#line 13393 "" + } +#line 13394 "" + } else if (*(unsigned char *)charq == 'V') { + +/* Ending */ + +#line 13398 "" + nnnl = all_1.nnl[0] + 1; +#line 13399 "" + lvoltxt = 0; +#line 13400 "" +L11: +#line 13400 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13401 "" + if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') { + +/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */ + +#line 13405 "" + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24], + 9); +#line 13406 "" + if (*(unsigned char *)durq == 'b') { +#line 13406 "" + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - + 24],10); +#line 13406 "" + } +#line 13407 "" + goto L11; +#line 13408 "" + } else if (*(unsigned char *)durq != ' ') { + +/* Start volta; Get text */ + +#line 13412 "" + if (lvoltxt == 0) { + +/* First character for text */ + +#line 13416 "" + lvoltxt = 1; +#line 13417 "" + all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - + 24],7); +#line 13418 "" + ++comgrace_1.nvolt; +#line 13419 "" + s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq, + (ftnlen)20, (ftnlen)1); +#line 13420 "" + } else { +/* Writing concatenation */ +#line 13421 "" + i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + ( + comgrace_1.nvolt - 1) * 20; +#line 13421 "" + i__5[1] = 1, a__2[1] = durq; +#line 13421 "" + s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__2, + i__5, &c__2, (ftnlen)20); +#line 13422 "" + ++lvoltxt; +#line 13423 "" + } +#line 13424 "" + goto L11; +#line 13425 "" + } +#line 13426 "" + } else if (*(unsigned char *)charq == 'B') { +#line 13427 "" + combc_1.bcspec = ! combc_1.bcspec; +#line 13428 "" + } else if (*(unsigned char *)charq == 'P') { + +/* Page numbers. Print stuff right now. */ + +#line 13432 "" + npg1 = 0; + +/* Will use ltopnam to signal whether there's a centered heading */ + +#line 13436 "" + ltopnam = 0; +#line 13437 "" + ipg1r = 0; +#line 13438 "" +L16: +#line 13438 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13439 "" + if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) { +#line 13440 "" + npg1 = npg1 * 10 + *(unsigned char *)durq - 48; +#line 13441 "" + goto L16; +#line 13442 "" + } else if (*(unsigned char *)durq == 'l') { +#line 13443 "" + if (npg1 == 0 || npg1 % 2 == 1) { +#line 13443 "" + ipg1r = 1; +#line 13443 "" + } +#line 13444 "" + goto L16; +#line 13445 "" + } else if (*(unsigned char *)durq == 'r') { +#line 13446 "" + if (npg1 > 0 && npg1 % 2 == 0) { +#line 13446 "" + ipg1r = 1; +#line 13446 "" + } +#line 13447 "" + goto L16; +#line 13448 "" + } 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 13453 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13454 "" + if (*(unsigned char *)durq == ' ') { +#line 13455 "" + ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60); +#line 13456 "" + } else { +#line 13457 "" + namstrt = all_1.iccount; +#line 13458 "" + if (*(unsigned char *)durq == '"') { + +/* Using quote delimiters. */ + +#line 13462 "" + quoted = TRUE_; +#line 13463 "" + ++namstrt; +#line 13464 "" + } else { +#line 13465 "" + quoted = FALSE_; +#line 13466 "" + } +#line 13467 "" + for (all_1.iccount = namstrt + 1; all_1.iccount <= 128; + ++all_1.iccount) { +#line 13468 "" + if (quoted && *(unsigned char *)&lineq[all_1.iccount - 1] + == '"' || ! quoted && *(unsigned char *)&lineq[ + all_1.iccount - 1] == ' ') { +#line 13468 "" + goto L36; +#line 13468 "" + } + +/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */ + +#line 13474 "" +/* L35: */ +#line 13474 "" + } +#line 13475 "" + s_wsle(&io___801); +#line 13475 "" + do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", ( + ftnlen)31); +#line 13475 "" + e_wsle(); +#line 13476 "" + stop1_(); +#line 13477 "" +L36: +#line 13478 "" + ltopnam = all_1.iccount - namstrt; +#line 13479 "" + s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60, + all_1.iccount - 1 - (namstrt - 1)); +#line 13480 "" + } +#line 13481 "" + } + +/* Done getting data, now assemble the command */ + +#line 13485 "" + if (npg1 == 0) { +#line 13485 "" + npg1 = 1; +#line 13485 "" + } + +/* 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 13490 "" + i__7[0] = 1, a__4[0] = all_1.sq; +#line 13490 "" + i__7[1] = 3, a__4[1] = "def"; +#line 13490 "" + i__7[2] = 1, a__4[2] = all_1.sq; +#line 13490 "" + i__7[3] = 11, a__4[3] = "atnextline{"; +#line 13490 "" + i__7[4] = 1, a__4[4] = all_1.sq; +#line 13490 "" + i__7[5] = 10, a__4[5] = "toppageno{"; +#line 13490 "" + s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59); +#line 13491 "" + lhead = 27; +/* else */ +/* hdlndq = sq//'toppageno{' */ +/* lhead = 11 */ +/* end if */ +#line 13496 "" + if (npg1 < 10) { + +/* Note we are overwriting the last "{" */ + +#line 13500 "" + ici__1.icierr = 0; +#line 13500 "" + ici__1.icirnum = 1; +#line 13500 "" + ici__1.icirlen = 1; +#line 13500 "" + ici__1.iciunit = hdlndq + (lhead - 1); +#line 13500 "" + ici__1.icifmt = "(i1)"; +#line 13500 "" + s_wsfi(&ici__1); +#line 13500 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 13500 "" + e_wsfi(); +#line 13501 "" + } else if (npg1 < 100) { +#line 13502 "" + lhead += 3; +#line 13503 "" + i__1 = lhead - 3; +#line 13503 "" + ici__1.icierr = 0; +#line 13503 "" + ici__1.icirnum = 1; +#line 13503 "" + ici__1.icirlen = lhead - i__1; +#line 13503 "" + ici__1.iciunit = hdlndq + i__1; +#line 13503 "" + ici__1.icifmt = "(i2,a1)"; +#line 13503 "" + s_wsfi(&ici__1); +#line 13503 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 13503 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 13503 "" + e_wsfi(); +#line 13504 "" + } else { +#line 13505 "" + lhead += 4; +#line 13506 "" + i__1 = lhead - 4; +#line 13506 "" + ici__1.icierr = 0; +#line 13506 "" + ici__1.icirnum = 1; +#line 13506 "" + ici__1.icirlen = lhead - i__1; +#line 13506 "" + ici__1.iciunit = hdlndq + i__1; +#line 13506 "" + ici__1.icifmt = "(i3,a1)"; +#line 13506 "" + s_wsfi(&ici__1); +#line 13506 "" + do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer)); +#line 13506 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 13506 "" + e_wsfi(); +#line 13507 "" + } +/* Writing concatenation */ +#line 13508 "" + i__6[0] = lhead, a__3[0] = hdlndq; +#line 13508 "" + i__1 = ipg1r + 48; +#line 13508 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 13508 "" + i__6[1] = 1, a__3[1] = ch__1; +#line 13508 "" + i__6[2] = 1, a__3[2] = "{"; +#line 13508 "" + s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59); +#line 13509 "" + lhead += 2; +/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */ +#line 13511 "" + if (ltopnam == 0) { +#line 13512 "" + if (comlast_1.islast) { +#line 13512 "" + s_wsfe(&io___803); +/* Writing concatenation */ +#line 13512 "" + i__5[0] = lhead, a__2[0] = hdlndq; +#line 13512 "" + i__5[1] = 3, a__2[1] = "}}%"; +#line 13512 "" + s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62); +#line 13512 "" + do_fio(&c__1, ch__17, lhead + 3); +#line 13512 "" + e_wsfe(); +#line 13512 "" + } +#line 13513 "" + } else { +#line 13514 "" + if (comlast_1.islast) { +#line 13514 "" + s_wsfe(&io___804); +/* Writing concatenation */ +#line 13514 "" + i__6[0] = lhead, a__3[0] = hdlndq; +#line 13514 "" + i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq; +#line 13514 "" + i__6[2] = 3, a__3[2] = "}}%"; +#line 13514 "" + s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122); +#line 13514 "" + do_fio(&c__1, ch__18, lhead + ltopnam + 3); +#line 13514 "" + e_wsfe(); +#line 13514 "" + } +#line 13516 "" + } +/* else */ +/* if (ltopnam .eq. 0) then */ +/* if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' */ +/* else */ +/* if (islast) */ +/* * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */ +/* end if */ +/* end if */ +#line 13525 "" + } else if (*(unsigned char *)charq == 'W') { + +/* Just eat the number that must follow, it was used in pmxa */ + +#line 13529 "" + ++all_1.iccount; +#line 13530 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 13531 "" + } else if (*(unsigned char *)charq == 'T') { +#line 13532 "" + comtitl_1.headlog = TRUE_; +#line 13533 "" + comtitl_1.inhead = 0; +#line 13534 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13535 "" + if (*(unsigned char *)durq == 'i') { +#line 13536 "" + getbuf_(comtitl_1.instrq, (ftnlen)120); + +/* A kluge for parts from separate score file for later movements. */ + +#line 13540 "" + if (*(unsigned char *)comtitl_1.instrq == ' ') { +#line 13540 "" + comtitl_1.headlog = FALSE_; +#line 13540 "" + } +#line 13541 "" + s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen) + 60); +#line 13542 "" + } else if (*(unsigned char *)durq == 't') { +#line 13543 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Optionally can include extra vertical \internotes above inbothd */ + +#line 13547 "" + if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 13548 "" + ipm = 1; +#line 13549 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Don't trust readnum to round this negative integer properly */ + +#line 13553 "" + ++all_1.iccount; +#line 13554 "" + if (*(unsigned char *)durq == '-') { +#line 13554 "" + ipm = -1; +#line 13554 "" + } +#line 13555 "" + } +#line 13556 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 13557 "" + comtitl_1.inhead = ipm * i_nint(&fnum); +#line 13558 "" + } +#line 13559 "" + getbuf_(comtitl_1.titleq, (ftnlen)120); +#line 13560 "" + } else { +#line 13561 "" + getbuf_(comtitl_1.compoq, (ftnlen)120); +#line 13562 "" + } +#line 13563 "" + comtitl_1.inhead += cominbot_1.inbothd; +#line 13564 "" + all_1.iccount = 128; +#line 13565 "" + } else if (*(unsigned char *)charq == 'A') { + +/* Accidental handling etc. */ + +#line 13569 "" +L27: +#line 13569 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13570 "" + if (*(unsigned char *)durq == 'r') { +#line 13571 "" + if (comlast_1.islast) { +#line 13572 "" + commidi_1.relacc = TRUE_; +#line 13573 "" + s_wsfe(&io___805); +/* Writing concatenation */ +#line 13573 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13573 "" + i__5[1] = 14, a__2[1] = "relativeaccid%"; +#line 13573 "" + s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15); +#line 13573 "" + do_fio(&c__1, ch__19, (ftnlen)15); +#line 13573 "" + e_wsfe(); +#line 13574 "" + } +#line 13575 "" + } else if (*(unsigned char *)durq == 's') { +#line 13576 "" + spfacs_1.bacfac = 1e6f; +#line 13577 "" + } else if (*(unsigned char *)durq == 'b') { +#line 13578 "" + if (comlast_1.islast) { +#line 13578 "" + s_wsfe(&io___806); +/* Writing concatenation */ +#line 13578 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13578 "" + i__5[1] = 9, a__2[1] = "bigaccid%"; +#line 13578 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 13578 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 13578 "" + e_wsfe(); +#line 13578 "" + } +#line 13579 "" + spfacs_1.accfac = spfacs_1.bacfac; +#line 13580 "" + } else if (*(unsigned char *)durq == 'a') { +#line 13581 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13582 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 13583 "" + --all_1.iccount; +#line 13584 "" + } else if (*(unsigned char *)durq == 'i') { +#line 13585 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13586 "" + readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, ( + ftnlen)1); +#line 13587 "" + if (! all_1.firstgulp) { +#line 13587 "" + comget_1.fintstf = tintstf; +#line 13587 "" + } + +/* Local corrections for first page were handled by pmxa */ + +#line 13591 "" + --all_1.iccount; +#line 13592 "" + } else if (*(unsigned char *)durq == 'I') { +#line 13593 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13594 "" + readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen) + 128, (ftnlen)1); +#line 13595 "" + --all_1.iccount; +#line 13596 "" + } else if (*(unsigned char *)durq == 'd') { +#line 13597 "" + comarp_1.lowdot = TRUE_; +#line 13598 "" + } else if (*(unsigned char *)durq == 'o') { +#line 13600 "" + } else if (*(unsigned char *)durq == 'S') { +/* 130324 */ +/* do 50 iiv = 1 , nv */ +#line 13603 "" + i__1 = comkeys_2.noinst; +#line 13603 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 13604 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13605 "" + if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 13606 "" + comfig_1.fullsize[iiv - 1] = .8f; +#line 13607 "" + } else if (*(unsigned char *)durq == 't') { +#line 13608 "" + comfig_1.fullsize[iiv - 1] = .64f; +#line 13609 "" + } else { +/* fullsize(ivx) = 1.0 */ +#line 13611 "" + comfig_1.fullsize[iiv - 1] = 1.f; +#line 13612 "" + } +#line 13613 "" +/* L50: */ +#line 13613 "" + } +#line 13614 "" + } else if (*(unsigned char *)durq == 'e') { + +/* Line-spacing equalization */ + +#line 13618 "" + comget_1.equalize = TRUE_; + +/* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */ +/* But it causes problems with some older scores and when excerpts are combined */ +/* with LaTeX. So as of 2.352 we write it here. */ + +#line 13624 "" + s_wsfe(&io___808); +/* Writing concatenation */ +#line 13624 "" + i__8[0] = 1, a__5[0] = all_1.sq; +#line 13624 "" + i__8[1] = 6, a__5[1] = "global"; +#line 13624 "" + i__8[2] = 1, a__5[2] = all_1.sq; +#line 13624 "" + i__8[3] = 19, a__5[3] = "parskip 0pt plus 12"; +#line 13624 "" + i__8[4] = 1, a__5[4] = all_1.sq; +#line 13624 "" + i__8[5] = 19, a__5[5] = "Interligne minus 99"; +#line 13624 "" + i__8[6] = 1, a__5[6] = all_1.sq; +#line 13624 "" + i__8[7] = 11, a__5[7] = "Interligne%"; +#line 13624 "" + s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59); +#line 13624 "" + do_fio(&c__1, ch__20, (ftnlen)59); +#line 13624 "" + e_wsfe(); +#line 13626 "" + s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1); +#line 13627 "" + lentemp = 1; +#line 13628 "" + i__1 = all_1.nv - 1; +#line 13628 "" + for (iiv = 2; iiv <= i__1; ++iiv) { +/* Writing concatenation */ +#line 13629 "" + i__5[0] = lentemp, a__2[0] = tempq; +#line 13629 "" + i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1); +#line 13629 "" + s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24); +#line 13630 "" + ++lentemp; +#line 13631 "" +/* L51: */ +#line 13631 "" + } +#line 13632 "" + s_wsfe(&io___811); +/* Writing concatenation */ +#line 13632 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 13632 "" + i__9[1] = 3, a__6[1] = "def"; +#line 13632 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 13632 "" + i__9[3] = 8, a__6[3] = "upstrut{"; +#line 13632 "" + i__9[4] = 1, a__6[4] = all_1.sq; +#line 13632 "" + i__9[5] = 6, a__6[5] = "znotes"; +#line 13632 "" + i__9[6] = lentemp, a__6[6] = tempq; +#line 13632 "" + i__9[7] = 1, a__6[7] = all_1.sq; +#line 13632 "" + i__9[8] = 10, a__6[8] = "zcharnote{"; +#line 13632 "" + i__9[9] = 1, a__6[9] = all_1.sq; +#line 13632 "" + i__9[10] = 9, a__6[10] = "upamt}{~}"; +#line 13632 "" + i__9[11] = 1, a__6[11] = all_1.sq; +#line 13632 "" + i__9[12] = 4, a__6[12] = "en}%"; +#line 13632 "" + s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70); +#line 13632 "" + do_fio(&c__1, ch__21, lentemp + 46); +#line 13632 "" + e_wsfe(); +#line 13635 "" + } else if (*(unsigned char *)durq == 'v') { + +/* Toggle usevshrink */ + +#line 13639 "" + comlast_1.usevshrink = ! comlast_1.usevshrink; +#line 13640 "" + } else if (*(unsigned char *)durq == 'p') { + +/* Postscript slurs. fontslur is already false (set in g1etnote) */ + +#line 13644 "" + if (! comslur_1.wrotepsslurdefaults) { + +/* Set postscrirpt slur adjustment defaults */ + +#line 13648 "" + s_wsfe(&io___812); +/* Writing concatenation */ +#line 13648 "" + i__7[0] = 1, a__4[0] = all_1.sq; +#line 13648 "" + i__7[1] = 12, a__4[1] = "Nosluradjust"; +#line 13648 "" + i__7[2] = 1, a__4[2] = all_1.sq; +#line 13648 "" + i__7[3] = 11, a__4[3] = "Notieadjust"; +#line 13648 "" + i__7[4] = 1, a__4[4] = all_1.sq; +#line 13648 "" + i__7[5] = 10, a__4[5] = "nohalfties"; +#line 13648 "" + s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36); +#line 13648 "" + do_fio(&c__1, ch__22, (ftnlen)36); +#line 13648 "" + e_wsfe(); +#line 13650 "" + comslur_1.wrotepsslurdefaults = TRUE_; +#line 13651 "" + } +#line 13652 "" +L52: +#line 13653 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +/* might be "+", "-", "h" or */ +#line 13654 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Characters to change defaults for ps slurs */ + +#line 13658 "" + g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen) + 1); +/* charq will be "s,t,h,c */ +#line 13659 "" + if (*(unsigned char *)durq == '+') { +#line 13660 "" + if (*(unsigned char *)charq == 's') { +#line 13661 "" + s_wsfe(&io___813); +/* Writing concatenation */ +#line 13661 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13661 "" + i__5[1] = 10, a__2[1] = "Sluradjust"; +#line 13661 "" + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 13661 "" + do_fio(&c__1, ch__10, (ftnlen)11); +#line 13661 "" + e_wsfe(); +#line 13662 "" + } else if (*(unsigned char *)charq == 't') { +#line 13663 "" + s_wsfe(&io___814); +/* Writing concatenation */ +#line 13663 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13663 "" + i__5[1] = 9, a__2[1] = "Tieadjust"; +#line 13663 "" + s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10); +#line 13663 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 13663 "" + e_wsfe(); +#line 13664 "" + } else if (*(unsigned char *)charq == 'h') { +#line 13665 "" + s_wsfe(&io___815); +/* Writing concatenation */ +#line 13665 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13665 "" + i__5[1] = 8, a__2[1] = "halfties"; +#line 13665 "" + s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9); +#line 13665 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 13665 "" + e_wsfe(); +#line 13666 "" + } else { +#line 13667 "" + comslur_1.slurcurve += 1; +#line 13668 "" + if (comslur_1.slurcurve > 3.1f) { +#line 13669 "" + printl_("WARNING!", (ftnlen)8); +#line 13670 "" + printl_("Default slur curvature advanced past HH"\ + ", resetting", (ftnlen)50); +#line 13672 "" + comslur_1.slurcurve = 3.f; +#line 13673 "" + } +#line 13674 "" + } +#line 13675 "" + } else { +#line 13676 "" + if (*(unsigned char *)charq == 's') { +#line 13677 "" + s_wsfe(&io___816); +/* Writing concatenation */ +#line 13677 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13677 "" + i__5[1] = 12, a__2[1] = "Nosluradjust"; +#line 13677 "" + s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13); +#line 13677 "" + do_fio(&c__1, ch__4, (ftnlen)13); +#line 13677 "" + e_wsfe(); +#line 13678 "" + } else if (*(unsigned char *)charq == 't') { +#line 13679 "" + s_wsfe(&io___817); +/* Writing concatenation */ +#line 13679 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13679 "" + i__5[1] = 11, a__2[1] = "Notieadjust"; +#line 13679 "" + s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12); +#line 13679 "" + do_fio(&c__1, ch__2, (ftnlen)12); +#line 13679 "" + e_wsfe(); +#line 13680 "" + } else if (*(unsigned char *)charq == 'h') { +#line 13681 "" + s_wsfe(&io___818); +/* Writing concatenation */ +#line 13681 "" + i__5[0] = 1, a__2[0] = all_1.sq; +#line 13681 "" + i__5[1] = 10, a__2[1] = "nohalfties"; +#line 13681 "" + s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11); +#line 13681 "" + do_fio(&c__1, ch__10, (ftnlen)11); +#line 13681 "" + e_wsfe(); +#line 13682 "" + } else { +#line 13683 "" + comslur_1.slurcurve += -1; +#line 13684 "" + if (comslur_1.slurcurve < -1.1f) { +#line 13685 "" + printl_("WARNING!", (ftnlen)8); +#line 13686 "" + printl_("Default slur curvature decremented belo"\ + "w f, resetting", (ftnlen)53); +#line 13688 "" + comslur_1.slurcurve = -1.f; +#line 13689 "" + } +#line 13690 "" + } +#line 13691 "" + } +#line 13692 "" + goto L52; +/* Check for another set of default changes */ +#line 13693 "" + } else if (*(unsigned char *)durq == 'l') { + +/* Set optional linebreak ties */ + +#line 13697 "" + comnotes_1.optlinebreakties = TRUE_; +#line 13698 "" + goto L52; +#line 13699 "" + } else if (*(unsigned char *)durq == 'h') { + +/* Set flag to write header special on every page */ + +#line 13703 "" + comnotes_1.headerspecial = TRUE_; +#line 13704 "" + goto L52; +#line 13705 "" + } else { +#line 13706 "" + --all_1.iccount; +#line 13707 "" + } +#line 13708 "" + } else if (*(unsigned char *)durq == 'K') { + +/* Toggle keyboard rest placement flag */ + +#line 13712 "" + comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests; +#line 13713 "" + } else if (*(unsigned char *)durq == 'c') { +#line 13714 "" + g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Just eat the input; it was used in pmxa */ + +#line 13718 "" + goto L27; +#line 13719 "" + } +#line 13720 "" + 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 13725 "" + all_1.iccount = 128; +#line 13726 "" + } else if (*(unsigned char *)durq != ' ') { +#line 13727 "" + goto L27; +#line 13728 "" + } +#line 13729 "" + } else if (*(unsigned char *)charq == 'K') { +#line 13730 "" +L77: +#line 13731 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13732 "" + if (*(unsigned char *)durq == 'n') { +#line 13733 "" + comignorenats_1.ignorenats = TRUE_; +#line 13734 "" + goto L77; +#line 13735 "" + } +#line 13736 "" + if (*(unsigned char *)durq != 'i') { + +/* Normal, full-score key change and/or transposition */ + +#line 13740 "" + num1 = 44 - *(unsigned char *)durq; +#line 13741 "" + ++all_1.iccount; +#line 13742 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 13743 "" + num1 *= i_nint(&fnum); + +/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */ + +#line 13747 "" + ++all_1.iccount; +#line 13748 "" + readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, ( + ftnlen)1); +#line 13749 "" + if (commidi_1.ismidi) { +#line 13750 "" + commidisig_1.midisig = i_nint(&fnum); +#line 13751 "" + if (*(unsigned char *)durq == '-') { +#line 13751 "" + commidisig_1.midisig = -commidisig_1.midisig; +#line 13751 "" + } +/* 130317 */ +#line 13753 "" + commidisig_1.midisig += comtop_1.idsig; +#line 13754 "" + midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1); +#line 13756 "" + } +/* 70 continue */ +#line 13758 "" + if (num1 == 0) { + +/* Key change, not transposition. */ + +#line 13762 "" + 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 13763 "" + comtop_1.lastisig = comtop_1.isig; +#line 13764 "" + comtop_1.isig = i_nint(&fnum); +#line 13765 "" + if (*(unsigned char *)durq == '-') { +#line 13765 "" + comtop_1.isig = -comtop_1.isig; +#line 13765 "" + } +#line 13766 "" + comtop_1.isig += comtop_1.idsig; +#line 13767 "" + if (commidi_1.ismidi) { +#line 13767 "" + midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1); +#line 13767 "" + } +#line 13768 "" + } 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 13774 "" + jv = 0; +#line 13775 "" + while(jv < 24) { +#line 13776 "" + ++jv; +#line 13777 "" + cominsttrans_1.itransamt[jv - 1] = num1; +#line 13778 "" + } +#line 13779 "" + comtop_1.idsig = comtop_1.isig - comtop_1.isig0; +#line 13780 "" + } +#line 13781 "" + } else { + +/* Instrument specific transposition. */ + +#line 13785 "" + 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 13790 "" + } +#line 13791 "" + } else if (*(unsigned char *)charq == '/') { +#line 13792 "" + 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 13797 "" + 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 13798 "" + ++comudsp_1.nudoff[commvl_1.ivx - 1]; +#line 13799 "" + comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1] + * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1]; +#line 13800 "" + --comudsp_1.nudsp; +#line 13801 "" + 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 13802 "" + } +#line 13803 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Save ending note level: */ + +#line 13807 "" + 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 13813 "" + if (! comnotes_1.was2[all_1.iv - 1]) { +#line 13813 "" + comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv - + 1]; +#line 13813 "" + } +#line 13814 "" + comnotes_1.was2[all_1.iv - 1] = FALSE_; +#line 13815 "" + comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev; +#line 13816 "" + } else { + +/* This is the 2nd line of music on this staff. */ + +#line 13820 "" + comnotes_1.was2[all_1.iv - 1] = TRUE_; +#line 13821 "" + comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev; +#line 13822 "" + } +#line 13823 "" + if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) { + +/* End of input block */ + +#line 13827 "" + *loop = FALSE_; +#line 13828 "" + } else { + +/* Start a new line of music */ + +#line 13832 "" + if (all_1.lenb0 != 0 && all_1.firstgulp) { +#line 13832 "" + all_1.lenbar = all_1.lenb0; +#line 13832 "" + } +#line 13833 "" + all_1.nbars = 0; +#line 13834 "" + if (*(unsigned char *)durq == ' ') { + +/* New line of music is on next staff */ + +#line 13838 "" + ++all_1.iv; +#line 13839 "" + commvl_1.ivx = all_1.iv; +#line 13840 "" + } else { + +/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */ + +#line 13844 "" + commvl_1.ivx = all_1.nv + 1; +#line 13845 "" + i__1 = all_1.nv; +#line 13845 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +#line 13846 "" + if (commvl_1.nvmx[iiv - 1] == 2) { +#line 13846 "" + ++commvl_1.ivx; +#line 13846 "" + } +#line 13847 "" +/* L23: */ +#line 13847 "" + } +#line 13848 "" + commvl_1.nvmx[all_1.iv - 1] = 2; +#line 13849 "" + commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx; +#line 13850 "" + all_1.itsofar[commvl_1.ivx - 1] = 0; +#line 13851 "" + all_1.nnl[commvl_1.ivx - 1] = 0; +#line 13852 "" + comfb_1.nfb[commvl_1.ivx - 1] = 0; +#line 13853 "" + comudsp_1.nudoff[commvl_1.ivx - 1] = 0; +#line 13854 "" + comcc_1.ndotmv[commvl_1.ivx - 1] = 0; +#line 13855 "" + for (j = 1; j <= 200; ++j) { +#line 13856 "" + all_1.irest[commvl_1.ivx + j * 24 - 25] = 0; +#line 13857 "" + all_1.islur[commvl_1.ivx + j * 24 - 25] = 0; +#line 13858 "" + all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0; +#line 13859 "" + all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0; +#line 13860 "" + all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0; +#line 13861 "" + all_1.mult[commvl_1.ivx + j * 24 - 25] = 0; +#line 13862 "" +/* L24: */ +#line 13862 "" + } + +/* Go back and lower the rests in voice "a" that don't have over-ridden heights */ + +#line 13866 "" + i__1 = all_1.nnl[all_1.iv - 1]; +#line 13866 "" + for (j = 1; j <= i__1; ++j) { +#line 13867 "" + if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) && + all_1.nolev[all_1.iv + j * 24 - 25] == 0) { +#line 13867 "" + all_1.nolev[all_1.iv + j * 24 - 25] = -4; +#line 13867 "" + } +#line 13869 "" +/* L26: */ +#line 13869 "" + } +#line 13870 "" + } +#line 13871 "" + } +#line 13872 "" + all_1.iccount = 128; +#line 13873 "" + } else if (*(unsigned char *)charq == 'X') { + +/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */ +/* which only happens for normal X at block start, and we took special measures to */ +/* keep group shifts for crossing block boundaries. */ + +/* Computing MAX */ +#line 13879 "" + i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1]; +#line 13879 "" + getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__1, + i__2) * 24 - 25], &comnotes_1.shifton, &comask_1.wheadpt, & + all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * + 24 - 1], &commvl_1.ivx, &all_1.irest[commvl_1.ivx + ( + all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[ + commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen) + 128, (ftnlen)1); +#line 13882 "" + } else if (*(unsigned char *)charq == 'I') { + +/* Midi controls. */ + +/* call getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, */ +#line 13887 "" + 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 13889 "" + } else if (*(unsigned char *)charq == 'M') { + +/* Macro action */ + +#line 13893 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13894 "" + if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Record or save a macro. Get the number of the macro. */ + +#line 13898 "" + getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13899 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 13900 "" + commac_1.macnum = i_nint(&fnum); +#line 13901 "" + commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); +#line 13902 "" + if (*(unsigned char *)charq == 'R') { +#line 13903 "" + mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); +#line 13904 "" + } else { + +/* Save (Record but don't activate) */ + +#line 13908 "" +L5: +#line 13908 "" + mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128); +#line 13909 "" + if (commac_1.mrecord) { +#line 13910 "" + getbuf_(lineq, (ftnlen)128); +#line 13911 "" + all_1.iccount = 0; +#line 13912 "" + goto L5; +#line 13913 "" + } +#line 13914 "" + all_1.iccount = all_1.iccount + ndxm + 1; +#line 13915 "" + } +#line 13916 "" + } else if (*(unsigned char *)charq == 'P') { + +/* Playback the macro */ + +#line 13920 "" + getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13921 "" + readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen) + 1); +#line 13922 "" + commac_1.macnum = i_nint(&fnum); +#line 13923 "" + commac_1.icchold = all_1.iccount; +#line 13924 "" + s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); +#line 13925 "" + all_1.iccount = 128; +#line 13926 "" + c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; +#line 13927 "" + commac_1.mplay = TRUE_; +#line 13928 "" + } +#line 13929 "" + } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Continued rhythmic shortcut */ + +#line 13933 "" + idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1); +#line 13934 "" + if (idotform == 1) { + +/* Check for start of forced beam on 2nd member of dotform=1 shortcut */ + +#line 13938 "" + if (comget_1.fbon) { +#line 13939 "" + 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 13939 "" + 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 13939 "" + } +#line 13942 "" + } + +/* Change duration of prior note */ + +#line 13946 "" + all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13947 "" + 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 13948 "" + all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx + + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]; +#line 13949 "" + } +#line 13950 "" + ++idotform; +#line 13951 "" + numnum = 1; +#line 13952 "" + cdot = TRUE_; +#line 13953 "" + goto L1; +#line 13954 "" + } +#line 13955 "" + return 0; +} /* getnote_ */ + +/* Subroutine */ int getorn_(char *lineq, integer *iccount, integer *iornq, + integer *iornq0, logical *ornrpt, integer *noffseg, integer *ip, + integer *ivx, logical *noxtup, logical *notcrd, integer *nole, ftnlen + lineq_len) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *), s_wsle( + cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle( + void); + + /* Local variables */ + static real fnum; + static integer korn; + static char durq[1]; + extern /* Subroutine */ int stop1_(void); + static char charq[1]; + static integer iorni; + static logical negseg; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen); + static integer iofforn; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + static real xofforn; + + /* Fortran I/O blocks */ + static cilist io___830 = { 0, 6, 0, 0, 0 }; + + + +/* iornq: Main note. Do not alter if chord note, except turn on bit 23 */ +/* iornq0: Store iorni + bit 23, in case of repeated ornaments */ +/* iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. */ +/* noffseg: horiz. offset for segno */ +/* nole: level of note w/ orn, used to ID the note/orn if there's a level shift. */ + + +/* 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 13979 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 13980 "" + if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */ +/* ivx(0-3,28), ip(4-12), */ +/* vshift (vshift+32 in bits 13-18), */ +/* hshift (nint(10*vshift)+128 in bits 19-26) */ +/* bit 27 = 0 if caesura, 1 if breath */ +/* bit 28: 5th bit of ivx */ + +#line 13989 "" + *iornq = bit_set(*iornq,28); +#line 13990 "" + ++comcb_1.nbc; +/* ibcdata(nbc) = ivx+16*ip */ +#line 13992 "" + comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4); +#line 13993 "" + if (*ivx >= 16) { +#line 13993 "" + comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ + comcb_1.nbc - 1],28); +#line 13993 "" + } +#line 13994 "" + if (*(unsigned char *)charq == 'b') { +#line 13994 "" + comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[ + comcb_1.nbc - 1],27); +#line 13994 "" + } +#line 13995 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 13996 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* We have a vertical shift, get it */ + +#line 14000 "" + ++(*iccount); +#line 14001 "" + readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14002 "" + if (*(unsigned char *)durq == '-') { +#line 14002 "" + fnum = -fnum; +#line 14002 "" + } +#line 14003 "" + r__1 = fnum + 32; +#line 14003 "" + i__1 = i_nint(&r__1); +#line 14003 "" + setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1); +#line 14004 "" + if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Horizontal shift, get it */ + +#line 14008 "" + ++(*iccount); +#line 14009 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14010 "" + if (*(unsigned char *)charq == '-') { +#line 14010 "" + fnum = -fnum; +#line 14010 "" + } +#line 14011 "" + r__1 = fnum * 10; +#line 14011 "" + i__1 = i_nint(&r__1) + 128; +#line 14011 "" + setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, & + i__1); +#line 14012 "" + } +#line 14013 "" + } +#line 14014 "" + return 0; +#line 14015 "" + } + +/* 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 14020 "" + *iornq = bit_set(*iornq,23); + +/* Isolate 21 bits defining exisiting ornaments */ + +#line 14024 "" + if (*notcrd) { +/* iorni = iand(4194303,iornq) */ +/* iorni = iand(541065215,iornq) */ +#line 14027 "" + iorni = 1614807039 & *iornq; +#line 14028 "" + } else { +#line 14029 "" + iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1]; +#line 14030 "" + } +/* korn = index('stmgx+Tupf._)e:XXX>^',charq) */ +#line 14032 "" + korn = i_indx("stmgx+Tupf._)e:XXX>^XXXXXXXXCG", charq, (ftnlen)30, ( + ftnlen)1); +#line 14033 "" + if (korn != 15) { +#line 14033 "" + iorni = bit_set(iorni,korn); +#line 14033 "" + } + +/* 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 14039 "" + if (korn == 15) { + +/* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */ +/* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq */ +/* Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq */ + +/* iorni = ior(iorni,iand(iornq0,1638383)) */ +/* iorni = ior(iorni,iand(iornq0,3735535)) */ +/* iorni = ior(iorni,iand(iornq0,540606447)) */ +#line 14048 "" + iorni |= *iornq0 & 1614348271; +#line 14049 "" + *ornrpt = FALSE_; +#line 14050 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); + +/* durq will be ' ' */ + +#line 14054 "" + } else if (korn == 14) { + +/* Editorial accidental */ + +#line 14058 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +/* korn = 15+index('sfn',durq) */ +#line 14060 "" + korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15; +#line 14061 "" + if (korn == 19) { +#line 14061 "" + korn = 21; +#line 14061 "" + } +#line 14062 "" + iorni = bit_set(bit_clear(iorni,14),korn); +#line 14063 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14064 "" + if (*(unsigned char *)durq == '?') { + +/* This is "oe[s|f|n]?". Set 21st bit also. */ + +#line 14068 "" + iorni = bit_set(iorni,21); +#line 14069 "" + korn += 6; +#line 14070 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14071 "" + } +/* iorni = ibset(ibclr(iorni,14),korn) */ +#line 14073 "" + } else if (korn == 4 && *noxtup) { + +/* segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points */ + +#line 14077 "" + *noffseg = 0; +#line 14078 "" + negseg = FALSE_; +#line 14079 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14080 "" + if (*(unsigned char *)durq != ' ') { + +/* Segno shift is specified */ + +#line 14084 "" + if (*(unsigned char *)durq == '-') { +#line 14085 "" + negseg = TRUE_; +#line 14086 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14087 "" + } +#line 14088 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14089 "" + *noffseg = (integer) fnum; +#line 14090 "" + if (negseg) { +#line 14090 "" + *noffseg = -(*noffseg); +#line 14090 "" + } +#line 14091 "" + } +#line 14092 "" + } else if (korn == 7) { + +/* Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" */ + +#line 14096 "" + ++comtrill_1.ntrill; +#line 14097 "" + comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx; +#line 14098 "" + comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip; +#line 14099 "" + comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f; +#line 14100 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14101 "" + if (*(unsigned char *)durq == 't') { + +/* Convert to new internal symbol for non-'"tr" trill */ + +#line 14105 "" + korn = 15; +#line 14106 "" + iorni = bit_set(bit_clear(iorni,7),15); +#line 14107 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14108 "" + } +#line 14109 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { + +/* We have a number for the length */ + +#line 14113 "" + readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[ + comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1); +#line 14114 "" + } +#line 14115 "" + } else if (korn == 10 && *noxtup) { + +/* Fermata */ + +#line 14119 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14120 "" + if (*(unsigned char *)durq == 'd') { +#line 14121 "" + korn = 14; +#line 14122 "" + iorni = bit_set(bit_clear(iorni,10),14); +#line 14123 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14124 "" + } +#line 14125 "" + } else { +#line 14126 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 14127 "" + } +#line 14128 "" + if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) { +#line 14129 "" + s_wsle(&io___830); +#line 14129 "" + do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", ( + ftnlen)41); +#line 14129 "" + do_lio(&c__9, &c__1, durq, (ftnlen)1); +#line 14129 "" + e_wsle(); +#line 14130 "" + stop1_(); +#line 14131 "" + } +#line 14132 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Shift ornament up or down */ + +#line 14136 "" + ++comtrill_1.nudorn; + +/* Set bit 25 in iorni as a signal. This may not really be necessary. */ + +#line 14140 "" + 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 14145 "" + xofforn = (real) (44 - *(unsigned char *)durq); +#line 14146 "" + ++(*iccount); +#line 14147 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14148 "" + r__1 = xofforn * fnum; +#line 14148 "" + iofforn = i_nint(&r__1); +#line 14149 "" + comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (* + nole << 12) + (korn << 19) + (iofforn + 32 << 25); +#line 14151 "" + comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx; +#line 14152 "" + if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Horizontal shift */ + +#line 14156 "" + comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set( + comtrill_1.kudorn[comtrill_1.nudorn - 1],31); +#line 14157 "" + xofforn = (real) (44 - *(unsigned char *)durq); +#line 14158 "" + ++(*iccount); +#line 14159 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +/* 141226 ornhshft(nudorn) = nint(xofforn*fnum) */ +#line 14161 "" + comtrill_1.ornhshft[comtrill_1.nudorn - 1] = xofforn * fnum; +#line 14162 "" + } +#line 14163 "" + } else if (*(unsigned char *)durq == ':') { + +/* Turn on repeated ornaments */ + +#line 14167 "" + *ornrpt = TRUE_; + +/* Save the ornament value just set */ + +#line 14171 "" + *iornq0 = iorni; +#line 14172 "" + } +#line 14173 "" + if (*notcrd) { +#line 14174 "" + *iornq |= iorni; +#line 14175 "" + } else { +#line 14176 "" + comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni; +#line 14177 "" + } +#line 14178 "" + return 0; +} /* getorn_ */ + +/* Subroutine */ int getpmxmod_(logical *global, char *includeq, ftnlen + includeq_len) +{ + /* System generated locals */ + address a__1[3], a__2[2]; + integer i__1[3], i__2[2], i__3; + char ch__1[114], ch__2[106], ch__3[108], ch__4[88]; + olist o__1; + cllist cl__1; + inlist ioin__1; + + /* Builtin functions */ + integer f_inqu(inlist *); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), e_wsfe(void); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer f_open(olist *), s_rsfe(cilist *), do_fio(integer *, char *, + ftnlen), e_rsfe(void), f_clos(cllist *); + + /* Local variables */ + static integer ilbufmod, ipbufmod, lenbufmod, lenmodline; + static char pmxmoddirq[80]; + static integer lpmxmoddirq; + extern /* Subroutine */ int stop1_(void); + static integer ilbuff; + extern /* Subroutine */ int getenv_(char *, char *, ftnlen, ftnlen); + static logical fexist; + extern integer lenstr_(char *, integer *, ftnlen); + extern /* Subroutine */ int printl_(char *, ftnlen); + static char lnholdq[128]; + + /* Fortran I/O blocks */ + static cilist io___836 = { 0, 6, 0, 0, 0 }; + static cilist io___837 = { 0, 15, 0, "()", 0 }; + static cilist io___841 = { 0, 18, 1, "(a)", 0 }; + + + +/* If global=.true., checks for environment variable with path to pmx.mod. */ +/* Then, if variable exists and points to pmx.mod, insert lines from */ +/* pmx.mod into buffer */ +/* If global=.false., checks for existence of includeq and uses it. */ + +/* lenbuf0 = total length of bufq on entry */ +/* lbuf(i) = length of line (i) */ +/* nlbuf = number of lines stored in bufq */ +/* ilbuf = index of first line after setup stuff (on entry). In general, index of */ +/* next line to be sucked from buffer. */ +/* ilbufmod = counter for lines in pmx.mod as they are grabbed. */ +/* Starts at ilbuf. Points to position of next line after */ +/* pmx.mod stuff in bufq on exiting loop 1 */ +/* ilbuff = transient counter for shifting operations */ +/* ipbuf = on entry, points to last character in setup stuff. In general, points */ +/* to last character of most recent line sucked from buffer. */ +/* ipbufmod = points to last character of most recent inserted line */ +/* from pmx.mod */ + +#line 14212 "" + c1omget_1.line1pmxmod = inbuff_1.ilbuf; +#line 14213 "" + if (! (*global)) { +#line 14214 "" + ioin__1.inerr = 0; +#line 14214 "" + ioin__1.infilen = includeq_len; +#line 14214 "" + ioin__1.infile = includeq; +#line 14214 "" + ioin__1.inex = &fexist; +#line 14214 "" + ioin__1.inopen = 0; +#line 14214 "" + ioin__1.innum = 0; +#line 14214 "" + ioin__1.innamed = 0; +#line 14214 "" + ioin__1.inname = 0; +#line 14214 "" + ioin__1.inacc = 0; +#line 14214 "" + ioin__1.inseq = 0; +#line 14214 "" + ioin__1.indir = 0; +#line 14214 "" + ioin__1.infmt = 0; +#line 14214 "" + ioin__1.inform = 0; +#line 14214 "" + ioin__1.inunf = 0; +#line 14214 "" + ioin__1.inrecl = 0; +#line 14214 "" + ioin__1.innrec = 0; +#line 14214 "" + ioin__1.inblank = 0; +#line 14214 "" + f_inqu(&ioin__1); + +/* Transfer includeq to temporary char variable with known length */ + +#line 14218 "" + s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len); +#line 14219 "" + lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 14220 "" + s_wsle(&io___836); +#line 14220 "" + e_wsle(); +#line 14221 "" + s_wsfe(&io___837); +#line 14221 "" + e_wsfe(); +#line 14222 "" + if (! fexist) { +/* Writing concatenation */ +#line 14223 "" + i__1[0] = 15, a__1[0] = "Could not find "; +#line 14223 "" + i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; +#line 14223 "" + i__1[2] = 19, a__1[2] = ", checking further."; +#line 14223 "" + s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114); +#line 14223 "" + printl_(ch__1, lpmxmoddirq + 34); + +/* File named includeq doesn't not exist. Get directory from PMXMODDIR and */ +/* see if it's there */ + +#line 14229 "" + getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); +#line 14230 "" + lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 14231 "" + if (lpmxmoddirq > 0) { +/* Writing concatenation */ +#line 14232 "" + i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; +#line 14232 "" + i__2[1] = includeq_len, a__2[1] = includeq; +#line 14232 "" + s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); +#line 14233 "" + lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 14234 "" + } else { +#line 14235 "" + printl_("No other directory defined by PMXMODDIR, stopping", ( + ftnlen)49); +#line 14237 "" + stop1_(); +#line 14238 "" + } +#line 14239 "" + ioin__1.inerr = 0; +#line 14239 "" + ioin__1.infilen = 80; +#line 14239 "" + ioin__1.infile = pmxmoddirq; +#line 14239 "" + ioin__1.inex = &fexist; +#line 14239 "" + ioin__1.inopen = 0; +#line 14239 "" + ioin__1.innum = 0; +#line 14239 "" + ioin__1.innamed = 0; +#line 14239 "" + ioin__1.inname = 0; +#line 14239 "" + ioin__1.inacc = 0; +#line 14239 "" + ioin__1.inseq = 0; +#line 14239 "" + ioin__1.indir = 0; +#line 14239 "" + ioin__1.infmt = 0; +#line 14239 "" + ioin__1.inform = 0; +#line 14239 "" + ioin__1.inunf = 0; +#line 14239 "" + ioin__1.inrecl = 0; +#line 14239 "" + ioin__1.innrec = 0; +#line 14239 "" + ioin__1.inblank = 0; +#line 14239 "" + f_inqu(&ioin__1); +#line 14240 "" + if (! fexist) { +/* Writing concatenation */ +#line 14241 "" + i__1[0] = 15, a__1[0] = "Could not find "; +#line 14241 "" + i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq; +#line 14241 "" + i__1[2] = 11, a__1[2] = ", stopping."; +#line 14241 "" + s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106); +#line 14241 "" + printl_(ch__2, lpmxmoddirq + 26); +#line 14243 "" + stop1_(); +#line 14244 "" + } +#line 14245 "" + } +/* Writing concatenation */ +#line 14246 "" + i__2[0] = 28, a__2[0] = "Opening normal include file "; +#line 14246 "" + i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 14246 "" + s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); +#line 14246 "" + printl_(ch__3, lpmxmoddirq + 28); +#line 14248 "" + o__1.oerr = 0; +#line 14248 "" + o__1.ounit = 18; +#line 14248 "" + o__1.ofnmlen = 80; +#line 14248 "" + o__1.ofnm = pmxmoddirq; +#line 14248 "" + o__1.orl = 0; +#line 14248 "" + o__1.osta = 0; +#line 14248 "" + o__1.oacc = 0; +#line 14248 "" + o__1.ofm = 0; +#line 14248 "" + o__1.oblnk = 0; +#line 14248 "" + f_open(&o__1); +#line 14249 "" + } else { + +/* Check for existence of pmx.mod */ + +#line 14253 "" + getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80); +#line 14254 "" + lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80); +#line 14255 "" + if (lpmxmoddirq == 0) { +#line 14255 "" + return 0; +#line 14255 "" + } +/* Writing concatenation */ +#line 14256 "" + i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq; +#line 14256 "" + i__2[1] = 7, a__2[1] = "pmx.mod"; +#line 14256 "" + s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80); +#line 14257 "" + lpmxmoddirq += 7; +#line 14258 "" + ioin__1.inerr = 0; +#line 14258 "" + ioin__1.infilen = 80; +#line 14258 "" + ioin__1.infile = pmxmoddirq; +#line 14258 "" + ioin__1.inex = &fexist; +#line 14258 "" + ioin__1.inopen = 0; +#line 14258 "" + ioin__1.innum = 0; +#line 14258 "" + ioin__1.innamed = 0; +#line 14258 "" + ioin__1.inname = 0; +#line 14258 "" + ioin__1.inacc = 0; +#line 14258 "" + ioin__1.inseq = 0; +#line 14258 "" + ioin__1.indir = 0; +#line 14258 "" + ioin__1.infmt = 0; +#line 14258 "" + ioin__1.inform = 0; +#line 14258 "" + ioin__1.inunf = 0; +#line 14258 "" + ioin__1.inrecl = 0; +#line 14258 "" + ioin__1.innrec = 0; +#line 14258 "" + ioin__1.inblank = 0; +#line 14258 "" + f_inqu(&ioin__1); +#line 14259 "" + if (! fexist) { +#line 14259 "" + return 0; +#line 14259 "" + } +/* Writing concatenation */ +#line 14260 "" + i__2[0] = 28, a__2[0] = "Opening global include file "; +#line 14260 "" + i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 14260 "" + s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108); +#line 14260 "" + printl_(ch__3, lpmxmoddirq + 28); +#line 14262 "" + o__1.oerr = 0; +#line 14262 "" + o__1.ounit = 18; +#line 14262 "" + o__1.ofnmlen = lpmxmoddirq; +#line 14262 "" + o__1.ofnm = pmxmoddirq; +#line 14262 "" + o__1.orl = 0; +#line 14262 "" + o__1.osta = 0; +#line 14262 "" + o__1.oacc = 0; +#line 14262 "" + o__1.ofm = 0; +#line 14262 "" + o__1.oblnk = 0; +#line 14262 "" + f_open(&o__1); +#line 14263 "" + } +#line 14264 "" + printl_("Adding include data", (ftnlen)19); + +/* Read lines in from pmx.mod one at a time */ + +#line 14268 "" + ipbufmod = inbuff_1.ipbuf; +#line 14269 "" + lenbufmod = c1omget_1.lenbuf0; +#line 14270 "" + for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 4000; ++ilbufmod) { +#line 14271 "" + i__3 = s_rsfe(&io___841); +#line 14271 "" + if (i__3 != 0) { +#line 14271 "" + goto L3; +#line 14271 "" + } +#line 14271 "" + i__3 = do_fio(&c__1, lnholdq, (ftnlen)128); +#line 14271 "" + if (i__3 != 0) { +#line 14271 "" + goto L3; +#line 14271 "" + } +#line 14271 "" + i__3 = e_rsfe(); +#line 14271 "" + if (i__3 != 0) { +#line 14271 "" + goto L3; +#line 14271 "" + } + +/* A line was read. Slide all existing lengths from here forward ahead by 1 */ + +#line 14275 "" + i__3 = ilbufmod; +#line 14275 "" + for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) { +#line 14276 "" + inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1]; +#line 14277 "" +/* L2: */ +#line 14277 "" + } + +/* Get length of line from include file */ + +#line 14281 "" + lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128); +#line 14282 "" + if (lenmodline == 0) { + +/* Blank line. Make it a single blank with length 1 */ + +#line 14286 "" + lenmodline = 1; +#line 14287 "" + s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); +#line 14288 "" + } +#line 14289 "" + inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline; +#line 14290 "" + printl_(lnholdq, lenmodline); + +/* Insert new stuff into bufq */ + +#line 14294 "" + i__3 = ipbufmod; +/* Writing concatenation */ +#line 14294 "" + i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq; +#line 14294 "" + i__1[1] = lenmodline, a__1[1] = lnholdq; +#line 14294 "" + i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3; +#line 14294 "" + s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)65536); + +/* Update internal parameters */ + +#line 14299 "" + ipbufmod += inbuff_1.lbuf[ilbufmod - 1]; +#line 14300 "" + lenbufmod += inbuff_1.lbuf[ilbufmod - 1]; +#line 14301 "" + ++inbuff_1.nlbuf; +#line 14302 "" +/* L1: */ +#line 14302 "" + } +#line 14303 "" +L3: +/* Writing concatenation */ +#line 14304 "" + i__2[0] = 8, a__2[0] = "Closing "; +#line 14304 "" + i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq; +#line 14304 "" + s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88); +#line 14304 "" + printl_(ch__4, lpmxmoddirq + 8); +#line 14305 "" + cl__1.cerr = 0; +#line 14305 "" + cl__1.cunit = 18; +#line 14305 "" + cl__1.csta = 0; +#line 14305 "" + f_clos(&cl__1); +#line 14306 "" + c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod - + inbuff_1.ilbuf; +#line 14307 "" + 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 14312 "" + c1omget_1.nline += -2; + +#line 14314 "" + return 0; +} /* getpmxmod_ */ + +/* Subroutine */ int getset_(integer *nv, integer *noinst, integer *mtrnuml, + integer *mtrdenl, integer *mtrnmp, integer *mtrdnp, real *xmtrnum0, + integer *npages, integer *nsyst, integer *musicsize, real *fracindent, + logical *istype0, char *inameq, char *clefq, char *sepsymq, char * + pathnameq, integer *lpath, integer *isig0, ftnlen inameq_len, ftnlen + clefq_len, ftnlen sepsymq_len, ftnlen pathnameq_len) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1; + olist o__1; + + /* Builtin functions */ + integer s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *), s_wsfe( + cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), + i_nint(real *), i_indx(char *, char *, ftnlen, ftnlen), s_wsle( + cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle( + void); + + /* Local variables */ + static integer i__, iv, ivi, ipos, nline; + static char lineq[128]; + static integer iinst, jinst; + extern doublereal readin_(char *, integer *, integer *, ftnlen); + extern /* Subroutine */ int getbuf_(char *, ftnlen); + static logical newway; + static integer iccount, nvsofar; + + /* Fortran I/O blocks */ + static cilist io___847 = { 0, 17, 0, "(a)", 0 }; + static cilist io___857 = { 0, 6, 0, 0, 0 }; + + + +/* Get the first line */ + +#line 14330 "" + /* Parameter adjustments */ +#line 14330 "" + --sepsymq; +#line 14330 "" + --clefq; +#line 14330 "" + inameq -= 79; +#line 14330 "" + +#line 14330 "" + /* Function Body */ +#line 14330 "" + iccount = 0; +#line 14331 "" +L9: +#line 14331 "" + getbuf_(lineq, (ftnlen)128); +#line 14332 "" + if (*(unsigned char *)lineq == '%') { +#line 14332 "" + goto L9; +#line 14332 "" + } +#line 14333 "" + *istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0; +#line 14334 "" + if (*istype0) { + +/* Have TeX input until next line that starts with '---'. Save in scratch. */ + +#line 14338 "" + o__1.oerr = 0; +#line 14338 "" + o__1.ounit = 17; +#line 14338 "" + o__1.ofnm = 0; +#line 14338 "" + o__1.orl = 0; +#line 14338 "" + o__1.osta = "SCRATCH"; +#line 14338 "" + o__1.oacc = 0; +#line 14338 "" + o__1.ofm = 0; +#line 14338 "" + o__1.oblnk = 0; +#line 14338 "" + f_open(&o__1); +#line 14339 "" +L3: +#line 14339 "" + getbuf_(lineq, (ftnlen)128); +#line 14340 "" + if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) { +#line 14341 "" + s_wsfe(&io___847); +#line 14341 "" + do_fio(&c__1, lineq, (ftnlen)128); +#line 14341 "" + e_wsfe(); +#line 14342 "" + goto L3; +#line 14343 "" + } + +/* Force a new line read on first call to readin */ + +#line 14347 "" + iccount = 128; +#line 14348 "" + } + +/* Here, lineq is first line w/ numerical setup data. */ + +#line 14352 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14352 "" + *nv = i_nint(&r__1); +#line 14353 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14353 "" + *noinst = i_nint(&r__1); +#line 14354 "" + newway = *noinst <= 0; +#line 14355 "" + if (newway) { +#line 14355 "" + *noinst = -(*noinst); +#line 14355 "" + } +#line 14356 "" + i__1 = *noinst; +#line 14356 "" + for (iinst = 1; iinst <= i__1; ++iinst) { + +/* Seve # of staves per inst in case later drop some inst's. */ + +#line 14360 "" + if (newway) { + +/* Read in nvi for each instrument */ + +#line 14364 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14364 "" + comnvi_1.nsperi[iinst - 1] = i_nint(&r__1); +#line 14365 "" + } else if (iinst > 1) { +#line 14366 "" + comnvi_1.nsperi[iinst - 1] = 1; +#line 14367 "" + } else { +#line 14368 "" + comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1; +#line 14369 "" + } +#line 14370 "" + comnvi_1.iiorig[iinst - 1] = iinst; +#line 14371 "" + comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1]; +#line 14372 "" +/* L2: */ +#line 14372 "" + } +#line 14373 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14373 "" + *mtrnuml = i_nint(&r__1); +#line 14374 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14374 "" + *mtrdenl = i_nint(&r__1); +/* c */ +/* c Kluge to make mtrdenl work */ +/* c */ +/* if (mtrdenl .eq. 1) then */ +/* mtrdenl = 2 */ +/* mtrnuml = mtrnuml*2 */ +/* end if */ +#line 14382 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14382 "" + *mtrnmp = i_nint(&r__1); +#line 14383 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14383 "" + *mtrdnp = i_nint(&r__1); +#line 14384 "" + *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 14390 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14390 "" + *isig0 = i_nint(&r__1); +/* 130316 */ +/* do 11 iinst = 1 , noinst */ +/* midisig(iinst) = isig0 */ +#line 14394 "" + commidisig_1.midisig = *isig0; +/* 11 continue */ +#line 14396 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14396 "" + *npages = i_nint(&r__1); +#line 14397 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14397 "" + *nsyst = i_nint(&r__1); +#line 14398 "" + r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128); +#line 14398 "" + *musicsize = i_nint(&r__1); +#line 14399 "" + *fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128); + +/* Next noinst non-comment lines are names of instruments. */ + +#line 14403 "" + i__1 = *noinst; +#line 14403 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 14404 "" +L5: +#line 14404 "" + getbuf_(inameq + i__ * 79, (ftnlen)79); +#line 14405 "" + if (*(unsigned char *)&inameq[i__ * 79] == '%') { +#line 14405 "" + goto L5; +#line 14405 "" + } +#line 14406 "" +/* L4: */ +#line 14406 "" + } + +/* Next non-comment line has nv clef names */ + +#line 14410 "" +L6: +#line 14410 "" + getbuf_(lineq, (ftnlen)128); +#line 14411 "" + if (*(unsigned char *)lineq == '%') { +#line 14411 "" + goto L6; +#line 14411 "" + } +#line 14412 "" + iv = 0; +#line 14413 "" + nvsofar = 0; +#line 14414 "" + i__1 = *noinst; +#line 14414 "" + for (jinst = 1; jinst <= i__1; ++jinst) { +#line 14415 "" + nvsofar += comnvi_1.nsperi[jinst - 1]; +#line 14416 "" + i__2 = comnvi_1.nsperi[jinst - 1]; +#line 14416 "" + for (ivi = 1; ivi <= i__2; ++ivi) { +#line 14417 "" + ++iv; +#line 14418 "" + *(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1]; +#line 14419 "" + if (iv == nvsofar) { +#line 14420 "" + *(unsigned char *)&sepsymq[iv] = '&'; +#line 14421 "" + } else { +#line 14422 "" + *(unsigned char *)&sepsymq[iv] = '|'; +#line 14423 "" + } +#line 14424 "" +/* L10: */ +#line 14424 "" + } +#line 14425 "" +/* L1: */ +#line 14425 "" + } + +/* Mext non-comment line has path name */ + +#line 14429 "" +L8: +#line 14429 "" + getbuf_(pathnameq, (ftnlen)40); +#line 14430 "" + if (*(unsigned char *)pathnameq == '%') { +#line 14430 "" + goto L8; +#line 14430 "" + } +#line 14431 "" + *lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1; + +/* 160130 Replace '\' by '/' */ + +#line 14435 "" +L12: +#line 14435 "" + ipos = i_indx(pathnameq, "\\", (ftnlen)40, (ftnlen)1); +#line 14436 "" + if (ipos > 0) { +#line 14437 "" + *(unsigned char *)&pathnameq[ipos - 1] = '/'; +#line 14438 "" + s_wsle(&io___857); +#line 14438 "" + do_lio(&c__9, &c__1, "Changed pathname to ", (ftnlen)20); +#line 14438 "" + do_lio(&c__9, &c__1, pathnameq, (*lpath)); +#line 14438 "" + e_wsle(); +#line 14439 "" + goto L12; +#line 14440 "" + } +#line 14441 "" + return 0; +} /* getset_ */ + +doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote, + real *to) +{ + /* System generated locals */ + integer i__1; + real ret_val, r__1, r__2; + + /* Local variables */ + static integer in; + static real tend, tgovern; + + +/* Get the squez factor by checking space against tgovern=minimum duration */ +/* of all notes sounding at time of n-th note in the list. */ +/* The starting time of base increment is to(n) and ending time is to(n)+space */ +/* Sounding notes are those that start at or before to(n) .and. end at or */ +/* after tend=to(n)+space */ +/* Since notes are ordered by increasing start times, as soon as we find one */ +/* that starts too late, we are done checking. */ + +#line 14455 "" + /* Parameter adjustments */ +#line 14455 "" + --to; +#line 14455 "" + --tnote; +#line 14455 "" + +#line 14455 "" + /* Function Body */ +#line 14455 "" + tgovern = 1e3f; +#line 14456 "" + tend = to[*n] + *space; +#line 14457 "" + i__1 = *ntot; +#line 14457 "" + 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 14462 "" + if (to[in] > to[*n] + comtol_1.tol) { +#line 14462 "" + goto L2; +#line 14462 "" + } +#line 14463 "" + if (to[in] + tnote[in] > tend - comtol_1.tol) { + +/* If here, this note overlaps and must be tested. */ + +/* Computing MIN */ +#line 14467 "" + r__1 = tgovern, r__2 = tnote[in]; +#line 14467 "" + tgovern = dmin(r__1,r__2); +#line 14468 "" + } +#line 14469 "" +/* L1: */ +#line 14469 "" + } +#line 14470 "" +L2: +#line 14471 "" + ret_val = *space / tgovern; +#line 14472 "" + return ret_val; +} /* getsquez_ */ + +/* Subroutine */ int getx_(char *lineq, integer *iccount, integer *irest, + logical *shifton, real *wheadpt, integer *iornq1, integer *ivx, + integer *irest1, integer *itsofar, integer *ntup, integer *itup, + integer *nnodur, char *dotq, integer *ndoub, ftnlen lineq_len, ftnlen + dotq_len) +{ + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static logical ess; + static real fnum; + static char durq[1], charq[1]; + static logical colon, number; + static integer nextbl; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen); + extern integer ifnodur_(integer *, char *, ftnlen); + + +/* 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. */ +/* Since during getnote phase time is integer itsofar, which is not updated */ +/* during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if */ +/* not in xtup. */ + +#line 14488 "" + colon = FALSE_; +#line 14489 "" + ess = FALSE_; +#line 14490 "" + number = FALSE_; +#line 14491 "" + nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount - + 1), (ftnlen)1) - 1; +#line 14492 "" + if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen) + 1) > 0) { + +/* "Parts only", ignore entire symbol */ + +#line 14496 "" + *iccount = nextbl; +#line 14497 "" + return 0; +#line 14498 "" + } +#line 14499 "" +L1: +#line 14499 "" + getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 14500 "" + if (*(unsigned char *)charq == 'B') { + +/* "Both parts and score," ignore character */ + +#line 14504 "" + goto L1; +#line 14505 "" + } else if (*(unsigned char *)charq == ':') { +#line 14506 "" + colon = TRUE_; +#line 14507 "" + goto L1; +#line 14508 "" + } else if (*(unsigned char *)charq == 'S') { +#line 14509 "" + ess = TRUE_; +#line 14510 "" + goto L1; +#line 14511 "" + } else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) { +#line 14512 "" + number = TRUE_; +#line 14513 "" + if (*(unsigned char *)charq == '-') { +#line 14513 "" + ++(*iccount); +#line 14513 "" + } +#line 14514 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 14515 "" + if (*(unsigned char *)charq == '-') { +#line 14515 "" + fnum = -fnum; +#line 14515 "" + } +#line 14516 "" + if (*(unsigned char *)durq != 'p') { +#line 14517 "" + fnum *= *wheadpt; +#line 14518 "" + --(*iccount); +#line 14519 "" + } +#line 14520 "" + goto L1; +#line 14521 "" + } + +/* charq must be blank, so done parsing */ + +#line 14525 "" + if (! ess && ! colon) { + +/* Ordinary hardspace. Goes before next note. */ +/* (Later, at "|" or "/", check for presence and switch to udoff if there!) */ + +#line 14530 "" + ++comudsp_1.nudsp; +#line 14531 "" + *iornq1 = bit_set(*iornq1,26); +#line 14532 "" + comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum; +#line 14533 "" + comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar); +#line 14534 "" + if (*ntup > 0) { +#line 14534 "" + comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + * + ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1); +#line 14534 "" + } +/* * +float(itup-1)/ntup*ifnodur(nnodur,dotq) */ +#line 14537 "" + } else if (! number) { + +/* Must be "X:" End a group offset. */ + +#line 14541 "" + *irest = bit_set(*irest,17); +#line 14542 "" + *shifton = FALSE_; +#line 14543 "" + return 0; +#line 14544 "" + } else { + +/* Only other possibility is start offset, "S" for single, ':' for multiple */ + +#line 14548 "" + ++comudsp_1.nudoff[*ivx - 1]; +#line 14549 "" + comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum; +#line 14550 "" + if (ess) { +#line 14551 "" + *irest1 = bit_set(*irest1,15); +#line 14552 "" + } else { +#line 14553 "" + *irest1 = bit_set(*irest1,16); +#line 14554 "" + *shifton = TRUE_; +#line 14555 "" + } +#line 14556 "" + } +#line 14557 "" + return 0; +} /* getx_ */ + +integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int stop1_(void); + + /* Fortran I/O blocks */ + static cilist io___868 = { 0, 6, 0, 0, 0 }; + static cilist io___869 = { 0, 6, 0, 0, 0 }; + + +#line 14561 "" + if (*idur == 6) { +#line 14562 "" + ret_val = 1; +#line 14563 "" + } else if (*idur == 3) { +#line 14564 "" + ret_val = 2; +#line 14565 "" + } else if (*idur == 1) { +#line 14566 "" + ret_val = 4; +#line 14567 "" + } else if (*idur == 8) { +#line 14568 "" + ret_val = 8; +#line 14569 "" + } else if (*idur == 4) { +#line 14570 "" + ret_val = 16; +#line 14571 "" + } else if (*idur == 2) { +#line 14572 "" + ret_val = 32; +#line 14573 "" + } else if (*idur == 0) { +#line 14574 "" + ret_val = 64; +#line 14575 "" + } else if (*idur == 16) { + +/* Only used for denominator of time signatures, not for notes */ + +#line 14579 "" + ret_val = 4; +#line 14580 "" + } else if (*idur == 9) { +#line 14581 "" + ret_val = 128; +#line 14582 "" + } else { +#line 14583 "" + s_wsle(&io___868); +#line 14583 "" + e_wsle(); +#line 14584 "" + s_wsle(&io___869); +#line 14584 "" + do_lio(&c__9, &c__1, "You entered an invalid note-length value:", ( + ftnlen)41); +#line 14584 "" + do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer)); +#line 14584 "" + e_wsle(); +#line 14585 "" + stop1_(); +#line 14586 "" + } +#line 14587 "" + if (*(unsigned char *)dotq == 'd') { +#line 14587 "" + ret_val = ret_val * 3 / 2; +#line 14587 "" + } +#line 14588 "" + return ret_val; +} /* i1fnodur_ */ + +/* integer*4 function longi(ishort) */ +/* integer*2 ishort */ +/* longi = ishort */ +/* return */ +/* end */ +integer iashft_(integer *nacc) +{ + /* Initialized data */ + + static integer ias[6] = { -1,1,0,0,-2,2 }; + + /* System generated locals */ + integer ret_val; + +#line 14598 "" + ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4]; +#line 14599 "" + return ret_val; +} /* iashft_ */ + +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___871 = { 0, 6, 0, 0, 0 }; + + +#line 14603 "" + if (*idur == 6) { +#line 14604 "" + ret_val = 1; +#line 14605 "" + } else if (*idur == 3) { +#line 14606 "" + ret_val = 2; +#line 14607 "" + } else if (*idur == 1) { +#line 14608 "" + ret_val = 4; +#line 14609 "" + } else if (*idur == 8) { +#line 14610 "" + ret_val = 8; +#line 14611 "" + } else if (*idur == 4) { +#line 14612 "" + ret_val = 16; +#line 14613 "" + } else if (*idur == 2) { +#line 14614 "" + ret_val = 32; +#line 14615 "" + } else if (*idur == 0) { +#line 14616 "" + ret_val = 64; +#line 14617 "" + } else if (*idur == 9) { +#line 14618 "" + ret_val = 128; +#line 14619 "" + } else if (*idur == 16) { + +/* Only used for denominator of time signatures, not for notes */ + +#line 14623 "" + ret_val = 4; +#line 14624 "" + } else { +#line 14625 "" + s_wsle(&io___871); +#line 14625 "" + do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33); +#line 14625 "" + e_wsle(); +#line 14626 "" + s_stop("", (ftnlen)0); +#line 14627 "" + } +#line 14628 "" + if (*(unsigned char *)dotq == 'd') { +#line 14628 "" + ret_val = ret_val * 3 / 2; +#line 14628 "" + } +#line 14629 "" + return ret_val; +} /* ifnodur_ */ + +integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len) +{ + /* System generated locals */ + integer ret_val; + +#line 14634 "" + ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans; +#line 14635 "" + return ret_val; +} /* ifnolev_ */ + +/* subroutine report(nsdat,isdat1,isdat2) */ +/* integer*4 isdat1(202),isdat2(202) */ +/* write(*,'(a)') */ +/* * ' isd on? iv kv ip id ud1 ud2 ndx ivo iho lev crd lhd rhd' */ +/* do 1 isdat = 1 , nsdat */ +/* isdata = isdat1(isdat) */ +/* ionoff = igetbits(isdata,1,11) */ +/* c iv = iand(7,isdata) */ +/* iv = igetbits(isdata,5,13) */ +/* kv = igetbits(isdata,1,12)+1 */ +/* ip = igetbits(isdata,8,3) */ +/* idcode = igetbits(isdata,7,19) */ +/* iud1 = igetbits(isdata,1,26) */ +/* iud2 = igetbits(isdata,1,27) */ +/* ndxslur = igetbits(isdata,4,28) */ +/* isdatb = isdat2(isdat) */ +/* ivo = igetbits(isdatb,6,6)-32 */ +/* iho = igetbits(isdatb,7,12)-64 */ +/* lev = igetbits(isdatb,7,19) */ +/* icrd = igetbits(isdatb,1,0) */ +/* lhd = igetbits(isdatb,1,1) */ +/* irhd = igetbits(isdatb,7,2) */ +/* write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur, */ +/* * ivo,iho,lev,icrd,lhd,irhd */ +/* 1 continue */ +/* print* */ +/* return */ +/* end */ +integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer pow_ii(integer *, integer *), lbit_shift(integer, integer); + + +/* Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */ +/* then added to ioff */ + +#line 14670 "" + ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift)); +#line 14671 "" + return ret_val; +} /* igetbits_ */ + +integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer * + nbytes) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + extern /* Subroutine */ int stop1_(void); + + /* Fortran I/O blocks */ + static cilist io___872 = { 0, 6, 0, 0, 0 }; + + + +/* Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */ + +#line 14679 "" + /* Parameter adjustments */ +#line 14679 "" + mmidi -= 25; +#line 14679 "" + +#line 14679 "" + /* Function Body */ +#line 14679 "" + ret_val = 0; +#line 14680 "" + for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { +#line 14681 "" + ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) * + 25]); +/* * +iand(127,longi(mmidi(icm,imidi+nbytes))) */ +#line 14684 "" + if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) { +#line 14684 "" + return ret_val; +#line 14684 "" + } +/* if (.not.btest(longi(mmidi(icm,imidi+nbytes)),7)) return */ +#line 14686 "" +/* L1: */ +#line 14686 "" + } +#line 14687 "" + s_wsle(&io___872); +#line 14687 "" + do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20); +#line 14687 "" + e_wsle(); +#line 14688 "" + stop1_(); +#line 14689 "" + return ret_val; +} /* igetvarlen_ */ + +logical isdotted_(integer *nodur, integer *ivx, integer *ip) +{ + /* System generated locals */ + real r__1; + logical ret_val; + + /* Builtin functions */ + double log(doublereal), r_mod(real *, real *); + + +/* Function returns true if note is dotted or double-dotted. */ +/* Return false for any xtuplet. */ + +#line 14698 "" + /* Parameter adjustments */ +#line 14698 "" + nodur -= 25; +#line 14698 "" + +#line 14698 "" + /* Function Body */ +#line 14698 "" + if (nodur[*ivx + *ip * 24] == 0) { +#line 14699 "" + ret_val = FALSE_; +#line 14700 "" + return ret_val; +#line 14701 "" + } else if (*ip > 1) { +#line 14702 "" + if (nodur[*ivx + (*ip - 1) * 24] == 0) { +#line 14703 "" + ret_val = FALSE_; +#line 14704 "" + return ret_val; +#line 14705 "" + } +#line 14706 "" + } + +/* Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */ + +#line 14710 "" + r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol * + .5f; +#line 14710 "" + ret_val = r_mod(&r__1, &c_b814) > comtol_1.tol; +#line 14712 "" + return ret_val; +} /* isdotted_ */ + +integer isetvarlen_(integer *idur, integer *nbytes) +{ + /* System generated locals */ + integer ret_val, i__1; + + /* Builtin functions */ + integer pow_ii(integer *, integer *), lbit_shift(integer, integer), + s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + + /* Local variables */ + extern /* Subroutine */ int stop1_(void); + static integer itemp; + + /* Fortran I/O blocks */ + static cilist io___874 = { 0, 6, 0, 0, 0 }; + + +#line 14715 "" + ret_val = 0; +#line 14716 "" + itemp = *idur; +#line 14717 "" + for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) { +#line 14718 "" + i__1 = *nbytes - 1; +#line 14718 "" + ret_val += (itemp & 127) * pow_ii(&c__256, &i__1); +#line 14719 "" + itemp = lbit_shift(itemp, (ftnlen)-7); +#line 14720 "" + if (itemp > 0) { +#line 14721 "" + i__1 = (*nbytes << 3) + 7; +#line 14721 "" + ret_val += pow_ii(&c__2, &i__1); +#line 14722 "" + } else { +#line 14723 "" + return ret_val; +#line 14724 "" + } +#line 14725 "" +/* L1: */ +#line 14725 "" + } +#line 14726 "" + s_wsle(&io___874); +#line 14726 "" + do_lio(&c__9, &c__1, "Problem in function isetvarlen", (ftnlen)30); +#line 14726 "" + e_wsle(); +#line 14727 "" + stop1_(); +#line 14728 "" + return ret_val; +} /* isetvarlen_ */ + +/* Subroutine */ int istring_(integer *i__, char *string, integer *len, + ftnlen string_len) +{ + /* System generated locals */ + address a__1[3], a__2[2]; + integer i__1[3], i__2[2]; + real r__1; + char ch__1[1], ch__2[4]; + icilist ici__1; + + /* Builtin functions */ + double r_lg10(real *); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + +/* Returns string with integer only if length is 1, otherwise enclosed in */ +/* brackets. */ + +#line 14735 "" + if (*i__ != 0) { +#line 14736 "" + r__1 = abs(*i__) * 1.0001f; +#line 14736 "" + *len = r_lg10(&r__1) + 1; +#line 14737 "" + if (*i__ < 0) { +#line 14737 "" + ++(*len); +#line 14737 "" + } +#line 14738 "" + } else { +#line 14739 "" + s_copy(string, "0", string_len, (ftnlen)1); +#line 14740 "" + *len = 1; +#line 14741 "" + return 0; +#line 14742 "" + } +#line 14743 "" + if (*len == 1) { +#line 14744 "" + *(unsigned char *)&ch__1[0] = *i__ + 48; +#line 14744 "" + s_copy(string, ch__1, string_len, (ftnlen)1); +#line 14745 "" + } else { +#line 14746 "" + s_copy(string, "{", string_len, (ftnlen)1); +#line 14747 "" + ici__1.icierr = 0; +#line 14747 "" + ici__1.icirnum = 1; +#line 14747 "" + ici__1.icirlen = *len; +#line 14747 "" + ici__1.iciunit = string + 1; +/* Writing concatenation */ +#line 14747 "" + i__1[0] = 2, a__1[0] = "(i"; +#line 14747 "" + *(unsigned char *)&ch__1[0] = *len + 48; +#line 14747 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 14747 "" + i__1[2] = 1, a__1[2] = ")"; +#line 14747 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2); +#line 14747 "" + s_wsfi(&ici__1); +#line 14747 "" + do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 14747 "" + e_wsfi(); +/* Writing concatenation */ +#line 14748 "" + i__2[0] = *len + 1, a__2[0] = string; +#line 14748 "" + i__2[1] = 1, a__2[1] = "}"; +#line 14748 "" + s_cat(string, a__2, i__2, &c__2, string_len); +#line 14749 "" + *len += 2; +#line 14750 "" + } +#line 14751 "" + return 0; +} /* istring_ */ + +integer lenstr_(char *string, integer *n, ftnlen string_len) +{ + /* System generated locals */ + integer ret_val; + +#line 14755 "" + for (ret_val = *n; ret_val >= 1; --ret_val) { +#line 14756 "" + if (*(unsigned char *)&string[ret_val - 1] != ' ') { +#line 14756 "" + return ret_val; +#line 14756 "" + } +#line 14757 "" +/* L1: */ +#line 14757 "" + } +#line 14758 "" + ret_val = 0; +#line 14759 "" + return ret_val; +} /* lenstr_ */ + +integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm, + integer *mult) +{ + /* System generated locals */ + integer ret_val; + + /* Local variables */ + static integer ioff; + + +/* 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 14767 "" + if (! bit_test(*irest,0)) { +#line 14768 "" + ret_val = *nolev; +#line 14769 "" + } else { + +/* Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. */ + +#line 14773 "" + if (*mult > 0) { +#line 14774 "" + if (*mult == 2) { +#line 14775 "" + ioff = (*iud << 1) - 1; +#line 14776 "" + } else if (*mult != 4) { +#line 14777 "" + ioff = *iud * *mult; +#line 14778 "" + } else { +#line 14779 "" + ioff = (*iud << 2) + 1; +#line 14780 "" + } +#line 14781 "" + } else { + +/* May need to futz with this later for non-beamed xtups (quarter, half rests) */ + +#line 14785 "" + ioff = *iud << 1; +#line 14786 "" + } +#line 14787 "" + ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff; +#line 14788 "" + } +#line 14789 "" + return ret_val; +} /* levrn_ */ + +integer lfmt1_(real *x) +{ + /* System generated locals */ + integer ret_val; + real r__1; + + /* Builtin functions */ + double r_sign(real *, real *), r_lg10(real *); + + /* Local variables */ + static real y; + + +/* Computes total length of an "f" format with one decimal place. */ +/* First round to nearest 0.1 */ + +#line 14796 "" + if (dabs(*x) < .001f) { +#line 14797 "" + ret_val = 2; +#line 14798 "" + } else { +#line 14799 "" + r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f; +#line 14799 "" + y = r_sign(&r__1, x); +#line 14800 "" + r__1 = dabs(y) * 1000 + .001f; +#line 14800 "" + ret_val = (integer) r_lg10(&r__1); +#line 14801 "" + if (y < 0.f) { +#line 14801 "" + ++ret_val; +#line 14801 "" + } +#line 14802 "" + } +#line 14803 "" + return ret_val; +} /* lfmt1_ */ + +/* Subroutine */ int linebreakties_(integer *isdat1, integer *isdat2, integer + *isdat3, integer *isdat4, integer *nsdat, logical *ispstie, char * + sepsymq, ftnlen sepsymq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3], a__3[5], a__4[4]; + integer i__1, i__2[2], i__3[3], i__4[5], i__5[4]; + real r__1; + char ch__1[1], ch__2[1]; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + extern /* Subroutine */ int writflot_(real *, char *, integer *, ftnlen); + static integer iv, kv, ncm; + static logical tie; + static integer iiv; + static char udq[1]; + static integer ndx, ilb12; + static real hoff; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer imid, ihoff, isdat, ivoff, lnote; + static char noteq[8]; + static integer idcode, islhgt; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten; + static char notexq[128]; + + /* Fortran I/O blocks */ + static cilist io___896 = { 0, 11, 0, "(a)", 0 }; + + + +/* This is called twice from pmxb after having input an entire block, before */ +/* making a bar that starts a new system. So nsdat reflects all slur starts */ +/* and stops in new block, while listslur, which is only set when bars are */ +/* made, reflects only open slurs from the old block. So we must check */ +/* listslur to find open ties, not all nsdat. */ +/* First of two calls (ispstie=.false. on entry) terminates tie at end of line. */ +/* Second (ispstie=.true. on entry) restarts tie at start of new line. Only */ +/* need data from original tie-start for both of these. Tie/slur data from */ +/* closing of full tie are not used except for shape alterations. */ + +/* do 1 ndx = 0 , 11 */ +#line 14828 "" + /* Parameter adjustments */ +#line 14828 "" + --sepsymq; +#line 14828 "" + --isdat4; +#line 14828 "" + --isdat3; +#line 14828 "" + --isdat2; +#line 14828 "" + --isdat1; +#line 14828 "" + +#line 14828 "" + /* Function Body */ +#line 14828 "" + for (ndx = 0; ndx <= 23; ++ndx) { +#line 14829 "" + 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 14833 "" + i__1 = *nsdat; +#line 14833 "" + for (isdat = 1; isdat <= i__1; ++isdat) { +/* if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */ +#line 14835 "" + if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(& + isdat1[isdat], &c__1, &c__18) << 4) != ndx) { +#line 14835 "" + goto L2; +#line 14835 "" + } +/* Wron */ +#line 14837 "" + if (! bit_test(isdat1[isdat],11)) { +#line 14837 "" + goto L2; +#line 14837 "" + } +/* Bypass if stop */ +#line 14838 "" + if (bit_test(isdat2[isdat],3)) { +#line 14838 "" + goto L3; +#line 14838 "" + } +/* "st" */ +#line 14839 "" + idcode = igetbits_(&isdat1[isdat], &c__7, &c__19); +#line 14840 "" + if (idcode == 1) { +#line 14840 "" + goto L3; +#line 14840 "" + } +/* "t" */ +#line 14841 "" + tie = FALSE_; +#line 14842 "" + goto L5; +#line 14843 "" +L2: +#line 14843 "" + ; +#line 14843 "" + } +#line 14844 "" + } +#line 14845 "" + goto L1; +#line 14846 "" +L3: +#line 14847 "" + tie = TRUE_; +#line 14848 "" +L5: + +/* A slur or tie is open, with index ndx */ + +#line 14852 "" + iv = igetbits_(&isdat1[isdat], &c__5, &c__13); +#line 14853 "" + kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1; +#line 14854 "" + *(unsigned char *)udq = 'd'; +#line 14855 "" + if (bit_test(isdat1[isdat],27)) { +#line 14855 "" + *(unsigned char *)udq = 'u'; +#line 14855 "" + } +/* Writing concatenation */ +#line 14856 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14856 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 14856 "" + i__2[1] = 6, a__1[1] = "znotes"; +#line 14856 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14857 "" + lnote = 7; +#line 14858 "" + i__1 = iv - 1; +#line 14858 "" + for (iiv = 1; iiv <= i__1; ++iiv) { +/* Writing concatenation */ +#line 14859 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14859 "" + i__2[1] = 1, a__1[1] = sepsymq + iiv; +#line 14859 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14860 "" + ++lnote; +#line 14861 "" +/* L4: */ +#line 14861 "" + } +#line 14862 "" + if (kv == 2) { +/* Writing concatenation */ +#line 14863 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 14863 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14863 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 14863 "" + i__3[2] = 9, a__2[2] = "nextvoice"; +#line 14863 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 14864 "" + lnote += 10; +#line 14865 "" + } + +/* Compute horiz and vert offsets */ + +/* nolev = igetbits(isdat2(isdat),7,19) */ +#line 14870 "" + islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14); +#line 14871 "" + ilb12 = 0; +#line 14872 "" + if (*ispstie) { +#line 14872 "" + ilb12 = 1; +#line 14872 "" + } +#line 14873 "" + i__1 = ilb12 << 4; +#line 14873 "" + ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32; +#line 14874 "" + if (ivoff == -32) { +#line 14874 "" + ivoff = 0; +#line 14874 "" + } +/* nolev = nolev+ivoff */ +#line 14876 "" + islhgt += ivoff; +#line 14877 "" + i__1 = (ilb12 << 4) + 6; +#line 14877 "" + ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64; +/* This is 10X */ +#line 14878 "" + if (ihoff == -64) { +#line 14878 "" + ihoff = 0; +#line 14878 "" + } + +/* Add starting stuff for command */ + +#line 14882 "" + if (! (*ispstie)) { +/* End 1st segment */ +/* Writing concatenation */ +#line 14883 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 14883 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14883 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 14883 "" + i__3[2] = 8, a__2[2] = "roffset{"; +#line 14883 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 14884 "" + lnote += 9; +/* hoff = ihoff*.1-.5 */ +/* hoff = ihoff*.1-.8 */ +#line 14887 "" + hoff = ihoff * .1f - .4f; +#line 14888 "" + if (hoff < 0.f) { +#line 14889 "" + hoff = -hoff; +/* Writing concatenation */ +#line 14890 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14890 "" + i__2[1] = 1, a__1[1] = "-"; +#line 14890 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14891 "" + ++lnote; +#line 14892 "" + } +#line 14893 "" + writflot_(&hoff, notexq, &lnote, (ftnlen)128); +/* Writing concatenation */ +#line 14894 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14894 "" + i__2[1] = 2, a__1[1] = "}{"; +#line 14894 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14895 "" + lnote += 2; +#line 14896 "" + } else { +/* Writing concatenation */ +#line 14897 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 14897 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14897 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 14897 "" + i__4[2] = 5, a__3[2] = "off{-"; +#line 14897 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 14897 "" + i__4[3] = 1, a__3[3] = ch__2; +#line 14897 "" + i__4[4] = 14, a__3[4] = "afterruleskip}"; +#line 14897 "" + s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); +#line 14899 "" + lnote += 21; + +/* 091025 add dotting for 2nd segment if needed */ + +#line 14903 "" + if (bit_test(isdat2[isdat],4)) { +/* Writing concatenation */ +#line 14904 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14904 "" + i__3[0] = 1, a__2[0] = ch__1; +#line 14904 "" + i__3[1] = 6, a__2[1] = "dotted"; +#line 14904 "" + i__3[2] = lnote, a__2[2] = notexq; +#line 14904 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 14905 "" + lnote += 7; +#line 14906 "" + } +#line 14907 "" + } +#line 14908 "" + if (*ispstie && tie) { +/* Writing concatenation */ +#line 14909 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14909 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14909 "" + i__5[1] = 1, a__4[1] = ch__1; +#line 14909 "" + i__5[2] = 8, a__4[2] = "tieforis"; +#line 14909 "" + i__5[3] = 1, a__4[3] = udq; +#line 14909 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14910 "" + lnote += 10; +#line 14911 "" + } +#line 14912 "" + if (bit_test(isdat3[isdat],0)) { + +/* Curvature tweak on termination of 1st seg */ + +#line 14916 "" + imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32; + +/* Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: */ +/* Abs(imid) Postscript slur type */ +/* 1 f */ +/* 4 h */ +/* 5 H */ +/* 6 HH */ + +/* Writing concatenation */ +#line 14925 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14925 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14925 "" + i__5[1] = 1, a__4[1] = ch__1; +#line 14925 "" + i__5[2] = 7, a__4[2] = "psforts"; +#line 14925 "" + i__1 = imid + 48; +#line 14925 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 14925 "" + i__5[3] = 1, a__4[3] = ch__2; +#line 14925 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14926 "" + lnote += 9; + +/* Zero out the flag in case there's a different curv on term of 2nd, */ + +#line 14930 "" + isdat3[isdat] = bit_clear(isdat3[isdat],0); +#line 14931 "" + } + +/* Add the command name */ + +#line 14935 "" + if (*ispstie) { +/* Writing concatenation */ +#line 14936 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14936 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14936 "" + i__5[1] = 1, a__4[1] = ch__1; +#line 14936 "" + i__5[2] = 2, a__4[2] = "is"; +#line 14936 "" + i__5[3] = 1, a__4[3] = udq; +#line 14936 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14937 "" + lnote += 4; +#line 14938 "" + } else if (tie) { +/* Writing concatenation */ +#line 14939 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 14939 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14939 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 14939 "" + i__3[2] = 4, a__2[2] = "ttie"; +#line 14939 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 14940 "" + lnote += 5; +#line 14941 "" + } else { +/* Writing concatenation */ +#line 14942 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 14942 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 14942 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 14942 "" + i__3[2] = 5, a__2[2] = "tslur"; +#line 14942 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 14943 "" + lnote += 6; +#line 14944 "" + } + +/* Add index */ + +/* if (11-ndx .lt. 10) then */ +/* notexq = notexq(1:lnote)//chax(59-ndx) */ +/* lnote = lnote+1 */ +/* else */ +/* notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */ +/* lnote = lnote+4 */ +/* end if */ +#line 14955 "" + if (23 - ndx < 10) { +/* Writing concatenation */ +#line 14956 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14956 "" + i__1 = 71 - ndx; +#line 14956 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 14956 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 14956 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14957 "" + ++lnote; +#line 14958 "" + } else if (23 - ndx < 20) { +/* Writing concatenation */ +#line 14959 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14959 "" + i__5[1] = 2, a__4[1] = "{1"; +#line 14959 "" + i__1 = 61 - ndx; +#line 14959 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 14959 "" + i__5[2] = 1, a__4[2] = ch__1; +#line 14959 "" + i__5[3] = 1, a__4[3] = "}"; +#line 14959 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14960 "" + lnote += 4; +#line 14961 "" + } else { +/* Writing concatenation */ +#line 14962 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14962 "" + i__5[1] = 2, a__4[1] = "{2"; +#line 14962 "" + i__1 = 51 - ndx; +#line 14962 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 14962 "" + i__5[2] = 1, a__4[2] = ch__1; +#line 14962 "" + i__5[3] = 1, a__4[3] = "}"; +#line 14962 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14963 "" + lnote += 4; +#line 14964 "" + } +#line 14965 "" + if (*ispstie || ! tie) { + +/* Add note name for slur height */ + +#line 14969 "" + comoct_1.noctup = 0; +#line 14970 "" + ncm = igetbits_(&isdat3[isdat], &c__8, &c__22); +#line 14971 "" + if (ncm == 23) { +#line 14971 "" + comoct_1.noctup = -2; +#line 14971 "" + } +/* call notefq(noteq,lnoten,nolev,ncm) */ +#line 14973 "" + notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8); +/* Writing concatenation */ +#line 14974 "" + i__5[0] = lnote, a__4[0] = notexq; +#line 14974 "" + i__5[1] = 1, a__4[1] = "{"; +#line 14974 "" + i__5[2] = lnoten, a__4[2] = noteq; +#line 14974 "" + i__5[3] = 1, a__4[3] = "}"; +#line 14974 "" + s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128); +#line 14975 "" + lnote = lnote + 1 + lnoten + 1; +#line 14976 "" + } +#line 14977 "" + if (*ispstie) { + +/* Horizontal shift start of new thing */ + +/* Writing concatenation */ +#line 14981 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14981 "" + i__2[1] = 1, a__1[1] = "{"; +#line 14981 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14982 "" + ++lnote; +/* ihoff = ihoff-13 */ +#line 14984 "" + if (tie) { +#line 14985 "" + ihoff += -12; +#line 14986 "" + } else { +#line 14987 "" + ihoff += -7; +#line 14988 "" + } +#line 14989 "" + if (ihoff < 0) { +#line 14990 "" + ihoff = -ihoff; +/* Writing concatenation */ +#line 14991 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14991 "" + i__2[1] = 1, a__1[1] = "-"; +#line 14991 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14992 "" + ++lnote; +#line 14993 "" + } +#line 14994 "" + r__1 = ihoff * .1f; +#line 14994 "" + writflot_(&r__1, notexq, &lnote, (ftnlen)128); +/* Writing concatenation */ +#line 14995 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 14995 "" + i__2[1] = 1, a__1[1] = "}"; +#line 14995 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 14996 "" + ++lnote; +#line 14997 "" + } + +/* Add closing stuff */ + +#line 15001 "" + if (*ispstie) { +/* Writing concatenation */ +#line 15002 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 15002 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15002 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 15002 "" + i__4[2] = 4, a__3[2] = "off{"; +#line 15002 "" + chax_(ch__2, (ftnlen)1, &c__92); +#line 15002 "" + i__4[3] = 1, a__3[3] = ch__2; +#line 15002 "" + i__4[4] = 14, a__3[4] = "afterruleskip}"; +#line 15002 "" + s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128); +#line 15004 "" + lnote += 20; +#line 15005 "" + } else { +/* Writing concatenation */ +#line 15006 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 15006 "" + i__2[1] = 1, a__1[1] = "}"; +#line 15006 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128); +#line 15007 "" + ++lnote; +#line 15008 "" + } +/* Writing concatenation */ +#line 15009 "" + i__3[0] = lnote, a__2[0] = notexq; +#line 15009 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15009 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 15009 "" + i__3[2] = 3, a__2[2] = "en%"; +#line 15009 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128); +#line 15010 "" + lnote += 4; +#line 15011 "" + s_wsfe(&io___896); +#line 15011 "" + do_fio(&c__1, notexq, lnote); +#line 15011 "" + e_wsfe(); +#line 15012 "" +L1: +#line 15012 "" + ; +#line 15012 "" + } +#line 15013 "" + *ispstie = ! (*ispstie); +#line 15014 "" + return 0; +} /* linebreakties_ */ + +/* Subroutine */ int littex_(integer *islur, integer *nnl, integer *iv, + logical *topmods, char *lineq, integer *iccount, ftnlen lineq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1[2], i__2[3]; + char ch__1[1], ch__2[129]; + olist o__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void), f_open(olist *); + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char durq[1]; + extern /* Subroutine */ int stop1_(void); + static logical merge; + static integer itype; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen); + + /* Fortran I/O blocks */ + static cilist io___900 = { 0, 6, 0, 0, 0 }; + static cilist io___901 = { 0, 6, 0, 0, 0 }; + static cilist io___902 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___903 = { 0, 11, 0, "(a)", 0 }; + static cilist io___904 = { 0, 16, 0, "(a)", 0 }; + + +#line 15032 "" + /* Parameter adjustments */ +#line 15032 "" + islur -= 25; +#line 15032 "" + +#line 15032 "" + /* Function Body */ +#line 15032 "" + merge = FALSE_; +#line 15033 "" + if (comgrace_1.nlit > 0) { +#line 15034 "" + merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl == + comgrace_1.iplit[comgrace_1.nlit - 1]; +#line 15035 "" + } +#line 15036 "" + ++comgrace_1.nlit; +#line 15037 "" + comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv; +#line 15038 "" + comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl; +#line 15039 "" + itype = 1; +#line 15040 "" +L17: +#line 15040 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15041 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15041 "" + if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { +#line 15042 "" + ++itype; +#line 15043 "" + goto L17; +#line 15044 "" + } +/* Writing concatenation */ +#line 15045 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15045 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 15045 "" + i__1[1] = 1, a__1[1] = durq; +#line 15045 "" + s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, ( + ftnlen)128); +#line 15046 "" + comgrace_1.lenlit[comgrace_1.nlit - 1] = 2; +#line 15047 "" +L18: +#line 15047 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15048 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15048 "" + if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) { +#line 15049 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 15050 "" + if (*(unsigned char *)durq != ' ') { + +/* Starting a new tex command within the string */ + +/* Writing concatenation */ +#line 15054 "" + i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] = + comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 15054 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 15054 "" + i__2[1] = 1, a__2[1] = ch__1; +#line 15054 "" + i__2[2] = 1, a__2[2] = durq; +#line 15054 "" + s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, & + c__3, (ftnlen)128); +#line 15055 "" + comgrace_1.lenlit[comgrace_1.nlit - 1] += 2; +#line 15056 "" + goto L18; +#line 15057 "" + } +#line 15058 "" + } else { +/* Writing concatenation */ +#line 15059 "" + i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = + comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 15059 "" + i__1[1] = 1, a__1[1] = durq; +#line 15059 "" + s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, + (ftnlen)128); +#line 15060 "" + ++comgrace_1.lenlit[comgrace_1.nlit - 1]; +#line 15061 "" + goto L18; +#line 15062 "" + } + +/* If here, just read backslash-blank so string is done */ + +#line 15066 "" + if (itype == 1) { +#line 15067 "" + islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16); +#line 15068 "" + if (merge) { + +/* There are 2 separate strings on the same note, so merge them. */ + +#line 15072 "" + --comgrace_1.nlit; +/* Writing concatenation */ +#line 15073 "" + i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = + comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 15073 "" + i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] = + comgrace_1.litq + (comgrace_1.nlit << 7); +#line 15073 "" + s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, & + c__2, (ftnlen)128); +#line 15075 "" + comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[ + comgrace_1.nlit]; +#line 15076 "" + if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) { +#line 15077 "" + s_wsle(&io___900); +#line 15077 "" + e_wsle(); +#line 15078 "" + s_wsle(&io___901); +#line 15078 "" + do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "\ + "128 characters", (ftnlen)52); +#line 15078 "" + e_wsle(); +#line 15080 "" + s_wsfe(&io___902); +#line 15080 "" + do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"\ + "racters", (ftnlen)52); +#line 15080 "" + e_wsfe(); +#line 15082 "" + stop1_(); +#line 15083 "" + } +#line 15084 "" + } +#line 15085 "" + } else { + +/* Type 2 or 3. */ + +#line 15089 "" + if (itype == 3) { + +/* Write the string NOW */ + +#line 15093 "" + if (comlast_1.islast) { +#line 15093 "" + s_wsfe(&io___903); +/* Writing concatenation */ +#line 15093 "" + i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = + comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 15093 "" + i__1[1] = 1, a__1[1] = "%"; +#line 15093 "" + s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); +#line 15093 "" + do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + + 1); +#line 15093 "" + e_wsfe(); +#line 15093 "" + } +#line 15095 "" + } else { + +/* Must go at top */ + +#line 15099 "" + if (! (*topmods)) { +#line 15100 "" + *topmods = TRUE_; +#line 15101 "" + o__1.oerr = 0; +#line 15101 "" + o__1.ounit = 16; +#line 15101 "" + o__1.ofnm = 0; +#line 15101 "" + o__1.orl = 0; +#line 15101 "" + o__1.osta = "SCRATCH"; +#line 15101 "" + o__1.oacc = 0; +#line 15101 "" + o__1.ofm = 0; +#line 15101 "" + o__1.oblnk = 0; +#line 15101 "" + f_open(&o__1); +#line 15102 "" + } + +/* Must write '%' here rather than later, in case string ends with blank. */ + +#line 15106 "" + s_wsfe(&io___904); +/* Writing concatenation */ +#line 15106 "" + i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] = + comgrace_1.litq + (comgrace_1.nlit - 1 << 7); +#line 15106 "" + i__1[1] = 1, a__1[1] = "%"; +#line 15106 "" + s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129); +#line 15106 "" + do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1); +#line 15106 "" + e_wsfe(); +#line 15107 "" + } +#line 15108 "" + --comgrace_1.nlit; +#line 15109 "" + } +#line 15110 "" + return 0; +} /* littex_ */ + +integer llen_(char *strq, integer *n, ftnlen strq_len) +{ + /* System generated locals */ + integer ret_val; + +#line 15114 "" + for (ret_val = *n; ret_val >= 0; --ret_val) { +#line 15115 "" + if (*(unsigned char *)&strq[ret_val - 1] != ' ') { +#line 15115 "" + return ret_val; +#line 15115 "" + } +#line 15116 "" +/* L1: */ +#line 15116 "" + } +#line 15117 "" + return ret_val; +} /* llen_ */ + +integer log2_(integer *n) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + double log(doublereal); + + +/* 5/25/08 Modify to allow more slurs */ + +/* log2 = alog(1.*n)/0.6931472+.0001 */ +/* log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */ +#line 15124 "" + ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8); +#line 15125 "" + return ret_val; +} /* log2_ */ + +/* Subroutine */ int logbeam_(integer *numnew, integer *nip1, integer *nip2) +{ + /* System generated locals */ + integer i__1, i__2, i__3; + real r__1; + char ch__1[1]; + + /* Builtin functions */ + double log(doublereal); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static integer ib, iip; + static real sum; + static integer iip1; + extern integer log2_(integer *); + static integer iiip; + extern /* Character */ VOID ulfq_(char *, ftnlen, real *, integer *); + extern integer ncmid_(integer *, integer *); + static integer ndoub, multx, nrests, numnow; + static logical isxtup; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + +#line 15144 "" + all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1; +#line 15145 "" + all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2; +#line 15146 "" + numnow = *numnew; +#line 15147 "" + if (*numnew > 1) { + +/* If it starts before any others, must put it in order */ + +#line 15151 "" + for (ib = *numnew - 1; ib >= 1; --ib) { +#line 15152 "" + if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) { +#line 15152 "" + goto L12; +#line 15152 "" + } +#line 15153 "" + all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[ + commvl_1.ivx + ib * 24 - 25]; +#line 15154 "" + all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[ + commvl_1.ivx + ib * 24 - 25]; +#line 15155 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] = + *(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25]; +#line 15156 "" + all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1; +#line 15157 "" + all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2; +#line 15158 "" + numnow = ib; +#line 15159 "" +/* L11: */ +#line 15159 "" + } +#line 15160 "" +L12: +#line 15161 "" + ; +#line 15161 "" + } +#line 15162 "" + sum = 0.f; + +/* Beam has non-xtup within */ + +#line 15166 "" + nrests = 0; +#line 15167 "" + isxtup = FALSE_; +#line 15168 "" + i__1 = *nip2; +#line 15168 "" + for (iip = *nip1; iip <= i__1; ++iip) { +#line 15169 "" + 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 15174 "" + i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], & + c__3, &c__22) + 8; +#line 15174 "" + setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0, + &i__2); +#line 15176 "" + } else if (! isxtup) { +#line 15177 "" + if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { +/* mult(ivx,iip) = 4-log2(nodur(ivx,iip)) */ +#line 15179 "" + i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25]) + + 8; +#line 15179 "" + setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, & + c__0, &i__2); +#line 15180 "" + } else { + +/* Start xtup within forced beam */ + +#line 15184 "" + isxtup = TRUE_; +#line 15185 "" + iip1 = iip; +#line 15186 "" + } +#line 15187 "" + } else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) { + +/* End of xtup within forced beam. Must count doubled notes */ + +#line 15191 "" + ndoub = 0; +#line 15192 "" + i__2 = iip; +#line 15192 "" + for (iiip = iip1; iiip <= i__2; ++iiip) { +#line 15193 "" + if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { +#line 15193 "" + ++ndoub; +#line 15193 "" + } +#line 15194 "" +/* L1: */ +#line 15194 "" + } +#line 15195 "" + 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 15197 "" + i__2 = iip; +#line 15197 "" + for (iiip = iip1; iiip <= i__2; ++iiip) { +/* mult(ivx,iiip) = multx */ +#line 15199 "" + i__3 = multx + 8; +#line 15199 "" + 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 15203 "" + if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) { +#line 15203 "" + --all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 15203 "" + } +#line 15205 "" + if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) { +#line 15206 "" + ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 15207 "" + } else if (iiip > 1) { +#line 15208 "" + if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 - + 25],19)) { +#line 15208 "" + ++all_1.mult[commvl_1.ivx + iiip * 24 - 25]; +#line 15208 "" + } +#line 15210 "" + } +#line 15211 "" +/* L74: */ +#line 15211 "" + } +#line 15212 "" + isxtup = FALSE_; +#line 15213 "" + } +#line 15214 "" + if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) { +#line 15215 "" + ++nrests; +#line 15216 "" + } else { +#line 15217 "" + sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25]; +#line 15218 "" + } +#line 15219 "" +/* L9: */ +#line 15219 "" + } + +/* Set beam up-down-ness */ + +#line 15223 "" + if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + + max(1,comfb_1.ifb) * 24 - 25] != 'x') { +#line 15224 "" + if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24 + - 25] == 'f') { + +/* Get default, then trade "l" and "u" */ + +#line 15228 "" + r__1 = sum / (*nip2 - *nip1 + 1 - nrests); +#line 15228 "" + i__1 = ncmid_(&all_1.iv, nip1); +#line 15228 "" + ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); +#line 15228 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = ( + char) (225 - *(unsigned char *)&ch__1[0]); +#line 15230 "" + } else { +#line 15231 "" + *(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 15232 "" + } + +/* This probably works only because forced beams are done first, so they */ +/* don't have to be re-sorted within each voice. ???? */ + +#line 15237 "" + } else if (commvl_1.nvmx[all_1.iv - 1] == 2) { + +/* Multi-voice per staff */ + +#line 15241 "" + if (commvl_1.ivx <= all_1.nv) { +#line 15242 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = + 'l'; +#line 15243 "" + } else { +#line 15244 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = + 'u'; +#line 15245 "" + } +#line 15246 "" + } else { + +/* Defaults */ + +#line 15250 "" + r__1 = sum / (*nip2 - *nip1 + 1 - nrests); +#line 15250 "" + i__1 = ncmid_(&all_1.iv, nip1); +#line 15250 "" + ulfq_(ch__1, (ftnlen)1, &r__1, &i__1); +#line 15250 "" + *(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *( + unsigned char *)&ch__1[0]; +#line 15252 "" + } +#line 15253 "" + return 0; +} /* logbeam_ */ + +/* Subroutine */ int m1rec1_(char *lineq, integer *iccount, integer *ibarcnt, + integer *ibaroff, integer *nbars, integer *ndxm, ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, + ftnlen, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int stop1_(void), errmsg_(char *, integer *, + integer *, char *, ftnlen, ftnlen); + extern integer ntindex_(char *, char *, integer *, ftnlen, ftnlen); + + +/* This is called when (a) macro recording is just starting and */ +/* (b) at the start of a new line, if recording is on */ + +#line 15269 "" + inbuff_1.lbuf[0] = inbuff_1.lbuf[0]; +#line 15270 "" + if (! commac_1.mrecord) { + +/* Starting the macro */ + +#line 15274 "" + c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - + inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; +#line 15275 "" + c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 15276 "" + c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; +#line 15277 "" + commac_1.mrecord = TRUE_; +#line 15278 "" + } +#line 15279 "" + if (*iccount < 128) { +#line 15280 "" + i__1 = *iccount; +#line 15280 "" + *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); +#line 15281 "" + if (*ndxm > 0) { +#line 15281 "" + i__1 = *iccount; +#line 15281 "" + i__2 = 128 - *iccount; +#line 15281 "" + *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); +#line 15281 "" + } +#line 15283 "" + if (*ndxm > 0) { + +/* This line ends the macro. */ + +#line 15287 "" + i__1 = *iccount + *ndxm; +#line 15287 "" + if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen) + 1) != 0) { +#line 15288 "" + i__1 = *iccount + *ndxm + 1; +#line 15288 "" + i__2 = *ibarcnt - *ibaroff + *nbars + 1; +#line 15288 "" + errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", ( + ftnlen)128, (ftnlen)27); +#line 15290 "" + stop1_(); +#line 15291 "" + } +#line 15292 "" + c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - + inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; +#line 15293 "" + c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 15294 "" + commac_1.mrecord = FALSE_; +#line 15295 "" + } +#line 15296 "" + } +#line 15297 "" + return 0; +} /* m1rec1_ */ + +/* Subroutine */ int make1bar_(integer *ibmrep, real *tglp1, real *tstart, + logical *cwrest, real *squez, integer *istop, integer *numbms, + integer *istart) +{ + /* System generated locals */ + integer i__1, i__2, i__3, i__4, i__5, i__6; + real r__1, r__2; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void); + + /* Local variables */ + extern /* Subroutine */ int findbeam_(integer *, integer *, integer *); + extern integer igetbits_(integer *, integer *, integer *); + extern doublereal getsquez_(integer *, integer *, real *, real *, real *); + static integer ib, in, ip, kp, kv, ib1, ib2, ip1, cnn[24], inj, iin, iiv, + isl; + static real xit[24]; + extern doublereal feon_(real *); + static integer irep; + static real tmin; + static integer iivx, itbb1, itbb2, itbb3, inip1; + static real tglp2; + extern /* Subroutine */ int addfb_(integer *, integer *, real *, real *, + real *, char *, integer *, ftnlen); + static integer mapfb[16]; + static real deskb; + extern doublereal fnote_(integer *, integer *, integer *, integer *); + static real eskzb; + static integer ibrep; + static real tminn; + static integer nxtup, nip1fb, nip2fb, ib1now, ib2now, ifbadd; + static real t1xtup[20]; + static integer nfbbar; + static logical infbmx[24]; + static integer ifbnow[24]; + static logical inxtup[24]; + static integer numnew, mapnow, nxtnow[24]; + static real xsquez; + extern /* Subroutine */ int logbeam_(integer *, integer *, integer *), + setbits_(integer *, integer *, integer *, integer *); + + /* Fortran I/O blocks */ + static cilist io___949 = { 0, 6, 0, 0, 0 }; + static cilist io___950 = { 0, 6, 0, 0, 0 }; + static cilist io___951 = { 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 15389 "" + /* Parameter adjustments */ +#line 15389 "" + --istart; +#line 15389 "" + --numbms; +#line 15389 "" + --istop; +#line 15389 "" + --squez; +#line 15389 "" + --cwrest; +#line 15389 "" + --tstart; +#line 15389 "" + +#line 15389 "" + /* Function Body */ +#line 15389 "" + 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 15394 "" + i__1 = all_1.nv; +#line 15394 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 15395 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 15395 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 15396 "" + commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] = + 0; +#line 15397 "" +/* L45: */ +#line 15397 "" + } +#line 15397 "" + } +#line 15398 "" + } + +/* Time from start of gulp to end of bar, used with forced beams */ + +#line 15402 "" + tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1); +#line 15403 "" + if (all_1.lenb0 > 0) { +#line 15403 "" + tglp2 -= all_1.lenb1; +#line 15403 "" + } +#line 15404 "" + *tglp1 = tglp2 - all_1.lenbar; + +/* infbmx will only be true if in xtup that is NOT in explicit forced beam. */ + +#line 15408 "" + i__2 = all_1.nv; +#line 15408 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 15409 "" + i__1 = commvl_1.nvmx[all_1.iv - 1]; +#line 15409 "" + for (kv = 1; kv <= i__1; ++kv) { +#line 15410 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 15411 "" + cwrest[commvl_1.ivx] = FALSE_; +#line 15412 "" + infbmx[commvl_1.ivx - 1] = FALSE_; +#line 15413 "" + inxtup[commvl_1.ivx - 1] = FALSE_; +#line 15414 "" + if (all_1.ibar > 1) { +#line 15415 "" + 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 15416 "" + } else { +#line 15417 "" + all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx + + all_1.ibar * 24 - 25]; +#line 15418 "" + } +#line 15419 "" +/* L1: */ +#line 15419 "" + } +#line 15419 "" + } + +/* initialize list note counter, time(iv), curr. note(iv). The loop to 4 */ +/* ONLY initializes each voice. */ + +#line 15424 "" + in = 1; +#line 15425 "" + nxtup = 0; +#line 15426 "" + comarp_1.narp = 0; +#line 15427 "" + i__1 = all_1.nv; +#line 15427 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 15428 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 15428 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 15429 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 15430 "" + comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; +#line 15431 "" + cnn[commvl_1.ivx - 1] = 1; +#line 15432 "" + all_1.ivxo[in - 1] = commvl_1.ivx; +#line 15433 "" + all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; +#line 15434 "" + all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1, + all_1.nacc); +#line 15435 "" + all_1.to[in - 1] = 0.f; +#line 15436 "" + 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 15440 "" + 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 15444 "" + ++nxtup; +#line 15445 "" + nxtnow[commvl_1.ivx - 1] = nxtup; +#line 15446 "" + inxtup[commvl_1.ivx - 1] = TRUE_; +#line 15447 "" + 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 15452 "" + if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { +#line 15453 "" + i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 15453 "" + for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) + { +#line 15454 "" + 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 15458 "" + goto L61; +#line 15459 "" + } 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 + + comfb_1.ifb * 24 - 25] > *tglp1 + xit[ + commvl_1.ivx - 1] + comtol_1.tol) { + +/* IS explicit fb here; must NOT insert one */ + +#line 15464 "" + goto L62; +#line 15465 "" + } +#line 15466 "" +/* L60: */ +#line 15466 "" + } +#line 15467 "" + } +#line 15468 "" +L61: + +/* If here, xtup isn't in explicit fb, so must insert one */ + +#line 15472 "" + infbmx[commvl_1.ivx - 1] = TRUE_; +#line 15473 "" + r__1 = t1xtup[nxtup - 1] + *tglp1; +#line 15473 "" + addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, + comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); +#line 15475 "" + ifbnow[commvl_1.ivx - 1] = ifbadd; +#line 15476 "" + } +#line 15477 "" +L62: +#line 15478 "" + if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) < + comtol_1.tol) { +#line 15478 "" + xit[commvl_1.ivx - 1] = 1e3f; +#line 15478 "" + } +#line 15479 "" + ++in; +#line 15480 "" +/* L4: */ +#line 15480 "" + } +#line 15480 "" + } + +/* Build the list: This is a manual loop starting at 5 */ + +#line 15484 "" +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 15489 "" + tmin = 1e3f; +#line 15490 "" + i__2 = all_1.nv; +#line 15490 "" + for (iiv = 1; iiv <= i__2; ++iiv) { +#line 15491 "" + i__1 = commvl_1.nvmx[iiv - 1]; +#line 15491 "" + for (kv = 1; kv <= i__1; ++kv) { +#line 15492 "" + iivx = commvl_1.ivmx[iiv + kv * 24 - 25]; +/* Computing MIN */ +#line 15493 "" + r__1 = tmin, r__2 = xit[iivx - 1]; +#line 15493 "" + tminn = dmin(r__1,r__2); +#line 15494 "" + if (tminn < tmin - comtol_1.tol) { +#line 15495 "" + tmin = tminn; +#line 15496 "" + commvl_1.ivx = iivx; +#line 15497 "" + } +#line 15498 "" +/* L6: */ +#line 15498 "" + } +#line 15498 "" + } +#line 15499 "" + if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) { +#line 15499 "" + goto L7; +#line 15499 "" + } +#line 15500 "" + all_1.ivxo[in - 1] = commvl_1.ivx; +#line 15501 "" + ++cnn[commvl_1.ivx - 1]; +#line 15502 "" + all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1]; +#line 15503 "" + all_1.to[in - 1] = tmin; + +/* Check if this voice is done */ + +#line 15507 "" + all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[ + commvl_1.ivx - 1], all_1.nacc); +#line 15508 "" + if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) { +#line 15509 "" + xit[commvl_1.ivx - 1] = 1e3f; +#line 15510 "" + } else { +#line 15511 "" + xit[commvl_1.ivx - 1] += all_1.tnote[in - 1]; +#line 15512 "" + } + +/* Flag xtups */ + +#line 15516 "" + if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) { +#line 15517 "" + if (! inxtup[commvl_1.ivx - 1]) { + +/* First note of xtup, not at start of bar. */ + +#line 15521 "" + ++nxtup; +#line 15522 "" + nxtnow[commvl_1.ivx - 1] = nxtup; +#line 15523 "" + inxtup[commvl_1.ivx - 1] = TRUE_; +#line 15524 "" + 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 15529 "" + if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { +#line 15530 "" + i__1 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 15530 "" + for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) { +#line 15531 "" + 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 15535 "" + goto L71; +#line 15536 "" + } 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 + + comfb_1.ifb * 24 - 25] > *tglp1 + xit[ + commvl_1.ivx - 1] + comtol_1.tol) { + +/* IS explicit bm. Don't put one */ + +#line 15541 "" + goto L72; +#line 15542 "" + } +#line 15543 "" +/* L70: */ +#line 15543 "" + } +#line 15544 "" + } +#line 15545 "" +L71: + +/* If here, no explicit bm, so put one in */ + +#line 15549 "" + infbmx[commvl_1.ivx - 1] = TRUE_; +#line 15550 "" + r__1 = t1xtup[nxtup - 1] + *tglp1; +#line 15550 "" + addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb, + comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1); +#line 15552 "" + ifbnow[commvl_1.ivx - 1] = ifbadd; +#line 15553 "" + } +#line 15554 "" +L72: +#line 15555 "" + ; +#line 15555 "" + } else if (inxtup[commvl_1.ivx - 1]) { + +/* This test is sufficient because already know nodur>0 */ + +#line 15559 "" + inxtup[commvl_1.ivx - 1] = FALSE_; +#line 15560 "" + if (infbmx[commvl_1.ivx - 1]) { + +/* Xtup is in auto-forced beam, so end it */ + +#line 15564 "" + 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 15566 "" + infbmx[commvl_1.ivx - 1] = FALSE_; +#line 15567 "" + } +#line 15568 "" + } +#line 15569 "" + 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)) { + +/* For staff jumped beam, flag the first note (lowest voice) at same time. */ +/* Later will start new notes group here. */ + +#line 15575 "" + inj = in; +#line 15576 "" + if (all_1.ivxo[in - 1] > 1) { +#line 15577 "" + for (iin = in - 1; iin >= 1; --iin) { +#line 15578 "" + if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) { +#line 15578 "" + goto L41; +#line 15578 "" + } +#line 15579 "" + if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1)) + < comtol_1.tol) { +#line 15580 "" + inj = iin; +#line 15581 "" + goto L40; +#line 15582 "" + } +#line 15583 "" +L40: +#line 15583 "" + ; +#line 15583 "" + } +#line 15584 "" + } +#line 15585 "" +L41: +#line 15586 "" + 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 15587 "" + } +#line 15588 "" + ++in; +#line 15589 "" + goto L5; +#line 15590 "" +L7: +#line 15591 "" + comntot_1.ntot = in - 1; +#line 15592 "" + i__1 = comntot_1.ntot - 1; +#line 15592 "" + for (in = 1; in <= i__1; ++in) { +#line 15593 "" + all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1]; +#line 15594 "" +/* L8: */ +#line 15594 "" + } +#line 15595 "" + all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1]; + +/* Debug writes */ + +/* write(*,'()') */ +/* write(*,'(a)')' Greetings from PMXB' */ +/* write(*,'(16i5)')(ivxo(in),in=1,ntot) */ +/* write(*,'(16i5)')(ipo(in),in=1,ntot) */ +/* write(*,'(16f5.1)')(to(in),in=1,ntot) */ +/* write(*,'(16f5.1)')(tno(in),in=1,ntot) */ +/* write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) */ +/* write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot) */ + +/* Done w/ list. Loop for parsing into note blocks: */ + +#line 15610 "" + ib = 1; +#line 15611 "" + istart[1] = 1; +#line 15612 "" + comnsp_2.space[0] = 0.f; +#line 15613 "" + in = 1; + +/* A manual loop to set space(ib) and istop(ib) */ + +#line 15617 "" +L9: +/* Computing MIN */ +#line 15619 "" + i__1 = in + 1; +#line 15619 "" + commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1]; +/* Computing MIN */ +#line 15620 "" + i__1 = in + 1; +#line 15620 "" + ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1]; +#line 15621 "" + isl = all_1.islur[commvl_1.ivx + ip * 24 - 25]; +#line 15622 "" + 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[ + commvl_1.ivx + ip * 24 - 25],29)) { +/* * .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then */ +/* Bits 1-13: stmgx+Tupf._) */ +/* 14: Down fermata, was F */ +/* 15: Trill w/o "tr", was U */ + +/* Checking for start of 2nd part of jumped beam */ + + +/* Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam; */ +/* flow out of if-loop and into block-wrapup */ + +/* 10/18/97: Problem with clef alignment. Got isl{15} set on lowest-numbered */ +/* voice, but it wasn't first in the list at the same time. So check if */ +/* prior notes in list have same time */ +/* 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */ +/* changes on last note in the list? */ + +#line 15643 "" + if (bit_test(isl,15) && in < comntot_1.ntot) { +#line 15644 "" + for (iin = in; iin >= 1; --iin) { +#line 15645 "" + if (all_1.tno[iin - 1] > comtol_1.tol) { +#line 15646 "" + in = iin; +#line 15647 "" + all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear( + all_1.islur[commvl_1.ivx + ip * 24 - 25],15); +#line 15648 "" + 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 15650 "" + goto L51; +#line 15651 "" + } +#line 15652 "" +/* L50: */ +#line 15652 "" + } +#line 15653 "" +L51: +#line 15654 "" + ; +#line 15654 "" + } +#line 15655 "" + if (comnsp_2.space[ib - 1] < comtol_1.tol) { +#line 15656 "" + comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 15657 "" + squez[ib] = 1.f; +#line 15658 "" + } +#line 15659 "" + istop[ib] = in; +#line 15660 "" + } else if (comnsp_2.space[ib - 1] < comtol_1.tol) { + +/* space hasn't been set yet, so tentatively set: */ + +#line 15664 "" + comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 15665 "" + if (comnsp_2.space[ib - 1] < comtol_1.tol) { +#line 15666 "" + ++in; +#line 15667 "" + } else { +#line 15668 "" + squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - + 1], all_1.tnote, all_1.to); +#line 15669 "" + istop[ib] = in; +#line 15670 "" + } +#line 15671 "" + goto L9; +#line 15672 "" + } else if (all_1.tno[in] < comtol_1.tol) { + +/* This is not the last note in the group, so */ + +#line 15676 "" + ++in; +#line 15677 "" + goto L9; +#line 15678 "" + } else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) < + comtol_1.tol) { +#line 15679 "" + i__1 = in + 1; +#line 15679 "" + xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1], + all_1.tnote, all_1.to); +#line 15680 "" + if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) { + +/* Keep spacing the same, update tentative stop point */ + +#line 15684 "" + ++in; +#line 15685 "" + istop[ib] = in; +#line 15686 "" + goto L9; +#line 15687 "" + } +#line 15688 "" + } + +/* At this point istart and istop are good, so finalize block */ + +#line 15692 "" + tstart[ib] = all_1.to[istart[ib] - 1]; +#line 15693 "" + if (istop[ib] == comntot_1.ntot) { +#line 15693 "" + goto L15; +#line 15693 "" + } +#line 15694 "" + ++ib; +#line 15695 "" + istart[ib] = istop[ib - 1] + 1; +#line 15696 "" + in = istart[ib]; + +/* Set tentative block space and squeeze-factor for upcoming block */ + +#line 15700 "" + comnsp_2.space[ib - 1] = all_1.tno[in - 1]; +#line 15701 "" + if (comnsp_2.space[ib - 1] > comtol_1.tol) { +#line 15701 "" + squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1], + all_1.tnote, all_1.to); +#line 15701 "" + } +#line 15703 "" + istop[ib] = in; +#line 15704 "" + goto L9; +#line 15705 "" +L15: +#line 15706 "" + comnsp_2.nb = ib; + +/* Invert the list of places into ipl(0-7), making it easier to analyze a voice */ + +#line 15710 "" + i__1 = comntot_1.ntot; +#line 15710 "" + 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 15715 "" + comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in; +#line 15716 "" +/* L13: */ +#line 15716 "" + } + +/* Compute elemskips from start of bar to each note in the bar, for beam slopes */ + +#line 15720 "" + eskzb = 0.f; +#line 15721 "" + ib = 1; +#line 15722 "" + i__1 = comntot_1.ntot; +#line 15722 "" + for (in = 1; in <= i__1; ++in) { +#line 15723 "" + if (in == istart[ib]) { +#line 15724 "" + r__1 = comnsp_2.space[ib - 1] / squez[ib]; +#line 15724 "" + deskb = squez[ib] * feon_(&r__1); +#line 15725 "" + } else if (all_1.tno[in - 2] > comtol_1.tol) { +#line 15726 "" + eskzb += deskb; +#line 15727 "" + } +#line 15728 "" + all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb; +#line 15729 "" + comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = + eskzb; +#line 15730 "" + if (in == istop[ib]) { +#line 15731 "" + eskzb += deskb; +#line 15732 "" + ++ib; +#line 15733 "" + } +#line 15734 "" +/* L30: */ +#line 15734 "" + } + +/* 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 15753 "" + i__1 = all_1.nv; +#line 15753 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 15754 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 15754 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 15755 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 15756 "" + numbms[commvl_1.ivx] = 0; +#line 15757 "" + mapfb[0] = 0; +#line 15758 "" + mapfb[1] = 0; +#line 15759 "" + mapfb[2] = 0; +#line 15760 "" + mapfb[3] = 0; + +/* First forced beams. */ + +#line 15764 "" + if (comfb_1.nfb[commvl_1.ivx - 1] > 0) { + +/* tglp2 is time from start of gulp to end of current bar. */ + +#line 15768 "" + nfbbar = 0; +#line 15769 "" + i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 15769 "" + for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) { +#line 15770 "" + if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > + tglp2 - comtol_1.tol) { +#line 15770 "" + goto L81; +#line 15770 "" + } +#line 15771 "" + ++nfbbar; +#line 15772 "" + ++numbms[commvl_1.ivx]; +#line 15773 "" + numnew = numbms[commvl_1.ivx]; + +/* Times from beginning of bar */ + +#line 15777 "" + itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx + + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); +#line 15778 "" + itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx + + comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol); +#line 15779 "" + i__4 = all_1.nn[commvl_1.ivx - 1]; +#line 15779 "" + for (ip = 1; ip <= i__4; ++ip) { +#line 15780 "" + if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx + + ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) { +#line 15781 "" + nip1fb = ip; +#line 15782 "" + i__5 = all_1.nn[commvl_1.ivx - 1]; +#line 15782 "" + for (ip1 = ip; ip1 <= i__5; ++ip1) { +#line 15783 "" + inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 * + 24 - 25]; +#line 15784 "" + if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[ + inip1 - 1] - itbb2, dabs(r__1)) < + comtol_1.tol) { +#line 15785 "" + nip2fb = ip1; +#line 15786 "" + itbb3 = itbb2 - 2; +#line 15787 "" + goto L85; +#line 15788 "" + } +#line 15789 "" +/* L84: */ +#line 15789 "" + } +#line 15790 "" + } +#line 15791 "" +/* L83: */ +#line 15791 "" + } +#line 15792 "" + s_wsle(&io___949); +#line 15792 "" + e_wsle(); +#line 15793 "" + s_wsle(&io___950); +#line 15793 "" + do_lio(&c__9, &c__1, "Timing problem w/ forced beams", ( + ftnlen)30); +#line 15793 "" + e_wsle(); +#line 15794 "" + s_wsfe(&io___951); +#line 15794 "" + do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen) + 30); +#line 15794 "" + e_wsfe(); +#line 15795 "" +L85: +#line 15796 "" + logbeam_(&numnew, &nip1fb, &nip2fb); + +/* Set up mapfb for forced beam just logged: */ + +#line 15800 "" + ib1 = itbb1 / 2; +#line 15801 "" + ib2 = itbb3 / 2; +#line 15802 "" + ibrep = all_1.lenbar / *ibmrep / 2; +#line 15803 "" + i__4 = *ibmrep; +#line 15803 "" + for (irep = 1; irep <= i__4; ++irep) { +/* Computing MAX */ +#line 15804 "" + i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep; +#line 15804 "" + ib1now = max(i__5,i__6); +/* Computing MIN */ +#line 15805 "" + i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) * + ibrep; +#line 15805 "" + ib2now = min(i__5,i__6); +#line 15806 "" + mapnow = 0; +#line 15807 "" + i__5 = ib2now; +#line 15807 "" + for (ib = ib1now; ib <= i__5; ++ib) { +#line 15808 "" + mapnow = bit_set(mapnow,ib); +#line 15809 "" +/* L87: */ +#line 15809 "" + } +#line 15810 "" + mapfb[irep - 1] |= mapnow; +#line 15811 "" +/* L86: */ +#line 15811 "" + } + +/* Since we are cycling thru forced beams, for those that start with a rest and */ +/* have height & slope adjustments, move adjustments to next note. */ +/* 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */ +/* start of beam */ + +#line 15818 "" + if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25], + 0)) { +/* call setbits(ipl(ivx,nip1fb+1),6,11, */ +/* * igetbits(ipl(ivx,nip1fb),6,11)) */ +/* call setbits(ipl(ivx,nip1fb+1),6,17, */ +/* * igetbits(ipl(ivx,nip1fb),6,17)) */ +/* call setbits(islur(ivx,nip1fb+1),2,27, */ +/* * igetbits(islur(ivx,nip1fb),2,27)) */ +#line 15825 "" + i__4 = nip2fb; +#line 15825 "" + for (kp = nip1fb + 1; kp <= i__4; ++kp) { +#line 15826 "" + i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb + * 24 - 25], &c__6, &c__11); +#line 15826 "" + setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], + &c__6, &c__11, &i__5); +#line 15828 "" + i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb + * 24 - 25], &c__6, &c__17); +#line 15828 "" + setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25], + &c__6, &c__17, &i__5); +#line 15830 "" + i__5 = igetbits_(&all_1.islur[commvl_1.ivx + + nip1fb * 24 - 25], &c__2, &c__27); +#line 15830 "" + setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25] + , &c__2, &c__27, &i__5); +#line 15832 "" +/* L88: */ +#line 15832 "" + } +#line 15833 "" + } +#line 15834 "" +/* L80: */ +#line 15834 "" + } +#line 15835 "" +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 15840 "" + if (nfbbar > 0) { +#line 15841 "" + comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar; +#line 15842 "" + i__3 = comfb_1.nfb[commvl_1.ivx - 1]; +#line 15842 "" + for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) + { +#line 15843 "" + comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = + comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb + + nfbbar) * 24 - 25]; +#line 15844 "" + comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] = + comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb + + nfbbar) * 24 - 25]; +#line 15845 "" + *(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 15846 "" +/* L82: */ +#line 15846 "" + } +#line 15847 "" + } +#line 15848 "" + } +#line 15849 "" + comfb_1.ifb = 0; + +/* Done with forced beam masks for this bar and voice. Now get normal beams. */ + +#line 15853 "" + findbeam_(ibmrep, &numbms[1], mapfb); +#line 15854 "" +/* L20: */ +#line 15854 "" + } +#line 15854 "" + } +#line 15855 "" + return 0; +} /* make1bar_ */ + +/* Subroutine */ int make2bar_(integer *ninow, real *tglp1, real *tstart, + logical *cwrest, real *squez, integer *istop, integer *numbms, + integer *istart, char *clefq, ftnlen clefq_len) +{ + /* System generated locals */ + address a__1[6], a__2[2], a__3[5], a__4[3], a__5[2], a__6[4], a__7[8], + a__8[7], a__9[9]; + integer i__1, i__2, i__3[6], i__4[2], i__5[5], i__6[3], i__7, i__8[2], + i__9[4], i__10, i__11[8], i__12, i__13, i__14[7], i__15[9]; + real r__1, r__2; + logical L__1; + char ch__1[80], ch__2[82], ch__3[20], ch__4[14], ch__5[12], ch__6[1], + ch__7[17], ch__8[16], ch__9[11], ch__10[10], ch__11[44], ch__12[ + 81], ch__13[113], ch__14[3], ch__15[9], ch__16[129], ch__17[6], + ch__18[5], ch__19[4], ch__20[13], ch__21[22]; + cilist ci__1; + + /* Builtin functions */ + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfe(cilist *), e_wsfe(void), lbit_shift(integer, integer), + i_nint(real *), s_wsle(cilist *), do_lio(integer *, integer *, + char *, ftnlen), e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer pow_ii(integer *, integer *); + double r_lg10(real *); + integer s_cmp(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + extern logical isdotted_(integer *, integer *, integer *); + extern /* Subroutine */ int beamstrt_(char *, integer *, integer *, + integer *, real *, real *, integer *, ftnlen); + static real ptsavail; + extern /* Subroutine */ int dopsslur_(integer *, integer *, integer *, + integer *, integer *, integer *, integer *, integer *, integer *, + integer *, logical *, integer *, char *, integer *, char *, + integer *, integer *, integer *, integer *, real *, integer *, + ftnlen, ftnlen), midievent_(char *, integer *, integer *, ftnlen); + static real stemshort; + 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 logical secondgrace; + extern integer log2_(integer *); + extern /* Subroutine */ int chkkbdrests_(integer *, integer *, integer *, + integer *, integer *, integer *, integer *, integer *, integer *, + integer *, integer *, real *, real *, integer *, integer *, + integer *, integer *, integer *, integer *); + static integer iacc, kacc, macc, ifig[2], icrd, ndig; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern doublereal feon_(real *); + static integer lcwr[24]; + extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *, + integer *, integer *, integer *, integer *); + static char cwrq[79*24]; + static real ptgr[37], spgr, ptsl, zero, tnow; + static integer nodu; + extern /* Subroutine */ int eskb4_(integer *, integer *, integer *, + integer *, real *, real *, real *, integer *, real *), stop1_( + void), doacc_(integer *, integer *, char *, integer *, integer *, + integer *, integer *, logical *, ftnlen); + static logical isacc; + static integer nclef, iaskb[24]; + static logical iscln, issig; + static integer nornb[24]; + static logical isarp, isdot; + static integer lnote; + static char noteq[8]; + static logical iscwr; + static char soutq[80]; + static integer lsout, itrpt, itsig; + extern integer ncmid_(integer *, integer *); + static integer iirpt, lclow; + extern /* Subroutine */ int dodyn_(integer *, integer *, integer *, + integer *, integer *, integer *, integer *, integer *, integer *, + logical *, integer *, integer *, char *, integer *, logical *, + 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); + static logical iscacc; + extern /* Subroutine */ int addask_(real *, real *, real *, real *, real * + , real *, logical *); + static logical isclef, isflag, isaccs, bspend, isgaft; + static real ptclef[24]; + static integer ihornb[576] /* was [24][24] */; + static real eskndg[24], ptsndg[24]; + static logical rpndot; + static char notexq[79]; + static logical stemup, beamon1[24]; + static integer ibmcnt1[24], lnoten; + extern /* Subroutine */ int wsclef_(integer *, integer *, integer *); + static real eonsqz; + extern /* Subroutine */ int precrd_(integer *, integer *, integer *, + integer *, integer *, integer *, char *, logical *, integer *, + ftnlen), chkarp_(integer *, integer *, integer *, integer *, + logical *, logical *); + static integer ibmchk; + static real taccfac, esksav, ptsadd; + static integer ihshft; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer lchead; + extern integer lenstr_(char *, integer *, ftnlen); + static integer islhgt; + static real offnsk; + extern /* Subroutine */ int putfig_(integer *, integer *, real *, logical + *, char *, integer *, ftnlen), putarp_(real *, integer *, integer + *, integer *, integer *, char *, integer *, ftnlen), doslur_( + integer *, integer *, integer *, integer *, integer *, integer *, + integer *, integer *, integer *, logical *, integer *, char *, + integer *, char *, integer *, integer *, integer *, integer *, + real *, integer *, ftnlen, ftnlen); + static integer iphold; + extern /* Subroutine */ int dograce_(integer *, integer *, real *, char *, + integer *, integer *, integer *, integer *, integer *, logical *, + logical *, integer *, integer *, integer *, integer *, integer *, + integer *, real *, char *, integer *, ftnlen, ftnlen), notefq_( + char *, integer *, integer *, integer *, ftnlen), addmidi_( + integer *, integer *, integer *, integer *, real *, logical *, + logical *), putorn_(integer *, integer *, integer *, integer *, + integer *, char *, integer *, integer *, integer *, integer *, + integer *, integer *, integer *, real *, char *, integer *, + integer *, integer *, logical *, logical *, ftnlen, ftnlen), + dotmov_(real *, real *, char *, integer *, integer *, ftnlen), + beamend_(char *, integer *, ftnlen); + static logical isgrace; + static integer icashft; + static real ptbneed; + extern /* Subroutine */ int beamid_(char *, integer *, ftnlen); + static integer itleft, itendb; + static real ptsneed; + extern /* Subroutine */ int clefsym_(integer *, char *, integer *, + integer *, ftnlen); + static logical isrshft, isfirst, nofirst; + extern /* Subroutine */ int endslur_(logical *, logical *, integer *, + integer *, integer *, integer *, integer *, char *, integer *, + logical *, ftnlen); + static char slurudq[1]; + extern /* Subroutine */ int putshft_(integer *, logical *, char *, + integer *, ftnlen), setbits_(integer *, integer *, integer *, + integer *); + static integer itright; + extern integer iashft_(integer *); + static integer nolevc, ivlast; + extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) + ; + static integer mtrspc; + static real wheadpt1; + + /* Fortran I/O blocks */ + static icilist io___971 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 }; + static icilist io___973 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 }; + static icilist io___974 = { 0, noteq, 0, "(i1)", 1, 1 }; + static cilist io___977 = { 0, 11, 0, "(a)", 0 }; + static cilist io___978 = { 0, 11, 0, "(a)", 0 }; + static cilist io___981 = { 0, 11, 0, "(a20,i1,a)", 0 }; + static cilist io___982 = { 0, 11, 0, "(a20,i2,a)", 0 }; + static cilist io___983 = { 0, 11, 0, "(a)", 0 }; + static icilist io___986 = { 0, soutq+8, 0, "(f4.1)", 4, 1 }; + static icilist io___987 = { 0, soutq+8, 0, "(f4.2)", 4, 1 }; + static icilist io___988 = { 0, soutq+10, 0, "(i2)", 2, 1 }; + static icilist io___989 = { 0, soutq+11, 0, "(i1)", 1, 1 }; + static cilist io___994 = { 0, 6, 0, 0, 0 }; + static cilist io___995 = { 0, 6, 0, 0, 0 }; + static cilist io___1015 = { 0, 6, 0, 0, 0 }; + static cilist io___1031 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1032 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1033 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1034 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1035 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1036 = { 0, 6, 0, 0, 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___1043 = { 0, notexq+11, 0, "(i2)", 2, 1 }; + static icilist io___1049 = { 0, notexq+6, 0, "(f3.1)", 3, 1 }; + static icilist io___1050 = { 0, notexq+6, 0, "(f4.1)", 4, 1 }; + static icilist io___1052 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; + static icilist io___1053 = { 0, notexq+5, 0, "(f4.1)", 4, 1 }; + static cilist io___1055 = { 0, 6, 0, 0, 0 }; + static cilist io___1056 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1057 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1058 = { 0, 6, 0, 0, 0 }; + static icilist io___1065 = { 0, notexq, 0, "(f4.2)", 79, 1 }; + static cilist io___1068 = { 0, 6, 0, 0, 0 }; + static cilist io___1081 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1084 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1087 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1089 = { 0, 11, 0, "(a)", 0 }; + + + +/* Factors for grace note, clef spacing. (fraction of wheadpt) */ +/* In 1.04, moved to block data subprogram */ + +/* 130316 */ + +/* Set up main ib loop within which a block (notes group) is written */ + +#line 15977 "" + /* Parameter adjustments */ +#line 15977 "" + --clefq; +#line 15977 "" + --istart; +#line 15977 "" + --numbms; +#line 15977 "" + --istop; +#line 15977 "" + --squez; +#line 15977 "" + --cwrest; +#line 15977 "" + --tstart; +#line 15977 "" + +#line 15977 "" + /* Function Body */ +#line 15977 "" + i__1 = all_1.nv; +#line 15977 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 15978 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 15978 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 15979 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 15980 "" + all_1.ibmcnt[commvl_1.ivx - 1] = 1; +#line 15981 "" + ibmcnt1[commvl_1.ivx - 1] = 1; +#line 15982 "" + all_1.beamon[commvl_1.ivx - 1] = FALSE_; +#line 15983 "" + beamon1[commvl_1.ivx - 1] = FALSE_; +#line 15984 "" + nornb[commvl_1.ivx - 1] = 0; +#line 15985 "" + iaskb[commvl_1.ivx - 1] = 1; +#line 15986 "" + comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; +#line 15987 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 15988 "" +/* L25: */ +#line 15988 "" + } +#line 15988 "" + } +#line 15989 "" + comas1_1.naskb = 0; +#line 15990 "" + ifig[0] = 1; +#line 15991 "" + ifig[1] = 1; +#line 15992 "" + comxtup_1.ixtup = 0; +#line 15993 "" + bspend = FALSE_; +#line 15994 "" + iscwr = FALSE_; +#line 15995 "" + rpndot = FALSE_; +#line 15996 "" + i__2 = comnsp_2.nb; +#line 15996 "" + for (ib = 1; ib <= i__2; ++ib) { + +/* Check for segno */ + +#line 16000 "" + if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) && + all_1.ivxo[istart[ib] - 1] == 1) { +#line 16002 "" + if (comgrace_1.noffseg <= -10) { +#line 16003 "" + s_wsfi(&io___971); +#line 16003 "" + do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( + integer)); +#line 16003 "" + e_wsfi(); +#line 16004 "" + lnoten = 5; +#line 16005 "" + } else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) { +#line 16006 "" + s_wsfi(&io___973); +#line 16006 "" + do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( + integer)); +#line 16006 "" + e_wsfi(); +#line 16007 "" + lnoten = 4; +#line 16008 "" + } else { +#line 16009 "" + s_wsfi(&io___974); +#line 16009 "" + do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof( + integer)); +#line 16009 "" + e_wsfi(); +#line 16010 "" + lnoten = 1; +#line 16011 "" + } +/* Writing concatenation */ +#line 16012 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 16012 "" + i__3[1] = 6, a__1[1] = "znotes"; +#line 16012 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 16012 "" + i__3[3] = 6, a__1[3] = "segnoo"; +#line 16012 "" + i__3[4] = lnoten, a__1[4] = noteq; +#line 16012 "" + i__3[5] = 1, a__1[5] = "9"; +#line 16012 "" + s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 16013 "" + lnote = lnoten + 15; +#line 16014 "" + i__1 = all_1.nv; +#line 16014 "" + for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) { +#line 16015 "" + if (lnote > 60) { +#line 16016 "" + if (comlast_1.islast) { +#line 16016 "" + s_wsfe(&io___977); +/* Writing concatenation */ +#line 16016 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 16016 "" + i__4[1] = 1, a__2[1] = "%"; +#line 16016 "" + s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80); +#line 16016 "" + do_fio(&c__1, ch__1, lnote + 1); +#line 16016 "" + e_wsfe(); +#line 16016 "" + } +/* Writing concatenation */ +#line 16017 "" + i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2); +#line 16017 "" + i__5[1] = 1, a__3[1] = all_1.sq; +#line 16017 "" + i__5[2] = 6, a__3[2] = "segnoo"; +#line 16017 "" + i__5[3] = lnoten, a__3[3] = noteq; +#line 16017 "" + i__5[4] = 1, a__3[4] = "9"; +#line 16017 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 16019 "" + lnote = lnoten + 9; +#line 16020 "" + } else { +/* Writing concatenation */ +#line 16021 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 16021 "" + i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2); +#line 16021 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 16021 "" + i__3[3] = 6, a__1[3] = "segnoo"; +#line 16021 "" + i__3[4] = lnoten, a__1[4] = noteq; +#line 16021 "" + i__3[5] = 1, a__1[5] = "9"; +#line 16021 "" + s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 16023 "" + lnote = lnote + lnoten + 9; +#line 16024 "" + } +#line 16025 "" +/* L130: */ +#line 16025 "" + } +#line 16026 "" + if (comlast_1.islast) { +#line 16026 "" + s_wsfe(&io___978); +/* Writing concatenation */ +#line 16026 "" + i__6[0] = lnote, a__4[0] = notexq; +#line 16026 "" + i__6[1] = 1, a__4[1] = all_1.sq; +#line 16026 "" + i__6[2] = 2, a__4[2] = "en"; +#line 16026 "" + s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); +#line 16026 "" + do_fio(&c__1, ch__2, lnote + 3); +#line 16026 "" + e_wsfe(); +#line 16026 "" + } +#line 16027 "" + lnote = 0; +#line 16028 "" + } + +/* Check for new clefs */ + +#line 16032 "" + isclef = FALSE_; +#line 16033 "" + 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 16038 "" + i__1 = istop[ib]; +#line 16038 "" + for (in = istart[ib]; in <= i__1; ++in) { +#line 16039 "" + if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in - + 1] * 24 - 25],11)) { +#line 16040 "" + i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] + + all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7; +#line 16040 "" + 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 16046 "" + if (bit_test(all_1.ipl[all_1.ivxo[in - 1] + all_1.ipo[in + - 1] * 24 - 25],2)) { +#line 16047 "" + if (all_1.iv <= 9) { +#line 16048 "" + s_wsfe(&io___981); +/* Writing concatenation */ +#line 16048 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16048 "" + i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; +#line 16048 "" + s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); +#line 16048 "" + do_fio(&c__1, ch__3, (ftnlen)20); +#line 16048 "" + do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 16048 "" + i__8[0] = 1, a__5[0] = all_1.sq; +#line 16048 "" + i__8[1] = 13, a__5[1] = "treblelowoct%"; +#line 16048 "" + s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); +#line 16048 "" + do_fio(&c__1, ch__4, (ftnlen)14); +#line 16048 "" + e_wsfe(); +#line 16050 "" + } else { +#line 16051 "" + s_wsfe(&io___982); +/* Writing concatenation */ +#line 16051 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16051 "" + i__4[1] = 19, a__2[1] = "settrebleclefsymbol"; +#line 16051 "" + s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20); +#line 16051 "" + do_fio(&c__1, ch__3, (ftnlen)20); +#line 16051 "" + do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 16051 "" + i__8[0] = 1, a__5[0] = all_1.sq; +#line 16051 "" + i__8[1] = 13, a__5[1] = "treblelowoct%"; +#line 16051 "" + s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14); +#line 16051 "" + do_fio(&c__1, ch__4, (ftnlen)14); +#line 16051 "" + e_wsfe(); +#line 16053 "" + } +#line 16054 "" + } +#line 16055 "" + } +#line 16056 "" +/* L140: */ +#line 16056 "" + } +#line 16057 "" + if (comlast_1.islast) { +#line 16057 "" + s_wsfe(&io___983); +/* Writing concatenation */ +#line 16057 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16057 "" + i__4[1] = 11, a__2[1] = "pmxnewclefs"; +#line 16057 "" + s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 16057 "" + do_fio(&c__1, ch__5, (ftnlen)12); +#line 16057 "" + e_wsfe(); +#line 16057 "" + } +#line 16058 "" + isclef = TRUE_; +#line 16059 "" + } + +/* Start a notes group. We're just gonna define every one using pnotes{n}, */ +/* where \def\pnotes#1{\vnotes#1\elemskip} */ + +/* Writing concatenation */ +#line 16064 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16064 "" + i__4[1] = 7, a__2[1] = "pnotes{"; +#line 16064 "" + s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 16065 "" + r__1 = comnsp_2.space[ib - 1] / squez[ib]; +#line 16065 "" + eonsqz = squez[ib] * feon_(&r__1); +#line 16066 "" + if (eonsqz > 9.995f) { +#line 16067 "" + s_wsfi(&io___986); +#line 16067 "" + do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); +#line 16067 "" + e_wsfi(); +#line 16068 "" + } else if (eonsqz > .995f) { +#line 16069 "" + s_wsfi(&io___987); +#line 16069 "" + do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real)); +#line 16069 "" + e_wsfi(); +#line 16070 "" + } else if (eonsqz > .095f) { +/* Writing concatenation */ +#line 16071 "" + i__4[0] = 8, a__2[0] = soutq; +#line 16071 "" + i__4[1] = 2, a__2[1] = "0."; +#line 16071 "" + s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 16072 "" + s_wsfi(&io___988); +#line 16072 "" + r__1 = eonsqz * 100; +#line 16072 "" + i__1 = i_nint(&r__1); +#line 16072 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 16072 "" + e_wsfi(); +#line 16073 "" + } else { +/* Writing concatenation */ +#line 16074 "" + i__4[0] = 8, a__2[0] = soutq; +#line 16074 "" + i__4[1] = 3, a__2[1] = "0.0"; +#line 16074 "" + s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 16075 "" + s_wsfi(&io___989); +#line 16075 "" + r__1 = eonsqz * 100; +#line 16075 "" + i__1 = i_nint(&r__1); +#line 16075 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 16075 "" + e_wsfi(); +#line 16076 "" + } +/* Writing concatenation */ +#line 16077 "" + i__4[0] = 12, a__2[0] = soutq; +#line 16077 "" + i__4[1] = 1, a__2[1] = "}"; +#line 16077 "" + s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 16078 "" + lsout = 13; + +/* Check whole block, flag accidentals etc that are too close, one per *time*. */ +/* Note about bar starts and after rpt's/boublebars: There is an afterruleskip */ +/* (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */ +/* (dotsfac*wheadpt) is presumed to be filled up. */ + +#line 16085 "" + in = istart[ib] - 1; +#line 16086 "" + itrpt = -1; +#line 16087 "" + itsig = -1; + +/* Begin big manual loop over notes in this block; ends at 112 */ + +#line 16091 "" +L111: +#line 16091 "" + ++in; +#line 16092 "" + if (in > istop[ib]) { +#line 16092 "" + goto L112; +#line 16092 "" + } +#line 16093 "" + ip = all_1.ipo[in - 1]; +#line 16094 "" + commvl_1.ivx = all_1.ivxo[in - 1]; +#line 16095 "" + if (commvl_1.ivx <= all_1.nv) { +#line 16096 "" + all_1.iv = commvl_1.ivx; +#line 16097 "" + } else { +#line 16098 "" + i__1 = all_1.nv; +#line 16098 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16099 "" + if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[ + all_1.iv + 23] == commvl_1.ivx) { +#line 16099 "" + goto L129; +#line 16099 "" + } +#line 16100 "" +/* L128: */ +#line 16100 "" + } +#line 16101 "" + s_wsle(&io___994); +#line 16101 "" + do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", ( + ftnlen)35); +#line 16101 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof( + integer)); +#line 16101 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof( + integer)); +#line 16101 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof( + integer)); +#line 16101 "" + e_wsle(); +#line 16102 "" + s_wsle(&io___995); +#line 16102 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof( + integer)); +#line 16102 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof( + integer)); +#line 16102 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof( + integer)); +#line 16102 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof( + integer)); +#line 16102 "" + e_wsle(); +#line 16103 "" + s_stop("", (ftnlen)0); +#line 16104 "" + } +#line 16105 "" +L129: + +/* Call precrd here so we know how much space to add for accid's in chords */ +/* After calling precrd, icashft>0 means there is a shifted chordal accid (incl. */ +/* main note. */ + +/* To call precrd, need up-downness, so must track if in beam. */ + +/* Deal w/ staff-jumping beams later */ +/* if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx) */ +/* * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */ +/* * btest(nacc(ivx,ip),21)) then */ +/* if (.not.btest(irest(ivx,ip),24)) then */ +#line 16118 "" + 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 16120 "" + beamon1[commvl_1.ivx - 1] = TRUE_; +#line 16121 "" + } +#line 16122 "" + icashft = 0; +#line 16123 "" + 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 16127 "" + if (beamon1[commvl_1.ivx - 1]) { +#line 16128 "" + 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 16131 "" + } else { +#line 16132 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 16132 "" + 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 16132 "" + 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 16136 "" + } +#line 16137 "" + } + +/* Turn beam off? */ + +#line 16141 "" + if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[ + commvl_1.ivx - 1] * 24 - 25] == ip) { +#line 16142 "" + beamon1[commvl_1.ivx - 1] = FALSE_; +#line 16143 "" + ++ibmcnt1[commvl_1.ivx - 1]; +#line 16144 "" + } + +/* Remember, rpts & internal sigs can only come at start of (internal) block */ + +#line 16148 "" + 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); + +/* i.e., do not set for chord. Now check for "(" as ornament on main note, */ + +/* !!! Need to do this for chord notes too. Maybe in chkarp? */ + +#line 16156 "" + isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0); + +/* 5/15/02 Add check for ) ornament of prior note. */ +/* 5/16 Nope...fails when grace intervenes. */ +/* if (ip .gt. 1) then */ +/* isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */ +/* end if */ +#line 16163 "" + isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27); +#line 16164 "" + iscacc = FALSE_; +#line 16165 "" + 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 16170 "" + 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 16172 "" + chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, & + iscacc, &isarp); +#line 16173 "" + } + +/* When we get motivated, will do spacing for arpeggios here. */ + +#line 16177 "" + if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] & + 96) > 0) { +#line 16177 "" + itrpt = i_nint(&all_1.to[in - 1]); +#line 16177 "" + } +#line 16179 "" + issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28); +#line 16180 "" + if (commvl_1.ivx == 1 && issig) { +#line 16180 "" + itsig = i_nint(&all_1.to[in - 1]); +#line 16180 "" + } +#line 16181 "" + 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 16183 "" + isgaft = FALSE_; +#line 16184 "" + if (ip > 1) { +#line 16185 "" + xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 - + 25] - 1]; +#line 16186 "" + 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 16187 "" + isgrace = isgrace || isgaft; +#line 16188 "" + } +#line 16189 "" + 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 16193 "" + isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol; +#line 16194 "" + if (isflag) { +#line 16194 "" + i__7 = ip - 1; +#line 16194 "" + i__1 = ncmid_(&all_1.iv, &i__7); +#line 16194 "" + 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 16194 "" + isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25] + ,0) && *(unsigned char *)&ch__6[0] == 'u'; +#line 16194 "" + } +#line 16198 "" + if (isflag) { +#line 16199 "" + i__1 = numbms[commvl_1.ivx]; +#line 16199 "" + for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) { +#line 16200 "" + if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) { +#line 16201 "" + goto L117; + +/* Add check for non-beamed xtuplets. May be problem with stem direction. */ + +/* else if (ip-1.le.ibm2(ivx,ibmchk)) then */ +#line 16206 "" + } 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 16208 "" + isflag = FALSE_; +#line 16209 "" + goto L117; +#line 16210 "" + } +#line 16211 "" +/* L116: */ +#line 16211 "" + } +#line 16212 "" + } +#line 16213 "" +L117: + +/* If isflag, then won't need to check for dot on prev. note. */ + +/* 5/16/02 ??? Try using this for ) ornament. */ + +#line 16219 "" + isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24 + - 1],13); +#line 16220 "" + isdot = ip > 1; +#line 16221 "" + if (isdot) { +#line 16221 "" + i__1 = ip - 1; +#line 16221 "" + isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1); +#line 16221 "" + } +#line 16222 "" + isrshft = ip > 1; +#line 16223 "" + if (isrshft) { +#line 16223 "" + isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], + 20); +#line 16223 "" + } +#line 16224 "" + 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 16224 "" + goto L111; +#line 16224 "" + } + +/* Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */ +/* Compute pts, the total occupied space including prior notehead. */ + +/* 130324 */ +/* wheadpt1 = wheadpt*fullsize(iv) */ +#line 16234 "" + wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[ + all_1.iv - 1] - 1]; +#line 16235 "" + pts = wheadpt1; + +/* Set up for possible cautionary accidental here */ + +#line 16239 "" + if (isaccs || iscacc) { +#line 16240 "" + if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) { +#line 16241 "" + taccfac = spfacs_1.accfac; +#line 16242 "" + } else { +#line 16243 "" + taccfac = spfacs_1.accfac * 1.4f; +/* cautionary accidental */ +#line 16244 "" + } +#line 16245 "" + } +#line 16246 "" + if (isgrace) { +#line 16247 "" + secondgrace = FALSE_; +#line 16248 "" + i__1 = comgrace_1.ngrace; +#line 16248 "" + for (ig = 1; ig <= i__1; ++ig) { +#line 16249 "" + if (! isgaft) { +#line 16250 "" + if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1] + == commvl_1.ivx) { +#line 16250 "" + goto L123; +#line 16250 "" + } +#line 16251 "" + } else if (ip > 1) { +#line 16252 "" + if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig + - 1] == commvl_1.ivx) { +#line 16252 "" + goto L123; +#line 16252 "" + } +#line 16253 "" + } +#line 16254 "" +/* L122: */ +#line 16254 "" + } +#line 16255 "" + s_wsle(&io___1015); +#line 16255 "" + do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", ( + ftnlen)39); +#line 16255 "" + e_wsle(); +#line 16256 "" + s_stop("", (ftnlen)0); +#line 16257 "" +L123: + +/* wgr = distance to backspace (in headwidths), less main acc. */ +/* ptgr = same in pts,+ main acc. Not used for after-grace. Distance to backspace. */ +/* 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 16264 "" + if (comgrace_1.nng[ig - 1] == 1) { +#line 16265 "" + wgr = spfacs_1.grafac; +#line 16266 "" + if (comgrace_1.multg[ig - 1] == 0) { +#line 16266 "" + wgr += -.4f; +#line 16266 "" + } +#line 16267 "" + } else { +#line 16268 "" + wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; +#line 16269 "" + i__1 = comgrace_1.nng[ig - 1]; +#line 16269 "" + for (ing = 2; ing <= i__1; ++ing) { +#line 16270 "" + if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing + - 1] > 0) { +#line 16270 "" + wgr += spfacs_1.acgfac; +#line 16270 "" + } +#line 16271 "" +/* L126: */ +#line 16271 "" + } +#line 16272 "" + } +#line 16273 "" + if (comgrace_1.graspace[ig - 1] > 0.f) { + +/* User-defined space before grace */ + +#line 16277 "" + wgr += comgrace_1.graspace[ig - 1]; +#line 16278 "" + } +#line 16279 "" + ptgr[ig - 1] = wgr * wheadpt1; +#line 16280 "" + spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1; + +/* !!! May need to mod for chord accid's */ + +#line 16284 "" + if (isaccs || iscacc) { +#line 16284 "" + ptgr[ig - 1] += taccfac * wheadpt1; +#line 16284 "" + } +#line 16285 "" + if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) { +#line 16285 "" + spgr += wheadpt1 * spfacs_1.agc1fac; +#line 16285 "" + } +#line 16286 "" + 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 16291 "" + if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) { +#line 16292 "" + if (comgrace_1.ipg[ig] == ip) { +#line 16293 "" + secondgrace = TRUE_; +#line 16294 "" + ++ig; +#line 16295 "" + goto L123; +#line 16296 "" + } +#line 16297 "" + } +#line 16298 "" + } +#line 16299 "" + if (iscln) { +#line 16300 "" + pts += spfacs_1.clefac * wheadpt1; + +/* How far to backspace when printing the clef */ + +#line 16304 "" + ptclef[commvl_1.ivx - 1] = 0.f; + +/* !!! May need to mod for chord accid's */ + +#line 16308 "" + if (isaccs || iscacc) { +#line 16308 "" + ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1; +#line 16308 "" + } +#line 16310 "" + if (isgrace) { +#line 16310 "" + ptclef[commvl_1.ivx - 1] += spgr; +#line 16310 "" + } +#line 16311 "" + } +#line 16312 "" + if (isrshft) { +#line 16313 "" + pts += spfacs_1.rtshfac * wheadpt1; +#line 16314 "" + } else if (isflag) { +#line 16315 "" + pts += spfacs_1.flagfac * wheadpt1; +#line 16316 "" + } else if (isdot) { +#line 16317 "" + pts += spfacs_1.dotfac * wheadpt1; +#line 16318 "" + } +#line 16319 "" + if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) { + +/* Repeat, need a little extra space */ + +#line 16323 "" + pts += spfacs_1.dotsfac * wheadpt1; +#line 16324 "" + } +#line 16325 "" + if (isarp) { +#line 16326 "" + pts += spfacs_1.arpfac * wheadpt1; +#line 16327 "" + } + +/* Add in padding space */ + +#line 16331 "" + pts += spfacs_1.xspfac * wheadpt1; + +/* Now done with all items needing space except accidentals, */ +/* accidental shifts, and left-notehead-shifts, and will later */ +/* subtract a notehead if at start of bar. */ + +/* Get available space in elemskips (esk) */ + +/* isfirst = ip.eq.1 .or. to(in).eq.itrpt .or. */ +/* * to(in) .eq. itsig */ +#line 16341 "" + 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 16343 "" + if (isfirst) { + +/* At start of bar or after repeat sign or new signature */ + +/* if (to(in) .eq. itsig) then */ +#line 16348 "" + if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol) + { +#line 16349 "" + esk = 0.f; +#line 16350 "" + } else { +#line 16351 "" + esk = comask_1.fbar; +#line 16352 "" + } +#line 16353 "" + } else { + +/* Not 1st note of bar */ + +#line 16357 "" + esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[ + commvl_1.ivx + (ip - 1) * 24 - 25]; +#line 16358 "" + } +#line 16359 "" + if (isgrace) { + +/* Since graces can be very long, cannot assume no interference if prior */ +/* note uses >1 noteskip. So must get elsk's back to prior note, whether or */ +/* not it used only one noteskip. */ +/* <<But if it was xtup. don't need to call eskb4.>>???? */ + +/* 10/8/05 Kluge to not zero out esk if in xtup */ + +#line 16368 "" + esksav = esk; +/* Computing MAX */ +#line 16369 "" + i__1 = 1, i__7 = ip - 2; +#line 16369 "" + 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 16369 "" + eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[ + 1], &comask_1.fbar, &itrpt, &esk); +#line 16369 "" + } +/* * to(in).ne.itsig) */ +#line 16373 "" + if (dabs(esk) < comtol_1.tol) { +#line 16373 "" + esk = esksav; +#line 16373 "" + } +#line 16374 "" + } + +/* Done getting available elemskips. Remove headwidth if first. Must do here */ +/* rather than earlier since check uses isfirst */ + +#line 16379 "" + if (isfirst) { +#line 16379 "" + pts -= wheadpt1; +#line 16379 "" + } + +/* Deal with accidental shifts and left-notehead shifts */ + +#line 16383 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { + +/* In a chord */ + +#line 16387 "" + ptsl = 0.f; +#line 16388 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) { +#line 16388 "" + ptsl = wheadpt1; +#line 16388 "" + } +/* Computing MAX */ +#line 16389 "" + r__1 = ptsl, r__2 = icashft * .05f * wheadpt1; +#line 16389 "" + ptsadd = dmax(r__1,r__2); + +/* Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */ + +#line 16393 "" + } else { + +/* Not in a chord */ + +#line 16397 "" + ihshft = 0; +#line 16398 "" + if (isaccs) { +#line 16399 "" + 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 16401 "" + if (ihshft != 0) { +/* Computing MAX */ +#line 16401 "" + i__1 = 0, i__7 = 107 - ihshft; +#line 16401 "" + ihshft = max(i__1,i__7); +#line 16401 "" + } +#line 16402 "" + } + +/* Check for left-shifted main note */ + +#line 16406 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { +#line 16406 "" + ihshft = max(20,ihshft); +#line 16406 "" + } +#line 16407 "" + ptsadd = ihshft * .05f * wheadpt1; +#line 16408 "" + } +#line 16409 "" + pts += ptsadd; +#line 16410 "" + if (isgrace) { +#line 16410 "" + ptgr[ig - 1] += ptsadd; +#line 16410 "" + } +#line 16411 "" + if (iscln) { +#line 16411 "" + ptclef[commvl_1.ivx - 1] += ptsadd; +#line 16411 "" + } + +/* Left-shifted, non-chord note before? */ + +#line 16415 "" + if (ip > 1) { +#line 16416 "" + 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 16416 "" + pts -= wheadpt1; +#line 16416 "" + } +#line 16418 "" + } + +/* Try big accidentals first */ + +#line 16422 "" + ptbneed = pts; +#line 16423 "" + if (isaccs || iscacc) { +#line 16424 "" + ptbneed += wheadpt1 * spfacs_1.bacfac; +#line 16425 "" + } +#line 16426 "" + if (comask_1.poenom * esk > ptbneed) { + +/* Set flag for big accidental */ + +#line 16430 "" + if (isacc) { +#line 16430 "" + all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[ + commvl_1.ivx + ip * 24 - 25],3); +#line 16430 "" + } +#line 16431 "" + goto L99; +#line 16432 "" + } + +/* Cannot use big, so try small */ + +#line 16436 "" + ptsneed = pts; +#line 16437 "" + if (isaccs || iscacc) { +#line 16438 "" + ptsneed += taccfac * wheadpt1; +#line 16439 "" + } +#line 16440 "" + if (comask_1.poenom * esk < ptsneed) { +#line 16440 "" + addask_(&all_1.to[in - 1], &ptsneed, &esk, &comask_1.fixednew, & + comask_1.scaldold, &c_b762, &c_false); +#line 16440 "" + } +#line 16442 "" +L99: +#line 16443 "" + if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) { + +/* User-defined space. Warning, "zero" may change value in addask! */ + +#line 16447 "" + zero = 0.f; +#line 16448 "" + addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, & + comask_1.scaldold, tglp1, &c_true); +#line 16450 "" + } + +/* End of big manual loop over "in" for accidental checking */ + +#line 16454 "" + goto L111; +#line 16455 "" +L112: + +/* End of ask analysis for this block. */ + +/* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */ + +#line 16461 "" + if (comas1_1.naskb > 0) { +#line 16461 "" + adjusteskz_(&ib, &istart[1], &comask_1.poenom); +#line 16461 "" + } + +/* Check for internal repeat or sig change. */ + +#line 16465 "" + if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) { +#line 16466 "" + iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] & + 67109216; +#line 16467 "" + if (iirpt > 0) { + +/* Internal repeat */ + +#line 16471 "" + if (comlast_1.islast) { +#line 16471 "" + s_wsfe(&io___1031); +/* Writing concatenation */ +#line 16471 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 16471 "" + i__9[1] = 7, a__6[1] = "advance"; +#line 16471 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 16471 "" + i__9[3] = 8, a__6[3] = "barno-1%"; +#line 16471 "" + s_cat(ch__7, a__6, i__9, &c__4, (ftnlen)17); +#line 16471 "" + do_fio(&c__1, ch__7, (ftnlen)17); +#line 16471 "" + e_wsfe(); +#line 16471 "" + } +#line 16472 "" + if (iirpt == 96) { +#line 16473 "" + if (comlast_1.islast) { +#line 16473 "" + s_wsfe(&io___1032); +/* Writing concatenation */ +#line 16473 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16473 "" + i__4[1] = 15, a__2[1] = "leftrightrepeat"; +#line 16473 "" + s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)16); +#line 16473 "" + do_fio(&c__1, ch__8, (ftnlen)16); +#line 16473 "" + e_wsfe(); +#line 16473 "" + } +#line 16474 "" + comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt; +#line 16475 "" + } else if (bit_test(iirpt,5)) { +#line 16476 "" + if (comlast_1.islast) { +#line 16476 "" + s_wsfe(&io___1033); +/* Writing concatenation */ +#line 16476 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16476 "" + i__4[1] = 10, a__2[1] = "leftrepeat"; +#line 16476 "" + s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); +#line 16476 "" + do_fio(&c__1, ch__9, (ftnlen)11); +#line 16476 "" + e_wsfe(); +#line 16476 "" + } +#line 16477 "" + comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; +#line 16478 "" + } else if (bit_test(iirpt,6)) { +#line 16479 "" + if (comlast_1.islast) { +#line 16479 "" + s_wsfe(&io___1034); +/* Writing concatenation */ +#line 16479 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16479 "" + i__4[1] = 11, a__2[1] = "rightrepeat"; +#line 16479 "" + s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 16479 "" + do_fio(&c__1, ch__5, (ftnlen)12); +#line 16479 "" + e_wsfe(); +#line 16479 "" + } +#line 16480 "" + comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt; +#line 16481 "" + } else if (bit_test(iirpt,8)) { +#line 16482 "" + if (comlast_1.islast) { +#line 16482 "" + s_wsfe(&io___1035); +/* Writing concatenation */ +#line 16482 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16482 "" + i__4[1] = 9, a__2[1] = "doublebar"; +#line 16482 "" + s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); +#line 16482 "" + do_fio(&c__1, ch__10, (ftnlen)10); +#line 16482 "" + e_wsfe(); +#line 16482 "" + } +#line 16483 "" + } else { +#line 16484 "" + s_wsle(&io___1036); +#line 16484 "" + do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "\ + "R*", (ftnlen)36); +#line 16484 "" + e_wsle(); +#line 16485 "" + stop1_(); +#line 16486 "" + } +#line 16487 "" + comask_1.scaldold -= comask_1.fbar; +#line 16488 "" + } +#line 16489 "" + if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) { + +/* Internal signature change. */ + +/* Writing concatenation */ +#line 16493 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16493 "" + i__4[1] = 17, a__2[1] = "generalsignature{"; +#line 16493 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16494 "" + lnote = 18; +#line 16495 "" + if (comtop_1.isig < 0) { +/* Writing concatenation */ +#line 16496 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 16496 "" + i__4[1] = 1, a__2[1] = "-"; +#line 16496 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16497 "" + ++lnote; +#line 16498 "" + } +#line 16499 "" + if (comlast_1.islast) { +#line 16499 "" + s_wsfe(&io___1037); +/* Writing concatenation */ +#line 16499 "" + i__6[0] = lnote, a__4[0] = notexq; +#line 16499 "" + i__1 = abs(comtop_1.isig) + 48; +#line 16499 "" + chax_(ch__6, (ftnlen)1, &i__1); +#line 16499 "" + i__6[1] = 1, a__4[1] = ch__6; +#line 16499 "" + i__6[2] = 2, a__4[2] = "}%"; +#line 16499 "" + s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82); +#line 16499 "" + do_fio(&c__1, ch__2, lnote + 3); +#line 16499 "" + e_wsfe(); +#line 16499 "" + } +#line 16501 "" + if (comlast_1.islast && comignorenats_1.ignorenats) { +#line 16501 "" + s_wsfe(&io___1038); +/* Writing concatenation */ +#line 16501 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16501 "" + i__4[1] = 11, a__2[1] = "ignorenats%"; +#line 16501 "" + s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 16501 "" + do_fio(&c__1, ch__5, (ftnlen)12); +#line 16501 "" + e_wsfe(); +#line 16501 "" + } +#line 16503 "" + if (comlast_1.islast) { +#line 16503 "" + s_wsfe(&io___1039); +/* Writing concatenation */ +#line 16503 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 16503 "" + i__3[1] = 14, a__1[1] = "zchangecontext"; +#line 16503 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 16503 "" + i__3[3] = 12, a__1[3] = "addspace{-.5"; +#line 16503 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 16503 "" + i__3[5] = 15, a__1[5] = "afterruleskip}%"; +#line 16503 "" + s_cat(ch__11, a__1, i__3, &c__6, (ftnlen)44); +#line 16503 "" + do_fio(&c__1, ch__11, (ftnlen)44); +#line 16503 "" + e_wsfe(); +#line 16503 "" + } +#line 16505 "" + lnote = 0; +#line 16506 "" + } +#line 16507 "" + } +#line 16508 "" + comnsp_2.flgndb = FALSE_; + +/* Done with start-of-block stuff. Begin main loop over voices. */ + +#line 16512 "" + i__1 = all_1.nv; +#line 16512 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 16513 "" + i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 16513 "" + for (kv = 1; kv <= i__7; ++kv) { +#line 16514 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 16515 "" + 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 16520 "" + if (all_1.figbass) { +#line 16521 "" + ivf = 0; +#line 16522 "" + if (commvl_1.ivx == 1) { +#line 16523 "" + ivf = 1; +#line 16524 "" + } else if (commvl_1.ivx == comfig_1.ivxfig2) { +#line 16525 "" + ivf = 2; +#line 16526 "" + } +#line 16527 "" + if (ivf > 0) { +#line 16527 "" + all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0; +#line 16527 "" + } +#line 16528 "" + } +#line 16529 "" + if (commvl_1.ivx > 1) { +#line 16530 "" + if (commvl_1.ivx <= all_1.nv) { +#line 16531 "" + addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq, + &lsout, (ftnlen)1, (ftnlen)80); +#line 16532 "" + } else { +/* Writing concatenation */ +#line 16533 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16533 "" + i__4[1] = 9, a__2[1] = "nextvoice"; +#line 16533 "" + s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10); +#line 16533 "" + addstr_(ch__10, &c__10, soutq, &lsout, (ftnlen)10, ( + ftnlen)80); +#line 16534 "" + } +#line 16535 "" + } +#line 16536 "" + if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) { + +/* Write header. First adjust height if needed to miss barno. */ + +#line 16540 "" + if (comask_1.bar1syst && all_1.iline != 1) { +#line 16541 "" + comhead_1.ihdht = comsln_1.irzbnd + 15 + + comsln_1.isnx; +#line 16542 "" + } + +/* Add user-defined vertical shift */ + +#line 16546 "" + comhead_1.ihdht += comhead_1.ihdvrt; +#line 16547 "" + lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80); +/* Writing concatenation */ +#line 16548 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16548 "" + i__4[1] = 10, a__2[1] = "zcharnote{"; +#line 16548 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16549 "" + s_wsfi(&io___1043); +#line 16549 "" + do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof( + integer)); +#line 16549 "" + e_wsfi(); +/* Writing concatenation */ +#line 16550 "" + i__3[0] = 13, a__1[0] = notexq; +#line 16550 "" + i__3[1] = 2, a__1[1] = "}{"; +#line 16550 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 16550 "" + i__3[3] = 7, a__1[3] = "bigfont"; +#line 16550 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 16550 "" + i__3[5] = 10, a__1[5] = "kern-30pt "; +#line 16550 "" + s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); +#line 16551 "" + addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +/* Writing concatenation */ +#line 16552 "" + i__4[0] = lchead, a__2[0] = comhead_1.headrq; +#line 16552 "" + i__4[1] = 1, a__2[1] = "}"; +#line 16552 "" + s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 16552 "" + i__10 = lchead + 1; +#line 16552 "" + addstr_(ch__12, &i__10, soutq, &lsout, lchead + 1, ( + ftnlen)80); +#line 16553 "" + comhead_1.ihdht = 0; +#line 16554 "" + } +#line 16555 "" + if (comhead_1.lower && commvl_1.ivx == all_1.nv) { +#line 16556 "" + lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80); +/* Writing concatenation */ +#line 16557 "" + i__11[0] = 1, a__7[0] = all_1.sq; +#line 16557 "" + i__11[1] = 14, a__7[1] = "zcharnote{-6}{"; +#line 16557 "" + i__11[2] = 1, a__7[2] = all_1.sq; +#line 16557 "" + i__11[3] = 5, a__7[3] = "tempo"; +#line 16557 "" + i__11[4] = 1, a__7[4] = all_1.sq; +#line 16557 "" + i__11[5] = 10, a__7[5] = "kern-10pt "; +#line 16557 "" + i__11[6] = lclow, a__7[6] = comhead_1.lowerq; +#line 16557 "" + i__11[7] = 1, a__7[7] = "}"; +#line 16557 "" + s_cat(ch__13, a__7, i__11, &c__8, (ftnlen)113); +#line 16557 "" + i__10 = lclow + 33; +#line 16557 "" + addstr_(ch__13, &i__10, soutq, &lsout, lclow + 33, ( + ftnlen)80); +#line 16560 "" + comhead_1.lower = FALSE_; +#line 16561 "" + } +#line 16562 "" + tnow = tstart[ib]; +#line 16563 "" + nofirst = TRUE_; + +/* Done setting up voice ivx for start of block ib. Loop over notes in voice. */ + +#line 16567 "" + i__10 = istop[ib]; +#line 16567 "" + for (all_1.jn = istart[ib]; all_1.jn <= i__10; ++all_1.jn) { +#line 16568 "" + if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) { +#line 16568 "" + goto L10; +#line 16568 "" + } +#line 16569 "" + ip = all_1.ipo[all_1.jn - 1]; + +/* May have problem with not initializing islhgt, so do it here */ + +#line 16573 "" + islhgt = 0; + +#line 16575 "" + if (nofirst) { +#line 16576 "" + comoct_1.noctup = 0; +#line 16577 "" + if (ncmid_(&all_1.iv, &ip) == 23) { +#line 16577 "" + comoct_1.noctup = -2; +#line 16577 "" + } +#line 16578 "" + nofirst = FALSE_; +#line 16579 "" + } + +/* Check for internal floating figure (before last note of group). */ + +#line 16583 "" +L12: +#line 16583 "" + if (all_1.figbass) { +#line 16584 "" + if (commvl_1.ivx == 1 || commvl_1.ivx == + comfig_1.ivxfig2) { +#line 16585 "" + ivf = 1; +#line 16586 "" + if (commvl_1.ivx > 1) { +#line 16586 "" + ivf = 2; +#line 16586 "" + } +#line 16587 "" + 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 16592 "" + offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ + ivf - 1] << 1) - 3]) / comnsp_2.space[ + ib - 1]; +#line 16593 "" + putfig_(&ivf, &ifig[ivf - 1], &offnsk, & + all_1.figchk[ivf - 1], soutq, &lsout, + (ftnlen)80); +#line 16595 "" + goto L12; +#line 16596 "" + } +#line 16597 "" + } +#line 16598 "" + } + +/* Put in \sk if needed */ + +#line 16602 "" + if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) { +/* Writing concatenation */ +#line 16603 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16603 "" + i__4[1] = 2, a__2[1] = "sk"; +#line 16603 "" + s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); +#line 16603 "" + addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, ( + ftnlen)80); +#line 16604 "" + tnow += comnsp_2.space[ib - 1]; +#line 16605 "" + goto L12; +#line 16606 "" + } + +/* Check for user-defined shifts */ + +#line 16610 "" + 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 16610 "" + putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, ( + ftnlen)80); +#line 16610 "" + } +#line 16612 "" +L21: +#line 16612 "" + if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow > + comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] - + comtol_1.tol) { +#line 16614 "" + if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] > + tstart[ib] - comtol_1.tol) { + +/* Insert placeholder for accidental skip */ + +/* Writing concatenation */ +#line 16618 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16618 "" + i__4[1] = 8, a__2[1] = "ask "; +#line 16618 "" + s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)9); +#line 16618 "" + addstr_(ch__15, &c__9, soutq, &lsout, (ftnlen)9, ( + ftnlen)80); +#line 16619 "" + ++comas2_1.nasksys; +#line 16620 "" + comas2_1.wasksys[comas2_1.nasksys - 1] = + comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] + ; +#line 16621 "" + if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] > + 0.f) { +#line 16622 "" + comas2_1.elasksys[comas2_1.nasksys - 1] = + comas1_1.elask[iaskb[commvl_1.ivx - 1] + - 1]; +#line 16623 "" + } else { + +/* This is a signal to permit negative ask's. Should really have elask>=0. */ + +#line 16627 "" + comas2_1.elasksys[comas2_1.nasksys - 1] = + -comas1_1.elask[iaskb[commvl_1.ivx - + 1] - 1]; +#line 16628 "" + } +#line 16629 "" + } + +/* May have skipped some task's in earlier blocks (due to void voice) */ + +#line 16633 "" + ++iaskb[commvl_1.ivx - 1]; +#line 16634 "" + goto L21; +#line 16635 "" + } +#line 16636 "" + if (all_1.figbass) { +#line 16637 "" + if (commvl_1.ivx == 1 || commvl_1.ivx == + comfig_1.ivxfig2) { +#line 16638 "" + ivf = 1; +#line 16639 "" + if (commvl_1.ivx > 1) { +#line 16639 "" + ivf = 2; +#line 16639 "" + } +#line 16640 "" + if (all_1.figchk[ivf - 1] && (r__1 = + comfig_1.itfig[ivf + (ifig[ivf - 1] << 1) + - 3] - tnow, dabs(r__1)) < comtol_1.tol) { + +/* Figure on a note. NB: later special check for late figs. */ + +#line 16645 "" + putfig_(&ivf, &ifig[ivf - 1], &c_b762, & + all_1.figchk[ivf - 1], soutq, &lsout, + (ftnlen)80); +#line 16646 "" + } +#line 16647 "" + } +#line 16648 "" + } + +/* Check for new clef here. */ + +#line 16652 "" + if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 + - 25],11)) { +/* print*,'At clef insertion, ptclef:',ptclef(iv) */ +#line 16654 "" + if (ptclef[all_1.iv - 1] > 0.f) { +/* Writing concatenation */ +#line 16655 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16655 "" + i__4[1] = 5, a__2[1] = "off{-"; +#line 16655 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16656 "" + if (ptclef[all_1.iv - 1] < 9.95f) { +#line 16657 "" + s_wsfi(&io___1049); +#line 16657 "" + do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( + ftnlen)sizeof(real)); +#line 16657 "" + e_wsfi(); +#line 16658 "" + lnote = 9; +#line 16659 "" + } else { +#line 16660 "" + s_wsfi(&io___1050); +#line 16660 "" + do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( + ftnlen)sizeof(real)); +#line 16660 "" + e_wsfi(); +#line 16661 "" + lnote = 10; +#line 16662 "" + } +/* Writing concatenation */ +#line 16663 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 16663 "" + i__4[1] = 3, a__2[1] = "pt}"; +#line 16663 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16664 "" + lnote += 3; +#line 16665 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, + (ftnlen)80); +/* print*,'Just added: ',notexq(1:lnote) */ +#line 16667 "" + } +#line 16668 "" + 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 16672 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],2) + ) { +/* Writing concatenation */ +#line 16672 "" + i__6[0] = 8, a__4[0] = notexq; +#line 16672 "" + i__6[1] = 1, a__4[1] = "8"; +#line 16672 "" + i__6[2] = 1, a__4[2] = notexq + 9; +#line 16672 "" + s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); +#line 16672 "" + } +#line 16674 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 16675 "" + if (ptclef[all_1.iv - 1] > 0.f) { +/* Writing concatenation */ +#line 16676 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16676 "" + i__4[1] = 4, a__2[1] = "off{"; +#line 16676 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16677 "" + if (ptclef[all_1.iv - 1] < 9.95f) { +#line 16678 "" + s_wsfi(&io___1052); +#line 16678 "" + do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( + ftnlen)sizeof(real)); +#line 16678 "" + e_wsfi(); +#line 16679 "" + lnote = 8; +#line 16680 "" + } else { +#line 16681 "" + s_wsfi(&io___1053); +#line 16681 "" + do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], ( + ftnlen)sizeof(real)); +#line 16681 "" + e_wsfi(); +#line 16682 "" + lnote = 9; +#line 16683 "" + } +/* Writing concatenation */ +#line 16684 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 16684 "" + i__4[1] = 3, a__2[1] = "pt}"; +#line 16684 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 16685 "" + lnote += 3; +#line 16686 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, + (ftnlen)80); +#line 16687 "" + } +#line 16688 "" + } + +/* Checking for literal TeX string BEFORE starting beams!! */ + +#line 16692 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16)) + { +#line 16693 "" + i__12 = comgrace_1.nlit; +#line 16693 "" + for (il = 1; il <= i__12; ++il) { +#line 16694 "" + if (comgrace_1.iplit[il - 1] == ip && + comgrace_1.ivlit[il - 1] == commvl_1.ivx) + { +#line 16694 "" + goto L125; +#line 16694 "" + } +#line 16695 "" +/* L124: */ +#line 16695 "" + } +#line 16696 "" + s_wsle(&io___1055); +#line 16696 "" + do_lio(&c__9, &c__1, "Problem finding index for lite"\ + "ral string", (ftnlen)40); +#line 16696 "" + e_wsle(); +#line 16697 "" + stop1_(); +#line 16698 "" +L125: + +/* Write a type 1 tex string. */ + +#line 16702 "" + if (comgrace_1.lenlit[il - 1] < 71) { + +/* Add normally */ + +#line 16706 "" + addstr_(comgrace_1.litq + (il - 1 << 7), & + comgrace_1.lenlit[il - 1], soutq, &lsout, + (ftnlen)128, (ftnlen)80); +#line 16707 "" + } else { + +/* Longer than 71. Write souq, Write string, start new soutq. */ + +#line 16711 "" + if (comlast_1.islast) { +#line 16711 "" + s_wsfe(&io___1056); +/* Writing concatenation */ +#line 16711 "" + i__4[0] = lsout, a__2[0] = soutq; +#line 16711 "" + i__4[1] = 1, a__2[1] = "%"; +#line 16711 "" + s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 16711 "" + do_fio(&c__1, ch__12, lsout + 1); +#line 16711 "" + e_wsfe(); +#line 16711 "" + } +#line 16712 "" + if (comlast_1.islast) { +#line 16712 "" + s_wsfe(&io___1057); +/* Writing concatenation */ +#line 16712 "" + i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] = + comgrace_1.litq + (il - 1 << 7); +#line 16712 "" + i__4[1] = 1, a__2[1] = "%"; +#line 16712 "" + s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)129); +#line 16712 "" + do_fio(&c__1, ch__16, comgrace_1.lenlit[il - + 1] + 1); +#line 16712 "" + e_wsfe(); +#line 16712 "" + } +#line 16713 "" + lsout = 0; +#line 16714 "" + } +#line 16715 "" + } + +/* Arpeggio on a main (non-chordal) note? */ + +#line 16719 "" + 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 16721 "" + s_wsle(&io___1058); +#line 16721 "" + do_lio(&c__9, &c__1, "Calling putarp main, iv,ivx:", ( + ftnlen)28); +#line 16721 "" + do_lio(&c__3, &c__1, (char *)&all_1.iv, (ftnlen) + sizeof(integer)); +#line 16721 "" + do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen) + sizeof(integer)); +#line 16721 "" + e_wsle(); +#line 16722 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16722 "" + putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[ + commvl_1.ivx + ip * 24 - 25], &i__12, soutq, & + lsout, (ftnlen)80); +#line 16724 "" + } + +/* See if a beam starts here */ + +#line 16728 "" + 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 16731 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],24)) { + +/* Not a jump start */ + +#line 16735 "" + 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 16735 "" + 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, + &all_1.nv, &all_1.ibar, &tnow, & + comtol_1.tol, all_1.nodur, &c__2, + comkbdrests_1.levtopr, + comkbdrests_1.levbotr, all_1.mult, + all_1.ipl); +#line 16735 "" + } +/* * mult) */ +#line 16742 "" + beamstrt_(notexq, &lnote, nornb, ihornb, + comnsp_2.space, &squez[1], &ib, (ftnlen) + 79); + +/* Shift beam start if notehead was shifted */ + +#line 16746 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - + 25],8)) { +/* Writing concatenation */ +#line 16747 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16747 "" + i__4[1] = 5, a__2[1] = "loff{"; +#line 16747 "" + s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 16747 "" + addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) + 6, (ftnlen)80); +#line 16748 "" + } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * + 24 - 25],9)) { +/* Writing concatenation */ +#line 16749 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 16749 "" + i__4[1] = 5, a__2[1] = "roff{"; +#line 16749 "" + s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 16749 "" + addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen) + 6, (ftnlen)80); +#line 16750 "" + } +#line 16751 "" + if (lnote > 0) { +#line 16751 "" + addstr_(notexq, &lnote, soutq, &lsout, ( + ftnlen)79, (ftnlen)80); +#line 16751 "" + } +#line 16752 "" + 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 16752 "" + addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, + (ftnlen)80); +#line 16752 "" + } +#line 16754 "" + } 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 16759 "" + combjmp_1.ivbj2 = commvl_1.ivx; + +/* Check for xtup since we bypassed beamstrt wherein vxtup is normally set */ + +#line 16763 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],28) && strtmid_1.ixrest[commvl_1.ivx + - 1] != 2) { +#line 16763 "" + comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_; +#line 16763 "" + } + +/* 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 16770 "" + comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_; +#line 16771 "" + } +#line 16772 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { +#line 16773 "" + all_1.beamon[commvl_1.ivx - 1] = TRUE_; +#line 16774 "" + bspend = TRUE_; +#line 16775 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 + - 25],24)) { +#line 16775 "" + bspend = TRUE_; +#line 16775 "" + } +#line 16776 "" + } +#line 16777 "" + } + +/* Setup for chords and possible slurs in chords */ + +#line 16781 "" + 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 16787 "" + if (all_1.beamon[commvl_1.ivx - 1]) { +#line 16788 "" + 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 + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25), &c_true, & + icashft, (ftnlen)1); +#line 16791 "" + } else { +#line 16792 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16792 "" + 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 16792 "" + 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 16796 "" + } +#line 16797 "" + } + +/* Is there slur or grace activity? */ + +#line 16801 "" + isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - + 25],4); +#line 16802 "" + if (ip > 1) { +#line 16802 "" + isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx + + (ip - 1) * 24 - 25],31); +#line 16802 "" + } + +/* isgrace if not 1st note in bar and previous note has Way-after grace. */ + +#line 16806 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0) + || isgrace) { +#line 16807 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], + 0)) { +#line 16808 "" + if (comslur_1.fontslur) { + +/* Call routine for non-postscript slurs */ + +#line 16812 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16812 "" + doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 - + 25], all_1.isdat1, all_1.isdat2, + all_1.isdat3, &all_1.nsdat, &ip, & + all_1.iv, &kv, &all_1.nv, & + all_1.beamon[commvl_1.ivx - 1], & + i__12, soutq, &lsout, all_1.ulq + ( + commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25), & + all_1.islur[commvl_1.ivx + ip * 24 - + 25], &all_1.ipl[commvl_1.ivx + ip * + 24 - 25], &all_1.iornq[commvl_1.ivx + + ip * 24 - 1], &islhgt, &all_1.tnote[ + comipl2_1.ipl2[commvl_1.ivx + ip * 24 + - 25] - 1], &all_1.nacc[commvl_1.ivx + + ip * 24 - 25], (ftnlen)80, (ftnlen) + 1); +#line 16817 "" + } else { + +/* Postscript slurs */ + +#line 16821 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16821 "" + dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24 + - 25], all_1.isdat1, all_1.isdat2, + all_1.isdat3, all_1.isdat4, & + all_1.nsdat, &ip, &all_1.iv, &kv, & + all_1.nv, &all_1.beamon[commvl_1.ivx + - 1], &i__12, soutq, &lsout, + all_1.ulq + (commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - + 25), &all_1.islur[commvl_1.ivx + ip * + 24 - 25], &all_1.ipl[commvl_1.ivx + + ip * 24 - 25], &all_1.iornq[ + commvl_1.ivx + ip * 24 - 1], &islhgt, + &all_1.tnote[comipl2_1.ipl2[ + commvl_1.ivx + ip * 24 - 25] - 1], & + all_1.nacc[commvl_1.ivx + ip * 24 - + 25], (ftnlen)80, (ftnlen)1); +#line 16827 "" + } +#line 16828 "" + } +#line 16829 "" + if (isgrace) { + +/* Grace note. */ + +#line 16833 "" + iphold = ip; +#line 16834 "" + isgrace = FALSE_; +#line 16835 "" + if (ip > 1) { +#line 16835 "" + isgrace = bit_test(all_1.ipl[commvl_1.ivx + ( + ip - 1) * 24 - 25],31); +#line 16835 "" + } +#line 16836 "" + if (isgrace) { +#line 16836 "" + --iphold; +#line 16836 "" + } +#line 16837 "" + isgrace = isgrace || ! bit_test(all_1.ipl[ + commvl_1.ivx + ip * 24 - 25],31) && ! + bit_test(all_1.ipl[commvl_1.ivx + ip * 24 + - 25],29); + +/* 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 16843 "" + if (isgrace) { +#line 16844 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16844 "" + i__13 = ncmid_(&all_1.iv, &ip); +#line 16844 "" + dograce_(&commvl_1.ivx, &iphold, ptgr, soutq, + &lsout, &i__12, &all_1.nacc[ + commvl_1.ivx + ip * 24 - 25], &ig, & + all_1.ipl[commvl_1.ivx + iphold * 24 + - 25], &c_false, &all_1.beamon[ + commvl_1.ivx - 1], &all_1.nolev[ + commvl_1.ivx + ip * 24 - 25], &i__13, + &all_1.islur[commvl_1.ivx + ip * 24 - + 25], &commvl_1.nvmx[all_1.iv - 1], & + all_1.nv, &all_1.ibmcnt[commvl_1.ivx + - 1], &all_1.tnote[comipl2_1.ipl2[ + commvl_1.ivx + ip * 24 - 25] - 1], + all_1.ulq, &cominsttrans_1.instno[ + all_1.iv - 1], (ftnlen)80, (ftnlen)1); +/* 130324 */ +/* * tnote(ipl2(ivx,ip)),ulq) */ +#line 16851 "" + if (comgrace_1.slurg[ig - 1]) { + +/* Terminate slur started in dograce. Get direction of main note stem */ + +#line 16855 "" + if (! all_1.beamon[commvl_1.ivx - 1]) { + +/* Separate note. Get stem direction. */ + +#line 16859 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16859 "" + 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 16859 "" + stemup = *(unsigned char *)&ch__6[0] + == 'u'; +#line 16861 "" + } else { + +/* In a beam */ + +#line 16865 "" + stemup = *(unsigned char *)&all_1.ulq[ + commvl_1.ivx + all_1.ibmcnt[ + commvl_1.ivx - 1] * 24 - 25] + == 'u'; +#line 16866 "" + } + +/* Stop the shift if whole note */ + +#line 16870 "" + stemup = stemup || all_1.tnote[ + comipl2_1.ipl2[commvl_1.ivx + ip * + 24 - 25] - 1] > 63.f; +#line 16872 "" + L__1 = ! comgrace_1.upg[ig - 1]; +#line 16872 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16872 "" + 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 16874 "" + } +#line 16875 "" + } +#line 16876 "" + } +#line 16877 "" + 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 16882 "" + i__12 = 16777215 - comslur_1.listslur; +#line 16882 "" + comslur_1.ndxslur = log2_(&i__12); + +/* Get note name */ + +#line 16886 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16886 "" + notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx + + ip * 24 - 25], &i__12, (ftnlen)8); + +/* Get slur direction */ + +#line 16890 "" + *(unsigned char *)slurudq = 'u'; +#line 16891 "" + if (! all_1.beamon[commvl_1.ivx - 1]) { +#line 16892 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16892 "" + 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 16892 "" + if (*(unsigned char *)&ch__6[0] == 'u') { +#line 16892 "" + *(unsigned char *)slurudq = 'd'; +#line 16892 "" + } +#line 16894 "" + } else { +#line 16895 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + + all_1.ibmcnt[commvl_1.ivx - 1] * 24 + - 25] == 'u') { +#line 16895 "" + *(unsigned char *)slurudq = 'd'; +#line 16895 "" + } +#line 16896 "" + } + +/* c Replace ndxslur by 11-ndxslur when printing only. */ +/* Replace ndxslur by 23-ndxslur when printing only. */ + +/* if (11-ndxslur .lt. 10) then */ +#line 16902 "" + if (23 - comslur_1.ndxslur < 10) { +/* notexq = sq//'islur'//slurudq//chax(59-ndxslur) */ +/* Writing concatenation */ +#line 16904 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 16904 "" + i__5[1] = 5, a__3[1] = "islur"; +#line 16904 "" + i__5[2] = 1, a__3[2] = slurudq; +#line 16904 "" + i__12 = 71 - comslur_1.ndxslur; +#line 16904 "" + chax_(ch__6, (ftnlen)1, &i__12); +#line 16904 "" + i__5[3] = 1, a__3[3] = ch__6; +#line 16904 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 16904 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 16906 "" + i__12 = lnoten + 8; +#line 16906 "" + addstr_(notexq, &i__12, soutq, &lsout, ( + ftnlen)79, (ftnlen)80); +#line 16907 "" + } else if (23 - comslur_1.ndxslur < 20) { +/* Writing concatenation */ +#line 16908 "" + i__14[0] = 1, a__8[0] = all_1.sq; +#line 16908 "" + i__14[1] = 5, a__8[1] = "islur"; +#line 16908 "" + i__14[2] = 1, a__8[2] = slurudq; +#line 16908 "" + i__14[3] = 2, a__8[3] = "{1"; +#line 16908 "" + i__12 = 61 - comslur_1.ndxslur; +#line 16908 "" + chax_(ch__6, (ftnlen)1, &i__12); +#line 16908 "" + i__14[4] = 1, a__8[4] = ch__6; +#line 16908 "" + i__14[5] = 1, a__8[5] = "}"; +#line 16908 "" + i__14[6] = lnoten, a__8[6] = noteq; +#line 16908 "" + s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); +#line 16910 "" + i__12 = lnoten + 11; +#line 16910 "" + addstr_(notexq, &i__12, soutq, &lsout, ( + ftnlen)79, (ftnlen)80); +#line 16911 "" + } else { +/* Writing concatenation */ +#line 16912 "" + i__14[0] = 1, a__8[0] = all_1.sq; +#line 16912 "" + i__14[1] = 5, a__8[1] = "islur"; +#line 16912 "" + i__14[2] = 1, a__8[2] = slurudq; +#line 16912 "" + i__14[3] = 2, a__8[3] = "{2"; +#line 16912 "" + i__12 = 51 - comslur_1.ndxslur; +#line 16912 "" + chax_(ch__6, (ftnlen)1, &i__12); +#line 16912 "" + i__14[4] = 1, a__8[4] = ch__6; +#line 16912 "" + i__14[5] = 1, a__8[5] = "}"; +#line 16912 "" + i__14[6] = lnoten, a__8[6] = noteq; +#line 16912 "" + s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79); +#line 16914 "" + i__12 = lnoten + 11; +#line 16914 "" + addstr_(notexq, &i__12, soutq, &lsout, ( + ftnlen)79, (ftnlen)80); +#line 16915 "" + } +/* call setbits(ipl(ivx,ip),4,23,ndxslur) */ +#line 16917 "" + setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25], + &c__5, &c__23, &comslur_1.ndxslur); +#line 16918 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - + 25],31)) { +#line 16918 "" + comslur_1.listslur = bit_set( + comslur_1.listslur,comslur_1.ndxslur); +#line 16918 "" + } + +/* Starting slur on W-grace on THIS note. Record ndxslur. */ + +#line 16923 "" + } +#line 16924 "" + } + +/* Process dynamic marks */ + +#line 16928 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26)) + { +#line 16929 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16929 "" + L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64; +#line 16929 "" + 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[ + commvl_1.ivx + ip * 24 - 25], &all_1.irest[ + commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[ + all_1.iv - 1], &all_1.nv, &all_1.beamon[ + 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 16933 "" + } + +/* Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. */ + +#line 16937 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) { + +/* Need a duration to set type of note head */ + +/* if (.not. vxtup(ivx)) then */ + +/* Clumsy test, but vxtup is not set until main note is processed. */ + +#line 16945 "" + if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test( + all_1.irest[commvl_1.ivx + ip * 24 - 25],28))) + { +#line 16946 "" + nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +/* else if (mult(ivx,ip) .lt. 0) then */ +#line 16948 "" + } else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & + 15) - 8 < 0) { +#line 16949 "" + nodu = 32; +#line 16950 "" + } else { +#line 16951 "" + nodu = 16; +#line 16952 "" + } +#line 16953 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16953 "" + L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - + 25],27); +#line 16953 "" + 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 + + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], + &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); +#line 16957 "" + } + +/* Now that chords are done, add stuff to midi file */ + +#line 16961 "" + if (commidi_1.ismidi) { +#line 16961 "" + i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + + commvel_1.miditran[cominsttrans_1.instno[ + all_1.iv - 1] - 1]; +#line 16961 "" + i__13 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; +#line 16961 "" + L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],0); +#line 16961 "" + 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 16961 "" + } +/* 130316 */ +/* * nolev(ivx,ip)-iTransAmt(instno(iv)), */ +/* * iand(nacc(ivx,ip),7),midisig(instno(iv)), */ + +/* Check for breath or caesura */ + +#line 16972 "" + if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28)) + { +#line 16973 "" + putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79) + ; +#line 16974 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 16975 "" + } + +/* Check for main-note ornaments. ')' on dotted notes go in with note, not here. */ +/* Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F */ +/* 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD */ + +/* isacc = iand(iornq(ivx,ip),4194287) .gt. 0 */ +/* isacc = iand(iornq(ivx,ip),541065199) .gt. 0 */ +#line 16983 "" + isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] & + 1614807023) > 0; + +/* isacc=.true. if any ornament except segno */ + +#line 16987 "" + 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 16991 "" + i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - + 25]); +#line 16991 "" + if (pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx + + ip * 24 - 25]) { +#line 16992 "" + if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & + 516079) == 0) { + +/* ). is the only non-segno ornament */ + +#line 16996 "" + isacc = FALSE_; +#line 16997 "" + } else { + +/* There are other ornaments in addition */ + +#line 17001 "" + rpndot = TRUE_; +#line 17002 "" + all_1.iornq[commvl_1.ivx + ip * 24 - 1] = + bit_clear(all_1.iornq[commvl_1.ivx + + ip * 24 - 1],13); +#line 17003 "" + } +#line 17004 "" + } +#line 17005 "" + } +#line 17006 "" + if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { + +/* Check for centered whole-bar rest with fermata (bits 10 or 14). */ + +#line 17010 "" + 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 17014 "" + comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_; +#line 17015 "" + goto L30; +#line 17016 "" + } +#line 17017 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 17017 "" + L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] + ,10); +#line 17017 "" + 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], & + all_1.nodur[commvl_1.ivx + ip * 24 - 25], + nornb, all_1.ulq, &all_1.ibmcnt[commvl_1.ivx + - 1], &commvl_1.ivx, &i__12, &all_1.islur[ + commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[ + all_1.iv - 1], &all_1.nv, ihornb, & + all_1.stemlen, notexq, &lnote, &ip, &islhgt, & + all_1.beamon[commvl_1.ivx - 1], &L__1, ( + ftnlen)1, (ftnlen)79); +#line 17022 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 17023 "" + } +#line 17024 "" + if (rpndot) { +#line 17025 "" + all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set( + all_1.iornq[commvl_1.ivx + ip * 24 - 1],13); +#line 17026 "" + rpndot = FALSE_; +#line 17027 "" + } +#line 17028 "" +L30: + +/* Check for main note accidental */ + +#line 17032 "" + 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 17034 "" + ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 + - 25], &c__7, &c__10); +#line 17035 "" + if (ihshft != 0) { +#line 17035 "" + ihshft += -107; +#line 17035 "" + } +#line 17036 "" + 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 17036 "" + ihshft += -20; +#line 17036 "" + } + +/* Not a chord, and left-shifted main note, so left-shift accid */ + +#line 17041 "" + i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 + - 25], &c__6, &c__4); +#line 17041 "" + i__13 = ncmid_(&all_1.iv, &ip); +#line 17041 "" + L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],31); +#line 17041 "" + 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 17044 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 17045 "" + } + +/* Lower dot for lower-voice notes. Conditions are: */ +/* 1. Dotted time value */ +/* 2. Lower voice of two */ +/* 3. Note is on a line */ +/* 4. Not a rest */ +/* . 5. Flag (lowdot) is set to true */ +/* 6. Not in an xtuplet */ + +#line 17055 "" + 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 17057 "" + i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - + 25]); +#line 17057 "" + 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 17060 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - + 25],19)) { + +/* Note already in movdot list. Drop by 2. */ + +#line 17064 "" + comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[ + commvl_1.ivx - 1] + 1) * 24 - 25] += + -2.f; +#line 17066 "" + } else { + +/* Not in list so just move it right now */ + +#line 17070 "" + i__12 = igetbits_(&all_1.islur[commvl_1.ivx + + ip * 24 - 25], &c__1, &c__3); +#line 17070 "" + dotmov_(&c_b761, &c_b762, soutq, &lsout, & + i__12, (ftnlen)80); +#line 17072 "" + } +#line 17073 "" + } +#line 17074 "" + } + +/* Check for dotted notes with moved dots */ + +#line 17078 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19)) + { +#line 17079 "" + ++comcc_1.ndotmv[commvl_1.ivx - 1]; +#line 17080 "" + i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 + - 25], &c__1, &c__3); +#line 17080 "" + 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 17082 "" + } + +/* Stemlength shortening? */ + +#line 17086 "" + if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27)) + { +#line 17087 "" + stemshort = 4.66f - (igetbits_(&all_1.mult[ + commvl_1.ivx + ip * 24 - 25], &c__3, &c__28) + + 1) * .667f * .5f; +/* Writing concatenation */ +#line 17088 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17088 "" + i__4[1] = 11, a__2[1] = "stemlength{"; +#line 17088 "" + s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12); +#line 17088 "" + addstr_(ch__5, &c__12, soutq, &lsout, (ftnlen)12, ( + ftnlen)80); +#line 17089 "" + s_wsfi(&io___1065); +#line 17089 "" + do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real) + ); +#line 17089 "" + e_wsfi(); +/* Writing concatenation */ +#line 17090 "" + i__4[0] = 4, a__2[0] = notexq; +#line 17090 "" + i__4[1] = 1, a__2[1] = "}"; +#line 17090 "" + s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 17090 "" + addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, ( + ftnlen)80); +#line 17091 "" + } else if (ip > 1) { +#line 17092 "" + if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24 + - 25],27)) { +/* Writing concatenation */ +#line 17092 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17092 "" + i__4[1] = 16, a__2[1] = "stemlength{4.66}"; +#line 17092 "" + s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)17); +#line 17092 "" + addstr_(ch__7, &c__17, soutq, &lsout, (ftnlen)17, + (ftnlen)80); +#line 17092 "" + } + +/* Cancel shortening. Looks like it gets automatically restored if new inst. or */ +/* new line, so no need to worry about affecting other lines */ + +#line 17098 "" + } + +/* Zero out slur-height marker for raising ornaments */ + +#line 17102 "" + islhgt = 0; + +/* Now start with spacing notes. Is a beam start pending? */ + +#line 17106 "" + 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 17108 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) { + +/* Special path for single note at end of otherwise beamed xtup */ + +#line 17112 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 17113 "" + } else { +#line 17114 "" + 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 17114 "" + 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, + &all_1.nv, &all_1.ibar, &tnow, & + comtol_1.tol, all_1.nodur, &c__2, + comkbdrests_1.levtopr, + comkbdrests_1.levbotr, all_1.mult, + all_1.ipl); +#line 17114 "" + } +/* * mult) */ +#line 17121 "" + beamn1_(notexq, &lnote, (ftnlen)79); +#line 17122 "" + } +#line 17123 "" + bspend = FALSE_; + +/* Is a beam ending? */ + +#line 17127 "" + } 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 17131 "" + if (bspend) { + +/* Must be a single-note ending of a jump-beam */ + +#line 17135 "" + bspend = FALSE_; +#line 17136 "" + } +#line 17137 "" + beamend_(notexq, &lnote, (ftnlen)79); +#line 17138 "" + if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25] + ,20)) { +#line 17139 "" + comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_; +#line 17140 "" + nornb[commvl_1.ivx - 1] = 0; +#line 17141 "" + ++all_1.ibmcnt[commvl_1.ivx - 1]; +#line 17142 "" + all_1.beamon[commvl_1.ivx - 1] = FALSE_; +#line 17143 "" + } + +/* Or if we're in the middle of a beam */ + +#line 17147 "" + } else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[ + commvl_1.ivx - 1]) { + +/* Added 130127 */ + +#line 17151 "" + 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 17151 "" + 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, & + all_1.nv, &all_1.ibar, &tnow, & + comtol_1.tol, all_1.nodur, &c__2, + comkbdrests_1.levtopr, + comkbdrests_1.levbotr, all_1.mult, + all_1.ipl); +#line 17151 "" + } +/* * mult) */ +#line 17158 "" + beamid_(notexq, &lnote, (ftnlen)79); + +/* Or whole-bar rest */ + +#line 17162 "" + } 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 && + all_1.ibar == 1 && all_1.lenb0 > 0) && ! bit_test( + all_1.irest[commvl_1.ivx + ip * 24 - 25],25) && ! + bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25], + 29)) { + +/* Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp */ + +#line 17170 "" + cwrest[commvl_1.ivx] = TRUE_; +#line 17171 "" + iscwr = TRUE_; +#line 17172 "" + notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ + commvl_1.ivx - 1], (ftnlen)79); +#line 17173 "" + tnow += all_1.lenbar; +#line 17174 "" + goto L10; +#line 17175 "" + } else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) { + +/* Before writing note or rest, check for keyboard rest height adjustment. */ +/* Conditions are 0. This is a non-blank rest */ +/* 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 17185 "" + 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 17276 "" + 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, & + all_1.nv, &all_1.ibar, &tnow, & + comtol_1.tol, all_1.nodur, &c__1, + comkbdrests_1.levtopr, + comkbdrests_1.levbotr, all_1.mult, + all_1.ipl); +/* * mult) */ +#line 17280 "" + } +/* 2 continue */ + +/* Write a separate note or rest */ + +#line 17285 "" + notex_(notexq, &lnote, (ftnlen)79); +#line 17286 "" + } + +/* Right offset? This may cause trouble */ + +#line 17290 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) { +/* Writing concatenation */ +#line 17291 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17291 "" + i__4[1] = 5, a__2[1] = "loff{"; +#line 17291 "" + s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 17291 "" + addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( + ftnlen)80); +#line 17292 "" + } else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25] + ,9)) { +/* Writing concatenation */ +#line 17293 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17293 "" + i__4[1] = 5, a__2[1] = "roff{"; +#line 17293 "" + s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6); +#line 17293 "" + addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, ( + ftnlen)80); +#line 17294 "" + } +#line 17295 "" + if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0) + { +#line 17295 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 17295 "" + } +#line 17297 "" + 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 17297 "" + addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen) + 80); +#line 17297 "" + } + +/* Terminate user-defined offsets. Fix format */ + +#line 17302 "" + 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 17302 "" + putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, ( + ftnlen)80); +#line 17302 "" + } + +/* Deal with After- and Way-after-graces. First, if end of bar, compute space */ +/* needed since it wasn't done during general ask-checks. If extra space is */ +/* 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 17310 "" + 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 17312 "" + i__12 = comgrace_1.ngrace; +#line 17312 "" + for (ig = 1; ig <= i__12; ++ig) { +#line 17313 "" + if (comgrace_1.ipg[ig - 1] == ip && + comgrace_1.ivg[ig - 1] == commvl_1.ivx) { +#line 17313 "" + goto L78; +#line 17313 "" + } +#line 17314 "" +/* L77: */ +#line 17314 "" + } +#line 17315 "" + s_wsle(&io___1068); +#line 17315 "" + do_lio(&c__9, &c__1, "Problem finding grace index "\ + "at \"do 77\"", (ftnlen)38); +#line 17315 "" + e_wsle(); +#line 17316 "" + stop1_(); +#line 17317 "" +L78: + +/* Get elemskip to end of bar. WON'T WORK IF XTUPS !! */ + +#line 17321 "" + esk = 0.f; +#line 17322 "" + i__12 = comnsp_2.nb; +#line 17322 "" + for (iib = ib; iib <= i__12; ++iib) { +#line 17323 "" + if (iib == ib) { +#line 17324 "" + itleft = i_nint(&all_1.to[comipl2_1.ipl2[ + commvl_1.ivx + ip * 24 - 25] - 1]); +#line 17325 "" + } else { +#line 17326 "" + itleft = i_nint(&tstart[ib]); +#line 17327 "" + } +#line 17328 "" + if (iib < comnsp_2.nb) { +#line 17329 "" + itright = i_nint(&tstart[iib + 1]); +#line 17330 "" + } else { +#line 17331 "" + itright = all_1.lenbar; +#line 17332 "" + } +#line 17333 "" + esk += feon_(&comnsp_2.space[ib - 1]) * (itright + - itleft) / comnsp_2.space[ib - 1]; +#line 17335 "" +/* L40: */ +#line 17335 "" + } +#line 17336 "" + ptsavail = comask_1.poenom * esk - comask_1.wheadpt; +#line 17337 "" + if (comgrace_1.nng[ig - 1] == 1) { +#line 17338 "" + wgr = spfacs_1.grafac; +#line 17339 "" + } else { +#line 17340 "" + wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac; +#line 17341 "" + i__12 = comgrace_1.nng[ig - 1]; +#line 17341 "" + for (ing = 1; ing <= i__12; ++ing) { +#line 17342 "" + if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] + - 1 + ing - 1] > 0) { +#line 17342 "" + wgr += spfacs_1.acgfac; +#line 17342 "" + } +#line 17343 "" +/* L41: */ +#line 17343 "" + } +#line 17344 "" + } +#line 17345 "" + ptgr[ig - 1] = wgr * comask_1.wheadpt; +#line 17346 "" + ptsneed = (wgr + .5f) * comask_1.wheadpt; +#line 17347 "" + ptsndg[commvl_1.ivx - 1] = 0.f; +#line 17348 "" + if (ptsavail < ptsneed) { +#line 17349 "" + ptsndg[commvl_1.ivx - 1] = ptsneed; +#line 17350 "" + eskndg[commvl_1.ivx - 1] = esk; +#line 17351 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - + 25],31)) { + +/* Convert GW to GA */ + +#line 17355 "" + 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 17356 "" + } +#line 17357 "" + } +#line 17358 "" + } + +/* Check for GA */ + +#line 17362 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) { +#line 17362 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 17362 "" + 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_b762, all_1.ulq, & + cominsttrans_1.instno[all_1.iv - 1], (ftnlen) + 80, (ftnlen)1); +#line 17362 "" + } +/* 130324 */ +/* * .false.,0,0,0,0,0,0,0.,ulq) */ + +/* Update running time */ + +#line 17371 "" + tnow += comnsp_2.space[ib - 1]; +#line 17372 "" +L10: +#line 17372 "" + ; +#line 17372 "" + } + +/* Have finished last note in this voice and block */ + +#line 17376 "" + r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1]; +#line 17376 "" + itendb = i_nint(&r__1); +#line 17377 "" + if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx == + comfig_1.ivxfig2) { +#line 17378 "" + ivf = 1; +#line 17379 "" + if (commvl_1.ivx > 1) { +#line 17379 "" + ivf = 2; +#line 17379 "" + } +#line 17380 "" +L17: +#line 17380 "" + 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 17384 "" + offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1] + << 1) - 3]) / comnsp_2.space[ib - 1]; +#line 17385 "" + putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[ + ivf - 1], soutq, &lsout, (ftnlen)80); +#line 17386 "" + goto L17; +#line 17387 "" + } +#line 17388 "" + } + +/* Check for flag, dot, or upstem on last note of bar. */ + +#line 17392 "" + if (ib == comnsp_2.nb) { +#line 17393 "" + ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[ + commvl_1.ivx - 1] * 24 - 25] - 1]; +#line 17394 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f; +#line 17395 "" + 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 17396 "" + if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) { + +/* Note in last space, smaller than a quarter note. */ + +#line 17400 "" + i__10 = ncmid_(&all_1.iv, &ip); +#line 17400 "" + 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 17400 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 + - 25],0) && *(unsigned char *)&ch__6[0] == + 'u' || isdotted_(all_1.nodur, & + commvl_1.ivx, &ip)) { + +/* Upstem non-rest, or dotted */ + +/* Computing MAX */ +#line 17407 "" + i__10 = 1, i__12 = numbms[commvl_1.ivx]; +#line 17407 "" + if (numbms[commvl_1.ivx] > 0 && ip == + all_1.ibm2[commvl_1.ivx + max(i__10, + i__12) * 24 - 25] && ! isdotted_( + all_1.nodur, &commvl_1.ivx, &ip)) { + +/* In beam and not dotted, so use smaller space */ + +#line 17414 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = + spfacs_1.upstmfac; +#line 17415 "" + } else { +#line 17416 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = + spfacs_1.flagfac; +#line 17417 "" + } +#line 17418 "" + } +#line 17419 "" + } else { + +/* Last space, nonflagged (no beam) only worry dot or up */ + +#line 17423 "" + if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) { +#line 17424 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = + spfacs_1.flagfac; +#line 17425 "" + } else /* if(complicated condition) */ { +#line 17425 "" + i__10 = ncmid_(&all_1.iv, &ip); +#line 17425 "" + 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 17425 "" + 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 17431 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = + spfacs_1.upstmfac; +#line 17432 "" + } +#line 17432 "" + } +#line 17433 "" + } +#line 17434 "" + } + +/* Check for right-shifted chordal note */ + +#line 17438 "" + if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20)) + { +#line 17438 "" + comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac; +#line 17438 "" + } +#line 17439 "" + comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[ + commvl_1.ivx - 1] > 0.f; +#line 17440 "" + if (commidi_1.ismidi) { + +/* For midi, set flags for accidentals on last note of bar. Assume they affect */ +/* first note of next bar whether or not tied. */ +/* Note has already been done, so next entry into addmidi is 1st in new bar. */ +/* First do main note, then chord notes */ + +/* Gyrations needed to account for multi-bar tied full-bar notes? */ +/* 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 17451 "" + if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0) + { + +/* Explicit accidental on last main note in bar */ + +#line 17455 "" + i__10 = comslm_1.naccbl[icm]; +#line 17455 "" + for (kacc = 1; kacc <= i__10; ++kacc) { +#line 17456 "" + if (comslm_1.laccbl[icm + kacc * 25 - 25] == + all_1.nolev[commvl_1.ivx + ip * 24 - + 25]) { +#line 17456 "" + goto L56; +#line 17456 "" + } +#line 17457 "" +/* L55: */ +#line 17457 "" + } +#line 17458 "" + ++comslm_1.naccbl[icm]; +#line 17459 "" + comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - + 25] = all_1.nolev[commvl_1.ivx + ip * 24 + - 25]; +#line 17460 "" + i__10 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & + 7; +#line 17460 "" + comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - + 25] = iashft_(&i__10); +#line 17461 "" + } +#line 17462 "" +L56: +#line 17463 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25], + 10) && commidi_1.crdacc) { +#line 17464 "" + i__10 = comtrill_1.icrd2; +#line 17464 "" + for (icrd = comtrill_1.icrd1; icrd <= i__10; + ++icrd) { +#line 17465 "" + iacc = igetbits_(&comtrill_1.icrdat[icrd - 1], + &c__3, &c__20); +#line 17466 "" + if (iacc > 0) { + +/* Explicit accidental on chord note at end of bar */ + +#line 17470 "" + nolevc = igetbits_(&comtrill_1.icrdat[ + icrd - 1], &c__7, &c__12); +#line 17471 "" + i__12 = comslm_1.naccbl[icm]; +#line 17471 "" + for (kacc = 1; kacc <= i__12; ++kacc) { +#line 17472 "" + if (comslm_1.laccbl[icm + kacc * 25 - + 25] == nolevc) { +#line 17472 "" + goto L59; +#line 17472 "" + } +#line 17473 "" +/* L58: */ +#line 17473 "" + } +#line 17474 "" + ++comslm_1.naccbl[icm]; +#line 17475 "" + comslm_1.laccbl[icm + comslm_1.naccbl[icm] + * 25 - 25] = nolevc; +#line 17476 "" + comslm_1.jaccbl[icm + comslm_1.naccbl[icm] + * 25 - 25] = iashft_(&iacc); +#line 17477 "" + } +#line 17478 "" +L59: +#line 17479 "" +/* L57: */ +#line 17479 "" + ; +#line 17479 "" + } +#line 17480 "" + } +/* if (lbacc(icm).eq.0 .and. accb4(icm)) then */ +#line 17482 "" + i__10 = commidi_1.naccim[icm]; +#line 17482 "" + for (kacc = 1; kacc <= i__10; ++kacc) { + +/* If naccim(icm)>0, */ +/* possible implicit accidental from earlier in the bar. Check for prior accid */ +/* in this bar at relevant note levels, main and chord notes. Only act if no */ +/* 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 17490 "" + if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] == + commidi_1.laccim[icm + kacc * 25 - 25]) { +#line 17490 "" + goto L66; +#line 17490 "" + } +#line 17491 "" + if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - + 25],10)) { +#line 17492 "" + i__12 = comtrill_1.icrd2; +#line 17492 "" + for (icrd = comtrill_1.icrd1; icrd <= i__12; + ++icrd) { +#line 17493 "" + if ((lbit_shift(comtrill_1.icrdat[icrd - + 1], (ftnlen)-12) & 127) == + commidi_1.laccim[icm + kacc * 25 + - 25]) { +#line 17493 "" + goto L66; +#line 17493 "" + } +#line 17495 "" +/* L67: */ +#line 17495 "" + } +#line 17496 "" + } +#line 17497 "" + goto L65; +#line 17498 "" +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 17503 "" + i__12 = comslm_1.naccbl[icm]; +#line 17503 "" + for (macc = 1; macc <= i__12; ++macc) { +#line 17504 "" + if (comslm_1.laccbl[icm + macc * 25 - 25] == + commidi_1.laccim[icm + kacc * 25 - 25] + ) { +#line 17504 "" + goto L65; +#line 17504 "" + } +#line 17505 "" +/* L68: */ +#line 17505 "" + } +#line 17506 "" + ++comslm_1.naccbl[icm]; +#line 17507 "" + comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 - + 25] = commidi_1.laccim[icm + kacc * 25 - + 25]; +#line 17508 "" + comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 - + 25] = commidi_1.jaccim[icm + kacc * 25 - + 25]; +#line 17509 "" +L65: +#line 17509 "" + ; +#line 17509 "" + } +#line 17510 "" + } +#line 17511 "" + } +#line 17512 "" +/* L11: */ +#line 17512 "" + } +#line 17512 "" + } + +/* Close out the notes group */ + +/* Writing concatenation */ +#line 17516 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17516 "" + i__4[1] = 2, a__2[1] = "en"; +#line 17516 "" + s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3); +#line 17516 "" + addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80); +#line 17517 "" + if (comlast_1.islast && lsout > 0) { +#line 17517 "" + s_wsfe(&io___1081); +/* Writing concatenation */ +#line 17517 "" + i__4[0] = lsout, a__2[0] = soutq; +#line 17517 "" + i__4[1] = 1, a__2[1] = "%"; +#line 17517 "" + s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81); +#line 17517 "" + do_fio(&c__1, ch__12, lsout + 1); +#line 17517 "" + e_wsfe(); +#line 17517 "" + } +#line 17518 "" +/* L16: */ +#line 17518 "" + } + +/* 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 17524 "" + isgrace = FALSE_; +#line 17525 "" + i__2 = all_1.nv; +#line 17525 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 17526 "" + comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1]; +#line 17527 "" + i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 17527 "" + for (kv = 1; kv <= i__7; ++kv) { +#line 17528 "" + comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[ + all_1.iv + kv * 24 - 25]; +#line 17529 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 17530 "" + comnsp_2.ptsgnd = 0.f; +#line 17531 "" + 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 17533 "" + comnsp_2.flgndb = TRUE_; +#line 17534 "" + if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) { +#line 17535 "" + comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1]; +#line 17536 "" + comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1]; +#line 17537 "" + } +#line 17538 "" + } +#line 17539 "" + 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 17543 "" + if (! isgrace) { + +/* This is the first one, so set up the string */ + +#line 17547 "" + isgrace = TRUE_; +#line 17548 "" + ivlast = 1; +/* Writing concatenation */ +#line 17549 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17549 "" + i__4[1] = 6, a__2[1] = "znotes"; +#line 17549 "" + s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80); +#line 17550 "" + lsout = 7; +#line 17551 "" + } +#line 17552 "" + i__1 = all_1.iv - 1; +#line 17552 "" + for (iiv = ivlast; iiv <= i__1; ++iiv) { +#line 17553 "" + addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, ( + ftnlen)1, (ftnlen)80); +#line 17554 "" +/* L76: */ +#line 17554 "" + } +#line 17555 "" + ivlast = all_1.iv; + +/* No need to put in 'nextvoice', even if 2 lines/staff */ + +#line 17559 "" + i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]); +#line 17559 "" + 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_b762, 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 17564 "" + } +#line 17565 "" +/* L75: */ +#line 17565 "" + } +#line 17565 "" + } +#line 17566 "" + if (isgrace) { +/* Writing concatenation */ +#line 17567 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17567 "" + i__4[1] = 3, a__2[1] = "en%"; +#line 17567 "" + s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)4); +#line 17567 "" + addstr_(ch__19, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80); +#line 17568 "" + if (comlast_1.islast && lsout > 0) { +#line 17568 "" + s_wsfe(&io___1084); +#line 17568 "" + do_fio(&c__1, soutq, lsout); +#line 17568 "" + e_wsfe(); +#line 17568 "" + } +#line 17569 "" + } +#line 17570 "" + lsout = 0; + +/* Write multibar rest. Assuming nv = 1 and do not worry about cwbrest */ +/* This has to be the only use of atnextbar */ + +#line 17575 "" + if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) { +/* Writing concatenation */ +#line 17576 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 17576 "" + i__3[1] = 3, a__1[1] = "def"; +#line 17576 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 17576 "" + i__3[3] = 10, a__1[3] = "atnextbar{"; +#line 17576 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 17576 "" + i__3[5] = 6, a__1[5] = "znotes"; +#line 17576 "" + s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80); +#line 17577 "" + lsout = 22; +/* Writing concatenation */ +#line 17578 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17578 "" + i__4[1] = 6, a__2[1] = "mbrest"; +#line 17578 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17579 "" + lnote = 7; +#line 17580 "" + istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8); +/* Writing concatenation */ +#line 17581 "" + i__4[0] = lnote, a__2[0] = notexq; +#line 17581 "" + i__4[1] = len, a__2[1] = noteq; +#line 17581 "" + s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 17582 "" + lnote += len; +#line 17583 "" + mtrspc = i_nint(&comgrace_1.xb4mbr); +#line 17584 "" + comgrace_1.xb4mbr = 0.f; +#line 17585 "" + istring_(&mtrspc, noteq, &len, (ftnlen)8); +/* Writing concatenation */ +#line 17586 "" + i__6[0] = lnote, a__4[0] = notexq; +#line 17586 "" + i__6[1] = len, a__4[1] = noteq; +#line 17586 "" + i__6[2] = 1, a__4[2] = "0"; +#line 17586 "" + s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79); +#line 17587 "" + lnote = lnote + len + 1; +#line 17588 "" + i__7 = all_1.nv; +#line 17588 "" + for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 17589 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80); +#line 17590 "" + if (all_1.iv < all_1.nv) { +#line 17590 "" + addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, + (ftnlen)1, (ftnlen)80); +#line 17590 "" + } +#line 17591 "" +/* L62: */ +#line 17591 "" + } +/* Writing concatenation */ +#line 17592 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17592 "" + i__4[1] = 4, a__2[1] = "en}%"; +#line 17592 "" + s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 17592 "" + addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); +#line 17593 "" + s_wsfe(&io___1087); +#line 17593 "" + do_fio(&c__1, soutq, lsout); +#line 17593 "" + e_wsfe(); +#line 17594 "" + lsout = 0; +#line 17595 "" + if (comgrace_1.mbrest > 1) { +#line 17596 "" + r__1 = comgrace_1.mbrest - 1 + .01f; +#line 17596 "" + ndig = (integer) r_lg10(&r__1) + 1; +#line 17597 "" + ci__1.cierr = 0; +#line 17597 "" + ci__1.ciunit = 11; +/* Writing concatenation */ +#line 17597 "" + i__6[0] = 6, a__4[0] = "(a14,i"; +#line 17597 "" + i__7 = ndig + 48; +#line 17597 "" + chax_(ch__6, (ftnlen)1, &i__7); +#line 17597 "" + i__6[1] = 1, a__4[1] = ch__6; +#line 17597 "" + i__6[2] = 4, a__4[2] = ",a1)"; +#line 17597 "" + ci__1.cifmt = (s_cat(ch__9, a__4, i__6, &c__3, (ftnlen)11), ch__9) + ; +#line 17597 "" + s_wsfe(&ci__1); +/* Writing concatenation */ +#line 17597 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 17597 "" + i__9[1] = 7, a__6[1] = "advance"; +#line 17597 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 17597 "" + i__9[3] = 5, a__6[3] = "barno"; +#line 17597 "" + s_cat(ch__4, a__6, i__9, &c__4, (ftnlen)14); +#line 17597 "" + do_fio(&c__1, ch__4, (ftnlen)14); +#line 17597 "" + i__2 = comgrace_1.mbrest - 1; +#line 17597 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 17597 "" + do_fio(&c__1, "%", (ftnlen)1); +#line 17597 "" + e_wsfe(); +#line 17599 "" + } +#line 17600 "" + } 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 17605 "" + comclefrests_1.centrests = TRUE_; +/* Writing concatenation */ +#line 17606 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 17606 "" + i__9[1] = 3, a__6[1] = "def"; +#line 17606 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 17606 "" + i__9[3] = 8, a__6[3] = "value{0}"; +#line 17606 "" + s_cat(ch__20, a__6, i__9, &c__4, (ftnlen)13); +#line 17606 "" + addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, (ftnlen)80); +/* Writing concatenation */ +#line 17607 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 17607 "" + i__3[1] = 3, a__1[1] = "def"; +#line 17607 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 17607 "" + i__3[3] = 10, a__1[3] = "atnextbar{"; +#line 17607 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 17607 "" + i__3[5] = 6, a__1[5] = "znotes"; +#line 17607 "" + s_cat(ch__21, a__1, i__3, &c__6, (ftnlen)22); +#line 17607 "" + addstr_(ch__21, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80); +#line 17609 "" + i__7 = all_1.nv; +#line 17609 "" + for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +/* added */ +#line 17611 "" + lnote = 0; + +#line 17613 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 17613 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 17614 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 17615 "" + if (cwrest[commvl_1.ivx]) { +/* Writing concatenation */ +#line 17616 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17616 "" + i__4[1] = 10, a__2[1] = "CenterBar{"; +#line 17616 "" + s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11); +#line 17616 "" + addstr_(ch__9, &c__11, soutq, &lsout, (ftnlen)11, (ftnlen) + 80); +#line 17617 "" + if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) { +#line 17618 "" + 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 17622 "" + 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 17622 "" + *(unsigned char *)&cwrq[(commvl_1.ivx - 1) * + 79 + 9] = 'c'; +#line 17622 "" + } +#line 17625 "" + } +#line 17626 "" + addstr_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[ + commvl_1.ivx - 1], soutq, &lsout, lcwr[ + commvl_1.ivx - 1], (ftnlen)80); +/* Writing concatenation */ +#line 17628 "" + i__6[0] = 6, a__4[0] = "}{-2}{"; +#line 17628 "" + i__6[1] = 1, a__4[1] = all_1.sq; +#line 17628 "" + i__6[2] = 6, a__4[2] = "value}"; +#line 17628 "" + s_cat(ch__20, a__4, i__6, &c__3, (ftnlen)13); +#line 17628 "" + addstr_(ch__20, &c__13, soutq, &lsout, (ftnlen)13, ( + ftnlen)80); +#line 17629 "" + } 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 17634 "" + i__15[0] = lnote, a__9[0] = notexq; +#line 17634 "" + i__15[1] = 1, a__9[1] = all_1.sq; +#line 17634 "" + i__15[2] = 13, a__9[2] = "loffset{.33}{"; +#line 17634 "" + i__15[3] = 1, a__9[3] = all_1.sq; +#line 17634 "" + i__15[4] = 11, a__9[4] = "fermataup7}"; +#line 17634 "" + i__15[5] = lcwr[commvl_1.ivx - 1], a__9[5] = cwrq + ( + commvl_1.ivx - 1) * 79; +#line 17634 "" + i__15[6] = 6, a__9[6] = "}{-2}{"; +#line 17634 "" + i__15[7] = 1, a__9[7] = all_1.sq; +#line 17634 "" + i__15[8] = 6, a__9[8] = "value}"; +#line 17634 "" + s_cat(notexq, a__9, i__15, &c__9, (ftnlen)79); +#line 17637 "" + lnote = lnote + 26 + lcwr[commvl_1.ivx - 1] + 13; +#line 17638 "" + addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, ( + ftnlen)80); +#line 17639 "" + comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_; +#line 17640 "" + } +#line 17641 "" + } +#line 17642 "" +/* L61: */ +#line 17642 "" + } +#line 17643 "" + if (all_1.iv != all_1.nv) { +#line 17643 "" + addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout, + (ftnlen)1, (ftnlen)80); +#line 17643 "" + } +#line 17644 "" +/* L60: */ +#line 17644 "" + } +#line 17645 "" + if (comlast_1.islast) { +/* Writing concatenation */ +#line 17646 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 17646 "" + i__4[1] = 4, a__2[1] = "en}%"; +#line 17646 "" + s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)5); +#line 17646 "" + addstr_(ch__18, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); +#line 17647 "" + if (lsout > 0) { +#line 17647 "" + s_wsfe(&io___1089); +#line 17647 "" + do_fio(&c__1, soutq, lsout); +#line 17647 "" + e_wsfe(); +#line 17647 "" + } +#line 17648 "" + } +#line 17649 "" + } + +/* End of block for centered whole-bar rests and multi-bar rests */ + +/* If at end of block, save durations of last notes in bar, for possible use */ +/* if clef changes at start of next bar */ + +#line 17656 "" + if (all_1.ibar == all_1.nbars) { +#line 17657 "" + i__7 = all_1.nv; +#line 17657 "" + for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 17658 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 17658 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 17659 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 17660 "" + 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 17661 "" +/* L63: */ +#line 17661 "" + } +#line 17661 "" + } +#line 17662 "" + } + +/* Update time for midi. This is only used for the event track */ + +#line 17666 "" + if (commidi_1.ismidi) { +#line 17667 "" + 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 17672 "" + if (all_1.lenb0 == all_1.lenbar) { +#line 17672 "" + i__2 = all_1.mtrdenl * all_1.lenb1 / 64; +#line 17672 "" + midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1); +#line 17672 "" + } +#line 17674 "" + } +#line 17675 "" + return 0; +} /* make2bar_ */ + +/* Subroutine */ int makeabar_(void) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1, r__2, r__3; + + /* Builtin functions */ + integer i_nint(real *); + + /* Local variables */ + extern /* Subroutine */ int catspace_(real *, real *, integer *); + static real elsperns; + extern doublereal getsquez_(integer *, integer *, real *, real *, real *); + static integer ib, in, kv, cnn[24]; + static real xit[24]; + static integer ilnc; + static real tmin; + static integer nnsk, ntot; + extern doublereal f1eon_(real *); + extern /* Subroutine */ int stop1_(void); + static real space[80]; + extern doublereal fnote_(integer *, integer *, integer *, integer *); + static real tminn, tnote[600]; + static integer istop[80]; + static real squez[80]; + static integer istart[80]; + extern /* Subroutine */ int printl_(char *, ftnlen); + static integer ivnext; + static real tstart[80], xsquez; + + +/* On input, have pseudo-durations in nodur(ivx,ip). Not real durations for */ +/* xtups, since only last note of xtup gets non-zero nodur, which */ +/* corresponds to single note of full length of xtup. */ +/* In this subroutine we make an ordered list of all notes in all voices. */ +/* ilnc = list note counter */ +/* ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note. */ +/* to(ilnc) = real start time of note in PMX-units (64=whole note) */ +/* tno(ilnc) = time to next event in the bar. */ +/* tnote(ilnc) = actual duration of note */ +/* Then run thru list, grouping consecutive notes into \notes groups ib. */ +/* space(ib) = real time unit for the \notes group */ +/* squez(ib) = factor on space to get effective space. This will be 1 if */ +/* there is a note exactly spanning each interval of space, and */ +/* <1 if not. */ +/* Details: let eon = elemskips per noteskip (like length). Basic formula is */ +/* eon = sqrt(space/2.) */ +/* If tgovern >= space, then */ +/* eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern). */ +/* Time needed to give this eon using basic formula is */ +/* teq = space**2/tgovern */ +/* Factor on space to get teq is */ +/* squez(ib) = space/tgovern */ +/* The eon for each ib can then be computed based on time of space*squez. */ +/* Iff squez = 1, there is a note spanning every increment in the \notes group. */ + +/* tnminb = minimum time span in the bar for increments spanned by notes, */ +/* i.e., with squez=1. Use after parsing into line to decide if */ +/* spacing needs to be "flattened" among notes groups. */ + +/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +/* logical rest,firstline,newmeter,gotclef */ +#line 17724 "" + linecom_1.elskb = 0.f; +#line 17725 "" + linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f; +#line 17726 "" + i__1 = a1ll_2.nv; +#line 17726 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 17727 "" + i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 17727 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 17728 "" + c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 17729 "" + if (a1ll_2.ibar > 1) { +#line 17730 "" + 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 17731 "" + } else { +#line 17732 "" + a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx + + a1ll_2.ibar * 24 - 25]; +#line 17733 "" + } +#line 17734 "" +/* L1: */ +#line 17734 "" + } +#line 17734 "" + } + +/* initialize list note counter, time(iv), curr. note(iv) */ + +#line 17738 "" + ilnc = 1; +#line 17739 "" + i__2 = a1ll_2.nv; +#line 17739 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { +#line 17740 "" + i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 17740 "" + for (kv = 1; kv <= i__1; ++kv) { +#line 17741 "" + c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 17742 "" + cnn[c1ommvl_1.ivx - 1] = 1; +#line 17743 "" + a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx; +#line 17744 "" + a1ll_2.ipo[ilnc - 1] = 1; +#line 17745 "" + a1ll_2.to[ilnc - 1] = 0.f; +#line 17746 "" + tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1, + c1ommvl_1.nacc); +#line 17747 "" + xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1]; +#line 17748 "" + if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) < + comtol_1.tol) { +#line 17748 "" + xit[c1ommvl_1.ivx - 1] = 1e3f; +#line 17748 "" + } +#line 17749 "" + ++ilnc; +#line 17750 "" +/* L4: */ +#line 17750 "" + } +#line 17750 "" + } + +/* Build the list */ + +#line 17754 "" +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 17759 "" + tmin = 1e3f; +#line 17760 "" + i__1 = a1ll_2.nv; +#line 17760 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 17761 "" + i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 17761 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 17762 "" + c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +/* Computing MIN */ +#line 17763 "" + r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1]; +#line 17763 "" + tminn = dmin(r__1,r__2); +#line 17764 "" + if (tminn < tmin) { +#line 17765 "" + tmin = tminn; +#line 17766 "" + ivnext = c1ommvl_1.ivx; +#line 17767 "" + } +#line 17768 "" +/* L6: */ +#line 17768 "" + } +#line 17768 "" + } +#line 17769 "" + if (tmin > 999.f) { +#line 17769 "" + goto L7; +#line 17769 "" + } +#line 17770 "" + a1ll_2.ivxo[ilnc - 1] = ivnext; +#line 17771 "" + ++cnn[ivnext - 1]; +#line 17772 "" + a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1]; +#line 17773 "" + a1ll_2.to[ilnc - 1] = tmin; + +/* Check if this voice is done */ + +#line 17777 "" + tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1], + c1ommvl_1.nacc); +#line 17778 "" + if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) { +#line 17779 "" + xit[ivnext - 1] = 1e3f; +#line 17780 "" + } else { +#line 17781 "" + xit[ivnext - 1] += tnote[ilnc - 1]; +#line 17782 "" + } +#line 17783 "" + ++ilnc; +#line 17784 "" + goto L5; +#line 17785 "" +L7: +#line 17786 "" + ntot = ilnc - 1; +#line 17787 "" + if (ntot > 600) { +#line 17788 "" + printl_(" ", (ftnlen)1); +#line 17789 "" + printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen) + 49); +#line 17790 "" + stop1_(); +#line 17791 "" + } +#line 17792 "" + i__2 = ntot - 1; +#line 17792 "" + for (in = 1; in <= i__2; ++in) { +#line 17793 "" + a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1]; +#line 17794 "" +/* L8: */ +#line 17794 "" + } +#line 17795 "" + a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], & + a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc); +#line 17796 "" + tnote[ntot - 1] = a1ll_2.tno[ntot - 1]; + +/* Debug writes */ + +/* write(*,'()') */ +/* write(*,'(16i5)')(ivxo(in),in=1,ntot) */ +/* write(*,'(16i5)')(ipo(in),in=1,ntot) */ +/* write(*,'(16f5.1)')(to(in),in=1,ntot) */ +/* write(*,'(16f5.1)')(tno(in),in=1,ntot) */ +/* write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot) */ +/* write(*,'(16f5.1)')(tnote(in),in=1,ntot) */ + +/* Done w/ list. Initialize loop for building note blocks: */ + +#line 17810 "" + ib = 1; +#line 17811 "" + istart[0] = 1; +#line 17812 "" + space[0] = 0.f; +#line 17813 "" + in = 1; + +/* Start the loop */ + +#line 17817 "" +L9: +#line 17818 "" + if (in == ntot) { +#line 17819 "" + if (space[ib - 1] < comtol_1.tol) { +#line 17820 "" + space[ib - 1] = a1ll_2.tno[in - 1]; + +/* Last gap in bar is spanned by a note, so cannot need a squeeze. */ + +#line 17824 "" + squez[ib - 1] = 1.f; +#line 17825 "" + } +#line 17826 "" + istop[ib - 1] = ntot; + +/* From here flow out of this if block and into block-setup */ + +#line 17830 "" + } else if (space[ib - 1] < comtol_1.tol) { + +/* space hasn't been set yet, so tentatively set: */ + +#line 17834 "" + space[ib - 1] = a1ll_2.tno[in - 1]; +#line 17835 "" + if (space[ib - 1] < comtol_1.tol) { +#line 17836 "" + ++in; +#line 17837 "" + } 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 17842 "" + squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, + a1ll_2.to); +#line 17843 "" + istop[ib - 1] = in; +#line 17844 "" + } +#line 17845 "" + goto L9; +#line 17846 "" + } else if (a1ll_2.tno[in] < comtol_1.tol) { + +/* This is not the last note in the space, so */ + +#line 17850 "" + ++in; +#line 17851 "" + goto L9; +#line 17852 "" + } 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 17856 "" + i__2 = in + 1; +#line 17856 "" + xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to); + +/* If it does have the same squez, loop, otherwise flow out */ + +#line 17860 "" + if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) { + +/* Keep spacing the same, update tentative stop point */ + +#line 17864 "" + ++in; +#line 17865 "" + istop[ib - 1] = in; +#line 17866 "" + goto L9; +#line 17867 "" + } +#line 17868 "" + } + +/* At this point istart, istop, space, and squez are good, so close out block */ + +#line 17872 "" + 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 17878 "" + r__1 = space[ib - 1] * squez[ib - 1]; +#line 17878 "" + elsperns = f1eon_(&r__1); +#line 17879 "" + if (istop[ib - 1] == ntot) { +#line 17880 "" + r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1]; +#line 17880 "" + nnsk = i_nint(&r__1); +#line 17881 "" + } else { +#line 17882 "" + r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1]; +#line 17882 "" + nnsk = i_nint(&r__1); +#line 17883 "" + } +#line 17884 "" + linecom_1.elskb += elsperns * nnsk; +#line 17885 "" + if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[ + c1omnotes_1.ibarcnt - 1]) { +#line 17886 "" + catspace_(&space[ib - 1], &squez[ib - 1], &nnsk); +#line 17887 "" + } else { + +/* This is the first entry for this bar */ + +#line 17891 "" + c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = + nnsk; +#line 17892 "" + c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = + space[ib - 1]; +#line 17893 "" + c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] = + squez[ib - 1]; +#line 17894 "" + ++c1omnotes_1.nptr[c1omnotes_1.ibarcnt]; +#line 17895 "" + } + +/* Update minimum space spanned by a note */ + +#line 17899 "" + if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) { +/* Computing MIN */ +#line 17899 "" + r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1] + ; +#line 17899 "" + linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3); +#line 17899 "" + } +#line 17901 "" + if (istop[ib - 1] == ntot) { +#line 17901 "" + goto L15; +#line 17901 "" + } + +/* End of spatial accounting for now */ + +#line 17905 "" + ++ib; +#line 17906 "" + istart[ib - 1] = istop[ib - 2] + 1; +#line 17907 "" + in = istart[ib - 1]; + +/* Set tentative block space for new block */ + +#line 17911 "" + space[ib - 1] = a1ll_2.tno[in - 1]; +#line 17912 "" + if (space[ib - 1] > comtol_1.tol) { +#line 17912 "" + squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote, + a1ll_2.to); +#line 17912 "" + } +#line 17914 "" + istop[ib - 1] = in; +#line 17915 "" + goto L9; +#line 17916 "" +L15: +/* nb = ib */ + +/* Debug writes */ + +/* 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) */ + +#line 17926 "" + return 0; +} /* makeabar_ */ + +/* Subroutine */ int midievent_(char *typeq, integer *in1, integer *in2, + ftnlen typeq_len) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Builtin functions */ + integer lbit_shift(integer, integer), i_nint(real *), s_wsle(cilist *), + do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); + + /* Local variables */ + static integer i__; + extern integer isetvarlen_(integer *, integer *), log2_(integer *); + static integer idur; + extern /* Subroutine */ int stop1_(void); + static integer nbytes, misperq; + + /* Fortran I/O blocks */ + static cilist io___1113 = { 0, 6, 0, 0, 0 }; + + + +/* We now store "conductor" events in mmidi(numchan,.), and count bytes */ +/* with imidi(numchan) */ + +#line 17945 "" + i__1 = comevent_1.miditime - comevent_1.lasttime; +#line 17945 "" + idur = isetvarlen_(&i__1, &nbytes); +#line 17946 "" + commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] + + nbytes + 1; +#line 17947 "" + i__1 = nbytes; +#line 17947 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 17948 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256) + ; +#line 17949 "" + idur = lbit_shift(idur, (ftnlen)-8); +#line 17950 "" +/* L1: */ +#line 17950 "" + } +#line 17951 "" + commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] * + 25 - 25] = 255; +#line 17952 "" + if (*(unsigned char *)typeq == 't') { + +/* Tempo event. in1 = quarters per minute (integer) */ + +#line 17956 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 1) * 25 - 25] = 81; +#line 17957 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 2) * 25 - 25] = 3; +#line 17958 "" + r__1 = 6e7f / *in1; +#line 17958 "" + misperq = i_nint(&r__1); +#line 17959 "" + for (i__ = 1; i__ <= 3; ++i__) { +#line 17960 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) ( + misperq % 256); +#line 17961 "" + misperq = lbit_shift(misperq, (ftnlen)-8); +#line 17962 "" +/* L2: */ +#line 17962 "" + } +#line 17963 "" + commidi_1.imidi[commidi_1.numchan] += 5; +#line 17964 "" + } else if (*(unsigned char *)typeq == 'm') { + +/* Meter event. in1=numerator, in2=denom (power of 2) */ + +#line 17968 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 1) * 25 - 25] = 88; +#line 17969 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 2) * 25 - 25] = 4; +#line 17970 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1); +#line 17971 "" + if (*in2 > 0) { +#line 17972 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2) + ; +#line 17973 "" + } else { +#line 17974 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 4) * 25 - 25] = 0; +#line 17975 "" + } +#line 17976 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 5) * 25 - 25] = 24; +#line 17977 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 6) * 25 - 25] = 8; +#line 17978 "" + commidi_1.imidi[commidi_1.numchan] += 6; +#line 17979 "" + } else if (*(unsigned char *)typeq == 'k') { + +/* Keychange event. in1 = isig */ + +#line 17983 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 1) * 25 - 25] = 89; +#line 17984 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 2) * 25 - 25] = 2; +#line 17985 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256) + % 256); +#line 17986 "" + commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[ + commidi_1.numchan] + 4) * 25 - 25] = 0; +#line 17987 "" + commidi_1.imidi[commidi_1.numchan] += 4; +#line 17988 "" + } else { +#line 17989 "" + s_wsle(&io___1113); +#line 17989 "" + do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29); +#line 17989 "" + e_wsle(); +#line 17990 "" + stop1_(); +#line 17991 "" + } +#line 17992 "" + comevent_1.lasttime = comevent_1.miditime; +#line 17993 "" + return 0; +} /* midievent_ */ + +/* Subroutine */ int moveln_(integer *iuin, integer *iuout, logical *done) +{ + /* System generated locals */ + integer i__1; + + /* Builtin functions */ + integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), + s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + extern integer llen_(char *, integer *, ftnlen); + static char outq[129]; + static integer lenout; + + /* Fortran I/O blocks */ + static cilist io___1114 = { 0, 0, 1, "(a)", 0 }; + static cilist io___1117 = { 0, 0, 0, "(a)", 0 }; + + +#line 17998 "" + *done = FALSE_; +#line 17999 "" + io___1114.ciunit = *iuin; +#line 17999 "" + i__1 = s_rsfe(&io___1114); +#line 17999 "" + if (i__1 != 0) { +#line 17999 "" + goto L1; +#line 17999 "" + } +#line 17999 "" + i__1 = do_fio(&c__1, outq, (ftnlen)129); +#line 17999 "" + if (i__1 != 0) { +#line 17999 "" + goto L1; +#line 17999 "" + } +#line 17999 "" + i__1 = e_rsfe(); +#line 17999 "" + if (i__1 != 0) { +#line 17999 "" + goto L1; +#line 17999 "" + } +#line 18000 "" + lenout = llen_(outq, &c__129, (ftnlen)129); +#line 18001 "" + io___1117.ciunit = *iuout; +#line 18001 "" + s_wsfe(&io___1117); +#line 18001 "" + do_fio(&c__1, outq, lenout); +#line 18001 "" + e_wsfe(); +#line 18002 "" + return 0; +#line 18003 "" +L1: +#line 18003 "" + *done = TRUE_; +#line 18004 "" + return 0; +} /* moveln_ */ + +/* Subroutine */ int mrec1_(char *lineq, integer *iccount, integer *ndxm, + ftnlen lineq_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern integer ntindex_(char *, char *, integer *, ftnlen, ftnlen); + + +/* This is called when (a) macro recording is just starting and */ +/* (b) at the start of a new line, if recording is on */ + +#line 18020 "" + if (! commac_1.mrecord) { + +/* Starting the macro */ + +#line 18024 "" + c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf - + inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount; +#line 18025 "" + c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 18026 "" + c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount; +#line 18027 "" + commac_1.mrecord = TRUE_; +#line 18028 "" + } +#line 18029 "" + if (*iccount < 128) { +#line 18030 "" + i__1 = *iccount; +#line 18030 "" + *ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1); +#line 18031 "" + if (*ndxm > 0) { +#line 18031 "" + i__1 = *iccount; +#line 18031 "" + i__2 = 128 - *iccount; +#line 18031 "" + *ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1); +#line 18031 "" + } +#line 18033 "" + if (*ndxm > 0) { + +/* This line ends the macro. */ + +#line 18037 "" + c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf - + inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm; +#line 18038 "" + c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1; +#line 18039 "" + commac_1.mrecord = FALSE_; +#line 18040 "" + } +#line 18041 "" + } +#line 18042 "" + return 0; +} /* mrec1_ */ + +integer ncmid_(integer *iv, integer *ip) +{ + /* 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); + + /* Local variables */ + static integer icc; + static real xtime; + + /* Fortran I/O blocks */ + static cilist io___1120 = { 0, 6, 0, 0, 0 }; + + +#line 18062 "" + if (comcc_1.ncc[*iv - 1] == 1) { +#line 18063 "" + ret_val = comcc_1.ncmidcc[*iv - 1]; +#line 18064 "" + } else { +#line 18065 "" + xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1]; +#line 18066 "" + for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) { +#line 18067 "" + if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) { +#line 18068 "" + ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25]; +#line 18069 "" + return ret_val; +#line 18070 "" + } +#line 18071 "" +/* L1: */ +#line 18071 "" + } +#line 18072 "" + s_wsle(&io___1120); +#line 18072 "" + do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18); +#line 18072 "" + e_wsle(); +#line 18073 "" + s_stop("", (ftnlen)0); +#line 18074 "" + } +#line 18075 "" + return ret_val; +} /* ncmid_ */ + +integer ncmidf_(char *clefq, ftnlen clefq_len) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + +/* 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 18098 "" + if (*(unsigned char *)clefq == '8') { + +/* treblelowoct; will treat as treble for this purpose */ + +#line 18102 "" + ret_val = 35; +#line 18103 "" + } else { +#line 18104 "" + ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) / + 2 << 1) + 21; +#line 18105 "" + } +#line 18106 "" + return ret_val; +} /* ncmidf_ */ + +/* Subroutine */ int newvoice_(integer *jv, char *clefq, logical *change, + ftnlen clefq_len) +{ + static integer j; + extern integer ncmidf_(char *, ftnlen); + +#line 18129 "" + commvl_1.nvmx[*jv - 1] = 1; +#line 18130 "" + commvl_1.ivmx[*jv - 1] = *jv; +#line 18131 "" + all_1.itsofar[*jv - 1] = 0; +#line 18132 "" + all_1.nnl[*jv - 1] = 0; +#line 18133 "" + comfb_1.nfb[*jv - 1] = 0; +#line 18134 "" + if (all_1.firstgulp || *change) { +#line 18135 "" + comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1); +#line 18136 "" + } else { +#line 18137 "" + comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1] + * 24 - 25]; +#line 18138 "" + } +#line 18139 "" + comcc_1.tcc[*jv - 1] = 0.f; +#line 18140 "" + comcc_1.ncc[*jv - 1] = 1; +#line 18141 "" + comudsp_1.nudoff[*jv - 1] = 0; +#line 18142 "" + comcc_1.ndotmv[*jv - 1] = 0; +#line 18143 "" + for (j = 1; j <= 200; ++j) { +#line 18144 "" + all_1.irest[*jv + j * 24 - 25] = 0; +#line 18145 "" + all_1.islur[*jv + j * 24 - 25] = 0; +#line 18146 "" + all_1.ipl[*jv + j * 24 - 25] = 0; +#line 18147 "" + all_1.nacc[*jv + j * 24 - 25] = 0; +#line 18148 "" + all_1.iornq[*jv + j * 24 - 1] = 0; +#line 18149 "" + all_1.mult[*jv + j * 24 - 25] = 0; +#line 18150 "" + if (*jv <= 2) { +#line 18150 "" + all_1.isfig[*jv + (j << 1) - 3] = FALSE_; +#line 18150 "" + } +#line 18151 "" +/* L5: */ +#line 18151 "" + } +#line 18152 "" + return 0; +} /* newvoice_ */ + +/* Subroutine */ int notefq_(char *noteq, integer *lnote, integer *nolev, + integer *ncmid, ftnlen noteq_len) +{ + /* System generated locals */ + integer i__1; + char ch__1[1], ch__2[1]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + static integer nupfroma, i__; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer iname, ioctup; + static char noteqt[1]; + extern /* Character */ VOID upcaseq_(char *, ftnlen, char *, ftnlen); + + +/* Returns name of note level with octave transpositions, updates noctup. */ + +#line 18161 "" + nupfroma = (*nolev + 1) % 7; +#line 18162 "" + iname = nupfroma + 97; +#line 18163 "" + ioctup = (*nolev + 1) / 7 - 4; +#line 18164 "" + chax_(ch__1, (ftnlen)1, &iname); +#line 18164 "" + *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; +#line 18165 "" + if (*ncmid == 23) { +#line 18165 "" + upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1); +#line 18165 "" + *(unsigned char *)noteqt = *(unsigned char *)&ch__1[0]; +#line 18165 "" + } +#line 18166 "" + if (ioctup == comoct_1.noctup) { +#line 18167 "" + s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1); +#line 18168 "" + *lnote = 1; + +/* Must ALWAYS check if lnote=1 for use with functions requiring a blank */ + +#line 18172 "" + } else if (ioctup > comoct_1.noctup) { + +/* Raise octave. Encase in {} */ + +#line 18176 "" + ici__1.icierr = 0; +#line 18176 "" + ici__1.icirnum = 1; +#line 18176 "" + ici__1.icirlen = 8; +#line 18176 "" + ici__1.iciunit = noteq; +#line 18176 "" + ici__1.icifmt = "(8a1)"; +#line 18176 "" + s_wsfi(&ici__1); +#line 18176 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 18176 "" + i__1 = ioctup - 1; +#line 18176 "" + for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) { +#line 18176 "" + chax_(ch__2, (ftnlen)1, &c__39); +#line 18176 "" + *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; +#line 18176 "" + do_fio(&c__1, ch__1, (ftnlen)1); +#line 18176 "" + } +#line 18176 "" + do_fio(&c__1, noteqt, (ftnlen)1); +#line 18176 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 18176 "" + e_wsfi(); +#line 18178 "" + *lnote = ioctup + 3 - comoct_1.noctup; +#line 18179 "" + comoct_1.noctup = ioctup; +#line 18180 "" + } else { + +/* Lower octave */ + +#line 18184 "" + ici__1.icierr = 0; +#line 18184 "" + ici__1.icirnum = 1; +#line 18184 "" + ici__1.icirlen = 8; +#line 18184 "" + ici__1.iciunit = noteq; +#line 18184 "" + ici__1.icifmt = "(8a1)"; +#line 18184 "" + s_wsfi(&ici__1); +#line 18184 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 18184 "" + i__1 = comoct_1.noctup - 1; +#line 18184 "" + for (i__ = ioctup; i__ <= i__1; ++i__) { +#line 18184 "" + chax_(ch__2, (ftnlen)1, &c__96); +#line 18184 "" + *(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0]; +#line 18184 "" + do_fio(&c__1, ch__1, (ftnlen)1); +#line 18184 "" + } +#line 18184 "" + do_fio(&c__1, noteqt, (ftnlen)1); +#line 18184 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 18184 "" + e_wsfi(); +#line 18186 "" + *lnote = comoct_1.noctup + 3 - ioctup; +#line 18187 "" + comoct_1.noctup = ioctup; +#line 18188 "" + } +#line 18189 "" + return 0; +} /* notefq_ */ + +/* Subroutine */ int notex_(char *notexq, integer *lnote, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[4], a__2[3], a__3[5], a__4[2], a__5[8]; + integer i__1, i__2, i__3[4], i__4[3], i__5[5], i__6[2], i__7[8]; + real r__1; + char ch__1[1]; + + /* Builtin functions */ + integer i_nint(real *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , pow_ii(integer *, integer *), i_sign(integer *, integer *); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static real raisedot; + static integer ip; + static char udq[1]; + extern integer log2_(integer *); + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static logical even; + static integer nole, ldot, nodu; + static char dotq[4]; + extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *, + integer *, integer *, integer *, integer *); + static real zmin; + static char numq[2]; + extern integer ncmid_(integer *, integer *); + static real fnole; + static char noteq[8]; + static integer lrest; + static char restq[40]; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten; + + /* Fortran I/O blocks */ + static icilist io___1139 = { 0, noteq, 0, "(i2)", 2, 1 }; + static icilist io___1143 = { 0, numq, 0, "(i2)", 2, 1 }; + static icilist io___1144 = { 0, noteq+1, 0, "(i2)", 2, 1 }; + static icilist io___1145 = { 0, noteq+1, 0, "(i3)", 3, 1 }; + + + +/* Returns non-beamed full note name */ + +#line 18219 "" + ip = all_1.ipo[all_1.jn - 1]; +#line 18220 "" + nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25]; + +/* Check for special situations with 2nds (see precrd) */ + +#line 18224 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) { +#line 18225 "" + --nole; +#line 18226 "" + } else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) { +#line 18227 "" + ++nole; +#line 18228 "" + } +#line 18229 "" + nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25]; +#line 18230 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 18231 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 18231 "" + 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 18231 "" + *(unsigned char *)udq = *(unsigned char *)&ch__1[0]; +#line 18233 "" + } + +/* Check figure level */ + +/* if (figbass .and. isfig(ivx,ip) */ +/* * .and. .not.btest(irest(ivx,ip),0)) then */ +#line 18239 "" + 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 18242 "" + if (*(unsigned char *)udq == 'u' || nodu >= 64) { + +/* Upper or no stem, fnole (in noleunits) set by notehead */ + +#line 18246 "" + fnole = (real) nole; +#line 18247 "" + } else { + +/* Lower stem, fnole set by bottom of stem */ + +#line 18251 "" + fnole = nole - all_1.stemlen; +#line 18252 "" + } +#line 18253 "" + zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4; +#line 18254 "" + if (commvl_1.ivx == 1) { +/* Computing MAX */ +#line 18255 "" + r__1 = 4 - zmin; +#line 18255 "" + i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1); +#line 18255 "" + all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2); +#line 18256 "" + } else { +/* Computing MAX */ +#line 18257 "" + r__1 = 4 - zmin; +#line 18257 "" + i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1); +#line 18257 "" + all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2); +#line 18258 "" + } +#line 18259 "" + } +#line 18260 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 18261 "" + i__1 = ncmid_(&all_1.iv, &ip); +#line 18261 "" + notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8); +#line 18262 "" + if (lnoten == 1) { +#line 18262 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 18262 "" + } +#line 18263 "" + if (nodu == 1) { +/* Writing concatenation */ +#line 18264 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18264 "" + i__3[1] = 4, a__1[1] = "cccc"; +#line 18264 "" + i__3[2] = 1, a__1[2] = udq; +#line 18264 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18264 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18265 "" + *lnote = lnoten + 6; +#line 18266 "" + } else if (nodu == 2) { +/* Writing concatenation */ +#line 18267 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18267 "" + i__3[1] = 3, a__1[1] = "ccc"; +#line 18267 "" + i__3[2] = 1, a__1[2] = udq; +#line 18267 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18267 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18268 "" + *lnote = lnoten + 5; +#line 18269 "" + } else if (nodu == 4) { +/* Writing concatenation */ +#line 18270 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18270 "" + i__3[1] = 2, a__1[1] = "cc"; +#line 18270 "" + i__3[2] = 1, a__1[2] = udq; +#line 18270 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18270 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18271 "" + *lnote = lnoten + 4; +#line 18272 "" + } else if (nodu == 8) { +/* Writing concatenation */ +#line 18273 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18273 "" + i__3[1] = 1, a__1[1] = "c"; +#line 18273 "" + i__3[2] = 1, a__1[2] = udq; +#line 18273 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18273 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18274 "" + *lnote = lnoten + 3; +#line 18275 "" + } else if (nodu == 16) { +/* Writing concatenation */ +#line 18276 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18276 "" + i__3[1] = 1, a__1[1] = "q"; +#line 18276 "" + i__3[2] = 1, a__1[2] = udq; +#line 18276 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18276 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18277 "" + *lnote = lnoten + 3; +#line 18278 "" + } else if (nodu == 32) { +/* Writing concatenation */ +#line 18279 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18279 "" + i__3[1] = 1, a__1[1] = "h"; +#line 18279 "" + i__3[2] = 1, a__1[2] = udq; +#line 18279 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18279 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18280 "" + *lnote = lnoten + 3; +#line 18281 "" + } else if (nodu == 64) { +/* Writing concatenation */ +#line 18282 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 18282 "" + i__4[1] = 2, a__2[1] = "wh"; +#line 18282 "" + i__4[2] = lnoten, a__2[2] = noteq; +#line 18282 "" + s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 18283 "" + *lnote = lnoten + 3; +#line 18284 "" + } else if (nodu == 128) { +/* notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */ +/* lnote = lnoten+10 */ +/* Writing concatenation */ +#line 18287 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 18287 "" + i__4[1] = 5, a__2[1] = "breve"; +#line 18287 "" + i__4[2] = lnoten, a__2[2] = noteq; +#line 18287 "" + s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 18288 "" + *lnote = lnoten + 6; +#line 18289 "" + } else { +#line 18290 "" + s_copy(dotq, "p", (ftnlen)4, (ftnlen)1); +#line 18291 "" + ldot = 1; +#line 18292 "" + if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) { + +/* Dotted note with ')' ornament */ + +#line 18296 "" + s_copy(dotq, "m", (ftnlen)4, (ftnlen)1); +#line 18297 "" + } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) { + +/* Double dot */ + +#line 18301 "" + s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2); +#line 18302 "" + ldot = 2; +#line 18303 "" + } +#line 18304 "" + if (nodu >= 192) { +/* Writing concatenation */ +#line 18305 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18305 "" + i__3[1] = 5, a__1[1] = "breve"; +#line 18305 "" + i__3[2] = ldot, a__1[2] = dotq; +#line 18305 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18305 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18306 "" + *lnote = lnoten + 6 + ldot; +#line 18307 "" + } else if (nodu >= 96) { +/* Writing concatenation */ +#line 18308 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 18308 "" + i__3[1] = 2, a__1[1] = "wh"; +#line 18308 "" + i__3[2] = ldot, a__1[2] = dotq; +#line 18308 "" + i__3[3] = lnoten, a__1[3] = noteq; +#line 18308 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18309 "" + *lnote = lnoten + 3 + ldot; +#line 18310 "" + } else if (nodu >= 48) { +/* Writing concatenation */ +#line 18311 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18311 "" + i__5[1] = 1, a__3[1] = "h"; +#line 18311 "" + i__5[2] = 1, a__3[2] = udq; +#line 18311 "" + i__5[3] = ldot, a__3[3] = dotq; +#line 18311 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 18311 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18312 "" + *lnote = lnoten + 3 + ldot; +#line 18313 "" + } else if (nodu >= 24) { +/* Writing concatenation */ +#line 18314 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18314 "" + i__5[1] = 1, a__3[1] = "q"; +#line 18314 "" + i__5[2] = 1, a__3[2] = udq; +#line 18314 "" + i__5[3] = ldot, a__3[3] = dotq; +#line 18314 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 18314 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18315 "" + *lnote = lnoten + 3 + ldot; +#line 18316 "" + } else if (nodu >= 12) { +/* Writing concatenation */ +#line 18317 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18317 "" + i__5[1] = 1, a__3[1] = "c"; +#line 18317 "" + i__5[2] = 1, a__3[2] = udq; +#line 18317 "" + i__5[3] = ldot, a__3[3] = dotq; +#line 18317 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 18317 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18318 "" + *lnote = lnoten + 3 + ldot; +#line 18319 "" + } else if (nodu >= 6) { +/* Writing concatenation */ +#line 18320 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18320 "" + i__5[1] = 2, a__3[1] = "cc"; +#line 18320 "" + i__5[2] = 1, a__3[2] = udq; +#line 18320 "" + i__5[3] = ldot, a__3[3] = dotq; +#line 18320 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 18320 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18321 "" + *lnote = lnoten + 4 + ldot; +#line 18322 "" + compoi_1.ispoi = TRUE_; +#line 18323 "" + } else { +/* Writing concatenation */ +#line 18324 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18324 "" + i__5[1] = 3, a__3[1] = "ccc"; +#line 18324 "" + i__5[2] = 1, a__3[2] = udq; +#line 18324 "" + i__5[3] = ldot, a__3[3] = dotq; +#line 18324 "" + i__5[4] = lnoten, a__3[4] = noteq; +#line 18324 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18325 "" + *lnote = lnoten + 5 + ldot; +#line 18326 "" + compoi_1.ispoi = TRUE_; +#line 18327 "" + } +#line 18328 "" + if (*(unsigned char *)dotq == 'm') { + +/* Need another call to the note, in case the first one has octave shifts */ + +#line 18332 "" + if (lnoten == 2) { +/* Writing concatenation */ +#line 18333 "" + i__3[0] = *lnote, a__1[0] = notexq; +#line 18333 "" + i__3[1] = 1, a__1[1] = "{"; +#line 18333 "" + i__3[2] = 1, a__1[2] = noteq + 1; +#line 18333 "" + i__3[3] = 1, a__1[3] = "}"; +#line 18333 "" + s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79); +#line 18334 "" + *lnote += 3; +#line 18335 "" + } else { +#line 18336 "" + i__1 = lnoten - 2; +/* Writing concatenation */ +#line 18336 "" + i__6[0] = *lnote, a__4[0] = notexq; +#line 18336 "" + i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1; +#line 18336 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18337 "" + ++(*lnote); +#line 18338 "" + } +#line 18339 "" + } +#line 18340 "" + } +#line 18341 "" + } else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) { + +/* Blank rest */ + +/* Writing concatenation */ +#line 18345 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18345 "" + i__6[1] = 2, a__4[1] = "sk"; +#line 18345 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18346 "" + *lnote = 3; +#line 18347 "" + } else { + +/* Non-blank rest */ + +#line 18351 "" + *lnote = 0; +#line 18352 "" + nole = (nole + 20) % 100 - 20; + +/* Kluge to get pause symbol for rp: */ + +#line 18356 "" + if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) { +#line 18356 "" + nodu = 64; +#line 18356 "" + } +#line 18357 "" + if (nodu <= 28) { + +/* Normal rest < or = double-dotted quarter */ + +#line 18361 "" + lrest = 3; +#line 18362 "" + if (nodu > 14) { +/* Writing concatenation */ +#line 18363 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18363 "" + i__6[1] = 2, a__4[1] = "qp"; +#line 18363 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18364 "" + } else if (nodu > 7) { +/* Writing concatenation */ +#line 18365 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18365 "" + i__6[1] = 2, a__4[1] = "ds"; +#line 18365 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18366 "" + } else if (nodu > 3) { +/* Writing concatenation */ +#line 18367 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18367 "" + i__6[1] = 2, a__4[1] = "qs"; +#line 18367 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18368 "" + } else if (nodu > 1) { +/* Writing concatenation */ +#line 18369 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18369 "" + i__6[1] = 2, a__4[1] = "hs"; +#line 18369 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18370 "" + } else { +/* Writing concatenation */ +#line 18371 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18371 "" + i__6[1] = 3, a__4[1] = "qqs"; +#line 18371 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18372 "" + lrest = 4; +#line 18373 "" + } +/* 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 */ +#line 18388 "" + s_copy(notexq, restq, (ftnlen)79, (ftnlen)40); +#line 18389 "" + *lnote = lrest; + +/* At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. */ + +#line 18393 "" + if (nole != 0) { +#line 18394 "" + if (abs(nole) < 10) { +#line 18395 "" + i__1 = abs(nole) + 48; +#line 18395 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 18395 "" + s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 18396 "" + lnoten = 1; +#line 18397 "" + } else { +#line 18398 "" + s_wsfi(&io___1139); +#line 18398 "" + i__1 = abs(nole); +#line 18398 "" + do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 18398 "" + e_wsfi(); +#line 18399 "" + lnoten = 2; +#line 18400 "" + } +#line 18401 "" + if (nole > 0) { +/* Writing concatenation */ +#line 18402 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18402 "" + i__5[1] = 5, a__3[1] = "raise"; +#line 18402 "" + i__5[2] = lnoten, a__3[2] = noteq; +#line 18402 "" + i__5[3] = 1, a__3[3] = all_1.sq; +#line 18402 "" + i__5[4] = 9, a__3[4] = "internote"; +#line 18402 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18403 "" + } else { +/* Writing concatenation */ +#line 18404 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 18404 "" + i__5[1] = 5, a__3[1] = "lower"; +#line 18404 "" + i__5[2] = lnoten, a__3[2] = noteq; +#line 18404 "" + i__5[3] = 1, a__3[3] = all_1.sq; +#line 18404 "" + i__5[4] = 9, a__3[4] = "internote"; +#line 18404 "" + s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79); +#line 18405 "" + } +#line 18406 "" + *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 18414 "" + i__6[0] = *lnote, a__4[0] = notexq; +#line 18414 "" + i__6[1] = lrest, a__4[1] = restq; +#line 18414 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18415 "" + *lnote += lrest; +/* if (2**log2(nodu) .ne. nodu) then */ +/* notexq = notexq(1:lnote)//'}' */ +/* lnote = lnote+1 */ +/* end if */ +#line 18420 "" + } +#line 18421 "" + i__1 = log2_(&nodu); +#line 18421 "" + if (pow_ii(&c__2, &i__1) != nodu) { + +/* Deal with dots (on rests shorter than half rest) */ + +/* Writing concatenation */ +#line 18425 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18425 "" + i__6[1] = 2, a__4[1] = "pt"; +#line 18425 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18426 "" + lrest = 3; +#line 18427 "" + i__1 = log2_(&nodu); +#line 18427 "" + if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { +/* Writing concatenation */ +#line 18428 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18428 "" + i__6[1] = 3, a__4[1] = "ppt"; +#line 18428 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18429 "" + lrest = 4; +#line 18430 "" + } +#line 18431 "" + nole += 4; +#line 18432 "" + raisedot = 0.f; + +/* Tweak dot positions for special cases */ + +#line 18436 "" + even = (nole + 100) % 2 == 0; +/* if (.not.even.and.nodu.gt.8.and. */ +/* * (nole.lt.0.or.nole.gt.8)) then */ +#line 18439 "" + if (! even && (nole < 0 || nole > 8)) { +#line 18440 "" + raisedot = 1.f; +#line 18441 "" + } +#line 18442 "" + if (nole >= 10 || nole <= -1) { +#line 18443 "" + s_wsfi(&io___1143); +#line 18443 "" + do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 18443 "" + e_wsfi(); +/* Writing concatenation */ +#line 18444 "" + i__3[0] = lrest, a__1[0] = restq; +#line 18444 "" + i__3[1] = 1, a__1[1] = "{"; +#line 18444 "" + i__3[2] = 2, a__1[2] = numq; +#line 18444 "" + i__3[3] = 1, a__1[3] = "}"; +#line 18444 "" + s_cat(restq, a__1, i__3, &c__4, (ftnlen)40); +#line 18445 "" + lrest += 4; +#line 18446 "" + } else { +/* Writing concatenation */ +#line 18447 "" + i__6[0] = lrest, a__4[0] = restq; +#line 18447 "" + i__1 = nole + 48; +#line 18447 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 18447 "" + i__6[1] = 1, a__4[1] = ch__1; +#line 18447 "" + s_cat(restq, a__4, i__6, &c__2, (ftnlen)40); +#line 18448 "" + ++lrest; +#line 18449 "" + } +#line 18450 "" + if (raisedot > 0.f) { +/* Writing concatenation */ +#line 18451 "" + i__7[0] = 1, a__5[0] = all_1.sq; +#line 18451 "" + i__7[1] = 5, a__5[1] = "raise"; +#line 18451 "" + i__7[2] = 1, a__5[2] = all_1.sq; +#line 18451 "" + i__7[3] = 9, a__5[3] = "internote"; +#line 18451 "" + i__7[4] = 1, a__5[4] = all_1.sq; +#line 18451 "" + i__7[5] = 5, a__5[5] = "hbox{"; +#line 18451 "" + i__7[6] = lrest, a__5[6] = restq; +#line 18451 "" + i__7[7] = 1, a__5[7] = "}"; +#line 18451 "" + s_cat(restq, a__5, i__7, &c__8, (ftnlen)40); +#line 18453 "" + lrest += 23; +#line 18454 "" + } +/* Writing concatenation */ +#line 18458 "" + i__6[0] = lrest, a__4[0] = restq; +#line 18458 "" + i__6[1] = *lnote, a__4[1] = notexq; +#line 18458 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18459 "" + *lnote += lrest; +#line 18460 "" + } +#line 18461 "" + } else { + +/* Half rest or longer */ + +#line 18465 "" + if (nole == 0) { + +/* Half or longer rest is not raised or lowered */ + +#line 18469 "" + if (nodu <= 56) { +/* Writing concatenation */ +#line 18470 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18470 "" + i__6[1] = 6, a__4[1] = "hpause"; +#line 18470 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18471 "" + *lnote = 7; +#line 18472 "" + } else if (nodu <= 112) { +#line 18473 "" + 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 18475 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18475 "" + i__6[1] = 5, a__4[1] = "pause"; +#line 18475 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18476 "" + } else { +/* Writing concatenation */ +#line 18477 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18477 "" + i__6[1] = 5, a__4[1] = "pausc"; +#line 18477 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18478 "" + } +#line 18479 "" + *lnote = 6; +#line 18480 "" + } else { +/* Writing concatenation */ +#line 18481 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18481 "" + i__6[1] = 5, a__4[1] = "PAuse"; +#line 18481 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18482 "" + *lnote = 6; +#line 18483 "" + } +#line 18484 "" + i__1 = log2_(&nodu); +#line 18484 "" + if (pow_ii(&c__2, &i__1) != nodu) { + +/* Dotted rest, hpause or longer */ + +/* Writing concatenation */ +#line 18488 "" + i__6[0] = *lnote, a__4[0] = notexq; +#line 18488 "" + i__6[1] = 1, a__4[1] = "p"; +#line 18488 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18489 "" + ++(*lnote); +#line 18490 "" + i__1 = log2_(&nodu); +#line 18490 "" + if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) { + +/* Double dotted long rest */ + +/* Writing concatenation */ +#line 18494 "" + i__6[0] = *lnote, a__4[0] = notexq; +#line 18494 "" + i__6[1] = 1, a__4[1] = "p"; +#line 18494 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18495 "" + ++(*lnote); +#line 18496 "" + } +#line 18497 "" + } +#line 18498 "" + } else { + +/* Raised or lowered half or whole rest */ + +#line 18502 "" + if (nodu == 32) { +/* Writing concatenation */ +#line 18503 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18503 "" + i__6[1] = 10, a__4[1] = "lifthpause"; +#line 18503 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18504 "" + *lnote = 11; +#line 18505 "" + } else if (nodu == 48) { +/* Writing concatenation */ +#line 18506 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18506 "" + i__6[1] = 11, a__4[1] = "lifthpausep"; +#line 18506 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18507 "" + *lnote = 12; +#line 18508 "" + } else if (nodu == 56) { +/* Writing concatenation */ +#line 18509 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18509 "" + i__6[1] = 12, a__4[1] = "lifthpausepp"; +#line 18509 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18510 "" + *lnote = 13; +#line 18511 "" + } else if (nodu == 64) { +/* Writing concatenation */ +#line 18512 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18512 "" + i__6[1] = 9, a__4[1] = "liftpause"; +#line 18512 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18513 "" + *lnote = 10; +#line 18514 "" + } else if (nodu == 96) { +/* Writing concatenation */ +#line 18515 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18515 "" + i__6[1] = 10, a__4[1] = "liftpausep"; +#line 18515 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18516 "" + *lnote = 11; +#line 18517 "" + } else if (nodu == 112) { +/* Writing concatenation */ +#line 18518 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18518 "" + i__6[1] = 11, a__4[1] = "liftpausepp"; +#line 18518 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18519 "" + *lnote = 12; +#line 18520 "" + } else if (nodu == 128) { +/* Writing concatenation */ +#line 18521 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18521 "" + i__6[1] = 9, a__4[1] = "liftPAuse"; +#line 18521 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18522 "" + *lnote = 10; +#line 18523 "" + } else { + +/* Assume dotted double whole rest */ + +/* Writing concatenation */ +#line 18527 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 18527 "" + i__6[1] = 10, a__4[1] = "liftPAusep"; +#line 18527 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18528 "" + *lnote = 11; +#line 18529 "" + } + +/* Set up height spec */ + +#line 18533 "" + i__1 = abs(nole) / 2; +#line 18533 "" + nole = i_sign(&i__1, &nole); +#line 18534 "" + if (nole <= 9 && nole >= 0) { +#line 18535 "" + i__1 = nole + 48; +#line 18535 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 18535 "" + s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1); +#line 18536 "" + lnoten = 1; +#line 18537 "" + } else { +#line 18538 "" + s_copy(noteq, "{", (ftnlen)8, (ftnlen)1); +#line 18539 "" + if (nole >= -9) { +#line 18540 "" + s_wsfi(&io___1144); +#line 18540 "" + do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 18540 "" + e_wsfi(); +#line 18541 "" + lnoten = 3; +#line 18542 "" + } else { +#line 18543 "" + s_wsfi(&io___1145); +#line 18543 "" + do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer)); +#line 18543 "" + e_wsfi(); +#line 18544 "" + lnoten = 4; +#line 18545 "" + } +/* Writing concatenation */ +#line 18546 "" + i__6[0] = lnoten, a__4[0] = noteq; +#line 18546 "" + i__6[1] = 1, a__4[1] = "}"; +#line 18546 "" + s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8); +#line 18547 "" + ++lnoten; +#line 18548 "" + } +/* Writing concatenation */ +#line 18549 "" + i__6[0] = *lnote, a__4[0] = notexq; +#line 18549 "" + i__6[1] = lnoten, a__4[1] = noteq; +#line 18549 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 18550 "" + *lnote += lnoten; +#line 18551 "" + } +#line 18552 "" + } +#line 18553 "" + } +#line 18554 "" + return 0; +} /* notex_ */ + +integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, + ftnlen s2q_len) +{ + /* System generated locals */ + address a__1[2]; + integer ret_val, i__1, i__2, i__3[2]; + char ch__1[1], ch__2[2]; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, + ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + static integer ic, len; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer ndxs2, ndxbs; + static logical intex; + extern integer lenstr_(char *, integer *, ftnlen); + + +/* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */ + +#line 18563 "" + ndxs2 = i_indx(line, s2q, line_len, s2q_len); +#line 18564 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 18564 "" + ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1); +#line 18565 "" + if (ndxbs == 0 || ndxs2 < ndxbs) { +#line 18566 "" + ret_val = ndxs2; +#line 18567 "" + } 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 18572 "" + len = lenstr_(line, lenline, line_len); +#line 18573 "" + intex = TRUE_; +#line 18574 "" + i__1 = len; +#line 18574 "" + for (ic = ndxbs + 1; ic <= i__1; ++ic) { +#line 18575 "" + if (ic == ndxs2) { +#line 18576 "" + if (intex) { +#line 18577 "" + ret_val = 0; +#line 18578 "" + i__2 = ic; +#line 18578 "" + ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) + + ic; +#line 18579 "" + } else { +#line 18580 "" + ret_val = ndxs2; +#line 18581 "" + return ret_val; +#line 18582 "" + } +#line 18583 "" + } else /* if(complicated condition) */ { +#line 18583 "" + i__2 = ic; +/* Writing concatenation */ +#line 18583 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 18583 "" + i__3[0] = 1, a__1[0] = ch__1; +#line 18583 "" + i__3[1] = 1, a__1[1] = " "; +#line 18583 "" + s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); +#line 18583 "" + if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen) + 2) == 0) { +#line 18584 "" + intex = FALSE_; +#line 18585 "" + } else /* if(complicated condition) */ { +#line 18585 "" + i__2 = ic; +/* Writing concatenation */ +#line 18585 "" + i__3[0] = 1, a__1[0] = " "; +#line 18585 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 18585 "" + i__3[1] = 1, a__1[1] = ch__1; +#line 18585 "" + s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2); +#line 18585 "" + if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, ( + ftnlen)2) == 0) { +#line 18587 "" + intex = TRUE_; +#line 18588 "" + } +#line 18588 "" + } +#line 18588 "" + } +#line 18589 "" +/* L1: */ +#line 18589 "" + } +#line 18590 "" + } +#line 18591 "" + return ret_val; +} /* ntindex_ */ + +/* Subroutine */ int ntrbbb_(integer *n, char *char1q, char *ulqq, integer * + iv, char *notexq, integer *lnote, ftnlen char1q_len, ftnlen ulqq_len, + ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[3], a__2[2]; + integer i__1[3], i__2[2], i__3; + char ch__1[1]; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + + /* Local variables */ + static integer im, len; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern /* Subroutine */ int stop1_(void); + static char tempq[4]; + extern /* Subroutine */ int printl_(char *, ftnlen), istring_(integer *, + char *, integer *, ftnlen); + + +/* This appends to notexq e.g. '\ibbbu1' */ + +#line 18602 "" + if (*n >= 5) { +#line 18602 "" + combbm_1.isbbm = TRUE_; +#line 18602 "" + } +#line 18603 "" + if (*lnote > 0) { +/* Writing concatenation */ +#line 18604 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 18604 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 18604 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 18604 "" + i__1[2] = 1, a__1[2] = char1q; +#line 18604 "" + s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); +#line 18605 "" + } else { +/* Writing concatenation */ +#line 18606 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 18606 "" + i__2[0] = 1, a__2[0] = ch__1; +#line 18606 "" + i__2[1] = 1, a__2[1] = char1q; +#line 18606 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 18607 "" + } +#line 18608 "" + *lnote += 2; +#line 18609 "" + i__3 = *n; +#line 18609 "" + for (im = 1; im <= i__3; ++im) { +/* Writing concatenation */ +#line 18610 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 18610 "" + i__2[1] = 1, a__2[1] = "b"; +#line 18610 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79); +#line 18611 "" + ++(*lnote); +#line 18612 "" +/* L3: */ +#line 18612 "" + } + +/* add the number, 0 if 12 */ + +/* 5/25/08 Allow >12 */ + +/* call istring(mod(iv,12),tempq,len) */ +#line 18619 "" + if (*iv < 24) { +#line 18620 "" + istring_(iv, tempq, &len, (ftnlen)4); +#line 18621 "" + } else if (*iv == 24) { +#line 18622 "" + *(unsigned char *)tempq = '0'; +#line 18623 "" + len = 1; +#line 18624 "" + } else { +#line 18625 "" + printl_("Sorry, too man open beams", (ftnlen)25); +#line 18626 "" + stop1_(); +#line 18627 "" + } +/* Writing concatenation */ +#line 18628 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 18628 "" + i__1[1] = 1, a__1[1] = ulqq; +#line 18628 "" + i__1[2] = len, a__1[2] = tempq; +#line 18628 "" + s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79); +#line 18629 "" + *lnote = *lnote + 1 + len; +#line 18630 "" + return 0; +} /* ntrbbb_ */ + +integer numclef_(char *clefq, ftnlen clefq_len) +{ + /* System generated locals */ + integer ret_val; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + +/* Returns the number to be used as argument of \setclef for MusiXTeX */ +/* For input 0-6 or tsmanrb return 0-7 */ +/* 7 f 9 */ +/* 8 0 */ + +#line 18640 "" + if (*(unsigned char *)clefq < 55) { +/* if (ichar(clefq) .le. 55) then */ +#line 18642 "" + ret_val = *(unsigned char *)clefq - 48; +/* if (numclef .eq. 7) numclef = 9 */ +#line 18644 "" + } else if (*(unsigned char *)clefq == '7') { +#line 18645 "" + ret_val = 9; +#line 18646 "" + } else if (*(unsigned char *)clefq == '8') { +#line 18647 "" + ret_val = 0; +#line 18648 "" + } else { +#line 18649 "" + ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1; +#line 18650 "" + } +#line 18651 "" + return ret_val; +} /* numclef_ */ + +/* Subroutine */ int outbar_(integer *i__, integer *jlast) +{ + /* System generated locals */ + address a__1[3]; + integer i__1[3], i__2; + real r__1; + char ch__1[9], ch__2[1], ch__3[11]; + cilist ci__1; + + /* Builtin functions */ + double r_lg10(real *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nfmt; + +#line 18655 "" + r__1 = *i__ + .5f; +#line 18655 "" + nfmt = r_lg10(&r__1) + 2; +#line 18656 "" + if (*jlast + 5 + nfmt < 80) { +#line 18657 "" + ci__1.cierr = 0; +#line 18657 "" + ci__1.ciunit = 6; +/* Writing concatenation */ +#line 18657 "" + i__1[0] = 5, a__1[0] = "(a5,i"; +#line 18657 "" + i__2 = nfmt + 48; +#line 18657 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 18657 "" + i__1[1] = 1, a__1[1] = ch__2; +#line 18657 "" + i__1[2] = 3, a__1[2] = ",$)"; +#line 18657 "" + ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); +#line 18657 "" + s_wsfe(&ci__1); +#line 18657 "" + do_fio(&c__1, " Bar", (ftnlen)5); +#line 18657 "" + do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 18657 "" + e_wsfe(); +#line 18658 "" + ci__1.cierr = 0; +#line 18658 "" + ci__1.ciunit = 15; +/* Writing concatenation */ +#line 18658 "" + i__1[0] = 5, a__1[0] = "(a5,i"; +#line 18658 "" + i__2 = nfmt + 48; +#line 18658 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 18658 "" + i__1[1] = 1, a__1[1] = ch__2; +#line 18658 "" + i__1[2] = 3, a__1[2] = ",$)"; +#line 18658 "" + ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1); +#line 18658 "" + s_wsfe(&ci__1); +#line 18658 "" + do_fio(&c__1, " Bar", (ftnlen)5); +#line 18658 "" + do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 18658 "" + e_wsfe(); +#line 18659 "" + *jlast = *jlast + 5 + nfmt; +#line 18660 "" + } else { +#line 18661 "" + ci__1.cierr = 0; +#line 18661 "" + ci__1.ciunit = 6; +/* Writing concatenation */ +#line 18661 "" + i__1[0] = 7, a__1[0] = "(/,a5,i"; +#line 18661 "" + i__2 = nfmt + 48; +#line 18661 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 18661 "" + i__1[1] = 1, a__1[1] = ch__2; +#line 18661 "" + i__1[2] = 3, a__1[2] = ",$)"; +#line 18661 "" + ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); +#line 18661 "" + s_wsfe(&ci__1); +#line 18661 "" + do_fio(&c__1, " Bar", (ftnlen)5); +#line 18661 "" + do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 18661 "" + e_wsfe(); +#line 18662 "" + ci__1.cierr = 0; +#line 18662 "" + ci__1.ciunit = 15; +/* Writing concatenation */ +#line 18662 "" + i__1[0] = 7, a__1[0] = "(/,a5,i"; +#line 18662 "" + i__2 = nfmt + 48; +#line 18662 "" + chax_(ch__2, (ftnlen)1, &i__2); +#line 18662 "" + i__1[1] = 1, a__1[1] = ch__2; +#line 18662 "" + i__1[2] = 3, a__1[2] = ",$)"; +#line 18662 "" + ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3); +#line 18662 "" + s_wsfe(&ci__1); +#line 18662 "" + do_fio(&c__1, " Bar", (ftnlen)5); +#line 18662 "" + do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer)); +#line 18662 "" + e_wsfe(); +#line 18663 "" + *jlast = nfmt + 5; +#line 18664 "" + } +#line 18665 "" + return 0; +} /* outbar_ */ + +/* Subroutine */ int pmxa_(char *basenameq, integer *lbase, logical *isfirst, + integer *nsyout, integer *nbarss, logical *optimize, ftnlen + basenameq_len) +{ + /* Initialized data */ + + static real wtimesig = .72f; + static real wclef = .8f; + static real wkeysig = .28f; + + /* System generated locals */ + integer i__1, i__2, i__3, i__4, i__5, i__6; + real r__1, r__2, r__3, r__4; + doublereal d__1, d__2; + olist o__1; + cllist cl__1; + alist al__1; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void), f_open(olist *), f_clos(cllist *), i_nint(real *); + double pow_dd(doublereal *, doublereal *); + integer f_rew(alist *); + + /* Local variables */ + extern /* Subroutine */ int g1etnote_(logical *, integer *, logical *, + logical *); + extern integer i1fnodur_(integer *, char *, ftnlen); + extern /* Subroutine */ int makeabar_(void); + static real xmtrnum0, heightil; + extern /* Subroutine */ int findeonk_(integer *, integer *, real *, real * + , real *, real *, real *); + static real elsstarg; + static logical cstuplet; + static real c__, d__; + static integer j, listcresc; + extern /* Subroutine */ int getpmxmod_(logical *, char *, ftnlen); + static integer isysendpg; + static logical fulltrans; + static integer ip, nomnsystp, kv; + static real xn; + static integer nns, isy, listdecresc, key1, key2; + static real diff; + static integer iflb, ifig, ifpb, ioff; + extern doublereal feon_(real *); + static real elsk[3999]; + static integer ikey; + static real elss[125]; + static logical loop; + static real wdpt; + static integer iptr; + static real diff1; + static integer ibar1; + extern doublereal f1eon_(real *); + extern /* Subroutine */ int stop1_(void); + static integer ipage, naccs; + static real celsk[4000]; + static logical newmb[3999]; + static integer ibars; + static real dtmin, dtmax, xelsk, wmins; + static integer ivnow, ibarb4; + static real fsyst; + static integer isyst; + static real elmin0, elmin1; + static integer isysb4; + static real omegag, facins, glueil; + extern /* Subroutine */ int outbar_(integer *, integer *); + static integer jprntb, nintpg, mtrdnp; + extern /* Subroutine */ int printl_(char *, ftnlen); + static real poenom; + static integer mtrnmp, nshort; + static real wminpt, celskb4, xiltxt; + static integer nsystp; + static real wsyspt; + extern /* Subroutine */ int g1etset_(integer *, integer *, integer *, + integer *, integer *, integer *, real *, integer *, integer *, + integer *, integer *, logical *); + static integer lenbeat, lastbar[126]; + static real xilfrac; + static integer iflbnow; + static logical bottreb; + static integer mtrdenl, imovbrk, lenmult, iscount; + static real sumelsk; + static integer instnow, nsystpp; + + /* Fortran I/O blocks */ + static cilist io___1158 = { 0, 6, 0, 0, 0 }; + static cilist io___1159 = { 0, 6, 0, 0, 0 }; + static cilist io___1160 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1161 = { 0, 19, 0, "(i6)", 0 }; + static cilist io___1173 = { 0, 6, 0, 0, 0 }; + static cilist io___1177 = { 0, 6, 0, 0, 0 }; + static cilist io___1183 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1184 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1189 = { 0, 6, 0, 0, 0 }; + static cilist io___1191 = { 0, 6, 0, 0, 0 }; + static cilist io___1192 = { 0, 6, 0, 0, 0 }; + static cilist io___1193 = { 0, 6, 0, 0, 0 }; + static cilist io___1194 = { 0, 15, 0, "(a,2i5)", 0 }; + static cilist io___1195 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1197 = { 0, 12, 0, "(a)", 0 }; + static cilist io___1198 = { 0, 12, 0, 0, 0 }; + static cilist io___1199 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 }; + static cilist io___1200 = { 0, 12, 0, 0, 0 }; + static cilist io___1219 = { 0, 12, 0, 0, 0 }; + static cilist io___1234 = { 0, 12, 0, "(i5)", 0 }; + static cilist io___1252 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 }; + static cilist io___1253 = { 0, 13, 0, "(i5)", 0 }; + static cilist io___1254 = { 0, 6, 0, "(/,a)", 0 }; + static cilist io___1255 = { 0, 6, 0, 0, 0 }; + static cilist io___1256 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___1257 = { 0, 15, 0, "()", 0 }; + + +/* ccccccccccccccccccccccccccccccccccccccccccccccc */ +/* c cc */ +/* c Subroutine, combine with pmxb.for */ +/* c */ +/* ccccccccccccccccccccccccccccccccccccccccccccccc */ +/* c */ +/* c Need to consider X spaces in xtuplets when getting poenom, and */ +/* c maybe fbar? */ +/* c mx06a */ +/* c ID numbers for voices when number of voices is reduced. */ +/* c */ +/* c mx03a */ +/* c account for new fracindent for new movements. */ +/* c */ +/* c Known changes since pmxa. Version 1.1b (see pmxb for longer list) */ +/* c */ +/* c Check ID codes for slurs. */ +/* c Version 1.24 still does not have details for spacing/positioning */ +/* c arpeggios if there are accidentals or shifted notes or crowded scores. */ +/* c Fix problem in 1.22 with arpeggios across multi-line staves */ +/* c Fix problem in 1.22 with flat key signatures */ +/* c Read setup data as strings */ +/* c Warning for octave designation plus +/- */ +/* c Don't pause for volta warning, */ +/* c Macros */ +/* c Correct fsyst to account for transposition and key changes. */ +/* c Check for nbars > nsyst */ +/* c */ +/* cccccccccccccccccccccccccccccccccc */ +/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */ +/* logical mrecord,mplay,endmac,gotclef,cstuplet */ +#line 18748 "" + /* Parameter adjustments */ +#line 18748 "" + --nbarss; +#line 18748 "" + +#line 18748 "" + /* Function Body */ +#line 18750 "" + commus_1.whead20 = .3f; +#line 18751 "" + if (! (*optimize)) { +#line 18752 "" + s_wsle(&io___1158); +#line 18752 "" + e_wsle(); +#line 18753 "" + s_wsle(&io___1159); +#line 18753 "" + do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23); +#line 18753 "" + e_wsle(); +#line 18754 "" + s_wsfe(&io___1160); +#line 18754 "" + do_fio(&c__1, " Starting first PMX pass", (ftnlen)24); +#line 18754 "" + e_wsfe(); +#line 18755 "" + } +#line 18756 "" + if (*isfirst) { +#line 18757 "" + o__1.oerr = 0; +#line 18757 "" + o__1.ounit = 19; +#line 18757 "" + o__1.ofnmlen = 11; +#line 18757 "" + o__1.ofnm = "pmxaerr.dat"; +#line 18757 "" + o__1.orl = 0; +#line 18757 "" + o__1.osta = 0; +#line 18757 "" + o__1.oacc = 0; +#line 18757 "" + o__1.ofm = 0; +#line 18757 "" + o__1.oblnk = 0; +#line 18757 "" + f_open(&o__1); +#line 18758 "" + s_wsfe(&io___1161); +#line 18758 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 18758 "" + e_wsfe(); +#line 18759 "" + cl__1.cerr = 0; +#line 18759 "" + cl__1.cunit = 19; +#line 18759 "" + cl__1.csta = 0; +#line 18759 "" + f_clos(&cl__1); +#line 18760 "" + } +#line 18761 "" + if (! (*optimize)) { +#line 18761 "" + jprntb = 81; +#line 18761 "" + } +#line 18762 "" + commac_1.macuse = 0; +#line 18763 "" + comkeys_1.ornrpt = FALSE_; +#line 18764 "" + comkeys_1.stickys = FALSE_; +#line 18765 "" + commac_1.mrecord = FALSE_; +#line 18766 "" + commac_1.mplay = FALSE_; +#line 18767 "" + c1omget_1.lastchar = FALSE_; +#line 18768 "" + comnvst_2.novshrinktop = FALSE_; +#line 18769 "" + cstuplet = FALSE_; +#line 18770 "" + comslur_1.fontslur = TRUE_; +#line 18771 "" + comligfont_1.isligfont = FALSE_; +#line 18772 "" + fulltrans = FALSE_; +#line 18773 "" + for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999; + ++c1omnotes_1.ibarcnt) { +#line 18774 "" + c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f; +#line 18775 "" + c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f; +#line 18776 "" +/* L42: */ +#line 18776 "" + } + +/* Initialize input buffer */ + +#line 18780 "" + c1omget_1.lenbuf0 = inbuff_1.ipbuf; +#line 18781 "" + inbuff_1.ipbuf = 0; +#line 18782 "" + inbuff_1.ilbuf = 1; +#line 18783 "" + 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 18788 "" + ivnow = 0; +#line 18789 "" + i__1 = comkeys_1.noinst; +#line 18789 "" + for (instnow = 1; instnow <= i__1; ++instnow) { +#line 18790 "" + i__2 = c1omget_1.nsperi[instnow - 1]; +#line 18790 "" + for (iscount = 1; iscount <= i__2; ++iscount) { +#line 18791 "" + ++ivnow; +#line 18792 "" + cominsttrans_1.instno[ivnow - 1] = instnow; +#line 18793 "" +/* L14: */ +#line 18793 "" + } +#line 18794 "" +/* L13: */ +#line 18794 "" + } + +/* Save initial meter for midi */ + +#line 18798 "" + if (! (*isfirst) && compage_1.npages == 0) { +#line 18799 "" + s_wsle(&io___1173); +#line 18799 "" + do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", ( + ftnlen)43); +#line 18799 "" + e_wsle(); +#line 18800 "" + stop1_(); +#line 18801 "" + } +#line 18802 "" + *nsyout = compage_1.nsyst; + +/* isig1 will be changed in getnote if there is a transposition */ + +#line 18806 "" + comkeys_1.isig1 = comkeys_1.newkey[0]; +#line 18807 "" + if (compage_1.npages > compage_1.nsyst) { +#line 18808 "" + printl_("npages > nsyst in input. Please fix the input.", (ftnlen)47) + ; +#line 18809 "" + stop1_(); +#line 18810 "" + } + +/* fbar = afterruleskip/elemskip */ +/* apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */ + +#line 18815 "" + c1ommvl_1.fbar = 1.f; +#line 18816 "" + c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize; +#line 18817 "" + ifig = 0; +#line 18818 "" + compage_1.usefig = TRUE_; +#line 18819 "" + lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1); +#line 18820 "" + lenmult = 1; +#line 18821 "" + if (mtrdenl == 2) { +#line 18822 "" + lenbeat = 16; +#line 18823 "" + lenmult = 2; +#line 18824 "" + } +#line 18825 "" + a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat; +#line 18826 "" + r__1 = lenmult * xmtrnum0 * lenbeat; +#line 18826 "" + a1ll_2.lenbr0 = i_nint(&r__1); +#line 18827 "" + a1ll_2.mtrnuml = 0; +#line 18828 "" + if (a1ll_2.lenbr0 != 0) { +#line 18829 "" + c1omnotes_1.ibaroff = 1; +#line 18830 "" + a1ll_2.lenbar = a1ll_2.lenbr0; +#line 18831 "" + } else { +#line 18832 "" + c1omnotes_1.ibaroff = 0; +#line 18833 "" + a1ll_2.lenbar = a1ll_2.lenbr1; +#line 18834 "" + } +#line 18835 "" + c1omnotes_1.ibarcnt = 0; +#line 18836 "" + c1omnotes_1.nptr[0] = 1; +#line 18837 "" + a1ll_2.iccount = 128; +#line 18838 "" + compage_1.nmovbrk = 0; +#line 18839 "" + compage_1.nflb = 0; +#line 18840 "" + compage_1.nfpb = 0; +#line 18841 "" + compage_1.ipagfpb[0] = 1; +#line 18842 "" + compage_1.isysfpb[0] = 1; +#line 18843 "" + compage_1.ibarflb[0] = 1; +#line 18844 "" + compage_1.isysflb[0] = 1; +#line 18845 "" + compage_1.nistaff[0] = a1ll_2.nv - 1; + +/* Check for pmx.mod */ + +#line 18849 "" + c1omget_1.linesinpmxmod = 0; +/* line1pmxmod = ilbuf */ +#line 18851 "" + getpmxmod_(&c_true, " ", (ftnlen)1); +#line 18852 "" + if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) { +#line 18853 "" + s_wsle(&io___1177); +#line 18853 "" + do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"\ + "ile", (ftnlen)49); +#line 18853 "" + e_wsle(); +#line 18854 "" + stop1_(); +#line 18855 "" + } + +/* Initialize for loop over lines */ + +#line 18859 "" + comkeys_1.nkeys = 1; +#line 18860 "" + comkeys_1.ibrkch[0] = 1; +#line 18861 "" + comkeys_1.mbrestsav = 0; +#line 18862 "" + comkeys_1.shifton = FALSE_; +#line 18863 "" + a1ll_2.firstline = TRUE_; +#line 18864 "" + a1ll_2.newmeter = FALSE_; +#line 18865 "" + c1omget_1.ihead = 0; +#line 18866 "" + c1omget_1.isheadr = FALSE_; +/* gotclef = .false. */ +#line 18868 "" + comkeys_1.idsig = 0; +#line 18869 "" + c1omnotes_1.iddot = 0; +#line 18870 "" + compage_1.fintstf = -1.f; +#line 18871 "" + compage_1.gintstf = 1.f; +#line 18872 "" + listcresc = 0; +#line 18873 "" + listdecresc = 0; +#line 18874 "" +L30: +#line 18874 "" + loop = TRUE_; +#line 18875 "" + comkeys_1.iskchb = FALSE_; +#line 18876 "" + c1omget_1.issegno = FALSE_; +#line 18877 "" + a1ll_2.nbars = 0; +#line 18878 "" + c1omnotes_1.ibarmbr = 0; +#line 18879 "" + i__1 = a1ll_2.nv; +#line 18879 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) { +#line 18880 "" + c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1; +#line 18881 "" + c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv; +#line 18882 "" + a1ll_2.itsofar[a1ll_2.iv - 1] = 0; +#line 18883 "" + a1ll_2.nnl[a1ll_2.iv - 1] = 0; +#line 18884 "" + for (j = 1; j <= 200; ++j) { +#line 18885 "" + a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_; +#line 18886 "" + c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f; +#line 18887 "" +/* L5: */ +#line 18887 "" + } +#line 18888 "" +/* L4: */ +#line 18888 "" + } +#line 18889 "" + a1ll_2.iv = 1; +#line 18890 "" + c1ommvl_1.ivx = 1; +#line 18891 "" + c1omget_1.fbon = FALSE_; +#line 18892 "" + comkeys_1.barend = FALSE_; +#line 18893 "" + c1omget_1.isvolt = FALSE_; +#line 18894 "" +L2: +#line 18894 "" + if (loop) { + +/* Within this short loop, nv voices are filled up for the duration of a block. */ +/* On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) */ +/* nodur(..),rest(..). nnl will later be */ +/* increased and things slid around as accidental skips are added. */ + +#line 18901 "" + g1etnote_(&loop, &ifig, optimize, &fulltrans); +#line 18902 "" + if (c1omget_1.lastchar) { +#line 18902 "" + goto L20; +#line 18902 "" + } +#line 18903 "" + goto L2; +#line 18904 "" + } +#line 18905 "" + if (comkeys_1.mbrestsav > 0) { +#line 18906 "" + printl_(" ", (ftnlen)1); +#line 18907 "" + printl_("You must enter the same multibar rest in ALL parts", (ftnlen) + 50); +#line 18909 "" + stop1_(); +#line 18910 "" + } +#line 18911 "" + i__1 = a1ll_2.nbars; +#line 18911 "" + for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { +#line 18912 "" + ++c1omnotes_1.ibarcnt; + +/* The following is just a signal to start a new bar when cataloging spaces */ +/* for catspace(...) */ + +#line 18917 "" + c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[ + c1omnotes_1.ibarcnt - 1]; +#line 18918 "" + newmb[c1omnotes_1.ibarcnt - 1] = FALSE_; +#line 18919 "" + if (a1ll_2.newmeter && a1ll_2.ibar == 1) { +#line 18919 "" + newmb[c1omnotes_1.ibarcnt - 1] = TRUE_; +#line 18919 "" + } + +/* Above is only for spacing calcs later on. Remember new meter can only occur */ +/* at START of a new input line (ibar = 1) */ + +#line 18924 "" + if (a1ll_2.ibar != c1omnotes_1.ibarmbr) { +#line 18925 "" + if (! (*optimize)) { +#line 18925 "" + i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 18925 "" + outbar_(&i__2, &jprntb); +#line 18925 "" + } +#line 18926 "" + } else { +#line 18927 "" + if (! (*optimize)) { +#line 18928 "" + s_wsfe(&io___1183); +#line 18928 "" + do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 18928 "" + i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 18928 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 18928 "" + do_fio(&c__1, "-", (ftnlen)1); +#line 18928 "" + i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + c1omnotes_1.mbrest - 1; +#line 18928 "" + do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); +#line 18928 "" + e_wsfe(); +#line 18930 "" + s_wsfe(&io___1184); +#line 18930 "" + do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 18930 "" + i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff; +#line 18930 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 18930 "" + do_fio(&c__1, "-", (ftnlen)1); +#line 18930 "" + i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + + c1omnotes_1.mbrest - 1; +#line 18930 "" + do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer)); +#line 18930 "" + e_wsfe(); +#line 18932 "" + jprntb = 0; +#line 18933 "" + } +#line 18934 "" + c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest + + 1; +#line 18935 "" + } +#line 18936 "" + if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) { +#line 18937 "" + if (a1ll_2.ibar == 1) { +#line 18938 "" + a1ll_2.lenbar = a1ll_2.lenbr0; +#line 18939 "" + } else { +#line 18940 "" + a1ll_2.lenbar = a1ll_2.lenbr1; +#line 18941 "" + } +#line 18942 "" + } +#line 18943 "" + if (a1ll_2.ibar > 1) { + +/* For bars after first, slide all stuff down to beginning of arrays */ + +#line 18947 "" + i__2 = a1ll_2.nv; +#line 18947 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) { +#line 18948 "" + i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 18948 "" + for (kv = 1; kv <= i__3; ++kv) { +#line 18949 "" + c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]; +#line 18950 "" + ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24 + - 25]; +#line 18951 "" + i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25] + - ioff; +#line 18951 "" + for (ip = 1; ip <= i__4; ++ip) { +#line 18952 "" + a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] = + a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24 + - 25]; +#line 18953 "" + a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] = + a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24 + - 25]; +#line 18954 "" + c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] = + c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) * + 24 - 25]; +#line 18955 "" +/* L12: */ +#line 18955 "" + } +#line 18956 "" +/* L11: */ +#line 18956 "" + } +#line 18956 "" + } +#line 18957 "" + } +#line 18958 "" + i__3 = a1ll_2.nv; +#line 18958 "" + for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) { +#line 18959 "" + i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1]; +#line 18959 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 18960 "" + ioff = 0; +#line 18961 "" + if (a1ll_2.ibar > 1) { +#line 18961 "" + ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25] + + (a1ll_2.ibar - 1) * 24 - 25]; +#line 18961 "" + } +#line 18962 "" +/* L67: */ +#line 18962 "" + } +#line 18962 "" + } +#line 18963 "" + makeabar_(); +#line 18964 "" + elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar; +#line 18965 "" +/* L10: */ +#line 18965 "" + } +#line 18966 "" + a1ll_2.newmeter = FALSE_; +#line 18967 "" + a1ll_2.firstline = FALSE_; +#line 18968 "" + goto L30; +#line 18969 "" +L20: + +/* Vertical analysis. */ + +#line 18973 "" + if (compage_1.npages == 0) { +#line 18974 "" + if (compage_1.nsyst == 0) { +#line 18975 "" + s_wsle(&io___1189); +#line 18975 "" + do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"\ + "ot 0", (ftnlen)46); +#line 18975 "" + e_wsle(); +#line 18976 "" + stop1_(); +#line 18977 "" + } +#line 18978 "" + compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1; +#line 18979 "" + if (a1ll_2.nv == 1) { +#line 18980 "" + nsystpp = 12; +#line 18981 "" + } else if (a1ll_2.nv == 2) { +#line 18982 "" + nsystpp = 7; +#line 18983 "" + } else if (a1ll_2.nv == 3) { +#line 18984 "" + nsystpp = 5; +#line 18985 "" + } else if (a1ll_2.nv == 4) { +#line 18986 "" + nsystpp = 3; +#line 18987 "" + } else if (a1ll_2.nv <= 7) { +#line 18988 "" + nsystpp = 2; +#line 18989 "" + } else { +#line 18990 "" + nsystpp = 1; +#line 18991 "" + } +#line 18992 "" + compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1; +#line 18993 "" + } + +/* Check nsyst vs ibarcnt */ + +#line 18997 "" + if (compage_1.nsyst > c1omnotes_1.ibarcnt) { +#line 18998 "" + s_wsle(&io___1191); +#line 18998 "" + e_wsle(); +#line 18999 "" + s_wsle(&io___1192); +#line 18999 "" + do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14); +#line 18999 "" + do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer) + ); +#line 18999 "" + do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof( + integer)); +#line 18999 "" + e_wsle(); +#line 19000 "" + s_wsle(&io___1193); +#line 19000 "" + do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33); +#line 19000 "" + e_wsle(); +#line 19001 "" + s_wsfe(&io___1194); +#line 19001 "" + do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15); +#line 19001 "" + do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); +#line 19001 "" + do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer)); +#line 19001 "" + e_wsfe(); +#line 19002 "" + s_wsfe(&io___1195); +#line 19002 "" + do_fio(&c__1, " There are more systems than bars.", (ftnlen)34); +#line 19002 "" + e_wsfe(); +#line 19003 "" + stop1_(); +#line 19004 "" + } + +/* Set up dummy forced line & page breaks after last real one */ + +#line 19008 "" + ++compage_1.nflb; +#line 19009 "" + compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1; +#line 19010 "" + compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1; +#line 19011 "" + ++compage_1.nfpb; +#line 19012 "" + compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1; +#line 19013 "" + compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1; +#line 19014 "" + heightil = compage_1.ptheight * 4.f / commus_1.musize; +#line 19015 "" + o__1.oerr = 0; +#line 19015 "" + o__1.ounit = 12; +#line 19015 "" + o__1.ofnm = 0; +#line 19015 "" + o__1.orl = 0; +#line 19015 "" + o__1.osta = "SCRATCH"; +#line 19015 "" + o__1.oacc = 0; +#line 19015 "" + o__1.ofm = 0; +#line 19015 "" + o__1.oblnk = 0; +#line 19015 "" + f_open(&o__1); +#line 19016 "" + s_wsfe(&io___1197); +#line 19016 "" + do_fio(&c__1, basenameq, (*lbase)); +#line 19016 "" + e_wsfe(); +#line 19017 "" + s_wsle(&io___1198); +#line 19017 "" + do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer)); +#line 19017 "" + e_wsle(); + +/* Pass to pmxb the initial signature, including effect of transposition. */ + +#line 19021 "" + s_wsfe(&io___1199); +#line 19021 "" + do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real)); +#line 19021 "" + do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)); +#line 19021 "" + do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer)); +#line 19021 "" + do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer)); +#line 19021 "" + e_wsfe(); +#line 19023 "" + s_wsle(&io___1200); +#line 19023 "" + do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer)); +#line 19023 "" + do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real)); +#line 19023 "" + do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real)); +#line 19023 "" + do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real)); +#line 19023 "" + do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real)); +#line 19023 "" + do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)); +#line 19023 "" + e_wsle(); +#line 19024 "" + iflbnow = -1; +#line 19025 "" + isysb4 = 0; +#line 19026 "" + i__1 = compage_1.nfpb; +#line 19026 "" + for (ifpb = 1; ifpb <= i__1; ++ifpb) { + +/* Each time thru this loop is like a single score with several pages */ + +#line 19030 "" + compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb - + 1]; +#line 19031 "" + compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb - + 1]; +#line 19032 "" + nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1; +#line 19033 "" + nshort = nomnsystp * compage_1.npages - compage_1.nsyst; +#line 19034 "" + i__2 = compage_1.npages; +#line 19034 "" + for (ipage = 1; ipage <= i__2; ++ipage) { +#line 19035 "" + nsystp = nomnsystp; +#line 19036 "" + if (ipage <= nshort) { +#line 19036 "" + --nsystp; +#line 19036 "" + } + +/* Last system number on this page: */ +#line 19039 "" + isysendpg = isysb4 + nsystp; +#line 19040 "" + nintpg = 0; +#line 19041 "" + i__3 = isysendpg; +#line 19041 "" + for (isy = isysb4 + 1; isy <= i__3; ++isy) { +#line 19042 "" + if (compage_1.isysflb[iflbnow + 1] == isy) { +#line 19042 "" + ++iflbnow; +#line 19042 "" + } +#line 19043 "" + nintpg += compage_1.nistaff[iflbnow]; +#line 19044 "" +/* L15: */ +#line 19044 "" + } +#line 19045 "" + xilfrac = 0.f; +#line 19046 "" + xiltxt = 0.f; +#line 19047 "" + if (ipage == 1 && c1omget_1.ihead > 0) { + +/* Needn't zero out ihead after printing titles if we only allow titles at top? */ + +#line 19051 "" + if ((c1omget_1.ihead & 1) == 1) { +#line 19052 "" + xiltxt += cblock_1.hgtin * 4 / commus_1.musize; +#line 19053 "" + xilfrac += cblock_1.etait; +#line 19054 "" + } +#line 19055 "" + if ((c1omget_1.ihead & 2) == 2) { +#line 19056 "" + xiltxt += cblock_1.hgtti * 4 / commus_1.musize; +#line 19057 "" + xilfrac += cblock_1.etatc; +#line 19058 "" + } +#line 19059 "" + if ((c1omget_1.ihead & 4) == 4) { +#line 19060 "" + xiltxt += cblock_1.hgtco * 4 / commus_1.musize; +#line 19061 "" + xilfrac += cblock_1.etacs1; +#line 19062 "" + } else { + +/* Use double the title-composer space if there is no composer */ + +#line 19066 "" + xilfrac += cblock_1.etatc; +#line 19067 "" + } +#line 19068 "" + } +#line 19069 "" + d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot; +/* C = nsystp*(nv-1) */ +#line 19071 "" + c__ = (real) nintpg; +/* xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */ +#line 19073 "" + xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) * + cblock_1.xilbn; +#line 19074 "" + if (bottreb) { +#line 19074 "" + xn -= (nsystp - 1) * cblock_1.xilbtc; +#line 19074 "" + } +#line 19075 "" + if (c1omget_1.ihead == 0 && c1omget_1.isheadr) { +#line 19075 "" + xn -= cblock_1.xilhdr; +#line 19075 "" + } +#line 19076 "" + if (ifig == 1) { +#line 19077 "" + xn -= nsystp * cblock_1.xilfig; +#line 19078 "" + } +#line 19079 "" + glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__); +#line 19080 "" + omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a + * c__); + +/* G = \interlines between systems */ +/* omega*G = \interlines between staves of the same system */ +/* \interstaff = 4+omega*G */ +/* C = total number of interstaff spaces in the page */ +/* D = omega-indep factors for scalable height = nsy-1 (intersystem glue) */ +/* + etatop + etabot + etatxt + */ +/* N = scaleable height (\interlignes) = height - htext - staff heights - xil */ +/* xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles */ +/* + (nsy-1)*xiltcb for treble clef bottoms */ +/* + nsy*xilfig for figures */ +/* G = N/(D + omega * C) = glueil, (1) */ +/* But (empirically) omega*G = a*G + b (2) */ +/* with a=1.071 and b=2.714 */ +/* Solving (1) and (2) gives */ +/* G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C) */ +/* Pass to pmxb omega*G (=\interstaff-4) */ +/* (etatop,bot,it,tc,cx)*G as inputs to \titles */ + +/* glueil = (heightil-xiltxt-nsystp*(xil+4*nv)) */ +/* * /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac) */ +/* xnsttop = glueil*etatop */ +/* xintstaff = 4+gfact*glueil */ + +/* Only the first page will get local adjustment now if needed, others in pmxb */ + +#line 19107 "" + if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) { +#line 19108 "" + facins = compage_1.fintstf; +#line 19109 "" + compage_1.fintstf = -1.f; +#line 19110 "" + } else { + +/* gintstf = 1.0 by default, but may be changed with AI<x> */ + +#line 19114 "" + facins = compage_1.gintstf; +#line 19115 "" + } +#line 19116 "" + s_wsle(&io___1219); +#line 19116 "" + do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer)); +/* Computing MAX */ +#line 19116 "" + r__2 = 0.f, r__3 = cblock_1.etatop * glueil; +#line 19116 "" + r__1 = dmax(r__2,r__3); +#line 19116 "" + do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 19116 "" + r__4 = facins * (omegag + 4); +#line 19116 "" + do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real)); +#line 19116 "" + e_wsle(); +#line 19117 "" + c1omget_1.ihead = 0; +#line 19118 "" + c1omget_1.isheadr = FALSE_; +#line 19119 "" + isysb4 = isysendpg; +#line 19120 "" +/* L7: */ +#line 19120 "" + } +#line 19121 "" +/* L8: */ +#line 19121 "" + } + +/* Done with vertical, now do horizontals */ + +#line 19125 "" + celsk[1] = elsk[0]; +#line 19126 "" + i__1 = c1omnotes_1.ibarcnt; +#line 19126 "" + for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) { +#line 19127 "" + celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1]; +#line 19128 "" +/* L21: */ +#line 19128 "" + } +#line 19129 "" + lastbar[0] = 0; +#line 19130 "" + ibar1 = 1; +#line 19131 "" + wmins = -1.f; +#line 19132 "" + iflb = 1; +#line 19133 "" + imovbrk = 0; +#line 19134 "" + ikey = 1; + +/* Return nsyst to its *total* value */ + +#line 19138 "" + compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1; +#line 19139 "" + i__1 = compage_1.nsyst; +#line 19139 "" + for (isyst = 1; isyst <= i__1; ++isyst) { +#line 19140 "" + if (isyst == compage_1.isysflb[iflb]) { +#line 19140 "" + ++iflb; +#line 19140 "" + } +#line 19141 "" + if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) { +#line 19142 "" + if (isyst == compage_1.isysmb[imovbrk + 1]) { +#line 19142 "" + ++imovbrk; +#line 19142 "" + } +#line 19143 "" + } +#line 19144 "" + ibarb4 = lastbar[isyst - 1]; +#line 19145 "" + if (isyst == 1) { +#line 19146 "" + if (*isfirst) { +#line 19146 "" + elsstarg = celsk[compage_1.ibarflb[1] - 1] / ( + compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1 + - c1omget_1.fracindent); +#line 19146 "" + } +#line 19148 "" + celskb4 = 0.f; +#line 19149 "" + } else { +#line 19150 "" + celskb4 = celsk[ibarb4]; + +/* Must dimension isysmb(0:*) just so I can execute this test! */ + +#line 19154 "" + if (*isfirst) { +#line 19155 "" + if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[ + imovbrk]) { + +/* First syst after forced line break. There may be indentation. */ + +#line 19159 "" + 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 19162 "" + } else { + +/* There is no indentation to deal with */ + +#line 19166 "" + elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4) + / (compage_1.isysflb[iflb] - isyst); +#line 19168 "" + } +#line 19169 "" + } +#line 19170 "" + } +#line 19171 "" + if (*isfirst) { +#line 19172 "" + diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1)); +#line 19173 "" + i__2 = c1omnotes_1.ibarcnt; +#line 19173 "" + for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) + { +#line 19174 "" + diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4); +#line 19175 "" + if (dabs(diff) >= diff1) { +#line 19175 "" + goto L24; +#line 19175 "" + } +#line 19176 "" + diff1 = dabs(diff); +#line 19177 "" +/* L23: */ +#line 19177 "" + } +#line 19178 "" +L24: +#line 19178 "" + --a1ll_2.ibar; +#line 19179 "" + lastbar[isyst] = a1ll_2.ibar; +#line 19180 "" + nbarss[isyst] = a1ll_2.ibar - ibarb4; +#line 19181 "" + } else { + +/* nbarss is given as an input, must compute lastbar and ibar */ + +#line 19185 "" + lastbar[isyst] = nbarss[isyst] + ibarb4; +#line 19186 "" + a1ll_2.ibar = lastbar[isyst]; +#line 19187 "" + } + +/* elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */ + +#line 19191 "" + elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4; +#line 19192 "" + s_wsfe(&io___1234); +#line 19192 "" + i__2 = lastbar[isyst - 1] + 1; +#line 19192 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 19192 "" + e_wsfe(); + +/* Transposed sigs are isig1, newkey(2,3,...). */ + +#line 19196 "" + if (ikey == 1) { +#line 19197 "" + key1 = comkeys_1.isig1; +#line 19198 "" + } else { +#line 19199 "" + key1 = comkeys_1.newkey[ikey - 1]; +#line 19200 "" + } +#line 19201 "" + fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize; +#line 19202 "" + xelsk = 0.f; +#line 19203 "" +L1: +#line 19203 "" + if (ikey < comkeys_1.nkeys) { +#line 19204 "" + if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) { + +/* Add space for all key changes */ + +#line 19208 "" + ++ikey; +#line 19209 "" + key2 = comkeys_1.newkey[ikey - 1]; +/* Computing MAX */ +/* Computing MAX */ +#line 19210 "" + i__5 = abs(key1), i__6 = abs(key2); +#line 19210 "" + i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6); +#line 19210 "" + naccs = max(i__3,i__4); +#line 19211 "" + fsyst += naccs * wkeysig; + +/* Account for afterruleskips (fbar) */ + +#line 19215 "" + xelsk += c1ommvl_1.fbar / 2; +#line 19216 "" + if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && ! + comkeys_1.kchmid[ikey - 1]) { +#line 19216 "" + xelsk += -1.f; +#line 19216 "" + } +#line 19218 "" + key1 = key2; +#line 19219 "" + goto L1; +#line 19220 "" + } +#line 19221 "" + } + +/* Add extra fixed space for double bar */ + +#line 19225 "" + if (isyst == compage_1.nsyst) { +#line 19226 "" + fsyst += 4.5f / commus_1.musize; +#line 19227 "" + } + +/* Add extra fixed space for initial time signature */ + +#line 19231 "" + if (isyst == 1) { +#line 19232 "" + fsyst += wtimesig; +#line 19233 "" + } + +/* Add extra fixed space for time signature changes & user-defined spaces */ + +#line 19237 "" + i__2 = lastbar[isyst]; +#line 19237 "" + for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) { +#line 19238 "" + if (newmb[ibars - 1]) { +#line 19238 "" + fsyst += wtimesig; +#line 19238 "" + } +#line 19239 "" + fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize; +#line 19240 "" +/* L26: */ +#line 19240 "" + } +#line 19241 "" + if (isyst == 1) { +#line 19242 "" + wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent); +#line 19243 "" + } else { +#line 19244 "" + if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == + compage_1.isysmb[imovbrk]) { +#line 19246 "" + wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1] + ); +#line 19247 "" + } else { +#line 19248 "" + wdpt = compage_1.widthpt; +#line 19249 "" + } +#line 19250 "" + } +#line 19251 "" + wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f; + +/* Checks for min spacing */ +/* Get min allowable space */ + +#line 19256 "" + dtmin = 1e3f; +#line 19257 "" + i__2 = ibar1 + nbarss[isyst] - 1; +#line 19257 "" + for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) { +/* Computing MIN */ +#line 19258 "" + r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1]; +#line 19258 "" + dtmin = dmin(r__1,r__2); +#line 19259 "" + if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) { +#line 19259 "" + wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1]; +#line 19259 "" + } +#line 19260 "" +/* L45: */ +#line 19260 "" + } +#line 19261 "" + if (wmins < 0.f) { +#line 19261 "" + wmins = .3f; +#line 19261 "" + } +#line 19262 "" + wminpt = (wmins + 1) * .3f * commus_1.musize; + +/* Find max duration & # of notes for this system */ + +#line 19266 "" + dtmax = 0.f; +#line 19267 "" + nns = 0; +#line 19268 "" + i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 19268 "" + for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { +/* Computing MAX */ +#line 19269 "" + r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1]; +#line 19269 "" + dtmax = dmax(r__1,r__2); +#line 19270 "" + nns += c1omnotes_1.nnpd[iptr - 1]; +#line 19271 "" +/* L43: */ +#line 19271 "" + } +#line 19272 "" + elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk); +#line 19273 "" + if (elmin0 >= wminpt) { + +/* Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */ +/* there is no need to "flatten" */ + +#line 19278 "" + sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst]; +#line 19279 "" + comeon_1.eonk = 0.f; +#line 19280 "" + comeon_1.ewmxk = 1.f; +#line 19281 "" + } else { +#line 19282 "" + elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) / + f1eon_(&dtmax) + nns); +#line 19283 "" + 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 19288 "" + comeon_1.eonk = .9f; +#line 19289 "" + } else { + +/* Find eonk by Newton method */ + +/* eonk = min(.9,(wminpt-elmin0)/(elmin1-elmin0)) */ +#line 19294 "" + i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 19294 "" + r__1 = wsyspt / wminpt; +#line 19294 "" + r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk; +#line 19294 "" + r__3 = (wminpt - elmin0) / (elmin1 - elmin0); +#line 19294 "" + findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, & + dtmin, &dtmax, &r__3); +#line 19297 "" + comeon_1.eonk = dmin(.9f,comeon_1.eonk); +#line 19298 "" + } +#line 19299 "" + d__1 = (doublereal) f1eon_(&dtmax); +#line 19299 "" + d__2 = (doublereal) comeon_1.eonk; +#line 19299 "" + comeon_1.ewmxk = pow_dd(&d__1, &d__2); + +/* Recompute poenom! */ + +#line 19303 "" + sumelsk = 0.f; +#line 19304 "" + i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1; +#line 19304 "" + for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) { +#line 19305 "" + r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1] + ; +#line 19305 "" + sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr + - 1] * feon_(&r__1); +#line 19307 "" +/* L44: */ +#line 19307 "" + } +#line 19308 "" + } +#line 19309 "" + poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk); + +/* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */ + +#line 19313 "" + if (isyst > 0) { +#line 19314 "" + if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst == + compage_1.isysmb[imovbrk]) { +#line 19316 "" + c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1]; +#line 19317 "" + } else { +#line 19318 "" + c1omget_1.fracindent = 0.f; +#line 19319 "" + } +#line 19320 "" + } +#line 19321 "" + s_wsfe(&io___1252); +#line 19321 "" + do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real)); +#line 19321 "" + do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer)); +#line 19321 "" + do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real)); +#line 19321 "" + do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real)); +#line 19321 "" + do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real)); +#line 19321 "" + do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)); +#line 19321 "" + do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)); +#line 19321 "" + e_wsfe(); +#line 19323 "" + ibar1 += nbarss[isyst]; +#line 19324 "" +/* L22: */ +#line 19324 "" + } +#line 19325 "" + al__1.aerr = 0; +#line 19325 "" + al__1.aunit = 12; +#line 19325 "" + f_rew(&al__1); +#line 19326 "" + o__1.oerr = 0; +#line 19326 "" + o__1.ounit = 13; +#line 19326 "" + o__1.ofnm = 0; +#line 19326 "" + o__1.orl = 0; +#line 19326 "" + o__1.osta = "SCRATCH"; +#line 19326 "" + o__1.oacc = 0; +#line 19326 "" + o__1.ofm = 0; +#line 19326 "" + o__1.oblnk = 0; +#line 19326 "" + f_open(&o__1); +#line 19327 "" + s_wsfe(&io___1253); +#line 19327 "" + do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer)); +#line 19327 "" + e_wsfe(); +#line 19328 "" + al__1.aerr = 0; +#line 19328 "" + al__1.aunit = 13; +#line 19328 "" + f_rew(&al__1); +#line 19329 "" + inbuff_1.ilbuf = 1; +#line 19330 "" + inbuff_1.ipbuf = 0; +#line 19331 "" + if (! (*optimize)) { +#line 19332 "" + s_wsfe(&io___1254); +#line 19332 "" + do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 19332 "" + e_wsfe(); +#line 19333 "" + s_wsle(&io___1255); +#line 19333 "" + e_wsle(); +#line 19334 "" + s_wsfe(&io___1256); +#line 19334 "" + do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 19334 "" + e_wsfe(); +#line 19335 "" + s_wsfe(&io___1257); +#line 19335 "" + e_wsfe(); +#line 19336 "" + } + +/* Following syntax is needed since pmxa is called with literal argument .false. */ + +#line 19340 "" + if (*isfirst) { +#line 19340 "" + *isfirst = FALSE_; +#line 19340 "" + } +#line 19341 "" + return 0; +} /* pmxa_ */ + +/* Subroutine */ int pmxb_(logical *inlast, real *poevec, integer *ncalls, + logical *optimize) +{ + /* System generated locals */ + address a__1[12], a__2[6], a__3[4], a__4[2], a__5[3], a__6[10], a__7[9], + a__8[2], a__9[5], a__10[8], a__11[14]; + integer i__1, i__2, i__3[12], i__4[6], i__5[4], i__6[2], i__7, i__8[3], + i__9[10], i__10[9], i__11[2], i__12[5], i__13, i__14[8], i__15[14] + ; + real r__1, r__2; + char ch__1[1], ch__2[46], ch__3[23], ch__4[26], ch__5[27], ch__6[20], + ch__7[29], ch__8[8], ch__9[35], ch__10[14], ch__11[19], ch__12[ + 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]; + cilist ci__1; + icilist ici__1; + olist o__1; + cllist cl__1; + alist al__1; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void), s_rsfe(cilist *), e_rsfe(void), s_rsle(cilist *), + e_rsle(void); + double r_mod(real *, real *); + integer i_nint(real *), pow_ii(integer *, integer *), f_open(olist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + double r_lg10(real *); + integer i_indx(char *, char *, ftnlen, ftnlen); + double r_dim(real *, real *); + integer i_dim(integer *, integer *); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + integer s_wsfi(icilist *), e_wsfi(void), lbit_shift(integer, integer), + f_clos(cllist *), f_rew(alist *); + + /* Local variables */ + static integer islnow, iplnow, lvoltxt, nbarss; + static real elsktot; + static integer ndigbn, indsym; + extern /* Subroutine */ int wgmeter_(integer *, integer *); + static integer mtrnms; + static real xnstbot; + static integer iptemp, islide, ipnew, iudorn, idynd; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + static integer itxtdyn, isdata, iarps; + extern /* Subroutine */ int make1bar_(integer *, real *, real *, logical * + , real *, integer *, integer *, integer *), make2bar_(integer *, + real *, real *, logical *, real *, integer *, integer *, integer * + , char *, ftnlen); + static real hardb4; + extern /* Subroutine */ int askfig_(char *, integer *, char *, integer *, + logical *, logical *, ftnlen, ftnlen); + static real xmtrnum0; + extern integer igetbits_(integer *, integer *, integer *); + extern /* Subroutine */ int newvoice_(integer *, char *, logical *, + ftnlen); + static logical lrptpend; + extern /* Subroutine */ int setmeter_(integer *, integer *, integer *, + integer *), puttitle_(integer *, real *, real *, char *, real *, + real *, real *, integer *, logical *, char *, ftnlen, ftnlen); + static integer i__; + static char basenameq[44], pathnameq[40]; + extern /* Subroutine */ int midievent_(char *, integer *, integer *, + ftnlen); + static real xintstaff[40]; + static integer ia, ig, il, ip, it, kv, ip2, ibc, icc, ipa, ipi; + static real esk; + static char nmq[40]; + static integer iiv; + static real poe, frac; + static integer ifig, jfig, ndig; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static real hesk[23]; + static integer ioff; + extern doublereal feon_(real *); + static char fmtq[24]; + static logical loop; + static real hpts[23], wdpt; + static logical lrpt, rrpt; + static integer lnmq, icrd, idyn; + static real tglp1; + extern /* Subroutine */ int stop1_(void); + static logical clchb; + static integer lbase, lclef; + static char charq[1]; + static logical clchv[24], slint; + static integer istop[80]; + static real squez[80]; + static logical ismbr; + static real etait, etatc, etacs1; + static integer nsyst, lpath, iauto; + static real slfac1; + static integer lnote, nclef, ipnow; + extern /* Subroutine */ int linebreakties_(integer *, integer *, integer * + , integer *, integer *, logical *, char *, ftnlen); + static real fsyst; + static integer isdat; + extern integer ncmid_(integer *, integer *); + extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *, + logical *); + static integer naccs; + static logical evolta; + static integer numbms[24], istart[80]; + static logical cwrest[24], svolta; + static char notexq[79]; + static logical onvolt; + static real tstart[80]; + static logical putmbr; + static real etatop, 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 logical newclef; + static real ptsndb; + extern /* Subroutine */ int topfile_(char *, integer *, integer *, char *, + integer *, integer *, real *, integer *, integer *, logical *, + real *, logical *, ftnlen, ftnlen); + static logical ispstie, vshrink; + static integer isyscnt; + 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; + + /* Fortran I/O blocks */ + static cilist io___1258 = { 0, 6, 0, 0, 0 }; + static cilist io___1259 = { 0, 6, 0, 0, 0 }; + static cilist io___1260 = { 0, 6, 0, 0, 0 }; + static cilist io___1261 = { 0, 15, 0, "(a)", 0 }; + static cilist io___1265 = { 0, 12, 0, "(a)", 0 }; + static cilist io___1267 = { 0, 12, 0, 0, 0 }; + static cilist io___1269 = { 0, 12, 0, 0, 0 }; + static cilist io___1285 = { 0, 6, 0, 0, 0 }; + static cilist io___1286 = { 0, 12, 0, 0, 0 }; + static cilist io___1292 = { 0, 13, 0, 0, 0 }; + static cilist io___1294 = { 0, 14, 0, "(a)", 0 }; + static cilist io___1297 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1298 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1299 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1302 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1312 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1314 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1315 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; + static cilist io___1319 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1320 = { 0, 11, 0, "(a14,f4.1,a)", 0 }; + static cilist io___1329 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1338 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1339 = { 0, 11, 0, "(a20,i1,a)", 0 }; + static cilist io___1340 = { 0, 11, 0, "(a20,i2,a)", 0 }; + static cilist io___1341 = { 0, 11, 0, "(a20)", 0 }; + static cilist io___1342 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1344 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1345 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1346 = { 0, 12, 0, 0, 0 }; + static cilist io___1349 = { 0, 6, 0, 0, 0 }; + static cilist io___1350 = { 0, 6, 0, 0, 0 }; + static cilist io___1353 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1354 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1355 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1356 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1357 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1358 = { 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___1364 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1365 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1374 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1375 = { 0, 12, 0, 0, 0 }; + static cilist io___1377 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 }; + static cilist io___1380 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1382 = { 0, 6, 0, 0, 0 }; + static cilist io___1383 = { 0, 6, 0, 0, 0 }; + static cilist io___1384 = { 0, 11, 0, "(a)", 0 }; + static icilist io___1387 = { 0, nmq+12, 0, "(2i1)", 2, 1 }; + static icilist io___1388 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 }; + static cilist io___1389 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1390 = { 0, 11, 0, "(a18,i1,a2)", 0 }; + static cilist io___1391 = { 0, 11, 0, "(a18,i2,a2)", 0 }; + static cilist io___1393 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1394 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1395 = { 0, 11, 0, "(a11,i3,a2)", 0 }; + static cilist io___1397 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1398 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1399 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1400 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1401 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1402 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1404 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1405 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1406 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1407 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1408 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1409 = { 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, "(a16,i1,a14)", 0 }; + static cilist io___1425 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1426 = { 0, 12, 1, 0, 0 }; + static cilist io___1429 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1430 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1431 = { 0, 11, 0, "(a)", 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___1436 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1437 = { 0, 11, 0, "(a,2i1,a)", 0 }; + static cilist io___1438 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1439 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1455 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1456 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1464 = { 0, 11, 0, "(a11,f5.1,a4)", 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, 6, 0, 0, 0 }; + static cilist io___1471 = { 0, 6, 0, 0, 0 }; + static cilist io___1472 = { 0, 15, 0, 0, 0 }; + static cilist io___1473 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1474 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1475 = { 0, 11, 0, fmtq, 0 }; + static cilist io___1476 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1477 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1478 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1479 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 }; + static cilist io___1480 = { 0, 6, 0, 0, 0 }; + static cilist io___1481 = { 0, 6, 0, 0, 0 }; + static cilist io___1482 = { 0, 6, 0, 0, 0 }; + static cilist io___1483 = { 0, 15, 0, "(/,a)", 0 }; + static cilist io___1484 = { 0, 15, 0, "(a)", 0 }; + + +/* ccccccccccccccccccccccccc */ +/* c */ +/* c To Do */ +/* c */ +/* c Resolve disagreement in final poe for 1st system, compared with *.mx2 */ +/* c Shift slurs on right- or left-shifted main notes (2/7/99) */ +/* c Various end-of-input-block repeat problems (ick142.pmx). */ +/* c Force multiplicity for un-beamed xtups. */ +/* c Clef change at end of piece */ +/* c Global "A" option to maximize "X" at a given time tick. */ +/* c Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted */ +/* c note. See trubl18.pmx */ +/* c Tab character as space. */ +/* c Clef interference with second line of music. */ +/* c Add space for interferences between *different* lines of music? */ +/* c Shift arpeggios, both automatic and manual. */ +/* c Different musicsize for different instruments. */ +/* c Spacing checks for accid's on left-shifted chord notes */ +/* c Spacing checks for double dots */ +/* c Allow forced line breaks w/o setting nsyst. */ +/* c Cresc-Decresc. (Enhance MusiXTeX first?) */ +/* c Dynamic Marks. */ +/* c Bug with Voltas at line end (MusiXTeX problem?). */ +/* c Subtle bug w/ slur hgt over line brk, see trubl15.pmx */ +/* c Stem-end slurs. */ +/* c Allow units in indentation. */ +/* c Make inline TeX more context sensitive. */ +/* c Werner's 4/2/98 problem with "o?" */ +/* c Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong. */ +/* c converts e.g. "r2db" into "r2d", which might be wrong. */ +/* c Werner's generalsignature problem with Key change and new transposition. */ +/* c (wibug8.pmx) */ +/* c Unequal xtuplets */ +/* c Print both sets of bar #'s in tex file. */ +/* c Make barlines invisible \def\xbar{\empty} , fix fbar. */ +/* c Auto-tie slurs 'At' */ +/* c Forced line break anywhere (e.g. at a mid-bar repeat). */ +/* c Clef change at very start of file. */ +/* c Tighten test for M as macro terminator. */ +/* c Fix title so not separate limit on author length + composer length. */ +/* c Arpeggios in xtups. */ +/* c */ +/* c mx10b */ +/* c Option for instrument name at top center. Last item in P command: */ +/* c P[n]c text is instrument name (use in parts) */ +/* c P[n]cstuff text is stuff (up to 1st blank) */ +/* c P[n]c"stuff with spaces" text is stuff with spaces */ +/* c */ +/* c Post version 1.43 */ +/* c Reduced space rqmt for multiplicity-0 graces (no flag) */ +/* c Removed last sepsym in centered whole-bar rests, fixes volta height bug. */ +/* c */ +/* c Version 1.43 */ +/* c Fix spacing for end-of-line signature change. */ +/* c Adjust left-shift of grace group for shifted accidentals. */ +/* c Put in extra space for left-shifted accidentals. */ +/* c Fix bug with dot-shift before accid-shift on chord note. */ +/* c Space-check for right-shifted main notes. */ +/* c Enable forcing stem direction of single notes in non-beamed xtups. */ +/* c Disallow clef change after last note before end of input block (pmxa) */ +/* c Print meter change before page break */ +/* c increase length of strings for \titles macro */ +/* c version 1.42 */ +/* c Loosen up input syntax for "X" commands. Subroutine getx() */ +/* c "B" and "P" in "X" commands */ +/* c mx09b */ +/* c Allow multiple rests at start of xtup */ +/* c Add 64th rest */ +/* c Fix xtup numbers over rests. (subroutine levrn) */ +/* c Initialize notcrd=.false. every gulp. Avoids undefined state with e.g. */ +/* c c za / ( c a ... */ +/* c Allow double dots to be shifted. */ +/* c Fix spacing with double dotted notes; permit splitting small note. */ +/* c Fix \dotted printout so it works with old compiler */ +/* c mx08b */ +/* c Automatic spaces if needed for shifted accidentals. */ +/* c Some Dynamics */ +/* c Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc) */ +/* c version 1.41 */ +/* c Allow ":" as last char of path name */ +/* c Dotted slurs "sb" */ +/* c Continue bar numbering at movement break "L[integer]Mc" */ +/* c mx07b */ +/* c Whole-bar rests with double lines of music. Fixed all options ? */ +/* c Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number]. */ +/* c Option to suppress centering full-bar rests. "o" */ +/* c mx06b */ +/* c Shift accid on left-shifted chord note. */ +/* c Rest as first note of xtup. */ +/* c Wrong slopes with small widths. Scale slfac1 by widthpt_default/widthpt */ +/* c Allow Rb for single bar at movemnet break or end of piece. (islur(25)) */ +/* c Change # of inst at a movement break. noinst is total # and must be used */ +/* c in 1st movement. ninow is current. nspern(1,...,ninow) is current */ +/* c staves/inst, nsperi(1,...,noinst) is original. rename tells whether to */ +/* c reprint names in parindent at a movement break. Default is .false. */ +/* c unless ninow changes, then .true. But can force either with r+/- as */ +/* c option in 'M' */ +/* c mx04b */ +/* c Double-dotted notes, separate+beamed, main+chord, still no extra space. */ +/* c ??? Don't shift slur ends on whole notes. */ +/* c (pmxa) Write line number of error in pmxaerr.dat */ +/* c mx02b */ +/* c Admit "RD" before "/" (search for "rptfq2:" ) */ +/* c In doslur, for multi-line staves, single notes, check forced stem dir'n */ +/* c before setting stemup (used to set horiz offset). */ +/* cccccccccccccccccccccccccccccc */ + +/* FYI /all/ differs in appearance in function ncmid */ + +/* cccccccccccc */ +/* c islur cc */ +/* cccccccccccc */ +/* bit meaning */ +/* 0 slur activity on this note */ +/* 1 t-slur here. */ +/* 2 force 0-slope beam starting on this note */ +/* 3 Double dotted note! */ +/* 4 grace before main note */ +/* 5 left repeat */ +/* 6 right repeat */ +/* 7 start Volta */ +/* 8 doublebar */ +/* 9 end Volta */ +/* 10 on=>endvoltabox */ +/* 11 on=>clefchange */ +/* 12-14 0=>treble, ... , 6=>bass */ +/* 15 on=> start new block for clef change (maybe diff. voice) */ +/* 16 literal TeX string */ +/* 17 1=up, 0=down stem for single note (override) See bit 30! */ +/* 18 if on, prohibit beaming */ +/* 19 if on, full bar rest as pause */ +/* 20 Beam multiplicity down-up */ +/* 21 Forced multiplicity for any beam including xtups */ +/* 22-24 Value of forced multiplicity */ +/* 25 single barline at movement break */ +/* 26 doubleBAR (see bits 5,6,8) */ +/* 27-28 Forced beam fine-tune height (1 to 3) */ +/* 29 Blank rest */ +/* 30 If on, get stem dir'n from bit 17 */ +/* 31 If on, suppress printing number with xtuplet starting here */ +/* 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 */ +/* 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) */ +/* 30 In forced beam. Signals need to check beam heights */ +/* 31 Grace way after main note. (stretch to next note, type W) */ +/* cccccccccccc */ +/* c iornq cc */ +/* cccccccccccc */ +/* 0 Ornament "(". Was user-defined horizontal slur shift on this note */ +/* until 9/24/97; changed that to irest(21) */ +/* 1-13 stmgx+Tupf._) */ +/* 14 Down fermata, was F */ +/* 15 Trill w/o "tr", was U */ +/* 16-18 Editorial s,f,n */ +/* 19-20 >^ */ +/* 21 "?" for editorial accid, w/ or w/o s,f,n */ +/* 22 Set if ihornb governs ornament height. Same in icrdorn. */ +/* 23 Set in getorn if ANY note at time of this main note has ornament. */ +/* This is ONLY used in beamstrt to signal whether to do more */ +/* tests for whether ihornb is needed. (ihornb is only needed */ +/* if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note) */ +/* (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm. */ +/* 24 Slur on after or way-after grace. Use as signal to START slur. */ +/* 25 Tweak orn ht. Same in icrdorn for chord note */ +/* 26 Insert user-defined space before this note (was 22) */ +/* 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord */ +/* 28 caesura or breath */ +/* c 29 blank barline (must be iv=1) (would have used islur but no room) */ +/* 29 coda */ +/* c 30 "Look-left" option for keyboard rest */ +/* 30 Part-by-part segno oG */ +/* 31 Set if any note (main or chord) has cautionary accid, for space checks */ +/* cccccccccccc */ +/* c irest cc */ +/* cccccccccccc */ +/* 0 rest=1, no rest = 0 */ +/* 1 There will be a vertical shift for number of this xtup */ +/* 2-6 Height shift, 1 => -15, 31 => +15 Indicate by +/- [n] after 'n' */ +/* 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 */ +/* 15 Single-voice, single note shift X(...)[p]S */ +/* 16 Start single-voice, multinote shift with this note X(...)[p]: */ +/* 17 End single-voice, multinote shift after this note. Enter symbol */ +/* after note. X: */ +/* 18 User-defined hardspace after last note of bar, *after* this note. */ +/* Value still stored in udoff(ivx,nudoff(ivx)), not with other */ +/* hardspaces in udsp, to avoid confusion with time checks. */ +/* 19 Move the dot. Data stored in ndotmv,updot,rtdot */ +/* 20 Set if right-shifted main or chord note here. Use for space checks. */ +/* 21 User-defined hardspace in xtup */ +/* 22 User-defined slur shift horizontal slur shift. */ +/* 23 Set on last note before staff-jumping a beam. */ +/* 24 Set on first note after staff-jumping a beam */ +/* 25 Suppress rest centering. "ro" */ +/* 26 Dynamic on this note */ +/* 27 Set if left-shifted main or chord note here. Use for space checks. */ +/* 28 Set if xtup starts on this note. */ +/* 29 Set on lowest-voice note at same time as 1st note after jump-beam. */ +/* 30 Set on note after end of jump-beam segment, to force new note group */ +/* 31 Flag for cautionary accidental */ +/* cccccccccccc */ +/* c nacc cc */ +/* cccccccccccc */ +/* 0-1 0=no accid, 1=fl, 2=sh, 3=na */ +/* 2 double */ +/* 3 big */ +/* 4-9 vertshift-32 */ +/* 10-16 20*(horiz. shift + 5.35) (Recentered ver 2.32) */ +/* 17 Midi-only accidental */ +/* 18 2:1 xtup */ +/* 19 Together with nacc(18), increase multiplicity by 1 and dot 1st note. */ +/* 20 Set on last note of each seg except last seg of single-slope beam. */ +/* 21 Set on 1st note of each seg except 1st seg of single-slope beam. */ +/* 22-26 If .ne.0, printed xtup number for xtup starting on this note. */ +/* 27 Set for dotted xtup note. Mult dur by 1.5, mult next by .5 & increase */ +/* multiplicity by 1 */ +/* 28 Set on main note of chord if accidentals are ordered. */ +/* 29 Tag for chordal accidental shift...means add to autoshifts. */ +/* 30-31 Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted. */ +/* If upstem|downstem, main is upper|lower member of 2nd */ +/* Action is to interchange pitches only when notes are placed. */ +/* cccccccccccc */ +/* c mult cc */ +/* cccccccccccc */ +/* 0-3 Multiplicity+8 (mult= # of flags) */ +/* 4 Set if slope adjustment for xtup bracket */ +/* 5-9 16+slope adjustment */ +/* 27 Stemlength override */ +/* 28-30 New stem length. */ +/* cccccccccccc */ +/* c isdat1 cc */ +/* cccccccccccc */ +/* 13-17 iv */ +/* 3-10 ip */ +/* 11 start/stop switch */ +/* 12 kv-1 */ +/* 19-25 ichar(code$) */ +/* 26 force direction? */ +/* 27 forced dir'n = up if on, set in sslur; also */ +/* final direction, set in doslur when beam is started, used on term. */ +/* 28-31 ndxslur, set in doslur when beam is started, used on term. */ +/* cccccccccccc */ +/* c isdat2 cc */ +/* cccccccccccc */ +/* 0 Chord switch. Not set on main note. */ +/* 1-2 left/right notehead shift. Set only for chord note. */ +/* 3 tie positioning */ +/* 4 dotted slur */ +/* 6-11 voff1 1-63 => -31...+31 */ +/* 12-18 hoff1 1-127 => -6.3...+6.3 */ +/* 19-25 nolev */ +/* 26 \sluradjust (p+s) */ +/* 27 \nosluradjust (p-s) */ +/* 28 \tieadjust (p+t) */ +/* 29 \notieadjust (p-t) */ +/* cccccccccccc */ +/* c isdat3 cc */ +/* cccccccccccc */ +/* 0 set if midslur (at least one argument) */ +/* 1 set if curve (2 more args) */ +/* 2-7 32+first arg (height correction) (1st arg may be negative) */ +/* 8-10 second arg (initial slope) */ +/* 11-13 third arg (closing slope) */ +/* 14-21 tie level for use in LineBreakTies */ +/* 22-29 ncm for use in LineBreakTies */ +/* cccccccccccc */ +/* c isdat4 cc Set these all at turn-on using s option */ +/* cccccccccccc */ +/* 0-5 Linebreak seg 1 voff 1-63 => -31...+31 */ +/* 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3 */ +/* 16-21 Linebreak seg 2 voff 1-63 => -31...+31 */ +/* 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3 */ +/* cccccccccccc */ +/* icrdat c */ +/* cccccccccccc */ +/* 0-7 ip within voice */ +/* 8-11 ivx (together with 28th bit) */ +/* 12-18 note level */ +/* 19 accidental? */ +/* 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp) */ +/* 23 shift left */ +/* 24 shift right */ +/* 25 arpeggio start or stop */ +/* 26 flag for moved dot (here, not icrdot, since this is always reset!) */ +/* 27 Midi-only accidental */ +/* 28 (6/27/10) 5th bit for ivx, to allow up to 24 voices */ +/* 29 Tag for accidental shift...means add to autoshifts. */ +/* 31 Flag for cautionary accidental on chord note */ +/* cccccccccccc */ +/* icrdot c: */ +/* cccccccccccc */ +/* 0-6 10*abs(vertical dot shift in \internote) + 64 */ +/* 7-13 10*abs(horizontal dot shift in \internote) + 64 */ +/* 14-19 vert accidental shift-32 */ +/* 20-26 20*(horiz accidental shift+3.2) */ +/* 27-29 top-down level rank of chord note w/accid. Set in crdaccs. */ + +/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */ + +/* ccccccccccccccccccccccccccccccc */ +#line 19792 "" + /* Parameter adjustments */ +#line 19792 "" + --poevec; +#line 19792 "" + +#line 19792 "" + /* Function Body */ +#line 19793 "" + if (! (*optimize)) { +#line 19794 "" + s_wsle(&io___1258); +#line 19794 "" + e_wsle(); +#line 19795 "" + s_wsle(&io___1259); +#line 19795 "" + do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24); +#line 19795 "" + e_wsle(); +#line 19796 "" + s_wsle(&io___1260); +#line 19796 "" + e_wsle(); +#line 19797 "" + s_wsfe(&io___1261); +#line 19797 "" + do_fio(&c__1, "Starting second PMX pass", (ftnlen)24); +#line 19797 "" + e_wsfe(); +#line 19798 "" + } +#line 19799 "" + newclef = FALSE_; +#line 19800 "" + comclefrests_1.centrests = FALSE_; +#line 19801 "" + ++(*ncalls); +#line 19802 "" + comlast_1.islast = *inlast; +#line 19803 "" + commac_1.macuse = 0; +#line 19804 "" + isyscnt = 0; +#line 19805 "" + all_1.stemmax = 8.2f; +#line 19806 "" + all_1.stemmin = 3.9f; +#line 19807 "" + all_1.stemlen = 6.f; +#line 19808 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 19808 "" + *(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0]; +#line 19809 "" + comignorenats_1.ignorenats = FALSE_; +#line 19810 "" + combc_1.bcspec = TRUE_; +#line 19811 "" + comas3_1.topmods = FALSE_; +#line 19812 "" + ismbr = FALSE_; +#line 19813 "" + s_rsfe(&io___1265); +#line 19813 "" + do_fio(&c__1, basenameq, (ftnlen)44); +#line 19813 "" + e_rsfe(); +#line 19814 "" + s_rsle(&io___1267); +#line 19814 "" + do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer)); +#line 19814 "" + e_rsle(); +#line 19815 "" + s_rsle(&io___1269); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real)); +#line 19815 "" + do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer)) + ; +#line 19815 "" + do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer)); +#line 19815 "" + do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); +#line 19815 "" + e_rsle(); +#line 19817 "" + inbuff_1.ilbuf = 1; +#line 19818 "" + inbuff_1.ipbuf = 0; +#line 19819 "" + 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 19822 "" + if (commidi_1.ismidi) { + +/* Initial key signature and meter for pickup bar */ +/* 130313 Unless explicit miditranspose for all parts (to be dealt with later), */ +/* want concert sig (isig0) here. K+n+m will have changed sig to isig */ +/* call midievent('k',isig,0) */ +/* 130316 */ +/* call midievent('k',isig0,0) */ +/* call midievent('k',midisig,0) */ + +/* Above is probably cosmetic */ +/* call midievent('k',midisig,0) */ +#line 19834 "" + if (xmtrnum0 > comtol_1.tol) { + +/* We have a pickup. Some tricky stuff to get a meter: */ + +#line 19838 "" + xntrial = xmtrnum0; +#line 19839 "" + for (ip2 = 0; ip2 <= 5; ++ip2) { +#line 19840 "" + if ((r__1 = r_mod(&xntrial, &c_b814), dabs(r__1)) < + comtol_1.tol) { +#line 19840 "" + goto L6; +#line 19840 "" + } +#line 19841 "" + xntrial *= 2; +#line 19842 "" +/* L5: */ +#line 19842 "" + } +#line 19843 "" + s_wsle(&io___1285); +#line 19843 "" + do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", ( + ftnlen)36); +#line 19843 "" + e_wsle(); +#line 19844 "" + xntrial = 1.f; +#line 19845 "" + ip2 = 0; +#line 19846 "" +L6: +#line 19847 "" + i__1 = i_nint(&xntrial); +#line 19847 "" + i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl; +#line 19847 "" + midievent_("m", &i__1, &i__2, (ftnlen)1); +#line 19848 "" + } else { + +/* No pickup, enter the starting meter */ + +#line 19852 "" + midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1); +#line 19853 "" + } +#line 19854 "" + } + +/* Set musicsize from value passed in common, due to possible reset by S[n]m16 */ + +#line 19858 "" + all_1.musicsize = commus_1.musize; +#line 19859 "" + s_rsle(&io___1286); +#line 19859 "" + do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real)); +#line 19859 "" + do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer)); +#line 19859 "" + i__1 = npages; +#line 19859 "" + for (ipa = 1; ipa <= i__1; ++ipa) { +#line 19859 "" + do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen) + sizeof(integer)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real)); +#line 19859 "" + do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real) + ); +#line 19859 "" + } +#line 19859 "" + do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer)); +#line 19859 "" + e_rsle(); + +/* If default width ever changes, must adjust this stmt. */ + +#line 19864 "" + slfac1 = 2.98156f / comtop_1.widthpt; +#line 19865 "" + all_1.figbass = FALSE_; +#line 19866 "" + s_rsle(&io___1292); +#line 19866 "" + do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer)); +#line 19866 "" + e_rsle(); +#line 19867 "" + if (ifig == 1) { +#line 19868 "" + all_1.figbass = TRUE_; +#line 19869 "" + o__1.oerr = 0; +#line 19869 "" + o__1.ounit = 14; +#line 19869 "" + o__1.ofnm = 0; +#line 19869 "" + o__1.orl = 0; +#line 19869 "" + o__1.osta = "SCRATCH"; +#line 19869 "" + o__1.oacc = 0; +#line 19869 "" + o__1.ofm = 0; +#line 19869 "" + o__1.oblnk = 0; +#line 19869 "" + f_open(&o__1); +#line 19870 "" + s_wsfe(&io___1294); +/* Writing concatenation */ +#line 19870 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 19870 "" + i__3[1] = 3, a__1[1] = "def"; +#line 19870 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 19870 "" + i__3[3] = 8, a__1[3] = "fixdrop{"; +#line 19870 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 19870 "" + i__3[5] = 7, a__1[5] = "advance"; +#line 19870 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 19870 "" + i__3[7] = 10, a__1[7] = "sysno by 1"; +#line 19870 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 19870 "" + i__3[9] = 6, a__1[9] = "ifcase"; +#line 19870 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 19870 "" + i__3[11] = 6, a__1[11] = "sysno%"; +#line 19870 "" + s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46); +#line 19870 "" + do_fio(&c__1, ch__2, (ftnlen)46); +#line 19870 "" + e_wsfe(); +#line 19872 "" + } +#line 19873 "" + comget_1.lastchar = FALSE_; +#line 19874 "" + ibcoff = 0; +#line 19875 "" + if (xmtrnum0 > 0.f) { +#line 19875 "" + ibcoff = -1; +#line 19875 "" + } +#line 19876 "" + o__1.oerr = 0; +#line 19876 "" + o__1.ounit = 11; +#line 19876 "" + o__1.ofnm = 0; +#line 19876 "" + o__1.orl = 0; +#line 19876 "" + o__1.osta = "SCRATCH"; +#line 19876 "" + o__1.oacc = 0; +#line 19876 "" + o__1.ofm = 0; +#line 19876 "" + o__1.oblnk = 0; +#line 19876 "" + 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 19882 "" + 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) + 1); + +/* ninow is working value of # of instruments. noinst is max #, and # at start. */ + +#line 19887 "" + comnotes_1.ninow = noinst; + +/* Save original printed meter in case movement breaks */ + +#line 19891 "" + comget_1.movnmp = all_1.mtrnmp; +#line 19892 "" + comget_1.movdnp = all_1.mtrdnp; + +#line 19894 "" + if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) { +#line 19894 "" + s_wsfe(&io___1297); +/* Writing concatenation */ +#line 19894 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 19894 "" + i__4[1] = 3, a__2[1] = "def"; +#line 19894 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 19894 "" + i__4[3] = 8, a__2[3] = "figfont{"; +#line 19894 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 19894 "" + i__4[5] = 9, a__2[5] = "eightrm}%"; +#line 19894 "" + s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23); +#line 19894 "" + do_fio(&c__1, ch__3, (ftnlen)23); +#line 19894 "" + e_wsfe(); +#line 19894 "" + } + +#line 19897 "" + if (comlast_1.islast && comligfont_1.isligfont) { +#line 19898 "" + if (all_1.musicsize == 16) { +#line 19899 "" + s_wsfe(&io___1298); +/* Writing concatenation */ +#line 19899 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 19899 "" + i__5[1] = 4, a__3[1] = "font"; +#line 19899 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 19899 "" + i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%"; +#line 19899 "" + s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26); +#line 19899 "" + do_fio(&c__1, ch__4, (ftnlen)26); +#line 19899 "" + e_wsfe(); +#line 19900 "" + } else { +#line 19901 "" + s_wsfe(&io___1299); +/* Writing concatenation */ +#line 19901 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 19901 "" + i__5[1] = 4, a__3[1] = "font"; +#line 19901 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 19901 "" + i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%"; +#line 19901 "" + s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); +#line 19901 "" + do_fio(&c__1, ch__5, (ftnlen)27); +#line 19901 "" + e_wsfe(); +#line 19902 "" + } +#line 19903 "" + } +#line 19904 "" + lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1); +#line 19905 "" + if (all_1.mtrdenl == 2) { +#line 19905 "" + lenbeat = 16; +#line 19905 "" + } +#line 19906 "" + all_1.lenb1 = all_1.mtrnuml * lenbeat; +#line 19907 "" + if (all_1.mtrdenl == 2) { +#line 19907 "" + all_1.lenb1 <<= 1; +#line 19907 "" + } +#line 19908 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep); +#line 19909 "" + r__1 = xmtrnum0 * lenbeat; +#line 19909 "" + all_1.lenb0 = i_nint(&r__1); +#line 19910 "" + if (all_1.mtrdenl == 2) { +#line 19910 "" + all_1.lenb0 <<= 1; +#line 19910 "" + } +#line 19911 "" + if (all_1.lenb0 != 0) { +#line 19912 "" + if (comlast_1.islast) { +#line 19912 "" + s_wsfe(&io___1302); +/* Writing concatenation */ +#line 19912 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 19912 "" + i__5[1] = 7, a__3[1] = "advance"; +#line 19912 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 19912 "" + i__5[3] = 11, a__3[3] = "barno by -1"; +#line 19912 "" + s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20); +#line 19912 "" + do_fio(&c__1, ch__6, (ftnlen)20); +#line 19912 "" + e_wsfe(); +#line 19912 "" + } +#line 19913 "" + all_1.lenbar = all_1.lenb0; +#line 19914 "" + } else { +#line 19915 "" + all_1.lenbar = all_1.lenb1; +#line 19916 "" + } + +/* Initialize full-program variables */ + +#line 19920 "" + comask_1.fixednew = 0.f; +#line 19921 "" + comask_1.scaldold = 0.f; +#line 19922 "" + comget_1.fintstf = -1.f; +#line 19923 "" + comget_1.gintstf = 1.f; +#line 19924 "" + comas2_1.nasksys = 0; +#line 19925 "" + combibarcnt_1.ibarcnt = 0; +#line 19926 "" + all_1.iline = 0; +#line 19927 "" + comget_1.movbrk = 0; +#line 19928 "" + isystpg = 0; +#line 19929 "" + comnotes_1.ipage = 1; +#line 19930 "" + all_1.iccount = 128; +#line 19931 "" + comas3_1.iask = 0; +#line 19932 "" + nhstot = 0; +#line 19933 "" + comnsp_2.nb = 1; +#line 19934 "" + if (! (*optimize)) { +#line 19934 "" + jprntb = 81; +#line 19934 "" + } +#line 19935 "" + comtop_1.idsig = 0; + +/* Next 5 are raise-barno parameters. irzbnd is integer part of default level. */ + +#line 19939 "" + comsln_1.irzbnd = 3; +#line 19940 "" + if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv - + 1] == 't') { +#line 19940 "" + comsln_1.irzbnd = 4; +#line 19940 "" + } +#line 19941 "" + comsln_1.is1n1 = 0; +#line 19942 "" + comsln_1.isnx = 0; +#line 19943 "" + comslur_1.slurcurve = 0.f; + +/* 111109 Made global rather than per gulp */ + +#line 19947 "" + comdyn_1.ndyn = 0; +#line 19948 "" + compoi_1.ispoi = FALSE_; +#line 19949 "" + slint = FALSE_; +#line 19950 "" + lrptpend = FALSE_; +#line 19951 "" + comget_1.rptnd1 = FALSE_; +#line 19952 "" + *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 19953 "" + comget_1.rptprev = FALSE_; +#line 19954 "" + onvolt = FALSE_; +#line 19955 "" + comnsp_2.flgndb = FALSE_; +#line 19956 "" + comget_1.fbon = FALSE_; +#line 19957 "" + comnotes_1.shifton = FALSE_; +#line 19958 "" + comget_1.ornrpt = FALSE_; +#line 19959 "" + comnotes_1.setis = FALSE_; +#line 19960 "" + comarp_1.lowdot = FALSE_; +#line 19961 "" + comnvi_1.rename = FALSE_; +#line 19962 "" + comnotes_1.nobar1 = FALSE_; +#line 19963 "" + comget_1.equalize = FALSE_; +#line 19964 "" + comlast_1.usevshrink = TRUE_; +#line 19965 "" + comslur_1.wrotepsslurdefaults = FALSE_; +#line 19966 "" + comnotes_1.optlinebreakties = FALSE_; +#line 19967 "" + comnotes_1.headerspecial = FALSE_; + +/* vshrink is initialized in topfile */ + +#line 19971 "" + comget_1.stickys = FALSE_; + +/* ixrest = 1 or 2 if xtup has started with a rest */ + +#line 19975 "" + for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) { +#line 19976 "" + strtmid_1.ixrest[commvl_1.ivx - 1] = 0; +#line 19977 "" + comfig_1.fullsize[commvl_1.ivx - 1] = 1.f; + +/* Set legacy note level to middle c as default */ + +#line 19981 "" + comnotes_1.ndlev[commvl_1.ivx - 1] = 29; +#line 19982 "" + comnotes_1.ndlev[commvl_1.ivx + 23] = 29; +#line 19983 "" +/* L1: */ +#line 19983 "" + } +#line 19984 "" + comnotes_1.npreslur = 0; +#line 19985 "" + nhssys = 0; +#line 19986 "" + comslur_1.listslur = 0; +#line 19987 "" + for (i__ = 1; i__ <= 202; ++i__) { +#line 19988 "" + all_1.isdat1[i__ - 1] = 0; +#line 19989 "" + all_1.isdat2[i__ - 1] = 0; +#line 19990 "" +/* L31: */ +#line 19990 "" + } +#line 19991 "" + all_1.nsdat = 0; + +/* Initialize flag for figures in any other voice than 1 */ + +#line 19995 "" + comfig_1.ivxfig2 = 0; + +/* Initialize for loop over gulps */ + +#line 19999 "" + all_1.firstgulp = TRUE_; + +/* Start a gulp */ + +#line 20003 "" +L30: +#line 20003 "" + loop = TRUE_; +#line 20004 "" + comnotes_1.notcrd = TRUE_; +#line 20005 "" + combjmp_1.isbjmp = FALSE_; +#line 20006 "" + combjmp_1.isbj2 = FALSE_; +#line 20007 "" + comfb_1.autofbon = FALSE_; +#line 20008 "" + comfb_1.tautofb = 0.f; +#line 20009 "" + all_1.nbars = 0; +#line 20010 "" + comfig_1.nfigs[0] = 0; +#line 20011 "" + comfig_1.nfigs[1] = 0; +#line 20012 "" + comgrace_1.ngrace = 0; +#line 20013 "" + comtrill_1.ntrill = 0; +#line 20014 "" + comtrill_1.ncrd = 0; +#line 20015 "" + comtrill_1.nudorn = 0; +#line 20016 "" + comgrace_1.nlit = 0; +#line 20017 "" + comgrace_1.nvolt = 0; +#line 20018 "" + comgrace_1.ibarmbr = 0; +#line 20019 "" + comudsp_1.nudsp = 0; +/* ndyn = 0 ! 111109 */ +#line 20021 "" + comdyn_1.ntxtdyn = 0; +#line 20022 "" + comcb_1.nbc = 0; +#line 20023 "" + comarpshift_1.numarpshift = 0; +#line 20024 "" + for (i__ = 1; i__ <= 37; ++i__) { +#line 20025 "" + comgrace_1.graspace[i__ - 1] = 0.f; +#line 20026 "" +/* L3: */ +#line 20026 "" + } + +/* 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 20031 "" + i__1 = all_1.nv; +#line 20031 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 20032 "" + newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, ( + ftnlen)1); +#line 20033 "" +/* L4: */ +#line 20033 "" + } + +/* Check if endsymbol was set earlier */ + +#line 20037 "" + if (comget_1.rptnd1) { +#line 20038 "" + comget_1.rptnd1 = FALSE_; +#line 20039 "" + *(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1; +#line 20040 "" + } else { + +/* Only use if movbrk>0, to signal default ('RD') */ + +#line 20044 "" + *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 20045 "" + } +#line 20046 "" + all_1.iv = 1; +#line 20047 "" + commvl_1.ivx = 1; +#line 20048 "" +L2: +#line 20048 "" + if (loop) { + +/* Within this loop, nv voices are filled up for the duration of the block. */ +/* On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv) */ +/* nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..). */ +/* nbars is for this input block. */ +/* 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 20057 "" + getnote_(&loop); +#line 20058 "" + if (comget_1.lastchar) { +#line 20058 "" + goto L40; +#line 20058 "" + } +#line 20059 "" + goto L2; +#line 20060 "" + } + +/* Finished an input block (gulp). */ + +#line 20064 "" + if (commidi_1.ismidi) { + +/* Put rests into midi array for 2nd lines that were not used in this gulp. */ + +#line 20068 "" + i__1 = all_1.nv; +#line 20068 "" + for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) { +#line 20069 "" + if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1] + == 1) { +#line 20070 "" + if (all_1.firstgulp && all_1.lenb0 != 0) { +#line 20071 "" + r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0; +#line 20071 "" + addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, + &c__0, &r__1, &c_true, &c_false); +#line 20073 "" + } else { +#line 20074 "" + r__1 = all_1.nbars * 1.f * all_1.lenbar; +#line 20074 "" + addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0, + &c__0, &r__1, &c_true, &c_false); +#line 20076 "" + } +#line 20077 "" + } +#line 20078 "" +/* L60: */ +#line 20078 "" + } +#line 20079 "" + } +#line 20080 "" + comgrace_1.nvolt = 0; +#line 20081 "" + for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) { +#line 20082 "" + comudsp_1.nudoff[all_1.iv - 1] = 0; +#line 20083 "" + comcc_1.ndotmv[all_1.iv - 1] = 0; +#line 20084 "" +/* L28: */ +#line 20084 "" + } + +/* Put stuff at top of p.1. Must wait until now to have read title info. */ + +#line 20088 "" + if (combibarcnt_1.ibarcnt == 0) { +#line 20089 "" + 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 20091 "" + if (comnotes_1.headerspecial) { +#line 20091 "" + s_wsfe(&io___1312); +/* Writing concatenation */ +#line 20091 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 20091 "" + i__6[0] = 1, a__4[0] = ch__1; +#line 20091 "" + i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"; +#line 20091 "" + s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); +#line 20091 "" + do_fio(&c__1, ch__7, (ftnlen)29); +#line 20091 "" + e_wsfe(); +#line 20091 "" + } + +/* Write special header for first page */ + +#line 20096 "" + } +#line 20097 "" + i__1 = all_1.nbars; +#line 20097 "" + for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) { +#line 20098 "" + ++combibarcnt_1.ibarcnt; +#line 20099 "" + comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto; +/* Computing MAX */ +#line 20100 "" + r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff; +#line 20100 "" + i__2 = 0, i__7 = (integer) r_lg10(&r__1); +#line 20100 "" + ndig = max(i__2,i__7); +#line 20101 "" + if (comlast_1.islast) { +#line 20101 "" + ci__1.cierr = 0; +#line 20101 "" + ci__1.ciunit = 11; +/* Writing concatenation */ +#line 20101 "" + i__8[0] = 6, a__5[0] = "(a11,i"; +#line 20101 "" + i__2 = ndig + 50; +#line 20101 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 20101 "" + i__8[1] = 1, a__5[1] = ch__1; +#line 20101 "" + i__8[2] = 1, a__5[2] = ")"; +#line 20101 "" + ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8); +#line 20101 "" + s_wsfe(&ci__1); +#line 20101 "" + do_fio(&c__1, "% Bar count", (ftnlen)11); +#line 20101 "" + i__7 = combibarcnt_1.ibarcnt + ibcoff; +#line 20101 "" + do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 20101 "" + e_wsfe(); +#line 20101 "" + } +#line 20104 "" + if (all_1.ibar != comgrace_1.ibarmbr) { +#line 20105 "" + if (! (*optimize)) { +#line 20105 "" + i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 20105 "" + outbar_(&i__2, &jprntb); +#line 20105 "" + } +#line 20106 "" + } else { +#line 20107 "" + if (! (*optimize)) { +#line 20108 "" + s_wsfe(&io___1314); +#line 20108 "" + do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 20108 "" + i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 20108 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 20108 "" + do_fio(&c__1, "-", (ftnlen)1); +#line 20108 "" + i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; +#line 20108 "" + do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 20108 "" + e_wsfe(); +#line 20110 "" + s_wsfe(&io___1315); +#line 20110 "" + do_fio(&c__1, " Multibar rest, bars", (ftnlen)20); +#line 20110 "" + i__2 = combibarcnt_1.ibarcnt + ibcoff; +#line 20110 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 20110 "" + do_fio(&c__1, "-", (ftnlen)1); +#line 20110 "" + i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1; +#line 20110 "" + do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 20110 "" + e_wsfe(); +#line 20112 "" + jprntb = 0; +#line 20113 "" + } +#line 20114 "" + ibcoff = ibcoff + comgrace_1.mbrest - 1; +/* if (ibar.eq.1 .and. firstgulp .and. */ +/* * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize */ +#line 20117 "" + if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[ + 0],5)) { +#line 20117 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 20117 "" + } +#line 20119 "" + } + +/* Move the read to after end-of-bar hardspace checks, so we get right poenom */ +/* at end of a line. */ +/* if (bar1syst) read(12,*) poenom */ + +/* Check for clef at start of bar. No slide yet. Also flags at end of prev. */ +/* bar. This block is run at the start of every bar. May fail for flag at */ +/* end of last bar. To account for necc. hardspaces, compute and store */ +/* nhssys = # of hard spaces for this system */ +/* hesk(nhssys) = elemskips avialable */ +/* hpts(nhssys) = hard points needed, including notehead */ +/* Here, merely insert placeholder into output. Later, when poe is computed, */ +/* compute additional pts and store them in hpttot(1...nhstot). Finally in */ +/* subroutine askfig, write true pts where placeholders are. */ + +#line 20135 "" + ioff = 0; +#line 20136 "" + if (all_1.ibar > 1) { +#line 20136 "" + ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24]; +#line 20136 "" + } +#line 20137 "" + clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15); +#line 20138 "" + putmbr = FALSE_; +#line 20139 "" + if (ismbr) { +#line 20140 "" + if (clchb) { +/* cc */ +/* cc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */ +/* cc */ +#line 20144 "" + s_wsfe(&io___1319); +/* Writing concatenation */ +#line 20144 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 20144 "" + i__9[1] = 3, a__6[1] = "let"; +#line 20144 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 20144 "" + i__9[3] = 4, a__6[3] = "mbrt"; +#line 20144 "" + i__9[4] = 1, a__6[4] = all_1.sq; +#line 20144 "" + i__9[5] = 6, a__6[5] = "mbrest"; +#line 20144 "" + i__9[6] = 1, a__6[6] = all_1.sq; +#line 20144 "" + i__9[7] = 3, a__6[7] = "def"; +#line 20144 "" + i__9[8] = 1, a__6[8] = all_1.sq; +#line 20144 "" + i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%"; +#line 20144 "" + s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35); +#line 20144 "" + do_fio(&c__1, ch__9, (ftnlen)35); +#line 20144 "" + e_wsfe(); +#line 20146 "" + s_wsfe(&io___1320); +/* Writing concatenation */ +#line 20146 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20146 "" + i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{"; +#line 20146 "" + s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); +#line 20146 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20146 "" + r__1 = all_1.musicsize * .55f; +#line 20146 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 20146 "" + i__10[0] = 1, a__7[0] = "}"; +#line 20146 "" + i__10[1] = 1, a__7[1] = all_1.sq; +#line 20146 "" + i__10[2] = 6, a__7[2] = "global"; +#line 20146 "" + i__10[3] = 1, a__7[3] = all_1.sq; +#line 20146 "" + i__10[4] = 3, a__7[4] = "let"; +#line 20146 "" + i__10[5] = 1, a__7[5] = all_1.sq; +#line 20146 "" + i__10[6] = 6, a__7[6] = "mbrest"; +#line 20146 "" + i__10[7] = 1, a__7[7] = all_1.sq; +#line 20146 "" + i__10[8] = 6, a__7[8] = "mbrt}%"; +#line 20146 "" + s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26); +#line 20146 "" + do_fio(&c__1, ch__4, (ftnlen)26); +#line 20146 "" + 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 20153 "" + } +#line 20154 "" + ismbr = FALSE_; +#line 20155 "" + putmbr = TRUE_; +#line 20156 "" + } +#line 20157 "" + if (all_1.ibar == comgrace_1.ibarmbr) { +#line 20157 "" + ismbr = TRUE_; +#line 20157 "" + } + +/* 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 20162 "" + if (! (clchb || comnsp_2.flgndb)) { +#line 20162 "" + goto L23; +#line 20162 "" + } + +/* Must check available space */ + +#line 20166 "" + ptsndb = 0.f; + +/* Zero out block signal */ + +#line 20170 "" + if (clchb) { +#line 20170 "" + all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff + + 1) * 24 - 24],15); +#line 20170 "" + } + +/* In this loop, we determine how much hardspace is needed (if any) */ +/* 9/7/97 Note that for last bar in input block, if number of lines of */ +/* music decreases in new block, highest numbered ones won't be checked */ +/* since the loop below covers the new nvmx(iv), not necessarily the old */ +/* one. */ +/* 4/18/98 Apparently nmxsav was a solution to the above problem */ + +#line 20179 "" + i__2 = all_1.nv; +#line 20179 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 20180 "" + i__7 = comnsp_2.nvmxsav[all_1.iv - 1]; +#line 20180 "" + for (kv = 1; kv <= i__7; ++kv) { +#line 20181 "" + commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25]; +#line 20182 "" + ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt; +#line 20183 "" + ioff = 0; +#line 20184 "" + if (all_1.ibar > 1) { +#line 20185 "" + ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - + 25]; +#line 20186 "" + ip = ioff; +#line 20187 "" + if (all_1.ibar > 2) { +#line 20187 "" + ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2) + * 24 - 25]; +#line 20187 "" + } +/* prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */ +#line 20189 "" + 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 20193 "" + } + +/* Only allow clef changes when ivx <= nv */ + +#line 20197 "" + if (commvl_1.ivx <= all_1.nv) { +#line 20198 "" + clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[ + all_1.iv + (ioff + 1) * 24 - 25],11); +#line 20199 "" + if (clchv[all_1.iv - 1]) { + +/* Clef change in this voice. Turn off signal. Get space avail. */ + +#line 20203 "" + all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] = + bit_clear(all_1.islur[all_1.iv + (ioff + 1) * + 24 - 25],11); +#line 20204 "" + if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] - + comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) < + comtol_1.tol) { +#line 20204 "" + ptsndv += combmh_1.clefend * comask_1.wheadpt; +#line 20204 "" + } +#line 20206 "" + } +#line 20207 "" + } +/* Computing MAX */ +#line 20208 "" + r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt * + spfacs_1.xspfac; +#line 20208 "" + ptsndb = dmax(r__1,r__2); +#line 20209 "" +/* L16: */ +#line 20209 "" + } +#line 20209 "" + } + +/* ???? where is nb set??? nb probably in left over from makeabar */ + +#line 20213 "" + r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1]; +#line 20213 "" + esk = feon_(&r__1); +#line 20214 "" + ptsdflt = esk * comask_1.poenom - comask_1.wheadpt; +/* if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */ +#line 20216 "" + 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 20221 "" + if (comlast_1.islast) { +#line 20221 "" + s_wsfe(&io___1329); +/* Writing concatenation */ +#line 20221 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20221 "" + i__6[1] = 18, a__4[1] = "xardspace{ pt}%"; +#line 20221 "" + s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); +#line 20221 "" + do_fio(&c__1, ch__11, (ftnlen)19); +#line 20221 "" + e_wsfe(); +#line 20221 "" + } +#line 20222 "" + ++nhssys; +#line 20223 "" + if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom * + comnsp_2.eskgnd) { +#line 20224 "" + hesk[nhssys - 1] = esk; +#line 20225 "" + hpts[nhssys - 1] = ptsndb + comask_1.wheadpt; +#line 20226 "" + } else { +#line 20227 "" + hesk[nhssys - 1] = comnsp_2.eskgnd; +#line 20228 "" + hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt; +#line 20229 "" + } +#line 20230 "" + comask_1.fixednew += hpts[nhssys - 1]; +#line 20231 "" + comask_1.scaldold += hesk[nhssys - 1]; +#line 20232 "" + } +#line 20233 "" + if (clchb) { +#line 20234 "" + i__7 = all_1.nv; +#line 20234 "" + for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 20235 "" + if (clchv[all_1.iv - 1]) { +/* Writing concatenation */ +#line 20236 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20236 "" + i__6[1] = 6, a__4[1] = "znotes"; +#line 20236 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20237 "" + lnote = 7; +#line 20238 "" + i__2 = all_1.iv; +#line 20238 "" + for (iiv = 2; iiv <= i__2; ++iiv) { +/* Writing concatenation */ +#line 20239 "" + i__6[0] = lnote, a__4[0] = notexq; +#line 20239 "" + i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2); +#line 20239 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20240 "" + ++lnote; +#line 20241 "" +/* L24: */ +#line 20241 "" + } + +/* Recompute ioff since it will vary from voice to voice */ + +#line 20245 "" + if (all_1.ibar == 1) { +#line 20246 "" + ioff = 0; +#line 20247 "" + } else { +#line 20248 "" + ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 - + 25]; +#line 20249 "" + } + +/* Must call clefsym to get nclef, even if there is a movement break */ + +#line 20253 "" + 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 20257 "" + if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) + ) { +/* Writing concatenation */ +#line 20257 "" + i__8[0] = 8, a__5[0] = fmtq; +#line 20257 "" + i__8[1] = 1, a__5[1] = "8"; +#line 20257 "" + i__8[2] = 1, a__5[2] = fmtq + 9; +#line 20257 "" + s_cat(fmtq, a__5, i__8, &c__3, (ftnlen)24); +#line 20257 "" + } +#line 20259 "" + if (comget_1.movbrk == 0 && comlast_1.islast) { +#line 20259 "" + s_wsfe(&io___1338); +/* Writing concatenation */ +#line 20259 "" + i__5[0] = lnote, a__3[0] = notexq; +#line 20259 "" + i__5[1] = lclef, a__3[1] = fmtq; +#line 20259 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20259 "" + i__5[3] = 3, a__3[3] = "en%"; +#line 20259 "" + s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107); +#line 20259 "" + do_fio(&c__1, ch__12, lnote + lclef + 4); +#line 20259 "" + e_wsfe(); +#line 20259 "" + } +/* call wsclef(iv,ninow,clefq,nclef) */ +#line 20263 "" + 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 20268 "" + newclef = TRUE_; + +/* 151220 */ +/* wrong test: */ +/* If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% */ +/* Replaced with right one. But also, clefq(iv) seems to stay at 8 here, */ +/* and if we change from TLO to normal clef, need to resetclefsymbols */ + +/* if (clefq(iv) .eq. '8') then */ +#line 20277 "" + if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2) + ) { +#line 20278 "" + if (all_1.iv <= 9) { +#line 20279 "" + s_wsfe(&io___1339); +/* Writing concatenation */ +#line 20279 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20279 "" + i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; +#line 20279 "" + s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); +#line 20279 "" + do_fio(&c__1, ch__6, (ftnlen)20); +#line 20279 "" + do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 20279 "" + i__11[0] = 1, a__8[0] = all_1.sq; +#line 20279 "" + i__11[1] = 13, a__8[1] = "treblelowoct%"; +#line 20279 "" + s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); +#line 20279 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20279 "" + e_wsfe(); +#line 20281 "" + } else { +#line 20282 "" + s_wsfe(&io___1340); +/* Writing concatenation */ +#line 20282 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20282 "" + i__6[1] = 19, a__4[1] = "settrebleclefsymbol"; +#line 20282 "" + s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20); +#line 20282 "" + do_fio(&c__1, ch__6, (ftnlen)20); +#line 20282 "" + do_fio(&c__1, (char *)&all_1.nv, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 20282 "" + i__11[0] = 1, a__8[0] = all_1.sq; +#line 20282 "" + i__11[1] = 13, a__8[1] = "treblelowoct%"; +#line 20282 "" + s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14); +#line 20282 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20282 "" + e_wsfe(); +#line 20284 "" + } +#line 20285 "" + } else { +#line 20286 "" + if (*(unsigned char *)&comclefq_1.clefq[all_1.iv - 1] + == '8') { +#line 20287 "" + s_wsfe(&io___1341); +/* Writing concatenation */ +#line 20287 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20287 "" + i__6[1] = 16, a__4[1] = "resetclefsymbols"; +#line 20287 "" + s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)17); +#line 20287 "" + do_fio(&c__1, ch__13, (ftnlen)17); +#line 20287 "" + e_wsfe(); +#line 20288 "" + } +#line 20289 "" + } +#line 20290 "" + } +#line 20291 "" +/* L17: */ +#line 20291 "" + } +#line 20292 "" + if (comlast_1.islast) { +#line 20292 "" + s_wsfe(&io___1342); +/* Writing concatenation */ +#line 20292 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20292 "" + i__6[1] = 11, a__4[1] = "pmxnewclefs"; +#line 20292 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20292 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20292 "" + e_wsfe(); +#line 20292 "" + } +#line 20293 "" + } +#line 20294 "" +L23: + +/* Kluge \CenterBar for whole bar rests if necessary */ + +#line 20298 "" + if (newclef && comclefrests_1.centrests) { +/* write(11,'(a)')sq//'def'//sq//'value{11}%' */ +#line 20300 "" + r__1 = all_1.musicsize * .55f; +#line 20300 "" + nvalue = i_nint(&r__1); +#line 20301 "" + if (nvalue > 10) { +#line 20302 "" + s_wsfe(&io___1344); +/* Writing concatenation */ +#line 20302 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20302 "" + i__5[1] = 3, a__3[1] = "def"; +#line 20302 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20302 "" + i__5[3] = 6, a__3[3] = "value{"; +#line 20302 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 20302 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20302 "" + do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); +#line 20302 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 20302 "" + e_wsfe(); +#line 20304 "" + } else { +#line 20305 "" + s_wsfe(&io___1345); +/* Writing concatenation */ +#line 20305 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20305 "" + i__5[1] = 3, a__3[1] = "def"; +#line 20305 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20305 "" + i__5[3] = 6, a__3[3] = "value{"; +#line 20305 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 20305 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20305 "" + do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer)); +#line 20305 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 20305 "" + e_wsfe(); +#line 20307 "" + } +#line 20308 "" + } +#line 20309 "" + newclef = FALSE_; +#line 20310 "" + comclefrests_1.centrests = FALSE_; + +/* End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */ + +#line 20314 "" + if (comask_1.bar1syst) { +#line 20315 "" + s_rsle(&io___1346); +#line 20315 "" + do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof( + real)); +#line 20315 "" + e_rsle(); +#line 20316 "" + } + +/* Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */ + +#line 20320 "" + if (all_1.ibar == 1) { +#line 20321 "" + islnow = all_1.islur[0]; +/* iornqnow = iornq(1,1) */ +#line 20323 "" + iplnow = all_1.ipl[0]; +#line 20324 "" + } else { +#line 20325 "" + 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 20327 "" + iplnow = all_1.ipl[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) * + 24 - 24]; +#line 20328 "" + } + +/* Check for R-symbols set at end of prior input block */ + +#line 20332 "" + if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E') + { +#line 20333 "" + if (*(unsigned char *)comget_1.rptfq2 == 'D') { +#line 20334 "" + islnow = bit_set(islnow,26); +#line 20335 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'r') { +#line 20336 "" + islnow = bit_set(islnow,6); +#line 20337 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { +#line 20338 "" + islnow = bit_set(islnow,8); +#line 20339 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { +#line 20340 "" + islnow = bit_set(islnow,25); +#line 20341 "" + } else { +#line 20342 "" + s_wsle(&io___1349); +#line 20342 "" + e_wsle(); +#line 20343 "" + s_wsle(&io___1350); +#line 20343 "" + do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"\ + "put block:", (ftnlen)46); +#line 20343 "" + do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 20343 "" + e_wsle(); +#line 20345 "" + stop1_(); +#line 20346 "" + } +#line 20347 "" + *(unsigned char *)comget_1.rptfq2 = 'E'; +#line 20348 "" + } +#line 20349 "" + if ((islnow & 352) != 0) { + +/* Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */ + +#line 20353 "" + lrpt = bit_test(islnow,5); +#line 20354 "" + rrpt = bit_test(islnow,6); +#line 20355 "" + lrptpend = lrpt && comask_1.bar1syst; +#line 20356 "" + if (lrpt && ! lrptpend) { +#line 20357 "" + if (rrpt) { +#line 20358 "" + if (comlast_1.islast) { +#line 20358 "" + s_wsfe(&io___1353); +/* Writing concatenation */ +#line 20358 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20358 "" + i__6[1] = 18, a__4[1] = "setleftrightrepeat"; +#line 20358 "" + s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19); +#line 20358 "" + do_fio(&c__1, ch__11, (ftnlen)19); +#line 20358 "" + e_wsfe(); +#line 20358 "" + } +#line 20359 "" + comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * + spfacs_1.lrrptfac - .4f; +#line 20360 "" + } else { +#line 20361 "" + if (comlast_1.islast) { +#line 20361 "" + s_wsfe(&io___1354); +/* Writing concatenation */ +#line 20361 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20361 "" + i__6[1] = 13, a__4[1] = "setleftrepeat"; +#line 20361 "" + s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14); +#line 20361 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20361 "" + e_wsfe(); +#line 20361 "" + } +#line 20362 "" + comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * + spfacs_1.rptfac - .4f; +#line 20363 "" + } +#line 20364 "" + } else if (rrpt) { +#line 20365 "" + if (comlast_1.islast) { +#line 20365 "" + s_wsfe(&io___1355); +/* Writing concatenation */ +#line 20365 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20365 "" + i__6[1] = 14, a__4[1] = "setrightrepeat"; +#line 20365 "" + s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); +#line 20365 "" + do_fio(&c__1, ch__16, (ftnlen)15); +#line 20365 "" + e_wsfe(); +#line 20365 "" + } +#line 20366 "" + comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * + spfacs_1.rptfac - .4f; +#line 20367 "" + } else if (bit_test(islnow,8)) { +#line 20368 "" + if (comlast_1.islast) { +#line 20368 "" + s_wsfe(&io___1356); +/* Writing concatenation */ +#line 20368 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20368 "" + i__6[1] = 12, a__4[1] = "setdoublebar"; +#line 20368 "" + s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 20368 "" + do_fio(&c__1, ch__17, (ftnlen)13); +#line 20368 "" + e_wsfe(); +#line 20368 "" + } +#line 20369 "" + comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * + spfacs_1.dbarfac - .4f; +#line 20370 "" + } +#line 20371 "" + } else if (bit_test(islnow,26)) { + +/* doubleBAR */ + +#line 20375 "" + if (comlast_1.islast) { +#line 20375 "" + s_wsfe(&io___1357); +/* Writing concatenation */ +#line 20375 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20375 "" + i__6[1] = 12, a__4[1] = "setdoubleBAR"; +#line 20375 "" + s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 20375 "" + do_fio(&c__1, ch__17, (ftnlen)13); +#line 20375 "" + e_wsfe(); +#line 20375 "" + } +#line 20376 "" + comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt * + spfacs_1.ddbarfac - .4f; +/* else if (btest(iornqnow,29)) then */ +#line 20378 "" + } else if (bit_test(iplnow,0)) { + +/* no bar line */ + +/* -- if (islast) write(11,'(a)')sq//'setzalaligne' */ +/* ++ */ +#line 20384 "" + if (comlast_1.islast) { +#line 20385 "" + if (comget_1.movbrk == 0) { +#line 20386 "" + s_wsfe(&io___1358); +/* Writing concatenation */ +#line 20386 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20386 "" + i__6[1] = 12, a__4[1] = "setzalaligne"; +#line 20386 "" + s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13); +#line 20386 "" + do_fio(&c__1, ch__17, (ftnlen)13); +#line 20386 "" + e_wsfe(); +#line 20387 "" + } 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 20393 "" + *(unsigned char *)comget_1.rptfq2 = 'z'; +#line 20394 "" + } +#line 20395 "" + } +/* ++ */ +#line 20397 "" + comask_1.fixednew += -.4f; +#line 20398 "" + } + +/* 1st and 2nd endings */ + +#line 20402 "" + svolta = bit_test(islnow,7); +#line 20403 "" + evolta = bit_test(islnow,9); +#line 20404 "" + if (evolta) { +#line 20405 "" + if (bit_test(islnow,10)) { +#line 20406 "" + if (comlast_1.islast) { +#line 20406 "" + s_wsfe(&io___1361); +/* Writing concatenation */ +#line 20406 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20406 "" + i__6[1] = 11, a__4[1] = "endvoltabox"; +#line 20406 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20406 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20406 "" + e_wsfe(); +#line 20406 "" + } +#line 20407 "" + } else { +#line 20408 "" + if (comlast_1.islast) { +#line 20408 "" + s_wsfe(&io___1362); +/* Writing concatenation */ +#line 20408 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20408 "" + i__6[1] = 8, a__4[1] = "endvolta"; +#line 20408 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 20408 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20408 "" + e_wsfe(); +#line 20408 "" + } +#line 20409 "" + } +#line 20410 "" + onvolt = FALSE_; +#line 20411 "" + } +#line 20412 "" + if (svolta) { +#line 20413 "" + ++comgrace_1.nvolt; +#line 20414 "" + lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, + " ", (ftnlen)20, (ftnlen)1) - 1; +#line 20415 "" + if (lvoltxt == 1) { +#line 20416 "" + if (comlast_1.islast) { +#line 20416 "" + s_wsfe(&io___1364); +/* Writing concatenation */ +#line 20416 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20416 "" + i__5[1] = 8, a__3[1] = "Setvolta"; +#line 20416 "" + i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + ( + comgrace_1.nvolt - 1) * 20; +#line 20416 "" + i__5[3] = 1, a__3[3] = "%"; +#line 20416 "" + s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11); +#line 20416 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20416 "" + e_wsfe(); +#line 20416 "" + } +#line 20418 "" + } else { +#line 20419 "" + if (comlast_1.islast) { +#line 20419 "" + s_wsfe(&io___1365); +/* Writing concatenation */ +#line 20419 "" + i__12[0] = 1, a__9[0] = all_1.sq; +#line 20419 "" + i__12[1] = 8, a__9[1] = "Setvolta"; +#line 20419 "" + i__12[2] = 1, a__9[2] = "{"; +#line 20419 "" + i__12[3] = lvoltxt, a__9[3] = comgrace_1.voltxtq + ( + comgrace_1.nvolt - 1) * 20; +#line 20419 "" + i__12[4] = 2, a__9[4] = "}%"; +#line 20419 "" + s_cat(ch__19, a__9, i__12, &c__5, (ftnlen)32); +#line 20419 "" + do_fio(&c__1, ch__19, lvoltxt + 12); +#line 20419 "" + e_wsfe(); +#line 20419 "" + } +#line 20421 "" + } +#line 20422 "" + onvolt = TRUE_; +#line 20423 "" + } +#line 20424 "" + if (all_1.ibar > 1) { +#line 20425 "" + ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1; +#line 20426 "" + } else { +#line 20427 "" + ipnow = 1; +#line 20428 "" + } +#line 20429 "" + iplnow = all_1.ipl[ipnow * 24 - 24]; +#line 20430 "" + if (comask_1.bar1syst) { + +/* If listslur>0, then there is at least one slur or tie carried over the break */ + +#line 20434 "" + ispstie = FALSE_; +#line 20435 "" + if (comnotes_1.optlinebreakties && ! comslur_1.fontslur && + comslur_1.listslur != 0 && comlast_1.islast) { +#line 20435 "" + linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, + all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( + ftnlen)1); +#line 20435 "" + } +#line 20439 "" + ++all_1.iline; + +/* End an old system, Start a new system */ + +/* Reduce space before mbrest at start of system */ +/* Need this even if no accidentals in key signature */ + +#line 20446 "" + if (all_1.ibar == comgrace_1.ibarmbr) { +#line 20446 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 20446 "" + } + +#line 20448 "" + if (all_1.iline != 1) { + +/* Not first line. */ +/* Get corrected poe = points/elemskip for *previous* system */ + +#line 20453 "" + wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); +#line 20454 "" + poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - + comask_1.fixednew) / (elsktot + comask_1.fbar * + nbarss - comask_1.scaldold); +#line 20456 "" + ++isyscnt; +#line 20457 "" + poevec[isyscnt] = poe; + +/* Transfer data for system into global arrays to hold until very end */ + +#line 20461 "" + i__7 = comas2_1.nasksys; +#line 20461 "" + for (ia = 1; ia <= i__7; ++ia) { +#line 20462 "" + ++comas3_1.iask; +#line 20463 "" + 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 20467 "" + if (comas2_1.elasksys[ia - 1] > 0.f) { +#line 20467 "" + comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ + comas3_1.iask - 1], &c_b762); +#line 20467 "" + } +#line 20468 "" +/* L9: */ +#line 20468 "" + } +#line 20469 "" + i__7 = nhssys; +#line 20469 "" + for (ia = 1; ia <= i__7; ++ia) { +#line 20470 "" + ++nhstot; +/* Computing MAX */ +#line 20471 "" + r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; +#line 20471 "" + comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); +#line 20472 "" +/* L25: */ +#line 20472 "" + } + +/* Reset counters for new system */ + +#line 20476 "" + comask_1.scaldold = 0.f; +#line 20477 "" + comask_1.fixednew = 0.f; +#line 20478 "" + comas2_1.nasksys = 0; +#line 20479 "" + nhssys = 0; +#line 20480 "" + } + +/* End of if block for first bar of non-first system. Still 1st bar, any system */ + +#line 20484 "" + if (comlast_1.islast && all_1.figbass) { +#line 20484 "" + s_wsfe(&io___1374); +/* Writing concatenation */ +#line 20484 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20484 "" + i__6[1] = 8, a__4[1] = "fixdrop%"; +#line 20484 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 20484 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20484 "" + e_wsfe(); +#line 20484 "" + } +#line 20485 "" + ++isystpg; + +/* Try moving the next stmt way down, to fix a bug and get \eject printed at */ +/* end of single-system page. */ +/* if (isystpg .eq. nsystp(ipage)) isystpg = 0 */ +#line 20490 "" + s_rsle(&io___1375); +#line 20490 "" + do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer)); +#line 20490 "" + do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real)); +#line 20490 "" + do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real)); +#line 20490 "" + do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real)); +#line 20490 "" + do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real)) + ; +#line 20490 "" + do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real) + ); +#line 20490 "" + e_rsle(); +#line 20491 "" + if (all_1.iline > 1) { +#line 20491 "" + comtop_1.fracindent = frac; +#line 20491 "" + } +#line 20492 "" + if (all_1.figbass) { +#line 20493 "" + all_1.ifigdr[(all_1.iline << 1) - 2] = 4; +#line 20494 "" + all_1.ifigdr[(all_1.iline << 1) - 1] = 4; +#line 20495 "" + } +#line 20496 "" + all_1.slfac = slfac1 * all_1.musicsize * elsktot; +#line 20497 "" + if (all_1.iline != 1) { + +/* For the line just _finished_, put figdrop in separate file. */ + +#line 20501 "" + if (all_1.figbass) { +#line 20501 "" + s_wsfe(&io___1377); +/* Writing concatenation */ +#line 20501 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20501 "" + i__6[1] = 8, a__4[1] = "figdrop="; +#line 20501 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 20501 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20501 "" + do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) + - 2], (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 20501 "" + i__8[0] = 1, a__5[0] = " "; +#line 20501 "" + i__8[1] = 1, a__5[1] = all_1.sq; +#line 20501 "" + i__8[2] = 8, a__5[2] = "figdtwo="; +#line 20501 "" + s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); +#line 20501 "" + do_fio(&c__1, ch__20, (ftnlen)10); +#line 20501 "" + do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1) + - 1], (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 20501 "" + i__11[0] = 1, a__8[0] = all_1.sq; +#line 20501 "" + i__11[1] = 3, a__8[1] = "or%"; +#line 20501 "" + s_cat(ch__21, a__8, i__11, &c__2, (ftnlen)4); +#line 20501 "" + do_fio(&c__1, ch__21, (ftnlen)4); +#line 20501 "" + e_wsfe(); +#line 20501 "" + } + +/* 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 20509 "" + r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f; +#line 20509 "" + ndigbn = (integer) r_lg10(&r__1) + 1; +#line 20510 "" + comsln_1.isnx = 0; +#line 20511 "" + 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 20517 "" + ioff = 0; +#line 20518 "" + if (all_1.ibar > 1) { +#line 20518 "" + 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 20518 "" + } +#line 20519 "" + i__7 = all_1.nsdat; +#line 20519 "" + for (isdat = 1; isdat <= i__7; ++isdat) { +#line 20520 "" + 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( + all_1.isdat1[isdat - 1],11) && igetbits_(& + all_1.isdat1[isdat - 1], &c__7, &c__19) == + comsln_1.is2n1) { + +/* Found slur ending. Just check note height, can't do fine adjustments. */ + +/* is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */ +/* Computing MAX */ +#line 20527 "" + i__2 = comsln_1.is1n1, i__13 = igetbits_(& + all_1.isdat2[isdat - 1], &c__7, &c__19); +#line 20527 "" + comsln_1.is1n1 = max(i__2,i__13); +#line 20528 "" + goto L51; +#line 20529 "" + } +#line 20530 "" +/* L50: */ +#line 20530 "" + } + +/* If exiting loop normally, did not find end of slur. c'est la vie. */ + +#line 20534 "" +L51: +#line 20535 "" + i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd; +#line 20535 "" + comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7); +#line 20536 "" + if (comsln_1.isnx > 0) { + +/* AHA! Slur likely to interfere with barno. */ + +/* Modified 090525 to use \bnrs */ + +#line 20542 "" + slint = TRUE_; +#line 20543 "" + s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12); +#line 20544 "" + if (comsln_1.irzbnd + comsln_1.isnx > 9) { +#line 20544 "" + s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen) + 12); +#line 20544 "" + } +#line 20545 "" + if (comlast_1.islast) { +#line 20545 "" + s_wsfe(&io___1380); +/* Writing concatenation */ +#line 20545 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20545 "" + i__5[1] = 3, a__3[1] = "def"; +#line 20545 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20545 "" + i__5[3] = 11, a__3[3] = "raisebarno{"; +#line 20545 "" + s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); +#line 20545 "" + do_fio(&c__1, ch__22, (ftnlen)16); +#line 20545 "" + i__7 = comsln_1.irzbnd + comsln_1.isnx; +#line 20545 "" + do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof( + integer)); +/* Writing concatenation */ +#line 20545 "" + i__8[0] = 2, a__5[0] = ".5"; +#line 20545 "" + i__8[1] = 1, a__5[1] = all_1.sq; +#line 20545 "" + i__8[2] = 11, a__5[2] = "internote}%"; +#line 20545 "" + s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); +#line 20545 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20545 "" + e_wsfe(); +#line 20545 "" + } +/* if (islast) then */ +/* if (isnx .le. 9) then */ +/* write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%' */ +/* else */ +/* write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%' */ +/* end if */ +/* end if */ + +#line 20555 "" + } +#line 20556 "" + } +#line 20557 "" + if (comget_1.movbrk > 0) { + +/* movbrk = 0 */ +/* Move the reset down, so can use movbrk>0 to stop extra meter prints. */ + +/* New movement. Redefine stoppiece, contpiece. These will be called either */ +/* explicitly or as part of alaligne. */ +/* indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */ +/* This is passed to \newmovement. */ + +#line 20567 "" + if (*(unsigned char *)comget_1.rptfq2 == 'E') { +#line 20567 "" + *(unsigned char *)comget_1.rptfq2 = 'D'; +#line 20567 "" + } +#line 20568 "" + indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, ( + ftnlen)1) - 1; +#line 20569 "" + *(unsigned char *)comget_1.rptfq2 = 'E'; + +/* Also check for Rd or Rr set the normal way */ + +#line 20573 "" + if (bit_test(islnow,8)) { +#line 20574 "" + indsym = 1; +#line 20575 "" + } else if (bit_test(islnow,6)) { +#line 20576 "" + indsym = 2; +#line 20577 "" + } +#line 20578 "" + if (indsym < 0) { +#line 20579 "" + s_wsle(&io___1382); +#line 20579 "" + e_wsle(); +#line 20580 "" + s_wsle(&io___1383); +#line 20580 "" + do_lio(&c__9, &c__1, "Illegal end symbol before \"/\"" + , (ftnlen)29); +#line 20580 "" + e_wsle(); +#line 20581 "" + stop1_(); +#line 20582 "" + } + +/* Check for continuation (no bar number reset) */ + +#line 20586 "" + if (comlast_1.islast && comnotes_1.nobar1) { +#line 20586 "" + s_wsfe(&io___1384); +/* Writing concatenation */ +#line 20586 "" + i__14[0] = 1, a__10[0] = all_1.sq; +#line 20586 "" + i__14[1] = 7, a__10[1] = "advance"; +#line 20586 "" + i__14[2] = 1, a__10[2] = all_1.sq; +#line 20586 "" + i__14[3] = 6, a__10[3] = "barno1"; +#line 20586 "" + i__14[4] = 1, a__10[4] = all_1.sq; +#line 20586 "" + i__14[5] = 10, a__10[5] = "startbarno"; +#line 20586 "" + i__14[6] = 1, a__10[6] = all_1.sq; +#line 20586 "" + i__14[7] = 6, a__10[7] = "barno%"; +#line 20586 "" + s_cat(ch__23, a__10, i__14, &c__8, (ftnlen)33); +#line 20586 "" + do_fio(&c__1, ch__23, (ftnlen)33); +#line 20586 "" + e_wsfe(); +#line 20586 "" + } + +/* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */ + +/* if (movgap .lt. 10) then */ +/* if (islast) write(11,'(a12,2i1,a1)') */ +/* * sq//'newmovement',movgap,indsym,'%' */ +/* else */ +/* if (islast) write(11,'(a13,i2,a1,i1,a1)') */ +/* * sq//'newmovement{',movgap,'}',indsym,'%' */ +/* end if */ +#line 20599 "" + if (comlast_1.islast) { +/* Writing concatenation */ +#line 20600 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20600 "" + i__6[1] = 11, a__4[1] = "newmovement"; +#line 20600 "" + s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40); +#line 20601 "" + lnmq = 12; +#line 20602 "" + if (comget_1.movgap < 10) { +#line 20603 "" + lnmq = 14; +#line 20604 "" + s_wsfi(&io___1387); +#line 20604 "" + do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) + sizeof(integer)); +#line 20604 "" + do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( + integer)); +#line 20604 "" + e_wsfi(); +#line 20605 "" + } else { +#line 20606 "" + lnmq = 17; +#line 20607 "" + s_wsfi(&io___1388); +#line 20607 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 20607 "" + do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen) + sizeof(integer)); +#line 20607 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 20607 "" + do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof( + integer)); +#line 20607 "" + e_wsfi(); +#line 20608 "" + } +#line 20609 "" + if (comnotes_1.ninow < 10) { +#line 20610 "" + ++lnmq; +#line 20611 "" + ici__1.icierr = 0; +#line 20611 "" + ici__1.icirnum = 1; +#line 20611 "" + ici__1.icirlen = 1; +#line 20611 "" + ici__1.iciunit = nmq + (lnmq - 1); +#line 20611 "" + ici__1.icifmt = "(i1)"; +#line 20611 "" + s_wsfi(&ici__1); +#line 20611 "" + do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) + sizeof(integer)); +#line 20611 "" + e_wsfi(); +#line 20612 "" + } else { +#line 20613 "" + lnmq += 4; +#line 20614 "" + i__7 = lnmq - 4; +#line 20614 "" + ici__1.icierr = 0; +#line 20614 "" + ici__1.icirnum = 1; +#line 20614 "" + ici__1.icirlen = lnmq - i__7; +#line 20614 "" + ici__1.iciunit = nmq + i__7; +#line 20614 "" + ici__1.icifmt = "(a1,i2,a1)"; +#line 20614 "" + s_wsfi(&ici__1); +#line 20614 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 20614 "" + do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen) + sizeof(integer)); +#line 20614 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 20614 "" + e_wsfi(); +#line 20615 "" + } +#line 20616 "" + ++lnmq; +#line 20617 "" + ici__1.icierr = 0; +#line 20617 "" + ici__1.icirnum = 1; +#line 20617 "" + ici__1.icirlen = 1; +#line 20617 "" + ici__1.iciunit = nmq + (lnmq - 1); +#line 20617 "" + ici__1.icifmt = "(a1)"; +#line 20617 "" + s_wsfi(&ici__1); +#line 20617 "" + do_fio(&c__1, "%", (ftnlen)1); +#line 20617 "" + e_wsfi(); +#line 20618 "" + s_wsfe(&io___1389); +#line 20618 "" + do_fio(&c__1, nmq, lnmq); +#line 20618 "" + e_wsfe(); +#line 20619 "" + } + +/* Change generalmeter if necessary */ + +#line 20623 "" + if (comlast_1.islast) { +#line 20623 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20623 "" + } + +/* (Moved all name-writing to getnote, right when 'M' is detected) */ + +#line 20627 "" + if (bit_test(iplnow,28)) { + +/* Key signature at movement break */ + +#line 20631 "" + iplnow = bit_clear(iplnow,28); +#line 20632 "" + if (comtop_1.isig > 0) { +#line 20633 "" + if (comlast_1.islast) { +#line 20633 "" + s_wsfe(&io___1390); +/* Writing concatenation */ +#line 20633 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20633 "" + i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 20633 "" + s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18); +#line 20633 "" + do_fio(&c__1, ch__24, (ftnlen)18); +#line 20633 "" + do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) + sizeof(integer)); +#line 20633 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 20633 "" + e_wsfe(); +#line 20633 "" + } +#line 20635 "" + } else { +#line 20636 "" + if (comlast_1.islast) { +#line 20636 "" + s_wsfe(&io___1391); +/* Writing concatenation */ +#line 20636 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20636 "" + i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 20636 "" + s_cat(ch__24, a__4, i__6, &c__2, (ftnlen)18); +#line 20636 "" + do_fio(&c__1, ch__24, (ftnlen)18); +#line 20636 "" + do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen) + sizeof(integer)); +#line 20636 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 20636 "" + e_wsfe(); +#line 20636 "" + } +#line 20638 "" + } +#line 20639 "" + if (comlast_1.islast && cominsttrans_1.laterinsttrans) + { +#line 20640 "" + writesetsign_(&cominsttrans_1.ninsttrans, + cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, & + cominsttrans_1.laterinsttrans); +#line 20642 "" + } +#line 20643 "" + } +#line 20644 "" + if (comget_1.parmov >= -.1f) { + +/* Resent paragraph indentation */ + +#line 20648 "" + ipi = comget_1.parmov * comtop_1.widthpt + .1f; +#line 20649 "" + if (ipi < 10) { +#line 20650 "" + if (comlast_1.islast) { +#line 20650 "" + s_wsfe(&io___1393); +/* Writing concatenation */ +#line 20650 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20650 "" + i__6[1] = 10, a__4[1] = "parindent "; +#line 20650 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 20650 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20650 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( + integer)); +#line 20650 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 20650 "" + e_wsfe(); +#line 20650 "" + } +#line 20652 "" + } else if (ipi < 100) { +#line 20653 "" + if (comlast_1.islast) { +#line 20653 "" + s_wsfe(&io___1394); +/* Writing concatenation */ +#line 20653 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20653 "" + i__6[1] = 10, a__4[1] = "parindent "; +#line 20653 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 20653 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20653 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( + integer)); +#line 20653 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 20653 "" + e_wsfe(); +#line 20653 "" + } +#line 20655 "" + } else { +#line 20656 "" + if (comlast_1.islast) { +#line 20656 "" + s_wsfe(&io___1395); +/* Writing concatenation */ +#line 20656 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20656 "" + i__6[1] = 10, a__4[1] = "parindent "; +#line 20656 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 20656 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20656 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof( + integer)); +#line 20656 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 20656 "" + e_wsfe(); +#line 20656 "" + } +#line 20658 "" + } +#line 20659 "" + } +#line 20660 "" + } +#line 20661 "" + if (isystpg == 1) { + +/* First line on a page (not 1st page, still first bar). Tidy up old page */ +/* then eject. */ + +/* Removed this 5/13/01 as it was causing double endvoltas. This probably */ +/* is only needed at the end in case there is no endvolta specified. */ +/* if (onvolt) then */ +/* c if (islast) write(11,'(a)')sq//'endvoltabox%' */ +/* c onvolt = .false. */ +/* end if */ + + +/* Check for meter change at start of a new PAGE */ + +#line 20676 "" + if (all_1.mtrnuml > 0) { + +/* Meter change at start of a new page. Ugly repeated coding here. */ + +#line 20680 "" + mtrnms = all_1.mtrnuml; +#line 20681 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & + combeam_1.ibmtyp, &ibmrep); +#line 20682 "" + all_1.mtrnuml = mtrnms; +#line 20683 "" + if (comget_1.movbrk == 0 && comlast_1.islast) { +#line 20683 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20683 "" + } +#line 20685 "" + } + +/* Key signature change? */ + +#line 20689 "" + if (bit_test(iplnow,28) && comget_1.movbrk == 0) { +/* Writing concatenation */ +#line 20690 "" + i__14[0] = 1, a__10[0] = all_1.sq; +#line 20690 "" + i__14[1] = 4, a__10[1] = "xbar"; +#line 20690 "" + i__14[2] = 1, a__10[2] = all_1.sq; +#line 20690 "" + i__14[3] = 10, a__10[3] = "addspace{-"; +#line 20690 "" + i__14[4] = 1, a__10[4] = all_1.sq; +#line 20690 "" + i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 20690 "" + i__14[6] = 1, a__10[6] = all_1.sq; +#line 20690 "" + i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 20690 "" + s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 20692 "" + lnote = 49; +#line 20693 "" + if (comtop_1.isig < 0) { +/* Writing concatenation */ +#line 20694 "" + i__6[0] = 49, a__4[0] = notexq; +#line 20694 "" + i__6[1] = 1, a__4[1] = "-"; +#line 20694 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20695 "" + lnote = 50; +#line 20696 "" + } +#line 20697 "" + if (comlast_1.islast) { +#line 20697 "" + s_wsfe(&io___1397); +/* Writing concatenation */ +#line 20697 "" + i__8[0] = lnote, a__5[0] = notexq; +#line 20697 "" + i__7 = abs(comtop_1.isig) + 48; +#line 20697 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 20697 "" + i__8[1] = 1, a__5[1] = ch__1; +#line 20697 "" + i__8[2] = 2, a__5[2] = "}%"; +#line 20697 "" + s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 20697 "" + do_fio(&c__1, ch__25, lnote + 3); +#line 20697 "" + e_wsfe(); +#line 20697 "" + } +#line 20699 "" + if (comlast_1.islast && cominsttrans_1.laterinsttrans) + { +#line 20700 "" + writesetsign_(&cominsttrans_1.ninsttrans, + cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, & + cominsttrans_1.laterinsttrans); +#line 20702 "" + } +#line 20703 "" + if (comlast_1.islast && comignorenats_1.ignorenats) { +#line 20703 "" + s_wsfe(&io___1398); +/* Writing concatenation */ +#line 20703 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20703 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20703 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20703 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20703 "" + e_wsfe(); +#line 20703 "" + } +#line 20705 "" + if (comlast_1.islast) { +#line 20705 "" + s_wsfe(&io___1399); +/* Writing concatenation */ +#line 20705 "" + i__9[0] = 1, a__6[0] = all_1.sq; +#line 20705 "" + i__9[1] = 14, a__6[1] = "zchangecontext"; +#line 20705 "" + i__9[2] = 1, a__6[2] = all_1.sq; +#line 20705 "" + i__9[3] = 10, a__6[3] = "addspace{-"; +#line 20705 "" + i__9[4] = 1, a__6[4] = all_1.sq; +#line 20705 "" + i__9[5] = 14, a__6[5] = "afterruleskip}"; +#line 20705 "" + i__9[6] = 1, a__6[6] = all_1.sq; +#line 20705 "" + i__9[7] = 10, a__6[7] = "zstoppiece"; +#line 20705 "" + i__9[8] = 1, a__6[8] = all_1.sq; +#line 20705 "" + i__9[9] = 13, a__6[9] = "PMXbarnotrue%"; +#line 20705 "" + s_cat(ch__26, a__6, i__9, &c__10, (ftnlen)66); +#line 20705 "" + do_fio(&c__1, ch__26, (ftnlen)66); +#line 20705 "" + e_wsfe(); +#line 20705 "" + } +#line 20708 "" + } else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) { + +/* Meter change but no signature change */ + +#line 20712 "" + if (comlast_1.islast) { +#line 20712 "" + s_wsfe(&io___1400); +/* Writing concatenation */ +#line 20712 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 20712 "" + i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 20712 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 20712 "" + i__3[3] = 10, a__1[3] = "addspace{-"; +#line 20712 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 20712 "" + i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 20712 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 20712 "" + i__3[7] = 3, a__1[7] = "let"; +#line 20712 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 20712 "" + i__3[9] = 4, a__1[9] = "bnat"; +#line 20712 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 20712 "" + i__3[11] = 9, a__1[11] = "barnoadd%"; +#line 20712 "" + s_cat(ch__27, a__1, i__3, &c__12, (ftnlen)60); +#line 20712 "" + do_fio(&c__1, ch__27, (ftnlen)60); +#line 20712 "" + e_wsfe(); +#line 20712 "" + } +#line 20716 "" + if (comlast_1.islast) { +#line 20716 "" + s_wsfe(&io___1401); +/* Writing concatenation */ +#line 20716 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 20716 "" + i__3[1] = 3, a__1[1] = "def"; +#line 20716 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 20716 "" + i__3[3] = 9, a__1[3] = "barnoadd{"; +#line 20716 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 20716 "" + i__3[5] = 3, a__1[5] = "let"; +#line 20716 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 20716 "" + i__3[7] = 8, a__1[7] = "barnoadd"; +#line 20716 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 20716 "" + i__3[9] = 5, a__1[9] = "bnat}"; +#line 20716 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 20716 "" + i__3[11] = 11, a__1[11] = "zstoppiece%"; +#line 20716 "" + s_cat(ch__28, a__1, i__3, &c__12, (ftnlen)45); +#line 20716 "" + do_fio(&c__1, ch__28, (ftnlen)45); +#line 20716 "" + e_wsfe(); +#line 20716 "" + } +#line 20719 "" + } else { +#line 20720 "" + if (comlast_1.islast) { +#line 20720 "" + s_wsfe(&io___1402); +/* Writing concatenation */ +#line 20720 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20720 "" + i__6[1] = 10, a__4[1] = "stoppiece%"; +#line 20720 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 20720 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20720 "" + e_wsfe(); +#line 20720 "" + } +#line 20721 "" + } + +/* This is the key spot when vshrink is used. Value of vshrink here comes from */ +/* just after the prior pagebreak, i.e., it is not affected by "Av" */ +/* that may have been entered at this pagebreak, since that only affects usevshrink. */ +/* So choose page *ending* (with or without \vfill) depending on old vshrink. Then */ +/* check value of usevshrink to reset vshrink if necessary for the new page, where */ +/* we have to set \interstaff and later call puttitle. */ +/* Top of first page needs special treatment. For this we use */ +/* novshrinktop, which was set in g1etnote on the first pass, since on */ +/* 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 20734 "" + if (! vshrink) { +#line 20735 "" + xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / + etatop; +#line 20736 "" + if (xnstbot < 9.95f) { +#line 20737 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10) + ; +#line 20738 "" + } else { +#line 20739 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10) + ; +#line 20740 "" + } +#line 20741 "" + if (comlast_1.islast) { +#line 20741 "" + s_wsfe(&io___1404); +/* Writing concatenation */ +#line 20741 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20741 "" + i__6[1] = 5, a__4[1] = "vskip"; +#line 20741 "" + s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6); +#line 20741 "" + do_fio(&c__1, ch__29, (ftnlen)6); +#line 20741 "" + do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof( + real)); +/* Writing concatenation */ +#line 20741 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20741 "" + i__5[1] = 10, a__3[1] = "Interligne"; +#line 20741 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20741 "" + i__5[3] = 6, a__3[3] = "eject%"; +#line 20741 "" + s_cat(ch__24, a__3, i__5, &c__4, (ftnlen)18); +#line 20741 "" + do_fio(&c__1, ch__24, (ftnlen)18); +#line 20741 "" + e_wsfe(); +#line 20741 "" + } +#line 20743 "" + } else { +#line 20744 "" + if (comlast_1.islast) { +#line 20744 "" + s_wsfe(&io___1405); +/* Writing concatenation */ +#line 20744 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20744 "" + i__5[1] = 5, a__3[1] = "vfill"; +#line 20744 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20744 "" + i__5[3] = 6, a__3[3] = "eject%"; +#line 20744 "" + s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)13); +#line 20744 "" + do_fio(&c__1, ch__17, (ftnlen)13); +#line 20744 "" + e_wsfe(); +#line 20744 "" + } +#line 20745 "" + } +#line 20746 "" + ++comnotes_1.ipage; + +/* Now that page is ejected, compute new vshrink */ + +#line 20750 "" + vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f && + comlast_1.usevshrink; +#line 20751 "" + if (vshrink) { +#line 20752 "" + comarp_1.xinsnow = 10.f; +#line 20753 "" + } else { +#line 20754 "" + comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1]; +#line 20755 "" + } +#line 20756 "" + if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) { +#line 20757 "" + comarp_1.xinsnow = comarp_1.xinsnow * + comget_1.fintstf / comget_1.gintstf; +#line 20758 "" + comget_1.fintstf = -1.f; +#line 20759 "" + } +#line 20760 "" + if (comarp_1.xinsnow < 9.95f) { +#line 20761 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 20762 "" + } else if (comarp_1.xinsnow < 99.95f) { +#line 20763 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 20764 "" + } else { +#line 20765 "" + s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10); +#line 20766 "" + } + +/* Vertical spacing parameters, then restart */ + +#line 20770 "" + if (comlast_1.islast) { +#line 20770 "" + s_wsfe(&io___1406); +/* Writing concatenation */ +#line 20770 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20770 "" + i__6[1] = 11, a__4[1] = "interstaff{"; +#line 20770 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20770 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20770 "" + do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen) + sizeof(real)); +/* Writing concatenation */ +#line 20770 "" + i__8[0] = 1, a__5[0] = "}"; +#line 20770 "" + i__8[1] = 1, a__5[1] = all_1.sq; +#line 20770 "" + i__8[2] = 9, a__5[2] = "contpiece"; +#line 20770 "" + s_cat(ch__15, a__5, i__8, &c__3, (ftnlen)11); +#line 20770 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20770 "" + e_wsfe(); +#line 20770 "" + } + +/* Check for meter change at start of a new PAGE */ + +#line 20775 "" + if (all_1.mtrnuml > 0) { + +/* Meter change at start of a new page */ + +#line 20779 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & + combeam_1.ibmtyp, &ibmrep); +#line 20780 "" + if (comget_1.movbrk == 0) { +#line 20781 "" + if (comlast_1.islast) { +#line 20781 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20781 "" + } +#line 20782 "" + if (all_1.mtrdnp > 0) { +#line 20783 "" + if (comlast_1.islast) { +#line 20783 "" + s_wsfe(&io___1407); +/* Writing concatenation */ +#line 20783 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20783 "" + i__6[1] = 10, a__4[1] = "newtimes2%"; +#line 20783 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen) + 11); +#line 20783 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 20783 "" + e_wsfe(); +#line 20783 "" + } +#line 20784 "" + if (all_1.ibar == comgrace_1.ibarmbr) { +#line 20784 "" + comgrace_1.xb4mbr = all_1.musicsize * + -.2f; +#line 20784 "" + } +#line 20785 "" + } +#line 20786 "" + } +#line 20787 "" + } + +/* 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 20792 "" + 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 20794 "" + if (comnotes_1.headerspecial) { +#line 20794 "" + s_wsfe(&io___1408); +/* Writing concatenation */ +#line 20794 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 20794 "" + i__6[0] = 1, a__4[0] = ch__1; +#line 20794 "" + i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%" + ; +#line 20794 "" + s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29); +#line 20794 "" + do_fio(&c__1, ch__7, (ftnlen)29); +#line 20794 "" + e_wsfe(); +#line 20794 "" + } + +/* Write special header for first page */ + +#line 20799 "" + } else { + +/* First bar of system, not a new page, force line break */ + +#line 20803 "" + if (bit_test(iplnow,28)) { + +/* Signature change */ + +/* Writing concatenation */ +#line 20807 "" + i__14[0] = 1, a__10[0] = all_1.sq; +#line 20807 "" + i__14[1] = 4, a__10[1] = "xbar"; +#line 20807 "" + i__14[2] = 1, a__10[2] = all_1.sq; +#line 20807 "" + i__14[3] = 10, a__10[3] = "addspace{-"; +#line 20807 "" + i__14[4] = 1, a__10[4] = all_1.sq; +#line 20807 "" + i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 20807 "" + i__14[6] = 1, a__10[6] = all_1.sq; +#line 20807 "" + i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 20807 "" + s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 20809 "" + lnote = 49; +#line 20810 "" + if (comtop_1.isig < 0) { +/* Writing concatenation */ +#line 20811 "" + i__6[0] = 49, a__4[0] = notexq; +#line 20811 "" + i__6[1] = 1, a__4[1] = "-"; +#line 20811 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20812 "" + lnote = 50; +#line 20813 "" + } +#line 20814 "" + if (comlast_1.islast) { +#line 20814 "" + s_wsfe(&io___1409); +/* Writing concatenation */ +#line 20814 "" + i__8[0] = lnote, a__5[0] = notexq; +#line 20814 "" + i__7 = abs(comtop_1.isig) + 48; +#line 20814 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 20814 "" + i__8[1] = 1, a__5[1] = ch__1; +#line 20814 "" + i__8[2] = 2, a__5[2] = "}%"; +#line 20814 "" + s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 20814 "" + do_fio(&c__1, ch__25, lnote + 3); +#line 20814 "" + e_wsfe(); +#line 20814 "" + } +#line 20816 "" + if (comlast_1.islast && cominsttrans_1.laterinsttrans) + { +#line 20817 "" + writesetsign_(&cominsttrans_1.ninsttrans, + cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, & + cominsttrans_1.laterinsttrans); +#line 20819 "" + } +#line 20820 "" + if (comlast_1.islast) { +#line 20820 "" + s_wsfe(&io___1410); +/* Writing concatenation */ +#line 20820 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20820 "" + i__5[1] = 7, a__3[1] = "advance"; +#line 20820 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20820 "" + i__5[3] = 8, a__3[3] = "barno-1%"; +#line 20820 "" + s_cat(ch__13, a__3, i__5, &c__4, (ftnlen)17); +#line 20820 "" + do_fio(&c__1, ch__13, (ftnlen)17); +#line 20820 "" + e_wsfe(); +#line 20820 "" + } +#line 20821 "" + if (all_1.mtrnuml != 0) { + +/* Meter+sig change, new line, may need mods if movement break here. */ + +#line 20825 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & + combeam_1.ibmtyp, &ibmrep); +#line 20826 "" + if (comlast_1.islast) { +#line 20827 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20828 "" + if (comignorenats_1.ignorenats) { +#line 20828 "" + s_wsfe(&io___1411); +/* Writing concatenation */ +#line 20828 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20828 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20828 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) + 12); +#line 20828 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20828 "" + e_wsfe(); +#line 20828 "" + } +#line 20829 "" + s_wsfe(&io___1412); +/* Writing concatenation */ +#line 20829 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 20829 "" + i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 20829 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 20829 "" + i__3[3] = 10, a__1[3] = "addspace{-"; +#line 20829 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 20829 "" + i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 20829 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 20829 "" + i__3[7] = 10, a__1[7] = "zstoppiece"; +#line 20829 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 20829 "" + i__3[9] = 12, a__1[9] = "PMXbarnotrue"; +#line 20829 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 20829 "" + i__3[11] = 10, a__1[11] = "contpiece%"; +#line 20829 "" + s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76); +#line 20829 "" + do_fio(&c__1, ch__30, (ftnlen)76); +#line 20829 "" + e_wsfe(); +/* * 'addspace{-'//sq//'afterruleskip}'//sq//'def' */ +/* * //sq//'writezbarno{}'//sq//'zalaligne%' */ +#line 20834 "" + s_wsfe(&io___1413); +/* Writing concatenation */ +#line 20834 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20834 "" + i__5[1] = 10, a__3[1] = "addspace{-"; +#line 20834 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20834 "" + i__5[3] = 15, a__3[3] = "afterruleskip}%"; +#line 20834 "" + s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27); +#line 20834 "" + do_fio(&c__1, ch__5, (ftnlen)27); +#line 20834 "" + e_wsfe(); +#line 20836 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20837 "" + if (comignorenats_1.ignorenats) { +#line 20837 "" + s_wsfe(&io___1414); +/* Writing concatenation */ +#line 20837 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20837 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20837 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) + 12); +#line 20837 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20837 "" + e_wsfe(); +#line 20837 "" + } +#line 20838 "" + s_wsfe(&io___1415); +/* Writing concatenation */ +#line 20838 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20838 "" + i__6[1] = 14, a__4[1] = "zchangecontext"; +#line 20838 "" + s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15); +#line 20838 "" + do_fio(&c__1, ch__16, (ftnlen)15); +#line 20838 "" + e_wsfe(); +#line 20839 "" + } +#line 20840 "" + } else { +#line 20841 "" + if (comlast_1.islast && + comignorenats_1.ignorenats) { +#line 20841 "" + s_wsfe(&io___1416); +/* Writing concatenation */ +#line 20841 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20841 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20841 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20841 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20841 "" + e_wsfe(); +#line 20841 "" + } +#line 20843 "" + if (comlast_1.islast) { +#line 20843 "" + s_wsfe(&io___1417); +/* Writing concatenation */ +#line 20843 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 20843 "" + i__3[1] = 14, a__1[1] = "xchangecontext"; +#line 20843 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 20843 "" + i__3[3] = 10, a__1[3] = "addspace{-"; +#line 20843 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 20843 "" + i__3[5] = 14, a__1[5] = "afterruleskip}"; +#line 20843 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 20843 "" + i__3[7] = 10, a__1[7] = "zstoppiece"; +#line 20843 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 20843 "" + i__3[9] = 12, a__1[9] = "PMXbarnotrue"; +#line 20843 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 20843 "" + i__3[11] = 10, a__1[11] = "contpiece%"; +#line 20843 "" + s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)76); +#line 20843 "" + do_fio(&c__1, ch__30, (ftnlen)76); +#line 20843 "" + e_wsfe(); +#line 20843 "" + } +/* * 'addspace{-'//sq//'afterruleskip}'//sq//'def'// */ +/* * sq//'writezbarno{}'//sq//'zalaligne%' */ +#line 20848 "" + } +#line 20849 "" + } else if (all_1.mtrnuml == 0) { + +/* No meter change */ + +#line 20853 "" + if (comlast_1.islast) { +#line 20853 "" + s_wsfe(&io___1418); +/* Writing concatenation */ +#line 20853 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20853 "" + i__6[1] = 8, a__4[1] = "alaligne"; +#line 20853 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 20853 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20853 "" + e_wsfe(); +#line 20853 "" + } +#line 20854 "" + } else { + +/* New meter, no new sig, end of line, not new page. */ + +/* \generalmeter{\meterfrac{3}{4}}% */ +/* \xchangecontext\addspace{-\afterruleskip}% */ +/* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */ +/* \zchangecontext */ + +#line 20863 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & + combeam_1.ibmtyp, &ibmrep); +#line 20864 "" + if (comget_1.movbrk == 0) { +#line 20865 "" + if (comlast_1.islast) { +#line 20865 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20865 "" + } +#line 20866 "" + if (all_1.mtrdnp > 0) { +#line 20867 "" + if (comlast_1.islast) { +#line 20868 "" + s_wsfe(&io___1419); +/* Writing concatenation */ +#line 20868 "" + i__3[0] = 1, a__1[0] = all_1.sq; +#line 20868 "" + i__3[1] = 3, a__1[1] = "let"; +#line 20868 "" + i__3[2] = 1, a__1[2] = all_1.sq; +#line 20868 "" + i__3[3] = 4, a__1[3] = "bnat"; +#line 20868 "" + i__3[4] = 1, a__1[4] = all_1.sq; +#line 20868 "" + i__3[5] = 8, a__1[5] = "barnoadd"; +#line 20868 "" + i__3[6] = 1, a__1[6] = all_1.sq; +#line 20868 "" + i__3[7] = 3, a__1[7] = "def"; +#line 20868 "" + i__3[8] = 1, a__1[8] = all_1.sq; +#line 20868 "" + i__3[9] = 9, a__1[9] = "barnoadd{"; +#line 20868 "" + i__3[10] = 1, a__1[10] = all_1.sq; +#line 20868 "" + i__3[11] = 7, a__1[11] = "empty}%"; +#line 20868 "" + s_cat(ch__31, a__1, i__3, &c__12, (ftnlen) + 40); +#line 20868 "" + do_fio(&c__1, ch__31, (ftnlen)40); +#line 20868 "" + e_wsfe(); +#line 20871 "" + s_wsfe(&io___1420); +/* Writing concatenation */ +#line 20871 "" + i__15[0] = 1, a__11[0] = all_1.sq; +#line 20871 "" + i__15[1] = 14, a__11[1] = "xchangecontext" + ; +#line 20871 "" + i__15[2] = 1, a__11[2] = all_1.sq; +#line 20871 "" + i__15[3] = 10, a__11[3] = "addspace{-"; +#line 20871 "" + i__15[4] = 1, a__11[4] = all_1.sq; +#line 20871 "" + i__15[5] = 14, a__11[5] = "afterruleskip}" + ; +#line 20871 "" + i__15[6] = 1, a__11[6] = all_1.sq; +#line 20871 "" + i__15[7] = 9, a__11[7] = "zalaligne"; +#line 20871 "" + i__15[8] = 1, a__11[8] = all_1.sq; +#line 20871 "" + i__15[9] = 3, a__11[9] = "let"; +#line 20871 "" + i__15[10] = 1, a__11[10] = all_1.sq; +#line 20871 "" + i__15[11] = 8, a__11[11] = "barnoadd"; +#line 20871 "" + i__15[12] = 1, a__11[12] = all_1.sq; +#line 20871 "" + i__15[13] = 4, a__11[13] = "bnat"; +#line 20871 "" + s_cat(ch__32, a__11, i__15, &c__14, ( + ftnlen)69); +#line 20871 "" + do_fio(&c__1, ch__32, (ftnlen)69); +#line 20871 "" + e_wsfe(); +#line 20874 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20875 "" + s_wsfe(&io___1421); +/* Writing concatenation */ +#line 20875 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 20875 "" + i__4[1] = 10, a__2[1] = "addspace{-"; +#line 20875 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 20875 "" + i__4[3] = 14, a__2[3] = "afterruleskip}"; +#line 20875 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 20875 "" + i__4[5] = 14, a__2[5] = "zchangecontext"; +#line 20875 "" + s_cat(ch__33, a__2, i__4, &c__6, (ftnlen) + 41); +#line 20875 "" + do_fio(&c__1, ch__33, (ftnlen)41); +#line 20875 "" + e_wsfe(); +#line 20877 "" + } +#line 20878 "" + if (all_1.ibar == comgrace_1.ibarmbr) { +#line 20878 "" + comgrace_1.xb4mbr = all_1.musicsize * + -.2f; +#line 20878 "" + } +#line 20879 "" + } else { +#line 20880 "" + if (comlast_1.islast) { +#line 20880 "" + s_wsfe(&io___1422); +/* Writing concatenation */ +#line 20880 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20880 "" + i__6[1] = 8, a__4[1] = "alaligne"; +#line 20880 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen) + 9); +#line 20880 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20880 "" + e_wsfe(); +#line 20880 "" + } +#line 20881 "" + } +#line 20882 "" + } else { +#line 20883 "" + if (comlast_1.islast) { +#line 20883 "" + s_wsfe(&io___1423); +/* Writing concatenation */ +#line 20883 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20883 "" + i__6[1] = 8, a__4[1] = "alaligne"; +#line 20883 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 20883 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 20883 "" + e_wsfe(); +#line 20883 "" + } +#line 20884 "" + } +#line 20885 "" + } +#line 20886 "" + } + +/* Modified 090525 to use \bnrs */ + +#line 20890 "" + if (slint) { +#line 20891 "" + slint = FALSE_; +#line 20892 "" + if (comlast_1.islast) { +#line 20892 "" + s_wsfe(&io___1424); +/* Writing concatenation */ +#line 20892 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 20892 "" + i__5[1] = 3, a__3[1] = "def"; +#line 20892 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 20892 "" + i__5[3] = 11, a__3[3] = "raisebarno{"; +#line 20892 "" + s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16); +#line 20892 "" + do_fio(&c__1, ch__22, (ftnlen)16); +#line 20892 "" + do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen) + sizeof(integer)); +/* Writing concatenation */ +#line 20892 "" + i__8[0] = 2, a__5[0] = ".5"; +#line 20892 "" + i__8[1] = 1, a__5[1] = all_1.sq; +#line 20892 "" + i__8[2] = 11, a__5[2] = "internote}%"; +#line 20892 "" + s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14); +#line 20892 "" + do_fio(&c__1, ch__10, (ftnlen)14); +#line 20892 "" + e_wsfe(); +#line 20892 "" + } +#line 20894 "" + } +#line 20895 "" + comget_1.movbrk = 0; +#line 20896 "" + } + +/* Clean up if we squelched bar number reset at movement break */ + +#line 20900 "" + if (comnotes_1.nobar1) { +#line 20901 "" + if (comlast_1.islast) { +#line 20901 "" + s_wsfe(&io___1425); +/* Writing concatenation */ +#line 20901 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20901 "" + i__6[1] = 11, a__4[1] = "startbarno1"; +#line 20901 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20901 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20901 "" + e_wsfe(); +#line 20901 "" + } +#line 20902 "" + comnotes_1.nobar1 = FALSE_; +#line 20903 "" + } +#line 20904 "" + i__7 = s_rsle(&io___1426); +#line 20904 "" + if (i__7 != 0) { +#line 20904 "" + goto L14; +#line 20904 "" + } +#line 20904 "" + i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof( + integer)); +#line 20904 "" + if (i__7 != 0) { +#line 20904 "" + goto L14; +#line 20904 "" + } +#line 20904 "" + i__7 = e_rsle(); +#line 20904 "" + if (i__7 != 0) { +#line 20904 "" + goto L14; +#line 20904 "" + } +#line 20905 "" +L14: + +/* We come thru here for the 1st bar of every system, so initialize is1n1 */ + +#line 20909 "" + comsln_1.is1n1 = 0; + +/* Brought down from above */ + +#line 20913 "" + if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) { +#line 20913 "" + isystpg = 0; +#line 20913 "" + } + +/* Check for linebreak ties */ + +#line 20917 "" + if (ispstie) { +#line 20917 "" + linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3, + all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, ( + ftnlen)1); +#line 20917 "" + } +#line 20920 "" + } else { + +/* Not first bar of system */ + +#line 20924 "" + if (bit_test(iplnow,28)) { + +/* Signature change */ + +#line 20928 "" + if (all_1.mtrnuml != 0) { + +/* Meter+signature change mid line, assume no movement break */ + +#line 20932 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, & + combeam_1.ibmtyp, &ibmrep); +#line 20933 "" + if (comlast_1.islast) { +#line 20933 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 20933 "" + } +/* Writing concatenation */ +#line 20934 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20934 "" + i__6[1] = 17, a__4[1] = "generalsignature{"; +#line 20934 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20935 "" + lnote = 18; +#line 20936 "" + if (comtop_1.isig < 0) { +/* Writing concatenation */ +#line 20937 "" + i__6[0] = 18, a__4[0] = notexq; +#line 20937 "" + i__6[1] = 1, a__4[1] = "-"; +#line 20937 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20938 "" + lnote = 19; +#line 20939 "" + } +#line 20940 "" + if (comlast_1.islast) { +#line 20941 "" + iptemp = abs(comtop_1.isig) + 48; +#line 20942 "" + chax_(ch__1, (ftnlen)1, &iptemp); +#line 20942 "" + *(unsigned char *)charq = *(unsigned char *)&ch__1[0]; +/* Writing concatenation */ +#line 20943 "" + i__8[0] = lnote, a__5[0] = notexq; +#line 20943 "" + i__8[1] = 1, a__5[1] = charq; +#line 20943 "" + i__8[2] = 2, a__5[2] = "}%"; +#line 20943 "" + s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79); +#line 20944 "" + lnote += 3; +#line 20945 "" + s_wsfe(&io___1429); +#line 20945 "" + do_fio(&c__1, notexq, lnote); +#line 20945 "" + e_wsfe(); +#line 20946 "" + if (comlast_1.islast && cominsttrans_1.laterinsttrans) + { +#line 20947 "" + writesetsign_(&cominsttrans_1.ninsttrans, + cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, & + cominsttrans_1.laterinsttrans); +#line 20949 "" + } +#line 20950 "" + if (comignorenats_1.ignorenats) { +#line 20950 "" + s_wsfe(&io___1430); +/* Writing concatenation */ +#line 20950 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20950 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20950 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20950 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20950 "" + e_wsfe(); +#line 20950 "" + } +#line 20951 "" + s_wsfe(&io___1431); +/* Writing concatenation */ +#line 20951 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20951 "" + i__6[1] = 15, a__4[1] = "xchangecontext%"; +#line 20951 "" + s_cat(ch__22, a__4, i__6, &c__2, (ftnlen)16); +#line 20951 "" + do_fio(&c__1, ch__22, (ftnlen)16); +#line 20951 "" + e_wsfe(); +#line 20952 "" + } +#line 20953 "" + if (all_1.ibar == comgrace_1.ibarmbr) { + +/* Compute space for multibar rest */ + +#line 20957 "" + if (comtop_1.lastisig * comtop_1.isig >= 0) { +/* Computing MAX */ +#line 20958 "" + i__7 = abs(comtop_1.lastisig), i__2 = abs( + comtop_1.isig); +#line 20958 "" + naccs = max(i__7,i__2); +#line 20959 "" + } else { +#line 20960 "" + naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, + abs(i__7)); +#line 20961 "" + } +/* xb4mbr = (facmtr+naccs*.24)*musicsize */ +#line 20963 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 20964 "" + } +#line 20965 "" + } else { + +/* Signature change only */ + +/* Writing concatenation */ +#line 20969 "" + i__14[0] = 1, a__10[0] = all_1.sq; +#line 20969 "" + i__14[1] = 4, a__10[1] = "xbar"; +#line 20969 "" + i__14[2] = 1, a__10[2] = all_1.sq; +#line 20969 "" + i__14[3] = 10, a__10[3] = "addspace{-"; +#line 20969 "" + i__14[4] = 1, a__10[4] = all_1.sq; +#line 20969 "" + i__14[5] = 14, a__10[5] = "afterruleskip}"; +#line 20969 "" + i__14[6] = 1, a__10[6] = all_1.sq; +#line 20969 "" + i__14[7] = 17, a__10[7] = "generalsignature{"; +#line 20969 "" + s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79); +#line 20971 "" + lnote = 49; +#line 20972 "" + if (comtop_1.isig < 0) { +/* Writing concatenation */ +#line 20973 "" + i__6[0] = 49, a__4[0] = notexq; +#line 20973 "" + i__6[1] = 1, a__4[1] = "-"; +#line 20973 "" + s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79); +#line 20974 "" + lnote = 50; +#line 20975 "" + } +#line 20976 "" + if (comlast_1.islast) { +#line 20976 "" + s_wsfe(&io___1433); +/* Writing concatenation */ +#line 20976 "" + i__8[0] = lnote, a__5[0] = notexq; +#line 20976 "" + i__7 = abs(comtop_1.isig) + 48; +#line 20976 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 20976 "" + i__8[1] = 1, a__5[1] = ch__1; +#line 20976 "" + i__8[2] = 2, a__5[2] = "}%"; +#line 20976 "" + s_cat(ch__25, a__5, i__8, &c__3, (ftnlen)82); +#line 20976 "" + do_fio(&c__1, ch__25, lnote + 3); +#line 20976 "" + e_wsfe(); +#line 20976 "" + } +#line 20978 "" + if (comlast_1.islast && cominsttrans_1.laterinsttrans) { +#line 20979 "" + writesetsign_(&cominsttrans_1.ninsttrans, + cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, & + cominsttrans_1.laterinsttrans); +#line 20981 "" + } +#line 20982 "" + if (comlast_1.islast && comignorenats_1.ignorenats) { +#line 20982 "" + s_wsfe(&io___1434); +/* Writing concatenation */ +#line 20982 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 20982 "" + i__6[1] = 11, a__4[1] = "ignorenats%"; +#line 20982 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 20982 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20982 "" + e_wsfe(); +#line 20982 "" + } +#line 20984 "" + if (comlast_1.islast) { +#line 20984 "" + s_wsfe(&io___1435); +/* Writing concatenation */ +#line 20984 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 20984 "" + i__4[1] = 14, a__2[1] = "zchangecontext"; +#line 20984 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 20984 "" + i__4[3] = 12, a__2[3] = "addspace{-.5"; +#line 20984 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 20984 "" + i__4[5] = 15, a__2[5] = "afterruleskip}%"; +#line 20984 "" + s_cat(ch__34, a__2, i__4, &c__6, (ftnlen)44); +#line 20984 "" + do_fio(&c__1, ch__34, (ftnlen)44); +#line 20984 "" + e_wsfe(); +#line 20984 "" + } +#line 20986 "" + if (all_1.ibar == comgrace_1.ibarmbr) { + +/* Compute space for multibar rest */ + +#line 20990 "" + if (comtop_1.lastisig * comtop_1.isig >= 0) { +/* Computing MAX */ +#line 20991 "" + i__7 = abs(comtop_1.lastisig), i__2 = abs( + comtop_1.isig); +#line 20991 "" + naccs = max(i__7,i__2); +#line 20992 "" + } else { +#line 20993 "" + naccs = (i__7 = comtop_1.lastisig - comtop_1.isig, + abs(i__7)); +#line 20994 "" + } +/* xb4mbr = naccs*.24*musicsize */ +#line 20996 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 20997 "" + } +#line 20998 "" + } +#line 20999 "" + } else if (all_1.mtrnuml == 0) { + +/* No meter change */ + +#line 21003 "" + if (comlast_1.islast) { +#line 21003 "" + s_wsfe(&io___1436); +/* Writing concatenation */ +#line 21003 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21003 "" + i__6[1] = 4, a__4[1] = "xbar"; +#line 21003 "" + s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5); +#line 21003 "" + do_fio(&c__1, ch__35, (ftnlen)5); +#line 21003 "" + e_wsfe(); +#line 21003 "" + } +#line 21004 "" + } else { + +/* Change meter midline */ + +#line 21008 "" + setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, & + ibmrep); +#line 21009 "" + if (comget_1.movbrk == 0) { +#line 21010 "" + if (comlast_1.islast) { +#line 21010 "" + wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp); +#line 21010 "" + } +#line 21011 "" + if (all_1.mtrdnp > 0) { +#line 21012 "" + if (comlast_1.islast) { +/* if (mbrest .gt. 0) then */ +/* c write(11,'(a)')sq//'addspace{-2'//sq// */ +/* c * 'afterruleskip}'//sq//'setemptybar'//sq//'bar' */ +/* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq// */ +/* * 'advance'//sq//'barno-1%' */ +/* end if */ +#line 21019 "" + s_wsfe(&io___1437); +/* Writing concatenation */ +#line 21019 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21019 "" + i__6[1] = 10, a__4[1] = "newtimes0%"; +#line 21019 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21019 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 21019 "" + e_wsfe(); +#line 21020 "" + } +/* if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize */ +#line 21022 "" + if (all_1.ibar == comgrace_1.ibarmbr) { +#line 21022 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21022 "" + } +#line 21023 "" + } else { +#line 21024 "" + if (comlast_1.islast) { +#line 21024 "" + s_wsfe(&io___1438); +/* Writing concatenation */ +#line 21024 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21024 "" + i__6[1] = 4, a__4[1] = "xbar"; +#line 21024 "" + s_cat(ch__35, a__4, i__6, &c__2, (ftnlen)5); +#line 21024 "" + do_fio(&c__1, ch__35, (ftnlen)5); +#line 21024 "" + e_wsfe(); +#line 21024 "" + } +#line 21025 "" + } +#line 21026 "" + } +#line 21027 "" + } +#line 21028 "" + } + +/* Now that xbar's are written, can put in left-repeats at line beginnings */ + +#line 21032 "" + if (lrptpend) { +#line 21033 "" + if (comlast_1.islast) { +#line 21033 "" + s_wsfe(&io___1439); +/* Writing concatenation */ +#line 21033 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 21033 "" + i__4[1] = 7, a__2[1] = "advance"; +#line 21033 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 21033 "" + i__4[3] = 7, a__2[3] = "barno-1"; +#line 21033 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 21033 "" + i__4[5] = 10, a__2[5] = "leftrepeat"; +#line 21033 "" + s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); +#line 21033 "" + do_fio(&c__1, ch__5, (ftnlen)27); +#line 21033 "" + e_wsfe(); +#line 21033 "" + } +#line 21035 "" + lrptpend = FALSE_; +#line 21036 "" + } +#line 21037 "" + if (all_1.ibar > 1) { + +/* For bars after first, slide all stuff down to beginning of arrays */ + +#line 21041 "" + i__7 = all_1.nv; +#line 21041 "" + for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) { +#line 21042 "" + i__2 = commvl_1.nvmx[all_1.iv - 1]; +#line 21042 "" + for (kv = 1; kv <= i__2; ++kv) { +#line 21043 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 21044 "" + ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - + 25]; +#line 21045 "" + i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] - + ioff; +#line 21045 "" + for (ip = 1; ip <= i__13; ++ip) { +#line 21046 "" + all_1.nolev[commvl_1.ivx + ip * 24 - 25] = + all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 - + 25]; +#line 21047 "" + all_1.nodur[commvl_1.ivx + ip * 24 - 25] = + all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 - + 25]; +#line 21048 "" + all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[ + commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 21049 "" + all_1.irest[commvl_1.ivx + ip * 24 - 25] = + all_1.irest[commvl_1.ivx + (ip + ioff) * 24 - + 25]; +#line 21050 "" + all_1.islur[commvl_1.ivx + ip * 24 - 25] = + all_1.islur[commvl_1.ivx + (ip + ioff) * 24 - + 25]; +#line 21051 "" + all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[ + commvl_1.ivx + (ip + ioff) * 24 - 25]; +#line 21052 "" + all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[ + commvl_1.ivx + (ip + ioff) * 24 - 1]; +#line 21053 "" + 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 21056 "" + if (all_1.figbass && commvl_1.ivx == 1 || + commvl_1.ivx == comfig_1.ivxfig2) { +#line 21057 "" + if (commvl_1.ivx == 1) { +#line 21058 "" + all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip + + ioff << 1) - 2]; +#line 21059 "" + } else { +#line 21060 "" + all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip + + ioff << 1) - 1]; +#line 21061 "" + } +#line 21062 "" + } +#line 21063 "" +/* L12: */ +#line 21063 "" + } +#line 21064 "" + if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1] + > 1) { +#line 21065 "" + islide = 0; +#line 21066 "" + i__13 = comcc_1.ncc[all_1.iv - 1]; +#line 21066 "" + for (icc = 1; icc <= i__13; ++icc) { +#line 21067 "" + if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= ( + real) all_1.lenbar) { + +/* This time will drop <=0 when slid. */ + +#line 21071 "" + islide = icc - 1; +#line 21072 "" + comcc_1.ncmidcc[all_1.iv - 1] = + comcc_1.ncmidcc[all_1.iv + icc * 24 - + 25]; +#line 21073 "" + } else { +#line 21074 "" + comcc_1.tcc[all_1.iv + (icc - islide) * 24 - + 25] = comcc_1.tcc[all_1.iv + icc * 24 + - 25] - all_1.lenbar; +#line 21075 "" + comcc_1.ncmidcc[all_1.iv + (icc - islide) * + 24 - 25] = comcc_1.ncmidcc[all_1.iv + + icc * 24 - 25]; +#line 21076 "" + } +#line 21077 "" +/* L13: */ +#line 21077 "" + } +#line 21078 "" + comcc_1.ncc[all_1.iv - 1] -= islide; +#line 21079 "" + comcc_1.tcc[all_1.iv - 1] = 0.f; +#line 21080 "" + } +#line 21081 "" +/* L11: */ +#line 21081 "" + } +#line 21081 "" + } +#line 21082 "" + i__2 = comgrace_1.ngrace; +#line 21082 "" + for (ig = 1; ig <= i__2; ++ig) { +#line 21083 "" + comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + ( + all_1.ibar - 1) * 24 - 25]; +#line 21084 "" + if (all_1.ibar > 2) { +#line 21084 "" + comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1] + + (all_1.ibar - 2) * 24 - 25]; +#line 21084 "" + } +#line 21085 "" +/* L15: */ +#line 21085 "" + } +#line 21086 "" + i__2 = comgrace_1.nlit; +#line 21086 "" + for (il = 1; il <= i__2; ++il) { +#line 21087 "" + comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1] + + (all_1.ibar - 1) * 24 - 25]; +#line 21088 "" + if (all_1.ibar > 2) { +#line 21088 "" + comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il + - 1] + (all_1.ibar - 2) * 24 - 25]; +#line 21088 "" + } +#line 21089 "" +/* L21: */ +#line 21089 "" + } +#line 21090 "" + i__2 = comtrill_1.ntrill; +#line 21090 "" + for (it = 1; it <= i__2; ++it) { +#line 21091 "" + comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it + - 1] + (all_1.ibar - 1) * 24 - 25]; +#line 21092 "" + if (all_1.ibar > 2) { +#line 21092 "" + comtrill_1.iptrill[it - 1] += all_1.nib[ + comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) * + 24 - 25]; +#line 21092 "" + } +#line 21094 "" +/* L22: */ +#line 21094 "" + } +#line 21095 "" + i__2 = comtrill_1.ncrd; +#line 21095 "" + for (icrd = 1; icrd <= i__2; ++icrd) { +/* ivx = iand(15,ishft(icrdat(icrd),-8)) */ +#line 21097 "" + 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 21099 "" + ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[ + commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21100 "" + if (all_1.ibar > 2) { +#line 21100 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21100 "" + } +#line 21101 "" + comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd - + 1]; +#line 21102 "" + comtrill_1.icrdat[icrd - 1] = max(0,ipnew) | + comtrill_1.icrdat[icrd - 1]; +#line 21103 "" +/* L27: */ +#line 21103 "" + } +#line 21104 "" + i__2 = comtrill_1.nudorn; +#line 21104 "" + for (iudorn = 1; iudorn <= i__2; ++iudorn) { +/* ivx = iand(15,ishft(kudorn(iudorn),-8)) */ +#line 21106 "" + commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1]; +#line 21107 "" + ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[ + commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21108 "" + if (all_1.ibar > 2) { +#line 21108 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21108 "" + } +#line 21109 "" + comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[ + iudorn - 1]; +#line 21110 "" + comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) | + comtrill_1.kudorn[iudorn - 1]; +#line 21111 "" +/* L29: */ +#line 21111 "" + } +#line 21112 "" + i__2 = comdyn_1.ndyn; +#line 21112 "" + for (idyn = 1; idyn <= i__2; ++idyn) { +#line 21113 "" + idynd = comdyn_1.idyndat[idyn - 1]; +/* ivx = iand(15,idynd) */ +#line 21115 "" + commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[ + idyn - 1], &c__1, &c__10) << 4); +#line 21116 "" + 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 21120 "" + if (all_1.ibar > 2) { +#line 21121 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21122 "" + } +#line 21123 "" + ipnew = i_dim(&ipnew, &c__0); +#line 21124 "" + setbits_(&idynd, &c__8, &c__4, &ipnew); +#line 21125 "" + comdyn_1.idyndat[idyn - 1] = idynd; +#line 21126 "" +/* L42: */ +#line 21126 "" + } +#line 21127 "" + i__2 = comdyn_1.ntxtdyn; +#line 21127 "" + for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) { +#line 21128 "" + idynd = comdyn_1.ivxiptxt[itxtdyn - 1]; +/* ivx = iand(15,idynd) */ +#line 21130 "" + commvl_1.ivx = 31 & idynd; +/* ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1) */ +#line 21132 "" + ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[ + commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21133 "" + if (all_1.ibar > 2) { +#line 21134 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21135 "" + } +#line 21136 "" + ipnew = i_dim(&ipnew, &c__0); +/* call setbits(idynd,8,4,ipnew) */ +#line 21138 "" + setbits_(&idynd, &c__8, &c__5, &ipnew); +#line 21139 "" + comdyn_1.ivxiptxt[itxtdyn - 1] = idynd; +#line 21140 "" +/* L43: */ +#line 21140 "" + } +#line 21141 "" + i__2 = all_1.nsdat; +#line 21141 "" + for (isdat = 1; isdat <= i__2; ++isdat) { +#line 21142 "" + isdata = all_1.isdat1[isdat - 1]; +#line 21143 "" + commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13) + + (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25]; +#line 21144 "" + ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[ + commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21145 "" + if (all_1.ibar > 2) { +#line 21146 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21147 "" + } +#line 21148 "" + ipnew = i_dim(&ipnew, &c__0); +#line 21149 "" + setbits_(&isdata, &c__8, &c__3, &ipnew); +#line 21150 "" + all_1.isdat1[isdat - 1] = isdata; +#line 21151 "" +/* L41: */ +#line 21151 "" + } +#line 21152 "" + i__2 = comcb_1.nbc; +#line 21152 "" + for (ibc = 1; ibc <= i__2; ++ibc) { +/* ivx = iand(15,ibcdata(ibc)) */ +#line 21154 "" + commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(& + comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4); +#line 21155 "" + ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) - + all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25]; +#line 21156 "" + if (all_1.ibar > 2) { +#line 21157 "" + ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 - + 25]; +#line 21158 "" + } +#line 21159 "" + ipnew = i_dim(&ipnew, &c__0); +#line 21160 "" + setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew); +#line 21161 "" +/* L44: */ +#line 21161 "" + } +#line 21162 "" + i__2 = comarpshift_1.numarpshift; +#line 21162 "" + for (iarps = 1; iarps <= i__2; ++iarps) { +#line 21163 "" + comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[ + comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1) + * 24 - 25]; +#line 21165 "" + if (all_1.ibar > 2) { +#line 21166 "" + comarpshift_1.iparpshift[iarps - 1] += all_1.nib[ + comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar + - 2) * 24 - 25]; +#line 21168 "" + } +#line 21169 "" +/* L45: */ +#line 21169 "" + } + +/* 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 21175 "" + for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) { +#line 21176 "" + if (all_1.figbass) { +#line 21177 "" + islide = 0; +#line 21178 "" + i__2 = comfig_1.nfigs[commvl_1.ivx - 1]; +#line 21178 "" + for (jfig = 1; jfig <= i__2; ++jfig) { +#line 21179 "" + if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] < + all_1.lenbar) { + +/* This figure was already used */ + +#line 21183 "" + islide = jfig; +#line 21184 "" + } else { +#line 21185 "" + comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1) + - 3] = comfig_1.itfig[commvl_1.ivx + ( + jfig << 1) - 3] - all_1.lenbar; +#line 21186 "" + 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 21187 "" + comgrace_1.itoff[commvl_1.ivx + (jfig - islide << + 1) - 3] = comgrace_1.itoff[commvl_1.ivx + + (jfig << 1) - 3]; +#line 21188 "" + comfig_1.ivupfig[commvl_1.ivx + (jfig - islide << + 1) - 3] = comfig_1.ivupfig[commvl_1.ivx + + (jfig << 1) - 3]; +#line 21189 "" + comfig_1.ivvfig[commvl_1.ivx + (jfig - islide << + 1) - 3] = comfig_1.ivvfig[commvl_1.ivx + ( + jfig << 1) - 3]; +#line 21190 "" + } +#line 21191 "" +/* L20: */ +#line 21191 "" + } +#line 21192 "" + comfig_1.nfigs[commvl_1.ivx - 1] -= islide; +#line 21193 "" + } +#line 21194 "" + if (comfig_1.nfigs[1] == 0) { +#line 21194 "" + goto L47; +#line 21194 "" + } +#line 21195 "" +/* L46: */ +#line 21195 "" + } +#line 21196 "" +L47: +#line 21197 "" + ; +#line 21197 "" + } + +/* End of sliding down for bars after first in gulp. */ + +/* The following may not be needed by makeabar, but just in case... */ + +#line 21203 "" + if (all_1.firstgulp && all_1.lenb0 != 0) { +#line 21204 "" + if (all_1.ibar == 1) { +#line 21205 "" + all_1.lenbar = all_1.lenb0; +#line 21206 "" + } else { +#line 21207 "" + all_1.lenbar = all_1.lenb1; +#line 21208 "" + } +#line 21209 "" + } + +/* Equal line spacing stuff */ + +#line 21213 "" + if (comget_1.equalize && comask_1.bar1syst) { +#line 21214 "" + if (isystpg == 1) { +#line 21215 "" + s_wsfe(&io___1455); +/* Writing concatenation */ +#line 21215 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21215 "" + i__6[1] = 8, a__4[1] = "starteq%"; +#line 21215 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21215 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 21215 "" + e_wsfe(); +#line 21216 "" + } else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1) + { +#line 21217 "" + s_wsfe(&io___1456); +/* Writing concatenation */ +#line 21217 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21217 "" + i__6[1] = 6, a__4[1] = "endeq%"; +#line 21217 "" + s_cat(ch__36, a__4, i__6, &c__2, (ftnlen)7); +#line 21217 "" + do_fio(&c__1, ch__36, (ftnlen)7); +#line 21217 "" + e_wsfe(); +#line 21218 "" + } +#line 21219 "" + } +#line 21220 "" + make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms, + istart); +#line 21222 "" + make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop, + numbms, istart, comclefq_1.clefq, (ftnlen)1); + +/* Hardspace before barline? */ + +#line 21227 "" + hardb4 = 0.f; +#line 21228 "" + i__2 = all_1.nv; +#line 21228 "" + for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) { +#line 21229 "" + i__7 = commvl_1.nvmx[all_1.iv - 1]; +#line 21229 "" + for (kv = 1; kv <= i__7; ++kv) { +#line 21230 "" + commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25]; +#line 21231 "" + if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx + - 1] * 24 - 25],18)) { +#line 21232 "" + ++comudsp_1.nudoff[commvl_1.ivx - 1]; +/* Computing MAX */ +#line 21233 "" + r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx + + comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25]; +#line 21233 "" + hardb4 = dmax(r__1,r__2); +#line 21234 "" + } +#line 21235 "" +/* L35: */ +#line 21235 "" + } +#line 21235 "" + } +#line 21236 "" + if (hardb4 > 0.f) { +#line 21237 "" + if (comlast_1.islast) { +#line 21237 "" + s_wsfe(&io___1464); +/* Writing concatenation */ +#line 21237 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21237 "" + i__6[1] = 10, a__4[1] = "hardspace{"; +#line 21237 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11); +#line 21237 "" + do_fio(&c__1, ch__15, (ftnlen)11); +#line 21237 "" + do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real)); +#line 21237 "" + do_fio(&c__1, "pt}%", (ftnlen)4); +#line 21237 "" + e_wsfe(); +#line 21237 "" + } + +/* 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 21243 "" + comask_1.fixednew -= hardb4; +#line 21244 "" + } +#line 21245 "" +/* L10: */ +#line 21245 "" + } +#line 21246 "" + all_1.firstgulp = FALSE_; +#line 21247 "" + all_1.lenb0 = 0; +#line 21248 "" + goto L30; +#line 21249 "" +L40: +#line 21249 "" + cl__1.cerr = 0; +#line 21249 "" + cl__1.cunit = 12; +#line 21249 "" + cl__1.csta = 0; +#line 21249 "" + f_clos(&cl__1); +#line 21250 "" + cl__1.cerr = 0; +#line 21250 "" + cl__1.cunit = 13; +#line 21250 "" + cl__1.csta = 0; +#line 21250 "" + f_clos(&cl__1); +#line 21251 "" + inbuff_1.ilbuf = 1; +#line 21252 "" + inbuff_1.ipbuf = 0; +#line 21253 "" + wdpt = comtop_1.widthpt; +#line 21254 "" + if (all_1.iline == 1) { +#line 21254 "" + wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent); +#line 21254 "" + } +#line 21255 "" + poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew) + / (elsktot + comask_1.fbar * nbarss - comask_1.scaldold); +#line 21257 "" + poevec[nsyst] = poe; +#line 21258 "" + if (! comlast_1.islast) { +#line 21259 "" + cl__1.cerr = 0; +#line 21259 "" + cl__1.cunit = 11; +#line 21259 "" + cl__1.csta = 0; +#line 21259 "" + f_clos(&cl__1); +#line 21260 "" + cl__1.cerr = 0; +#line 21260 "" + cl__1.cunit = 16; +#line 21260 "" + cl__1.csta = 0; +#line 21260 "" + f_clos(&cl__1); +#line 21261 "" + if (all_1.figbass) { +#line 21261 "" + cl__1.cerr = 0; +#line 21261 "" + cl__1.cunit = 14; +#line 21261 "" + cl__1.csta = 0; +#line 21261 "" + f_clos(&cl__1); +#line 21261 "" + } +#line 21262 "" + return 0; +#line 21263 "" + } +#line 21264 "" + i__1 = comas2_1.nasksys; +#line 21264 "" + for (ia = 1; ia <= i__1; ++ia) { +#line 21265 "" + ++comas3_1.iask; +#line 21266 "" + comas3_1.ask[comas3_1.iask - 1] = comas2_1.wasksys[ia - 1] / poe - ( + r__1 = comas2_1.elasksys[ia - 1], dabs(r__1)); +#line 21267 "" + if (comas2_1.elasksys[ia - 1] > 0.f) { +#line 21267 "" + comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[ + comas3_1.iask - 1], &c_b762); +#line 21267 "" + } +#line 21268 "" +/* L19: */ +#line 21268 "" + } +#line 21269 "" + i__1 = nhssys; +#line 21269 "" + for (ia = 1; ia <= i__1; ++ia) { +#line 21270 "" + ++nhstot; +/* Computing MAX */ +#line 21271 "" + r__1 = hpts[ia - 1] - hesk[ia - 1] * poe; +#line 21271 "" + comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f); +#line 21272 "" +/* L26: */ +#line 21272 "" + } +#line 21273 "" + if (comlast_1.islast && onvolt) { +#line 21273 "" + s_wsfe(&io___1465); +/* Writing concatenation */ +#line 21273 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21273 "" + i__6[1] = 11, a__4[1] = "endvoltabox"; +#line 21273 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12); +#line 21273 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 21273 "" + e_wsfe(); +#line 21273 "" + } +#line 21275 "" + if (*(unsigned char *)comget_1.rptfq2 != 'E') { + +/* Terminal repeat. Right or double? */ + +#line 21279 "" + if (*(unsigned char *)comget_1.rptfq2 == 'r') { +#line 21280 "" + if (comlast_1.islast) { +#line 21280 "" + s_wsfe(&io___1466); +/* Writing concatenation */ +#line 21280 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 21280 "" + i__5[1] = 14, a__3[1] = "setrightrepeat"; +#line 21280 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 21280 "" + i__5[3] = 8, a__3[3] = "endpiece"; +#line 21280 "" + s_cat(ch__37, a__3, i__5, &c__4, (ftnlen)24); +#line 21280 "" + do_fio(&c__1, ch__37, (ftnlen)24); +#line 21280 "" + e_wsfe(); +#line 21280 "" + } +#line 21282 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'd') { +#line 21283 "" + if (comlast_1.islast) { +#line 21283 "" + s_wsfe(&io___1467); +/* Writing concatenation */ +#line 21283 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 21283 "" + i__5[1] = 12, a__3[1] = "setdoublebar"; +#line 21283 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 21283 "" + i__5[3] = 8, a__3[3] = "endpiece"; +#line 21283 "" + s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22); +#line 21283 "" + do_fio(&c__1, ch__38, (ftnlen)22); +#line 21283 "" + e_wsfe(); +#line 21283 "" + } +#line 21284 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'b') { +#line 21285 "" + if (comlast_1.islast) { +#line 21285 "" + s_wsfe(&io___1468); +/* Writing concatenation */ +#line 21285 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21285 "" + i__6[1] = 8, a__4[1] = "endpiece"; +#line 21285 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21285 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 21285 "" + e_wsfe(); +#line 21285 "" + } +#line 21286 "" + } else if (*(unsigned char *)comget_1.rptfq2 == 'z') { +#line 21287 "" + if (comlast_1.islast) { +#line 21287 "" + s_wsfe(&io___1469); +/* Writing concatenation */ +#line 21287 "" + i__5[0] = 1, a__3[0] = all_1.sq; +#line 21287 "" + i__5[1] = 12, a__3[1] = "setzalaligne"; +#line 21287 "" + i__5[2] = 1, a__3[2] = all_1.sq; +#line 21287 "" + i__5[3] = 8, a__3[3] = "Endpiece"; +#line 21287 "" + s_cat(ch__38, a__3, i__5, &c__4, (ftnlen)22); +#line 21287 "" + do_fio(&c__1, ch__38, (ftnlen)22); +#line 21287 "" + e_wsfe(); +#line 21287 "" + } +#line 21288 "" + } else { +/* else if (rptfq2 .ne. 'D') then */ +#line 21290 "" + s_wsle(&io___1470); +#line 21290 "" + e_wsle(); +#line 21291 "" + s_wsle(&io___1471); +#line 21291 "" + do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ + "q2:", (ftnlen)37); +#line 21291 "" + do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 21291 "" + e_wsle(); +#line 21292 "" + s_wsle(&io___1472); +#line 21292 "" + do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\ + "q2:", (ftnlen)37); +#line 21292 "" + do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1); +#line 21292 "" + e_wsle(); +#line 21293 "" + if (comlast_1.islast) { +#line 21293 "" + s_wsfe(&io___1473); +/* Writing concatenation */ +#line 21293 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21293 "" + i__6[1] = 8, a__4[1] = "Endpiece"; +#line 21293 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21293 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 21293 "" + e_wsfe(); +#line 21293 "" + } +#line 21294 "" + } +#line 21295 "" + } else { +#line 21296 "" + if (comlast_1.islast) { +#line 21296 "" + s_wsfe(&io___1474); +/* Writing concatenation */ +#line 21296 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21296 "" + i__6[1] = 8, a__4[1] = "Endpiece"; +#line 21296 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21296 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 21296 "" + e_wsfe(); +#line 21296 "" + } +#line 21297 "" + } +#line 21298 "" + if (! vshrink) { +#line 21299 "" + xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop; +#line 21300 "" + if (xnstbot < 9.95f) { +#line 21301 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 21302 "" + } else { +#line 21303 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 21304 "" + } +#line 21305 "" + if (comlast_1.islast) { +#line 21305 "" + s_wsfe(&io___1475); +/* Writing concatenation */ +#line 21305 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21305 "" + i__6[1] = 5, a__4[1] = "vskip"; +#line 21305 "" + s_cat(ch__29, a__4, i__6, &c__2, (ftnlen)6); +#line 21305 "" + do_fio(&c__1, ch__29, (ftnlen)6); +#line 21305 "" + do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 21305 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 21305 "" + i__4[1] = 10, a__2[1] = "Interligne"; +#line 21305 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 21305 "" + i__4[3] = 5, a__2[3] = "eject"; +#line 21305 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 21305 "" + i__4[5] = 9, a__2[5] = "endmuflex"; +#line 21305 "" + s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27); +#line 21305 "" + do_fio(&c__1, ch__5, (ftnlen)27); +#line 21305 "" + e_wsfe(); +#line 21305 "" + } +#line 21307 "" + if (comlast_1.islast) { +#line 21307 "" + s_wsfe(&io___1476); +/* Writing concatenation */ +#line 21307 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21307 "" + i__6[1] = 3, a__4[1] = "bye"; +#line 21307 "" + s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); +#line 21307 "" + do_fio(&c__1, ch__21, (ftnlen)4); +#line 21307 "" + e_wsfe(); +#line 21307 "" + } +#line 21308 "" + } else { +#line 21309 "" + if (comlast_1.islast) { +#line 21309 "" + s_wsfe(&io___1477); +/* Writing concatenation */ +#line 21309 "" + i__4[0] = 1, a__2[0] = all_1.sq; +#line 21309 "" + i__4[1] = 5, a__2[1] = "vfill"; +#line 21309 "" + i__4[2] = 1, a__2[2] = all_1.sq; +#line 21309 "" + i__4[3] = 5, a__2[3] = "eject"; +#line 21309 "" + i__4[4] = 1, a__2[4] = all_1.sq; +#line 21309 "" + i__4[5] = 9, a__2[5] = "endmuflex"; +#line 21309 "" + s_cat(ch__38, a__2, i__4, &c__6, (ftnlen)22); +#line 21309 "" + do_fio(&c__1, ch__38, (ftnlen)22); +#line 21309 "" + e_wsfe(); +#line 21309 "" + } +#line 21311 "" + if (comlast_1.islast) { +#line 21311 "" + s_wsfe(&io___1478); +/* Writing concatenation */ +#line 21311 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21311 "" + i__6[1] = 3, a__4[1] = "bye"; +#line 21311 "" + s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4); +#line 21311 "" + do_fio(&c__1, ch__21, (ftnlen)4); +#line 21311 "" + e_wsfe(); +#line 21311 "" + } +#line 21312 "" + } +#line 21313 "" + al__1.aerr = 0; +#line 21313 "" + al__1.aunit = 11; +#line 21313 "" + f_rew(&al__1); +#line 21314 "" + if (all_1.figbass) { +#line 21315 "" + s_wsfe(&io___1479); +/* Writing concatenation */ +#line 21315 "" + i__6[0] = 1, a__4[0] = all_1.sq; +#line 21315 "" + i__6[1] = 8, a__4[1] = "figdrop="; +#line 21315 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9); +#line 21315 "" + do_fio(&c__1, ch__18, (ftnlen)9); +#line 21315 "" + do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen) + sizeof(integer)); +/* Writing concatenation */ +#line 21315 "" + i__8[0] = 1, a__5[0] = " "; +#line 21315 "" + i__8[1] = 1, a__5[1] = all_1.sq; +#line 21315 "" + i__8[2] = 8, a__5[2] = "figdtwo="; +#line 21315 "" + s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10); +#line 21315 "" + do_fio(&c__1, ch__20, (ftnlen)10); +#line 21315 "" + do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen) + sizeof(integer)); +/* Writing concatenation */ +#line 21315 "" + i__11[0] = 1, a__8[0] = all_1.sq; +#line 21315 "" + i__11[1] = 4, a__8[1] = "fi}%"; +#line 21315 "" + s_cat(ch__35, a__8, i__11, &c__2, (ftnlen)5); +#line 21315 "" + do_fio(&c__1, ch__35, (ftnlen)5); +#line 21315 "" + e_wsfe(); +#line 21318 "" + al__1.aerr = 0; +#line 21318 "" + al__1.aunit = 14; +#line 21318 "" + f_rew(&al__1); +#line 21319 "" + } +#line 21320 "" + askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, ( + ftnlen)40, (ftnlen)44); +#line 21321 "" + if (! (*optimize)) { +#line 21322 "" + s_wsle(&io___1480); +#line 21322 "" + e_wsle(); +#line 21323 "" + s_wsle(&io___1481); +/* Writing concatenation */ +#line 21323 "" + i__5[0] = 8, a__3[0] = "Writing "; +#line 21323 "" + i__5[1] = lpath, a__3[1] = pathnameq; +#line 21323 "" + i__5[2] = lbase, a__3[2] = basenameq; +#line 21323 "" + i__5[3] = 4, a__3[3] = ".tex"; +#line 21323 "" + s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96); +#line 21323 "" + do_lio(&c__9, &c__1, ch__39, lpath + 8 + lbase + 4); +#line 21323 "" + e_wsle(); +#line 21325 "" + s_wsle(&io___1482); +#line 21325 "" + do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26); +#line 21325 "" + e_wsle(); +#line 21326 "" + s_wsfe(&io___1483); +/* Writing concatenation */ +#line 21326 "" + i__5[0] = 8, a__3[0] = "Writing "; +#line 21326 "" + i__5[1] = lpath, a__3[1] = pathnameq; +#line 21326 "" + i__5[2] = lbase, a__3[2] = basenameq; +#line 21326 "" + i__5[3] = 4, a__3[3] = ".tex"; +#line 21326 "" + s_cat(ch__39, a__3, i__5, &c__4, (ftnlen)96); +#line 21326 "" + do_fio(&c__1, ch__39, lpath + 8 + lbase + 4); +#line 21326 "" + e_wsfe(); +#line 21328 "" + s_wsfe(&io___1484); +#line 21328 "" + do_fio(&c__1, " Done with second PMX pass. Now run TeX", (ftnlen)40); +#line 21328 "" + e_wsfe(); +#line 21329 "" + } +#line 21330 "" + return 0; +} /* pmxb_ */ + +/* Subroutine */ int poestats_(integer *nsyst, real *poe, real *poebar, real * + devnorm) +{ + /* System generated locals */ + integer i__1; + real r__1; + + /* Builtin functions */ + double sqrt(doublereal); + + /* Local variables */ + static real sumx; + static integer isyst; + static real sumxx; + + +/* Compute avg. & norm. std. dev. of poe. */ + +#line 21338 "" + /* Parameter adjustments */ +#line 21338 "" + --poe; +#line 21338 "" + +#line 21338 "" + /* Function Body */ +#line 21338 "" + sumx = 0.f; +#line 21339 "" + sumxx = 0.f; +#line 21340 "" + i__1 = *nsyst; +#line 21340 "" + for (isyst = 1; isyst <= i__1; ++isyst) { +#line 21341 "" + sumx += poe[isyst]; +/* Computing 2nd power */ +#line 21342 "" + r__1 = poe[isyst]; +#line 21342 "" + sumxx += r__1 * r__1; +#line 21343 "" +/* L1: */ +#line 21343 "" + } +/* Computing 2nd power */ +#line 21344 "" + r__1 = sumx; +#line 21344 "" + *devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1); +#line 21345 "" + *poebar = sumx / *nsyst; +#line 21346 "" + return 0; +} /* poestats_ */ + +/* Subroutine */ int precrd_(integer *ivx, integer *ip, integer *nolevm, + integer *nacc, integer *ipl, integer *irest, char *udq, logical * + twooftwo, integer *icashft, ftnlen udq_len) +{ + /* System generated locals */ + integer i__1, i__2, i__3; + + /* Builtin functions */ + integer lbit_shift(integer, integer), s_wsle(cilist *), e_wsle(void), + do_lio(integer *, integer *, char *, ftnlen); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static integer i__, levminacc, levmaxacc, ip1, ile, ivx1, iold, ilev; + static logical is2nd; + extern /* Subroutine */ int stop1_(void); + static integer kicrd[10], nolev, iaccid, naccid, iorder, icrdot0; + extern /* Subroutine */ int crdaccs_(integer *, integer *, integer *, + integer *, integer *, integer *, integer *, integer *, integer *, + logical *, integer *); + static integer levtabl[88]; + extern /* Subroutine */ int setbits_(integer *, integer *, integer *, + integer *); + + /* Fortran I/O blocks */ + static cilist io___1492 = { 0, 6, 0, 0, 0 }; + static cilist io___1493 = { 0, 6, 0, 0, 0 }; + static cilist io___1504 = { 0, 6, 0, 0, 0 }; + static cilist io___1505 = { 0, 6, 0, 0, 0 }; + + + +/* Analyzes chords, data to be used with slurs on chords and plain chords. */ +/* Check for 2nds, shift notes if neccesary. */ +/* ipl(10) chord present */ +/* irest(20) set if any note is right shifted */ +/* irest(27) set if any note is left shifted */ +/* ipl(8|9) left|right shift main note */ +/* icrdat(23|24) ditto chord note */ +/* udq is updown-ness, needed to analyze 2nds. */ +/* 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 21368 "" + for (i__ = 1; i__ <= 88; ++i__) { +#line 21369 "" + levtabl[i__ - 1] = 0; +#line 21370 "" +/* L11: */ +#line 21370 "" + } +#line 21371 "" + i__1 = comtrill_1.ncrd; +#line 21371 "" + for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) { +#line 21372 "" + 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 21374 "" + ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]; +#line 21375 "" + if (ip1 == *ip && ivx1 == *ivx) { +#line 21375 "" + goto L2; +#line 21375 "" + } +#line 21376 "" +/* L1: */ +#line 21376 "" + } +#line 21377 "" + s_wsle(&io___1492); +#line 21377 "" + e_wsle(); +#line 21378 "" + s_wsle(&io___1493); +#line 21378 "" + do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"\ + "e to Dr. Don!", (ftnlen)63); +#line 21378 "" + e_wsle(); +#line 21380 "" + stop1_(); +#line 21381 "" +L2: +#line 21382 "" + comtrill_1.maxlev = *nolevm; +#line 21383 "" + comtrill_1.minlev = *nolevm; +#line 21384 "" + levtabl[*nolevm - 1] = -1; +#line 21385 "" + is2nd = FALSE_; +#line 21386 "" + naccid = 0; +#line 21387 "" + levmaxacc = -100; +#line 21388 "" + levminacc = 1000; + +/* Check 1st 3 bits of nacc for accid on main note of chord. */ + +#line 21392 "" + if ((7 & *nacc) > 0) { +#line 21393 "" + 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 21398 "" + kicrd[0] = 0; +#line 21399 "" + levmaxacc = *nolevm; +#line 21400 "" + levminacc = *nolevm; + +/* Start the level-ranking */ + +#line 21404 "" + icrdot0 = 1; +#line 21405 "" + } +#line 21406 "" + i__1 = comtrill_1.ncrd; +#line 21406 "" + for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1; + ++comtrill_1.icrd2) { +#line 21407 "" + nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, & + c__12); +#line 21408 "" + levtabl[nolev - 1] = comtrill_1.icrd2; +#line 21409 "" + comtrill_1.maxlev = max(comtrill_1.maxlev,nolev); +#line 21410 "" + comtrill_1.minlev = min(comtrill_1.minlev,nolev); + +/* Check for accidental */ + +#line 21414 "" + if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) { +#line 21415 "" + ++naccid; +#line 21416 "" + levmaxacc = max(levmaxacc,nolev); +#line 21417 "" + levminacc = min(levminacc,nolev); + +/* Add this icrd to list of values for notes with accid's. */ + +#line 21421 "" + kicrd[naccid - 1] = comtrill_1.icrd2; +#line 21422 "" + if (! bit_test(*nacc,28)) { + +/* Order not forced, so get the level-ranking, top down */ + +#line 21426 "" + iorder = 1; +#line 21427 "" + i__2 = naccid - 1; +#line 21427 "" + for (iaccid = 1; iaccid <= i__2; ++iaccid) { +#line 21428 "" + if (kicrd[iaccid - 1] == 0) { +#line 21429 "" + if (*nolevm > nolev) { +#line 21430 "" + ++iorder; +#line 21431 "" + } else { +#line 21432 "" + ++icrdot0; +#line 21433 "" + } +#line 21434 "" + } else { +#line 21435 "" + if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] - + 1], &c__7, &c__12) > nolev) { +#line 21437 "" + ++iorder; +#line 21438 "" + } else { +#line 21439 "" + iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid + - 1] - 1], &c__3, &c__27); +#line 21440 "" + i__3 = iold + 1; +#line 21440 "" + setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1] + , &c__3, &c__27, &i__3); +#line 21441 "" + } +#line 21442 "" + } +#line 21443 "" +/* L12: */ +#line 21443 "" + } +#line 21444 "" + setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, & + c__27, &iorder); +#line 21445 "" + } +#line 21446 "" + } + +/* Exit loop if last note in this chord */ + +#line 21450 "" + if (comtrill_1.icrd2 == comtrill_1.ncrd) { +#line 21450 "" + goto L4; +#line 21450 "" + } +#line 21451 "" + 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 21451 "" + goto L4; +#line 21451 "" + } +/* * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */ +#line 21455 "" +/* L3: */ +#line 21455 "" + } +#line 21456 "" + s_wsle(&io___1504); +#line 21456 "" + e_wsle(); +#line 21457 "" + s_wsle(&io___1505); +#line 21457 "" + do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."\ + " Don!", (ftnlen)55); +#line 21457 "" + e_wsle(); +#line 21458 "" + stop1_(); +#line 21459 "" +L4: + +/* Now icrd1, icrd2 define range of icrd for this chord. */ + +/* Bypass autos-shifting if any manual shifts are present */ + +#line 21465 "" + if (bit_test(*irest,20) || bit_test(*irest,27)) { +#line 21465 "" + goto L10; +#line 21465 "" + } + +/* Check for 2nds */ + +#line 21469 "" + for (ilev = 1; ilev <= 87; ++ilev) { +#line 21470 "" + if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) { + +/* There is at least one 2nd.. */ + +#line 21474 "" + if (*(unsigned char *)udq == 'u') { + +/* Upstem. Start with 2nd just found and go up, rt-shifting upper */ +/* member of each pair */ + +#line 21479 "" + ile = ilev; + +/* Set main-note flag for ANY right-shift */ + +#line 21483 "" + *irest = bit_set(*irest,20); +#line 21484 "" +L7: +#line 21485 "" + 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 21491 "" + *nacc = bit_set(*nacc,30); +#line 21492 "" + comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( + comtrill_1.icrdat[levtabl[ile - 1] - 1],24); +#line 21493 "" + } else { + +/* Upper member is chord note, must be rt-shifted */ + +#line 21497 "" + comtrill_1.icrdat[levtabl[ile] - 1] = bit_set( + comtrill_1.icrdat[levtabl[ile] - 1],24); +#line 21498 "" + } +#line 21499 "" + ++ile; +#line 21500 "" +L8: +#line 21501 "" + ++ile; +#line 21502 "" + if (ile < 87) { +#line 21503 "" + if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) { +#line 21504 "" + goto L7; +#line 21505 "" + } else { +#line 21506 "" + goto L8; +#line 21507 "" + } +#line 21508 "" + } +#line 21509 "" + goto L10; +#line 21510 "" + } 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 21515 "" + ile = 88; + +/* Set main-note flag for ANY right-shift */ + +#line 21519 "" + *irest = bit_set(*irest,27); +#line 21520 "" +L9: +#line 21521 "" + if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) { +#line 21522 "" + if (levtabl[ile - 2] < 0) { +/* ipl = ibset(ipl,8) */ + +/* Dnstem, & lower member is main so must be left-shifted. This would move */ +/* 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 21529 "" + *nacc = bit_set(*nacc,31); +#line 21530 "" + comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set( + comtrill_1.icrdat[levtabl[ile - 1] - 1],23); +#line 21531 "" + } else { + +/* Lower member is chord note, must be shifted */ + +#line 21535 "" + comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set( + comtrill_1.icrdat[levtabl[ile - 2] - 1],23); +#line 21537 "" + } +#line 21538 "" + --ile; +#line 21539 "" + } +#line 21540 "" + --ile; +#line 21541 "" + if (ile >= ilev + 1) { +#line 21541 "" + goto L9; +#line 21541 "" + } +#line 21542 "" + goto L10; +#line 21543 "" + } +#line 21544 "" + } +#line 21545 "" +/* L5: */ +#line 21545 "" + } +#line 21546 "" +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 21551 "" + if (naccid >= 1) { +#line 21551 "" + crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, & + levminacc, &icrdot0, twooftwo, icashft); +#line 21551 "" + } +#line 21553 "" + return 0; +} /* precrd_ */ + +/* Subroutine */ int printl_(char *string, ftnlen string_len) +{ + /* Builtin functions */ + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), + e_wsfe(void); + + /* Fortran I/O blocks */ + static cilist io___1508 = { 0, 6, 0, 0, 0 }; + static cilist io___1509 = { 0, 15, 0, "(a)", 0 }; + + + +/* Send string to console and to log file */ + +#line 21560 "" + s_wsle(&io___1508); +#line 21560 "" + do_lio(&c__9, &c__1, string, string_len); +#line 21560 "" + e_wsle(); +#line 21561 "" + s_wsfe(&io___1509); +#line 21561 "" + do_fio(&c__1, string, string_len); +#line 21561 "" + e_wsfe(); +#line 21562 "" + return 0; +} /* printl_ */ + +/* Subroutine */ int putarp_(real *tnow, integer *iv, integer *ip, integer * + nolev, integer *ncm, char *soutq, integer *lsout, ftnlen soutq_len) +{ + /* Initialized data */ + + static char symq[8*2] = "raisearp" "arpeggio"; + + /* System generated locals */ + address a__1[2], a__2[3], a__3[4]; + integer i__1, i__2[2], i__3[3], i__4[4]; + real r__1; + char ch__1[1], ch__2[1]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); + /* Subroutine */ int s_stop(char *, ftnlen); + integer i_nint(real *); + + /* Local variables */ + static logical isarpshift; + static integer iiv, nstaffshift; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer iarp, isym, iarps, lnote; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static integer levbot, ilvert, invert; + static char notexq[79]; + static integer iivivx1; + + /* Fortran I/O blocks */ + static icilist io___1515 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 }; + static cilist io___1521 = { 0, 6, 0, 0, 0 }; + static cilist io___1522 = { 0, 6, 0, 0, 0 }; + + + +/* NOTE iv in arg list is really ivx, referring to voice rather than staff. */ + +/* Find which iarp, if any */ + +#line 21583 "" + i__1 = comarp_1.narp; +#line 21583 "" + for (iarp = 1; iarp <= i__1; ++iarp) { +#line 21584 "" + if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) < + comtol_1.tol) { +#line 21584 "" + goto L2; +#line 21584 "" + } +#line 21585 "" +/* L1: */ +#line 21585 "" + } + +/* If here, this is the *first* call for this arp. */ + +#line 21589 "" + ++comarp_1.narp; +#line 21590 "" + comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f; +#line 21591 "" + comarp_1.ivar1[comarp_1.narp - 1] = *iv; +#line 21592 "" + comarp_1.ipar1[comarp_1.narp - 1] = *ip; +#line 21593 "" + comarp_1.levar1[comarp_1.narp - 1] = *nolev; +#line 21594 "" + comarp_1.ncmar1[comarp_1.narp - 1] = *ncm; +#line 21595 "" + return 0; +#line 21596 "" +L2: + +/* If here, this is *second* call at this time, narp points to values from 1st. */ + +/* Check for shift. Set IsArpShift and iarps */ + +#line 21602 "" + i__1 = comarpshift_1.numarpshift; +#line 21602 "" + for (iarps = 1; iarps <= i__1; ++iarps) { +#line 21603 "" + if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] && + comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp - + 1]) { +#line 21605 "" + isarpshift = TRUE_; +/* Writing concatenation */ +#line 21606 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21606 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 21606 "" + i__2[1] = 8, a__1[1] = "loffset{"; +#line 21606 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21607 "" + s_wsfi(&io___1515); +#line 21607 "" + do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen) + sizeof(real)); +#line 21607 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 21607 "" + e_wsfi(); +#line 21608 "" + lnote = 14; +#line 21609 "" + goto L4; +#line 21610 "" + } +#line 21611 "" +/* L3: */ +#line 21611 "" + } +#line 21612 "" + isarpshift = FALSE_; +#line 21613 "" + lnote = 0; +#line 21614 "" +L4: +#line 21615 "" + if (*iv == comarp_1.ivar1[iarp - 1]) { + +/* Arp is in a single voice. */ + +/* Computing MIN */ +#line 21619 "" + i__1 = comarp_1.levar1[iarp - 1]; +#line 21619 "" + levbot = min(i__1,*nolev) - *ncm + 3; +#line 21620 "" + invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1; +#line 21621 "" + } 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 21627 "" + for (iiv = 1; iiv <= 24; ++iiv) { +#line 21628 "" + 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 21630 "" + iivivx1 = iiv; +#line 21631 "" + goto L6; +#line 21632 "" + } +#line 21633 "" +/* L5: */ +#line 21633 "" + } +#line 21634 "" + s_wsle(&io___1521); +#line 21634 "" + do_lio(&c__9, &c__1, "Screwup#1 in putarp", (ftnlen)19); +#line 21634 "" + e_wsle(); +#line 21635 "" + s_stop("", (ftnlen)0); +#line 21636 "" +L6: +#line 21637 "" + for (iiv = 1; iiv <= 24; ++iiv) { +#line 21638 "" + if (commvl_1.ivmx[iiv - 1] == *iv || commvl_1.nvmx[iiv - 1] == 2 + && commvl_1.ivmx[iiv + 23] == *iv) { +#line 21638 "" + goto L8; +#line 21638 "" + } + +/* Found iv for both voices (iivivx1, iiv), done looking */ + +#line 21643 "" +/* L7: */ +#line 21643 "" + } +#line 21644 "" + s_wsle(&io___1522); +#line 21644 "" + do_lio(&c__9, &c__1, "Screwup#2 in putarp", (ftnlen)19); +#line 21644 "" + e_wsle(); +#line 21645 "" + s_stop("", (ftnlen)0); +#line 21646 "" +L8: +#line 21647 "" + if (iivivx1 == iiv) { +#line 21648 "" + nstaffshift = 0; +#line 21649 "" + } else { +#line 21650 "" + r__1 = comarp_1.xinsnow * 2; +#line 21650 "" + nstaffshift = -i_nint(&r__1); +#line 21651 "" + } +/* levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) */ +#line 21653 "" + levbot = nstaffshift + 3 + comarp_1.levar1[iarp - 1] - + comarp_1.ncmar1[iarp - 1]; +#line 21654 "" + 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 21658 "" + } + +/* isym will be (1,2) if invert is (even,odd). If even, raise .5\internote */ + +#line 21662 "" + isym = invert % 2 + 1; +#line 21663 "" + ilvert = (invert + 1) / 2; +#line 21664 "" + if (levbot >= 0 && levbot <= 9) { + +/* Single digit */ + +#line 21668 "" + if (! isarpshift) { +/* Writing concatenation */ +#line 21669 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21669 "" + i__3[0] = 1, a__2[0] = ch__1; +#line 21669 "" + i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); +#line 21669 "" + i__1 = levbot + 48; +#line 21669 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 21669 "" + i__3[2] = 1, a__2[2] = ch__2; +#line 21669 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 21670 "" + } else { +/* Writing concatenation */ +#line 21671 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 21671 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21671 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 21671 "" + i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); +#line 21671 "" + i__1 = levbot + 48; +#line 21671 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 21671 "" + i__4[3] = 1, a__3[3] = ch__2; +#line 21671 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 21673 "" + } +#line 21674 "" + lnote += 10; +#line 21675 "" + } else { +#line 21676 "" + if (! isarpshift) { +/* Writing concatenation */ +#line 21677 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21677 "" + i__3[0] = 1, a__2[0] = ch__1; +#line 21677 "" + i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3); +#line 21677 "" + i__3[2] = 1, a__2[2] = "{"; +#line 21677 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79); +#line 21678 "" + } else { +/* Writing concatenation */ +#line 21679 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 21679 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21679 "" + i__4[1] = 1, a__3[1] = ch__1; +#line 21679 "" + i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3); +#line 21679 "" + i__4[3] = 1, a__3[3] = "{"; +#line 21679 "" + s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79); +#line 21680 "" + } +#line 21681 "" + lnote += 10; +#line 21682 "" + if (levbot >= -9) { + +/* Need two spaces for number */ + +#line 21686 "" + i__1 = lnote; +#line 21686 "" + ici__1.icierr = 0; +#line 21686 "" + ici__1.icirnum = 1; +#line 21686 "" + ici__1.icirlen = lnote + 3 - i__1; +#line 21686 "" + ici__1.iciunit = notexq + i__1; +#line 21686 "" + ici__1.icifmt = "(i2,a1)"; +#line 21686 "" + s_wsfi(&ici__1); +#line 21686 "" + do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); +#line 21686 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 21686 "" + e_wsfi(); +#line 21687 "" + lnote += 3; +#line 21688 "" + } else { +#line 21689 "" + i__1 = lnote; +#line 21689 "" + ici__1.icierr = 0; +#line 21689 "" + ici__1.icirnum = 1; +#line 21689 "" + ici__1.icirlen = lnote + 4 - i__1; +#line 21689 "" + ici__1.iciunit = notexq + i__1; +#line 21689 "" + ici__1.icifmt = "(i3,a1)"; +#line 21689 "" + s_wsfi(&ici__1); +#line 21689 "" + do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer)); +#line 21689 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 21689 "" + e_wsfi(); +#line 21690 "" + lnote += 4; +#line 21691 "" + } +#line 21692 "" + } +/* if (ilvert .le. 9) then */ +/* call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */ +/* * soutq,lsout) */ +/* else */ +/* write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' */ +/* call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) */ +/* end if */ +#line 21701 "" + if (ilvert > 9) { +#line 21702 "" + i__1 = lnote; +#line 21702 "" + ici__1.icierr = 0; +#line 21702 "" + ici__1.icirnum = 1; +#line 21702 "" + ici__1.icirlen = lnote + 4 - i__1; +#line 21702 "" + ici__1.iciunit = notexq + i__1; +#line 21702 "" + ici__1.icifmt = "(a1,i2,a1)"; +#line 21702 "" + s_wsfi(&ici__1); +#line 21702 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 21702 "" + do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer)); +#line 21702 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 21702 "" + e_wsfi(); +#line 21703 "" + lnote += 4; +#line 21704 "" + } else { +/* Writing concatenation */ +#line 21705 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 21705 "" + i__1 = ilvert + 48; +#line 21705 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 21705 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 21705 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21706 "" + ++lnote; +#line 21707 "" + } +#line 21708 "" + if (isarpshift) { +/* Writing concatenation */ +#line 21709 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 21709 "" + i__2[1] = 1, a__1[1] = "}"; +#line 21709 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21710 "" + ++lnote; +#line 21711 "" + } +#line 21712 "" + addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80); + +/* cancel out the stored time, to permit two arps at same time! */ + +#line 21716 "" + comarp_1.tar[iarp - 1] = -1.f; +#line 21717 "" + return 0; +} /* putarp_ */ + +/* Subroutine */ int putast_(real *elask, integer *indxask, char *outq, + ftnlen outq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1, i__2[3]; + icilist ici__1; + + /* Builtin functions */ + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + + /* Local variables */ + static integer lp; + static char tag[129], fmtq[9]; + + /* Fortran I/O blocks */ + static icilist io___1528 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 }; + + +#line 21722 "" + if (*elask >= 0.f) { +#line 21723 "" + if (*elask < .995f) { +#line 21724 "" + lp = 3; +#line 21725 "" + } else if (*elask < 9.995f) { +#line 21726 "" + lp = 4; +#line 21727 "" + } else { +#line 21728 "" + lp = 5; +#line 21729 "" + } +#line 21730 "" + s_wsfi(&io___1528); +#line 21730 "" + do_fio(&c__1, "(a2,f", (ftnlen)5); +#line 21730 "" + do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer)); +#line 21730 "" + do_fio(&c__1, ".2)", (ftnlen)3); +#line 21730 "" + e_wsfi(); +#line 21731 "" + } else { +#line 21732 "" + lp = 5; +#line 21733 "" + s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9); +#line 21734 "" + } + +/* Overwrite as follows: ...xyz*ask *lmnop... -> */ +/* ...xyz*ast{.nn}*lmnop... */ +/* ...xyz*ast{n.nn}*lmnop... */ +/* ...xyz*ast{nn.nn}*lmnop... */ +/* or for negative, ...xyz*ast{-nn.n}*lmnop... */ +#line 21741 "" + i__1 = *indxask + 8; +#line 21741 "" + s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1); +#line 21742 "" + i__1 = *indxask + 2; +#line 21742 "" + ici__1.icierr = 0; +#line 21742 "" + ici__1.icirnum = 1; +#line 21742 "" + ici__1.icirlen = 129 - i__1; +#line 21742 "" + ici__1.iciunit = outq + i__1; +#line 21742 "" + ici__1.icifmt = fmtq; +#line 21742 "" + s_wsfi(&ici__1); +#line 21742 "" + do_fio(&c__1, "t{", (ftnlen)2); +#line 21742 "" + do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real)); +#line 21742 "" + e_wsfi(); +/* Writing concatenation */ +#line 21743 "" + i__2[0] = *indxask + 4 + lp, a__1[0] = outq; +#line 21743 "" + i__2[1] = 1, a__1[1] = "}"; +#line 21743 "" + i__2[2] = 129, a__1[2] = tag; +#line 21743 "" + s_cat(outq, a__1, i__2, &c__3, (ftnlen)129); +#line 21744 "" + return 0; +} /* putast_ */ + +/* Subroutine */ int putcb_(integer *ivx, integer *ip, char *notexq, integer * + lnote, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[2]; + integer i__1, i__2[2]; + char ch__1[1]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_stop(char *, ftnlen), s_copy(char *, char *, + ftnlen, ftnlen), s_cat(char *, char **, integer *, integer *, + ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static integer ibc, ipbc, ivxbc; + static real hshft; + static integer ihshft, ivshft; + extern /* Subroutine */ int printl_(char *, ftnlen); + +/* ivxip = ivx+16*ip */ +#line 21751 "" + i__1 = comcb_1.nbc; +#line 21751 "" + 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 21755 "" + ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[ + ibc - 1], &c__1, &c__28) << 4); +#line 21756 "" + ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4); +#line 21757 "" + if (*ivx == ivxbc && *ip == ipbc) { +#line 21757 "" + goto L2; +#line 21757 "" + } +#line 21758 "" +/* L1: */ +#line 21758 "" + } +#line 21759 "" + printl_("Error in putbc, Call Dr. Don", (ftnlen)28); +#line 21760 "" + s_stop("", (ftnlen)0); +#line 21761 "" +L2: +#line 21762 "" + if (bit_test(comcb_1.ibcdata[ibc - 1],27)) { +#line 21763 "" + *lnote = 8; +#line 21764 "" + s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8); +#line 21765 "" + } else { +#line 21766 "" + *lnote = 9; +#line 21767 "" + s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9); +#line 21768 "" + } +#line 21769 "" + ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13); +/* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */ +#line 21771 "" + if (ivshft > 0) { +#line 21771 "" + ivshft += -32; +#line 21771 "" + } +#line 21772 "" + if (ivshft < 0 || ivshft > 9) { +/* Writing concatenation */ +#line 21773 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21773 "" + i__2[1] = 1, a__1[1] = "{"; +#line 21773 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21774 "" + ++(*lnote); +#line 21775 "" + if (ivshft < -9) { +#line 21776 "" + i__1 = *lnote; +#line 21776 "" + ici__1.icierr = 0; +#line 21776 "" + ici__1.icirnum = 1; +#line 21776 "" + ici__1.icirlen = *lnote + 3 - i__1; +#line 21776 "" + ici__1.iciunit = notexq + i__1; +#line 21776 "" + ici__1.icifmt = "(i3)"; +#line 21776 "" + s_wsfi(&ici__1); +#line 21776 "" + do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 21776 "" + e_wsfi(); +#line 21777 "" + *lnote += 3; +#line 21778 "" + } else { +#line 21779 "" + i__1 = *lnote; +#line 21779 "" + ici__1.icierr = 0; +#line 21779 "" + ici__1.icirnum = 1; +#line 21779 "" + ici__1.icirlen = *lnote + 2 - i__1; +#line 21779 "" + ici__1.iciunit = notexq + i__1; +#line 21779 "" + ici__1.icifmt = "(i2)"; +#line 21779 "" + s_wsfi(&ici__1); +#line 21779 "" + do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 21779 "" + e_wsfi(); +#line 21780 "" + *lnote += 2; +#line 21781 "" + } +/* Writing concatenation */ +#line 21782 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21782 "" + i__2[1] = 1, a__1[1] = "}"; +#line 21782 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21783 "" + ++(*lnote); +#line 21784 "" + } else { +/* Writing concatenation */ +#line 21785 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21785 "" + *(unsigned char *)&ch__1[0] = ivshft + 48; +#line 21785 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 21785 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21786 "" + ++(*lnote); +#line 21787 "" + } +#line 21788 "" + ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19); +#line 21789 "" + if (ihshft == 0) { +/* Writing concatenation */ +#line 21790 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21790 "" + i__2[1] = 1, a__1[1] = "0"; +#line 21790 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21791 "" + ++(*lnote); +#line 21792 "" + } else { +#line 21793 "" + hshft = (ihshft - 128) * .1f; + +/* -12.8<hshft<12.8 */ + +/* Writing concatenation */ +#line 21797 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21797 "" + i__2[1] = 1, a__1[1] = "{"; +#line 21797 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21798 "" + ++(*lnote); +#line 21799 "" + if (hshft < -9.95f) { +#line 21800 "" + i__1 = *lnote; +#line 21800 "" + ici__1.icierr = 0; +#line 21800 "" + ici__1.icirnum = 1; +#line 21800 "" + ici__1.icirlen = *lnote + 5 - i__1; +#line 21800 "" + ici__1.iciunit = notexq + i__1; +#line 21800 "" + ici__1.icifmt = "(f5.1)"; +#line 21800 "" + s_wsfi(&ici__1); +#line 21800 "" + do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21800 "" + e_wsfi(); +#line 21801 "" + *lnote += 5; +#line 21802 "" + } else if (hshft < -.05f || hshft > 9.95f) { +#line 21803 "" + i__1 = *lnote; +#line 21803 "" + ici__1.icierr = 0; +#line 21803 "" + ici__1.icirnum = 1; +#line 21803 "" + ici__1.icirlen = *lnote + 4 - i__1; +#line 21803 "" + ici__1.iciunit = notexq + i__1; +#line 21803 "" + ici__1.icifmt = "(f4.1)"; +#line 21803 "" + s_wsfi(&ici__1); +#line 21803 "" + do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21803 "" + e_wsfi(); +#line 21804 "" + *lnote += 4; +#line 21805 "" + } else { +#line 21806 "" + i__1 = *lnote; +#line 21806 "" + ici__1.icierr = 0; +#line 21806 "" + ici__1.icirnum = 1; +#line 21806 "" + ici__1.icirlen = *lnote + 3 - i__1; +#line 21806 "" + ici__1.iciunit = notexq + i__1; +#line 21806 "" + ici__1.icifmt = "(f3.1)"; +#line 21806 "" + s_wsfi(&ici__1); +#line 21806 "" + do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21806 "" + e_wsfi(); +#line 21807 "" + *lnote += 3; +#line 21808 "" + } +/* Writing concatenation */ +#line 21809 "" + i__2[0] = *lnote, a__1[0] = notexq; +#line 21809 "" + i__2[1] = 1, a__1[1] = "}"; +#line 21809 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21810 "" + ++(*lnote); +#line 21811 "" + } +#line 21812 "" + return 0; +} /* putcb_ */ + +/* Subroutine */ int putfig_(integer *ivx, integer *ifig, real *offnsk, + logical *figcheck, char *soutq, integer *lsout, ftnlen soutq_len) +{ + /* System generated locals */ + address a__1[6], a__2[2], a__3[3], a__4[4]; + integer i__1[6], i__2[2], i__3, i__4[3], i__5[4]; + real r__1; + char ch__1[1], ch__2[22], ch__3[21], ch__4[20], ch__5[19], ch__6[18], + ch__7[13], ch__8[11], ch__9[8], ch__10[2]; + + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, + char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer ic; + static char sq[1]; + static integer nof; + static char ch1q[1], ch2q[1]; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer nofa; + static char figq[10]; + static integer lnof; + static char nofq[5]; + static integer lnum, lnofa; + static char nofaq[5]; + static integer icnum, lnote; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static char figutq[4], conttq[4], notexq[80]; + extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen) + ; + + /* Fortran I/O blocks */ + static icilist io___1541 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; + static icilist io___1542 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; + static icilist io___1543 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; + static icilist io___1544 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; + static icilist io___1557 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; + static icilist io___1558 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; + static icilist io___1559 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; + static icilist io___1560 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; + + +#line 21824 "" + if (*ivx == 1) { +#line 21825 "" + s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4); +#line 21826 "" + s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4); +#line 21827 "" + } else { +#line 21828 "" + s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4); +#line 21829 "" + s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4); +#line 21830 "" + } +#line 21831 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 21831 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 21832 "" + if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] != 0) { + +/* Alter figdrop */ + +/* Writing concatenation */ +#line 21836 "" + i__1[0] = 1, a__1[0] = sq; +#line 21836 "" + i__1[1] = 6, a__1[1] = "global"; +#line 21836 "" + i__1[2] = 1, a__1[2] = sq; +#line 21836 "" + i__1[3] = 7, a__1[3] = "advance"; +#line 21836 "" + i__1[4] = 1, a__1[4] = sq; +#line 21836 "" + i__1[5] = 7, a__1[5] = "figdrop"; +#line 21836 "" + s_cat(notexq, a__1, i__1, &c__6, (ftnlen)80); +#line 21837 "" + lnote = 23; +#line 21838 "" + if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] < 0) { +/* Writing concatenation */ +#line 21839 "" + i__2[0] = lnote, a__2[0] = notexq; +#line 21839 "" + i__2[1] = 1, a__2[1] = "-"; +#line 21839 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 21840 "" + ++lnote; +#line 21841 "" + } +/* Writing concatenation */ +#line 21842 "" + i__2[0] = lnote, a__2[0] = notexq; +#line 21842 "" + *(unsigned char *)&ch__1[0] = (i__3 = comfig_2.ivvfig[*ivx + (*ifig << + 1) - 3], abs(i__3)) + 48; +#line 21842 "" + i__2[1] = 1, a__2[1] = ch__1; +#line 21842 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 21843 "" + ++lnote; +#line 21844 "" + addstr_(notexq, &lnote, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 21845 "" + } +#line 21846 "" + if (dabs(*offnsk) > 1e-4f) { + +/* Write offset for floating figure, to two decimal places */ + +/* Writing concatenation */ +#line 21850 "" + i__2[0] = 1, a__2[0] = sq; +#line 21850 "" + i__2[1] = 4, a__2[1] = "off{"; +#line 21850 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 21851 "" + if (-(*offnsk) < -9.995f) { +#line 21852 "" + s_wsfi(&io___1541); +#line 21852 "" + r__1 = -(*offnsk); +#line 21852 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 21852 "" + e_wsfi(); +#line 21853 "" + lnote = 11; +#line 21854 "" + } else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) { +#line 21855 "" + s_wsfi(&io___1542); +#line 21855 "" + r__1 = -(*offnsk); +#line 21855 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 21855 "" + e_wsfi(); +#line 21856 "" + lnote = 10; +#line 21857 "" + } else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) { +#line 21858 "" + s_wsfi(&io___1543); +#line 21858 "" + r__1 = -(*offnsk); +#line 21858 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 21858 "" + e_wsfi(); +#line 21859 "" + lnote = 9; +#line 21860 "" + } else { +#line 21861 "" + s_wsfi(&io___1544); +#line 21861 "" + r__1 = -(*offnsk); +#line 21861 "" + do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 21861 "" + e_wsfi(); +#line 21862 "" + lnote = 8; +#line 21863 "" + } +/* Writing concatenation */ +#line 21864 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 21864 "" + i__4[1] = 1, a__3[1] = sq; +#line 21864 "" + i__4[2] = 9, a__3[2] = "noteskip}"; +#line 21864 "" + s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); +#line 21865 "" + i__3 = lnote + 10; +#line 21865 "" + addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 21866 "" + } +#line 21867 "" + s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10, + (ftnlen)10); +#line 21868 "" + ic = 1; +/* nof = 0 */ +/* nofa = -1 */ +#line 21871 "" + nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3]; +#line 21872 "" + nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1; + +/* Beginning of manual loop */ + +#line 21876 "" +L1: +#line 21876 "" + *(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1]; + +/* Exit when first blank is encountered */ + +#line 21880 "" + if (*(unsigned char *)ch1q == ' ') { +#line 21880 "" + goto L2; +#line 21880 "" + } + +/* Starting a level. Set up vertical offset. */ + +/* lnof = 1 */ +/* nofq = chax(nof+48) */ +/* if (nof .gt. 9) then */ +/* lnof = 2 */ +/* nofq = '1'//chax(nof-10+48) */ +/* end if */ +/* if (nofa .eq.-1) then */ +/* lnofa = 2 */ +/* nofaq = '-1' */ +/* else if (nofa .lt. 10) then */ +/* lnofa = 1 */ +/* nofaq = chax(nofa+48) */ +/* else */ +/* lnofa = 2 */ +/* nofaq = '1'//chax(nofa+38) */ +/* end if */ +#line 21900 "" + istring_(&nof, nofq, &lnof, (ftnlen)5); +#line 21901 "" + istring_(&nofa, nofaq, &lnofa, (ftnlen)5); +#line 21902 "" + 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 21908 "" + icnum = ic + 1; +#line 21909 "" +L3: +#line 21910 "" + ++ic; +#line 21911 "" + if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0) + { +#line 21911 "" + goto L3; +#line 21911 "" + } +#line 21912 "" + lnum = ic - icnum; +/* Writing concatenation */ +#line 21913 "" + i__1[0] = 1, a__1[0] = sq; +#line 21913 "" + i__1[1] = 4, a__1[1] = conttq; +#line 21913 "" + i__1[2] = lnof, a__1[2] = nofq; +#line 21913 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21913 "" + i__1[4] = ic - 1 - (icnum - 1), a__1[4] = figq + (icnum - 1); +#line 21913 "" + i__1[5] = 1, a__1[5] = "}"; +#line 21913 "" + s_cat(ch__2, a__1, i__1, &c__6, (ftnlen)22); +#line 21913 "" + i__3 = ic + 7 - icnum + lnof; +#line 21913 "" + addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1)) + + 1, (ftnlen)80); +#line 21915 "" + if (*(unsigned char *)&figq[ic - 1] != ':') { +#line 21915 "" + --ic; +#line 21915 "" + } +#line 21916 "" + } else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-' + || *(unsigned char *)ch1q == 'n') { +#line 21917 "" + ++ic; +#line 21918 "" + *(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1]; +#line 21919 "" + if (*(unsigned char *)ch2q == ' ') { + +/* Figure is a stand-alone accidental, so must be centered */ + +#line 21923 "" + if (*(unsigned char *)ch1q == '#') { +/* Writing concatenation */ +#line 21924 "" + i__1[0] = 1, a__1[0] = sq; +#line 21924 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21924 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21924 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21924 "" + i__1[4] = 1, a__1[4] = sq; +#line 21924 "" + i__1[5] = 9, a__1[5] = "sharpfig}"; +#line 21924 "" + s_cat(ch__3, a__1, i__1, &c__6, (ftnlen)21); +#line 21924 "" + i__3 = lnofa + 16; +#line 21924 "" + addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80); +#line 21926 "" + } else if (*(unsigned char *)ch1q == '-') { +/* Writing concatenation */ +#line 21927 "" + i__1[0] = 1, a__1[0] = sq; +#line 21927 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21927 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21927 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21927 "" + i__1[4] = 1, a__1[4] = sq; +#line 21927 "" + i__1[5] = 8, a__1[5] = "flatfig}"; +#line 21927 "" + s_cat(ch__4, a__1, i__1, &c__6, (ftnlen)20); +#line 21927 "" + i__3 = lnofa + 15; +#line 21927 "" + addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80); +#line 21929 "" + } else if (*(unsigned char *)ch1q == 'n') { +/* Writing concatenation */ +#line 21930 "" + i__1[0] = 1, a__1[0] = sq; +#line 21930 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21930 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21930 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21930 "" + i__1[4] = 1, a__1[4] = sq; +#line 21930 "" + i__1[5] = 7, a__1[5] = "natfig}"; +#line 21930 "" + s_cat(ch__5, a__1, i__1, &c__6, (ftnlen)19); +#line 21930 "" + i__3 = lnofa + 14; +#line 21930 "" + addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80); +#line 21932 "" + } +#line 21933 "" + goto L2; +#line 21934 "" + } else { + +/* Figure is an accidental followed by a number */ +/* First put the accidental (offset to the left) */ + +#line 21939 "" + if (*(unsigned char *)ch1q == '#') { +/* Writing concatenation */ +#line 21940 "" + i__1[0] = 1, a__1[0] = sq; +#line 21940 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21940 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21940 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21940 "" + i__1[4] = 1, a__1[4] = sq; +#line 21940 "" + i__1[5] = 6, a__1[5] = "fsmsh}"; +#line 21940 "" + s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 21940 "" + i__3 = lnofa + 13; +#line 21940 "" + addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 21943 "" + } else if (*(unsigned char *)ch1q == '-') { +/* Writing concatenation */ +#line 21944 "" + i__1[0] = 1, a__1[0] = sq; +#line 21944 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21944 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21944 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21944 "" + i__1[4] = 1, a__1[4] = sq; +#line 21944 "" + i__1[5] = 6, a__1[5] = "fsmfl}"; +#line 21944 "" + s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 21944 "" + i__3 = lnofa + 13; +#line 21944 "" + addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 21947 "" + } else if (*(unsigned char *)ch1q == 'n') { +/* Writing concatenation */ +#line 21948 "" + i__1[0] = 1, a__1[0] = sq; +#line 21948 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21948 "" + i__1[2] = lnofa, a__1[2] = nofaq; +#line 21948 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21948 "" + i__1[4] = 1, a__1[4] = sq; +#line 21948 "" + i__1[5] = 6, a__1[5] = "fsmna}"; +#line 21948 "" + s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18); +#line 21948 "" + i__3 = lnofa + 13; +#line 21948 "" + addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80); +#line 21951 "" + } + +/* Now put the number */ + +/* Writing concatenation */ +#line 21955 "" + i__1[0] = 1, a__1[0] = sq; +#line 21955 "" + i__1[1] = 4, a__1[1] = figutq; +#line 21955 "" + i__1[2] = lnof, a__1[2] = nofq; +#line 21955 "" + i__1[3] = 1, a__1[3] = "{"; +#line 21955 "" + i__1[4] = 1, a__1[4] = ch2q; +#line 21955 "" + i__1[5] = 1, a__1[5] = "}"; +#line 21955 "" + s_cat(ch__7, a__1, i__1, &c__6, (ftnlen)13); +#line 21955 "" + i__3 = lnof + 8; +#line 21955 "" + addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80); +#line 21957 "" + } +#line 21958 "" + } else if (*(unsigned char *)ch1q == '_') { + +/* Placeholder only (for lowering a figure). Don't do anything! */ + +#line 21963 "" + } else { + +/* Figure is a single number, maybe with s after */ + +/* Writing concatenation */ +#line 21967 "" + i__5[0] = 1, a__4[0] = sq; +#line 21967 "" + i__5[1] = 4, a__4[1] = figutq; +#line 21967 "" + i__5[2] = lnof, a__4[2] = nofq; +#line 21967 "" + i__5[3] = 1, a__4[3] = "{"; +#line 21967 "" + s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11); +#line 21967 "" + i__3 = lnof + 6; +#line 21967 "" + addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80); +#line 21969 "" + i__3 = ic; +#line 21969 "" + s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3); +#line 21970 "" + if (*(unsigned char *)ch2q == 's') { + +/* Use a special character. Insert font call */ + +#line 21974 "" + ++ic; +/* Writing concatenation */ +#line 21975 "" + i__2[0] = 1, a__2[0] = sq; +#line 21975 "" + i__2[1] = 7, a__2[1] = "ligfont"; +#line 21975 "" + s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8); +#line 21975 "" + addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80); +#line 21976 "" + } +/* Writing concatenation */ +#line 21977 "" + i__2[0] = 1, a__2[0] = ch1q; +#line 21977 "" + i__2[1] = 1, a__2[1] = "}"; +#line 21977 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)2); +#line 21977 "" + addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80); +/* call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */ +/* * 8+lnof,soutq,lsout) */ +#line 21980 "" + } +#line 21981 "" + if (ic >= 10) { +#line 21981 "" + goto L2; +#line 21981 "" + } +#line 21982 "" + ++ic; +#line 21983 "" + nof += 4; +#line 21984 "" + nofa += 4; +#line 21985 "" + goto L1; +#line 21986 "" +L2: +#line 21987 "" + if (dabs(*offnsk) > 1e-4f) { +/* Writing concatenation */ +#line 21988 "" + i__2[0] = 1, a__2[0] = sq; +#line 21988 "" + i__2[1] = 4, a__2[1] = "off{"; +#line 21988 "" + s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80); +#line 21989 "" + if (*offnsk < -9.995f) { +#line 21990 "" + s_wsfi(&io___1557); +#line 21990 "" + do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 21990 "" + e_wsfi(); +#line 21991 "" + lnote = 11; +#line 21992 "" + } else if (*offnsk < -.995f || *offnsk > 9.995f) { +#line 21993 "" + s_wsfi(&io___1558); +#line 21993 "" + do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 21993 "" + e_wsfi(); +#line 21994 "" + lnote = 10; +#line 21995 "" + } else if (*offnsk < -1e-4f || *offnsk > .995f) { +#line 21996 "" + s_wsfi(&io___1559); +#line 21996 "" + do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 21996 "" + e_wsfi(); +#line 21997 "" + lnote = 9; +#line 21998 "" + } else { +#line 21999 "" + s_wsfi(&io___1560); +#line 21999 "" + do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real)); +#line 21999 "" + e_wsfi(); +#line 22000 "" + lnote = 8; +#line 22001 "" + } +/* Writing concatenation */ +#line 22002 "" + i__4[0] = lnote, a__3[0] = notexq; +#line 22002 "" + i__4[1] = 1, a__3[1] = sq; +#line 22002 "" + i__4[2] = 9, a__3[2] = "noteskip}"; +#line 22002 "" + s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80); +#line 22003 "" + i__3 = lnote + 10; +#line 22003 "" + addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80); +#line 22004 "" + } +#line 22005 "" + if (*ifig < comfig_2.nfigs[*ivx - 1]) { +#line 22006 "" + ++(*ifig); +#line 22007 "" + } else { +#line 22008 "" + comfig_2.nfigs[*ivx - 1] = 0; +#line 22009 "" + *figcheck = FALSE_; +#line 22010 "" + } +#line 22011 "" + return 0; +} /* putfig_ */ + +/* Subroutine */ int putorn_(integer *iornq, integer *nolev, integer *nolevm, + integer *nodur, integer *nornb, char *ulq, integer *ibmcnt, integer * + ivx, integer *ncm, integer *islur, integer *nvmx, integer *nv, + integer *ihornb, real *stemlin, char *outq, integer *lout, integer * + ip, integer *islhgt, logical *beamon, logical *iscrd, ftnlen ulq_len, + ftnlen outq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3], a__3[6]; + integer i__1, i__2, i__3[2], i__4[3], i__5[6]; + real r__1, r__2; + char ch__1[1], ch__2[6]; + icilist ici__1; + + /* Builtin functions */ + integer pow_ii(integer *, integer *), i_nint(real *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer lbit_shift(integer, integer), i_dim(integer *, integer *), s_wsfi( + icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); + static logical usehornb; + static char sq[1]; + extern integer log2_(integer *); + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer ioff, ibit; + extern /* Character */ VOID udqq_(char *, ftnlen, integer *, integer *, + integer *, integer *, integer *, integer *); + extern integer lfmt1_(real *); + static integer ibitt, ihorn, lform, lnote; + static char noteq[8]; + static integer iornt; + static char ulpzq[1]; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten, iudorn; + static char notexq[79]; + static integer iclracc, ioffinc; + static real stemlen; + extern /* Subroutine */ int dotrill_(integer *, integer *, integer *, + char *, integer *, char *, integer *, ftnlen, ftnlen); + + +/* All args are individual array element *values* except nornb,ihornb,ulq. */ +/* notcrd = .true. if ornament is on main note. */ +/* nolevm is level of main note (for chords) */ + +#line 22031 "" + /* Parameter adjustments */ +#line 22031 "" + ihornb -= 25; +#line 22031 "" + ulq -= 25; +#line 22031 "" + --nornb; +#line 22031 "" + +#line 22031 "" + /* Function Body */ +#line 22031 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 22031 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 22032 "" + *lout = 0; +#line 22033 "" + usehornb = FALSE_; +#line 22034 "" + if (*nodur < 64) { +#line 22035 "" + stemlen = *stemlin; +#line 22036 "" + } else { +#line 22037 "" + stemlen = 0.f; +#line 22038 "" + } + +/* Get up-downness. ulpzq is opposite from stem direction for both beams and */ +/* non beams. Can use in name of ornament [ . or _ ] */ + +#line 22043 "" + if (*beamon) { +#line 22044 "" + if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') { +#line 22045 "" + *(unsigned char *)ulpzq = 'l'; +#line 22046 "" + } else { +#line 22047 "" + *(unsigned char *)ulpzq = 'u'; +#line 22048 "" + } +#line 22049 "" + } else { +#line 22050 "" + udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv); +#line 22050 "" + if (*(unsigned char *)&ch__1[0] == 'l') { +#line 22051 "" + *(unsigned char *)ulpzq = 'u'; +#line 22052 "" + } else { +#line 22053 "" + *(unsigned char *)ulpzq = 'l'; +#line 22054 "" + } +#line 22055 "" + } + +/* To enable >1 ornament on a note, next line is top of manual loop. */ + +#line 22059 "" +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 22064 "" + if (bit_test(*iornq,29)) { +#line 22065 "" + ibit = 29; +#line 22066 "" + } else if (bit_test(*iornq,30)) { +#line 22067 "" + ibit = 30; +#line 22068 "" + } else { +#line 22069 "" + i__1 = *iornq & 4194303; +#line 22069 "" + ibit = log2_(&i__1); +/* ibit = log2(iand(iornq,33554431)) */ +#line 22071 "" + } +#line 22072 "" + iornt = pow_ii(&c__2, &ibit); + +/* Begin routine to set height. Bits 0-13: (stmgx+Tupf._) */ +/* 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n */ +/* 19-20: >^, 21: ? (with or w/o 16-18) */ +/* and 29-30: C (coda), G (new segno) */ + +/* Do not use beam height for . or _ */ + +#line 22081 "" + 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 22086 "" + ihorn = ihornb[*ivx + nornb[*ivx] * 24]; +#line 22087 "" + if (*(unsigned char *)ulpzq == 'u') { +#line 22087 "" + ihorn += -2; +#line 22087 "" + } + +/* Following flag tells whether to increment nornb when exiting the subroutine. */ + +#line 22091 "" + usehornb = TRUE_; +#line 22092 "" + } else if (ibit == 14) { + +/* Down fermata. Don't worry about upper chord notes. */ + +#line 22096 "" + if (*(unsigned char *)ulpzq == 'l') { +/* Computing MIN */ +#line 22097 "" + i__1 = *nolev, i__2 = *ncm - 3; +#line 22097 "" + ihorn = min(i__1,i__2); +#line 22098 "" + } else { +/* Computing MIN */ +#line 22099 "" + r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; +#line 22099 "" + ihorn = dmin(r__1,r__2); +#line 22100 "" + } +#line 22101 "" + } else if (bit_test(iornt,13) || bit_test(iornt,0)) { + +/* ( or ) */ + +#line 22105 "" + ihorn = *nolev; +#line 22106 "" + } 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 22112 "" + if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *) + ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned + char *)ulpzq == 'u') { +#line 22114 "" + ihorn = *nolev; +#line 22115 "" + } else if (comtrill_1.maxlev == *nolev) { +#line 22116 "" + *(unsigned char *)ulpzq = 'u'; +/* Computing MAX */ +#line 22117 "" + r__1 = *nolev + stemlen, r__2 = *ncm + 3.f; +#line 22117 "" + ihorn = dmax(r__1,r__2); +#line 22118 "" + } else { +#line 22119 "" + *(unsigned char *)ulpzq = 'l'; +/* Computing MIN */ +#line 22120 "" + r__1 = *nolev - stemlen, r__2 = *ncm - 3.f; +#line 22120 "" + ihorn = dmin(r__1,r__2); +#line 22121 "" + } +#line 22122 "" + } else if (*iscrd && *nolev == comtrill_1.minlev) { +#line 22123 "" + if (*(unsigned char *)ulpzq == 'l') { +/* Computing MIN */ +#line 22124 "" + i__1 = *nolev - 3, i__2 = *ncm - 6; +#line 22124 "" + ihorn = min(i__1,i__2); +#line 22125 "" + } else { +/* Computing MIN */ +#line 22126 "" + i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6; +#line 22126 "" + ihorn = min(i__1,i__2); +#line 22127 "" + } +#line 22128 "" + } else if (ibit == 10 && *nolev > 90) { + +/* Special treatment for fermata on a shifted rest */ + +#line 22132 "" + ihorn = *ncm + 5; +#line 22133 "" + } else if (*(unsigned char *)ulpzq == 'l') { + +/* (iscrd and nolev=maxlev) or (.not.iscrd) */ + +/* Computing MAX */ +#line 22137 "" + r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f; +#line 22137 "" + ihorn = dmax(r__1,r__2); +#line 22138 "" + } else if (ibit == 29 || ibit == 30) { + +/* coda or new segno, no height tweak */ + +#line 22142 "" + ihorn = *ncm + 5; +#line 22143 "" + } else { +/* Computing MAX */ +#line 22144 "" + i__1 = *nolev + 2, i__2 = *ncm + 5; +#line 22144 "" + ihorn = max(i__1,i__2); +#line 22145 "" + } +#line 22146 "" + ioff = 0; +#line 22147 "" + 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 22152 "" + if (bit_test(iornt,2)) { +/* Writing concatenation */ +#line 22153 "" + i__3[0] = 1, a__1[0] = sq; +#line 22153 "" + i__3[1] = 5, a__1[1] = "shake"; +#line 22153 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22154 "" + lnote = 6; +#line 22155 "" + } else if (bit_test(iornt,3)) { +/* Writing concatenation */ +#line 22156 "" + i__3[0] = 1, a__1[0] = sq; +#line 22156 "" + i__3[1] = 7, a__1[1] = "mordent"; +#line 22156 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22157 "" + lnote = 8; +#line 22158 "" + } else if (bit_test(iornt,1)) { +/* Writing concatenation */ +#line 22159 "" + i__3[0] = 1, a__1[0] = sq; +#line 22159 "" + i__3[1] = 3, a__1[1] = "mtr"; +#line 22159 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22160 "" + lnote = 4; +#line 22161 "" + } else if (bit_test(iornt,5)) { +/* Writing concatenation */ +#line 22162 "" + i__3[0] = 1, a__1[0] = sq; +#line 22162 "" + i__3[1] = 3, a__1[1] = "xtr"; +#line 22162 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22163 "" + lnote = 4; +#line 22164 "" + } else if (bit_test(iornt,6)) { +/* Writing concatenation */ +#line 22165 "" + i__3[0] = 1, a__1[0] = sq; +#line 22165 "" + i__3[1] = 3, a__1[1] = "ptr"; +#line 22165 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22166 "" + lnote = 4; +#line 22167 "" + } else if (bit_test(iornt,13)) { +/* Writing concatenation */ +#line 22168 "" + i__3[0] = 1, a__1[0] = sq; +#line 22168 "" + i__3[1] = 3, a__1[1] = "rpn"; +#line 22168 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22169 "" + lnote = 4; +#line 22170 "" + } else if (bit_test(iornt,0)) { +/* Writing concatenation */ +#line 22171 "" + i__3[0] = 1, a__1[0] = sq; +#line 22171 "" + i__3[1] = 3, a__1[1] = "lpn"; +#line 22171 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22172 "" + lnote = 4; +#line 22173 "" + } else if (bit_test(iornt,12)) { +/* Writing concatenation */ +#line 22174 "" + i__4[0] = 1, a__2[0] = sq; +#line 22174 "" + i__4[1] = 1, a__2[1] = ulpzq; +#line 22174 "" + i__4[2] = 2, a__2[2] = "st"; +#line 22174 "" + s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 22175 "" + lnote = 4; +#line 22176 "" + } else if (bit_test(iornt,11)) { +/* Writing concatenation */ +#line 22177 "" + i__4[0] = 1, a__2[0] = sq; +#line 22177 "" + i__4[1] = 1, a__2[1] = ulpzq; +#line 22177 "" + i__4[2] = 2, a__2[2] = "pz"; +#line 22177 "" + s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79); +#line 22178 "" + lnote = 4; +#line 22179 "" + } else if (bit_test(iornt,8)) { +/* Writing concatenation */ +#line 22180 "" + i__3[0] = 1, a__1[0] = sq; +#line 22180 "" + i__3[1] = 3, a__1[1] = "upz"; +#line 22180 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22181 "" + lnote = 4; +#line 22182 "" + ioff = -2; +#line 22183 "" + } else if (bit_test(iornt,9)) { +/* Writing concatenation */ +#line 22184 "" + i__3[0] = 1, a__1[0] = sq; +#line 22184 "" + i__3[1] = 4, a__1[1] = "uppz"; +#line 22184 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22185 "" + lnote = 5; +#line 22186 "" + ioff = -2; +#line 22187 "" + } else if (bit_test(iornt,10)) { +#line 22188 "" + if (*nodur < 48) { +/* Writing concatenation */ +#line 22189 "" + i__3[0] = 1, a__1[0] = sq; +#line 22189 "" + i__3[1] = 9, a__1[1] = "fermataup"; +#line 22189 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22190 "" + } else { +/* Writing concatenation */ +#line 22191 "" + i__3[0] = 1, a__1[0] = sq; +#line 22191 "" + i__3[1] = 9, a__1[1] = "Fermataup"; +#line 22191 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22192 "" + } +#line 22193 "" + lnote = 10; +#line 22194 "" + ioff = -2; +#line 22195 "" + } else if (bit_test(iornt,14)) { +#line 22196 "" + if (*nodur < 48) { +/* Writing concatenation */ +#line 22197 "" + i__3[0] = 1, a__1[0] = sq; +#line 22197 "" + i__3[1] = 11, a__1[1] = "fermatadown"; +#line 22197 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22198 "" + } else { +/* Writing concatenation */ +#line 22199 "" + i__3[0] = 1, a__1[0] = sq; +#line 22199 "" + i__3[1] = 11, a__1[1] = "Fermatadown"; +#line 22199 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22200 "" + } +#line 22201 "" + lnote = 12; +#line 22202 "" + } else if (bit_test(iornt,21)) { + +/* "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 */ + +#line 22206 "" + if (bit_test(*iornq,16)) { +/* Writing concatenation */ +#line 22207 "" + i__3[0] = 1, a__1[0] = sq; +#line 22207 "" + i__3[1] = 6, a__1[1] = "qsharp"; +#line 22207 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22208 "" + lnote = 7; +#line 22209 "" + ioff = 2; +#line 22210 "" + *iornq = bit_clear(*iornq,16); +#line 22211 "" + iclracc = 16; +#line 22212 "" + } else if (bit_test(*iornq,17)) { +/* Writing concatenation */ +#line 22213 "" + i__3[0] = 1, a__1[0] = sq; +#line 22213 "" + i__3[1] = 5, a__1[1] = "qflat"; +#line 22213 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22214 "" + lnote = 6; +#line 22215 "" + ioff = 1; +#line 22216 "" + *iornq = bit_clear(*iornq,17); +#line 22217 "" + iclracc = 17; +#line 22218 "" + } else if (bit_test(*iornq,18)) { +/* Writing concatenation */ +#line 22219 "" + i__3[0] = 1, a__1[0] = sq; +#line 22219 "" + i__3[1] = 4, a__1[1] = "qnat"; +#line 22219 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22220 "" + lnote = 5; +#line 22221 "" + ioff = 2; +#line 22222 "" + *iornq = bit_clear(*iornq,18); +#line 22223 "" + iclracc = 18; +#line 22224 "" + } else { +/* Writing concatenation */ +#line 22225 "" + i__3[0] = 1, a__1[0] = sq; +#line 22225 "" + i__3[1] = 5, a__1[1] = "qedit"; +#line 22225 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22226 "" + lnote = 6; +#line 22227 "" + ioff = 0; +#line 22228 "" + } +#line 22229 "" + } else if (bit_test(iornt,16)) { +/* Writing concatenation */ +#line 22230 "" + i__3[0] = 1, a__1[0] = sq; +#line 22230 "" + i__3[1] = 6, a__1[1] = "esharp"; +#line 22230 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22231 "" + lnote = 7; +#line 22232 "" + ioff = 2; +#line 22233 "" + } else if (bit_test(iornt,17)) { +/* Writing concatenation */ +#line 22234 "" + i__3[0] = 1, a__1[0] = sq; +#line 22234 "" + i__3[1] = 5, a__1[1] = "eflat"; +#line 22234 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22235 "" + lnote = 6; +#line 22236 "" + ioff = 1; +#line 22237 "" + } else if (bit_test(iornt,18)) { +/* Writing concatenation */ +#line 22238 "" + i__3[0] = 1, a__1[0] = sq; +#line 22238 "" + i__3[1] = 4, a__1[1] = "enat"; +#line 22238 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22239 "" + lnote = 5; +#line 22240 "" + ioff = 2; +#line 22241 "" + } else if (bit_test(iornt,19)) { +/* Writing concatenation */ +#line 22242 "" + i__3[0] = 1, a__1[0] = sq; +#line 22242 "" + i__3[1] = 3, a__1[1] = "usf"; +#line 22242 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22243 "" + lnote = 4; +#line 22244 "" + ioff = -2; +#line 22245 "" + } else if (bit_test(iornt,20)) { +/* Writing concatenation */ +#line 22246 "" + i__3[0] = 1, a__1[0] = sq; +#line 22246 "" + i__3[1] = 4, a__1[1] = "usfz"; +#line 22246 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22247 "" + lnote = 5; +#line 22248 "" + ioff = -2; +#line 22249 "" + } else if (bit_test(iornt,29)) { +/* Writing concatenation */ +#line 22250 "" + i__3[0] = 1, a__1[0] = sq; +#line 22250 "" + i__3[1] = 5, a__1[1] = "ccoda"; +#line 22250 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22251 "" + lnote = 6; +#line 22252 "" + } else if (bit_test(iornt,30)) { +/* Writing concatenation */ +#line 22253 "" + i__3[0] = 1, a__1[0] = sq; +#line 22253 "" + i__3[1] = 6, a__1[1] = "ssegno"; +#line 22253 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22254 "" + lnote = 7; +#line 22255 "" + } +#line 22256 "" + iudorn = 0; + +/* User-defined level shift of ornament from default? */ + +#line 22260 "" + if (bit_test(*iornq,25)) { + +/* Find which (if any) element of kudorn has the shift. */ + +#line 22264 "" + i__1 = comtrill_1.nudorn; +#line 22264 "" + for (iudorn = 1; iudorn <= i__1; ++iudorn) { +/* if (ibit .lt. 21) then */ +/* if (ibit.lt.21 .or. ibit.eq.29) then */ +#line 22267 "" + if (ibit < 21 || ibit == 29 || ibit == 30) { +#line 22268 "" + ibitt = ibit; + +/* Could have oes, but not oe? or oes? */ + +#line 22272 "" + } else if (iclracc > 0) { + +/* Earlier cleared edit. accid, meaning it was oes? */ + +#line 22276 "" + ibitt = iclracc + 6; +#line 22277 "" + } else { +#line 22278 "" + ibitt = 21; +#line 22279 "" + } +#line 22280 "" + ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19); +/* if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */ +#line 22282 "" + if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx == + comivxudorn_1.ivxudorn[iudorn - 1]) { +#line 22282 "" + goto L4; +#line 22282 "" + } +#line 22284 "" +/* L3: */ +#line 22284 "" + } + +/* Nothing shifted on this note; exit this if block */ + +#line 22288 "" + iudorn = 0; +#line 22289 "" + goto L5; +#line 22290 "" +L4: +#line 22291 "" + ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25) + ) - 32; +#line 22292 "" + 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 22297 "" + i__3[0] = 1, a__1[0] = sq; +#line 22297 "" + i__3[1] = 3, a__1[1] = "lsf"; +#line 22297 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22298 "" + ioffinc += 6; +#line 22299 "" + } +#line 22300 "" + ioff += ioffinc; +#line 22301 "" + } +#line 22302 "" +L5: + +/* Shift level to avoid slur. Conditions are */ +/* 1. There is a slur */ +/* 2. No user-defined orn height shift (btest(iornq,25)) */ +/* 3. upslur (islhgt>0) */ +/* 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */ +/* 5. islhgt+3 >= height already computed. */ + +#line 22311 "" + if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) { +#line 22311 "" + i__1 = *islhgt + 3; +#line 22311 "" + ioff += i_dim(&i__1, &ihorn); +#line 22311 "" + } +#line 22314 "" + i__1 = ihorn + ioff; +#line 22314 "" + notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8); +#line 22315 "" + if (lnoten == 1) { +#line 22315 "" + addblank_(noteq, &lnoten, (ftnlen)8); +#line 22315 "" + } +#line 22316 "" + if ((iornt & 32896) > 0) { + +/* T-trill or trill w/o "tr" */ + +#line 22320 "" + dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, ( + ftnlen)79); +#line 22321 "" + } else { +/* Writing concatenation */ +#line 22322 "" + i__3[0] = lnote, a__1[0] = notexq; +#line 22322 "" + i__3[1] = lnoten, a__1[1] = noteq; +#line 22322 "" + s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79); +#line 22323 "" + lnote += lnoten; +#line 22324 "" + } +#line 22325 "" + if (iudorn > 0) { +#line 22326 "" + if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) { + +/* Horizontal shift */ + +#line 22330 "" + lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]); +#line 22331 "" + ici__1.icierr = 0; +#line 22331 "" + ici__1.icirnum = 1; +#line 22331 "" + ici__1.icirlen = lform; +#line 22331 "" + ici__1.iciunit = noteq; +/* Writing concatenation */ +#line 22331 "" + i__4[0] = 2, a__2[0] = "(f"; +#line 22331 "" + i__1 = lform + 48; +#line 22331 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 22331 "" + i__4[1] = 1, a__2[1] = ch__1; +#line 22331 "" + i__4[2] = 3, a__2[2] = ".1)"; +#line 22331 "" + ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6), + ch__2); +#line 22331 "" + s_wsfi(&ici__1); +#line 22331 "" + do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen) + sizeof(real)); +#line 22331 "" + e_wsfi(); +/* Writing concatenation */ +#line 22333 "" + i__5[0] = 1, a__3[0] = sq; +#line 22333 "" + i__5[1] = 8, a__3[1] = "roffset{"; +#line 22333 "" + i__5[2] = lform, a__3[2] = noteq; +#line 22333 "" + i__5[3] = 2, a__3[3] = "}{"; +#line 22333 "" + i__5[4] = lnote, a__3[4] = notexq; +#line 22333 "" + i__5[5] = 1, a__3[5] = "}"; +#line 22333 "" + s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79); +#line 22335 "" + lnote = lnote + lform + 12; +#line 22336 "" + comtrill_1.ornhshft[iudorn - 1] = 0.f; +#line 22337 "" + comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[ + iudorn - 1],31); +#line 22338 "" + } +#line 22339 "" + } + +/* Zero out the bit for ornament just dealt with. */ + +#line 22343 "" + *iornq = bit_clear(*iornq,ibit); +#line 22344 "" + if (*lout == 0) { +#line 22345 "" + s_copy(outq, notexq, (ftnlen)79, lnote); +#line 22346 "" + } else { +/* Writing concatenation */ +#line 22347 "" + i__3[0] = *lout, a__1[0] = outq; +#line 22347 "" + i__3[1] = lnote, a__1[1] = notexq; +#line 22347 "" + s_cat(outq, a__1, i__3, &c__2, (ftnlen)79); +#line 22348 "" + } +#line 22349 "" + *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 22355 "" + if ((*iornq & 4194303) > 0) { +#line 22355 "" + goto L2; +#line 22355 "" + } +#line 22356 "" + if (usehornb) { +#line 22356 "" + ++nornb[*ivx]; +#line 22356 "" + } +#line 22357 "" + return 0; +} /* putorn_ */ + +/* Subroutine */ int putshft_(integer *ivx, logical *onoff, char *soutq, + integer *lsout, ftnlen soutq_len) +{ + /* System generated locals */ + address a__1[3], a__2[4]; + integer i__1[3], i__2, i__3[4]; + real r__1; + char ch__1[1], ch__2[6], ch__3[88]; + icilist ici__1; + + /* Builtin functions */ + double r_sign(real *, real *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + static char sq[1]; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer ifmt; + static real xoff; + extern /* Subroutine */ int addstr_(char *, integer *, char *, integer *, + ftnlen, ftnlen); + static char notexq[80]; + +#line 22365 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 22365 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; + +/* Start user-defined offsets X(...): or X(...)S */ + +#line 22369 "" + if (*onoff) { +#line 22369 "" + ++comudsp_1.nudoff[*ivx - 1]; +#line 22369 "" + } + +/* Xoff is in pts. Round off to nearest .1. Will use at end of shift. */ + +#line 22373 "" + xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25]; +#line 22374 "" + r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f; +#line 22374 "" + xoff = r_sign(&r__1, &xoff); +#line 22375 "" + if (! (*onoff)) { +#line 22375 "" + xoff = -xoff; +#line 22375 "" + } +#line 22376 "" + if (xoff < -9.95f) { +#line 22377 "" + ifmt = 5; +#line 22378 "" + } else if (xoff < -.95f || xoff > 9.95f) { +#line 22379 "" + ifmt = 4; +#line 22380 "" + } else { +#line 22381 "" + ifmt = 3; +#line 22382 "" + } +#line 22383 "" + ici__1.icierr = 0; +#line 22383 "" + ici__1.icirnum = 1; +#line 22383 "" + ici__1.icirlen = 80; +#line 22383 "" + ici__1.iciunit = notexq; +/* Writing concatenation */ +#line 22383 "" + i__1[0] = 2, a__1[0] = "(f"; +#line 22383 "" + i__2 = ifmt + 48; +#line 22383 "" + chax_(ch__1, (ftnlen)1, &i__2); +#line 22383 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 22383 "" + i__1[2] = 3, a__1[2] = ".1)"; +#line 22383 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 22383 "" + s_wsfi(&ici__1); +#line 22383 "" + do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real)); +#line 22383 "" + e_wsfi(); +/* Writing concatenation */ +#line 22384 "" + i__3[0] = 1, a__2[0] = sq; +#line 22384 "" + i__3[1] = 4, a__2[1] = "off{"; +#line 22384 "" + i__3[2] = ifmt, a__2[2] = notexq; +#line 22384 "" + i__3[3] = 3, a__2[3] = "pt}"; +#line 22384 "" + s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88); +#line 22384 "" + i__2 = ifmt + 8; +#line 22384 "" + addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80); +#line 22386 "" + return 0; +} /* putshft_ */ + +/* Subroutine */ int puttitle_(integer *inhnoh, real *xnsttop, real *etatop, + char *sq, real *etait, real *etatc, real *etacs1, integer *nv, + logical *vshrink, char *sepsymq, ftnlen sq_len, ftnlen sepsymq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3], a__3[3], a__4[4]; + integer i__1[2], i__2, i__3[3], i__4, i__5[3], i__6[4]; + real r__1; + char ch__1[8], ch__2[1], ch__3[10], ch__4[148], ch__5[129], ch__6[133]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + double r_lg10(real *); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsfe(cilist *), e_wsfe(void); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern /* Subroutine */ int writflot_(real *, char *, integer *, ftnlen); + static integer iv, lcq, ndig; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static real xcsil, xtcil, vskil, xitil, glueil; + extern integer lenstr_(char *, integer *, ftnlen); + extern /* Subroutine */ int printl_(char *, ftnlen); + static char notexq[127]; + static integer lenline; + + /* Fortran I/O blocks */ + static cilist io___1588 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1591 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1594 = { 0, 11, 0, "(a)", 0 }; + + + +/* Called once per page, at top of page! If vshrink, only called for p.1. */ +/* 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 22405 "" + /* Parameter adjustments */ +#line 22405 "" + --sepsymq; +#line 22405 "" + +#line 22405 "" + /* Function Body */ +/* Writing concatenation */ +#line 22405 "" + i__1[0] = 1, a__1[0] = sq; +#line 22405 "" + i__1[1] = 6, a__1[1] = "znotes"; +#line 22405 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22406 "" + lenline = 7; +#line 22407 "" + i__2 = *nv - 1; +#line 22407 "" + for (iv = 1; iv <= i__2; ++iv) { +/* Writing concatenation */ +#line 22408 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22408 "" + i__1[1] = 1, a__1[1] = sepsymq + iv; +#line 22408 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22409 "" + ++lenline; +#line 22410 "" +/* L22: */ +#line 22410 "" + } +/* Writing concatenation */ +#line 22411 "" + i__3[0] = lenline, a__2[0] = notexq; +#line 22411 "" + i__3[1] = 1, a__2[1] = sq; +#line 22411 "" + i__3[2] = 10, a__2[2] = "zcharnote{"; +#line 22411 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); +#line 22412 "" + lenline += 11; +#line 22413 "" + if (! comtitl_1.headlog) { +#line 22414 "" + comtitl_1.inhead = *inhnoh; +#line 22415 "" + } +#line 22416 "" + if (*vshrink && comlast_1.usevshrink) { +#line 22417 "" + comtitl_1.inhead = 16; +#line 22418 "" + } +#line 22419 "" + r__1 = comtitl_1.inhead + .01f; +#line 22419 "" + ndig = (integer) r_lg10(&r__1) + 1; +#line 22420 "" + i__2 = lenline; +#line 22420 "" + ici__1.icierr = 0; +#line 22420 "" + ici__1.icirnum = 1; +#line 22420 "" + ici__1.icirlen = lenline + ndig + 10 - i__2; +#line 22420 "" + ici__1.iciunit = notexq + i__2; +/* Writing concatenation */ +#line 22420 "" + i__3[0] = 2, a__2[0] = "(i"; +#line 22420 "" + i__4 = ndig + 48; +#line 22420 "" + chax_(ch__2, (ftnlen)1, &i__4); +#line 22420 "" + i__3[1] = 1, a__2[1] = ch__2; +#line 22420 "" + i__3[2] = 5, a__2[2] = ",a10)"; +#line 22420 "" + ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1); +#line 22420 "" + s_wsfi(&ici__1); +#line 22420 "" + do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 22420 "" + i__5[0] = 2, a__3[0] = "}{"; +#line 22420 "" + i__5[1] = 1, a__3[1] = sq; +#line 22420 "" + i__5[2] = 7, a__3[2] = "titles{"; +#line 22420 "" + s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10); +#line 22420 "" + do_fio(&c__1, ch__3, (ftnlen)10); +#line 22420 "" + e_wsfi(); +#line 22422 "" + lenline = lenline + ndig + 10; + +/* Vertical skip at top of page (\Il) = etatop*glueil. Needed whether */ +/* headers are present or not. */ + +#line 22427 "" + glueil = *xnsttop / *etatop; +#line 22428 "" + vskil = *etatop * glueil; +#line 22429 "" + if (*vshrink && comlast_1.usevshrink) { +#line 22429 "" + vskil = 2.f; +#line 22429 "" + } +#line 22430 "" + writflot_(&vskil, notexq, &lenline, (ftnlen)127); +#line 22431 "" + if (! comtitl_1.headlog) { +#line 22432 "" + if (comlast_1.islast) { +#line 22432 "" + s_wsfe(&io___1588); +/* Writing concatenation */ +#line 22432 "" + i__6[0] = lenline, a__4[0] = notexq; +#line 22432 "" + i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}"; +#line 22432 "" + i__6[2] = 1, a__4[2] = sq; +#line 22432 "" + i__6[3] = 3, a__4[3] = "en%"; +#line 22432 "" + s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148); +#line 22432 "" + do_fio(&c__1, ch__4, lenline + 21); +#line 22432 "" + e_wsfe(); +#line 22432 "" + } +#line 22434 "" + } else { +/* Writing concatenation */ +#line 22435 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22435 "" + i__1[1] = 2, a__1[1] = "}{"; +#line 22435 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22436 "" + lenline += 2; +#line 22437 "" + lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120); +#line 22438 "" + if (lcq > 0) { +#line 22439 "" + xitil = *etait * glueil; +#line 22440 "" + if (*vshrink && comlast_1.usevshrink) { +#line 22440 "" + xitil = 2.f; +#line 22440 "" + } +/* Writing concatenation */ +#line 22441 "" + i__3[0] = lenline, a__2[0] = notexq; +#line 22441 "" + i__3[1] = lcq, a__2[1] = comtitl_1.instrq; +#line 22441 "" + i__3[2] = 2, a__2[2] = "}{"; +#line 22441 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); + +/* Null out instrument once used */ + +#line 22445 "" + s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1); +#line 22446 "" + lenline = lenline + lcq + 2; +#line 22447 "" + writflot_(&xitil, notexq, &lenline, (ftnlen)127); +#line 22448 "" + } else { +/* Writing concatenation */ +#line 22449 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22449 "" + i__1[1] = 3, a__1[1] = "}{0"; +#line 22449 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22450 "" + lenline += 3; +#line 22451 "" + } +#line 22452 "" + if (comlast_1.islast) { +#line 22452 "" + s_wsfe(&io___1591); +/* Writing concatenation */ +#line 22452 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22452 "" + i__1[1] = 2, a__1[1] = "}%"; +#line 22452 "" + s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129); +#line 22452 "" + do_fio(&c__1, ch__5, lenline + 2); +#line 22452 "" + e_wsfe(); +#line 22452 "" + } +#line 22453 "" + s_copy(notexq, "{", (ftnlen)127, (ftnlen)1); +#line 22454 "" + lenline = 1; +#line 22455 "" + lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120); +#line 22456 "" + if (lcq > 0) { +/* Writing concatenation */ +#line 22457 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22457 "" + i__1[1] = lcq, a__1[1] = comtitl_1.titleq; +#line 22457 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22458 "" + lenline += lcq; +#line 22459 "" + } else { +#line 22460 "" + printl_(" ", (ftnlen)1); +#line 22461 "" + printl_("WARNING", (ftnlen)7); +#line 22462 "" + printl_(" In a title block, you have specified instrument and/or" + , (ftnlen)56); +#line 22464 "" + printl_(" composer but no title for the piece.", (ftnlen)38); +#line 22466 "" + } +/* Writing concatenation */ +#line 22467 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22467 "" + i__1[1] = 2, a__1[1] = "}{"; +#line 22467 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22468 "" + lenline += 2; +#line 22469 "" + xtcil = *etatc * glueil; +#line 22470 "" + lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120); +#line 22471 "" + if (lcq == 0) { +#line 22471 "" + xtcil *= 2; +#line 22471 "" + } +#line 22472 "" + if (*vshrink && comlast_1.usevshrink) { +#line 22472 "" + xtcil = 2.f; +#line 22472 "" + } +#line 22473 "" + writflot_(&xtcil, notexq, &lenline, (ftnlen)127); +/* Writing concatenation */ +#line 22474 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22474 "" + i__1[1] = 2, a__1[1] = "}{"; +#line 22474 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22475 "" + lenline += 2; +#line 22476 "" + if (lcq > 0) { +/* Writing concatenation */ +#line 22477 "" + i__3[0] = lenline, a__2[0] = notexq; +#line 22477 "" + i__3[1] = lcq, a__2[1] = comtitl_1.compoq; +#line 22477 "" + i__3[2] = 2, a__2[2] = "}{"; +#line 22477 "" + s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127); +#line 22478 "" + lenline = lenline + 2 + lcq; + +/* Null out compoq so it does not get written later */ + +#line 22482 "" + s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1); +#line 22483 "" + xcsil = *etacs1 * glueil; +#line 22484 "" + if (*vshrink && comlast_1.usevshrink) { +#line 22484 "" + xcsil = 2.f; +#line 22484 "" + } +#line 22485 "" + writflot_(&xcsil, notexq, &lenline, (ftnlen)127); +#line 22486 "" + } else { +/* Writing concatenation */ +#line 22487 "" + i__1[0] = lenline, a__1[0] = notexq; +#line 22487 "" + i__1[1] = 3, a__1[1] = "}{0"; +#line 22487 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127); +#line 22488 "" + lenline += 3; +#line 22489 "" + } +#line 22490 "" + if (comlast_1.islast) { +#line 22490 "" + s_wsfe(&io___1594); +/* Writing concatenation */ +#line 22490 "" + i__6[0] = lenline, a__4[0] = notexq; +#line 22490 "" + i__6[1] = 2, a__4[1] = "}}"; +#line 22490 "" + i__6[2] = 1, a__4[2] = sq; +#line 22490 "" + i__6[3] = 3, a__4[3] = "en%"; +#line 22490 "" + s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133); +#line 22490 "" + do_fio(&c__1, ch__6, lenline + 6); +#line 22490 "" + e_wsfe(); +#line 22490 "" + } +#line 22491 "" + comtitl_1.headlog = FALSE_; +#line 22492 "" + } +#line 22493 "" + return 0; +} /* puttitle_ */ + +/* Subroutine */ int putxtn_(integer *ntupv, integer *iflop, integer *multb, + integer *iud, real *wheadpt, real *poenom, integer *nolev1, integer * + islope, real *slfac, real *xnlmid, integer *islur, integer *lnote, + char *notexq, integer *ncmid, integer *nlnum, real *eloff, integer * + iup, integer *irest, logical *usexnumt, ftnlen notexq_len) +{ + /* System generated locals */ + address a__1[2], a__2[3]; + integer i__1[2], i__2[3], i__3; + real r__1; + char ch__1[1]; + icilist ici__1; + + /* Builtin functions */ + integer i_nint(real *), lbit_shift(integer, integer); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char noteq[8]; + extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer + *, ftnlen); + static integer lnoten, istrtn; + + +/* Places digit for xtuplet. */ + +#line 22505 "" + if (*iflop != 0 && *multb > 0) { + +/* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */ + +#line 22509 "" + *eloff -= *iud * .5f * *wheadpt / *poenom; + +/* Number goes on beam side, must use beam parameters to set pos'n */ + +#line 22513 "" + *nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8); +#line 22514 "" + if (*multb >= 2) { +#line 22514 "" + *nlnum += *iup; +#line 22514 "" + } +#line 22515 "" + } else { +#line 22516 "" + r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11; +#line 22516 "" + *nlnum = i_nint(&r__1); +#line 22517 "" + } +#line 22518 "" + if (! bit_test(*islur,31)) { + +/* Only print number when wanted. First check vert, horiz offset */ + +#line 22522 "" + if (bit_test(*irest,1)) { +#line 22522 "" + *nlnum = *nlnum + (31 & lbit_shift(*irest, (ftnlen)-2)) - 16; +#line 22522 "" + } +#line 22523 "" + if (bit_test(*irest,7)) { +#line 22523 "" + *eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * * + wheadpt / *poenom; +#line 22523 "" + } +#line 22525 "" + if (! (*usexnumt)) { +/* Writing concatenation */ +#line 22526 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 22526 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 22526 "" + i__1[1] = 5, a__1[1] = "xnum{"; +#line 22526 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 22527 "" + *lnote = 10; +#line 22528 "" + istrtn = 7; +#line 22529 "" + } else { +/* Writing concatenation */ +#line 22530 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 22530 "" + i__1[0] = 1, a__1[0] = ch__1; +#line 22530 "" + i__1[1] = 6, a__1[1] = "xnumt{"; +#line 22530 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 22531 "" + *lnote = 11; +#line 22532 "" + istrtn = 8; +#line 22533 "" + } +#line 22534 "" + if (*eloff < .995f) { +#line 22535 "" + ici__1.icierr = 0; +#line 22535 "" + ici__1.icirnum = 1; +#line 22535 "" + ici__1.icirlen = 4; +#line 22535 "" + ici__1.iciunit = notexq + (istrtn - 1); +#line 22535 "" + ici__1.icifmt = "(i1,f3.2)"; +#line 22535 "" + s_wsfi(&ici__1); +#line 22535 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 22535 "" + do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 22535 "" + e_wsfi(); +#line 22536 "" + } else if (*eloff < 9.995f) { +#line 22537 "" + ici__1.icierr = 0; +#line 22537 "" + ici__1.icirnum = 1; +#line 22537 "" + ici__1.icirlen = 4; +#line 22537 "" + ici__1.iciunit = notexq + (istrtn - 1); +#line 22537 "" + ici__1.icifmt = "(f4.2)"; +#line 22537 "" + s_wsfi(&ici__1); +#line 22537 "" + do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 22537 "" + e_wsfi(); +#line 22538 "" + } else { +#line 22539 "" + ici__1.icierr = 0; +#line 22539 "" + ici__1.icirnum = 1; +#line 22539 "" + ici__1.icirlen = 5; +#line 22539 "" + ici__1.iciunit = notexq + (istrtn - 1); +#line 22539 "" + ici__1.icifmt = "(f5.2)"; +#line 22539 "" + s_wsfi(&ici__1); +#line 22539 "" + do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real)); +#line 22539 "" + e_wsfi(); +#line 22540 "" + ++(*lnote); +#line 22541 "" + } +#line 22542 "" + notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8); +/* Writing concatenation */ +#line 22543 "" + i__2[0] = *lnote, a__2[0] = notexq; +#line 22543 "" + i__2[1] = 1, a__2[1] = "}"; +#line 22543 "" + i__2[2] = lnoten, a__2[2] = noteq; +#line 22543 "" + s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79); +#line 22544 "" + *lnote = *lnote + 1 + lnoten; +#line 22545 "" + if (*ntupv < 10) { +#line 22546 "" + i__3 = *lnote; +#line 22546 "" + ici__1.icierr = 0; +#line 22546 "" + ici__1.icirnum = 1; +#line 22546 "" + ici__1.icirlen = *lnote + 1 - i__3; +#line 22546 "" + ici__1.iciunit = notexq + i__3; +#line 22546 "" + ici__1.icifmt = "(i1)"; +#line 22546 "" + s_wsfi(&ici__1); +#line 22546 "" + do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); +#line 22546 "" + e_wsfi(); +#line 22547 "" + ++(*lnote); +#line 22548 "" + } else { +/* Writing concatenation */ +#line 22549 "" + i__1[0] = *lnote, a__1[0] = notexq; +#line 22549 "" + i__1[1] = 1, a__1[1] = "{"; +#line 22549 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 22550 "" + i__3 = *lnote + 1; +#line 22550 "" + ici__1.icierr = 0; +#line 22550 "" + ici__1.icirnum = 1; +#line 22550 "" + ici__1.icirlen = *lnote + 3 - i__3; +#line 22550 "" + ici__1.iciunit = notexq + i__3; +#line 22550 "" + ici__1.icifmt = "(i2)"; +#line 22550 "" + s_wsfi(&ici__1); +#line 22550 "" + do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer)); +#line 22550 "" + e_wsfi(); +/* Writing concatenation */ +#line 22551 "" + i__1[0] = *lnote + 3, a__1[0] = notexq; +#line 22551 "" + i__1[1] = 1, a__1[1] = "}"; +#line 22551 "" + s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79); +#line 22552 "" + *lnote += 4; +#line 22553 "" + } +#line 22554 "" + } +#line 22555 "" + return 0; +} /* putxtn_ */ + +/* Subroutine */ int read10_(char *string, logical *lastchar, ftnlen + string_len) +{ + /* Builtin functions */ + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer ip1, ip2; + extern /* Subroutine */ int getbuf_(char *, ftnlen); + +#line 22569 "" + if (! commac_1.mplay) { +#line 22570 "" + if (inbuff_1.ilbuf > inbuff_1.nlbuf) { +#line 22570 "" + goto L999; +#line 22570 "" + } +#line 22571 "" + getbuf_(string, string_len); +#line 22572 "" + return 0; +#line 22573 "" +L999: +#line 22573 "" + *lastchar = TRUE_; +#line 22574 "" + return 0; +#line 22575 "" + } else { + +/* Play a macro. Set pointer to first character needed in buffer */ + +#line 22579 "" + if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) { + +/* Getting first line of macro */ + +#line 22583 "" + ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1]; +#line 22584 "" + c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1]; +#line 22585 "" + } else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) { + +/* Beyond first line of macro. Advance line-start pointer. */ + +#line 22589 "" + c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2]; +#line 22590 "" + ip1 = c1ommac_1.iplmac + 1; +#line 22591 "" + } else { + +/* Beyond last line of macro. Terminate it! */ + +#line 22595 "" + commac_1.mplay = FALSE_; +#line 22596 "" + commac_1.endmac = TRUE_; +#line 22597 "" + return 0; +#line 22598 "" + } +#line 22599 "" + if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) { + +/* Getting last line of macro. */ + +#line 22603 "" + ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1]; +#line 22604 "" + } else { + +/* Getting line before last line of macro. */ + +#line 22608 "" + ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1]; +#line 22609 "" + } +#line 22610 "" + if (ip2 >= ip1) { +#line 22611 "" + s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1 + - 1)); +#line 22612 "" + } else { + +/* Kluge for when macro start is on a line by itself */ + +#line 22616 "" + s_copy(string, " ", string_len, (ftnlen)1); +#line 22617 "" + } +#line 22618 "" + ++c1ommac_1.ilmac; +#line 22619 "" + return 0; +#line 22620 "" + } +#line 22621 "" + return 0; +} /* read10_ */ + +doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen + lineq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1[3]; + real ret_val; + char ch__1[27], ch__2[6], ch__3[1]; + icilist ici__1; + + /* Builtin functions */ + integer 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), + s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + ; + + /* Local variables */ + static integer i1, i2, icf; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char durq[1]; + extern /* Subroutine */ int stop1_(void), getbuf_(char *, ftnlen), + getchar_(char *, integer *, char *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1603 = { 0, 6, 0, 0, 0 }; + + + +/* Reads a piece of setup data from file lineq, gets a new lineq from */ +/* file 10 (jobname.pmx) and increments nline if needed, passes over */ +/* comment lines */ + +#line 22630 "" +L4: +#line 22630 "" + if (*iccount == 128) { +#line 22631 "" +L1: +#line 22631 "" + getbuf_(lineq, (ftnlen)128); +#line 22632 "" + ++(*nline); +#line 22633 "" + if (*(unsigned char *)lineq == '%') { +#line 22633 "" + goto L1; +#line 22633 "" + } +#line 22634 "" + *iccount = 0; +#line 22635 "" + } +#line 22636 "" + ++(*iccount); + +/* Find next non-blank or end of line */ + +#line 22640 "" + for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { +#line 22641 "" + if (*(unsigned char *)&lineq[*iccount - 1] != ' ') { +#line 22641 "" + goto L3; +#line 22641 "" + } +#line 22642 "" +/* L2: */ +#line 22642 "" + } + +/* If here, need to get a new line */ + +#line 22646 "" + *iccount = 128; +#line 22647 "" + goto L4; +#line 22648 "" +L3: + +/* iccount now points to start of number to read */ + +#line 22652 "" + i1 = *iccount; +#line 22653 "" +L5: +#line 22653 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Remember that getchar increments iccount, then reads a character. */ + +#line 22657 "" + if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 22657 "" + goto L5; +#line 22657 "" + } +#line 22658 "" + i2 = *iccount - 1; +#line 22659 "" + if (i2 < i1) { +#line 22660 "" + s_wsle(&io___1603); +/* Writing concatenation */ +#line 22660 "" + i__1[0] = 7, a__1[0] = "Found \""; +#line 22660 "" + i__1[1] = 1, a__1[1] = durq; +#line 22660 "" + i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 22660 "" + s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 22660 "" + do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 22660 "" + e_wsle(); +#line 22661 "" + stop1_(); +#line 22662 "" + } +#line 22663 "" + icf = i2 - i1 + 49; +#line 22664 "" + ici__1.icierr = 0; +#line 22664 "" + ici__1.iciend = 0; +#line 22664 "" + ici__1.icirnum = 1; +#line 22664 "" + ici__1.icirlen = i2 - (i1 - 1); +#line 22664 "" + ici__1.iciunit = lineq + (i1 - 1); +/* Writing concatenation */ +#line 22664 "" + i__1[0] = 2, a__1[0] = "(f"; +#line 22664 "" + chax_(ch__3, (ftnlen)1, &icf); +#line 22664 "" + i__1[1] = 1, a__1[1] = ch__3; +#line 22664 "" + i__1[2] = 3, a__1[2] = ".0)"; +#line 22664 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 22664 "" + s_rsfi(&ici__1); +#line 22664 "" + do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); +#line 22664 "" + e_rsfi(); +#line 22665 "" + return ret_val; +} /* readin_ */ + +/* Subroutine */ int readmeter_(char *lineq, integer *iccount, integer * + mtrnum, integer *mtrden, ftnlen lineq_len) +{ + /* System generated locals */ + address a__1[3]; + integer i__1, i__2[3]; + char ch__1[4], ch__2[1]; + icilist ici__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + ; + + /* Local variables */ + static integer ns; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char durq[1]; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen); + +#line 22670 "" + i__1 = *iccount; +#line 22670 "" + if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) { + +/* No slashes, so use old method */ + +#line 22674 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22675 "" + if (*(unsigned char *)durq == '-') { + +/* Negative numerator is used only to printed; signals vertical slash */ + +#line 22679 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22680 "" + *mtrnum = -(*(unsigned char *)durq - 48); +#line 22681 "" + } else if (*(unsigned char *)durq == 'o') { + +/* Numerator is EXACTLY 1 */ + +#line 22685 "" + *mtrnum = 1; +#line 22686 "" + } else { +#line 22687 "" + *mtrnum = *(unsigned char *)durq - 48; +#line 22688 "" + if (*mtrnum == 1) { + +/* Numerator is >9 */ + +#line 22692 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22693 "" + *mtrnum = *(unsigned char *)durq - 38; +#line 22694 "" + } +#line 22695 "" + } +#line 22696 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22697 "" + if (*(unsigned char *)durq == 'o') { +#line 22698 "" + *mtrden = 1; +#line 22699 "" + } else { +#line 22700 "" + *mtrden = *(unsigned char *)durq - 48; +#line 22701 "" + if (*mtrden == 1) { +#line 22702 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22703 "" + *mtrden = *(unsigned char *)durq - 38; +#line 22704 "" + } +#line 22705 "" + } +#line 22706 "" + } else { + +/* Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */ + +#line 22710 "" + ++(*iccount); +#line 22711 "" + ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), ( + ftnlen)1); +#line 22712 "" + ici__1.icierr = 0; +#line 22712 "" + ici__1.iciend = 0; +#line 22712 "" + ici__1.icirnum = 1; +#line 22712 "" + ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); +#line 22712 "" + ici__1.iciunit = lineq + (*iccount - 1); +/* Writing concatenation */ +#line 22712 "" + i__2[0] = 2, a__1[0] = "(i"; +#line 22712 "" + i__1 = ns + 47; +#line 22712 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 22712 "" + i__2[1] = 1, a__1[1] = ch__2; +#line 22712 "" + i__2[2] = 1, a__1[2] = ")"; +#line 22712 "" + ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 22712 "" + s_rsfi(&ici__1); +#line 22712 "" + do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer)); +#line 22712 "" + e_rsfi(); + +/* Reset iccount to start of second integer */ + +#line 22716 "" + *iccount += ns; + +/* There must be either a slash or a blank at pos'n 2 or 3 */ + +#line 22720 "" + ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1); +#line 22721 "" + if (ns == 0) { +#line 22721 "" + ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1); +#line 22721 "" + } +#line 22722 "" + ici__1.icierr = 0; +#line 22722 "" + ici__1.iciend = 0; +#line 22722 "" + ici__1.icirnum = 1; +#line 22722 "" + ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1); +#line 22722 "" + ici__1.iciunit = lineq + (*iccount - 1); +/* Writing concatenation */ +#line 22722 "" + i__2[0] = 2, a__1[0] = "(i"; +#line 22722 "" + i__1 = ns + 47; +#line 22722 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 22722 "" + i__2[1] = 1, a__1[1] = ch__2; +#line 22722 "" + i__2[2] = 1, a__1[2] = ")"; +#line 22722 "" + ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1); +#line 22722 "" + s_rsfi(&ici__1); +#line 22722 "" + do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer)); +#line 22722 "" + e_rsfi(); + +/* Set iccount to last character used */ + +#line 22726 "" + *iccount = *iccount + ns - 1; +#line 22727 "" + } +#line 22728 "" + return 0; +} /* readmeter_ */ + +/* Subroutine */ int readnum_(char *lineq, integer *iccount, char *durq, real + *fnum, ftnlen lineq_len, ftnlen durq_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 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), + s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void) + ; + + /* Local variables */ + static integer i1, i2, icf; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + extern /* Subroutine */ int stop1_(void), getchar_(char *, integer *, + char *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1609 = { 0, 6, 0, 0, 0 }; + + + +/* This reads a number starting at position iccount. Remember that on exit, */ +/* getchar leaves iccount at the last character retrieved. So must only */ +/* call this routine *after* detecting a number or decimal. */ +/* On exit, durq is next character after end of number. */ + +#line 22739 "" + i1 = *iccount; +#line 22740 "" +L1: +#line 22740 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22741 "" + if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) { +#line 22741 "" + goto L1; +#line 22741 "" + } +#line 22742 "" + i2 = *iccount - 1; +#line 22743 "" + if (i2 < i1) { +#line 22744 "" + s_wsle(&io___1609); +/* Writing concatenation */ +#line 22744 "" + i__1[0] = 7, a__1[0] = "Found \""; +#line 22744 "" + i__1[1] = 1, a__1[1] = durq; +#line 22744 "" + i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 22744 "" + s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 22744 "" + do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 22744 "" + e_wsle(); +#line 22745 "" + stop1_(); +#line 22746 "" + } else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)& + lineq[i2 - 1] == '.') { +#line 22747 "" + --i2; +#line 22748 "" + --(*iccount); +#line 22749 "" + } +#line 22750 "" + icf = i2 - i1 + 49; +#line 22751 "" + ici__1.icierr = 0; +#line 22751 "" + ici__1.iciend = 0; +#line 22751 "" + ici__1.icirnum = 1; +#line 22751 "" + ici__1.icirlen = i2 - (i1 - 1); +#line 22751 "" + ici__1.iciunit = lineq + (i1 - 1); +/* Writing concatenation */ +#line 22751 "" + i__1[0] = 2, a__1[0] = "(f"; +#line 22751 "" + chax_(ch__3, (ftnlen)1, &icf); +#line 22751 "" + i__1[1] = 1, a__1[1] = ch__3; +#line 22751 "" + i__1[2] = 3, a__1[2] = ".0)"; +#line 22751 "" + ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 22751 "" + s_rsfi(&ici__1); +#line 22751 "" + do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real)); +#line 22751 "" + e_rsfi(); +#line 22752 "" + return 0; +} /* readnum_ */ + +/* Subroutine */ int setbits_(integer *isdata, integer *iwidbit, integer * + 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); + + /* Local variables */ + static integer ibase; + + /* Fortran I/O blocks */ + static cilist io___1612 = { 0, 6, 0, 0, 0 }; + static cilist io___1613 = { 0, 6, 0, 0, 0 }; + static cilist io___1614 = { 0, 15, 0, "(/,a)", 0 }; + + + +/* Sets iwidbits of isdata, shifted by ishift, to ivalue */ + +#line 22758 "" + ibase = pow_ii(&c__2, iwidbit) - 1; +#line 22759 "" + if (*ivalue > ibase) { +#line 22760 "" + s_wsle(&io___1612); +#line 22760 "" + e_wsle(); +#line 22761 "" + s_wsle(&io___1613); +#line 22761 "" + do_lio(&c__9, &c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34) + ; +#line 22761 "" + e_wsle(); +#line 22762 "" + s_wsfe(&io___1614); +#line 22762 "" + do_fio(&c__1, "WARNING in setbits: ivalue > ibase", (ftnlen)34); +#line 22762 "" + e_wsfe(); +#line 22763 "" + } +#line 22764 "" + *isdata = ~ lbit_shift(ibase, *ishift) & *isdata; +#line 22765 "" + *isdata |= lbit_shift(*ivalue, *ishift); +#line 22766 "" + return 0; +} /* setbits_ */ + +/* Subroutine */ int setbm2_(real *xelsk, integer *nnb, real *sumx, real * + sumy, integer *ipb, integer *islope, integer *nolev1) +{ + /* System generated locals */ + integer i__1; + real r__1, r__2; + + /* Builtin functions */ + integer i_nint(real *), i_sign(integer *, integer *); + + /* Local variables */ + static real em; + static integer ibc, inb, iul; + static real beta, smin, delta, ybeam, ynote, sumxx, sumxy, deficit; + + +/* The MEAN SQUARE slope algorithm */ + +#line 22788 "" + /* Parameter adjustments */ +#line 22788 "" + --ipb; +#line 22788 "" + --xelsk; +#line 22788 "" + +#line 22788 "" + /* Function Body */ +#line 22788 "" + ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 22789 "" + sumxx = 0.f; +#line 22790 "" + sumxy = 0.f; +#line 22791 "" + i__1 = *nnb; +#line 22791 "" + for (inb = 1; inb <= i__1; ++inb) { +/* Computing 2nd power */ +#line 22792 "" + r__1 = xelsk[inb]; +#line 22792 "" + sumxx += r__1 * r__1; +#line 22793 "" + sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; +#line 22794 "" +/* L2: */ +#line 22794 "" + } +#line 22795 "" + delta = *nnb * sumxx - *sumx * *sumx; +#line 22796 "" + em = (*nnb * sumxy - *sumx * *sumy) / delta; +#line 22797 "" + r__1 = em * .5f * all_1.slfac; +#line 22797 "" + *islope = i_nint(&r__1); +#line 22798 "" + if (abs(*islope) > 9) { +#line 22798 "" + *islope = i_sign(&c__9, islope); +#line 22798 "" + } +#line 22799 "" + beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb; +#line 22800 "" + *nolev1 = i_nint(&beta); + +/* Check if any stems are too short */ + +#line 22804 "" + smin = 100.f; +#line 22805 "" + iul = -1; +#line 22806 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 22806 "" + iul = 1; +#line 22806 "" + } +#line 22807 "" + i__1 = *nnb; +#line 22807 "" + for (inb = 1; inb <= i__1; ++inb) { +#line 22808 "" + ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] / + all_1.slfac; +#line 22809 "" + ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; +/* Computing MIN */ +#line 22810 "" + r__1 = smin, r__2 = iul * (ybeam - ynote); +#line 22810 "" + smin = dmin(r__1,r__2); +#line 22811 "" +/* L4: */ +#line 22811 "" + } +#line 22812 "" + if (smin < all_1.stemmin) { +#line 22813 "" + deficit = all_1.stemmin - smin; +#line 22814 "" + r__1 = *nolev1 + iul * deficit; +#line 22814 "" + *nolev1 = i_nint(&r__1); +#line 22815 "" + } +#line 22816 "" + return 0; +} /* setbm2_ */ + +/* Subroutine */ int setmac_(char *lineq, integer *iccount, integer *ibarcnt, + integer *ibaroff, integer *nbars, char *charq, char *durq, integer * + ivx, integer *nline, ftnlen lineq_len, ftnlen charq_len, ftnlen + durq_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *) + ; + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static real fnum; + static integer ndxm; + extern /* Subroutine */ int stop1_(void), m1rec1_(char *, integer *, + integer *, integer *, integer *, integer *, ftnlen), getbuf_(char + *, ftnlen), errmsg_(char *, integer *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen), g1etchar_(char *, integer *, char *, ftnlen, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1627 = { 0, 6, 0, 0, 0 }; + static cilist io___1628 = { 0, 6, 0, 0, 0 }; + static cilist io___1629 = { 0, 6, 0, 0, 0 }; + + + +/* Macro action */ + +#line 22829 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 22830 "" + if (*(unsigned char *)charq == 'S' && *ivx != 1) { +#line 22831 "" + s_wsle(&io___1627); +#line 22831 "" + e_wsle(); +#line 22832 "" + s_wsle(&io___1628); +#line 22832 "" + e_wsle(); +#line 22833 "" + s_wsle(&io___1629); +#line 22833 "" + do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25); +#line 22833 "" + e_wsle(); +#line 22834 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22834 "" + errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"\ + "prt if in voice #1!", (ftnlen)128, (ftnlen)53); +#line 22836 "" + } +#line 22837 "" + if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) { +#line 22838 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22838 "" + errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"\ + ")!", (ftnlen)128, (ftnlen)36); +#line 22840 "" + stop1_(); +#line 22841 "" + } else if (*(unsigned char *)charq != ' ') { + +/* Record or playback a macro. Get the number of the macro. */ + +#line 22845 "" + g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 22846 "" + if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { +#line 22847 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22847 "" + errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""\ + ",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43); +#line 22849 "" + stop1_(); +#line 22850 "" + } +#line 22851 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 22852 "" + commac_1.macnum = i_nint(&fnum); +#line 22853 "" + if (*(unsigned char *)durq != ' ') { +#line 22854 "" + i__1 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22854 "" + errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"\ + " a blank!", (ftnlen)128, (ftnlen)41); +#line 22856 "" + stop1_(); +#line 22857 "" + } +#line 22858 "" + if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Record or save a macro */ + +#line 22862 "" + if (commac_1.macnum < 1 || commac_1.macnum > 20) { +#line 22863 "" + i__1 = *iccount - 1; +#line 22863 "" + i__2 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22863 "" + errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!" + , (ftnlen)128, (ftnlen)31); +#line 22865 "" + stop1_(); +/* else if (btest(macuse,macnum)) then */ +/* print* */ +/* print*,'WARNING: Redefining macro # ',macnum */ +#line 22869 "" + } +#line 22870 "" + commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum); +#line 22871 "" + if (*(unsigned char *)charq == 'R') { +#line 22872 "" + m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( + ftnlen)128); +#line 22873 "" + } else if (*(unsigned char *)charq == 'S') { + +/* Save (Record but don't activate) */ + +#line 22877 "" +L1: +#line 22877 "" + m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, ( + ftnlen)128); +#line 22878 "" + if (commac_1.mrecord) { +#line 22879 "" + getbuf_(lineq, (ftnlen)128); +#line 22880 "" + ++(*nline); +#line 22881 "" + *iccount = 0; +#line 22882 "" + goto L1; +#line 22883 "" + } +#line 22884 "" + *iccount = *iccount + ndxm + 1; +#line 22885 "" + } +#line 22886 "" + } else { + +/* Playback the macro */ + +#line 22890 "" + if (! bit_test(commac_1.macuse,commac_1.macnum)) { +#line 22891 "" + i__1 = *iccount - 1; +#line 22891 "" + i__2 = *ibarcnt - *ibaroff + *nbars + 1; +#line 22891 "" + errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"\ + "ot been recorded!", (ftnlen)128, (ftnlen)47); +#line 22893 "" + stop1_(); +#line 22894 "" + } +#line 22895 "" + commac_1.icchold = *iccount; +#line 22896 "" + s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128); +#line 22897 "" + *iccount = 128; +#line 22898 "" + commac_1.mplay = TRUE_; +#line 22899 "" + c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1]; +#line 22900 "" + } +#line 22901 "" + } +#line 22902 "" + return 0; +} /* setmac_ */ + +/* Subroutine */ int setmeter_(integer *mtrnuml, integer *mtrdenl, integer * + ibmtyp, integer *ibmrep) +{ + +/* Sets last 2 args depending on 1st 2, (logical) num, denom. */ +/* ibmtyp = 1, 2, or 3 defines set of masks for beam groupings. */ +/* 1: all duple meters */ +/* 2: triple w/ denom=4, subdivide in groups of 2 8ths */ +/* 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 22913 "" + if (*mtrdenl == 4) { +#line 22914 "" + if (*mtrnuml % 3 == 0) { +#line 22915 "" + *ibmtyp = 2; +#line 22916 "" + *ibmrep = *mtrnuml / 3; +#line 22917 "" + } else { +#line 22918 "" + *ibmtyp = 1; +#line 22919 "" + *ibmrep = *mtrnuml / 2; +#line 22920 "" + } +#line 22921 "" + } else if (*mtrdenl == 2) { +#line 22922 "" + *ibmtyp = 1; +#line 22923 "" + if (*mtrnuml == 3) { +#line 22924 "" + *ibmrep = 3; +#line 22925 "" + } else { +#line 22926 "" + *ibmrep = (*mtrnuml << 1) / *mtrdenl; +#line 22927 "" + } +#line 22928 "" + } else { + +/* Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */ + +#line 22932 "" + *ibmtyp = 3; +#line 22933 "" + *ibmrep = *mtrnuml / 3; +#line 22934 "" + } + +/* Reset so we don't keep writing new meters */ + +#line 22938 "" + *mtrnuml = 0; + +/* Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter */ + +#line 22942 "" + *ibmrep = max(*ibmrep,1); +#line 22943 "" + return 0; +} /* setmeter_ */ + +/* Subroutine */ int setupb_(real *xelsk, integer *nnb, real *sumx, real * + sumy, integer *ipb, real *smed, integer *ixrest) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1, r__2; + + /* Builtin functions */ + double r_sign(real *, real *); + integer i_nint(real *), i_sign(integer *, integer *); + double sqrt(doublereal); + + /* Local variables */ + static integer i__, j; + static real t; + static integer n1, ip; + static real yb1; + static integer ibc, inb, jnb; + static real off; + static integer nsc, iul; + static real syb, sum, ssq, off1, off2; + static logical l1ng, l2ng; + static real beta, smin, eskz0; + static integer ipxt1; + extern integer ncmid_(integer *, integer *); + static real ybeam, xboff; + static integer ndoub; + static real slope[800]; + static integer issbs; + static real ynote; + extern /* Subroutine */ int setbm2_(real *, integer *, real *, real *, + integer *, integer *, integer *); + static integer nscmid; + static real dnolev; + static integer iplast, nolevo; + static real xnolev2, deficit; + static integer ipxtmid; + + +/* The outer combo algorithm */ + +#line 22977 "" + /* Parameter adjustments */ +#line 22977 "" + --ipb; +#line 22977 "" + --xelsk; +#line 22977 "" + +#line 22977 "" + /* Function Body */ +#line 22977 "" + ibc = all_1.ibmcnt[commvl_1.ivx - 1]; +#line 22978 "" + comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; +#line 22979 "" + 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 22984 "" + comxtup_2.nssb[commvl_1.ivx - 1] = 0; +#line 22985 "" + comxtup_2.issb[commvl_1.ivx - 1] = 0; + +/* Set flag for xtup beam starting with rest (no others can start with rest) */ + +#line 22989 "" + if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) { +#line 22989 "" + *ixrest = 1; +#line 22989 "" + } + +/* Figure how many elemskips to each note. Use the list, counting only non-rests. */ + +#line 22993 "" + eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] + * 24 - 25]; +#line 22994 "" + *nnb = 0; +#line 22995 "" + *sumx = 0.f; +#line 22996 "" + *sumy = 0.f; +#line 22997 "" + ipxt1 = 0; +#line 22998 "" + iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25]; +#line 22999 "" + i__1 = iplast; +#line 22999 "" + for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) { +#line 23000 "" + if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) { +#line 23001 "" + ++(*nnb); +#line 23002 "" + ipb[*nnb] = ip; +#line 23003 "" + xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0; +#line 23004 "" + *sumx += xelsk[*nnb]; +#line 23005 "" + *sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25]; +#line 23006 "" + 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 23011 "" + ++comxtup_2.nssb[commvl_1.ivx - 1]; +#line 23012 "" + comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx + - 1] * 24 - 25] = *nnb; +#line 23013 "" + } +#line 23014 "" + } + +/* New xtup stuff here. Final object is to get distance from start of xtup */ +/* to number. xtinbm counts xtups in this beam only. mtupv is the printed */ +/* 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 23021 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { +#line 23021 "" + ++ndoub; +#line 23021 "" + } +#line 23022 "" + if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) { + +/* Xtup is starting here */ + +#line 23026 "" + ++comxtup_2.nxtinbm[commvl_1.ivx - 1]; +#line 23027 "" + ipxt1 = ip; +#line 23028 "" + if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) { +#line 23029 "" + ndoub = 1; +#line 23030 "" + } else { +#line 23031 "" + ndoub = 0; +#line 23032 "" + } +#line 23033 "" + } 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 23037 "" + 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 23041 "" + 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 23045 "" + ipxtmid = (ip + ipxt1) / 2; +#line 23046 "" + 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 23047 "" + if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx + - 1] * 24 - 25] % 2 == 0) { +#line 23047 "" + 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 23047 "" + } +#line 23050 "" + ipxt1 = 0; +#line 23051 "" + } +#line 23052 "" +/* L2: */ +#line 23052 "" + } + +/* Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */ + +#line 23056 "" + comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0; +#line 23057 "" + *smed = 0.f; +#line 23058 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) { + +/* No forced 0 slope */ + +#line 23062 "" + if (*nnb == 1) { +#line 23062 "" + goto L6; +#line 23062 "" + } +#line 23063 "" + nsc = 0; +#line 23064 "" + i__1 = *nnb - 1; +#line 23064 "" + for (inb = 1; inb <= i__1; ++inb) { +#line 23065 "" + i__2 = *nnb; +#line 23065 "" + for (jnb = inb + 1; jnb <= i__2; ++jnb) { +#line 23066 "" + ++nsc; +#line 23067 "" + 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 23069 "" + if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) { +#line 23070 "" + ++nsc; +#line 23071 "" + slope[nsc - 1] = slope[nsc - 2]; +#line 23072 "" + ++nsc; +#line 23073 "" + slope[nsc - 1] = slope[nsc - 2]; +#line 23074 "" + } +#line 23075 "" +/* L5: */ +#line 23075 "" + } +#line 23075 "" + } +#line 23076 "" + if (nsc == 1) { +#line 23077 "" + *smed = slope[0]; +#line 23078 "" + goto L6; +#line 23079 "" + } +#line 23080 "" + nscmid = nsc / 2 + 1; +#line 23081 "" + i__2 = nscmid; +#line 23081 "" + for (i__ = 1; i__ <= i__2; ++i__) { +#line 23082 "" + i__1 = nsc; +#line 23082 "" + for (j = i__ + 1; j <= i__1; ++j) { +#line 23083 "" + if (slope[j - 1] < slope[i__ - 1]) { +#line 23084 "" + t = slope[j - 1]; +#line 23085 "" + slope[j - 1] = slope[i__ - 1]; +#line 23086 "" + slope[i__ - 1] = t; +#line 23087 "" + } +#line 23088 "" +/* L7: */ +#line 23088 "" + } +#line 23088 "" + } +#line 23089 "" + *smed = slope[nscmid - 1]; +#line 23090 "" + if (nsc == nsc / 2 << 1) { + +/* Even number of slopes in the list, so median is ambiguous */ + +#line 23094 "" + 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 23098 "" + *smed = slope[nscmid - 2]; +#line 23099 "" + } 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 23103 "" + sum = 0.f; +#line 23104 "" + i__1 = nsc; +#line 23104 "" + for (i__ = 1; i__ <= i__1; ++i__) { +#line 23105 "" + sum += slope[i__ - 1]; +#line 23106 "" +/* L1: */ +#line 23106 "" + } +#line 23107 "" + *smed = r_sign(smed, &sum); +#line 23108 "" + } +#line 23109 "" + } +#line 23110 "" +L6: +#line 23111 "" + r__1 = *smed * .5f * all_1.slfac; +#line 23111 "" + comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); +#line 23112 "" + if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) { +#line 23112 "" + comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, & + comxtup_2.islope[commvl_1.ivx - 1]); +#line 23112 "" + } +#line 23114 "" + } else { + +/* Forced horizontal beam */ + +#line 23118 "" + comxtup_2.islope[commvl_1.ivx - 1] = 0; +#line 23119 "" + } +#line 23120 "" + beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx) + / *nnb; + +/* If ixrest>0, this is a virtual nolev1 at location of rest. Will first use */ +/* as is for placing xtup number and/or bracket, then reset it for start of */ +/* actual beam */ + +#line 23126 "" + comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta); + +/* Check if any stems are too short */ + +#line 23130 "" + smin = 100.f; +#line 23131 "" + iul = -1; +#line 23132 "" + if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') { +#line 23132 "" + iul = 1; +#line 23132 "" + } +#line 23133 "" + ssq = 0.f; +#line 23134 "" + syb = 0.f; +/* yb1 = nolev1(ivx)+iul*(stemlen+bmhgt*(mult(ivx,ipb(1))-1)) */ +#line 23136 "" + 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 23138 "" + i__1 = *nnb; +#line 23138 "" + for (inb = 1; inb <= i__1; ++inb) { +#line 23139 "" + 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 23142 "" + syb += ybeam; +#line 23143 "" + ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25]; +#line 23144 "" + off = ybeam - ynote; +#line 23145 "" + if (inb == 1) { +#line 23146 "" + off1 = off; +#line 23147 "" + } else if (inb == *nnb) { +#line 23148 "" + off2 = off; +#line 23149 "" + } +#line 23150 "" + ssq += off * off; +/* Computing MIN */ +#line 23151 "" + r__1 = smin, r__2 = iul * off; +#line 23151 "" + smin = dmin(r__1,r__2); +#line 23152 "" +/* L4: */ +#line 23152 "" + } +#line 23153 "" + dnolev = 0.f; +#line 23154 "" + if (smin < all_1.stemmin) { +#line 23155 "" + deficit = all_1.stemmin - smin; +#line 23156 "" + nolevo = comxtup_2.nolev1[commvl_1.ivx - 1]; +#line 23157 "" + r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit; +#line 23157 "" + comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 23158 "" + dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo); +#line 23159 "" + off1 += dnolev; +#line 23160 "" + off2 += dnolev; +#line 23161 "" + } +/* Computing 2nd power */ +#line 23162 "" + r__1 = dnolev; +#line 23162 "" + ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1; +#line 23163 "" + 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)) { + +/* 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 23171 "" + setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[ + commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]); +#line 23172 "" + } + +/* Check if beam starts or ends too high or low. */ + +/* xboff = bmhgt*(mult(ivx,ipb(1))-1) */ +#line 23177 "" + xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 - + 25]) - 9); +#line 23178 "" + l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[ + 1])) + xboff + 7 < 0.f; +#line 23179 "" + xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[ + commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb]; +#line 23180 "" + l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f; +#line 23181 "" + if (l1ng || l2ng) { + +/* Need to correct start or stop, also slope */ + +#line 23185 "" + if (l1ng) { +#line 23186 "" + r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul; +#line 23186 "" + comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1); +#line 23187 "" + } +#line 23188 "" + if (l2ng) { +#line 23189 "" + r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul; +#line 23189 "" + xnolev2 = (real) i_nint(&r__1); +#line 23190 "" + } + +/* Since one or the other end has changed, need to change slope */ + +#line 23194 "" + if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2)) { +#line 23194 "" + r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1] + ) / xelsk[*nnb]; +#line 23194 "" + comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1); +#line 23194 "" + } +#line 23196 "" + } +#line 23197 "" + if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) { + +/* This is a single-slope beam group. Store start heights for later segs. */ + +#line 23201 "" + i__1 = comxtup_2.nssb[commvl_1.ivx - 1]; +#line 23201 "" + for (issbs = 1; issbs <= i__1; ++issbs) { +#line 23202 "" + 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 23204 "" +/* L3: */ +#line 23204 "" + } +#line 23205 "" + } +#line 23206 "" + return 0; +} /* setupb_ */ + +/* Subroutine */ int sortpoe_(integer *nsyst, real *poe, integer *ipoe) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Local variables */ + static integer io1, io2, iord, itemp; + + +/* Initialize ipoe: */ + +#line 23215 "" + /* Parameter adjustments */ +#line 23215 "" + --ipoe; +#line 23215 "" + --poe; +#line 23215 "" + +#line 23215 "" + /* Function Body */ +#line 23215 "" + i__1 = *nsyst; +#line 23215 "" + for (iord = 1; iord <= i__1; ++iord) { +#line 23216 "" + ipoe[iord] = iord; +#line 23217 "" +/* L3: */ +#line 23217 "" + } + +/* 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 23222 "" + i__1 = *nsyst - 1; +#line 23222 "" + for (io1 = 1; io1 <= i__1; ++io1) { +#line 23223 "" + i__2 = *nsyst; +#line 23223 "" + for (io2 = io1 + 1; io2 <= i__2; ++io2) { +#line 23224 "" + if (poe[ipoe[io1]] > poe[ipoe[io2]]) { + +/* Interchange the indices */ + +#line 23228 "" + itemp = ipoe[io1]; +#line 23229 "" + ipoe[io1] = ipoe[io2]; +#line 23230 "" + ipoe[io2] = itemp; +#line 23231 "" + } +#line 23232 "" +/* L5: */ +#line 23232 "" + } +#line 23233 "" +/* L4: */ +#line 23233 "" + } +#line 23234 "" + return 0; +} /* sortpoe_ */ + +/* Subroutine */ int spsslur_(char *lineq, integer *iccount, integer *iv, + integer *kv, integer *ip, integer *isdat1, integer *isdat2, integer * + isdat3, integer *isdat4, integer *nsdat, logical *notcrd, integer * + nolev, char *starter, ftnlen lineq_len, ftnlen starter_len) +{ + /* System generated locals */ + integer i__1, i__2; + real r__1; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *, + ftnlen, ftnlen), i_nint(real *); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static integer ilb12; + static real fnum; + static char dumq[1], durq[1]; + static integer ihoff, isdat, ivoff, icurv1, idcode, nolevc, numint; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen), setbits_(integer *, integer *, integer *, integer *); + + +/* Reads in slur data. Record all h/v-shifts for non-chords, user-specified */ +/* ones for chords. */ +/* 5/26/02 This subr is called ONLY for postscript slurs. */ + +/* See subroutine doslur for bit values in isdat1,2,3 */ + + +/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ + +#line 23259 "" + /* Parameter adjustments */ +#line 23259 "" + --isdat4; +#line 23259 "" + --isdat3; +#line 23259 "" + --isdat2; +#line 23259 "" + --isdat1; +#line 23259 "" + +#line 23259 "" + /* Function Body */ +#line 23259 "" + numint = 0; +#line 23260 "" + ivoff = 0; +#line 23261 "" + ihoff = 0; +#line 23262 "" + ++(*nsdat); +#line 23263 "" + if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') + { +#line 23263 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 23263 "" + } +#line 23265 "" + setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); +#line 23266 "" + i__1 = *kv - 1; +#line 23266 "" + setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); +#line 23267 "" + setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); +#line 23268 "" + isdat3[*nsdat] = 0; +#line 23269 "" + isdat4[*nsdat] = 0; +#line 23270 "" + ilb12 = 0; + +/* Get ID code */ + +/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */ +#line 23274 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +/* if (index('uldtb+-hfnHps ',durq) .gt. 0) then */ +#line 23276 "" + if (i_indx("uldtb+-hfnHpsv ", durq, (ftnlen)15, (ftnlen)1) > 0) { + +/* Null id. Note for ps slurs, 'H' cannot be an ID */ + +#line 23280 "" + --(*iccount); +#line 23281 "" + if (*(unsigned char *)&lineq[*iccount - 1] == 't') { +#line 23282 "" + idcode = 1; +#line 23283 "" + } else { +#line 23284 "" + idcode = 32; +#line 23285 "" + } +#line 23286 "" + } else { + +/* Set explicit idcode */ + +#line 23290 "" + idcode = *(unsigned char *)durq; +#line 23291 "" + i__1 = *iccount - 2; +#line 23291 "" + if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) { + +/* Make t[ID] look like s[ID]t */ + +#line 23295 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 23296 "" + } +#line 23297 "" + } +#line 23298 "" + setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); + +/* Set start/stop: look thru list from end for same idcode,iv,kv */ + +#line 23302 "" + for (isdat = *nsdat - 1; isdat >= 1; --isdat) { +#line 23303 "" + 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 23309 "" + if (bit_test(isdat1[isdat],11)) { +#line 23309 "" + goto L3; +#line 23309 "" + } + +/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ + +#line 23313 "" + goto L4; +#line 23314 "" + } +#line 23315 "" +/* L2: */ +#line 23315 "" + } + +/* If here, this is turnon. */ + +#line 23319 "" +L4: +#line 23320 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); +#line 23321 "" +L3: + +/* Now done with initial turnon- or turnoff-specifics. */ + +#line 23325 "" + if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) { + +/* There's a default curvature tweak */ + +#line 23329 "" + icurv1 = i_nint(&comslur_1.slurcurve) + 3; +#line 23330 "" + if (icurv1 == 2) { +#line 23330 "" + icurv1 = 1; +#line 23330 "" + } +#line 23331 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 23332 "" + i__1 = icurv1 + 32; +#line 23332 "" + setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 23333 "" + } + +/* Loop for rest of input */ + +#line 23337 "" +L1: +#line 23337 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23338 "" + if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Force direction */ + +#line 23342 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); +#line 23343 "" + if (*(unsigned char *)durq == 'u') { +#line 23343 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); +#line 23343 "" + } +#line 23344 "" + goto L1; +#line 23345 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 23346 "" + ++numint; +#line 23347 "" + if (numint == 1) { + +/* Vertical offset */ + +#line 23351 "" + ++(*iccount); +#line 23352 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23353 "" + --(*iccount); +#line 23354 "" + ivoff = i_nint(&fnum); +#line 23355 "" + if (*(unsigned char *)durq == '-') { +#line 23355 "" + ivoff = -ivoff; +#line 23355 "" + } +#line 23356 "" + } else if (numint == 2) { + +/* Horizontal offset */ + +#line 23360 "" + ++(*iccount); +#line 23361 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23362 "" + --(*iccount); + +/* fnum is abs(hshift), must be 0 to 6.3 */ + +#line 23366 "" + ihoff = fnum * 10 + .5f; +#line 23367 "" + if (*(unsigned char *)durq == '-') { +#line 23367 "" + ihoff = -ihoff; +#line 23367 "" + } + +/* Later will set bits to 1...127 to represent -6.3,...+6.3 */ + +#line 23371 "" + } else { + +/* Must be the 3rd signed integer, so it's a curve specification */ + +#line 23375 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 23376 "" + ++(*iccount); +#line 23377 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23378 "" + icurv1 = i_nint(&fnum); +#line 23379 "" + if (*(unsigned char *)durq == '-') { +#line 23379 "" + icurv1 = -icurv1; +#line 23379 "" + } +#line 23380 "" + i__1 = icurv1 + 32; +#line 23380 "" + setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 23381 "" + if (*(unsigned char *)dumq != ':') { + +/* Back up the pointer and loop for more input */ + +#line 23385 "" + --(*iccount); +#line 23386 "" + } else { + +/* Expect two single digits as parameters for curve */ + +#line 23390 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); +#line 23391 "" + i__1 = *iccount; +#line 23391 "" + i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 23391 "" + setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); +#line 23393 "" + i__1 = *iccount + 1; +#line 23393 "" + i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 23393 "" + setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); +#line 23395 "" + *iccount += 2; +#line 23396 "" + } +#line 23397 "" + } +#line 23398 "" + goto L1; +#line 23399 "" + } else if (*(unsigned char *)durq == 't') { +#line 23400 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 23401 "" + goto L1; +#line 23402 "" + } else if (*(unsigned char *)durq == 'b') { +#line 23403 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); +#line 23404 "" + goto L1; +#line 23405 "" + } else if (*(unsigned char *)durq == 's') { + +/* Endpoint tweaks for linebreak slurs. */ + +#line 23409 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); + +/* Next is vertical offset */ + +/* Must be +|- */ +#line 23413 "" + ++(*iccount); +#line 23414 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23415 "" + if (*(unsigned char *)durq == '-') { +#line 23415 "" + fnum = -fnum; +#line 23415 "" + } +#line 23416 "" + i__1 = ilb12 << 4; +#line 23416 "" + i__2 = i_nint(&fnum) + 32; +#line 23416 "" + setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2); +#line 23417 "" + if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) { + +/* Also a horizontal offset */ + +#line 23421 "" + ++(*iccount); +#line 23422 "" + readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23423 "" + if (*(unsigned char *)dumq == '-') { +#line 23423 "" + fnum = -fnum; +#line 23423 "" + } +#line 23424 "" + i__1 = (ilb12 << 4) + 6; +#line 23424 "" + r__1 = fnum * 10; +#line 23424 "" + i__2 = i_nint(&r__1) + 64; +#line 23424 "" + setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2); +#line 23425 "" + } +#line 23426 "" + --(*iccount); +#line 23427 "" + ilb12 = 1; +#line 23428 "" + goto L1; +#line 23429 "" + } 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 23434 "" + icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1); +#line 23435 "" + if (icurv1 == 5) { + +/* check for 2nd H */ + +#line 23439 "" + i__1 = *iccount; +#line 23439 "" + if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) + { +#line 23440 "" + ++(*iccount); +#line 23441 "" + icurv1 = 6; +#line 23442 "" + } +#line 23443 "" + } +#line 23444 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 23445 "" + i__1 = icurv1 + 32; +#line 23445 "" + setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 23446 "" + goto L1; +#line 23447 "" + } else if (*(unsigned char *)durq == 'p') { +/* Local adjustment */ +#line 23448 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +/* +|- */ +#line 23449 "" + 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 23454 "" + if (*(unsigned char *)durq == '+') { +#line 23455 "" + if (*(unsigned char *)dumq == 's') { +#line 23456 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],26); +#line 23457 "" + } else { +#line 23458 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],28); +#line 23459 "" + } +#line 23460 "" + } else { +#line 23461 "" + if (*(unsigned char *)dumq == 's') { +#line 23462 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],27); +#line 23463 "" + } else { +#line 23464 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],29); +#line 23465 "" + } +#line 23466 "" + } +#line 23467 "" + goto L1; +#line 23468 "" + } else if (*(unsigned char *)durq == 'v') { +/* Stem slur */ +#line 23469 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],2); +#line 23470 "" + goto L1; +#line 23471 "" + } + +/* Record shifts */ + +#line 23475 "" + i__1 = ivoff + 32; +#line 23475 "" + setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); +#line 23476 "" + i__1 = ihoff + 64; +#line 23476 "" + setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); + +/* Record chord flag, note level, notehead shift */ + +#line 23480 "" + if (*notcrd) { +#line 23481 "" + setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); +#line 23482 "" + } else { +#line 23483 "" + nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & + c__12); +#line 23484 "" + setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); +#line 23485 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); +#line 23486 "" + i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & + c__23); +#line 23486 "" + setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); +#line 23487 "" + } +#line 23488 "" + return 0; +} /* spsslur_ */ + +/* Subroutine */ int sslur_(char *lineq, integer *iccount, integer *iv, + integer *kv, integer *ip, integer *isdat1, integer *isdat2, integer * + isdat3, integer *nsdat, logical *notcrd, integer *nolev, char * + starter, ftnlen lineq_len, ftnlen starter_len) +{ + /* System generated locals */ + integer i__1, i__2; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), i_nint(real *), s_cmp( + char *, char *, ftnlen, ftnlen); + + /* Local variables */ + extern integer igetbits_(integer *, integer *, integer *); + static real fnum; + static char dumq[1], durq[1]; + static integer ihoff, isdat, ivoff, icurv1, idcode, nolevc, numint; + extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen, + ftnlen), readnum_(char *, integer *, char *, real *, ftnlen, + ftnlen), setbits_(integer *, integer *, integer *, integer *); + + +/* Reads in slur data. Record all h/v-shifts for non-chords, user-specified */ +/* ones for chords. */ +/* 5/26/02 now only for non-postscript slurs, use spsslur() for postscript */ + +/* See subroutine doslur for bit values in isdat1,2,3 */ + + +/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */ + +#line 23513 "" + /* Parameter adjustments */ +#line 23513 "" + --isdat3; +#line 23513 "" + --isdat2; +#line 23513 "" + --isdat1; +#line 23513 "" + +#line 23513 "" + /* Function Body */ +#line 23513 "" + numint = 0; +#line 23514 "" + ivoff = 0; +#line 23515 "" + ihoff = 0; +#line 23516 "" + ++(*nsdat); +#line 23517 "" + if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}') + { +#line 23517 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 23517 "" + } +#line 23519 "" + setbits_(&isdat1[*nsdat], &c__5, &c__13, iv); +#line 23520 "" + i__1 = *kv - 1; +#line 23520 "" + setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1); +#line 23521 "" + setbits_(&isdat1[*nsdat], &c__8, &c__3, ip); +#line 23522 "" + isdat3[*nsdat] = 0; + +/* Get id letter */ + +#line 23526 "" + if (*(unsigned char *)&lineq[*iccount - 1] == 't') { + +/* Old-style t-slur. Use special idcode = 1 */ + +#line 23530 "" + idcode = 1; +#line 23531 "" + } else { +#line 23532 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23533 "" + if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) { + +/* Null id */ + +#line 23537 "" + idcode = 32; +#line 23538 "" + --(*iccount); +#line 23539 "" + } else if (*(unsigned char *)durq == 'H') { + +/* Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */ + +#line 23543 "" + idcode = 32; +#line 23544 "" + --(*iccount); + +/* There may be another "H", but no need to deal with it yet */ + +#line 23548 "" + } else { + +/* Set explicit idcode */ + +#line 23552 "" + idcode = *(unsigned char *)durq; +#line 23553 "" + } +#line 23554 "" + } +#line 23555 "" + setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode); + +/* Set start/stop: look thru list from end for same idcode,iv,kv */ + +#line 23559 "" + for (isdat = *nsdat - 1; isdat >= 1; --isdat) { +#line 23560 "" + 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 23566 "" + if (bit_test(isdat1[isdat],11)) { +#line 23566 "" + goto L3; +#line 23566 "" + } + +/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */ + +#line 23570 "" + goto L4; +#line 23571 "" + } +#line 23572 "" +/* L2: */ +#line 23572 "" + } + +/* If here, this is turnon. */ + +#line 23576 "" +L4: +#line 23577 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],11); +#line 23578 "" +L3: + +/* Now done with initial turnon- or turnoff-specifics. Loop for rest of input */ + +#line 23582 "" +L1: +#line 23582 "" + getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); +#line 23583 "" + if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) { + +/* Force direction */ + +#line 23587 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],26); +#line 23588 "" + if (*(unsigned char *)durq == 'u') { +#line 23588 "" + isdat1[*nsdat] = bit_set(isdat1[*nsdat],27); +#line 23588 "" + } +#line 23589 "" + goto L1; +#line 23590 "" + } else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) { +#line 23591 "" + ++numint; +#line 23592 "" + if (numint == 1) { + +/* Vertical offset */ + +#line 23596 "" + ++(*iccount); +#line 23597 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23598 "" + --(*iccount); +#line 23599 "" + ivoff = i_nint(&fnum); +#line 23600 "" + if (*(unsigned char *)durq == '-') { +#line 23600 "" + ivoff = -ivoff; +#line 23600 "" + } +#line 23601 "" + } else if (numint == 2) { + +/* Horizontal offset */ + +#line 23605 "" + ++(*iccount); +#line 23606 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23607 "" + --(*iccount); + +/* fnum is abs(hshift), must be 0 to 6.3 */ + +#line 23611 "" + ihoff = fnum * 10 + .5f; +#line 23612 "" + if (*(unsigned char *)durq == '-') { +#line 23612 "" + ihoff = -ihoff; +#line 23612 "" + } + +/* Later will set bits to 1...127 to represent -6.3,...+6.3 */ + +#line 23616 "" + } else { + +/* Must be the 3rd signed integer, so it's a curve specification */ + +#line 23620 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],0); +#line 23621 "" + ++(*iccount); +#line 23622 "" + readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1); +#line 23623 "" + icurv1 = i_nint(&fnum); +#line 23624 "" + if (*(unsigned char *)durq == '-') { +#line 23624 "" + icurv1 = -icurv1; +#line 23624 "" + } +#line 23625 "" + i__1 = icurv1 + 32; +#line 23625 "" + setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 23626 "" + if (*(unsigned char *)dumq != ':') { + +/* Back up the pointer and loop for more input */ + +#line 23630 "" + --(*iccount); +#line 23631 "" + } else { + +/* Expect two single digits as parameters for curve */ + +#line 23635 "" + isdat3[*nsdat] = bit_set(isdat3[*nsdat],1); +#line 23636 "" + i__1 = *iccount; +#line 23636 "" + i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 23636 "" + setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2); +#line 23638 "" + i__1 = *iccount + 1; +#line 23638 "" + i__2 = *(unsigned char *)&lineq[i__1] - 48; +#line 23638 "" + setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2); +#line 23640 "" + *iccount += 2; +#line 23641 "" + } +#line 23642 "" + } +#line 23643 "" + goto L1; +#line 23644 "" + } else if (*(unsigned char *)durq == 't') { +#line 23645 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],3); +#line 23646 "" + goto L1; +#line 23647 "" + } else if (*(unsigned char *)durq == 'b') { +#line 23648 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],4); +#line 23649 "" + goto L1; +#line 23650 "" + } 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 23654 "" + icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2; +#line 23655 "" + if (icurv1 == 3) { +#line 23656 "" + icurv1 = 1; +#line 23657 "" + } else if (icurv1 == 5) { + +/* check for 2nd H */ + +#line 23661 "" + i__1 = *iccount; +#line 23661 "" + if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0) + { +#line 23662 "" + ++(*iccount); +#line 23663 "" + icurv1 = 6; +#line 23664 "" + } +#line 23665 "" + } +#line 23666 "" + 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 23671 "" + i__1 = icurv1 + 32; +#line 23671 "" + setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1); +#line 23672 "" + goto L1; +#line 23673 "" + } + +/* Record shifts */ + +#line 23677 "" + i__1 = ivoff + 32; +#line 23677 "" + setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1); +#line 23678 "" + i__1 = ihoff + 64; +#line 23678 "" + setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1); + +/* Record chord flag, note level, notehead shift */ + +#line 23682 "" + if (*notcrd) { +#line 23683 "" + setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev); +#line 23684 "" + } else { +#line 23685 "" + nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, & + c__12); +#line 23686 "" + setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc); +#line 23687 "" + isdat2[*nsdat] = bit_set(isdat2[*nsdat],0); +#line 23688 "" + i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, & + c__23); +#line 23688 "" + setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1); +#line 23689 "" + } +#line 23690 "" + return 0; +} /* sslur_ */ + +/* Subroutine */ int stop1_(void) +{ + extern /* Subroutine */ int exit_(integer *); + +#line 23693 "" + exit_(&c__1); +#line 23694 "" + return 0; +} /* stop1_ */ + +/* Subroutine */ int topfile_(char *basenameq, integer *lbase, integer *nv, + char *clefq, integer *noinst, integer *musicsize, real *xinstf1, + integer *mtrnmp, integer *mtrdnp, logical *vshrink, real *fbar, + logical *fontslur, ftnlen basenameq_len, ftnlen clefq_len) +{ + /* System generated locals */ + address a__1[3], a__2[2], a__3[4], a__4[6], a__5[2], a__6[5], a__7[10], + a__8[20], a__9[12], a__10[8]; + integer i__1[3], i__2[2], i__3[4], i__4[6], i__5, i__6[2], i__7, i__8, + i__9[5], i__10[10], i__11[20], i__12[12], i__13[8]; + real r__1; + char ch__1[1], ch__2[50], ch__3[15], ch__4[10], ch__5[39], ch__6[14], + ch__7[17], ch__8[16], ch__9[32], ch__10[8], ch__11[12], ch__12[9], + ch__13[13], ch__14[11], ch__15[21], ch__16[7], ch__17[6], ch__18[ + 30], ch__19[19], ch__20[1], ch__21[2], ch__22[33], ch__23[25], + ch__24[35], ch__25[81], ch__26[82], ch__27[18], ch__28[57], + ch__29[44], ch__30[62], ch__31[54], ch__32[86], ch__33[41], + ch__34[47]; + cilist ci__1; + + /* Builtin functions */ + integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), e_wsfi(void), i_nint(real *); + double r_lg10(real *); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer k, iv; + static char sq[1]; + static integer ipi; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static char fmtq[24]; + extern /* Subroutine */ int writesetsign_(integer *, integer *, integer *, + logical *); + static char fbarq[5]; + static integer lname, lfmtq, iinst; + static char clefqiv[1]; + extern integer numclef_(char *, ftnlen); + extern /* Subroutine */ int wgmeter_(integer *, integer *); + static integer nstaves; + + /* Fortran I/O blocks */ + static cilist io___1694 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1695 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1696 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1697 = { 0, 11, 0, "(a)", 0 }; + 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___1710 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1711 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1712 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1713 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static icilist io___1715 = { 0, fbarq, 0, "(f5.3)", 5, 1 }; + static cilist io___1716 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1717 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1718 = { 0, 11, 0, "(a7,i3,a2)", 0 }; + static cilist io___1719 = { 0, 11, 0, "(a8,i3,a2)", 0 }; + static cilist io___1720 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + static cilist io___1721 = { 0, 11, 0, "(a8,i1,a2)", 0 }; + static cilist io___1722 = { 0, 11, 0, "(a8,i2,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, "(a)", 0 }; + static cilist io___1728 = { 0, 11, 0, "(a19,i1,a1)", 0 }; + static cilist io___1729 = { 0, 11, 0, "(a19,i2,a1)", 0 }; + static cilist io___1732 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1733 = { 0, 11, 0, "(a11,i2,a)", 0 }; + static cilist io___1738 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1739 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1740 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1741 = { 0, 11, 0, "(a21,i2,a)", 0 }; + static cilist io___1743 = { 0, 11, 0, "(a8,i1,a)", 0 }; + static cilist io___1744 = { 0, 11, 0, "(a9,i2,a)", 0 }; + static cilist io___1745 = { 0, 11, 0, "(a18,i2,a2)", 0 }; + static cilist io___1747 = { 0, 11, 0, "(a11,i1,a2)", 0 }; + static cilist io___1748 = { 0, 11, 0, "(a11,i2,a2)", 0 }; + static cilist io___1749 = { 0, 11, 0, "(a11,i3,a2)", 0 }; + static cilist io___1750 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1751 = { 0, 11, 0, fmtq, 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, "(a)", 0 }; + static cilist io___1756 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1757 = { 0, 11, 0, "(a)", 0 }; + + +#line 23719 "" + /* Parameter adjustments */ +#line 23719 "" + --clefq; +#line 23719 "" + +#line 23719 "" + /* Function Body */ +#line 23719 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 23719 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 23720 "" + *vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop; +#line 23721 "" + if (*vshrink) { +#line 23722 "" + comarp_1.xinsnow = 10.f; +#line 23723 "" + } else { +#line 23724 "" + comarp_1.xinsnow = *xinstf1; +#line 23725 "" + } +#line 23726 "" + if (! comlast_1.islast) { +#line 23726 "" + return 0; +#line 23726 "" + } +#line 23727 "" + s_wsfe(&io___1694); +#line 23727 "" + do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17); +#line 23727 "" + e_wsfe(); +#line 23728 "" + s_wsfe(&io___1695); +#line 23728 "" + do_fio(&c__1, "%", (ftnlen)1); +#line 23728 "" + e_wsfe(); +#line 23729 "" + s_wsfe(&io___1696); +/* Writing concatenation */ +#line 23729 "" + i__1[0] = 2, a__1[0] = "% "; +#line 23729 "" + i__1[1] = *lbase, a__1[1] = basenameq; +#line 23729 "" + i__1[2] = 4, a__1[2] = ".tex"; +#line 23729 "" + s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50); +#line 23729 "" + do_fio(&c__1, ch__2, *lbase + 6); +#line 23729 "" + e_wsfe(); +#line 23730 "" + s_wsfe(&io___1697); +#line 23730 "" + do_fio(&c__1, "%", (ftnlen)1); +#line 23730 "" + e_wsfe(); +#line 23731 "" + s_wsfe(&io___1698); +#line 23731 "" + do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16); +#line 23731 "" + e_wsfe(); +#line 23732 "" + s_wsfe(&io___1699); +/* Writing concatenation */ +#line 23732 "" + i__2[0] = 1, a__2[0] = sq; +#line 23732 "" + i__2[1] = 14, a__2[1] = "input musixtex"; +#line 23732 "" + s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15); +#line 23732 "" + do_fio(&c__1, ch__3, (ftnlen)15); +#line 23732 "" + e_wsfe(); +#line 23733 "" + s_wsfe(&io___1700); +/* Writing concatenation */ +#line 23733 "" + i__2[0] = 1, a__2[0] = sq; +#line 23733 "" + i__2[1] = 9, a__2[1] = "input pmx"; +#line 23733 "" + s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10); +#line 23733 "" + do_fio(&c__1, ch__4, (ftnlen)10); +#line 23733 "" + e_wsfe(); +/* write(11,'(a)')sq//'input musixmad' */ +/* write(11,'(a)')sq//'input musixxad' */ +#line 23736 "" + s_wsfe(&io___1701); +/* Writing concatenation */ +#line 23736 "" + i__3[0] = 1, a__3[0] = sq; +#line 23736 "" + i__3[1] = 15, a__3[1] = "setmaxslurs{24}"; +#line 23736 "" + i__3[2] = 1, a__3[2] = sq; +#line 23736 "" + i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%"; +#line 23736 "" + s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39); +#line 23736 "" + do_fio(&c__1, ch__5, (ftnlen)39); +#line 23736 "" + e_wsfe(); +#line 23738 "" + if (! (*fontslur)) { +#line 23738 "" + s_wsfe(&io___1702); +/* Writing concatenation */ +#line 23738 "" + i__2[0] = 1, a__2[0] = sq; +#line 23738 "" + i__2[1] = 13, a__2[1] = "input musixps"; +#line 23738 "" + s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); +#line 23738 "" + do_fio(&c__1, ch__6, (ftnlen)14); +#line 23738 "" + e_wsfe(); +#line 23738 "" + } + +/* Need to input musixmad to permit more slurs. */ + +#line 23742 "" + if (*musicsize == 20) { +#line 23743 "" + s_wsfe(&io___1703); +/* Writing concatenation */ +#line 23743 "" + i__2[0] = 1, a__2[0] = sq; +#line 23743 "" + i__2[1] = 16, a__2[1] = "normalmusicsize%"; +#line 23743 "" + s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17); +#line 23743 "" + do_fio(&c__1, ch__7, (ftnlen)17); +#line 23743 "" + e_wsfe(); +#line 23744 "" + } else if (*musicsize == 16) { +#line 23745 "" + s_wsfe(&io___1704); +/* Writing concatenation */ +#line 23745 "" + i__2[0] = 1, a__2[0] = sq; +#line 23745 "" + i__2[1] = 15, a__2[1] = "smallmusicsize%"; +#line 23745 "" + s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 23745 "" + do_fio(&c__1, ch__8, (ftnlen)16); +#line 23745 "" + e_wsfe(); +#line 23746 "" + } else if (*musicsize == 24) { +#line 23747 "" + s_wsfe(&io___1705); +/* Writing concatenation */ +#line 23747 "" + i__2[0] = 1, a__2[0] = sq; +#line 23747 "" + i__2[1] = 15, a__2[1] = "largemusicsize%"; +#line 23747 "" + s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 23747 "" + do_fio(&c__1, ch__8, (ftnlen)16); +#line 23747 "" + e_wsfe(); +#line 23748 "" + s_wsfe(&io___1706); +/* Writing concatenation */ +#line 23748 "" + i__4[0] = 1, a__4[0] = sq; +#line 23748 "" + i__4[1] = 3, a__4[1] = "def"; +#line 23748 "" + i__4[2] = 1, a__4[2] = sq; +#line 23748 "" + i__4[3] = 10, a__4[3] = "meterfont{"; +#line 23748 "" + i__4[4] = 1, a__4[4] = sq; +#line 23748 "" + i__4[5] = 16, a__4[5] = "meterlargefont}%"; +#line 23748 "" + s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32); +#line 23748 "" + do_fio(&c__1, ch__9, (ftnlen)32); +#line 23748 "" + e_wsfe(); +#line 23750 "" + } else if (*musicsize == 29) { +#line 23751 "" + s_wsfe(&io___1707); +/* Writing concatenation */ +#line 23751 "" + i__2[0] = 1, a__2[0] = sq; +#line 23751 "" + i__2[1] = 15, a__2[1] = "Largemusicsize%"; +#line 23751 "" + s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16); +#line 23751 "" + do_fio(&c__1, ch__8, (ftnlen)16); +#line 23751 "" + e_wsfe(); +#line 23752 "" + s_wsfe(&io___1708); +/* Writing concatenation */ +#line 23752 "" + i__4[0] = 1, a__4[0] = sq; +#line 23752 "" + i__4[1] = 3, a__4[1] = "def"; +#line 23752 "" + i__4[2] = 1, a__4[2] = sq; +#line 23752 "" + i__4[3] = 10, a__4[3] = "meterfont{"; +#line 23752 "" + i__4[4] = 1, a__4[4] = sq; +#line 23752 "" + i__4[5] = 16, a__4[5] = "meterLargefont}%"; +#line 23752 "" + s_cat(ch__9, a__4, i__4, &c__6, (ftnlen)32); +#line 23752 "" + do_fio(&c__1, ch__9, (ftnlen)32); +#line 23752 "" + e_wsfe(); +#line 23754 "" + } + +/* Set sizes. Have sizes per staff in isize(.) and noinst per staff in */ +/* nsperi(.) */ + +/* 130324 */ +/* iiv = 1 */ +#line 23761 "" + i__5 = *noinst; +#line 23761 "" + for (iinst = 1; iinst <= i__5; ++iinst) { +/* if (isize(iiv) .eq. 1) then */ +#line 23763 "" + if (comsize_1.isize[iinst - 1] == 1) { +#line 23764 "" + if (iinst <= 9) { +#line 23765 "" + s_wsfe(&io___1710); +/* Writing concatenation */ +#line 23765 "" + i__2[0] = 1, a__2[0] = sq; +#line 23765 "" + i__2[1] = 7, a__2[1] = "setsize"; +#line 23765 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23765 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23765 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23765 "" + i__6[0] = 1, a__5[0] = sq; +#line 23765 "" + i__6[1] = 11, a__5[1] = "smallvalue%"; +#line 23765 "" + s_cat(ch__11, a__5, i__6, &c__2, (ftnlen)12); +#line 23765 "" + do_fio(&c__1, ch__11, (ftnlen)12); +#line 23765 "" + e_wsfe(); +#line 23767 "" + } else { +#line 23768 "" + s_wsfe(&io___1711); +/* Writing concatenation */ +#line 23768 "" + i__2[0] = 1, a__2[0] = sq; +#line 23768 "" + i__2[1] = 8, a__2[1] = "setsize{"; +#line 23768 "" + s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 23768 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 23768 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23768 "" + i__1[0] = 1, a__1[0] = "}"; +#line 23768 "" + i__1[1] = 1, a__1[1] = sq; +#line 23768 "" + i__1[2] = 11, a__1[2] = "smallvalue%"; +#line 23768 "" + s_cat(ch__13, a__1, i__1, &c__3, (ftnlen)13); +#line 23768 "" + do_fio(&c__1, ch__13, (ftnlen)13); +#line 23768 "" + e_wsfe(); +#line 23770 "" + } +/* else if (isize(iiv) .eq. 2) then */ +#line 23772 "" + } else if (comsize_1.isize[iinst - 1] == 2) { +#line 23773 "" + if (iinst <= 9) { +#line 23774 "" + s_wsfe(&io___1712); +/* Writing concatenation */ +#line 23774 "" + i__2[0] = 1, a__2[0] = sq; +#line 23774 "" + i__2[1] = 7, a__2[1] = "setsize"; +#line 23774 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23774 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23774 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23774 "" + i__6[0] = 1, a__5[0] = sq; +#line 23774 "" + i__6[1] = 10, a__5[1] = "tinyvalue%"; +#line 23774 "" + s_cat(ch__14, a__5, i__6, &c__2, (ftnlen)11); +#line 23774 "" + do_fio(&c__1, ch__14, (ftnlen)11); +#line 23774 "" + e_wsfe(); +#line 23776 "" + } else { +#line 23777 "" + s_wsfe(&io___1713); +/* Writing concatenation */ +#line 23777 "" + i__2[0] = 1, a__2[0] = sq; +#line 23777 "" + i__2[1] = 8, a__2[1] = "setsize{"; +#line 23777 "" + s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 23777 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 23777 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23777 "" + i__1[0] = 1, a__1[0] = "}"; +#line 23777 "" + i__1[1] = 1, a__1[1] = sq; +#line 23777 "" + i__1[2] = 10, a__1[2] = "tinyvalue%"; +#line 23777 "" + s_cat(ch__11, a__1, i__1, &c__3, (ftnlen)12); +#line 23777 "" + do_fio(&c__1, ch__11, (ftnlen)12); +#line 23777 "" + e_wsfe(); +#line 23779 "" + } +#line 23780 "" + } +/* iiv = iiv+nsperi(iinst) */ +#line 23782 "" +/* L5: */ +#line 23782 "" + } +#line 23783 "" + s_wsfi(&io___1715); +#line 23783 "" + do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real)); +#line 23783 "" + e_wsfi(); +#line 23784 "" + s_wsfe(&io___1716); +/* Writing concatenation */ +#line 23784 "" + i__2[0] = 1, a__2[0] = sq; +#line 23784 "" + i__2[1] = 13, a__2[1] = "nopagenumbers"; +#line 23784 "" + s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14); +#line 23784 "" + do_fio(&c__1, ch__6, (ftnlen)14); +#line 23784 "" + e_wsfe(); +#line 23785 "" + s_wsfe(&io___1717); +/* Writing concatenation */ +#line 23785 "" + i__3[0] = 1, a__3[0] = sq; +#line 23785 "" + i__3[1] = 14, a__3[1] = "tracingstats=2"; +#line 23785 "" + i__3[2] = 1, a__3[2] = sq; +#line 23785 "" + i__3[3] = 5, a__3[3] = "relax"; +#line 23785 "" + s_cat(ch__15, a__3, i__3, &c__4, (ftnlen)21); +#line 23785 "" + do_fio(&c__1, ch__15, (ftnlen)21); +#line 23785 "" + e_wsfe(); +#line 23786 "" + s_wsfe(&io___1718); +/* Writing concatenation */ +#line 23786 "" + i__2[0] = 1, a__2[0] = sq; +#line 23786 "" + i__2[1] = 6, a__2[1] = "hsize="; +#line 23786 "" + s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)7); +#line 23786 "" + do_fio(&c__1, ch__16, (ftnlen)7); +#line 23786 "" + i__5 = i_nint(&comtop_1.widthpt); +#line 23786 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23786 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23786 "" + e_wsfe(); +#line 23787 "" + ci__1.cierr = 0; +#line 23787 "" + ci__1.ciunit = 11; +/* Writing concatenation */ +#line 23787 "" + i__1[0] = 5, a__1[0] = "(a6,i"; +#line 23787 "" + r__1 = comtop_1.height + .1f; +#line 23787 "" + i__5 = (integer) r_lg10(&r__1) + 49; +#line 23787 "" + chax_(ch__1, (ftnlen)1, &i__5); +#line 23787 "" + i__1[1] = 1, a__1[1] = ch__1; +#line 23787 "" + i__1[2] = 4, a__1[2] = ",a2)"; +#line 23787 "" + ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4); +#line 23787 "" + s_wsfe(&ci__1); +/* Writing concatenation */ +#line 23787 "" + i__2[0] = 1, a__2[0] = sq; +#line 23787 "" + i__2[1] = 5, a__2[1] = "vsize"; +#line 23787 "" + s_cat(ch__17, a__2, i__2, &c__2, (ftnlen)6); +#line 23787 "" + do_fio(&c__1, ch__17, (ftnlen)6); +#line 23787 "" + i__7 = (integer) (comtop_1.height + .1f); +#line 23787 "" + do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer)); +#line 23787 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23787 "" + e_wsfe(); +#line 23789 "" + if (dabs(comtop_1.hoffpt) > .1f) { +#line 23790 "" + if (comtop_1.hoffpt <= -10.f) { +#line 23791 "" + s_wsfe(&io___1719); +/* Writing concatenation */ +#line 23791 "" + i__2[0] = 1, a__2[0] = sq; +#line 23791 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 23791 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23791 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23791 "" + i__5 = i_nint(&comtop_1.hoffpt); +#line 23791 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23791 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23791 "" + e_wsfe(); +#line 23792 "" + } else if (comtop_1.hoffpt < 0.f) { +#line 23793 "" + s_wsfe(&io___1720); +/* Writing concatenation */ +#line 23793 "" + i__2[0] = 1, a__2[0] = sq; +#line 23793 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 23793 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23793 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23793 "" + i__5 = i_nint(&comtop_1.hoffpt); +#line 23793 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23793 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23793 "" + e_wsfe(); +#line 23794 "" + } else if (comtop_1.hoffpt < 10.f) { +#line 23795 "" + s_wsfe(&io___1721); +/* Writing concatenation */ +#line 23795 "" + i__2[0] = 1, a__2[0] = sq; +#line 23795 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 23795 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23795 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23795 "" + i__5 = i_nint(&comtop_1.hoffpt); +#line 23795 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23795 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23795 "" + e_wsfe(); +#line 23796 "" + } else { +#line 23797 "" + s_wsfe(&io___1722); +/* Writing concatenation */ +#line 23797 "" + i__2[0] = 1, a__2[0] = sq; +#line 23797 "" + i__2[1] = 7, a__2[1] = "hoffset"; +#line 23797 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23797 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23797 "" + i__5 = i_nint(&comtop_1.hoffpt); +#line 23797 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23797 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23797 "" + e_wsfe(); +#line 23798 "" + } +#line 23799 "" + } +#line 23800 "" + if (dabs(comtop_1.voffpt) > .1f) { +#line 23801 "" + if (comtop_1.voffpt <= -10.f) { +#line 23802 "" + s_wsfe(&io___1723); +/* Writing concatenation */ +#line 23802 "" + i__2[0] = 1, a__2[0] = sq; +#line 23802 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 23802 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23802 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23802 "" + i__5 = i_nint(&comtop_1.voffpt); +#line 23802 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23802 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23802 "" + e_wsfe(); +#line 23803 "" + } else if (comtop_1.voffpt < 0.f) { +#line 23804 "" + s_wsfe(&io___1724); +/* Writing concatenation */ +#line 23804 "" + i__2[0] = 1, a__2[0] = sq; +#line 23804 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 23804 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23804 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23804 "" + i__5 = i_nint(&comtop_1.voffpt); +#line 23804 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23804 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23804 "" + e_wsfe(); +#line 23805 "" + } else if (comtop_1.voffpt < 10.f) { +#line 23806 "" + s_wsfe(&io___1725); +/* Writing concatenation */ +#line 23806 "" + i__2[0] = 1, a__2[0] = sq; +#line 23806 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 23806 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23806 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23806 "" + i__5 = i_nint(&comtop_1.voffpt); +#line 23806 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23806 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23806 "" + e_wsfe(); +#line 23807 "" + } else { +#line 23808 "" + s_wsfe(&io___1726); +/* Writing concatenation */ +#line 23808 "" + i__2[0] = 1, a__2[0] = sq; +#line 23808 "" + i__2[1] = 7, a__2[1] = "voffset"; +#line 23808 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23808 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23808 "" + i__5 = i_nint(&comtop_1.voffpt); +#line 23808 "" + do_fio(&c__1, (char *)&i__5, (ftnlen)sizeof(integer)); +#line 23808 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23808 "" + e_wsfe(); +#line 23809 "" + } +#line 23810 "" + } + +/* 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 23815 "" + if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') { +#line 23815 "" + s_wsfe(&io___1727); +/* Writing concatenation */ +#line 23815 "" + i__4[0] = 1, a__4[0] = sq; +#line 23815 "" + i__4[1] = 3, a__4[1] = "def"; +#line 23815 "" + i__4[2] = 1, a__4[2] = sq; +#line 23815 "" + i__4[3] = 14, a__4[3] = "raisebarno{4.5"; +#line 23815 "" + i__4[4] = 1, a__4[4] = sq; +#line 23815 "" + i__4[5] = 10, a__4[5] = "internote}"; +#line 23815 "" + s_cat(ch__18, a__4, i__4, &c__6, (ftnlen)30); +#line 23815 "" + do_fio(&c__1, ch__18, (ftnlen)30); +#line 23815 "" + e_wsfe(); +#line 23815 "" + } +#line 23817 "" + if (*noinst < 10) { +#line 23818 "" + s_wsfe(&io___1728); +/* Writing concatenation */ +#line 23818 "" + i__3[0] = 1, a__3[0] = sq; +#line 23818 "" + i__3[1] = 3, a__3[1] = "def"; +#line 23818 "" + i__3[2] = 1, a__3[2] = sq; +#line 23818 "" + i__3[3] = 14, a__3[3] = "nbinstruments{"; +#line 23818 "" + s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19); +#line 23818 "" + do_fio(&c__1, ch__19, (ftnlen)19); +#line 23818 "" + do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); +#line 23818 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 23818 "" + e_wsfe(); +#line 23820 "" + } else { +#line 23821 "" + s_wsfe(&io___1729); +/* Writing concatenation */ +#line 23821 "" + i__3[0] = 1, a__3[0] = sq; +#line 23821 "" + i__3[1] = 3, a__3[1] = "def"; +#line 23821 "" + i__3[2] = 1, a__3[2] = sq; +#line 23821 "" + i__3[3] = 14, a__3[3] = "nbinstruments{"; +#line 23821 "" + s_cat(ch__19, a__3, i__3, &c__4, (ftnlen)19); +#line 23821 "" + do_fio(&c__1, ch__19, (ftnlen)19); +#line 23821 "" + do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer)); +#line 23821 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 23821 "" + e_wsfe(); +#line 23823 "" + } +#line 23824 "" + iv = 0; +#line 23825 "" + i__5 = *noinst; +#line 23825 "" + for (iinst = 1; iinst <= i__5; ++iinst) { +#line 23826 "" + nstaves = comnvi_1.nsperi[iinst - 1]; +#line 23827 "" + if (iinst < 10) { +#line 23828 "" + s_wsfe(&io___1732); +/* Writing concatenation */ +#line 23828 "" + i__3[0] = 1, a__3[0] = sq; +#line 23828 "" + i__3[1] = 9, a__3[1] = "setstaffs"; +#line 23828 "" + i__7 = iinst + 48; +#line 23828 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23828 "" + i__3[2] = 1, a__3[2] = ch__1; +#line 23828 "" + i__8 = nstaves + 48; +#line 23828 "" + chax_(ch__20, (ftnlen)1, &i__8); +#line 23828 "" + i__3[3] = 1, a__3[3] = ch__20; +#line 23828 "" + s_cat(ch__11, a__3, i__3, &c__4, (ftnlen)12); +#line 23828 "" + do_fio(&c__1, ch__11, (ftnlen)12); +#line 23828 "" + e_wsfe(); +#line 23830 "" + } else { +#line 23831 "" + s_wsfe(&io___1733); +/* Writing concatenation */ +#line 23831 "" + i__2[0] = 1, a__2[0] = sq; +#line 23831 "" + i__2[1] = 10, a__2[1] = "setstaffs{"; +#line 23831 "" + s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 23831 "" + do_fio(&c__1, ch__14, (ftnlen)11); +#line 23831 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23831 "" + i__6[0] = 1, a__5[0] = "}"; +#line 23831 "" + i__7 = nstaves + 48; +#line 23831 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23831 "" + i__6[1] = 1, a__5[1] = ch__1; +#line 23831 "" + s_cat(ch__21, a__5, i__6, &c__2, (ftnlen)2); +#line 23831 "" + do_fio(&c__1, ch__21, (ftnlen)2); +#line 23831 "" + e_wsfe(); +#line 23833 "" + } +#line 23834 "" + ++iv; +#line 23835 "" + *(unsigned char *)clefqiv = *(unsigned char *)&clefq[iv]; +#line 23836 "" + if (*(unsigned char *)clefqiv == '8') { +#line 23837 "" + *(unsigned char *)clefqiv = 't'; +#line 23838 "" + cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] = 7; +#line 23839 "" + } +#line 23840 "" + if (nstaves == 1) { +#line 23841 "" + i__7 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 23841 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23841 "" + s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1); +#line 23842 "" + lfmtq = 1; +#line 23843 "" + } else { +/* Writing concatenation */ +#line 23844 "" + i__2[0] = 1, a__2[0] = "{"; +#line 23844 "" + i__7 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 23844 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23844 "" + i__2[1] = 1, a__2[1] = ch__1; +#line 23844 "" + s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 23845 "" + lfmtq = 2; +#line 23846 "" + i__7 = nstaves; +#line 23846 "" + for (k = 2; k <= i__7; ++k) { +#line 23847 "" + ++iv; +/* Writing concatenation */ +#line 23848 "" + i__2[0] = lfmtq, a__2[0] = fmtq; +#line 23848 "" + i__8 = numclef_(clefq + iv, (ftnlen)1) + 48; +#line 23848 "" + chax_(ch__1, (ftnlen)1, &i__8); +#line 23848 "" + i__2[1] = 1, a__2[1] = ch__1; +#line 23848 "" + s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 23849 "" + ++lfmtq; +#line 23850 "" +/* L2: */ +#line 23850 "" + } +/* Writing concatenation */ +#line 23851 "" + i__2[0] = lfmtq, a__2[0] = fmtq; +#line 23851 "" + i__2[1] = 1, a__2[1] = "}"; +#line 23851 "" + s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24); +#line 23852 "" + ++lfmtq; +#line 23853 "" + } +#line 23854 "" + if (iinst < 10) { +#line 23855 "" + s_wsfe(&io___1738); +/* Writing concatenation */ +#line 23855 "" + i__3[0] = 1, a__3[0] = sq; +#line 23855 "" + i__3[1] = 7, a__3[1] = "setclef"; +#line 23855 "" + i__7 = iinst + 48; +#line 23855 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23855 "" + i__3[2] = 1, a__3[2] = ch__1; +#line 23855 "" + i__3[3] = lfmtq, a__3[3] = fmtq; +#line 23855 "" + s_cat(ch__22, a__3, i__3, &c__4, (ftnlen)33); +#line 23855 "" + do_fio(&c__1, ch__22, lfmtq + 9); +#line 23855 "" + e_wsfe(); +#line 23856 "" + } else { +#line 23857 "" + s_wsfe(&io___1739); +/* Writing concatenation */ +#line 23857 "" + i__2[0] = 1, a__2[0] = sq; +#line 23857 "" + i__2[1] = 8, a__2[1] = "setclef{"; +#line 23857 "" + s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 23857 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 23857 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23857 "" + i__6[0] = 1, a__5[0] = "}"; +#line 23857 "" + i__6[1] = lfmtq, a__5[1] = fmtq; +#line 23857 "" + s_cat(ch__23, a__5, i__6, &c__2, (ftnlen)25); +#line 23857 "" + do_fio(&c__1, ch__23, lfmtq + 1); +#line 23857 "" + e_wsfe(); +#line 23858 "" + } +#line 23859 "" + if (*(unsigned char *)&clefq[iv] == '8') { +#line 23860 "" + if (iinst < 10) { +#line 23861 "" + s_wsfe(&io___1740); +/* Writing concatenation */ +#line 23861 "" + i__9[0] = 1, a__6[0] = sq; +#line 23861 "" + i__9[1] = 19, a__6[1] = "settrebleclefsymbol"; +#line 23861 "" + i__7 = iinst + 48; +#line 23861 "" + chax_(ch__1, (ftnlen)1, &i__7); +#line 23861 "" + i__9[2] = 1, a__6[2] = ch__1; +#line 23861 "" + i__9[3] = 1, a__6[3] = sq; +#line 23861 "" + i__9[4] = 13, a__6[4] = "treblelowoct%"; +#line 23861 "" + s_cat(ch__24, a__6, i__9, &c__5, (ftnlen)35); +#line 23861 "" + do_fio(&c__1, ch__24, (ftnlen)35); +#line 23861 "" + e_wsfe(); +#line 23863 "" + } else { +#line 23864 "" + s_wsfe(&io___1741); +/* Writing concatenation */ +#line 23864 "" + i__2[0] = 1, a__2[0] = sq; +#line 23864 "" + i__2[1] = 20, a__2[1] = "settrebleclefsymbol{"; +#line 23864 "" + s_cat(ch__15, a__2, i__2, &c__2, (ftnlen)21); +#line 23864 "" + do_fio(&c__1, ch__15, (ftnlen)21); +#line 23864 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23864 "" + i__1[0] = 1, a__1[0] = "}"; +#line 23864 "" + i__1[1] = 1, a__1[1] = sq; +#line 23864 "" + i__1[2] = 13, a__1[2] = "treblelowoct%"; +#line 23864 "" + s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)15); +#line 23864 "" + do_fio(&c__1, ch__3, (ftnlen)15); +#line 23864 "" + e_wsfe(); +#line 23866 "" + } +#line 23867 "" + } +#line 23868 "" + for (lname = 79; lname >= 2; --lname) { +#line 23869 "" + if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname + - 1)] != ' ') { +#line 23869 "" + goto L4; +#line 23869 "" + } +#line 23870 "" +/* L3: */ +#line 23870 "" + } +#line 23871 "" +L4: +#line 23872 "" + comtop_1.lnam[iinst - 1] = lname; +#line 23873 "" + if (iinst < 10) { +#line 23874 "" + s_wsfe(&io___1743); +/* Writing concatenation */ +#line 23874 "" + i__2[0] = 1, a__2[0] = sq; +#line 23874 "" + i__2[1] = 7, a__2[1] = "setname"; +#line 23874 "" + s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)8); +#line 23874 "" + do_fio(&c__1, ch__10, (ftnlen)8); +#line 23874 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23874 "" + i__1[0] = 1, a__1[0] = "{"; +#line 23874 "" + i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; +#line 23874 "" + i__1[2] = 1, a__1[2] = "}"; +#line 23874 "" + s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)81); +#line 23874 "" + do_fio(&c__1, ch__25, lname + 2); +#line 23874 "" + e_wsfe(); +#line 23876 "" + } else { +#line 23877 "" + s_wsfe(&io___1744); +/* Writing concatenation */ +#line 23877 "" + i__2[0] = 1, a__2[0] = sq; +#line 23877 "" + i__2[1] = 8, a__2[1] = "setname{"; +#line 23877 "" + s_cat(ch__12, a__2, i__2, &c__2, (ftnlen)9); +#line 23877 "" + do_fio(&c__1, ch__12, (ftnlen)9); +#line 23877 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +/* Writing concatenation */ +#line 23877 "" + i__1[0] = 2, a__1[0] = "}{"; +#line 23877 "" + i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79; +#line 23877 "" + i__1[2] = 1, a__1[2] = "}"; +#line 23877 "" + s_cat(ch__26, a__1, i__1, &c__3, (ftnlen)82); +#line 23877 "" + do_fio(&c__1, ch__26, lname + 3); +#line 23877 "" + e_wsfe(); +#line 23879 "" + } +#line 23880 "" +/* L1: */ +#line 23880 "" + } +#line 23881 "" + s_wsfe(&io___1745); +/* Writing concatenation */ +#line 23881 "" + i__2[0] = 1, a__2[0] = sq; +#line 23881 "" + i__2[1] = 17, a__2[1] = "generalsignature{"; +#line 23881 "" + s_cat(ch__27, a__2, i__2, &c__2, (ftnlen)18); +#line 23881 "" + do_fio(&c__1, ch__27, (ftnlen)18); +#line 23881 "" + do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer)); +#line 23881 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 23881 "" + e_wsfe(); +#line 23882 "" + if (cominsttrans_1.earlytranson) { +#line 23882 "" + writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans, + cominsttrans_1.itranskey, &cominsttrans_1.earlytranson); +#line 23882 "" + } +#line 23884 "" + wgmeter_(mtrnmp, mtrdnp); +#line 23885 "" + r__1 = comtop_1.fracindent * comtop_1.widthpt; +#line 23885 "" + ipi = i_nint(&r__1); +#line 23886 "" + if (ipi < 10) { +#line 23887 "" + s_wsfe(&io___1747); +/* Writing concatenation */ +#line 23887 "" + i__2[0] = 1, a__2[0] = sq; +#line 23887 "" + i__2[1] = 10, a__2[1] = "parindent "; +#line 23887 "" + s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 23887 "" + do_fio(&c__1, ch__14, (ftnlen)11); +#line 23887 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 23887 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23887 "" + e_wsfe(); +#line 23888 "" + } else if (ipi < 100) { +#line 23889 "" + s_wsfe(&io___1748); +/* Writing concatenation */ +#line 23889 "" + i__2[0] = 1, a__2[0] = sq; +#line 23889 "" + i__2[1] = 10, a__2[1] = "parindent "; +#line 23889 "" + s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 23889 "" + do_fio(&c__1, ch__14, (ftnlen)11); +#line 23889 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 23889 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23889 "" + e_wsfe(); +#line 23890 "" + } else { +#line 23891 "" + s_wsfe(&io___1749); +/* Writing concatenation */ +#line 23891 "" + i__2[0] = 1, a__2[0] = sq; +#line 23891 "" + i__2[1] = 10, a__2[1] = "parindent "; +#line 23891 "" + s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)11); +#line 23891 "" + do_fio(&c__1, ch__14, (ftnlen)11); +#line 23891 "" + do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer)); +#line 23891 "" + do_fio(&c__1, "pt", (ftnlen)2); +#line 23891 "" + e_wsfe(); +#line 23892 "" + } +#line 23893 "" + s_wsfe(&io___1750); +/* Writing concatenation */ +#line 23893 "" + i__10[0] = 1, a__7[0] = sq; +#line 23893 "" + i__10[1] = 11, a__7[1] = "elemskip1pt"; +#line 23893 "" + i__10[2] = 1, a__7[2] = sq; +#line 23893 "" + i__10[3] = 13, a__7[3] = "afterruleskip"; +#line 23893 "" + i__10[4] = 5, a__7[4] = fbarq; +#line 23893 "" + i__10[5] = 2, a__7[5] = "pt"; +#line 23893 "" + i__10[6] = 1, a__7[6] = sq; +#line 23893 "" + i__10[7] = 17, a__7[7] = "beforeruleskip0pt"; +#line 23893 "" + i__10[8] = 1, a__7[8] = sq; +#line 23893 "" + i__10[9] = 5, a__7[9] = "relax"; +#line 23893 "" + s_cat(ch__28, a__7, i__10, &c__10, (ftnlen)57); +#line 23893 "" + do_fio(&c__1, ch__28, (ftnlen)57); +#line 23893 "" + e_wsfe(); +#line 23895 "" + if (! (*vshrink)) { +#line 23896 "" + if (*xinstf1 < 9.95f) { +#line 23897 "" + s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10); +#line 23898 "" + } else { +#line 23899 "" + s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10); +#line 23900 "" + } +#line 23901 "" + s_wsfe(&io___1751); +/* Writing concatenation */ +#line 23901 "" + i__4[0] = 1, a__4[0] = sq; +#line 23901 "" + i__4[1] = 15, a__4[1] = "stafftopmarg0pt"; +#line 23901 "" + i__4[2] = 1, a__4[2] = sq; +#line 23901 "" + i__4[3] = 15, a__4[3] = "staffbotmarg0pt"; +#line 23901 "" + i__4[4] = 1, a__4[4] = sq; +#line 23901 "" + i__4[5] = 11, a__4[5] = "interstaff{"; +#line 23901 "" + s_cat(ch__29, a__4, i__4, &c__6, (ftnlen)44); +#line 23901 "" + do_fio(&c__1, ch__29, (ftnlen)44); +#line 23901 "" + do_fio(&c__1, (char *)&(*xinstf1), (ftnlen)sizeof(real)); +/* Writing concatenation */ +#line 23901 "" + i__1[0] = 1, a__1[0] = "}"; +#line 23901 "" + i__1[1] = 1, a__1[1] = sq; +#line 23901 "" + i__1[2] = 5, a__1[2] = "relax"; +#line 23901 "" + s_cat(ch__16, a__1, i__1, &c__3, (ftnlen)7); +#line 23901 "" + do_fio(&c__1, ch__16, (ftnlen)7); +#line 23901 "" + e_wsfe(); +#line 23903 "" + } else { +#line 23904 "" + s_wsfe(&io___1752); +/* Writing concatenation */ +#line 23904 "" + i__10[0] = 1, a__7[0] = sq; +#line 23904 "" + i__10[1] = 15, a__7[1] = "stafftopmarg0pt"; +#line 23904 "" + i__10[2] = 1, a__7[2] = sq; +#line 23904 "" + i__10[3] = 13, a__7[3] = "staffbotmarg5"; +#line 23904 "" + i__10[4] = 1, a__7[4] = sq; +#line 23904 "" + i__10[5] = 10, a__7[5] = "Interligne"; +#line 23904 "" + i__10[6] = 1, a__7[6] = sq; +#line 23904 "" + i__10[7] = 14, a__7[7] = "interstaff{10}"; +#line 23904 "" + i__10[8] = 1, a__7[8] = sq; +#line 23904 "" + i__10[9] = 5, a__7[9] = "relax"; +#line 23904 "" + s_cat(ch__30, a__7, i__10, &c__10, (ftnlen)62); +#line 23904 "" + do_fio(&c__1, ch__30, (ftnlen)62); +#line 23904 "" + e_wsfe(); +#line 23907 "" + } +#line 23908 "" + if (*nv == 1) { +#line 23908 "" + s_wsfe(&io___1753); +/* Writing concatenation */ +#line 23908 "" + i__2[0] = 1, a__2[0] = sq; +#line 23908 "" + i__2[1] = 11, a__2[1] = "nostartrule"; +#line 23908 "" + s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)12); +#line 23908 "" + do_fio(&c__1, ch__11, (ftnlen)12); +#line 23908 "" + e_wsfe(); +#line 23908 "" + } +#line 23909 "" + s_wsfe(&io___1754); +/* Writing concatenation */ +#line 23909 "" + i__3[0] = 1, a__3[0] = sq; +#line 23909 "" + i__3[1] = 8, a__3[1] = "readmod{"; +#line 23909 "" + i__3[2] = *lbase, a__3[2] = basenameq; +#line 23909 "" + i__3[3] = 1, a__3[3] = "}"; +#line 23909 "" + s_cat(ch__31, a__3, i__3, &c__4, (ftnlen)54); +#line 23909 "" + do_fio(&c__1, ch__31, *lbase + 10); +#line 23909 "" + e_wsfe(); +#line 23910 "" + if (comnvst_1.cstuplet) { +#line 23911 "" + s_wsfe(&io___1755); +/* Writing concatenation */ +#line 23911 "" + i__11[0] = 1, a__8[0] = sq; +#line 23911 "" + i__11[1] = 12, a__8[1] = "input tuplet"; +#line 23911 "" + i__11[2] = 1, a__8[2] = sq; +#line 23911 "" + i__11[3] = 3, a__8[3] = "def"; +#line 23911 "" + i__11[4] = 1, a__8[4] = sq; +#line 23911 "" + i__11[5] = 12, a__8[5] = "xnumt#1#2#3{"; +#line 23911 "" + i__11[6] = 1, a__8[6] = sq; +#line 23911 "" + i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}"; +#line 23911 "" + i__11[8] = 1, a__8[8] = sq; +#line 23911 "" + i__11[9] = 3, a__8[9] = "def"; +#line 23911 "" + i__11[10] = 1, a__8[10] = sq; +#line 23911 "" + i__11[11] = 10, a__8[11] = "tuplettxt{"; +#line 23911 "" + i__11[12] = 1, a__8[12] = sq; +#line 23911 "" + i__11[13] = 9, a__8[13] = "smalltype"; +#line 23911 "" + i__11[14] = 1, a__8[14] = sq; +#line 23911 "" + i__11[15] = 6, a__8[15] = "it{#3}"; +#line 23911 "" + i__11[16] = 1, a__8[16] = sq; +#line 23911 "" + i__11[17] = 1, a__8[17] = "/"; +#line 23911 "" + i__11[18] = 1, a__8[18] = sq; +#line 23911 "" + i__11[19] = 4, a__8[19] = "/}}%"; +#line 23911 "" + s_cat(ch__32, a__8, i__11, &c__20, (ftnlen)86); +#line 23911 "" + do_fio(&c__1, ch__32, (ftnlen)86); +#line 23911 "" + e_wsfe(); +#line 23915 "" + s_wsfe(&io___1756); +/* Writing concatenation */ +#line 23915 "" + i__12[0] = 1, a__9[0] = sq; +#line 23915 "" + i__12[1] = 3, a__9[1] = "let"; +#line 23915 "" + i__12[2] = 1, a__9[2] = sq; +#line 23915 "" + i__12[3] = 5, a__9[3] = "ovbkt"; +#line 23915 "" + i__12[4] = 1, a__9[4] = sq; +#line 23915 "" + i__12[5] = 8, a__9[5] = "uptuplet"; +#line 23915 "" + i__12[6] = 1, a__9[6] = sq; +#line 23915 "" + i__12[7] = 3, a__9[7] = "let"; +#line 23915 "" + i__12[8] = 1, a__9[8] = sq; +#line 23915 "" + i__12[9] = 5, a__9[9] = "unbkt"; +#line 23915 "" + i__12[10] = 1, a__9[10] = sq; +#line 23915 "" + i__12[11] = 11, a__9[11] = "downtuplet%"; +#line 23915 "" + s_cat(ch__33, a__9, i__12, &c__12, (ftnlen)41); +#line 23915 "" + do_fio(&c__1, ch__33, (ftnlen)41); +#line 23915 "" + e_wsfe(); +#line 23917 "" + } +#line 23918 "" + s_wsfe(&io___1757); +/* Writing concatenation */ +#line 23918 "" + i__13[0] = 1, a__10[0] = sq; +#line 23918 "" + i__13[1] = 11, a__10[1] = "startmuflex"; +#line 23918 "" + i__13[2] = 1, a__10[2] = sq; +#line 23918 "" + i__13[3] = 10, a__10[3] = "startpiece"; +#line 23918 "" + i__13[4] = 1, a__10[4] = sq; +#line 23918 "" + i__13[5] = 8, a__10[5] = "addspace"; +#line 23918 "" + i__13[6] = 1, a__10[6] = sq; +#line 23918 "" + i__13[7] = 14, a__10[7] = "afterruleskip%"; +#line 23918 "" + s_cat(ch__34, a__10, i__13, &c__8, (ftnlen)47); +#line 23918 "" + do_fio(&c__1, ch__34, (ftnlen)47); +#line 23918 "" + e_wsfe(); +#line 23920 "" + return 0; +} /* topfile_ */ + +/* Character */ VOID udfq_(char *ret_val, ftnlen ret_val_len, integer *nolev, + integer *ncm) +{ + static integer ntest; + + +/* Slur directions */ + +#line 23928 "" + ntest = *nolev - *ncm; +#line 23929 "" + if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) { +#line 23931 "" + *(unsigned char *)ret_val = 'd'; +#line 23932 "" + } else { +#line 23933 "" + *(unsigned char *)ret_val = 'u'; +#line 23934 "" + } +#line 23935 "" + return ; +} /* udfq_ */ + +/* Character */ VOID udqq_(char *ret_val, ftnlen ret_val_len, integer *nole, + integer *ncm, integer *isl, integer *nvmx, integer *ivx, integer *nv) +{ + /* System generated locals */ + real r__1; + char ch__2[1]; + + /* Local variables */ + extern /* Character */ VOID ulfq_(char *, ftnlen, real *, integer *); + static char udqqq[1]; + + +/* Stem direction for single notes */ + +#line 23944 "" + if (bit_test(*isl,30)) { + +/* Absolute override */ + +#line 23948 "" + if (bit_test(*isl,17)) { +#line 23949 "" + *(unsigned char *)udqqq = 'u'; +#line 23950 "" + } else { +#line 23951 "" + *(unsigned char *)udqqq = 'l'; +#line 23952 "" + } +#line 23953 "" + } else if (*nvmx == 1) { + +/* Single voice per staff, default */ + +#line 23957 "" + r__1 = *nole * 1.f; +#line 23957 "" + ulfq_(ch__2, (ftnlen)1, &r__1, ncm); +#line 23957 "" + *(unsigned char *)udqqq = *(unsigned char *)&ch__2[0]; +#line 23958 "" + } else { + +/* Multi-voice per staff, 1st is lower, 2nd upper */ + +#line 23962 "" + if (*ivx <= *nv) { +#line 23963 "" + *(unsigned char *)udqqq = 'l'; +#line 23964 "" + } else { +#line 23965 "" + *(unsigned char *)udqqq = 'u'; +#line 23966 "" + } +#line 23967 "" + } +#line 23968 "" + *(unsigned char *)ret_val = *(unsigned char *)udqqq; +#line 23969 "" + return ; +} /* udqq_ */ + +/* Character */ VOID ulfq_(char *ret_val, ftnlen ret_val_len, real *xnolev, + integer *ncm) +{ + static real test; + + +/* Stem directions */ + +#line 23977 "" + test = *xnolev - *ncm; +#line 23978 "" + if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) { +#line 23980 "" + *(unsigned char *)ret_val = 'u'; +#line 23981 "" + } else { +#line 23982 "" + *(unsigned char *)ret_val = 'l'; +#line 23983 "" + } +#line 23984 "" + return ; +} /* ulfq_ */ + +/* Character */ VOID upcaseq_(char *ret_val, ftnlen ret_val_len, char *chq, + ftnlen chq_len) +{ + /* System generated locals */ + address a__1[2]; + integer i__1, i__2[2]; + char ch__2[1], ch__3[53]; + + /* Builtin functions */ + integer 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); + + /* Local variables */ + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + + /* Fortran I/O blocks */ + static cilist io___1761 = { 0, 6, 0, 0, 0 }; + + +#line 23988 "" + if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) { +#line 23989 "" + i__1 = *(unsigned char *)chq - 32; +#line 23989 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 23989 "" + *(unsigned char *)ret_val = *(unsigned char *)&ch__2[0]; +#line 23990 "" + } else { +#line 23991 "" + *(unsigned char *)ret_val = *(unsigned char *)chq; +#line 23992 "" + s_wsle(&io___1761); +/* Writing concatenation */ +#line 23992 "" + i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"\ + "rgument: "; +#line 23992 "" + i__2[1] = 1, a__1[1] = chq; +#line 23992 "" + s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53); +#line 23992 "" + do_lio(&c__9, &c__1, ch__3, (ftnlen)53); +#line 23992 "" + e_wsle(); +#line 23994 "" + s_stop("", (ftnlen)0); +#line 23995 "" + } +#line 23996 "" + return ; +} /* upcaseq_ */ + +/* Subroutine */ int wgmeter_(integer *mtrnmp, integer *mtrdnp) +{ + /* System generated locals */ + address a__1[4]; + integer i__1[4], i__2; + char ch__1[1], ch__2[25], ch__3[26], ch__4[21], ch__5[24]; + + /* Builtin functions */ + integer s_wsfe(cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_fio(integer *, char *, ftnlen), e_wsfe(void); + + /* Local variables */ + static char sq[1]; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + + /* Fortran I/O blocks */ + static cilist io___1763 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 }; + static cilist io___1764 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 }; + static cilist io___1765 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 }; + static cilist io___1766 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 }; + static cilist io___1767 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 }; + static cilist io___1768 = { 0, 11, 0, "(a21,i1,a2)", 0 }; + static cilist io___1769 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1770 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1771 = { 0, 11, 0, "(a)", 0 }; + + + +/* Writes meter stuff to file 11, so only called if islast=.true. */ + +#line 24003 "" + if (*mtrdnp == 0) { +#line 24003 "" + return 0; +#line 24003 "" + } +#line 24004 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 24004 "" + *(unsigned char *)sq = *(unsigned char *)&ch__1[0]; +#line 24005 "" + if (*mtrnmp > 0 && *mtrnmp <= 9) { +#line 24006 "" + if (*mtrdnp < 10) { +#line 24007 "" + s_wsfe(&io___1763); +/* Writing concatenation */ +#line 24007 "" + i__1[0] = 1, a__1[0] = sq; +#line 24007 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24007 "" + i__1[2] = 1, a__1[2] = sq; +#line 24007 "" + i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 24007 "" + s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 24007 "" + do_fio(&c__1, ch__2, (ftnlen)25); +#line 24007 "" + do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 24007 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 24007 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24007 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 24007 "" + e_wsfe(); +#line 24010 "" + } else { +#line 24011 "" + s_wsfe(&io___1764); +/* Writing concatenation */ +#line 24011 "" + i__1[0] = 1, a__1[0] = sq; +#line 24011 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24011 "" + i__1[2] = 1, a__1[2] = sq; +#line 24011 "" + i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 24011 "" + s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 24011 "" + do_fio(&c__1, ch__2, (ftnlen)25); +#line 24011 "" + do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 24011 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 24011 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24011 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 24011 "" + e_wsfe(); +#line 24014 "" + } +#line 24015 "" + } else if (*mtrnmp >= 10) { +#line 24016 "" + if (*mtrdnp < 10) { +#line 24017 "" + s_wsfe(&io___1765); +/* Writing concatenation */ +#line 24017 "" + i__1[0] = 1, a__1[0] = sq; +#line 24017 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24017 "" + i__1[2] = 1, a__1[2] = sq; +#line 24017 "" + i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 24017 "" + s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 24017 "" + do_fio(&c__1, ch__2, (ftnlen)25); +#line 24017 "" + do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 24017 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 24017 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24017 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 24017 "" + e_wsfe(); +#line 24020 "" + } else { +#line 24021 "" + s_wsfe(&io___1766); +/* Writing concatenation */ +#line 24021 "" + i__1[0] = 1, a__1[0] = sq; +#line 24021 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24021 "" + i__1[2] = 1, a__1[2] = sq; +#line 24021 "" + i__1[3] = 10, a__1[3] = "meterfrac{"; +#line 24021 "" + s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25); +#line 24021 "" + do_fio(&c__1, ch__2, (ftnlen)25); +#line 24021 "" + do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer)); +#line 24021 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 24021 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24021 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 24021 "" + e_wsfe(); +#line 24024 "" + } +#line 24025 "" + } else if (*mtrnmp < 0) { +#line 24026 "" + s_wsfe(&io___1767); +/* Writing concatenation */ +#line 24026 "" + i__1[0] = 1, a__1[0] = sq; +#line 24026 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24026 "" + i__1[2] = 1, a__1[2] = sq; +#line 24026 "" + i__1[3] = 11, a__1[3] = "meterfracS{"; +#line 24026 "" + s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26); +#line 24026 "" + do_fio(&c__1, ch__3, (ftnlen)26); +#line 24026 "" + i__2 = -(*mtrnmp); +#line 24026 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 24026 "" + do_fio(&c__1, "}{", (ftnlen)2); +#line 24026 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24026 "" + do_fio(&c__1, "}}%", (ftnlen)3); +#line 24026 "" + e_wsfe(); +#line 24029 "" + } else if (*mtrdnp <= 4) { +#line 24030 "" + s_wsfe(&io___1768); +/* Writing concatenation */ +#line 24030 "" + i__1[0] = 1, a__1[0] = sq; +#line 24030 "" + i__1[1] = 13, a__1[1] = "generalmeter{"; +#line 24030 "" + i__1[2] = 1, a__1[2] = sq; +#line 24030 "" + i__1[3] = 6, a__1[3] = "meterN"; +#line 24030 "" + s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); +#line 24030 "" + do_fio(&c__1, ch__4, (ftnlen)21); +#line 24030 "" + do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer)); +#line 24030 "" + do_fio(&c__1, "}%", (ftnlen)2); +#line 24030 "" + e_wsfe(); +#line 24032 "" + } else if (*mtrdnp == 5) { +#line 24033 "" + s_wsfe(&io___1769); +/* Writing concatenation */ +#line 24033 "" + i__1[0] = 1, a__1[0] = sq; +#line 24033 "" + i__1[1] = 12, a__1[1] = "generalmeter"; +#line 24033 "" + i__1[2] = 1, a__1[2] = sq; +#line 24033 "" + i__1[3] = 10, a__1[3] = "allabreve%"; +#line 24033 "" + s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); +#line 24033 "" + do_fio(&c__1, ch__5, (ftnlen)24); +#line 24033 "" + e_wsfe(); +#line 24034 "" + } else if (*mtrdnp == 6) { +#line 24035 "" + s_wsfe(&io___1770); +/* Writing concatenation */ +#line 24035 "" + i__1[0] = 1, a__1[0] = sq; +#line 24035 "" + i__1[1] = 12, a__1[1] = "generalmeter"; +#line 24035 "" + i__1[2] = 1, a__1[2] = sq; +#line 24035 "" + i__1[3] = 7, a__1[3] = "meterC%"; +#line 24035 "" + s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21); +#line 24035 "" + do_fio(&c__1, ch__4, (ftnlen)21); +#line 24035 "" + e_wsfe(); +#line 24036 "" + } else if (*mtrdnp == 7) { +#line 24037 "" + s_wsfe(&io___1771); +/* Writing concatenation */ +#line 24037 "" + i__1[0] = 1, a__1[0] = sq; +#line 24037 "" + i__1[1] = 12, a__1[1] = "generalmeter"; +#line 24037 "" + i__1[2] = 1, a__1[2] = sq; +#line 24037 "" + i__1[3] = 10, a__1[3] = "meterIIIS%"; +#line 24037 "" + s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24); +#line 24037 "" + do_fio(&c__1, ch__5, (ftnlen)24); +#line 24037 "" + e_wsfe(); +#line 24038 "" + } +#line 24039 "" + return 0; +} /* wgmeter_ */ + +/* Subroutine */ int writemidi_(char *jobname, integer *ljob, ftnlen + jobname_len) +{ + /* Initialized data */ + + static shortint icmm[16] = { 0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16 }; + + /* System generated locals */ + address a__1[4], a__2[7], a__3[3], a__4[2], a__5[12]; + integer i__1[4], i__2, i__3[7], i__4[3], i__5[2], i__6, i__7[12], i__8, + i__9, i__10, i__11, i__12; + char ch__1[14], ch__2[1], ch__3[12], ch__4[1], ch__5[1], ch__6[46], ch__7[ + 27], ch__8[29], ch__9[15], ch__10[1], ch__11[4], ch__12[81], + ch__13[25]; + cllist cl__1; + + /* Builtin functions */ + integer s_wsfe(cilist *); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer do_fio(integer *, char *, ftnlen), e_wsfe(void), lbit_shift( + integer, integer), s_wsfi(icilist *), e_wsfi(void), f_clos(cllist + *); + + /* Local variables */ + static integer i__, kv, ib0, ib1, icm; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer isec, mend, ndata, ibyte; + static char byteq[1*4], instq[10], tempoq[10]; + extern /* Subroutine */ int printl_(char *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1773 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1774 = { 0, 52, 0, "(a6,10Z4)", 0 }; + static cilist io___1779 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1780 = { 0, 52, 0, "(a6,8z4)", 0 }; + static cilist io___1781 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1782 = { 0, 52, 0, "(a)", 0 }; + static cilist io___1783 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1784 = { 0, 52, 0, "(a)", 0 }; + static cilist io___1787 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1788 = { 0, 52, 0, "(z4)", 0 }; + static cilist io___1789 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1790 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1795 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1796 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 }; + static cilist io___1797 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1798 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1799 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1800 = { 0, 52, 0, "(a)", 0 }; + static icilist io___1802 = { 0, tempoq, 0, "(i2)", 10, 1 }; + static icilist io___1804 = { 0, instq, 0, "(i3)", 10, 1 }; + static cilist io___1805 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1806 = { 0, 52, 0, "(z4)", 0 }; + static cilist io___1807 = { 0, 51, 0, "(a,$)", 0 }; + static cilist io___1808 = { 0, 52, 0, "(4z4)", 0 }; + static cilist io___1809 = { 0, 6, 0, "(1x,a12,(10i6))", 0 }; + static cilist io___1810 = { 0, 15, 0, "(1x,a12,(10i6))", 0 }; + + + +/* Used to be icmm(0:nm); did midi fail when nv>16? */ + + +/* These are not consecutive because channel 9 is reserved for percussion. */ + + +/* Write Header */ + +#line 24092 "" + s_wsfe(&io___1773); +/* Writing concatenation */ +#line 24092 "" + i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000"; +#line 24092 "" + *(unsigned char *)&ch__2[0] = commidi_1.numchan + 1; +#line 24092 "" + i__1[1] = 1, a__1[1] = ch__2; +#line 24092 "" + i__1[2] = 1, a__1[2] = "\000"; +#line 24092 "" + i__1[3] = 1, a__1[3] = "\360"; +#line 24092 "" + s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14); +#line 24092 "" + do_fio(&c__1, ch__1, (ftnlen)14); +#line 24092 "" + e_wsfe(); +#line 24094 "" + if (commidi_1.debugmidi) { +#line 24094 "" + s_wsfe(&io___1774); +#line 24094 "" + do_fio(&c__1, "\"MThd\"", (ftnlen)6); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + i__2 = commidi_1.numchan + 1; +#line 24094 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24094 "" + do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer)); +#line 24094 "" + e_wsfe(); +#line 24094 "" + } + +/* Write the "conductor" track, for keys, meter, and tempos */ +/* Get the number of bytes in the conductor event stream */ + +#line 24101 "" + ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[ + commidi_1.numchan + commmac_1.nmidsec * 25 - 25]; +#line 24102 "" + i__2 = commmac_1.nmidsec - 1; +#line 24102 "" + for (isec = 1; isec <= i__2; ++isec) { +#line 24103 "" + ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 - + 25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; +#line 24104 "" +/* L15: */ +#line 24104 "" + } +/* ib1 = (4+ljob+26+ndata+4)/256 */ +/* ib0 = 4+ljob+26+ndata+4-256*ib1 */ +#line 24107 "" + ib1 = (*ljob + 31 + ndata + 4) / 256; +#line 24108 "" + ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8); +#line 24109 "" + s_wsfe(&io___1779); +/* Writing concatenation */ +#line 24109 "" + i__3[0] = 6, a__2[0] = "MTrk\000\000"; +#line 24109 "" + *(unsigned char *)&ch__2[0] = ib1; +#line 24109 "" + i__3[1] = 1, a__2[1] = ch__2; +#line 24109 "" + *(unsigned char *)&ch__4[0] = ib0; +#line 24109 "" + i__3[2] = 1, a__2[2] = ch__4; +#line 24109 "" + i__3[3] = 1, a__2[3] = "\000"; +#line 24109 "" + i__3[4] = 1, a__2[4] = "\377"; +#line 24109 "" + i__3[5] = 1, a__2[5] = "\001"; +#line 24109 "" + *(unsigned char *)&ch__5[0] = *ljob + 27; +#line 24109 "" + i__3[6] = 1, a__2[6] = ch__5; +#line 24109 "" + s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12); +#line 24109 "" + do_fio(&c__1, ch__3, (ftnlen)12); +#line 24109 "" + e_wsfe(); + +/* Text header */ + +/* * //char(0)//char(255)//char(1)//char(ljob+26) */ +#line 24115 "" + if (commidi_1.debugmidi) { +#line 24115 "" + s_wsfe(&io___1780); +#line 24115 "" + do_fio(&c__1, "\"MTrk\"", (ftnlen)6); +#line 24115 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 24115 "" + do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer)); +#line 24115 "" + i__2 = *ljob + 27; +#line 24115 "" + do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 24115 "" + e_wsfe(); +#line 24115 "" + } +#line 24118 "" + s_wsfe(&io___1781); +#line 24118 "" + do_fio(&c__1, jobname, (*ljob)); +#line 24118 "" + e_wsfe(); +#line 24119 "" + if (commidi_1.debugmidi) { +#line 24119 "" + s_wsfe(&io___1782); +/* Writing concatenation */ +#line 24119 "" + i__4[0] = 1, a__3[0] = "\""; +#line 24119 "" + i__4[1] = *ljob, a__3[1] = jobname; +#line 24119 "" + i__4[2] = 1, a__3[2] = "\""; +#line 24119 "" + s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46); +#line 24119 "" + do_fio(&c__1, ch__6, *ljob + 2); +#line 24119 "" + e_wsfe(); +#line 24119 "" + } + +/* (separate writes are needed to defeat compiler BUG!!!) */ + +/* write(51,'(a,$)')'.mid, produced by PMX 2.30' */ +#line 24124 "" + s_wsfe(&io___1783); +/* Writing concatenation */ +#line 24124 "" + i__5[0] = 22, a__4[0] = ".mid, produced by PMX "; +#line 24124 "" + i__5[1] = 5, a__4[1] = comver_1.versionc; +#line 24124 "" + s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27); +#line 24124 "" + do_fio(&c__1, ch__7, (ftnlen)27); +#line 24124 "" + e_wsfe(); +#line 24125 "" + if (commidi_1.debugmidi) { +#line 24125 "" + s_wsfe(&io___1784); +/* Writing concatenation */ +#line 24125 "" + i__4[0] = 23, a__3[0] = "\".mid, produced by PMX "; +#line 24125 "" + i__4[1] = 5, a__3[1] = comver_1.versionc; +#line 24125 "" + i__4[2] = 1, a__3[2] = "\""; +#line 24125 "" + s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29); +#line 24125 "" + do_fio(&c__1, ch__8, (ftnlen)29); +#line 24125 "" + e_wsfe(); +#line 24125 "" + } + +/* Conductor event data: Loop over sections. */ + +#line 24130 "" + i__2 = commmac_1.nmidsec; +#line 24130 "" + for (isec = 1; isec <= i__2; ++isec) { +#line 24131 "" + if (isec < commmac_1.nmidsec) { +#line 24132 "" + mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25]; +#line 24133 "" + } else { +#line 24134 "" + mend = commidi_1.imidi[commidi_1.numchan]; +#line 24135 "" + } +#line 24136 "" + i__6 = mend; +#line 24136 "" + for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25]; + i__ <= i__6; ++i__) { +#line 24137 "" + s_wsfe(&io___1787); +#line 24137 "" + *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[ + commidi_1.numchan + i__ * 25 - 25]; +#line 24137 "" + do_fio(&c__1, ch__2, (ftnlen)1); +#line 24137 "" + e_wsfe(); +#line 24138 "" + if (commidi_1.debugmidi) { +#line 24138 "" + s_wsfe(&io___1788); +#line 24138 "" + do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan + + i__ * 25 - 25], (ftnlen)sizeof(shortint)); +#line 24138 "" + e_wsfe(); +#line 24138 "" + } +#line 24139 "" +/* L17: */ +#line 24139 "" + } +#line 24140 "" +/* L16: */ +#line 24140 "" + } + +/* And close out the time sig / tempo track. */ + +#line 24144 "" + s_wsfe(&io___1789); +#line 24144 "" + do_fio(&c__1, "\000\377/\000", (ftnlen)4); +#line 24144 "" + e_wsfe(); +#line 24145 "" + if (commidi_1.debugmidi) { +#line 24145 "" + s_wsfe(&io___1790); +#line 24145 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24145 "" + do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 24145 "" + do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); +#line 24145 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24145 "" + e_wsfe(); +#line 24145 "" + } + +/* Loop over track for each voice: The following sets up iv. */ + +#line 24149 "" + all_1.iv = all_1.nv; +#line 24150 "" + if (commidi_1.twoline[all_1.nv - 1]) { +#line 24151 "" + kv = 2; +#line 24152 "" + } else { +#line 24153 "" + kv = 1; +#line 24154 "" + } + +/* 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 24175 "" + i__2 = commidi_1.numchan - 1; +#line 24175 "" + for (icm = 0; icm <= i__2; ++icm) { + +/* Get the number of bytes in the data stream */ + +#line 24179 "" + ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm + + commmac_1.nmidsec * 25 - 25]; +#line 24180 "" + i__6 = commmac_1.nmidsec - 1; +#line 24180 "" + for (isec = 1; isec <= i__6; ++isec) { +#line 24181 "" + ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] - + commmac_1.msecstrt[icm + isec * 25 - 25]; +#line 24182 "" +/* L11: */ +#line 24182 "" + } + +/* 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 24188 "" + ndata += 11; + +/* Add 4+lnam(iinsiv(iv)) if lnam>0 , */ + +#line 24192 "" + if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { +#line 24192 "" + ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] + - 1]; +#line 24192 "" + } + +/* Separate total byte counts into 4 bytes */ + +#line 24196 "" + for (ibyte = 1; ibyte <= 4; ++ibyte) { +#line 24197 "" + if (ndata > 0) { +#line 24198 "" + *(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256); +#line 24199 "" + ndata = lbit_shift(ndata, (ftnlen)-8); +#line 24200 "" + } else { +#line 24201 "" + *(unsigned char *)&byteq[ibyte - 1] = '\0'; +#line 24202 "" + } +#line 24203 "" +/* L2: */ +#line 24203 "" + } + +/* Now write front stuff for this track */ + +#line 24207 "" + s_wsfe(&io___1795); +/* Writing concatenation */ +#line 24207 "" + i__7[0] = 4, a__5[0] = "MTrk"; +#line 24207 "" + i__7[1] = 1, a__5[1] = byteq + 3; +#line 24207 "" + i__7[2] = 1, a__5[2] = byteq + 2; +#line 24207 "" + i__7[3] = 1, a__5[3] = byteq + 1; +#line 24207 "" + i__7[4] = 1, a__5[4] = byteq; +#line 24207 "" + i__7[5] = 1, a__5[5] = "\000"; +#line 24207 "" + *(unsigned char *)&ch__2[0] = icmm[icm] + 192; +#line 24207 "" + i__7[6] = 1, a__5[6] = ch__2; +#line 24207 "" + *(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[ + all_1.iv - 1] - 1]; +#line 24207 "" + i__7[7] = 1, a__5[7] = ch__4; +#line 24207 "" + i__7[8] = 1, a__5[8] = "\000"; +#line 24207 "" + *(unsigned char *)&ch__5[0] = icmm[icm] + 176; +#line 24207 "" + i__7[9] = 1, a__5[9] = ch__5; +#line 24207 "" + i__7[10] = 1, a__5[10] = "\n"; +#line 24207 "" + *(unsigned char *)&ch__10[0] = commvel_1.midbc[icm]; +#line 24207 "" + i__7[11] = 1, a__5[11] = ch__10; +#line 24207 "" + s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15); +#line 24207 "" + do_fio(&c__1, ch__9, (ftnlen)15); +#line 24207 "" + e_wsfe(); +/* * //char(0)//char(12*16+icmm(icm))//char(midinst(iv)) */ +#line 24211 "" + if (commidi_1.debugmidi) { +#line 24211 "" + s_wsfe(&io___1796); +#line 24211 "" + do_fio(&c__1, "icm=", (ftnlen)4); +#line 24211 "" + do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, " \"MTrk\"", (ftnlen)7); +#line 24211 "" + i__6 = *(unsigned char *)&byteq[3]; +#line 24211 "" + do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer)); +#line 24211 "" + i__8 = *(unsigned char *)&byteq[2]; +#line 24211 "" + do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer)); +#line 24211 "" + i__9 = *(unsigned char *)&byteq[1]; +#line 24211 "" + do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer)); +#line 24211 "" + i__10 = *(unsigned char *)&byteq[0]; +#line 24211 "" + do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24211 "" + i__11 = icmm[icm] + 192; +#line 24211 "" + do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[ + all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24211 "" + i__12 = icmm[icm] + 176; +#line 24211 "" + do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer)); +#line 24211 "" + do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof( + integer)); +#line 24211 "" + e_wsfe(); +#line 24211 "" + } +/* * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iv), */ +#line 24216 "" + if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) { + +/* Add instrument name as sequence name */ + +#line 24220 "" + s_wsfe(&io___1797); +/* Writing concatenation */ +#line 24220 "" + i__5[0] = 3, a__4[0] = "\000\377\003"; +#line 24220 "" + *(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[ + all_1.iv - 1] - 1]; +#line 24220 "" + i__5[1] = 1, a__4[1] = ch__2; +#line 24220 "" + s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4); +#line 24220 "" + do_fio(&c__1, ch__11, (ftnlen)4); +#line 24220 "" + e_wsfe(); +#line 24222 "" + if (commidi_1.debugmidi) { +#line 24222 "" + s_wsfe(&io___1798); +#line 24222 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24222 "" + do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 24222 "" + do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer)); +#line 24222 "" + do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[ + all_1.iv - 1] - 1], (ftnlen)sizeof(integer)); +#line 24222 "" + e_wsfe(); +#line 24222 "" + } +#line 24223 "" + s_wsfe(&io___1799); +#line 24223 "" + 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 24223 "" + e_wsfe(); +#line 24225 "" + if (commidi_1.debugmidi) { +#line 24225 "" + s_wsfe(&io___1800); +/* Writing concatenation */ +#line 24225 "" + i__4[0] = 1, a__3[0] = "\""; +#line 24225 "" + 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 24225 "" + i__4[2] = 1, a__3[2] = "\""; +#line 24225 "" + s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81); +#line 24225 "" + do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv + - 1] - 1] + 2); +#line 24225 "" + e_wsfe(); +#line 24225 "" + } +#line 24227 "" + } +#line 24228 "" + s_wsfi(&io___1802); +#line 24228 "" + do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); +#line 24228 "" + e_wsfi(); +#line 24229 "" + s_wsfi(&io___1804); +#line 24229 "" + do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv - + 1] - 1], (ftnlen)sizeof(integer)); +#line 24229 "" + e_wsfi(); +/* Writing concatenation */ +#line 24230 "" + i__1[0] = 16, a__1[0] = "MIDI instrument "; +#line 24230 "" + i__1[1] = 2, a__1[1] = tempoq; +#line 24230 "" + i__1[2] = 4, a__1[2] = " is "; +#line 24230 "" + i__1[3] = 3, a__1[3] = instq; +#line 24230 "" + s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25); +#line 24230 "" + printl_(ch__13, (ftnlen)25); + +/* Notes: Loop over sections. */ + +#line 24234 "" + i__6 = commmac_1.nmidsec; +#line 24234 "" + for (isec = 1; isec <= i__6; ++isec) { +#line 24235 "" + if (isec < commmac_1.nmidsec) { +#line 24236 "" + mend = commmac_1.msecend[icm + isec * 25 - 25]; +#line 24237 "" + } else { +#line 24238 "" + mend = commidi_1.imidi[icm]; +#line 24239 "" + } +#line 24240 "" + i__8 = mend; +#line 24240 "" + for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8; + ++i__) { +#line 24241 "" + s_wsfe(&io___1805); +#line 24241 "" + *(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm + + i__ * 25 - 25]; +#line 24241 "" + do_fio(&c__1, ch__2, (ftnlen)1); +#line 24241 "" + e_wsfe(); +#line 24242 "" + if (commidi_1.debugmidi) { +#line 24242 "" + s_wsfe(&io___1806); +#line 24242 "" + do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 - + 25], (ftnlen)sizeof(shortint)); +#line 24242 "" + e_wsfe(); +#line 24242 "" + } +#line 24243 "" +/* L10: */ +#line 24243 "" + } +#line 24244 "" +/* L9: */ +#line 24244 "" + } + +/* Closing 4 bytes */ + +#line 24248 "" + s_wsfe(&io___1807); +/* Writing concatenation */ +#line 24248 "" + chax_(ch__2, (ftnlen)1, &c__0); +#line 24248 "" + i__1[0] = 1, a__1[0] = ch__2; +#line 24248 "" + i__1[1] = 1, a__1[1] = "\377"; +#line 24248 "" + i__1[2] = 1, a__1[2] = "/"; +#line 24248 "" + i__1[3] = 1, a__1[3] = "\000"; +#line 24248 "" + s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4); +#line 24248 "" + do_fio(&c__1, ch__11, (ftnlen)4); +#line 24248 "" + e_wsfe(); +#line 24249 "" + if (commidi_1.debugmidi) { +#line 24249 "" + s_wsfe(&io___1808); +#line 24249 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24249 "" + do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer)); +#line 24249 "" + do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer)); +#line 24249 "" + do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); +#line 24249 "" + e_wsfe(); +#line 24249 "" + } +#line 24250 "" + if (kv == 2) { +#line 24251 "" + kv = 1; +#line 24252 "" + } else if (all_1.iv == 1) { +#line 24253 "" + goto L5; +#line 24254 "" + } else { +#line 24255 "" + --all_1.iv; +#line 24256 "" + if (commidi_1.twoline[all_1.iv - 1]) { +#line 24256 "" + kv = 2; +#line 24256 "" + } +#line 24257 "" + } +#line 24258 "" +L5: +#line 24258 "" + ; +#line 24258 "" + } +#line 24259 "" + s_wsfe(&io___1809); +#line 24259 "" + do_fio(&c__1, "Bytes used:", (ftnlen)11); +#line 24259 "" + i__2 = commidi_1.numchan; +#line 24259 "" + for (icm = 0; icm <= i__2; ++icm) { +#line 24259 "" + do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); +#line 24259 "" + } +#line 24259 "" + e_wsfe(); +#line 24260 "" + s_wsfe(&io___1810); +#line 24260 "" + do_fio(&c__1, "Bytes used:", (ftnlen)11); +#line 24260 "" + i__2 = commidi_1.numchan; +#line 24260 "" + for (icm = 0; icm <= i__2; ++icm) { +#line 24260 "" + do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer)); +#line 24260 "" + } +#line 24260 "" + e_wsfe(); +#line 24262 "" + cl__1.cerr = 0; +#line 24262 "" + cl__1.cunit = 51; +#line 24262 "" + cl__1.csta = 0; +#line 24262 "" + f_clos(&cl__1); +#line 24263 "" + if (commidi_1.debugmidi) { +#line 24263 "" + cl__1.cerr = 0; +#line 24263 "" + cl__1.cunit = 52; +#line 24263 "" + cl__1.csta = 0; +#line 24263 "" + f_clos(&cl__1); +#line 24263 "" + } +#line 24264 "" + return 0; +} /* writemidi_ */ + +/* Subroutine */ int writesetsign_(integer *ninsttrans, integer *iinsttrans, + integer *itranskey, logical *flag__) +{ + /* System generated locals */ + address a__1[2]; + integer i__1, i__2[2], i__3; + char ch__1[1], ch__2[80]; + icilist ici__1; + + /* Builtin functions */ + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + static integer i__; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer lnote; + static char notexq[79]; + + /* Fortran I/O blocks */ + static cilist io___1814 = { 0, 11, 0, "(a)", 0 }; + + + +/* Assumes notexq is blank */ + +#line 24275 "" + /* Parameter adjustments */ +#line 24275 "" + --itranskey; +#line 24275 "" + --iinsttrans; +#line 24275 "" + +#line 24275 "" + /* Function Body */ +#line 24275 "" + i__1 = *ninsttrans; +#line 24275 "" + for (i__ = 1; i__ <= i__1; ++i__) { +/* Writing concatenation */ +#line 24276 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 24276 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 24276 "" + i__2[1] = 7, a__1[1] = "setsign"; +#line 24276 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 24277 "" + lnote = 8; +#line 24278 "" + if (iinsttrans[i__] < 10) { +/* Writing concatenation */ +#line 24279 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 24279 "" + i__3 = iinsttrans[i__] + 48; +#line 24279 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 24279 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 24279 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 24280 "" + ++lnote; +#line 24281 "" + } else { +#line 24282 "" + i__3 = lnote; +#line 24282 "" + ici__1.icierr = 0; +#line 24282 "" + ici__1.icirnum = 1; +#line 24282 "" + ici__1.icirlen = lnote + 4 - i__3; +#line 24282 "" + ici__1.iciunit = notexq + i__3; +#line 24282 "" + ici__1.icifmt = "(a1,i2,a1)"; +#line 24282 "" + s_wsfi(&ici__1); +#line 24282 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 24282 "" + do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer)); +#line 24282 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 24282 "" + e_wsfi(); +#line 24284 "" + lnote += 4; +#line 24285 "" + } +#line 24286 "" + if (itranskey[i__] < 0) { +#line 24287 "" + i__3 = lnote; +#line 24287 "" + ici__1.icierr = 0; +#line 24287 "" + ici__1.icirnum = 1; +#line 24287 "" + ici__1.icirlen = lnote + 4 - i__3; +#line 24287 "" + ici__1.iciunit = notexq + i__3; +#line 24287 "" + ici__1.icifmt = "(a1,i2,a1)"; +#line 24287 "" + s_wsfi(&ici__1); +#line 24287 "" + do_fio(&c__1, "{", (ftnlen)1); +#line 24287 "" + do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer)); +#line 24287 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 24287 "" + e_wsfi(); +#line 24289 "" + lnote += 4; +#line 24290 "" + } else { +/* Writing concatenation */ +#line 24291 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 24291 "" + i__3 = itranskey[i__] + 48; +#line 24291 "" + chax_(ch__1, (ftnlen)1, &i__3); +#line 24291 "" + i__2[1] = 1, a__1[1] = ch__1; +#line 24291 "" + s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 24292 "" + ++lnote; +#line 24293 "" + } +#line 24294 "" + s_wsfe(&io___1814); +/* Writing concatenation */ +#line 24294 "" + i__2[0] = lnote, a__1[0] = notexq; +#line 24294 "" + i__2[1] = 1, a__1[1] = "%"; +#line 24294 "" + s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80); +#line 24294 "" + do_fio(&c__1, ch__2, lnote + 1); +#line 24294 "" + e_wsfe(); +#line 24295 "" +/* L1: */ +#line 24295 "" + } +#line 24296 "" + *flag__ = FALSE_; +#line 24297 "" + return 0; +} /* writesetsign_ */ + +/* Subroutine */ int writflot_(real *x, char *notexq, integer *lenline, + ftnlen notexq_len) +{ + /* System generated locals */ + integer i__1; + icilist ici__1; + + /* Builtin functions */ + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + ; + +#line 24301 "" + if (*x < .95f) { +#line 24302 "" + i__1 = *lenline; +#line 24302 "" + ici__1.icierr = 0; +#line 24302 "" + ici__1.icirnum = 1; +#line 24302 "" + ici__1.icirlen = *lenline + 2 - i__1; +#line 24302 "" + ici__1.iciunit = notexq + i__1; +#line 24302 "" + ici__1.icifmt = "(f2.1)"; +#line 24302 "" + s_wsfi(&ici__1); +#line 24302 "" + do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 24302 "" + e_wsfi(); +#line 24303 "" + *lenline += 2; +#line 24304 "" + } else if (*x < 9.95f) { +#line 24305 "" + i__1 = *lenline; +#line 24305 "" + ici__1.icierr = 0; +#line 24305 "" + ici__1.icirnum = 1; +#line 24305 "" + ici__1.icirlen = *lenline + 3 - i__1; +#line 24305 "" + ici__1.iciunit = notexq + i__1; +#line 24305 "" + ici__1.icifmt = "(f3.1)"; +#line 24305 "" + s_wsfi(&ici__1); +#line 24305 "" + do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 24305 "" + e_wsfi(); +#line 24306 "" + *lenline += 3; +#line 24307 "" + } else { +#line 24308 "" + i__1 = *lenline; +#line 24308 "" + ici__1.icierr = 0; +#line 24308 "" + ici__1.icirnum = 1; +#line 24308 "" + ici__1.icirlen = *lenline + 4 - i__1; +#line 24308 "" + ici__1.iciunit = notexq + i__1; +#line 24308 "" + ici__1.icifmt = "(f4.1)"; +#line 24308 "" + s_wsfi(&ici__1); +#line 24308 "" + do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real)); +#line 24308 "" + e_wsfi(); +#line 24309 "" + *lenline += 4; +#line 24310 "" + } +#line 24311 "" + return 0; +} /* writflot_ */ + +/* Subroutine */ int wsclef_(integer *iv, integer *ninow, integer *nclef) +{ + /* System generated locals */ + address a__1[3], a__2[2]; + integer i__1, i__2[3], i__3[2], i__4; + char ch__1[1], ch__2[1], ch__3[9], ch__4[22]; + + /* Builtin functions */ + integer s_wsle(cilist *), e_wsle(void), do_lio(integer *, integer *, char + *, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); + integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) + , s_wsfe(cilist *), e_wsfe(void); + + /* Local variables */ + static integer iv1, iv2, iiv; + extern /* Character */ VOID chax_(char *, ftnlen, integer *); + static integer ltem; + static char temq[20]; + extern /* Subroutine */ int stop1_(void); + static integer iinst; + extern integer numclef_(char *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1817 = { 0, 6, 0, 0, 0 }; + static cilist io___1818 = { 0, 6, 0, 0, 0 }; + static icilist io___1822 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 }; + static cilist io___1823 = { 0, 11, 0, "(a)", 0 }; + static cilist io___1825 = { 0, 11, 0, "(a)", 0 }; + + +/* subroutine wsclef(iv,ninow,clefq,nclef) */ + +/* Writes \setclef for instrument containing *staff* iv */ + + +/* In pmx271, had removed clefq, so with 2 or more staves in */ +/* an instrument, had problems. So replace in 272 */ + +#line 24330 "" + if (*nclef < 7) { +#line 24331 "" + i__1 = *nclef + 48; +#line 24331 "" + chax_(ch__1, (ftnlen)1, &i__1); +#line 24331 "" + *(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)& + ch__1[0]; +#line 24332 "" + } else { +#line 24333 "" + *(unsigned char *)&comclefq_1.clefq[*iv - 1] = '9'; +#line 24334 "" + } +#line 24335 "" + if (! comlast_1.islast) { +#line 24335 "" + return 0; +#line 24335 "" + } +#line 24336 "" + iv1 = 1; +#line 24337 "" + i__1 = *ninow; +#line 24337 "" + for (iinst = 1; iinst <= i__1; ++iinst) { +#line 24338 "" + if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) { +#line 24338 "" + goto L2; +#line 24338 "" + } +#line 24339 "" + iv1 += comnvi_1.nspern[iinst - 1]; +#line 24340 "" +/* L1: */ +#line 24340 "" + } +#line 24341 "" + s_wsle(&io___1817); +#line 24341 "" + e_wsle(); +#line 24342 "" + s_wsle(&io___1818); +#line 24342 "" + do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29); +#line 24342 "" + e_wsle(); +#line 24343 "" + stop1_(); +#line 24344 "" +L2: + +/* Here, iinst is the instrument number with staff of clef change */ + +#line 24348 "" + iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1; +#line 24349 "" + if (iinst < 10) { +/* Writing concatenation */ +#line 24350 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 24350 "" + i__2[0] = 1, a__1[0] = ch__1; +#line 24350 "" + i__2[1] = 7, a__1[1] = "setclef"; +#line 24350 "" + i__1 = iinst + 48; +#line 24350 "" + chax_(ch__2, (ftnlen)1, &i__1); +#line 24350 "" + i__2[2] = 1, a__1[2] = ch__2; +#line 24350 "" + s_cat(temq, a__1, i__2, &c__3, (ftnlen)20); +#line 24351 "" + ltem = 9; +#line 24352 "" + } else { +#line 24353 "" + s_wsfi(&io___1822); +/* Writing concatenation */ +#line 24353 "" + chax_(ch__1, (ftnlen)1, &c__92); +#line 24353 "" + i__3[0] = 1, a__2[0] = ch__1; +#line 24353 "" + i__3[1] = 8, a__2[1] = "setclef{"; +#line 24353 "" + s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9); +#line 24353 "" + do_fio(&c__1, ch__3, (ftnlen)9); +#line 24353 "" + do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer)); +#line 24353 "" + do_fio(&c__1, "}", (ftnlen)1); +#line 24353 "" + e_wsfi(); +#line 24354 "" + ltem = 12; +#line 24355 "" + } +#line 24356 "" + if (iv1 == iv2) { + +/* Only one staff (iv) in instrument with clef change */ + +#line 24360 "" + s_wsfe(&io___1823); +/* Writing concatenation */ +#line 24360 "" + i__2[0] = ltem, a__1[0] = temq; +#line 24360 "" + i__2[1] = 1, a__1[1] = comclefq_1.clefq + (*iv - 1); +#line 24360 "" + i__2[2] = 1, a__1[2] = "%"; +#line 24360 "" + s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)22); +#line 24360 "" + do_fio(&c__1, ch__4, ltem + 2); +#line 24360 "" + e_wsfe(); +#line 24361 "" + } else { +/* Writing concatenation */ +#line 24362 "" + i__3[0] = ltem, a__2[0] = temq; +#line 24362 "" + i__3[1] = 1, a__2[1] = "{"; +#line 24362 "" + s_cat(temq, a__2, i__3, &c__2, (ftnlen)20); +#line 24363 "" + ++ltem; + +/* Loop over staves, but clefq has only changed for one of them */ + +#line 24367 "" + i__1 = iv2; +#line 24367 "" + for (iiv = iv1; iiv <= i__1; ++iiv) { +/* Writing concatenation */ +#line 24368 "" + i__3[0] = ltem, a__2[0] = temq; +#line 24368 "" + i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (ftnlen)1) + 48; +#line 24368 "" + chax_(ch__1, (ftnlen)1, &i__4); +#line 24368 "" + i__3[1] = 1, a__2[1] = ch__1; +#line 24368 "" + s_cat(temq, a__2, i__3, &c__2, (ftnlen)20); +#line 24369 "" + ++ltem; +#line 24370 "" +/* L3: */ +#line 24370 "" + } +#line 24371 "" + s_wsfe(&io___1825); +/* Writing concatenation */ +#line 24371 "" + i__3[0] = ltem, a__2[0] = temq; +#line 24371 "" + i__3[1] = 2, a__2[1] = "}%"; +#line 24371 "" + s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)22); +#line 24371 "" + do_fio(&c__1, ch__4, ltem + 2); +#line 24371 "" + e_wsfe(); +#line 24372 "" + } +#line 24373 "" + return 0; +} /* wsclef_ */ + +/* Subroutine */ int chkpmxlyr_(char *lineq, integer *iccount, integer * + lyrerr, ftnlen lineq_len) +{ + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static char charq[1]; + extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen, + ftnlen); + +#line 24378 "" + *lyrerr = 0; + +/* On entry, last char was " */ + +#line 24382 "" +L18: +#line 24382 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 24383 "" + if (*iccount == 121) { +#line 24384 "" + *lyrerr = 2; +#line 24385 "" + return 0; +#line 24386 "" + } else if (*(unsigned char *)charq == '"') { +#line 24387 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); + +/* Check for raise/lower command */ + +#line 24391 "" + if (*(unsigned char *)charq == '@') { + +/* @ positions lyrics vertically for current voice */ +/* [a,b] above or below of the staff */ +/* +/- i offset, \internotes */ + +#line 24397 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 24398 "" + if (i_indx("ab", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 24399 "" + *lyrerr = 3; +#line 24400 "" + return 0; +#line 24401 "" + } +#line 24402 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 24403 "" + if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) == 0) { +#line 24404 "" + *lyrerr = 4; +#line 24405 "" + return 0; +#line 24406 "" + } +#line 24407 "" + g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1); +#line 24408 "" + if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) { +#line 24409 "" + *lyrerr = 5; +#line 24410 "" + return 0; +#line 24411 "" + } +#line 24412 "" + } else if (*(unsigned char *)charq != ' ') { + +/* 2nd " must be followed by ' ' */ + +#line 24416 "" + *lyrerr = 1; +#line 24417 "" + return 0; +#line 24418 "" + } +#line 24419 "" + return 0; +#line 24420 "" + } +#line 24421 "" + 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]; + + /* Builtin functions */ + integer i_indx(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), do_lio( + integer *, integer *, char *, ftnlen), e_wsle(void), s_cmp(char *, + char *, ftnlen, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), + s_copy(char *, char *, ftnlen, ftnlen); + + /* Local variables */ + static integer i2nd, iend; + extern /* Subroutine */ int stop1_(void); + static integer itilde; + static char lineqt[128]; + static integer istart; + extern integer lenstr_(char *, integer *, ftnlen); + + /* Fortran I/O blocks */ + static cilist io___1832 = { 0, 6, 0, 0, 0 }; + + + +/* lineq has " at iccount. Find end of lyrics string, replace "..." */ +/* with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', */ +/* (unless preceded with '\'), check length */ + +#line 24432 "" + iend = lenstr_(lineq, &c__128, (ftnlen)128); +#line 24433 "" + i__1 = *iccount; +#line 24433 "" + i2nd = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1); +#line 24434 "" + istart = *iccount; +#line 24435 "" +L1: +#line 24435 "" + i__1 = istart; +#line 24435 "" + itilde = istart + i_indx(lineq + i__1, "~", i2nd - 1 - i__1, (ftnlen)1); +#line 24436 "" + if (itilde > istart && itilde < i2nd) { + +/* Replace tilde if not preceded by \ */ + +#line 24440 "" + if (iend >= 117) { +#line 24441 "" + s_wsle(&io___1832); +#line 24441 "" + do_lio(&c__9, &c__1, "Sorry, lyric string is too long, stopping", + (ftnlen)41); +#line 24441 "" + e_wsle(); +#line 24442 "" + stop1_(); +#line 24443 "" + } else /* if(complicated condition) */ { +#line 24443 "" + i__1 = itilde - 2; +#line 24443 "" + if (s_cmp(lineq + i__1, sq, itilde - 1 - i__1, (ftnlen)1) == 0) { +#line 24444 "" + istart = itilde; +#line 24445 "" + goto L1; +#line 24446 "" + } +#line 24446 "" + } +#line 24447 "" + i__1 = itilde; +/* Writing concatenation */ +#line 24447 "" + i__2[0] = itilde - 1, a__1[0] = lineq; +#line 24447 "" + i__2[1] = 1, a__1[1] = sq; +#line 24447 "" + i__2[2] = 3, a__1[2] = "lk "; +#line 24447 "" + i__2[3] = iend - i__1, a__1[3] = lineq + i__1; +#line 24447 "" + s_cat(lineqt, a__1, i__2, &c__4, (ftnlen)128); +#line 24449 "" + iend = lenstr_(lineqt, &c__128, (ftnlen)128); +#line 24450 "" + i2nd += 3; +#line 24451 "" + s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 24452 "" + goto L1; +#line 24453 "" + } +#line 24454 "" + if (*iccount == 1) { +#line 24455 "" + i__1 = i2nd; +/* Writing concatenation */ +#line 24455 "" + i__3[0] = 1, a__2[0] = sq; +#line 24455 "" + i__3[1] = 7, a__2[1] = "pmxlyr{"; +#line 24455 "" + i__3[2] = i2nd - 2, a__2[2] = lineq + 1; +#line 24455 "" + i__3[3] = 1, a__2[3] = "}"; +#line 24455 "" + i__3[4] = 1, a__2[4] = sq; +#line 24455 "" + i__3[5] = 128 - i__1, a__2[5] = lineq + i__1; +#line 24455 "" + s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); +#line 24457 "" + } else { +#line 24458 "" + i__1 = *iccount; +#line 24458 "" + i__4 = i2nd; +/* Writing concatenation */ +#line 24458 "" + i__5[0] = *iccount - 1, a__3[0] = lineq; +#line 24458 "" + i__5[1] = 1, a__3[1] = sq; +#line 24458 "" + i__5[2] = 7, a__3[2] = "pmxlyr{"; +#line 24458 "" + i__5[3] = i2nd - 1 - i__1, a__3[3] = lineq + i__1; +#line 24458 "" + i__5[4] = 1, a__3[4] = "}"; +#line 24458 "" + i__5[5] = 1, a__3[5] = sq; +#line 24458 "" + i__5[6] = 128 - i__4, a__3[6] = lineq + i__4; +#line 24458 "" + s_cat(lineqt, a__3, i__5, &c__7, (ftnlen)128); +#line 24461 "" + } +#line 24462 "" + i2nd += 8; +#line 24463 "" + s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 24464 "" + i__1 = i2nd; +#line 24464 "" + if (s_cmp(lineq + i__1, "@", i2nd + 1 - i__1, (ftnlen)1) == 0) { +#line 24465 "" + i__1 = i2nd + 1; +#line 24465 "" + i__4 = i2nd + 4; +/* Writing concatenation */ +#line 24465 "" + i__3[0] = i2nd, a__2[0] = lineq; +#line 24465 "" + i__3[1] = 3, a__2[1] = "at{"; +#line 24465 "" + i__3[2] = i2nd + 4 - i__1, a__2[2] = lineq + i__1; +#line 24465 "" + i__3[3] = 1, a__2[3] = "}"; +#line 24465 "" + i__3[4] = 1, a__2[4] = sq; +#line 24465 "" + i__3[5] = 128 - i__4, a__2[5] = lineq + i__4; +#line 24465 "" + s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128); +#line 24467 "" + s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128); +#line 24468 "" + } +#line 24469 "" + return 0; +} /* dopmxlyr_ */ + +/* Main program alias */ int pmxab_ () { MAIN__ (); return 0; } |