diff options
-rw-r--r-- | Build/source/texk/README | 2 | ||||
-rw-r--r-- | Build/source/utils/README | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog | 11 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-common | 81 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-ptr-to-int | 16 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/Makefile.am | 4 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 | 142 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/PATCH-scor2prt.for-1 | 182 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc | 23 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c | 6 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h | 4 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/pmx270.for | 218 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig | 218 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/pmxab.c | 56 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/scor2prt.c | 12 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-2.7.0/scor2prt.for | 24 |
16 files changed, 643 insertions, 358 deletions
diff --git a/Build/source/texk/README b/Build/source/texk/README index ea7155c5fae..b03c5d092a3 100644 --- a/Build/source/texk/README +++ b/Build/source/texk/README @@ -89,8 +89,6 @@ ptexenc - maintained here, by us (akira et al.) seetexk - ? -tetex - scripts maintained here, by us - tex4htk - checked 25apr11 http://tug.org/tex4ht/ diff --git a/Build/source/utils/README b/Build/source/utils/README index 8662e3b3306..79ee6ed6f4d 100644 --- a/Build/source/utils/README +++ b/Build/source/utils/README @@ -12,7 +12,7 @@ asymptote 2.31 - checked 17may14 m-tx 0.60d - checked 16apr12 http://mirror.ctan.org/support/m-tx/ -pmx 2.7.0 - checked 11apr13 +pmx 2.7.0 - checked 25nov14 http://mirror.ctan.org/support/pmx/ ps2eps 1.68 - checked 10may12 diff --git a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog b/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog index c3f90e96932..4faa12f492d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog +++ b/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog @@ -1,3 +1,14 @@ +2013-11-25 Peter Breitenlohner <peb@mppmu.mpg.de> + + Updated pmx-2.7.0 source tree from a modifies version of + pmx-2.7.0.tar.gz (dated 2014-11-22) again from: + http://www.ctan.org/tex-archive/support/pmx/ + + * patch-01-common (removed): Now included upstream. + + * patch-01-ptr-to-int (new): Avoid cast from pointer to integer + of different size. + 2013-04-12 Peter Breitenlohner <peb@mppmu.mpg.de> * patch-01-common: Make sure f2c can convert pmx270.for, i.e., diff --git a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-common b/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-common deleted file mode 100644 index 54614abae3a..00000000000 --- a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-common +++ /dev/null @@ -1,81 +0,0 @@ -diff -ur pmx-2.7.0.orig/pmx270.for pmx-2.7.0/pmx270.for ---- pmx-2.7.0.orig/pmx270.for 2013-04-03 09:02:49.000000000 +0200 -+++ pmx-2.7.0/pmx270.for 2013-04-12 08:47:44.000000000 +0200 -@@ -10904,7 +10904,7 @@ - end if - go to 1 - end -- subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars, -+ subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars, - * lenbar, - c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, - * mtrdenl,first) -@@ -10933,7 +10933,7 @@ - * debugmidi - logical debugmidi - common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) -- * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm) -+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) - integer*2 iinsiv - character*1 durq - character*2 instq -@@ -11010,7 +11010,7 @@ - c Instrument numbers or letters. Expect noinst of them. - c - c do 2 ivx = 1 , nv -- do 2 ivx = 1 , noinst -+ do 2 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (ichar(durq) .gt. 96) then - c -@@ -11055,7 +11055,7 @@ - c Follow same pattern as for insttrument numbers above. - c - c do 7 ivx = 1 , nv -- do 7 ivx = 1 , noinst -+ do 7 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -@@ -11078,7 +11078,7 @@ - c Follow same pattern as for instrument numbers above. - c - c do 8 ivx = 1 , nv -- do 8 ivx = 1 , noinst -+ do 8 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - if (index('123456789',durq) .eq. 0) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, -@@ -11101,7 +11101,7 @@ - c Follow similar pattern as above, but separator is +|-. - c - c do 9 ivx = 1 , nv -- do 9 ivx = 1 , noinst -+ do 9 ivx = 1 , noinstarg - call getchar(lineq,iccount,durq) - ipm = index('-+',durq) - if (ipm .eq. 0) then -diff -ur pmx-2.7.0.orig/scor2prt.c pmx-2.7.0/scor2prt.c ---- pmx-2.7.0.orig/scor2prt.c 2013-04-03 08:54:13.000000000 +0200 -+++ pmx-2.7.0/scor2prt.c 2013-04-11 08:47:42.000000000 +0200 -@@ -25,7 +25,7 @@ - integer noinow, iorig[24], noinst; - logical insetup, replacing; - integer instnum[24]; -- real botv[24]; -+ logical botv[24]; - integer nvi[24], nsyst, nvnow; - }; - -diff -ur pmx-2.7.0.orig/scor2prt.for pmx-2.7.0/scor2prt.for ---- pmx-2.7.0.orig/scor2prt.for 2013-04-03 08:48:23.000000000 +0200 -+++ pmx-2.7.0/scor2prt.for 2013-04-11 08:40:28.000000000 +0200 -@@ -1482,7 +1482,7 @@ - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - character*128 line -- logical insetup,replacing -+ logical insetup,replacing,botv - iccount = 0 - do 1 iset = 1 , 12 - call partnum(iv,iccount,line,xdata) diff --git a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-ptr-to-int b/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-ptr-to-int new file mode 100644 index 00000000000..b2662315f34 --- /dev/null +++ b/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-ptr-to-int @@ -0,0 +1,16 @@ +diff -ur pmx-2.7.0.orig/libf2c/signal_.c pmx-2.7.0/libf2c/signal_.c +--- pmx-2.7.0.orig/libf2c/signal_.c 2013-03-12 18:54:34.000000000 +0100 ++++ pmx-2.7.0/libf2c/signal_.c 2014-11-25 09:31:31.000000000 +0100 +@@ -14,7 +14,11 @@ + int sig; + sig = (int)*sigp; + +- return (ftnint)signal(sig, proc); ++#ifdef _WIN64 ++ return (ftnint)(__int64)signal(sig, proc); ++#else ++ return (ftnint)(long)signal(sig, proc); ++#endif + } + #ifdef __cplusplus + } diff --git a/Build/source/utils/pmx/pmx-2.7.0/Makefile.am b/Build/source/utils/pmx/pmx-2.7.0/Makefile.am index 263823f6786..e1a0d8b9e19 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/Makefile.am +++ b/Build/source/utils/pmx/pmx-2.7.0/Makefile.am @@ -230,7 +230,9 @@ TESTS_ENVIRONMENT = test_src=$(srcdir)/tests EXTRA_DIST = $(TESTS) PATCHES = libf2c/patch-01-binary libf2c/patch-03-DOS-line-endings \ - libf2c/patch-04-MSVC-complex libf2c/patch-05-FreeBSD-off_t libf2c/patch-06-WIN32 + libf2c/patch-04-MSVC-complex libf2c/patch-05-FreeBSD-off_t libf2c/patch-06-WIN32 \ + libf2c/patch-07-MuslLibc \ + PATCH-pmx270.for-1 PATCH-scor2prt.for-1 ## pmx.test EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \ tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx diff --git a/Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 b/Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 new file mode 100644 index 00000000000..332ef603ee2 --- /dev/null +++ b/Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 @@ -0,0 +1,142 @@ +*** pmx270.for.orig 2013-04-11 12:02:15.467193491 -0400 +--- pmx270.for 2013-04-11 12:24:50.120527593 -0400 +*************** +*** 780,787 **** + read(*,'(a)')jobname + numargs = 1 + else +! call getarg(1,jobname,idum) ! May need to replace this w/ next line +! c call getarg(1,jobname) + end if + 10 ljob = lenstr(jobname,44) + if (ljob .gt. 44) then +--- 780,787 ---- + read(*,'(a)')jobname + numargs = 1 + else +! c call getarg(1,jobname,idum) ! May need to replace this w/ next line +! call getarg(1,jobname) + end if + 10 ljob = lenstr(jobname,44) + if (ljob .gt. 44) then +*************** +*** 793,800 **** + else if (numargs .eq. 2) then + if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then + optimize = .true. +! call getarg(2,jobname,idum) ! May need to replace this w/ next line +! c call getarg(2,jobname) + numargs = 1 + go to 10 + else +--- 793,800 ---- + else if (numargs .eq. 2) then + if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then + optimize = .true. +! c call getarg(2,jobname,idum) ! May need to replace this w/ next line +! call getarg(2,jobname) + numargs = 1 + go to 10 + else +*************** +*** 10904,10910 **** + end if + go to 1 + end +! subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars, + * lenbar, + c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, + * mtrdenl,first) +--- 10904,10910 ---- + end if + go to 1 + end +! subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars, + * lenbar, + c subroutine getmidi(nv,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar, + * mtrdenl,first) +*************** +*** 10933,10939 **** + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) +! * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm) + integer*2 iinsiv + character*1 durq + character*2 instq +--- 10933,10939 ---- + * debugmidi + logical debugmidi + common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) +! * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) + integer*2 iinsiv + character*1 durq + character*2 instq +*************** +*** 11010,11016 **** + c Instrument numbers or letters. Expect noinst of them. + c + c do 2 ivx = 1 , nv +! do 2 ivx = 1 , noinst + call getchar(lineq,iccount,durq) + if (ichar(durq) .gt. 96) then + c +--- 11010,11016 ---- + c Instrument numbers or letters. Expect noinst of them. + c + c do 2 ivx = 1 , nv +! do 2 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (ichar(durq) .gt. 96) then + c +*************** +*** 11055,11061 **** + c Follow same pattern as for insttrument numbers above. + c + c do 7 ivx = 1 , nv +! do 7 ivx = 1 , noinst + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +--- 11055,11061 ---- + c Follow same pattern as for insttrument numbers above. + c + c do 7 ivx = 1 , nv +! do 7 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +*************** +*** 11078,11084 **** + c Follow same pattern as for instrument numbers above. + c + c do 8 ivx = 1 , nv +! do 8 ivx = 1 , noinst + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +--- 11078,11084 ---- + c Follow same pattern as for instrument numbers above. + c + c do 8 ivx = 1 , nv +! do 8 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + if (index('123456789',durq) .eq. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +*************** +*** 11101,11107 **** + c Follow similar pattern as above, but separator is +|-. + c + c do 9 ivx = 1 , nv +! do 9 ivx = 1 , noinst + call getchar(lineq,iccount,durq) + ipm = index('-+',durq) + if (ipm .eq. 0) then +--- 11101,11107 ---- + c Follow similar pattern as above, but separator is +|-. + c + c do 9 ivx = 1 , nv +! do 9 ivx = 1 , noinstarg + call getchar(lineq,iccount,durq) + ipm = index('-+',durq) + if (ipm .eq. 0) then diff --git a/Build/source/utils/pmx/pmx-2.7.0/PATCH-scor2prt.for-1 b/Build/source/utils/pmx/pmx-2.7.0/PATCH-scor2prt.for-1 new file mode 100644 index 00000000000..54656fad837 --- /dev/null +++ b/Build/source/utils/pmx/pmx-2.7.0/PATCH-scor2prt.for-1 @@ -0,0 +1,182 @@ +*** scor2prt.for.orig 2013-04-11 12:20:31.619378371 -0400 +--- scor2prt.for 2013-04-11 12:24:09.417929495 -0400 +*************** +*** 110,117 **** + read(*,'(a)')jobname + numargs = 1 + else +! call getarg(1,jobname,idum) ! May need to replace this w/ next line +! c call getarg(1,jobname) + end if + ljob = lenstr(jobname,27) + if (ljob .eq. 0) then +--- 110,117 ---- + read(*,'(a)')jobname + numargs = 1 + else +! c call getarg(1,jobname,idum) ! May need to replace this w/ next line +! call getarg(1,jobname) + end if + ljob = lenstr(jobname,27) + if (ljob .eq. 0) then +*************** +*** 177,183 **** + do 22 iv = 1 , nv + instnum(iv) = insnow + if (iv .eq. ivlast) then +! if (iv .lt. nv) botv(iv+1) = .true. + c + c The previous stmt will set botv true only for bot voice of iinst>1. It is + c used when writing termrpts, but the one in voice one is handled differently, +--- 177,183 ---- + do 22 iv = 1 , nv + instnum(iv) = insnow + if (iv .eq. ivlast) then +! if (iv .lt. nv) botv(iv+1) = .true. + c + c The previous stmt will set botv true only for bot voice of iinst>1. It is + c used when writing termrpts, but the one in voice one is handled differently, +*************** +*** 213,235 **** + c + read(10,'(a)')line + call chkcom(line) +! backspace(10) + c + c Normally this puts pointer at start of line with 1st inst name + c Check if prior line was "%%" + c + backspace(10) +! read(10,'(a)')line +! if (line(1:2) .eq. '%%') backspace(10) + do 14 iv = 1 , noinst +! gotname = .false. + 16 read(10,'(a)') instrum(iv) + if (instrum(iv)(1:2) .eq. '%%') then + read(10,'(a)')line + go to 16 + else if (instrum(iv)(1:1) .eq. '%') then + ivq = ichar(instrum(iv)(2:2))-48 +! if (ivq.ne.iv) then + c + c It's really a comment. Copy to parts, then get another trial name. + c +--- 213,235 ---- + c + read(10,'(a)')line + call chkcom(line) +! backspace(10) + c + c Normally this puts pointer at start of line with 1st inst name + c Check if prior line was "%%" + c + backspace(10) +! read(10,'(a)')line +! if (line(1:2) .eq. '%%') backspace(10) + do 14 iv = 1 , noinst +! gotname = .false. + 16 read(10,'(a)') instrum(iv) + if (instrum(iv)(1:2) .eq. '%%') then + read(10,'(a)')line + go to 16 + else if (instrum(iv)(1:1) .eq. '%') then + ivq = ichar(instrum(iv)(2:2))-48 +! if (ivq.ne.iv) then + c + c It's really a comment. Copy to parts, then get another trial name. + c +*************** +*** 270,276 **** + c + read(10,'(a)')line + call chkcom(line) +! if (replacing) then + c + c If here, we have next line after "%%", containing score's clef string + c Assume all clefs are handled with instrument comments. +--- 270,276 ---- + c + read(10,'(a)')line + call chkcom(line) +! if (replacing) then + c + c If here, we have next line after "%%", containing score's clef string + c Assume all clefs are handled with instrument comments. +*************** +*** 339,345 **** + call zapbl(line,128) + call chkcom(line) + lenline = lenstr(line,128) +! if (lenline .eq. 0) go to 4 + if (line(1:1) .eq. 'T') then + call allparts(line,128) + read(10,'(a)')line +--- 339,345 ---- + call zapbl(line,128) + call chkcom(line) + lenline = lenstr(line,128) +! if (lenline .eq. 0) go to 4 + if (line(1:1) .eq. 'T') then + call allparts(line,128) + read(10,'(a)')line +*************** +*** 548,554 **** + c + read(line(3:3),'(i1)')iudpfn + idxstartname = 5 +! else + read(line(3:4),'(i2)')iudpfn + idxstartname = 6 + end if +--- 548,554 ---- + c + read(line(3:3),'(i1)')iudpfn + idxstartname = 5 +! else + read(line(3:4),'(i2)')iudpfn + idxstartname = 6 + end if +*************** +*** 903,914 **** + c New way with slashes: idxs is index of 1st slash! + c + read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum +! idxb = index(line(1)(idxs+1:),'/') + read(line(1)(idxs+1:idxs+idxb-1), +! * '(i'//char(48+idxb-1)//')')mtrden + end if + end if +! lenbeat = ifnodur(mtrden,'x') + lenmult = 1 + if (mtrden .eq. 2) then + lenbeat = 16 +--- 903,914 ---- + c New way with slashes: idxs is index of 1st slash! + c + read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum +! idxb = index(line(1)(idxs+1:),'/') + read(line(1)(idxs+1:idxs+idxb-1), +! * '(i'//char(48+idxb-1)//')')mtrden + end if + end if +! lenbeat = ifnodur(mtrden,'x') + lenmult = 1 + if (mtrden .eq. 2) then + lenbeat = 16 +*************** +*** 1482,1488 **** + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + character*128 line +! logical insetup,replacing + iccount = 0 + do 1 iset = 1 , 12 + call partnum(iv,iccount,line,xdata) +--- 1482,1488 ---- + common /all/ noinow,iorig(noimax),noinst,insetup,replacing, + * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow + character*128 line +! logical insetup,replacing,botv + iccount = 0 + do 1 iset = 1 , 12 + call partnum(iv,iccount,line,xdata) diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc b/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc new file mode 100644 index 00000000000..bcfc5489720 --- /dev/null +++ b/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc @@ -0,0 +1,23 @@ + +pmx does not compile with musl libc because the included +libf2c uses the nonstandard type __off64_t. The below patch, +which is adapted from current libf2c, fixes this. + +Felix Janda [mailto:felix.janda@posteo.de] + + +--- a/pmx-2.6.18/libf2c/sysdep1.h ++++ b/pmx-2.6.18/libf2c/sysdep1.h +@@ -10,7 +10,11 @@ + + #ifdef __linux__ + #define USE_LARGEFILE ++#ifdef __GLIBC__ + #define OFF_T __off64_t ++#else ++#define OFF_T off_t ++#endif + #endif + + #ifdef _AIX43 + diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c b/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c index 3b0e6cfe98b..d4a2e6eae84 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c +++ b/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c @@ -14,7 +14,11 @@ signal_(integer *sigp, sig_pf proc) int sig; sig = (int)*sigp; - return (ftnint)signal(sig, proc); +#ifdef _WIN64 + return (ftnint)(__int64)signal(sig, proc); +#else + return (ftnint)(long)signal(sig, proc); +#endif } #ifdef __cplusplus } diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h b/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h index 4c026a240a1..29546db848e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h +++ b/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h @@ -10,7 +10,11 @@ #ifdef __linux__ #define USE_LARGEFILE +#ifdef __GLIBC__ #define OFF_T __off64_t +#else +#define OFF_T off_t +#endif #endif #ifdef _AIX43 diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for b/Build/source/utils/pmx/pmx-2.7.0/pmx270.for index 5c8e4c36e60..3721bac92d0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for +++ b/Build/source/utils/pmx/pmx-2.7.0/pmx270.for @@ -21,8 +21,8 @@ c along with this program. If not, see <http://www.gnu.org/licenses/>. c c character*9 date - character*5 version,versionc - common /comver/ versionc + character*5 version,versionc + common /comver/ versionc c c To compile with gfortran: c 1. Merge all files using copy *.for epmx[nnnn].for @@ -726,8 +726,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording). c ccccccccccccccccccccccccc c - data date /'3 Apr 13'/ - data version /'2.7'/ + data date /'3 Apr 13'/ + data version /'2.7'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -1347,7 +1347,7 @@ c jacc = iashft(iacc) eximacc = .true. if (.not.relacc) jacc = jacc+ipsav0-ipsav -c +c c (Above) Shift applies to diatonic pitch but will be added to adjusted one c else if (naccim(icm) .gt. 0) then @@ -1443,7 +1443,7 @@ c Bail if this is a chord note on the first call (from docrd) c if (notmain) then call chkimidi(icm) - return + return end if end if c @@ -1787,21 +1787,21 @@ c In iunit, looks backward for oldq, overwrites newq c Safest if both are same length! c character*128 lineq(200),nowq - character*(*) oldq,newq + character*(*) oldq,newq linesback = 0 1 continue backspace(iunit) - read(iunit,'(a)')nowq - ndx = index(nowq,oldq(1:lenold)) + read(iunit,'(a)')nowq + ndx = index(nowq,oldq(1:lenold)) c c Save the line just read c linesback = linesback+1 - lineq(linesback) = nowq + lineq(linesback) = nowq if (ndx .eq. 0) then backspace(iunit) - go to 1 - end if + go to 1 + end if c c If here, it's replacement time. c @@ -2276,7 +2276,7 @@ c c c Check for 2nd member of dotted xtup c - if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', + if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) end if c @@ -2896,7 +2896,7 @@ c Beam segment start. New start level 4 continue end if end if - end if + end if iadj = igetbits(islur(ivx,ipb1),2,27) addbrack = .false. if (btest(ipl(ivx,ipb1),30)) then @@ -3091,7 +3091,7 @@ c return end block data - parameter (nm=24) + parameter (nm=24) common /comtol/ tol common /comtrans/ cheadq common /compage/ widthpt,ptheight,hoffpt,voffpt, @@ -3153,7 +3153,7 @@ c * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12., * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 / data fracsys /30*0./ - data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, + data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3, @@ -3669,7 +3669,7 @@ c meas value for y, natural is 1.6 * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / data segal / c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , -cc (meas. value is 3.08) ^^^^ +cc (meas. value is 3.08) ^^^^ cc Raise top of flat so it interferes with bottom of sharp * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2, * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2, @@ -3693,7 +3693,7 @@ c nsegrb = nsegrb0 rmsshift = 0. shiftmin = 1000. - do 1 iwa = 1 , naccid + do 1 iwa = 1 , naccid c c Initialize shift for this note c @@ -3719,7 +3719,7 @@ c c c Cycle thru segments of right-hand barrier c - do 3 isegrb = 1 , nsegrb-1 + do 3 isegrb = 1 , nsegrb-1 c c Must find all barrier segments that start below ytopseg & end above ybotseg c @@ -3911,7 +3911,7 @@ cc c c This is the final call on the pre-ask pass, so compute left-shift rqmt. c - icashft = nint(-20*shiftmin) + icashft = nint(-20*shiftmin) end if cc cc Temporary printout for boundary segments @@ -4050,12 +4050,12 @@ c No auto-ordering, No autoshifts, Observe all manual shifts. c End if c End if c - maxmanshft = 0 + maxmanshft = 0 do 13 i = 1 , naccid if (kicrd(i) .eq. 0) then c c Main note -c +c manshft = igetbits(nacc,7,10) if (manshft .ne. 0) then manual = .true. @@ -4122,7 +4122,7 @@ c if (kicrd(i) .eq. 0) then irank = icrdot0 nolev = nolevm - else + else irank = igetbits(icrdot(kicrd(i)),3,27) nolev = igetbits(icrdat(kicrd(i)),7,12) end if @@ -4131,8 +4131,8 @@ c else micrd(5-irank) = kicrd(i) end if - if (irank .eq. 2) then - levmidacc = nolev + if (irank .eq. 2) then + levmidacc = nolev end if 20 continue if (levmaxacc.ne.levmidacc+1 .and. @@ -4371,36 +4371,36 @@ c 4. Not a rest (cannot be a rest in a chord!) c. 5. Flag (lowdot) is set to true c if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then - if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then - if (btest(icrdat(icrd),26)) then + if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then + if (btest(icrdat(icrd),26)) then c c Note already in movdot list. Drop by 2. c - call setbits(icrdot(icrd),7,0, + call setbits(icrdot(icrd),7,0, * igetbits(icrdot(icrd),7,0)-20) else c c Not in list so just move it right now c - call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) - end if - end if - end if - if (btest(icrdat(icrd),26)) then + call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) + end if + end if + end if + if (btest(icrdat(icrd),26)) then c c Move the dot. c - updotc = 0.1*(iand(127,icrdot(icrd))-64) - rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) - call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) - end if - isleft = btest(icrdat(icrd),23) - isright = btest(icrdat(icrd),24) + updotc = 0.1*(iand(127,icrdot(icrd))-64) + rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) + call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) + end if + isleft = btest(icrdat(icrd),23) + isright = btest(icrdat(icrd),24) c c Check for ornament in chord. c - if (icrdorn(icrd) .gt. 0) then - call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, + if (icrdorn(icrd) .gt. 0) then + call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, * ip,0,beamon,.true.) c @@ -4558,11 +4558,11 @@ c c ivxtent = iand(idyndat(idyn),15) ivxtent = iand(idyndat(idyn),15) * +16*igetbits(idynda2(idyn),1,10) - if (ivxtent .eq. ivx) then + if (ivxtent .eq. ivx) then iptent = igetbits(idyndat(idyn),8,4) if (iptent .eq. ip) then numdyn = numdyn+1 - idynn(numdyn) = idyn + idynn(numdyn) = idyn else if (iptent .gt. ip) then c c I don't think there are any more possible for this ivx,ip, so exit loop @@ -4640,7 +4640,7 @@ c c Build the command into notex in stages. Insert name & rq'd args in order: c c Command name -c hpstrt, hpcend, hpdend, pmxdyn +c hpstrt, hpcend, hpdend, pmxdyn c ivx c X X X c level @@ -4690,7 +4690,7 @@ c else if (idno .eq.14) then notexq = chax(92)//'Idecresc' lnote = 9 - else + else notexq = chax(92)//'Tcresc' end if end if @@ -4768,8 +4768,8 @@ c c Cases: c numdyn type1 type2 type3 data used c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12) -c 2 hrpnend wrd-grp - ivowg,hoh2 -c 2 hrpnend hrpnstrt - hoh2h1(1...2) +c 2 hrpnend wrd-grp - ivowg,hoh2 +c 2 hrpnend hrpnstrt - hoh2h1(1...2) c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 c if (idno.gt.0 .and. idno.le.12) then @@ -4796,13 +4796,13 @@ c c Hairpin end then hairpin start, no words, (remember dealing with end now) c hoff = hoff+hoh2h1(1) - else + else c c Hairpin end then word-group, need idno for w-g to set hp offset c hoff = hoff + * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12)) - end if + end if c c Protecting against hp start-stop on same note c @@ -4822,7 +4822,7 @@ c c Hairpin end then hairpin start, (remember dealing with start now) c hoff = hoff+hoh2h1(2) - else + else c c Hairpin start after word-group, need idno for w-g to set hp offset c @@ -4852,7 +4852,7 @@ c c Postscript hairpin start...inset placeholder for start level. notexq = notexq(1:lnote)//'{ }' - lnote = lnote+5 + lnote = lnote+5 end if else c @@ -5063,8 +5063,8 @@ c 121 continue ngs = ngstrt(ig) mg = multg(ig) -c wheadpt1 = wheadpt*fullsize(ivx) - wheadpt1 = wheadpt*fullsize(instno) +c wheadpt1 = wheadpt*fullsize(ivx) + wheadpt1 = wheadpt*fullsize(instno) c c For way-after-graces at end of bar, must set the octave. c @@ -5166,7 +5166,7 @@ c * 4+lnoten,soutq,lsout) c end if call addstr(notexq(1:lnote)//noteq(1:lnoten), * lnote+lnoten,soutq,lsout) - if (.not.fontslur) then + if (.not.fontslur) then c c Horizontal tweaks for postscript slur on single grace c @@ -5376,7 +5376,7 @@ c Start a slur on multiple fore-grace c if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then call notefq(noteq,lnoten,nolevg(ngs),ncm) - if (fontslur) then + if (fontslur) then if (upg(ig)) then call addstr(sq//'islurd',7,soutq,lsout) else @@ -5517,7 +5517,7 @@ c lnote = 6 else if (ptoff .lt. 99.95) then write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff lnote = lnote+4 - else + else write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff lnote = lnote+5 end if @@ -5778,7 +5778,7 @@ c else ihoff = ihoff+2 end if - end if + end if if (iscrd) then c c Additional horiz shifts for h-shifted noteheads? @@ -5810,16 +5810,16 @@ c Check for local adjustment default changes c if (btest(isdat2(isdat),26)) then notexq = chax(92)//'sluradjust'//chax(92) - lnote = 12 + lnote = 12 else if (btest(isdat2(isdat),27)) then notexq = chax(92)//'nosluradjust'//chax(92) - lnote = 14 + lnote = 14 else if (btest(isdat2(isdat),28)) then notexq = chax(92)//'tieadjust'//chax(92) - lnote = 11 + lnote = 11 else if (btest(isdat2(isdat),29)) then notexq = chax(92)//'notieadjust'//chax(92) - lnote = 13 + lnote = 13 end if if (ihoff .eq. 0) then c @@ -7143,7 +7143,7 @@ c c Start of 32nd gap, lump with following note c ip = ip+1 - nodue(nreal) = 1+nodur(ivx,ip) + nodue(nreal) = 1+nodur(ivx,ip) itnow = itnow+nodue(nreal) else c @@ -7826,7 +7826,7 @@ c nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) call g1etchar(lineq,iccount,durq) end if - if (durq .eq. 'n') then + if (durq .eq. 'n') then c c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. c @@ -8086,8 +8086,8 @@ c call stop1() end if end if - iccount = iccount-1 - go to 15 + iccount = iccount-1 + go to 15 else if (dumq .eq. 'H' .and. iposn.gt.1) then if (lineq(iccount+1:iccount+1) .eq. 'H') * iccount=iccount+1 @@ -8113,7 +8113,7 @@ c * 'Expected "s" or "t" here!') call stop1() end if - go to 15 + go to 15 else if (dumq .ne. ' ') then ic = ichar(dumq) if ((ic.ge.48.and.ic.le.57) .or. @@ -8471,7 +8471,7 @@ c iccount = iccount-1 end if go to 2 - else if (durq .ne. ' ') then + else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character!') print*,'ASCII code:',ichar(durq) @@ -8915,7 +8915,7 @@ c * 'Cannot reshape postscript ties this way!') call stop1() end if - if (lineq(iccount+1:iccount+1) .eq. 'H') then + if (lineq(iccount+1:iccount+1) .eq. 'H') then iccount=iccount+1 iposn = iposn+1 end if @@ -9034,9 +9034,9 @@ c call stop1() end if end if - iccount = iccount-1 - go to 8 - else if (dumq .eq. 'H' .and. iposn.gt.1) then + iccount = iccount-1 + go to 8 + else if (dumq .eq. 'H' .and. iposn.gt.1) then if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1 go to 8 end if @@ -9155,7 +9155,7 @@ c call stop1() end if call g1etchar(lineq,iccount,charq) - if (charq .eq. '-') then + if (charq .eq. '-') then if (lineq(iccount+1:iccount+2) .ne. '[ ') then call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, * 'Only sequence allowed here is "[ "!') @@ -10500,7 +10500,7 @@ c Hairpin here. Check if opposite type from one that's already on c if (idno.eq.14.and.btest(listdecresc,ivx) .or. * idno.eq.15.and.btest(listcresc,ivx)) then - call printl(' ') + call printl(' ') call printl('Started one kind of hairpin while other is on') call stop1() end if @@ -11053,7 +11053,7 @@ c c c Get volumes for each instrument. Expect nv of them. c Follow same pattern as for insttrument numbers above. -c +c c do 7 ivx = 1 , nv do 7 ivx = 1 , noinstarg call getchar(lineq,iccount,durq) @@ -11076,7 +11076,7 @@ c do 7 ivx = 1 , nv c c Get balance for each instrument. Expect nv of them. c Follow same pattern as for instrument numbers above. -c +c c do 8 ivx = 1 , nv do 8 ivx = 1 , noinstarg call getchar(lineq,iccount,durq) @@ -11099,7 +11099,7 @@ c do 8 ivx = 1 , nv c c Get transposition for each instrument. Expect nv of them. c Follow similar pattern as above, but separator is +|-. -c +c c do 9 ivx = 1 , nv do 9 ivx = 1 , noinstarg call getchar(lineq,iccount,durq) @@ -11898,7 +11898,7 @@ c ivf = 2 end if nfig1 = nfigs(ivf)+1 - call getfig(itoff(ivf,nfig1),charq,lineq,iccount, + call getfig(itoff(ivf,nfig1),charq,lineq,iccount, * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx), * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) go to 7 @@ -12477,7 +12477,7 @@ c numnum = 0 c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) icrdat(ncrd) = nnl(ivx) - call setbits(icrdat(ncrd),4,8,mod(ivx,16)) + call setbits(icrdat(ncrd),4,8,mod(ivx,16)) if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) icrdot(ncrd) = 0 icrdorn(ncrd) = 0 @@ -12497,7 +12497,7 @@ c Expect +|-|<|> , set tag, loop c icrdat(ncrd) = ibset(icrdat(ncrd),29) go to 25 - else if (ndx .gt. 0) then + else if (ndx .gt. 0) then if (ndx .le. 3) then if (.not.btest(icrdat(ncrd),19)) then icrdat(ncrd) = ibset(icrdat(ncrd),19) @@ -13849,7 +13849,7 @@ c * t1fb(ivx,nfb(ivx)) = * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2 end if -c +c c Change duration of prior note c itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) @@ -13871,7 +13871,7 @@ c iornq0: Store iorni + bit 23, in case of repeated ornaments c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. c noffseg: horiz. offset for segno c nole: level of note w/ orn, used to ID the note/orn if there's a level shift. -c +c common /comivxudorn/ivxudorn(63) common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), @@ -14615,7 +14615,7 @@ c isetvarlen = isetvarlen+2**(8*nbytes+7) else return - end if + end if 1 continue print*,'Problem in function isetvarlen' call stop1() @@ -14706,7 +14706,7 @@ c logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie character*1 udq,chax,sepsymq(nm) character*8 noteq - character*128 notexq + character*128 notexq c c This is called twice from pmxb after having input an entire block, before c making a bar that starts a new system. So nsdat reflects all slur starts @@ -14718,8 +14718,8 @@ c Second (ispstie=.true. on entry) restarts tie at start of new line. Only c need data from original tie-start for both of these. Tie/slur data from c closing of full tie are not used except for shape alterations. c -c do 1 ndx = 0 , 11 - do 1 ndx = 0 , 23 +c do 1 ndx = 0 , 11 + do 1 ndx = 0 , 23 if (btest(listslur,ndx)) then c c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie @@ -15098,7 +15098,7 @@ c else if (iiip .gt. 1) then if (btest(nacc(ivx,iiip-1),19)) * mult(ivx,iiip) = mult(ivx,iiip)+1 - end if + end if 74 continue isxtup = .false. end if @@ -15157,7 +15157,7 @@ c character*65536 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - lbuf(1) = lbuf(1) + lbuf(1) = lbuf(1) if (.not.mrecord) then c c Starting the macro @@ -16695,7 +16695,7 @@ c * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), * nacc(ivx,ip)) end if - end if + end if if (isgrace) then c c Grace note. @@ -16796,7 +16796,7 @@ c c Process dynamic marks c if (btest(irest(ivx,ip),26)) then - call dodyn(ivx,ip, + call dodyn(ivx,ip, * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip), * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq, * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout) @@ -17945,7 +17945,7 @@ c common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), * ndotmv(nm),updot(nm,20),rtdot(nm,20) common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtol/ tol + common /comtol/ tol if (ncc(iv) .eq. 1) then ncmid = ncmidcc(iv,1) else @@ -18636,7 +18636,7 @@ ccccccccccccccccccccccccccccccccccc mplay = .false. lastchar = .false. novshrinktop = .false. - cstuplet = .false. + cstuplet = .false. fontslur = .true. isligfont = .false. fulltrans = .false. @@ -18833,7 +18833,7 @@ c call makeabar() elsk(ibarcnt) = elskb+fbar 10 continue - newmeter = .false. + newmeter = .false. firstline = .false. go to 30 20 continue @@ -19665,7 +19665,7 @@ cccccccccccccccccccccccccccccccc ignorenats = .false. bcspec = .true. topmods = .false. - ismbr = .false. + ismbr = .false. read(12,'(a)')basenameq read(12,*)lbase read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop, @@ -19818,7 +19818,7 @@ c nobar1 = .false. equalize = .false. usevshrink = .true. - WrotePsslurDefaults = .false. + WrotePsslurDefaults = .false. OptLineBreakTies = .false. HeaderSpecial = .false. c @@ -20397,7 +20397,7 @@ c end if lnmq = 12 if (movgap .lt. 10) then lnmq = 14 - write(nmq(13:14),'(2i1)')movgap,indsym + write(nmq(13:14),'(2i1)')movgap,indsym else lnmq = 17 write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym @@ -21168,7 +21168,7 @@ c minlev = nolevm levtabl(nolevm) = -1 is2nd = .false. - naccid = 0 + naccid = 0 levmaxacc = -100 levminacc = 1000 c @@ -21456,7 +21456,7 @@ c end if if (ilvert .gt. 9) then write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' lnote = lnote+4 - else + else notexq = notexq(1:lnote)//chax(48+ilvert) lnote = lnote+1 end if @@ -21503,7 +21503,7 @@ c or for negative, ...xyz*ast{-nn.n}*lmnop... character*79 notexq logical btest c ivxip = ivx+16*ip - do 1 ibc = 1 , nbc + do 1 ibc = 1 , nbc c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 @@ -21565,7 +21565,7 @@ c lnote = lnote+1 end if return - end + end subroutine putfig(ivx,ifig,offnsk,figcheck,soutq,lsout) parameter (nm=24) common /comfig/ itfig(2,74),figqq(2,74),ivupfig(2,74),nfigs(2), @@ -22984,8 +22984,8 @@ c call setbits(isdat1(nsdat),1,12,kv-1) call setbits(isdat1(nsdat),8,3,ip) isdat3(nsdat) = 0 - isdat4(nsdat) = 0 - ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur + isdat4(nsdat) = 0 + ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur c c Get ID code c @@ -23170,15 +23170,15 @@ c 28 \tieadjust (p+t) c 29 \notieadjust (p-t) if (durq .eq. '+') then if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),26) + isdat2(nsdat) = ibset(isdat2(nsdat),26) else - isdat2(nsdat) = ibset(isdat2(nsdat),28) + isdat2(nsdat) = ibset(isdat2(nsdat),28) end if else if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),27) + isdat2(nsdat) = ibset(isdat2(nsdat),27) else - isdat2(nsdat) = ibset(isdat2(nsdat),29) + isdat2(nsdat) = ibset(isdat2(nsdat),29) end if end if go to 1 @@ -23780,8 +23780,8 @@ c c Used to be icmm(0:nm); did midi fail when nv>16? c integer*2 iinsiv,icmm(0:15) - character*5 versionc - common /comver/ versionc + character*5 versionc + common /comver/ versionc c c These are not consecutive because channel 9 is reserved for percussion. c @@ -23968,7 +23968,7 @@ c integer*4 iInstTrans(nm),iTransKey(nm) character*79 notexq character*1 chax - logical flag + logical flag c c Assumes notexq is blank c @@ -23994,7 +23994,7 @@ c write(11,'(a)')notexq(1:lnote)//'%' 1 continue flag = .false. - return + return end subroutine writflot(x,notexq,lenline) character*(*) notexq diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig b/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig index 2c1f0053b8f..df86e657986 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig +++ b/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig @@ -21,8 +21,8 @@ c along with this program. If not, see <http://www.gnu.org/licenses/>. c c character*9 date - character*5 version,versionc - common /comver/ versionc + character*5 version,versionc + common /comver/ versionc c c To compile with gfortran: c 1. Merge all files using copy *.for epmx[nnnn].for @@ -726,8 +726,8 @@ c nmidsec section starts and stops based on PLAYING macros (not recording). c ccccccccccccccccccccccccc c - data date /'3 Apr 13'/ - data version /'2.7'/ + data date /'3 Apr 13'/ + data version /'2.7'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -1347,7 +1347,7 @@ c jacc = iashft(iacc) eximacc = .true. if (.not.relacc) jacc = jacc+ipsav0-ipsav -c +c c (Above) Shift applies to diatonic pitch but will be added to adjusted one c else if (naccim(icm) .gt. 0) then @@ -1443,7 +1443,7 @@ c Bail if this is a chord note on the first call (from docrd) c if (notmain) then call chkimidi(icm) - return + return end if end if c @@ -1787,21 +1787,21 @@ c In iunit, looks backward for oldq, overwrites newq c Safest if both are same length! c character*128 lineq(200),nowq - character*(*) oldq,newq + character*(*) oldq,newq linesback = 0 1 continue backspace(iunit) - read(iunit,'(a)')nowq - ndx = index(nowq,oldq(1:lenold)) + read(iunit,'(a)')nowq + ndx = index(nowq,oldq(1:lenold)) c c Save the line just read c linesback = linesback+1 - lineq(linesback) = nowq + lineq(linesback) = nowq if (ndx .eq. 0) then backspace(iunit) - go to 1 - end if + go to 1 + end if c c If here, it's replacement time. c @@ -2276,7 +2276,7 @@ c c c Check for 2nd member of dotted xtup c - if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', + if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t', * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote) end if c @@ -2896,7 +2896,7 @@ c Beam segment start. New start level 4 continue end if end if - end if + end if iadj = igetbits(islur(ivx,ipb1),2,27) addbrack = .false. if (btest(ipl(ivx,ipb1),30)) then @@ -3091,7 +3091,7 @@ c return end block data - parameter (nm=24) + parameter (nm=24) common /comtol/ tol common /comtrans/ cheadq common /compage/ widthpt,ptheight,hoffpt,voffpt, @@ -3153,7 +3153,7 @@ c * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12., * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 / data fracsys /30*0./ - data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, + data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1, c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6, * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3, @@ -3669,7 +3669,7 @@ c meas value for y, natural is 1.6 * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. / data segal / c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. , -cc (meas. value is 3.08) ^^^^ +cc (meas. value is 3.08) ^^^^ cc Raise top of flat so it interferes with bottom of sharp * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2, * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2, @@ -3693,7 +3693,7 @@ c nsegrb = nsegrb0 rmsshift = 0. shiftmin = 1000. - do 1 iwa = 1 , naccid + do 1 iwa = 1 , naccid c c Initialize shift for this note c @@ -3719,7 +3719,7 @@ c c c Cycle thru segments of right-hand barrier c - do 3 isegrb = 1 , nsegrb-1 + do 3 isegrb = 1 , nsegrb-1 c c Must find all barrier segments that start below ytopseg & end above ybotseg c @@ -3911,7 +3911,7 @@ cc c c This is the final call on the pre-ask pass, so compute left-shift rqmt. c - icashft = nint(-20*shiftmin) + icashft = nint(-20*shiftmin) end if cc cc Temporary printout for boundary segments @@ -4050,12 +4050,12 @@ c No auto-ordering, No autoshifts, Observe all manual shifts. c End if c End if c - maxmanshft = 0 + maxmanshft = 0 do 13 i = 1 , naccid if (kicrd(i) .eq. 0) then c c Main note -c +c manshft = igetbits(nacc,7,10) if (manshft .ne. 0) then manual = .true. @@ -4122,7 +4122,7 @@ c if (kicrd(i) .eq. 0) then irank = icrdot0 nolev = nolevm - else + else irank = igetbits(icrdot(kicrd(i)),3,27) nolev = igetbits(icrdat(kicrd(i)),7,12) end if @@ -4131,8 +4131,8 @@ c else micrd(5-irank) = kicrd(i) end if - if (irank .eq. 2) then - levmidacc = nolev + if (irank .eq. 2) then + levmidacc = nolev end if 20 continue if (levmaxacc.ne.levmidacc+1 .and. @@ -4371,36 +4371,36 @@ c 4. Not a rest (cannot be a rest in a chord!) c. 5. Flag (lowdot) is set to true c if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then - if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then - if (btest(icrdat(icrd),26)) then + if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then + if (btest(icrdat(icrd),26)) then c c Note already in movdot list. Drop by 2. c - call setbits(icrdot(icrd),7,0, + call setbits(icrdot(icrd),7,0, * igetbits(icrdot(icrd),7,0)-20) else c c Not in list so just move it right now c - call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) - end if - end if - end if - if (btest(icrdat(icrd),26)) then + call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3)) + end if + end if + end if + if (btest(icrdat(icrd),26)) then c c Move the dot. c - updotc = 0.1*(iand(127,icrdot(icrd))-64) - rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) - call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) - end if - isleft = btest(icrdat(icrd),23) - isright = btest(icrdat(icrd),24) + updotc = 0.1*(iand(127,icrdot(icrd))-64) + rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64) + call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3)) + end if + isleft = btest(icrdat(icrd),23) + isright = btest(icrdat(icrd),24) c c Check for ornament in chord. c - if (icrdorn(icrd) .gt. 0) then - call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, + if (icrdorn(icrd) .gt. 0) then + call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq, * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout, * ip,0,beamon,.true.) c @@ -4558,11 +4558,11 @@ c c ivxtent = iand(idyndat(idyn),15) ivxtent = iand(idyndat(idyn),15) * +16*igetbits(idynda2(idyn),1,10) - if (ivxtent .eq. ivx) then + if (ivxtent .eq. ivx) then iptent = igetbits(idyndat(idyn),8,4) if (iptent .eq. ip) then numdyn = numdyn+1 - idynn(numdyn) = idyn + idynn(numdyn) = idyn else if (iptent .gt. ip) then c c I don't think there are any more possible for this ivx,ip, so exit loop @@ -4640,7 +4640,7 @@ c c Build the command into notex in stages. Insert name & rq'd args in order: c c Command name -c hpstrt, hpcend, hpdend, pmxdyn +c hpstrt, hpcend, hpdend, pmxdyn c ivx c X X X c level @@ -4690,7 +4690,7 @@ c else if (idno .eq.14) then notexq = chax(92)//'Idecresc' lnote = 9 - else + else notexq = chax(92)//'Tcresc' end if end if @@ -4768,8 +4768,8 @@ c c Cases: c numdyn type1 type2 type3 data used c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12) -c 2 hrpnend wrd-grp - ivowg,hoh2 -c 2 hrpnend hrpnstrt - hoh2h1(1...2) +c 2 hrpnend wrd-grp - ivowg,hoh2 +c 2 hrpnend hrpnstrt - hoh2h1(1...2) c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 c if (idno.gt.0 .and. idno.le.12) then @@ -4796,13 +4796,13 @@ c c Hairpin end then hairpin start, no words, (remember dealing with end now) c hoff = hoff+hoh2h1(1) - else + else c c Hairpin end then word-group, need idno for w-g to set hp offset c hoff = hoff + * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12)) - end if + end if c c Protecting against hp start-stop on same note c @@ -4822,7 +4822,7 @@ c c Hairpin end then hairpin start, (remember dealing with start now) c hoff = hoff+hoh2h1(2) - else + else c c Hairpin start after word-group, need idno for w-g to set hp offset c @@ -4852,7 +4852,7 @@ c c Postscript hairpin start...inset placeholder for start level. notexq = notexq(1:lnote)//'{ }' - lnote = lnote+5 + lnote = lnote+5 end if else c @@ -5063,8 +5063,8 @@ c 121 continue ngs = ngstrt(ig) mg = multg(ig) -c wheadpt1 = wheadpt*fullsize(ivx) - wheadpt1 = wheadpt*fullsize(instno) +c wheadpt1 = wheadpt*fullsize(ivx) + wheadpt1 = wheadpt*fullsize(instno) c c For way-after-graces at end of bar, must set the octave. c @@ -5166,7 +5166,7 @@ c * 4+lnoten,soutq,lsout) c end if call addstr(notexq(1:lnote)//noteq(1:lnoten), * lnote+lnoten,soutq,lsout) - if (.not.fontslur) then + if (.not.fontslur) then c c Horizontal tweaks for postscript slur on single grace c @@ -5376,7 +5376,7 @@ c Start a slur on multiple fore-grace c if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then call notefq(noteq,lnoten,nolevg(ngs),ncm) - if (fontslur) then + if (fontslur) then if (upg(ig)) then call addstr(sq//'islurd',7,soutq,lsout) else @@ -5517,7 +5517,7 @@ c lnote = 6 else if (ptoff .lt. 99.95) then write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff lnote = lnote+4 - else + else write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff lnote = lnote+5 end if @@ -5778,7 +5778,7 @@ c else ihoff = ihoff+2 end if - end if + end if if (iscrd) then c c Additional horiz shifts for h-shifted noteheads? @@ -5810,16 +5810,16 @@ c Check for local adjustment default changes c if (btest(isdat2(isdat),26)) then notexq = chax(92)//'sluradjust'//chax(92) - lnote = 12 + lnote = 12 else if (btest(isdat2(isdat),27)) then notexq = chax(92)//'nosluradjust'//chax(92) - lnote = 14 + lnote = 14 else if (btest(isdat2(isdat),28)) then notexq = chax(92)//'tieadjust'//chax(92) - lnote = 11 + lnote = 11 else if (btest(isdat2(isdat),29)) then notexq = chax(92)//'notieadjust'//chax(92) - lnote = 13 + lnote = 13 end if if (ihoff .eq. 0) then c @@ -7143,7 +7143,7 @@ c c Start of 32nd gap, lump with following note c ip = ip+1 - nodue(nreal) = 1+nodur(ivx,ip) + nodue(nreal) = 1+nodur(ivx,ip) itnow = itnow+nodue(nreal) else c @@ -7826,7 +7826,7 @@ c nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27) call g1etchar(lineq,iccount,durq) end if - if (durq .eq. 'n') then + if (durq .eq. 'n') then c c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. c @@ -8086,8 +8086,8 @@ c call stop1() end if end if - iccount = iccount-1 - go to 15 + iccount = iccount-1 + go to 15 else if (dumq .eq. 'H' .and. iposn.gt.1) then if (lineq(iccount+1:iccount+1) .eq. 'H') * iccount=iccount+1 @@ -8113,7 +8113,7 @@ c * 'Expected "s" or "t" here!') call stop1() end if - go to 15 + go to 15 else if (dumq .ne. ' ') then ic = ichar(dumq) if ((ic.ge.48.and.ic.le.57) .or. @@ -8471,7 +8471,7 @@ c iccount = iccount-1 end if go to 2 - else if (durq .ne. ' ') then + else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character!') print*,'ASCII code:',ichar(durq) @@ -8915,7 +8915,7 @@ c * 'Cannot reshape postscript ties this way!') call stop1() end if - if (lineq(iccount+1:iccount+1) .eq. 'H') then + if (lineq(iccount+1:iccount+1) .eq. 'H') then iccount=iccount+1 iposn = iposn+1 end if @@ -9034,9 +9034,9 @@ c call stop1() end if end if - iccount = iccount-1 - go to 8 - else if (dumq .eq. 'H' .and. iposn.gt.1) then + iccount = iccount-1 + go to 8 + else if (dumq .eq. 'H' .and. iposn.gt.1) then if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1 go to 8 end if @@ -9155,7 +9155,7 @@ c call stop1() end if call g1etchar(lineq,iccount,charq) - if (charq .eq. '-') then + if (charq .eq. '-') then if (lineq(iccount+1:iccount+2) .ne. '[ ') then call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, * 'Only sequence allowed here is "[ "!') @@ -10500,7 +10500,7 @@ c Hairpin here. Check if opposite type from one that's already on c if (idno.eq.14.and.btest(listdecresc,ivx) .or. * idno.eq.15.and.btest(listcresc,ivx)) then - call printl(' ') + call printl(' ') call printl('Started one kind of hairpin while other is on') call stop1() end if @@ -11053,7 +11053,7 @@ c c c Get volumes for each instrument. Expect nv of them. c Follow same pattern as for insttrument numbers above. -c +c c do 7 ivx = 1 , nv do 7 ivx = 1 , noinst call getchar(lineq,iccount,durq) @@ -11076,7 +11076,7 @@ c do 7 ivx = 1 , nv c c Get balance for each instrument. Expect nv of them. c Follow same pattern as for instrument numbers above. -c +c c do 8 ivx = 1 , nv do 8 ivx = 1 , noinst call getchar(lineq,iccount,durq) @@ -11099,7 +11099,7 @@ c do 8 ivx = 1 , nv c c Get transposition for each instrument. Expect nv of them. c Follow similar pattern as above, but separator is +|-. -c +c c do 9 ivx = 1 , nv do 9 ivx = 1 , noinst call getchar(lineq,iccount,durq) @@ -11898,7 +11898,7 @@ c ivf = 2 end if nfig1 = nfigs(ivf)+1 - call getfig(itoff(ivf,nfig1),charq,lineq,iccount, + call getfig(itoff(ivf,nfig1),charq,lineq,iccount, * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx), * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) go to 7 @@ -12477,7 +12477,7 @@ c numnum = 0 c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) icrdat(ncrd) = nnl(ivx) - call setbits(icrdat(ncrd),4,8,mod(ivx,16)) + call setbits(icrdat(ncrd),4,8,mod(ivx,16)) if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28) icrdot(ncrd) = 0 icrdorn(ncrd) = 0 @@ -12497,7 +12497,7 @@ c Expect +|-|<|> , set tag, loop c icrdat(ncrd) = ibset(icrdat(ncrd),29) go to 25 - else if (ndx .gt. 0) then + else if (ndx .gt. 0) then if (ndx .le. 3) then if (.not.btest(icrdat(ncrd),19)) then icrdat(ncrd) = ibset(icrdat(ncrd),19) @@ -13849,7 +13849,7 @@ c * t1fb(ivx,nfb(ivx)) = * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2 end if -c +c c Change duration of prior note c itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx)) @@ -13871,7 +13871,7 @@ c iornq0: Store iorni + bit 23, in case of repeated ornaments c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd. c noffseg: horiz. offset for segno c nole: level of note w/ orn, used to ID the note/orn if there's a level shift. -c +c common /comivxudorn/ivxudorn(63) common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24), @@ -14615,7 +14615,7 @@ c isetvarlen = isetvarlen+2**(8*nbytes+7) else return - end if + end if 1 continue print*,'Problem in function isetvarlen' call stop1() @@ -14706,7 +14706,7 @@ c logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie character*1 udq,chax,sepsymq(nm) character*8 noteq - character*128 notexq + character*128 notexq c c This is called twice from pmxb after having input an entire block, before c making a bar that starts a new system. So nsdat reflects all slur starts @@ -14718,8 +14718,8 @@ c Second (ispstie=.true. on entry) restarts tie at start of new line. Only c need data from original tie-start for both of these. Tie/slur data from c closing of full tie are not used except for shape alterations. c -c do 1 ndx = 0 , 11 - do 1 ndx = 0 , 23 +c do 1 ndx = 0 , 11 + do 1 ndx = 0 , 23 if (btest(listslur,ndx)) then c c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie @@ -15098,7 +15098,7 @@ c else if (iiip .gt. 1) then if (btest(nacc(ivx,iiip-1),19)) * mult(ivx,iiip) = mult(ivx,iiip)+1 - end if + end if 74 continue isxtup = .false. end if @@ -15157,7 +15157,7 @@ c character*65536 bufq integer*2 lbuf(maxblks) common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq - lbuf(1) = lbuf(1) + lbuf(1) = lbuf(1) if (.not.mrecord) then c c Starting the macro @@ -16695,7 +16695,7 @@ c * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)), * nacc(ivx,ip)) end if - end if + end if if (isgrace) then c c Grace note. @@ -16796,7 +16796,7 @@ c c Process dynamic marks c if (btest(irest(ivx,ip),26)) then - call dodyn(ivx,ip, + call dodyn(ivx,ip, * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip), * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq, * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout) @@ -17945,7 +17945,7 @@ c common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10), * ndotmv(nm),updot(nm,20),rtdot(nm,20) common /commvl/ nvmx(nm),ivmx(nm,2),ivx - common /comtol/ tol + common /comtol/ tol if (ncc(iv) .eq. 1) then ncmid = ncmidcc(iv,1) else @@ -18636,7 +18636,7 @@ ccccccccccccccccccccccccccccccccccc mplay = .false. lastchar = .false. novshrinktop = .false. - cstuplet = .false. + cstuplet = .false. fontslur = .true. isligfont = .false. fulltrans = .false. @@ -18833,7 +18833,7 @@ c call makeabar() elsk(ibarcnt) = elskb+fbar 10 continue - newmeter = .false. + newmeter = .false. firstline = .false. go to 30 20 continue @@ -19665,7 +19665,7 @@ cccccccccccccccccccccccccccccccc ignorenats = .false. bcspec = .true. topmods = .false. - ismbr = .false. + ismbr = .false. read(12,'(a)')basenameq read(12,*)lbase read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop, @@ -19818,7 +19818,7 @@ c nobar1 = .false. equalize = .false. usevshrink = .true. - WrotePsslurDefaults = .false. + WrotePsslurDefaults = .false. OptLineBreakTies = .false. HeaderSpecial = .false. c @@ -20397,7 +20397,7 @@ c end if lnmq = 12 if (movgap .lt. 10) then lnmq = 14 - write(nmq(13:14),'(2i1)')movgap,indsym + write(nmq(13:14),'(2i1)')movgap,indsym else lnmq = 17 write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym @@ -21168,7 +21168,7 @@ c minlev = nolevm levtabl(nolevm) = -1 is2nd = .false. - naccid = 0 + naccid = 0 levmaxacc = -100 levminacc = 1000 c @@ -21456,7 +21456,7 @@ c end if if (ilvert .gt. 9) then write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' lnote = lnote+4 - else + else notexq = notexq(1:lnote)//chax(48+ilvert) lnote = lnote+1 end if @@ -21503,7 +21503,7 @@ c or for negative, ...xyz*ast{-nn.n}*lmnop... character*79 notexq logical btest c ivxip = ivx+16*ip - do 1 ibc = 1 , nbc + do 1 ibc = 1 , nbc c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 @@ -21565,7 +21565,7 @@ c lnote = lnote+1 end if return - end + end subroutine putfig(ivx,ifig,offnsk,figcheck,soutq,lsout) parameter (nm=24) common /comfig/ itfig(2,74),figqq(2,74),ivupfig(2,74),nfigs(2), @@ -22984,8 +22984,8 @@ c call setbits(isdat1(nsdat),1,12,kv-1) call setbits(isdat1(nsdat),8,3,ip) isdat3(nsdat) = 0 - isdat4(nsdat) = 0 - ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur + isdat4(nsdat) = 0 + ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur c c Get ID code c @@ -23170,15 +23170,15 @@ c 28 \tieadjust (p+t) c 29 \notieadjust (p-t) if (durq .eq. '+') then if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),26) + isdat2(nsdat) = ibset(isdat2(nsdat),26) else - isdat2(nsdat) = ibset(isdat2(nsdat),28) + isdat2(nsdat) = ibset(isdat2(nsdat),28) end if else if (dumq .eq. 's') then - isdat2(nsdat) = ibset(isdat2(nsdat),27) + isdat2(nsdat) = ibset(isdat2(nsdat),27) else - isdat2(nsdat) = ibset(isdat2(nsdat),29) + isdat2(nsdat) = ibset(isdat2(nsdat),29) end if end if go to 1 @@ -23780,8 +23780,8 @@ c c Used to be icmm(0:nm); did midi fail when nv>16? c integer*2 iinsiv,icmm(0:15) - character*5 versionc - common /comver/ versionc + character*5 versionc + common /comver/ versionc c c These are not consecutive because channel 9 is reserved for percussion. c @@ -23968,7 +23968,7 @@ c integer*4 iInstTrans(nm),iTransKey(nm) character*79 notexq character*1 chax - logical flag + logical flag c c Assumes notexq is blank c @@ -23994,7 +23994,7 @@ c write(11,'(a)')notexq(1:lnote)//'%' 1 continue flag = .false. - return + return end subroutine writflot(x,notexq,lenline) character*(*) notexq diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmxab.c b/Build/source/utils/pmx/pmx-2.7.0/pmxab.c index 7b466f615e2..5768ca634c3 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmxab.c +++ b/Build/source/utils/pmx/pmx-2.7.0/pmxab.c @@ -48,21 +48,13 @@ struct { #define commidi_1 commidi_ -union { - struct { - integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24] - , midtc[25], noinst; - shortint iinsiv[24]; - } _1; - struct { - integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24] - , midtc[25], noinstdum; - shortint iinsiv[24]; - } _2; +struct { + integer midivel[24], midvelc[25], midibal[24], midbc[25], miditran[24], + midtc[25], noinst; + shortint iinsiv[24]; } commvel_; -#define commvel_1 (commvel_._1) -#define commvel_2 (commvel_._2) +#define commvel_1 commvel_ struct { integer ipbuf, ilbuf, nlbuf; @@ -6265,7 +6257,7 @@ L18: /* * -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 (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) */ @@ -7589,7 +7581,7 @@ L2: /* Build the command into notex in stages. Insert name & rq'd args in order: */ /* Command name */ -/* hpstrt, hpcend, hpdend, pmxdyn */ +/* hpstrt, hpcend, hpdend, pmxdyn */ /* ivx */ /* X X X */ /* level */ @@ -7774,8 +7766,8 @@ L2: /* 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) */ +/* 2 hrpnend wrd-grp - ivowg,hoh2 */ +/* 2 hrpnend hrpnstrt - hoh2h1(1...2) */ /* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */ if (idno > 0 && idno <= 12) { @@ -8253,7 +8245,7 @@ L5: L121: ngs = comgrace_1.ngstrt[*ig - 1]; mg = comgrace_1.multg[*ig - 1]; -/* wheadpt1 = wheadpt*fullsize(ivx) */ +/* wheadpt1 = wheadpt*fullsize(ivx) */ wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1]; /* For way-after-graces at end of bar, must set the octave. */ @@ -17143,9 +17135,9 @@ L1: goto L1; } /* getitransinfo_ */ -/* Subroutine */ int getmidi_(integer *noinst, char *lineq, integer *iccount, - integer *ibarcnt, integer *ibaroff, integer *nbars, integer *lenbar, - integer *mtrdenl, logical *first, ftnlen lineq_len) +/* 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 */ @@ -17272,7 +17264,7 @@ L1: /* Instrument numbers or letters. Expect noinst of them. */ /* do 2 ivx = 1 , nv */ - i__1 = *noinst; + i__1 = *noinstarg; for (ivx = 1; ivx <= i__1; ++ivx) { getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); if (*(unsigned char *)durq > 96) { @@ -17330,7 +17322,7 @@ L1: /* Follow same pattern as for insttrument numbers above. */ /* do 7 ivx = 1 , nv */ - i__1 = *noinst; + i__1 = *noinstarg; for (ivx = 1; ivx <= i__1; ++ivx) { getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { @@ -17340,8 +17332,8 @@ L1: stop1_(); } readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); - commvel_2.midivel[ivx - 1] = i_nint(&fnum) - 1; - if (commvel_2.midivel[ivx - 1] < 0 || commvel_2.midivel[ivx - 1] + commvel_1.midivel[ivx - 1] = i_nint(&fnum) - 1; + if (commvel_1.midivel[ivx - 1] < 0 || commvel_1.midivel[ivx - 1] > 127) { i__3 = *iccount - 1; i__4 = *ibarcnt - *ibaroff + *nbars + 1; @@ -17361,7 +17353,7 @@ L1: /* Follow same pattern as for instrument numbers above. */ /* do 8 ivx = 1 , nv */ - i__1 = *noinst; + i__1 = *noinstarg; for (ivx = 1; ivx <= i__1; ++ivx) { getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) { @@ -17371,8 +17363,8 @@ L1: stop1_(); } readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); - commvel_2.midibal[ivx - 1] = i_nint(&fnum) - 1; - if (commvel_2.midibal[ivx - 1] < 0 || commvel_2.midibal[ivx - 1] + commvel_1.midibal[ivx - 1] = i_nint(&fnum) - 1; + if (commvel_1.midibal[ivx - 1] < 0 || commvel_1.midibal[ivx - 1] > 127) { i__3 = *iccount - 1; i__4 = *ibarcnt - *ibaroff + *nbars + 1; @@ -17392,7 +17384,7 @@ L1: /* Follow similar pattern as above, but separator is +|-. */ /* do 9 ivx = 1 , nv */ - i__1 = *noinst; + i__1 = *noinstarg; for (ivx = 1; ivx <= i__1; ++ivx) { getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1); @@ -17411,7 +17403,7 @@ L1: stop1_(); } readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1); - commvel_2.miditran[ivx - 1] = ipm * i_nint(&fnum); + 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!') */ @@ -22650,7 +22642,7 @@ integer lfmt1_(real *x) /* 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 */ +/* do 1 ndx = 0 , 11 */ /* Parameter adjustments */ --sepsymq; --isdat4; @@ -36212,7 +36204,7 @@ L6: /* Get ID code */ -/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */ +/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak s */ getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); if (i_indx("uldtb+-hfnHps ", durq, (ftnlen)14, (ftnlen)1) > 0) { diff --git a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c b/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c index de12aaa6f88..d83124d27e0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c +++ b/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c @@ -21,16 +21,8 @@ struct all_1_ { logical botv[24]; integer nvi[24], nsyst, nvnow; }; -struct all_2_ { - integer noinow, iorig[24], noinst; - logical insetup, replacing; - integer instnum[24]; - logical botv[24]; - integer nvi[24], nsyst, nvnow; -}; #define all_1 (*(struct all_1_ *) &all_) -#define all_2 (*(struct all_2_ *) &all_) /* Initialized data */ @@ -2595,7 +2587,7 @@ L2: /* It's nv */ s_wsfe(&io___209); - do_fio(&c__1, (char *)&all_2.nvi[*iv - 1], (ftnlen)sizeof( + do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof( integer)); e_wsfe(); } else { @@ -2603,7 +2595,7 @@ L2: /* npages must be computed */ s_wsfe(&io___210); - i__1 = (all_2.nsyst - 1) / 12 + 1; + i__1 = (all_1.nsyst - 1) / 12 + 1; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); e_wsfe(); } diff --git a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for b/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for index 018f44a4651..c6ff8931ff2 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for +++ b/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for @@ -177,7 +177,7 @@ c do 22 iv = 1 , nv instnum(iv) = insnow if (iv .eq. ivlast) then - if (iv .lt. nv) botv(iv+1) = .true. + if (iv .lt. nv) botv(iv+1) = .true. c c The previous stmt will set botv true only for bot voice of iinst>1. It is c used when writing termrpts, but the one in voice one is handled differently, @@ -213,23 +213,23 @@ c Must leave insetup=.true. else could bypass ALL instrument names. c read(10,'(a)')line call chkcom(line) - backspace(10) + backspace(10) c c Normally this puts pointer at start of line with 1st inst name c Check if prior line was "%%" c backspace(10) - read(10,'(a)')line - if (line(1:2) .eq. '%%') backspace(10) + read(10,'(a)')line + if (line(1:2) .eq. '%%') backspace(10) do 14 iv = 1 , noinst - gotname = .false. + gotname = .false. 16 read(10,'(a)') instrum(iv) if (instrum(iv)(1:2) .eq. '%%') then read(10,'(a)')line go to 16 else if (instrum(iv)(1:1) .eq. '%') then ivq = ichar(instrum(iv)(2:2))-48 - if (ivq.ne.iv) then + if (ivq.ne.iv) then c c It's really a comment. Copy to parts, then get another trial name. c @@ -270,7 +270,7 @@ c Clef string: Note insetup is still T, so "%%" will be treated specially c read(10,'(a)')line call chkcom(line) - if (replacing) then + if (replacing) then c c If here, we have next line after "%%", containing score's clef string c Assume all clefs are handled with instrument comments. @@ -339,7 +339,7 @@ c call zapbl(line,128) call chkcom(line) lenline = lenstr(line,128) - if (lenline .eq. 0) go to 4 + if (lenline .eq. 0) go to 4 if (line(1:1) .eq. 'T') then call allparts(line,128) read(10,'(a)')line @@ -548,7 +548,7 @@ c Single digit instrument number c read(line(3:3),'(i1)')iudpfn idxstartname = 5 - else + else read(line(3:4),'(i2)')iudpfn idxstartname = 6 end if @@ -903,12 +903,12 @@ c c New way with slashes: idxs is index of 1st slash! c read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum - idxb = index(line(1)(idxs+1:),'/') + idxb = index(line(1)(idxs+1:),'/') read(line(1)(idxs+1:idxs+idxb-1), - * '(i'//char(48+idxb-1)//')')mtrden + * '(i'//char(48+idxb-1)//')')mtrden end if end if - lenbeat = ifnodur(mtrden,'x') + lenbeat = ifnodur(mtrden,'x') lenmult = 1 if (mtrden .eq. 2) then lenbeat = 16 |