#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 . */ /* 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 / */ /* 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 "/" 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 \"/\"", (ftnlen)39); #line 1001 "" e_wsle(); #line 1002 "" s_wsle(&io___40); #line 1002 "" do_lio(&c__9, &c__1, "Removing last line of \"/\"", (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= 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 /", (ftnlen)18); #line 7563 "" e_wsle(); #line 7564 "" s_wsle(&io___590); #line 7564 "" do_lio(&c__9, &c__1, "appending /", (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. */ /* <>???? */ /* 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 */ #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 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; }